Upgrade to Encode 0.99, from Dan Kogai.

[p5sagit/p5-mst-13.2.git] / ext / PerlIO / PerlIO.t

BEGIN {
	chdir 't' if -d 't';
	@INC = '../lib';
	require Config; import Config;
	unless ($Config{'useperlio'}) {
	    print "1..0 # Skip: PerlIO not used\n";
	    exit 0;
	}
}

use Test::More tests => 35;

use_ok('PerlIO');

my $txt = "txt$$";
my $bin = "bin$$";
my $utf = "utf$$";

my $txtfh;
my $binfh;
my $utffh;

ok(open($txtfh, ">:crlf", $txt));

ok(open($binfh, ">:raw",  $bin));

ok(open($utffh, ">:utf8", $utf));
print "ok 4\n";

print $txtfh "foo\n";
print $txtfh "bar\n";

ok(close($txtfh));

print $binfh "foo\n";
print $binfh "bar\n";

ok(close($binfh));

print $utffh "foo\x{ff}\n";
print $utffh "bar\x{abcd}\n";

ok(close($utffh));

ok(open($txtfh, "<:crlf", $txt));

ok(open($binfh, "<:raw",  $bin));


ok(open($utffh, "<:utf8", $utf));

is(scalar <$txtfh>, "foo\n");
is(scalar <$txtfh>, "bar\n");

is(scalar <$binfh>, "foo\n");
is(scalar <$binfh>, "bar\n");

is(scalar <$utffh>,  "foo\x{ff}\n");
is(scalar <$utffh>, "bar\x{abcd}\n");

ok(eof($txtfh));;

ok(eof($binfh));

ok(eof($utffh));

ok(close($txtfh));

ok(close($binfh));

ok(close($utffh));

# magic temporary file via 3 arg open with undef
{
    ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');
    ok( defined fileno($x),     '       fileno' );

    select $x;
    ok( (print "ok\n"),         '       print' );

    select STDOUT;
    ok( seek($x,0,0),           '       seek' );
    is( scalar <$x>, "ok\n",    '       readline' );
    ok( tell($x) >= 3,          '       tell' );

    # test magic temp file over STDOUT
    open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
    my $status = open(STDOUT,"+<",undef);
    open STDOUT,  ">&OLDOUT" or die "cannot dup OLDOUT: $!";
    # report after STDOUT is restored
    ok($status, '       re-open STDOUT');
    close OLDOUT;
}

# in-memory open
{
    my $var;
    ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');
    ok( defined fileno($x),     '       fileno' );

    select $x;
    ok( (print "ok\n"),         '       print' );

    select STDOUT;
    ok( seek($x,0,0),           '       seek' );
    is( scalar <$x>, "ok\n",    '       readline' );
    ok( tell($x) >= 3,          '       tell' );
}

END {
    1 while unlink $txt;
    1 while unlink $bin;
    1 while unlink $utf;
}