Move IO from ext/ to dist/
[perl.git] / dist / IO / t / io_taint.t
1 #!./perl -T
2
3 use Config;
4
5 BEGIN {
6     if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bIO\b/ && $^O ne 'VMS') {
7         print "1..0\n";
8         exit 0;
9     }
10 }
11
12 use strict;
13 if ($ENV{PERL_CORE}) {
14   require("../../t/test.pl");
15 }
16 else {
17   require("./t/test.pl");
18 }
19 plan(tests => 5);
20
21 END { unlink "./__taint__$$" }
22
23 use IO::File;
24 my $x = new IO::File "> ./__taint__$$" || die("Cannot open ./__taint__$$\n");
25 print $x "$$\n";
26 $x->close;
27
28 $x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
29 chop(my $unsafe = <$x>);
30 eval { kill 0 * $unsafe };
31 SKIP: {
32   skip($^O) if $^O eq 'MSWin32' or $^O eq 'NetWare';
33   like($@, '^Insecure');
34 }
35 $x->close;
36
37 # We could have just done a seek on $x, but technically we haven't tested
38 # seek yet...
39 $x = new IO::File "< ./__taint__$$" || die("Cannot open ./__taint__$$\n");
40 $x->untaint;
41 ok(!$?); # Calling the method worked
42 chop($unsafe = <$x>);
43 eval { kill 0 * $unsafe };
44 unlike($@,'^Insecure');
45 $x->close;
46
47 TODO: {
48   todo_skip("Known bug in 5.10.0",2) if $] >= 5.010 and $] < 5.010_001;
49
50   # this will segfault if it fails
51
52   sub PVBM () { 'foo' }
53   { my $dummy = index 'foo', PVBM }
54
55   eval { IO::Handle::untaint(PVBM) };
56   pass();
57
58   eval { IO::Handle::untaint(\PVBM) };
59   pass();
60 }
61
62 exit 0;