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.

6 files changed, 76 insertions, 14 deletions

diff --git a/ext/XS-APItest/t/call.t b/ext/XS-APItest/t/call.t
index 390ed8de93..1116f286fb 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 8cd3fb4d27..eb6bcc3828 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 =~ <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 }'),
diff --git a/t/TEST b/t/TEST
index 01ba89d94f..a5f56404b3 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 50801fa0bf..a79d5c0d45 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 9d936735ad..e59e556034 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 7df78c7b62..b467855714 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:
 	  {