Import perl-5.18.2

OK espie@ sthen@ deraadt@

21 files changed, 442 insertions, 60 deletions

diff --git a/gnu/usr.bin/perl/t/run/dtrace.pl b/gnu/usr.bin/perl/t/run/dtrace.pl
new file mode 100644
index 00000000000..d81cc0710eb
--- /dev/null
+++ b/gnu/usr.bin/perl/t/run/dtrace.pl
@@ -0,0 +1 @@
+42
diff --git a/gnu/usr.bin/perl/t/run/dtrace.t b/gnu/usr.bin/perl/t/run/dtrace.t
index 625e4039077..49bda6643ab 100644
--- a/gnu/usr.bin/perl/t/run/dtrace.t
+++ b/gnu/usr.bin/perl/t/run/dtrace.t
@@ -24,7 +24,7 @@ use strict;
 use warnings;
 use IPC::Open2;
 
-plan(tests => 5);
+plan(tests => 9);
 
 dtrace_like(
     '1',
@@ -62,7 +62,7 @@ dtrace_like(
     'phase changes of a simple script',
 );
 
-# this code taken from t/op/magic_phase.t which tests all of the
+# this code taken from t/opbasic/magic_phase.t which tests all of the
 # transitions of ${^GLOBAL_PHASE}. instead of printing (which will
 # interact nondeterministically with the DTrace output), we increment
 # an unused variable for side effects
@@ -117,6 +117,40 @@ PHASES
      'make sure sub-entry and phase-change interact well',
 );
 
+dtrace_like(<< 'PERL_SCRIPT',
+    my $tmp = "foo";
+    $tmp =~ s/f/b/;
+    chop $tmp;
+PERL_SCRIPT
+    << 'D_SCRIPT',
+    op-entry { printf("op-entry <%s>\n", copyinstr(arg0)) }
+D_SCRIPT
+    [
+        qr/op-entry <subst>/,
+        qr/op-entry <schop>/,
+    ],
+    'basic op probe',
+);
+
+dtrace_like(<< 'PERL_SCRIPT',
+    use strict;
+    require HTTP::Tiny;
+    do "run/dtrace.pl";
+PERL_SCRIPT
+    << 'D_SCRIPT',
+    loading-file { printf("loading-file <%s>\n", copyinstr(arg0)) }
+    loaded-file  { printf("loaded-file <%s>\n", copyinstr(arg0)) }
+D_SCRIPT
+    [
+        # the original test made sure that each file generated a loading-file then a loaded-file,
+        # but that had a race condition when the kernel would push the perl process onto a different
+        # CPU, so the DTrace output would appear out of order
+        qr{loading-file <strict\.pm>.*loading-file <HTTP/Tiny\.pm>.*loading-file <run/dtrace\.pl>}s,
+        qr{loaded-file <strict\.pm>.*loaded-file <HTTP/Tiny\.pm>.*loaded-file <run/dtrace\.pl>}s,
+    ],
+    'loading-file, loaded-file probes',
+);
+
 sub dtrace_like {
     my $perl     = shift;
     my $probes   = shift;
@@ -152,6 +186,11 @@ sub dtrace_like {
     die "Unexpected error from DTrace: $result"
         if $child_exit_status != 0;
 
-    like($result, $expected, $name);
+    if (ref($expected) eq 'ARRAY') {
+        like($result, $_, $name) for @$expected;
+    }
+    else {
+        like($result, $expected, $name);
+    }
 }
 
diff --git a/gnu/usr.bin/perl/t/run/flib/broken.pm b/gnu/usr.bin/perl/t/run/flib/broken.pm
new file mode 100644
index 00000000000..18f4d45bd78
--- /dev/null
+++ b/gnu/usr.bin/perl/t/run/flib/broken.pm
@@ -0,0 +1,8 @@
+package broken;
+
+use strict;
+use warnings;
+
+$x = 1;
+
+1;
diff --git a/gnu/usr.bin/perl/t/run/fresh_perl.t b/gnu/usr.bin/perl/t/run/fresh_perl.t
index 9c76a64f468..376ceafc48f 100644
--- a/gnu/usr.bin/perl/t/run/fresh_perl.t
+++ b/gnu/usr.bin/perl/t/run/fresh_perl.t
@@ -81,7 +81,7 @@ $array[128]=1
 ########
 $x=0x0eabcd; print $x->ref;
 EXPECT
-Can't call method "ref" without a package or object reference at - line 1.
+Can't locate object method "ref" via package "961485" (perhaps you forgot to load "961485"?) at - line 1.
 ########
 chop ($str .= <DATA>);
 ########
@@ -349,15 +349,12 @@ sub foo { local $_ = shift; @_ = split; @_ }
 @x = foo(' x  y  z ');
 print "you die joe!\n" unless "@x" eq 'x y z';
 ########
-/(?{"{"})/	# Check it outside of eval too
+"A" =~ /(?{"{"})/	# Check it outside of eval too
 EXPECT
-Sequence (?{...}) not terminated or not {}-balanced in regex; marked by <-- HERE in m/(?{ <-- HERE "{"})/ at - line 1.
 ########
 /(?{"{"}})/	# Check it outside of eval too
 EXPECT
-Unmatched right curly bracket at (re_eval 1) line 1, at end of line
-syntax error at (re_eval 1) line 1, near ""{"}"
-Compilation failed in regexp at - line 1.
+Sequence (?{...}) not terminated with ')' at - line 1.
 ########
 BEGIN { @ARGV = qw(a b c d e) }
 BEGIN { print "argv <@ARGV>\nbegin <",shift,">\n" }
@@ -825,3 +822,55 @@ eval {
 print "If you get here, you didn't crash\n";
 EXPECT
 If you get here, you didn't crash
+######## [perl #112312] crash on syntax error
+# SKIP: !defined &DynaLoader::boot_DynaLoader # miniperl
+#!/usr/bin/perl
+use strict;
+use warnings;
+sub meow (&);
+my %h;
+my $k;
+meow {
+	my $t : need_this;
+	$t = {
+		size =>  $h{$k}{size};
+		used =>  $h{$k}(used}
+	};
+};
+EXPECT
+syntax error at - line 12, near "used"
+syntax error at - line 12, near "used}"
+Unmatched right curly bracket at - line 14, at end of line
+Execution of - aborted due to compilation errors.
+######## [perl #112312] crash on syntax error - another test
+# SKIP: !defined &DynaLoader::boot_DynaLoader # miniperl
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+sub meow (&);
+
+my %h;
+my $k;
+
+meow {
+        my $t : need_this;
+        $t = {
+                size => $h{$k}{size};
+                used => $h{$k}(used}
+        };
+};
+
+sub testo {
+        my $value = shift;
+        print;
+        print;
+        print;
+        1;
+}
+
+EXPECT
+syntax error at - line 15, near "used"
+syntax error at - line 15, near "used}"
+Unmatched right curly bracket at - line 17, at end of line
+Execution of - aborted due to compilation errors.
diff --git a/gnu/usr.bin/perl/t/run/locale.t b/gnu/usr.bin/perl/t/run/locale.t
index 7bbb0a9d39c..d01e3bca98b 100644
--- a/gnu/usr.bin/perl/t/run/locale.t
+++ b/gnu/usr.bin/perl/t/run/locale.t
@@ -64,7 +64,11 @@ my $original_locale = setlocale(LC_NUMERIC);
 
 my ($base, $different, $difference);
 for ("C", @locales) { # prefer C for the base if available
-    use locale;
+    BEGIN {
+        if($Config{d_setlocale}) {
+            require locale; import locale;
+        }
+    }
     setlocale(LC_NUMERIC, $_) or next;
     my $in = 4.2; # avoid any constant folding bugs
     if ((my $s = sprintf("%g", $in)) eq "4.2")  {
@@ -113,14 +117,15 @@ format STDOUT =
 @.#
 4.179
 .
-{ use locale; write; }
+{ require locale; import locale; write; }
 EOF
 	    "too late to look at the locale at write() time");
         }
 
         {
 	    fresh_perl_is(<<'EOF', $difference, {},
-use locale; format STDOUT =
+use locale;
+format STDOUT =
 @.#
 4.179
 .
@@ -134,7 +139,11 @@ EOF
         # do not let "use 5.000" affect the locale!
         # this test is to prevent regression of [rt.perl.org #105784]
         fresh_perl_is(<<"EOF",
-            use locale;
+            BEGIN {
+                if($Config{d_setlocale}) {
+                    require locale; import locale;
+                }
+            }
             use POSIX;
             my \$i = 0.123;
             POSIX::setlocale(POSIX::LC_NUMERIC(),"$different");
@@ -163,7 +172,7 @@ EOF
 	local $ENV{LC_NUMERIC} = $_;
 	local $ENV{LC_ALL}; # so it never overrides LC_NUMERIC
 	fresh_perl_is(<<'EOF', "$difference "x4, {},
-	    use locale;
+        use locale;
 	    use POSIX qw(locale_h);
 	    setlocale(LC_NUMERIC, "");
 	    my $in = 4.2;
diff --git a/gnu/usr.bin/perl/t/run/mad.t b/gnu/usr.bin/perl/t/run/mad.t
new file mode 100644
index 00000000000..83023c53ef0
--- /dev/null
+++ b/gnu/usr.bin/perl/t/run/mad.t
@@ -0,0 +1,46 @@
+#!./perl
+#
+# Tests for Perl mad environment
+#
+# $PERL_XMLDUMP
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require Config; import Config;
+    require './test.pl';
+    skip_all_without_config('mad');
+}
+
+use File::Path;
+use File::Spec;
+
+my $tempdir = tempfile;
+
+mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!";
+unshift @INC, '../../lib';
+my $cleanup = 1;
+
+END {
+    if ($cleanup) {
+	rmtree($tempdir);
+    }
+}
+
+plan tests => 4;
+
+{
+    delete local $ENV{$_} for keys %ENV;
+    my $fn = File::Spec->catfile(File::Spec->curdir(), "withoutT.xml");
+    $ENV{PERL_XMLDUMP} = $fn;
+    fresh_perl_is('print q/hello/', '', {}, 'mad without -T');
+    ok(-f $fn, "xml file created without -T as expected");
+}
+
+{
+    delete local $ENV{$_} for keys %ENV;
+    my $fn = File::Spec->catfile(File::Spec->curdir(), "withT.xml");
+    fresh_perl_is('print q/hello/', 'hello', { switches => [ "-T" ] },
+		  'mad with -T');
+    ok(!-e $fn, "no xml file created with -T as expected");
+}
diff --git a/gnu/usr.bin/perl/t/run/noswitch.t b/gnu/usr.bin/perl/t/run/noswitch.t
index a902c1fff7d..ff562534cdb 100644
--- a/gnu/usr.bin/perl/t/run/noswitch.t
+++ b/gnu/usr.bin/perl/t/run/noswitch.t
@@ -1,12 +1,16 @@
 #!./perl
 
 BEGIN {
-    print "1..3\n";
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
     *ARGV = *DATA;
+    plan(tests => 3);
 }
-print "ok 1\n";
-print <>;
-print "ok 3\n";
+
+pass("first test");
+is( scalar <>, "ok 2\n", "read from aliased DATA filehandle");
+pass("last test");
 
 __DATA__
-ok 2 - read from aliased DATA filehandle
+ok 2
diff --git a/gnu/usr.bin/perl/t/run/runenv.t b/gnu/usr.bin/perl/t/run/runenv.t
index cea25904148..b3df796dd1e 100644
--- a/gnu/usr.bin/perl/t/run/runenv.t
+++ b/gnu/usr.bin/perl/t/run/runenv.t
@@ -12,7 +12,7 @@ BEGIN {
     skip_all_without_config('d_fork');
 }
 
-plan tests => 84;
+plan tests => 104;
 
 my $STDOUT = tempfile();
 my $STDERR = tempfile();
@@ -53,7 +53,7 @@ sub runperl_and_capture {
     }
     open STDOUT, '>', $STDOUT or exit $FAILURE_CODE;
     open STDERR, '>', $STDERR and do { exec $PERL, @$args };
-    # it didn't_work:
+    # it did not work:
     print STDOUT "IWHCWJIHCI\cNHJWCJQWKJQJWCQW\n";
     exit $FAILURE_CODE;
   }
@@ -63,8 +63,21 @@ sub try {
   my ($env, $args, $stdout, $stderr) = @_;
   my ($actual_stdout, $actual_stderr) = runperl_and_capture($env, $args);
   local $::Level = $::Level + 1;
-  is ($stdout, $actual_stdout);
-  is ($stderr, $actual_stderr);
+  my @envpairs = ();
+  for my $k (sort keys %$env) {
+    push @envpairs, "$k => $env->{$k}";
+  }
+  my $label = join(',' => (@envpairs, @$args));
+  if (ref $stdout) {
+    ok ( $actual_stdout =~/$stdout/, $label . ' stdout' );
+  } else {
+    is ( $actual_stdout, $stdout, $label . ' stdout' );
+  }
+  if (ref $stderr) {
+    ok ( $actual_stderr =~/$stderr/, $label . ' stderr' );
+  } else {
+    is ( $actual_stderr, $stderr, $label . ' stderr' );
+  }
 }
 
 #  PERL5OPT    Command-line options (switches).  Switches in
@@ -191,6 +204,77 @@ try({PERL5LIB => "foo",
     '',
     '');
 
+try({PERL_HASH_SEED_DEBUG => 1},
+    ['-e','1'],
+    '',
+    qr/HASH_FUNCTION =/);
+
+try({PERL_HASH_SEED_DEBUG => 1},
+    ['-e','1'],
+    '',
+    qr/HASH_SEED =/);
+
+# special case, seed "0" implies disabled hash key traversal randomization
+try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 0/);
+
+# check that setting it to a different value with the same logical value
+# triggers the normal "deterministic mode".
+try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0x0"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 2/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "0"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 0/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "1"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 1/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "2"},
+    ['-e','1'],
+    '',
+    qr/PERTURB_KEYS = 2/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12345678"},
+    ['-e','1'],
+    '',
+    qr/HASH_SEED = 0x12345678/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12"},
+    ['-e','1'],
+    '',
+    qr/HASH_SEED = 0x12000000/);
+
+try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "123456789"},
+    ['-e','1'],
+    '',
+    qr/HASH_SEED = 0x12345678/);
+
+# Test that PERL_PERTURB_KEYS works as expected.  We check that we get the same
+# results if we use PERL_PERTURB_KEYS = 0 or 2 and we reuse the seed from previous run.
+my @print_keys = ( '-e', '@_{"A".."Z"}=(); print keys %_');
+for my $mode ( 0,1, 2 ) { # disabled and deterministic respectively
+    my %base_opts = ( PERL_PERTURB_KEYS => $mode, PERL_HASH_SEED_DEBUG => 1 ),
+    my ($out, $err) = runperl_and_capture( { %base_opts }, [ @print_keys ]);
+    if ($err=~/HASH_SEED = (0x[a-f0-9]+)/) {
+        my $seed = $1;
+        my($out2, $err2) = runperl_and_capture( { %base_opts, PERL_HASH_SEED => $seed }, [ @print_keys ]);
+        if ( $mode == 1 ) {
+            isnt ($out,$out2,"PERL_PERTURB_KEYS = $mode results in different key order with the same key");
+        } else {
+            is ($out,$out2,"PERL_PERTURB_KEYS = $mode allows one to recreate a random hash");
+        }
+        is ($err,$err2,"Got the same debug output when we set PERL_HASH_SEED and PERL_PERTURB_KEYS");
+    }
+}
+
 # Tests for S_incpush_use_sep():
 
 my @dump_inc = ('-e', 'print "$_\n" foreach @INC');
diff --git a/gnu/usr.bin/perl/t/run/script.t b/gnu/usr.bin/perl/t/run/script.t
index 83d733abd23..2553e0045bc 100755
--- a/gnu/usr.bin/perl/t/run/script.t
+++ b/gnu/usr.bin/perl/t/run/script.t
@@ -4,17 +4,16 @@ BEGIN {
     chdir 't';
     @INC = '../lib';
     require './test.pl';	# for which_perl() etc
+    plan(3);
 }
 
 my $Perl = which_perl();
 
 my $filename = tempfile();
 
-print "1..3\n";
-
 $x = `$Perl -le "print 'ok';"`;
 
-if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";}
+is($x, "ok\n", "Got expected 'perl -le' output");
 
 open(try,">$filename") || (die "Can't open temp file.");
 print try 'print "ok\n";'; print try "\n";
@@ -22,8 +21,8 @@ close try or die "Could not close: $!";
 
 $x = `$Perl $filename`;
 
-if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";}
+is($x, "ok\n", "Got expected output of command from script");
 
 $x = `$Perl <$filename`;
 
-if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";}
+is($x, "ok\n", "Got expected output of command read from script");
diff --git a/gnu/usr.bin/perl/t/run/switch0.t b/gnu/usr.bin/perl/t/run/switch0.t
index 9919e1231a2..94d5bd2df7a 100644
--- a/gnu/usr.bin/perl/t/run/switch0.t
+++ b/gnu/usr.bin/perl/t/run/switch0.t
@@ -1,3 +1,11 @@
 #!./perl -0
-print "1..1\n";
-print ord $/ == 0 ? "ok 1\n" : "not ok 1\n";
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+plan tests => 1;
+
+is(ord $/, 0, '$/ set to 0 via switch');
diff --git a/gnu/usr.bin/perl/t/run/switchF.t b/gnu/usr.bin/perl/t/run/switchF.t
index a6e9031d0c8..dcf44094dd8 100644
--- a/gnu/usr.bin/perl/t/run/switchF.t
+++ b/gnu/usr.bin/perl/t/run/switchF.t
@@ -1,11 +1,16 @@
 #!./perl -anFx+
 
 BEGIN {
-    print "1..2\n";
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
     *ARGV = *DATA;
+    plan(tests => 2);
 }
-print "@F";
+my $index = $F[-1];
+chomp $index;
+is($index, $., "line $.");
 
 __DATA__
 okx1
-okxxx2
+okx3xx2
diff --git a/gnu/usr.bin/perl/t/run/switchF1.t b/gnu/usr.bin/perl/t/run/switchF1.t
index f94c159544a..70fe638acbd 100755
--- a/gnu/usr.bin/perl/t/run/switchF1.t
+++ b/gnu/usr.bin/perl/t/run/switchF1.t
@@ -1,4 +1,8 @@
 #!perl -w
+
+# This test file does not use test.pl because of the involved way in which it
+# generates its TAP output.
+
 print "1..5\n";
 
 my $file = "Run_switchF1.pl";
@@ -14,10 +18,10 @@ BEGIN {
 print "@F";
 
 __DATA__
-okx1
-okq2
-ok\3
-ok'4
+okx1x- use of alternate delimiter (lower case letter) in -F
+okq2q- use of alternate delimiter (lower case letter) in -F
+ok\3\- use of alternate delimiter (backslash) in -F
+ok'4'- use of alternate delimiter (apostrophe) in -F
 EOT
 
 # 2 of the characters toke.c used to use to quote the split parameter:
@@ -26,6 +30,8 @@ $prog =~ s/QQ/\x01\x80/;
 print F $prog;
 close F or die "Close $file: $!";
 
-print system ($^X, $file) ? "not ok 5\n" : "ok 5\n";
+$count = 5;
+$result = "ok $count - complete test of alternate delimiters in -F\n";
+print system ($^X, $file) ? "not $result" : $result;
 
 unlink $file or die "Unlink $file: $!";
diff --git a/gnu/usr.bin/perl/t/run/switchI.t b/gnu/usr.bin/perl/t/run/switchI.t
index 27f78a60779..7fb222bb219 100644
--- a/gnu/usr.bin/perl/t/run/switchI.t
+++ b/gnu/usr.bin/perl/t/run/switchI.t
@@ -11,11 +11,12 @@ my $Is_VMS   = $^O eq 'VMS';
 my $lib;
 
 $lib = 'Bla';
-ok(grep { $_ eq $lib } @INC[0..($#INC-1)]);
+ok do { grep { $_ eq $lib } @INC[0..($#INC-1)] }, 'Identified entry in @INC';
 SKIP: {
   skip 'Double colons not allowed in dir spec', 1 if $Is_VMS;
   $lib = 'Foo::Bar';
-  ok(grep { $_ eq $lib } @INC[0..($#INC-1)]);
+  ok do { grep { $_ eq $lib } @INC[0..($#INC-1)] },
+    'Identified entry in @INC with double colons';
 }
 
 $lib = 'Bla2';
diff --git a/gnu/usr.bin/perl/t/run/switchM.t b/gnu/usr.bin/perl/t/run/switchM.t
new file mode 100644
index 00000000000..72e8908b01b
--- /dev/null
+++ b/gnu/usr.bin/perl/t/run/switchM.t
@@ -0,0 +1,19 @@
+#!./perl
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+use strict;
+
+require './test.pl';
+
+plan(2);
+
+like(runperl(switches => ['-Irun/flib', '-Mbroken'], stderr => 1),
+     qr/^Global symbol "\$x" requires explicit package name at run\/flib\/broken.pm line 6\./,
+     "Ensure -Irun/flib produces correct filename in warnings");
+
+like(runperl(switches => ['-Irun/flib/', '-Mbroken'], stderr => 1),
+     qr/^Global symbol "\$x" requires explicit package name at run\/flib\/broken.pm line 6\./,
+     "Ensure -Irun/flib/ produces correct filename in warnings");
diff --git a/gnu/usr.bin/perl/t/run/switcha.t b/gnu/usr.bin/perl/t/run/switcha.t
index ec2f0ccc066..16c7917b0ee 100644
--- a/gnu/usr.bin/perl/t/run/switcha.t
+++ b/gnu/usr.bin/perl/t/run/switcha.t
@@ -1,11 +1,14 @@
 #!./perl -na
 
 BEGIN {
-    print "1..2\n";
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
     *ARGV = *DATA;
-    $i = 0;
+    plan(tests => 2);
 }
-print "$F[1] ",++$i,"\n";
+chomp;
+is($F[1], 'ok', "testing split of string '$_'");
 
 __DATA__
 not ok
diff --git a/gnu/usr.bin/perl/t/run/switchd.t b/gnu/usr.bin/perl/t/run/switchd.t
index eadcd94053d..4334262616e 100644
--- a/gnu/usr.bin/perl/t/run/switchd.t
+++ b/gnu/usr.bin/perl/t/run/switchd.t
@@ -9,7 +9,7 @@ BEGIN { require "./test.pl"; }
 
 # This test depends on t/lib/Devel/switchd*.pm.
 
-plan(tests => 7);
+plan(tests => 10);
 
 my $r;
 
@@ -35,19 +35,25 @@ __SWDTEST__
 		 progfile => $filename,
 		 args => ['3'],
 		);
-    like($r, qr/^sub<Devel::switchd::import>;import<Devel::switchd>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/);
+    like($r,
+qr/^sub<Devel::switchd::import>;import<Devel::switchd>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/,
+    'Got debugging output: 1');
     $r = runperl(
 		 switches => [ '-Ilib', '-f', '-d:switchd=a,42' ],
 		 progfile => $filename,
 		 args => ['4'],
 		);
-    like($r, qr/^sub<Devel::switchd::import>;import<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/);
+    like($r,
+qr/^sub<Devel::switchd::import>;import<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/,
+    'Got debugging output: 2');
     $r = runperl(
 		 switches => [ '-Ilib', '-f', '-d:-switchd=a,42' ],
 		 progfile => $filename,
 		 args => ['4'],
 		);
-    like($r, qr/^sub<Devel::switchd::unimport>;unimport<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/);
+    like($r,
+qr/^sub<Devel::switchd::unimport>;unimport<Devel::switchd a 42>;DB<main,$::tempfile_regexp,9>;sub<Foo::foo>;DB<Foo,$::tempfile_regexp,5>;DB<Foo,$::tempfile_regexp,6>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;sub<Bar::bar>;DB<Bar,$::tempfile_regexp,2>;$/,
+    'Got debugging output: 3');
 }
 
 # [perl #71806]
@@ -110,3 +116,50 @@ like(
   qr "ok\r?\n",
  'No crash when calling orphaned subroutine via goto &',
 );
+
+# test when DB::DB is seen but not defined [perl #114990]
+like(
+  runperl(
+    switches => [ '-Ilib', '-d:nodb' ],
+    prog     => [ '1' ],
+    stderr   => 1,
+  ),
+  qr/^No DB::DB routine defined/,
+  "No crash when *DB::DB exists but not &DB::DB",
+);
+like(
+  runperl(
+    switches => [ '-Ilib' ],
+    prog     => 'sub DB::DB; BEGIN { $^P = 0x22; } for(0..9){ warn }',
+    stderr   => 1,
+  ),
+  qr/^No DB::DB routine defined/,
+  "No crash when &DB::DB exists but isn't actually defined",
+);
+
+# [perl #115742] Recursive DB::DB clobbering its own pad
+like(
+  runperl(
+    switches => [ '-Ilib' ],
+    progs    => [ split "\n", <<'='
+     BEGIN {
+      $^P = 0x22;
+     }
+     package DB;
+     sub DB {
+      my $x = 42;
+      return if $__++;
+      $^D |= 1 << 30; # allow recursive calls
+      main::foo();
+      print $x//q-u-, qq-\n-;
+     }
+     package main;
+     chop;
+     sub foo { chop; }
+=
+    ],
+    stderr   => 1,
+  ),
+  qr/42/,
+  "Recursive DB::DB does not clobber its own pad",
+);
diff --git a/gnu/usr.bin/perl/t/run/switches.t b/gnu/usr.bin/perl/t/run/switches.t
index 57ae32474d7..f1b923461d9 100644
--- a/gnu/usr.bin/perl/t/run/switches.t
+++ b/gnu/usr.bin/perl/t/run/switches.t
@@ -11,9 +11,11 @@ BEGIN {
 
 BEGIN { require "./test.pl"; }
 
-plan(tests => 112);
+plan(tests => 115);
 
 use Config;
+use Errno qw(EACCES EISDIR);
+use POSIX qw(setlocale LC_ALL);
 
 # due to a bug in VMS's piping which makes it impossible for runperl()
 # to emulate echo -n (ie. stdin always winds up with a newline), these 
@@ -107,6 +109,25 @@ SWTEST
     );
 }
 
+{
+    my $tempdir = tempfile;
+    mkdir $tempdir, 0700 or die "Can't mkdir '$tempdir': $!";
+
+    local $ENV{'LC_ALL'} = 'C'; # Keep the test simple: expect English
+    local $ENV{LANGUAGE} = 'C';
+    setlocale(LC_ALL, "C");
+
+    # Win32 won't let us open the directory, so we never get to die with
+    # EISDIR, which happens after open.
+    my $error  = do { local $! = $^O eq 'MSWin32' ? EACCES : EISDIR; "$!" };
+    like(
+        runperl( switches => [ '-c' ], args  => [ $tempdir ], stderr => 1),
+        qr/Can't open perl script.*$tempdir.*\Q$error/s,
+        "RT \#61362: Cannot syntax-check a directory"
+    );
+    rmdir $tempdir or die "Can't rmdir '$tempdir': $!";
+}
+
 # Tests for -l
 
 $r = runperl(
@@ -350,6 +371,26 @@ __EOF__
     is(join(":", @bak),
        "foo yada dada:bada foo bing:king kong foo",
        "-i backup file");
+
+    my $out1 = runperl(
+        switches => ['-i.bak -p'],
+        prog     => 'exit',
+        stderr   => 1,
+        stdin    => "1\n",
+    );
+    is(
+        $out1,
+        "-i used with no filenames on the command line, reading from STDIN.\n",
+        "warning when no files given"
+    );
+    my $out2 = runperl(
+        switches => ['-i.bak -p'],
+        prog     => 'exit',
+        stderr   => 1,
+        stdin    => "1\n",
+        args     => ['file'],
+    );
+    is($out2, "", "no warning when files given");
 }
 
 # Tests for -E
@@ -363,12 +404,12 @@ is( $r, "Hello, world!\n", "-E say" );
 
 
 $r = runperl(
-    switches	=> [ '-E', '"undef ~~ undef and say q(Hello, world!)"']
+    switches	=> [ '-E', '"no warnings q{experimental::smartmatch}; undef ~~ undef and say q(Hello, world!)"']
 );
 is( $r, "Hello, world!\n", "-E ~~" );
 
 $r = runperl(
-    switches	=> [ '-E', '"given(undef) {when(undef) { say q(Hello, world!)"}}']
+    switches	=> [ '-E', '"no warnings q{experimental::smartmatch}; given(undef) {when(undef) { say q(Hello, world!)"}}']
 );
 is( $r, "Hello, world!\n", "-E given" );
 
diff --git a/gnu/usr.bin/perl/t/run/switchn.t b/gnu/usr.bin/perl/t/run/switchn.t
index bca9a66e76c..6ad4a7265f0 100644
--- a/gnu/usr.bin/perl/t/run/switchn.t
+++ b/gnu/usr.bin/perl/t/run/switchn.t
@@ -1,15 +1,19 @@
 #!./perl -n
 
 BEGIN {
-    print "1..3\n";
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
     *ARGV = *DATA;
+    plan(tests => 3);
 }
 
 END {
-    print "ok 3\n";
+    pass("Final test");
 }
 
-print;
+chomp;
+is("ok ".$., $_, "Checking line $.");
 
 s/^/not /;
 
diff --git a/gnu/usr.bin/perl/t/run/switchp.t b/gnu/usr.bin/perl/t/run/switchp.t
index 1d1fe1485f5..ab1ae902854 100644
--- a/gnu/usr.bin/perl/t/run/switchp.t
+++ b/gnu/usr.bin/perl/t/run/switchp.t
@@ -1,16 +1,19 @@
 #!./perl -p
 
+# This test file does not use test.pl because of the involved way in which it
+# generates its TAP output.
+
 BEGIN {
     print "1..3\n";
     *ARGV = *DATA;
 }
 
 END {
-    print "ok 3\n";
+    print "ok 3 - -p switch tested\n";
 }
 
 s/^not //;
 
 __DATA__
-not ok 1
-not ok 2
+not ok 1 - -p switch first iteration
+not ok 2 - -p switch second iteration
diff --git a/gnu/usr.bin/perl/t/run/switchx.aux b/gnu/usr.bin/perl/t/run/switchx.aux
index 0db6103ee26..b59df4a0ed8 100644
--- a/gnu/usr.bin/perl/t/run/switchx.aux
+++ b/gnu/usr.bin/perl/t/run/switchx.aux
@@ -19,9 +19,9 @@ still not perl
 
 print "1..7";
 if (-f 'run/switchx.aux') {
-    print "ok 1";
+    print "ok 1 - Test file exists";
 }
-print "ok 2";
+print "ok 2 - Test file utilized";
 # other tests are in switchx2.aux
 
 __END__
diff --git a/gnu/usr.bin/perl/t/run/switchx2.aux b/gnu/usr.bin/perl/t/run/switchx2.aux
index c1fb6ee65dc..6d54a2d202c 100644
--- a/gnu/usr.bin/perl/t/run/switchx2.aux
+++ b/gnu/usr.bin/perl/t/run/switchx2.aux
@@ -21,10 +21,10 @@ if [[ -z $FOO ]]; then echo 'not ok 1'; fi
 # These lines get executed
 my $test = $ARGV[0];
 if (-f 'switchx.t') {
-    print("ok $test");
+    print("ok $test - perl -l option tested");
 }
 $test++;
-print "ok $test";
+print "ok $test - Second test file utilized";
 
 __END__