t/loc_tools.pl: Consider thread 0 always locale-safe

[perl5.git] / t / run / switchd.t

diff --git a/t/run/switchd.t b/t/run/switchd.t
index 98acba4..d2b2022 100644 (file)
--- a/t/run/switchd.t
+++ b/t/run/switchd.t
@@ -3,13 +3,12 @@
 BEGIN {
     chdir 't' if -d 't';
     @INC = qw(../lib lib);
+    require "./test.pl";
 }
 
-BEGIN { require "./test.pl"; }
-
 # This test depends on t/lib/Devel/switchd*.pm.
 
-plan(tests => 12);
+plan(tests => 21);
 
 my $r;
 
@@ -70,6 +69,17 @@ cmp_ok(
  'The debugger can see the lines of the main program under #!perl -d',
 );
 
+like
+  runperl(
+   switches => [ '"-Mless ++INC->{q-Devel/_.pm-}"' ],
+   progs    => [
+    '#!perl -d:_',
+    'sub DB::DB{} print line=>__LINE__',
+   ],
+  ),
+  qr/line2/,
+ '#!perl -d:whatever does not throw line numbers off';
+
 # [perl #48332]
 like(
   runperl(
@@ -136,6 +146,16 @@ like(
   qr/^No DB::DB routine defined/,
   "No crash when &DB::DB exists but isn't actually defined",
 );
+# or seen and defined later
+is(
+  runperl(
+    switches => [ '-Ilib', '-d:nodb' ], # nodb.pm contains *DB::DB...if 0
+    prog     => 'warn; sub DB::DB { print qq-ok\n-; exit }',
+    stderr   => 1,
+  ),
+  "ok\n",
+  "DB::DB works after '*DB::DB if 0'",
+);
 
 # [perl #115742] Recursive DB::DB clobbering its own pad
 like(
@@ -177,14 +197,133 @@ like(
 
 # PERL5DB with embedded newlines
 {
-    local $ENV{PERL5DB} = "sub DB::DB{}\ndie";
-    like(
+    local $ENV{PERL5DB} = "sub DB::DB{}\nwarn";
+    is(
       runperl(
        switches => [ '-Ilib', '-ld' ],
-       prog     => 'print qq|not ok|',
+       prog     => 'warn',
        stderr   => 1
       ),
-      qr /Died/,
+      "Warning: something's wrong.\n"
+     ."Warning: something's wrong at -e line 1.\n",
      'PERL5DB with embedded newlines',
     );
 }
+
+# test that DB::goto works
+is(
+  runperl(
+   switches => [ '-Ilib', '-d:switchd_goto' ],
+   prog => 'sub baz { print qq|hello;\n| } sub foo { goto &baz } foo()',
+   stderr => 1,
+  ),
+  "goto<main::baz>;hello;\n",
+  "DB::goto"
+);
+
+# Test that %DB::lsub is not vivified
+is(
+  runperl(
+   switches => [ '-Ilib', '-d:switchd_empty' ],
+   progs => ['sub DB::sub {} sub foo : lvalue {} foo();',
+             'print qq-ok\n- unless defined *DB::lsub{HASH}'],
+  ),
+  "ok\n",
+  "%DB::lsub is not vivified"
+);
+
+# Test setting of breakpoints without *DB::dbline aliased
+is(
+  runperl(
+   switches => [ '-Ilib', '-d:nodb' ],
+   progs => [ split "\n",
+    'sub DB::DB {
+      $DB::single = 0, return if $DB::single; print qq[ok\n]; exit
+     }
+     ${q(_<).__FILE__}{6} = 1; # set a breakpoint
+     sub foo {
+         die; # line 6
+     }
+     foo();
+    '
+   ],
+   stderr => 1
+  ),
+  "ok\n",
+  "setting breakpoints without *DB::dbline aliased"
+);
+
+# [perl #121255]
+# Check that utf8 caches are flushed when $DB::sub is set
+is(
+  runperl(
+   switches => [ '-Ilib', '-d:switchd_empty' ],
+   progs => [ split "\n",
+    'sub DB::sub{length($DB::sub); goto &$DB::sub}
+     ${^UTF8CACHE}=-1;
+     print
+       eval qq|sub oo\x{25f} { 42 }
+               sub ooooo\x{25f} { oo\x{25f}() }
+               ooooo\x{25f}()| 
+        || $@,
+       qq|\n|;
+    '
+   ],
+   stderr => 1
+  ),
+  "42\n",
+  'UTF8 length caches on $DB::sub are flushed'
+);
+
+# [perl #122771] -d conflicting with sort optimisations
+is(
+  runperl(
+   switches => [ '-Ilib', '-d:switchd_empty' ],
+   prog => 'BEGIN { $^P &= ~0x4 } sort { $$b <=> $$a } (); print qq-42\n-',
+  ),
+  "42\n",
+  '-d does not conflict with sort optimisations'
+);
+
+SKIP: {
+  skip_if_miniperl("under miniperl", 1);
+is(
+  runperl(
+   switches => [ '-Ilib', '-d:switchd_empty' ],
+   progs => [ split "\n",
+    'use bignum;
+     $DB::single=2;
+     print qq/debugged\n/;
+    '
+   ],
+   stderr => 1
+  ),
+  "debugged\n",
+  "\$DB::single set to overload"
+);
+}
+
+# [perl #123748]
+#
+# On some platforms, it's possible that calls to getenv() will
+# return a pointer to statically allocated data that may be
+# overwritten by subsequent calls to getenv/putenv/setenv/unsetenv.
+#
+# In perl.c, s = PerlEnv_GetEnv("PERL5OPT") is called, and
+# then moreswitches(s), which, if -d:switchd_empty is given,
+# will call my_setenv("PERL5DB", "use Devel::switchd_empty"),
+# and then return to continue parsing s.
+#
+# This may need -Accflags="-DPERL_USE_SAFE_PUTENV" to fail on
+# affected systems.
+{
+local $ENV{PERL5OPT} = '-d:switchd_empty';
+
+like(
+  runperl(
+   switches => [ '-Ilib' ], prog => 'print q(hi)',
+  ),
+  qr/hi/,
+ 'putenv does not interfere with PERL5OPT parsing',
+);
+}