1#!./perl -t
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = '../lib';
6    require './test.pl';
7}
8
9use Config;
10
11if (exists($Config{taint_support}) && !$Config{taint_support}) {
12    skip_all("perl built without taint support");
13}
14
15plan tests => 13;
16
17my $Perl = which_perl();
18
19my $warning;
20local $SIG{__WARN__} = sub { $warning = join "\n", @_; };
21my $Tmsg = 'while running with -t switch';
22
23is( ${^TAINT}, -1, '${^TAINT} == -1' );
24
25my $out = `$Perl -le "print q(Hello)"`;
26is( $out, "Hello\n",                      '`` worked' );
27like( $warning, qr/^Insecure .* $Tmsg/, '    taint warn' );
28
29{
30    no warnings 'taint';
31    $warning = '';
32    my $out = `$Perl -le "print q(Hello)"`;
33    is( $out, "Hello\n",                      '`` worked' );
34    is( $warning, '',                       '   no warnings "taint"' );
35}
36
37# Get ourselves a tainted variable.
38my $filename = tempfile();
39$file = $0;
40$file =~ s/.*/$filename/;
41ok( open(FILE, ">$file"),   'open >' ) or DIE $!;
42print FILE "Stuff\n";
43close FILE;
44like( $warning, qr/^Insecure dependency in open $Tmsg/, 'open > taint warn' );
45ok( -e $file,   '   file written' );
46
47unlink($file);
48like( $warning, qr/^Insecure dependency in unlink $Tmsg/,
49                                                  'unlink() taint warn' );
50ok( !-e $file,  'unlink worked' );
51
52ok( !$^W,   "-t doesn't enable regular warnings" );
53
54
55mkdir('ttdir');
56open(FH,'>','ttdir/ttest.pl')or DIE $!;
57print FH 'return 42';
58close FH or DIE $!;
59
60SKIP: {
61    ($^O eq 'MSWin32') || skip('skip tainted do test with \ separator');
62    my $test = 0;
63    $test =  do '.\ttdir/ttest.pl';
64    is($test, 42, 'Could "do" .\ttdir/ttest.pl');
65}
66{
67    my $test = 0;
68    $test =  do './ttdir/ttest.pl';
69    is($test, 42, 'Could "do" ./ttdir/ttest.pl');
70}
71unlink ('./ttdir/ttest.pl');
72rmdir ('ttdir');
73