t/run/switcht.t

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