This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Do not honor TMPDIR for anonymous temporary files when tainting
[perl5.git] / t / io / perlio.t
CommitLineData
ec28694c
JH
1BEGIN {
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
26e8050a 11use Test::More tests => 39;
ec28694c 12
51f12e47 13use_ok('PerlIO');
ec28694c
JH
14
15my $txt = "txt$$";
16my $bin = "bin$$";
17my $utf = "utf$$";
26e8050a 18my $nonexistent = "nex$$";
ec28694c
JH
19
20my $txtfh;
21my $binfh;
22my $utffh;
23
51f12e47 24ok(open($txtfh, ">:crlf", $txt));
ec28694c 25
51f12e47 26ok(open($binfh, ">:raw", $bin));
ec28694c 27
51f12e47 28ok(open($utffh, ">:utf8", $utf));
ec28694c
JH
29
30print $txtfh "foo\n";
31print $txtfh "bar\n";
51f12e47
JH
32
33ok(close($txtfh));
ec28694c
JH
34
35print $binfh "foo\n";
36print $binfh "bar\n";
51f12e47
JH
37
38ok(close($binfh));
ec28694c
JH
39
40print $utffh "foo\x{ff}\n";
41print $utffh "bar\x{abcd}\n";
ec28694c 42
51f12e47
JH
43ok(close($utffh));
44
45ok(open($txtfh, "<:crlf", $txt));
46
47ok(open($binfh, "<:raw", $bin));
48
49
50ok(open($utffh, "<:utf8", $utf));
ec28694c 51
51f12e47
JH
52is(scalar <$txtfh>, "foo\n");
53is(scalar <$txtfh>, "bar\n");
ec28694c 54
51f12e47
JH
55is(scalar <$binfh>, "foo\n");
56is(scalar <$binfh>, "bar\n");
ec28694c 57
51f12e47
JH
58is(scalar <$utffh>, "foo\x{ff}\n");
59is(scalar <$utffh>, "bar\x{abcd}\n");
ec28694c 60
51f12e47 61ok(eof($txtfh));;
ec28694c 62
51f12e47 63ok(eof($binfh));
ec28694c 64
51f12e47 65ok(eof($utffh));
ec28694c 66
51f12e47 67ok(close($txtfh));
ec28694c 68
51f12e47 69ok(close($binfh));
ec28694c 70
51f12e47 71ok(close($utffh));
ec28694c 72
51f12e47
JH
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;
26e8050a
NT
93
94 SKIP: {
95 skip("TMPDIR not honored on this platform", 2)
96 if !$Config{d_mkstemp}
97 || $^O eq 'VMS' || $^O eq 'MSwin32' || $^O eq 'os2';
98 local $ENV{TMPDIR} = $nonexistent;
0b99e986 99 ok( open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to a non-existent dir');
26e8050a
NT
100
101 mkdir $ENV{TMPDIR};
102 ok(open(my $x,"+<",undef), 'TMPDIR honored by magic temp file via 3 arg open with undef - works if TMPDIR points to an existent dir');
103 }
51f12e47
JH
104}
105
106# in-memory open
0cb48d00
RGS
107SKIP: {
108 eval { require PerlIO::scalar };
109 unless (find PerlIO::Layer 'scalar') {
110 skip("PerlIO::scalar not found", 8);
111 }
51f12e47
JH
112 my $var;
113 ok( open(my $x,"+<",\$var), 'magic in-memory file via 3 arg open with \\$var');
114 ok( defined fileno($x), ' fileno' );
115
116 select $x;
117 ok( (print "ok\n"), ' print' );
118
119 select STDOUT;
120 ok( seek($x,0,0), ' seek' );
121 is( scalar <$x>, "ok\n", ' readline' );
122 ok( tell($x) >= 3, ' tell' );
123
124 TODO: {
125 local $TODO = "broken";
126
127 # test in-memory open over STDOUT
128 open OLDOUT, ">&STDOUT" or die "cannot dup STDOUT: $!";
129 #close STDOUT;
130 my $status = open(STDOUT,">",\$var);
131 my $error = "$!" unless $status; # remember the error
3351db02 132 close STDOUT unless $status;
51f12e47
JH
133 open STDOUT, ">&OLDOUT" or die "cannot dup OLDOUT: $!";
134 print "# $error\n" unless $status;
135 # report after STDOUT is restored
136 ok($status, ' open STDOUT into in-memory var');
137
138 # test in-memory open over STDERR
139 open OLDERR, ">&STDERR" or die "cannot dup STDERR: $!";
140 #close STDERR;
141 ok( open(STDERR,">",\$var), ' open STDERR into in-memory var');
142 open STDERR, ">&OLDERR" or die "cannot dup OLDERR: $!";
143 }
144}
ec28694c 145
ec28694c
JH
146
147END {
148 1 while unlink $txt;
149 1 while unlink $bin;
150 1 while unlink $utf;
0b99e986 151 rmdir $nonexistent;
ec28694c
JH
152}
153