From 40b4fae97cd0fe9fb82757cfba16b247deedd208 Mon Sep 17 00:00:00 2001 From: Yves Orton Date: Fri, 31 Mar 2023 13:22:15 +0200 Subject: [PATCH] test infra - Under -DNO_TAINT_SUPPORT skip tests that use -T or -t This patch uses a collection of heuristics to skip test files which would die on a perl compiled with -DNO_TAINT_SUPPORT but without -DSILENT_NO_TAINT_SUPPORT. -DNO_TAINT_SUPPORT disables taint support in a "safe" way, such that if you try to use taint mode with the -t or -T options an exception will be thrown informing you that the perl you are using does not support taint. (The related setting -DSILENT_NO_TAINT_SUPPORT disables taint support but causes the -t and -T options to be silently ignored.) The error from using -t and -T is thrown very early in the process startup and there is no way to "gracefully" handle it and convert it into something else, for instance to skip a test file which contains it. This patch generally fixes our code to skip these tests. * Make t/TEST and t/harness check shebang lines and use filename checks to filter out tests that use -t or -T. Primarily this is the result of checking their shebang line, but some cpan/ files are excluded by name, either from a very short list of exclusions, or because their file name contains the word "taint". Non-cpan test files were fixed individually as noted below. * test.pl - make run_multiple_progs() skip test cases based on the switches that are part of the test definition. This function is used in a great deal of our internal tests, so it fixes a lot of tests in one go. * XS-APITest/t/call.t, t/run/switchDX.t, lib/B/Deparse.t - Skip a small set of tests in each file. --- ext/XS-APItest/t/call.t | 9 ++++++--- lib/B/Deparse.t | 29 +++++++++++++++++++---------- t/TEST | 32 ++++++++++++++++++++++++++++++++ t/harness | 2 ++ t/run/switchDx.t | 7 ++++++- t/test.pl | 11 +++++++++++ 6 files changed, 76 insertions(+), 14 deletions(-) diff --git a/ext/XS-APItest/t/call.t b/ext/XS-APItest/t/call.t index 390ed8de9387..1116f286fb2e 100644 --- a/ext/XS-APItest/t/call.t +++ b/ext/XS-APItest/t/call.t @@ -14,7 +14,7 @@ BEGIN { plan(538); use_ok('XS::APItest') }; - +use Config; ######################### # f(): general test sub to be called by call_sv() etc. @@ -343,8 +343,11 @@ for my $fn_type (qw(eval_pv eval_sv call_sv)) { # DAPM 9-Aug-04. A taint test in eval_sv() could die after setting up # a new jump level but before pushing an eval context, leading to # stack corruption +SKIP: { + skip("Your perl was built without taint support", 1) + unless $Config{taint_support}; -fresh_perl_is(<<'EOF', "x=2", { switches => ['-T', '-I../../lib'] }, 'eval_sv() taint'); + fresh_perl_is(<<'EOF', "x=2", { switches => ['-T', '-I../../lib'] }, 'eval_sv() taint'); use XS::APItest; my $x = 0; @@ -357,4 +360,4 @@ sub f { eval { my @a = sort f 2, 1; $x++}; print "x=$x\n"; EOF - +} diff --git a/lib/B/Deparse.t b/lib/B/Deparse.t index ae1372f63050..292c04064052 100644 --- a/lib/B/Deparse.t +++ b/lib/B/Deparse.t @@ -307,14 +307,19 @@ x(); z() . EOCODH -is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], +SKIP: { + skip("Your perl was built without taint support", 1) + unless $Config::Config{taint_support}; + + is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], prog => "format =\n\@\n\$;\n.\n"), - <<'EOCODM', '$; on format line'; -format STDOUT = -@ -$; -. -EOCODM + <<~'EOCODM', '$; on format line'; + format STDOUT = + @ + $; + . + EOCODM +} is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse,-l', $path ], prog => "format =\n\@\n\$foo\n.\n"), @@ -537,10 +542,14 @@ is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path ], "sub BEGIN {\n \$main::{'f'} = \\!0;\n}\n", '&PL_sv_yes constant (used to croak)'; -is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], +SKIP: { + skip("Your perl was built without taint support", 1) + unless $Config::Config{taint_support}; + is runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-T' ], prog => '$x =~ (1?/$a/:0)'), - '$x =~ ($_ =~ /$a/);'."\n", - '$foo =~ under taint mode'; + '$x =~ ($_ =~ /$a/);'."\n", + '$foo =~ under taint mode'; +} unlike runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-w' ], prog => 'BEGIN { undef &foo }'), diff --git a/t/TEST b/t/TEST index 01ba89d94f8d..a5f56404b3d8 100755 --- a/t/TEST +++ b/t/TEST @@ -522,6 +522,36 @@ sub dump_tests { exit(0); } +sub filter_taint_tests { + my $tests = shift; + require Config; + return unless $Config::Config{taint_disabled} eq "define"; + + # These are test files which are known to fail with -DNO_TAINT_SUPPORT + # but which do not have "taint" in their name, nor have shebang lines + # with -t or -T in them. So we exclude them specifically instead. + my %known_tainter = map { $_ => 0 } ( + '../cpan/Test-Harness/t/regression.t', + '../cpan/Test-Harness/t/source_handler.t', + '../cpan/Test-Harness/t/compat/inc-propagation.t', + ); + @$tests = grep { + my $file = $_; + open my $ifh, "<", $file + or die "Failed to read: '$file': $!"; + my $line = <$ifh>; + my $keep = $file=~/taint/ ? 0 : ($known_tainter{$file} // 1); + if ($line=~/^#!.*perl\s+-(\w+)/) { + my $switch = $1; + if ($switch =~ s/[Tt]//) { + $keep = 0; + } + } + $keep + } @$tests; +} + + unless (@ARGV) { # base first, as TEST bails out if that can't run # then comp, to validate that require works @@ -608,6 +638,8 @@ unless (@ARGV) { dump_tests(\@ARGV) if $dump_tests; +filter_taint_tests(\@ARGV); + if ($::deparse) { _testprogs('deparse', '', @ARGV); } diff --git a/t/harness b/t/harness index 50801fa0bf80..a79d5c0d450c 100644 --- a/t/harness +++ b/t/harness @@ -433,6 +433,8 @@ for (@tests) { dump_tests(\@tests) if $dump_tests; +filter_taint_tests(\@tests); + my %options; my $type = 'perl'; diff --git a/t/run/switchDx.t b/t/run/switchDx.t index 9d936735adf8..e59e5560340d 100644 --- a/t/run/switchDx.t +++ b/t/run/switchDx.t @@ -48,9 +48,14 @@ END { fresh_perl_like("print qq(hello)", qr/define raw/, { stderr => 1, switches => [ '-Di' ] }, "-Di defaults to stderr"); - fresh_perl_like("print qq(hello)", qr/define raw/, + SKIP: { + skip("Your perl was built without taint support", 1) + unless $Config{taint_support}; + + fresh_perl_like("print qq(hello)", qr/define raw/, { stderr => 1, switches => [ '-TDi' ] }, "Perlio debug output to STDERR with -TDi (no PERLIO_DEBUG)"); + } } { # -DXv tests diff --git a/t/test.pl b/t/test.pl index 7df78c7b6286..b46785571402 100644 --- a/t/test.pl +++ b/t/test.pl @@ -1327,6 +1327,13 @@ sub run_multiple_progs { my $dummy; ($dummy, @prgs) = _setup_one_file(shift); } + my $taint_disabled; + if (! eval {require Config; 1}) { + warn "test.pl had problems loading Config: $@"; + $taint_disabled = ''; + } else { + $taint_disabled = $Config::Config{taint_disabled}; + } my $tmpfile = tempfile(); @@ -1379,6 +1386,10 @@ sub run_multiple_progs { $name = "test from $file at line $line"; } + if ($switch=~/[Tt]/ and $taint_disabled eq "define") { + $reason{skip} ||= "This perl does not support taint"; + } + if ($reason{skip}) { SKIP: {