From b6b095db19c7249e5c8f6af658508ba229202ac0 Mon Sep 17 00:00:00 2001 From: Todd Rinaldo Date: Thu, 31 Mar 2016 17:04:29 -0500 Subject: Patch unit tests to explicitly insert "." into @INC when needed. Backported to perl 5.22 by Dominic Hargreaves and forward to 5.24 by Niko Tyni Bug: https://rt.perl.org/Public/Bug/Display.html?id=127810 Patch-Name: debian/CVE-2016-1238/test-suite-without-dot.diff --- Makefile.SH | 2 +- Porting/pod_rules.pl | 2 +- TestInit.pm | 2 +- lib/strict.t | 2 +- lib/warnings.t | 2 +- makedef.pl | 2 +- regen.pl | 2 +- regen/ebcdic.pl | 3 +++ regen/genpacksizetables.pl | 2 +- regen/mg_vtable.pl | 2 +- t/comp/line_debug.t | 2 ++ t/lib/warnings/op | 1 + t/op/goto.t | 2 +- t/porting/regen.t | 2 +- t/re/pat.t | 4 ++-- t/run/switches.t | 6 +++--- t/test.pl | 3 ++- 17 files changed, 24 insertions(+), 17 deletions(-) diff --git a/Makefile.SH b/Makefile.SH index 5f19529..f56827f 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -345,7 +345,7 @@ RUN_PERL = \$(LDLIBPTH) \$(RUN) $perl\$(EXE_EXT) $spitshell >>$Makefile < 'plan9/mkfile', ); -require 'Porting/pod_lib.pl'; +require './Porting/pod_lib.pl'; sub my_die; # process command-line switches diff --git a/TestInit.pm b/TestInit.pm index f4ed6fd..f9a5e91 100644 --- a/TestInit.pm +++ b/TestInit.pm @@ -47,7 +47,7 @@ sub import { } elsif ($_ eq 'T') { $chdir = '..' unless -f 't/TEST' && -f 'MANIFEST' && -d 'lib' && -d 'ext'; - @INC = 'lib'; + @INC = qw/ lib . /; $setopt = 1; } else { die "Unknown option '$_'"; diff --git a/lib/strict.t b/lib/strict.t index d6c6ed0..bfee762 100644 --- a/lib/strict.t +++ b/lib/strict.t @@ -1,7 +1,7 @@ #!./perl chdir 't' if -d 't'; -@INC = '../lib'; +@INC = ( '.', '../lib' ); our $local_tests = 6; require "../t/lib/common.pl"; diff --git a/lib/warnings.t b/lib/warnings.t index ee696fe..7c24f3a 100644 --- a/lib/warnings.t +++ b/lib/warnings.t @@ -1,7 +1,7 @@ #!./perl chdir 't' if -d 't'; -@INC = '../lib'; +@INC = ( '.', '../lib' ); our $UTF8 = (${^OPEN} || "") =~ /:utf8/; require "../t/lib/common.pl"; diff --git a/makedef.pl b/makedef.pl index 104696c..c0a220a 100644 --- a/makedef.pl +++ b/makedef.pl @@ -70,7 +70,7 @@ BEGIN { } use constant PLATFORM => $ARGS{PLATFORM}; -require "$ARGS{TARG_DIR}regen/embed_lib.pl"; +require "./$ARGS{TARG_DIR}regen/embed_lib.pl"; # Is the following guard strictly necessary? Added during refactoring # to keep the same behaviour when merging other code into here. diff --git a/regen.pl b/regen.pl index 8788668..71a6eda 100644 --- a/regen.pl +++ b/regen.pl @@ -15,7 +15,7 @@ use strict; my $tap = $ARGV[0] && $ARGV[0] eq '--tap' ? '# ' : ''; foreach my $pl (map {chomp; "regen/$_"} ) { - my @command = ($^X, $pl, @ARGV); + my @command = ($^X, '-I.', $pl, @ARGV); print "$tap@command\n"; system @command and die "@command failed: $?" diff --git a/regen/ebcdic.pl b/regen/ebcdic.pl index fa8a051..718a7c8 100644 --- a/regen/ebcdic.pl +++ b/regen/ebcdic.pl @@ -1,6 +1,9 @@ use v5.16.0; use strict; use warnings; + +BEGIN { unshift @INC, '.' } + require 'regen/regen_lib.pl'; require 'regen/charset_translations.pl'; diff --git a/regen/genpacksizetables.pl b/regen/genpacksizetables.pl index 7a03dcd..d886822 100644 --- a/regen/genpacksizetables.pl +++ b/regen/genpacksizetables.pl @@ -3,7 +3,7 @@ # it will generate EBCDIC too. (TODO) use strict; use Encode; -require 'regen/regen_lib.pl'; +require './regen/regen_lib.pl'; sub make_text { my ($chrmap, $letter, $unpredictable, $nocsum, $size, $condition) = @_; diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl index a05a7d4..342f5e0 100644 --- a/regen/mg_vtable.pl +++ b/regen/mg_vtable.pl @@ -20,7 +20,7 @@ require 5.004; BEGIN { # Get function prototypes - require 'regen/regen_lib.pl'; + require './regen/regen_lib.pl'; } my %mg = diff --git a/t/comp/line_debug.t b/t/comp/line_debug.t index 8361194..71626bb 100644 --- a/t/comp/line_debug.t +++ b/t/comp/line_debug.t @@ -1,5 +1,7 @@ #!./perl +BEGIN { unshift @INC, '.' } + chdir 't' if -d 't'; sub ok { diff --git a/t/lib/warnings/op b/t/lib/warnings/op index 528639e..df9dadb 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -1435,6 +1435,7 @@ END { print "in end\n"; } print "in mainline\n"; 1; --FILE-- +BEGIN { unshift @INC, '.' } require abc; do "abc.pm"; EXPECT diff --git a/t/op/goto.t b/t/op/goto.t index aa2f24f..a65ede2 100644 --- a/t/op/goto.t +++ b/t/op/goto.t @@ -280,7 +280,7 @@ YYY: print "OK\n"; EOT close $f; -$r = runperl(prog => 'use Op_goto01; print qq[DONE\n]'); +$r = runperl(prog => 'BEGIN { unshift @INC, q[.] } use Op_goto01; print qq[DONE\n]'); is($r, "OK\nDONE\n", "goto within use-d file"); unlink_all "Op_goto01.pm"; diff --git a/t/porting/regen.t b/t/porting/regen.t index 5d08518..d234260 100644 --- a/t/porting/regen.t +++ b/t/porting/regen.t @@ -86,7 +86,7 @@ OUTER: foreach my $file (@files) { } foreach (@progs) { - my $command = "$^X $_ --tap"; + my $command = "$^X -I. $_ --tap"; system $command and die "Failed to run $command: $?"; } diff --git a/t/re/pat.t b/t/re/pat.t index 295a9f7..8652bf6 100644 --- a/t/re/pat.t +++ b/t/re/pat.t @@ -1663,7 +1663,7 @@ EOP # NOTE - Do not put quotes in the code! # NOTE - We have to triple escape the backref in the pattern below. my $code=' - BEGIN{require q(test.pl);} + BEGIN{require q(./test.pl);} watchdog(3); for my $len (1 .. 20) { my $eights= q(8) x $len; @@ -1679,7 +1679,7 @@ EOP # #123562] my $code=' - BEGIN{require q(test.pl);} + BEGIN{require q(./test.pl);} use Encode qw(_utf8_on); # \x80 and \x41 are continuation bytes in their respective # character sets diff --git a/t/run/switches.t b/t/run/switches.t index aa9bda3..2272c94 100644 --- a/t/run/switches.t +++ b/t/run/switches.t @@ -194,17 +194,17 @@ sub import { print map "<\$_>", \@_ } SWTESTPM close $f or die "Could not close: $!"; $r = runperl( - switches => [ "-M$package" ], + switches => [ "-I.", "-M$package" ], prog => '1', ); is( $r, "<$package>", '-M' ); $r = runperl( - switches => [ "-M$package=foo" ], + switches => [ "-I.", "-M$package=foo" ], prog => '1', ); is( $r, "<$package>", '-M with import parameter' ); $r = runperl( - switches => [ "-m$package" ], + switches => [ "-I.", "-m$package" ], prog => '1', ); diff --git a/t/test.pl b/t/test.pl index acff745..4195c9a 100644 --- a/t/test.pl +++ b/t/test.pl @@ -646,7 +646,7 @@ sub _create_runperl { # Create the string to qx in runperl(). $runperl = "$ENV{PERL_RUNPERL_DEBUG} $runperl"; } unless ($args{nolib}) { - $runperl = $runperl . ' "-I../lib"'; # doublequotes because of VMS + $runperl = $runperl . ' "-I../lib" "-I." '; # doublequotes because of VMS } if ($args{switches}) { local $Level = 2; @@ -1235,6 +1235,7 @@ sub run_multiple_progs { open my $fh, '>', $tmpfile or die "Cannot open >$tmpfile: $!"; print $fh q{ BEGIN { + push @INC, '.'; open STDERR, '>&', STDOUT or die "Can't dup STDOUT->STDERR: $!;"; }