This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix PathTools taint handling for Perl 5.6
[perl5.git] / dist / PathTools / t / taint.t
1 #!./perl -Tw
2 # Testing Cwd under taint mode.
3
4 use strict;
5
6 use Cwd;
7 chdir 't' unless $ENV{PERL_CORE};
8
9 use File::Spec;
10 use lib File::Spec->catdir('t', 'lib');
11 use Test::More;
12 BEGIN {
13     plan(
14         !eval { eval("1".substr($^X,0,0)) }
15         ? (tests => 21)
16         : (skip_all => "A perl without taint support")
17     );
18 }
19
20 use Scalar::Util qw/tainted/;
21
22 my @Functions = qw(getcwd cwd fastcwd fastgetcwd
23                    abs_path fast_abs_path
24                    realpath fast_realpath
25                   );
26
27 foreach my $func (@Functions) {
28     no strict 'refs';
29     my $cwd;
30     eval { $cwd = &{'Cwd::'.$func} };
31     is( $@, '',         "$func() should not explode under taint mode" );
32     ok( tainted($cwd),  "its return value should be tainted" );
33 }
34
35 # Previous versions of Cwd tainted $^O
36 is !tainted($^O), 1, "\$^O should not be tainted";
37
38 {
39     # [perl #126862] canonpath() loses taint
40     my $tainted = substr($ENV{PATH}, 0, 0);
41     # yes, getcwd()'s result should be tainted, and is tested above
42     # but be sure
43     ok tainted(File::Spec->canonpath($tainted . Cwd::getcwd)),
44         "canonpath() keeps taint on non-empty string";
45     ok tainted(File::Spec->canonpath($tainted)),
46         "canonpath() keeps taint on empty string";
47
48     (Cwd::getcwd() =~ /^(.*)/);
49     my $untainted = $1;
50     ok !tainted($untainted), "make sure our untainted value is untainted";
51     ok !tainted(File::Spec->canonpath($untainted)),
52         "canonpath() doesn't add taint to untainted string";
53 }