ext/PerlIO/PerlIO.t

   1 BEGIN {
   2         chdir 't' if -d 't';
   3         @INC = '../lib';
   4         require Config; import Config;
   5         unless ($Config{'useperlio'}) {
   6             print "1..0 # Skip: PerlIO not used\n";
   7             exit 0;
   8         }
   9 }
  10
  11 use Test::More tests => 35;
  12
  13 use_ok('PerlIO');
  14
  15 my $txt = "txt$$";
  16 my $bin = "bin$$";
  17 my $utf = "utf$$";
  18
  19 my $txtfh;
  20 my $binfh;
  21 my $utffh;
  22
  23 ok(open($txtfh, ">:crlf", $txt));
  24
  25 ok(open($binfh, ">:raw",  $bin));
  26
  27 ok(open($utffh, ">:utf8", $utf));
  28 print "ok 4\n";
  29
  30 print $txtfh "foo\n";
  31 print $txtfh "bar\n";
  32
  33 ok(close($txtfh));
  34
  35 print $binfh "foo\n";
  36 print $binfh "bar\n";
  37
  38 ok(close($binfh));
  39
  40 print $utffh "foo\x{ff}\n";
  41 print $utffh "bar\x{abcd}\n";
  42
  43 ok(close($utffh));
  44
  45 ok(open($txtfh, "<:crlf", $txt));
  46
  47 ok(open($binfh, "<:raw",  $bin));
  48
  49
  50 ok(open($utffh, "<:utf8", $utf));
  51
  52 is(scalar <$txtfh>, "foo\n");
  53 is(scalar <$txtfh>, "bar\n");
  54
  55 is(scalar <$binfh>, "foo\n");
  56 is(scalar <$binfh>, "bar\n");
  57
  58 is(scalar <$utffh>,  "foo\x{ff}\n");
  59 is(scalar <$utffh>, "bar\x{abcd}\n");
  60
  61 ok(eof($txtfh));;
  62
  63 ok(eof($binfh));
  64
  65 ok(eof($utffh));
  66
  67 ok(close($txtfh));
  68
  69 ok(close($binfh));
  70
  71 ok(close($utffh));
  72
  73 # magic temporary file via 3 arg open with undef
  74 {
  75     ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef');
  76     ok( defined fileno($x),     '       fileno' );
  77
  78     select $x;
  79     ok( (print "ok\n"),         '       print' );
  80
  81     select STDOUT;
  82     ok( seek($x,0,0),           '       seek' );
  83     is( scalar <$x>, "ok\n",    '       readline' );
  84     ok( tell($x) >= 3,          '       tell' );
  85
  86     # test magic temp file over STDOUT
  87     open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
  88     my $status = open(STDOUT,"+<",undef);
  89     open STDOUT,  ">&OLDOUT" or die "cannot dup OLDOUT: $!";
  90     # report after STDOUT is restored
  91     ok($status, '       re-open STDOUT');
  92     close OLDOUT;
  93 }
  94
  95 # in-memory open
  96 {
  97     my $var;
  98     ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');
  99     ok( defined fileno($x),     '       fileno' );
 100
 101     select $x;
 102     ok( (print "ok\n"),         '       print' );
 103
 104     select STDOUT;
 105     ok( seek($x,0,0),           '       seek' );
 106     is( scalar <$x>, "ok\n",    '       readline' );
 107     ok( tell($x) >= 3,          '       tell' );
 108 }
 109
 110 END {
 111     1 while unlink $txt;
 112     1 while unlink $bin;
 113     1 while unlink $utf;
 114 }
 115