Commit | Line | Data |
---|---|---|
ec28694c JH |
1 | BEGIN { |
2 | chdir 't' if -d 't'; | |
3 | @INC = '../lib'; | |
4 | require Config; import Config; | |
6b5da1a3 | 5 | unless (find PerlIO::Layer 'perlio') { |
dc87d25e | 6 | print "1..0 # Skip: PerlIO not used\n"; |
ec28694c JH |
7 | exit 0; |
8 | } | |
9 | } | |
10 | ||
51f12e47 | 11 | use Test::More tests => 37; |
ec28694c | 12 | |
51f12e47 | 13 | use_ok('PerlIO'); |
ec28694c JH |
14 | |
15 | my $txt = "txt$$"; | |
16 | my $bin = "bin$$"; | |
17 | my $utf = "utf$$"; | |
18 | ||
19 | my $txtfh; | |
20 | my $binfh; | |
21 | my $utffh; | |
22 | ||
51f12e47 | 23 | ok(open($txtfh, ">:crlf", $txt)); |
ec28694c | 24 | |
51f12e47 | 25 | ok(open($binfh, ">:raw", $bin)); |
ec28694c | 26 | |
51f12e47 | 27 | ok(open($utffh, ">:utf8", $utf)); |
ec28694c JH |
28 | |
29 | print $txtfh "foo\n"; | |
30 | print $txtfh "bar\n"; | |
51f12e47 JH |
31 | |
32 | ok(close($txtfh)); | |
ec28694c JH |
33 | |
34 | print $binfh "foo\n"; | |
35 | print $binfh "bar\n"; | |
51f12e47 JH |
36 | |
37 | ok(close($binfh)); | |
ec28694c JH |
38 | |
39 | print $utffh "foo\x{ff}\n"; | |
40 | print $utffh "bar\x{abcd}\n"; | |
ec28694c | 41 | |
51f12e47 JH |
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)); | |
ec28694c | 50 | |
51f12e47 JH |
51 | is(scalar <$txtfh>, "foo\n"); |
52 | is(scalar <$txtfh>, "bar\n"); | |
ec28694c | 53 | |
51f12e47 JH |
54 | is(scalar <$binfh>, "foo\n"); |
55 | is(scalar <$binfh>, "bar\n"); | |
ec28694c | 56 | |
51f12e47 JH |
57 | is(scalar <$utffh>, "foo\x{ff}\n"); |
58 | is(scalar <$utffh>, "bar\x{abcd}\n"); | |
ec28694c | 59 | |
51f12e47 | 60 | ok(eof($txtfh));; |
ec28694c | 61 | |
51f12e47 | 62 | ok(eof($binfh)); |
ec28694c | 63 | |
51f12e47 | 64 | ok(eof($utffh)); |
ec28694c | 65 | |
51f12e47 | 66 | ok(close($txtfh)); |
ec28694c | 67 | |
51f12e47 | 68 | ok(close($binfh)); |
ec28694c | 69 | |
51f12e47 | 70 | ok(close($utffh)); |
ec28694c | 71 | |
51f12e47 JH |
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 | { | |
96 | my $var; | |
97 | ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var'); | |
98 | ok( defined fileno($x), ' fileno' ); | |
99 | ||
100 | select $x; | |
101 | ok( (print "ok\n"), ' print' ); | |
102 | ||
103 | select STDOUT; | |
104 | ok( seek($x,0,0), ' seek' ); | |
105 | is( scalar <$x>, "ok\n", ' readline' ); | |
106 | ok( tell($x) >= 3, ' tell' ); | |
107 | ||
108 | TODO: { | |
109 | local $TODO = "broken"; | |
110 | ||
111 | # test in-memory open over STDOUT | |
112 | open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!"; | |
113 | #close STDOUT; | |
114 | my $status = open(STDOUT,">",\$var); | |
115 | my $error = "$!" unless $status; # remember the error | |
3351db02 | 116 | close STDOUT unless $status; |
51f12e47 JH |
117 | open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!"; |
118 | print "# $error\n" unless $status; | |
119 | # report after STDOUT is restored | |
120 | ok($status, ' open STDOUT into in-memory var'); | |
121 | ||
122 | # test in-memory open over STDERR | |
123 | open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!"; | |
124 | #close STDERR; | |
125 | ok( open(STDERR,">",\$var), ' open STDERR into in-memory var'); | |
126 | open STDERR, ">&OLDERR" or die "cannot dup OLDERR: $!"; | |
127 | } | |
128 | } | |
ec28694c | 129 | |
ec28694c JH |
130 | |
131 | END { | |
132 | 1 while unlink $txt; | |
133 | 1 while unlink $bin; | |
134 | 1 while unlink $utf; | |
135 | } | |
136 |