Skip to content

Commit

Permalink
test infra - Under -DNO_TAINT_SUPPORT skip tests that use -T or -t
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
demerphq committed Apr 2, 2023
1 parent 32d5adb commit 40b4fae
Show file tree
Hide file tree
Showing 6 changed files with 76 additions and 14 deletions.
9 changes: 6 additions & 3 deletions ext/XS-APItest/t/call.t
Expand Up @@ -14,7 +14,7 @@ BEGIN {
plan(538);
use_ok('XS::APItest')
};

use Config;
#########################

# f(): general test sub to be called by call_sv() etc.
Expand Down Expand Up @@ -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;
Expand All @@ -357,4 +360,4 @@ sub f {
eval { my @a = sort f 2, 1; $x++};
print "x=$x\n";
EOF

}
29 changes: 19 additions & 10 deletions lib/B/Deparse.t
Expand Up @@ -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"),
Expand Down Expand Up @@ -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 =~ <branch-folded match> under taint mode';
'$x =~ ($_ =~ /$a/);'."\n",
'$foo =~ <branch-folded match> under taint mode';
}

unlike runperl(stderr => 1, switches => [ '-MO=-qq,Deparse', $path, '-w' ],
prog => 'BEGIN { undef &foo }'),
Expand Down
32 changes: 32 additions & 0 deletions t/TEST
Expand Up @@ -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
Expand Down Expand Up @@ -608,6 +638,8 @@ unless (@ARGV) {

dump_tests(\@ARGV) if $dump_tests;

filter_taint_tests(\@ARGV);

if ($::deparse) {
_testprogs('deparse', '', @ARGV);
}
Expand Down
2 changes: 2 additions & 0 deletions t/harness
Expand Up @@ -433,6 +433,8 @@ for (@tests) {

dump_tests(\@tests) if $dump_tests;

filter_taint_tests(\@tests);

my %options;

my $type = 'perl';
Expand Down
7 changes: 6 additions & 1 deletion t/run/switchDx.t
Expand Up @@ -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
Expand Down
11 changes: 11 additions & 0 deletions t/test.pl
Expand Up @@ -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();

Expand Down Expand Up @@ -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:
{
Expand Down

0 comments on commit 40b4fae

Please sign in to comment.