This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #121081] workaround different output on VMS
[perl5.git] / lib / perl5db.pl
index b37018e..c1d6752 100644 (file)
@@ -523,7 +523,7 @@ BEGIN {
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 use vars qw($VERSION $header);
 
-$VERSION = '1.41';
+$VERSION = '1.43';
 
 $header = "perl5db.pl version $VERSION";
 
@@ -4094,9 +4094,6 @@ sub _print_frame_message {
 }
 
 sub DB::sub {
-    # Do not use a regex in this subroutine -> results in corrupted memory
-    # See: [perl #66110]
-
     # lock ourselves under threads
     lock($DBGR);
 
@@ -4269,7 +4266,9 @@ sub lsub : lvalue {
     $stack[-1] = $single;
 
     # Turn off all flags except single-stepping.
-    $single &= 1;
+    # Use local so the single-step value is popped back off the
+    # stack for us.
+    local $single = $single & 1;
 
     # If we've gotten really deeply recursed, turn on the flag that will
     # make us stop with the 'deep recursion' message.
@@ -4278,9 +4277,6 @@ sub lsub : lvalue {
     # If frame messages are on ...
     _print_frame_message($al);
 
-    # Pop the single-step value back off the stack.
-    $single |= $stack[ $stack_depth-- ];
-
     # call the original lvalue sub.
     &$sub;
 }
@@ -6147,7 +6143,11 @@ sub print_lineinfo {
     resetterm(1) if $LINEINFO eq $OUT and $term_pid != $$;
     local $\ = '';
     local $, = '';
-    print $LINEINFO @_;
+    # $LINEINFO may be undef if $noTTY is set or some other issue.
+    if ($LINEINFO)
+    {
+        print {$LINEINFO} @_;
+    }
 } ## end sub print_lineinfo
 
 =head2 C<postponed_sub>
@@ -9385,7 +9385,7 @@ If the package is C<::> (C<main>), create an empty list; if it's something else,
 =cut
 
         push @out, map "$prefix$_", grep /^\Q$text/,
-          ( grep /^_?[a-zA-Z]/, keys %$pack ),
+          ( grep /^_?[a-zA-Z]/, do { no strict 'refs'; keys %$pack } ),
           ( $pack eq '::' ? () : ( grep /::$/, keys %:: ) );
 
 =item *