| 1 | BEGIN { |
| 2 | chdir 't' if -d 't'; |
| 3 | @INC = '../lib'; |
| 4 | require Config; import Config; |
| 5 | unless (find PerlIO::Layer 'perlio') { |
| 6 | print "1..0 # Skip: PerlIO not used\n"; |
| 7 | exit 0; |
| 8 | } |
| 9 | } |
| 10 | |
| 11 | use Test::More tests => 37; |
| 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 | |
| 29 | print $txtfh "foo\n"; |
| 30 | print $txtfh "bar\n"; |
| 31 | |
| 32 | ok(close($txtfh)); |
| 33 | |
| 34 | print $binfh "foo\n"; |
| 35 | print $binfh "bar\n"; |
| 36 | |
| 37 | ok(close($binfh)); |
| 38 | |
| 39 | print $utffh "foo\x{ff}\n"; |
| 40 | print $utffh "bar\x{abcd}\n"; |
| 41 | |
| 42 | ok(close($utffh)); |
| 43 | |
| 44 | ok(open($txtfh, "<:crlf", $txt)); |
| 45 | |
| 46 | ok(open($binfh, "<:raw", $bin)); |
| 47 | |
| 48 | |
| 49 | ok(open($utffh, "<:utf8", $utf)); |
| 50 | |
| 51 | is(scalar <$txtfh>, "foo\n"); |
| 52 | is(scalar <$txtfh>, "bar\n"); |
| 53 | |
| 54 | is(scalar <$binfh>, "foo\n"); |
| 55 | is(scalar <$binfh>, "bar\n"); |
| 56 | |
| 57 | is(scalar <$utffh>, "foo\x{ff}\n"); |
| 58 | is(scalar <$utffh>, "bar\x{abcd}\n"); |
| 59 | |
| 60 | ok(eof($txtfh));; |
| 61 | |
| 62 | ok(eof($binfh)); |
| 63 | |
| 64 | ok(eof($utffh)); |
| 65 | |
| 66 | ok(close($txtfh)); |
| 67 | |
| 68 | ok(close($binfh)); |
| 69 | |
| 70 | ok(close($utffh)); |
| 71 | |
| 72 | # magic temporary file via 3 arg open with undef |
| 73 | { |
| 74 | ok( open(my $x,"+<",undef), 'magic temp file via 3 arg open with undef'); |
| 75 | ok( defined fileno($x), ' fileno' ); |
| 76 | |
| 77 | select $x; |
| 78 | ok( (print "ok\n"), ' print' ); |
| 79 | |
| 80 | select STDOUT; |
| 81 | ok( seek($x,0,0), ' seek' ); |
| 82 | is( scalar <$x>, "ok\n", ' readline' ); |
| 83 | ok( tell($x) >= 3, ' tell' ); |
| 84 | |
| 85 | # test magic temp file over STDOUT |
| 86 | open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!"; |
| 87 | my $status = open(STDOUT,"+<",undef); |
| 88 | open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!"; |
| 89 | # report after STDOUT is restored |
| 90 | ok($status, ' re-open STDOUT'); |
| 91 | close OLDOUT; |
| 92 | } |
| 93 | |
| 94 | # in-memory open |
| 95 | SKIP: { |
| 96 | eval { require PerlIO::scalar }; |
| 97 | unless (find PerlIO::Layer 'scalar') { |
| 98 | skip("PerlIO::scalar not found", 8); |
| 99 | } |
| 100 | my $var; |
| 101 | ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var'); |
| 102 | ok( defined fileno($x), ' fileno' ); |
| 103 | |
| 104 | select $x; |
| 105 | ok( (print "ok\n"), ' print' ); |
| 106 | |
| 107 | select STDOUT; |
| 108 | ok( seek($x,0,0), ' seek' ); |
| 109 | is( scalar <$x>, "ok\n", ' readline' ); |
| 110 | ok( tell($x) >= 3, ' tell' ); |
| 111 | |
| 112 | TODO: { |
| 113 | local $TODO = "broken"; |
| 114 | |
| 115 | # test in-memory open over STDOUT |
| 116 | open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!"; |
| 117 | #close STDOUT; |
| 118 | my $status = open(STDOUT,">",\$var); |
| 119 | my $error = "$!" unless $status; # remember the error |
| 120 | close STDOUT unless $status; |
| 121 | open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!"; |
| 122 | print "# $error\n" unless $status; |
| 123 | # report after STDOUT is restored |
| 124 | ok($status, ' open STDOUT into in-memory var'); |
| 125 | |
| 126 | # test in-memory open over STDERR |
| 127 | open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!"; |
| 128 | #close STDERR; |
| 129 | ok( open(STDERR,">",\$var), ' open STDERR into in-memory var'); |
| 130 | open STDERR, ">&OLDERR" or die "cannot dup OLDERR: $!"; |
| 131 | } |
| 132 | } |
| 133 | |
| 134 | |
| 135 | END { |
| 136 | 1 while unlink $txt; |
| 137 | 1 while unlink $bin; |
| 138 | 1 while unlink $utf; |
| 139 | } |
| 140 | |