This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
do/require don't treat '.\foo' or '..\foo' as "absolute paths" on Windows.
[perl5.git] / t / run / switcht.t
1 #!./perl -t
2
3 BEGIN {
4     chdir 't';
5     @INC = '../lib';
6     require './test.pl';
7 }
8
9 plan tests => 13;
10
11 my $Perl = which_perl();
12
13 my $warning;
14 local $SIG{__WARN__} = sub { $warning = join "\n", @_; };
15 my $Tmsg = 'while running with -t switch';
16
17 is( ${^TAINT}, -1, '${^TAINT} == -1' );
18
19 my $out = `$Perl -le "print q(Hello)"`;
20 is( $out, "Hello\n",                      '`` worked' );
21 like( $warning, qr/^Insecure .* $Tmsg/, '    taint warn' );
22
23 {
24     no warnings 'taint';
25     $warning = '';
26     my $out = `$Perl -le "print q(Hello)"`;
27     is( $out, "Hello\n",                      '`` worked' );
28     is( $warning, '',                       '   no warnings "taint"' );
29 }
30
31 # Get ourselves a tainted variable.
32 my $filename = tempfile();
33 $file = $0;
34 $file =~ s/.*/$filename/;
35 ok( open(FILE, ">$file"),   'open >' ) or DIE $!;
36 print FILE "Stuff\n";
37 close FILE;
38 like( $warning, qr/^Insecure dependency in open $Tmsg/, 'open > taint warn' );
39 ok( -e $file,   '   file written' );
40
41 unlink($file);
42 like( $warning, qr/^Insecure dependency in unlink $Tmsg/,
43                                                   'unlink() taint warn' );
44 ok( !-e $file,  'unlink worked' );
45
46 ok( !$^W,   "-t doesn't enable regular warnings" );
47
48
49 mkdir('tt');
50 open(FH,'>','tt/ttest.pl')or DIE $!;
51 print FH 'return 42';
52 close FH or DIE $!;
53
54 SKIP: {
55     ($^O eq 'MSWin32') || skip('skip tainted do test with \ seperator');
56     my $test = 0;
57     $test =  do '.\tt/ttest.pl';
58     is($test, 42, 'Could "do" .\tt/ttest.pl');
59 }
60 {
61     my $test = 0;
62     $test =  do './tt/ttest.pl';
63     is($test, 42, 'Could "do" ./tt/ttest.pl');
64 }
65 unlink ('./tt/ttest.pl');
66 rmdir ('tt');