This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
internally change "when" to "whereso"
[perl5.git] / lib / perl5db.pl
index f26731b..ecc49a8 100644 (file)
@@ -528,7 +528,8 @@ BEGIN {
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 use vars qw($VERSION $header);
 
-$VERSION = '1.49_04';
+# bump to X.XX in blead, only use X.XX_XX in maint
+$VERSION = '1.53';
 
 $header = "perl5db.pl version $VERSION";
 
@@ -1532,14 +1533,6 @@ We then determine what the console should be on various systems:
         undef $console;
     }
 
-=item * Unix - use F</dev/tty>.
-
-=cut
-
-    elsif ( -e "/dev/tty" ) {
-        $console = "/dev/tty";
-    }
-
 =item * Windows or MSDOS - use C<con>.
 
 =cut
@@ -1564,6 +1557,17 @@ We then determine what the console should be on various systems:
         $console = 'sys$command';
     }
 
+# Keep this penultimate, on the grounds that it satisfies a wide variety of
+# Unix-like systems that would otherwise need to be identified individually.
+
+=item * Unix - use F</dev/tty>.
+
+=cut
+
+    elsif ( -e "/dev/tty" ) {
+        $console = "/dev/tty";
+    }
+
 # Keep this last.
 
     else {
@@ -1655,14 +1659,14 @@ and if we can.
             $o = $i unless defined $o;
 
             # read/write on in, or just read, or read on STDIN.
-            open( IN,      "+<$i" )
-              || open( IN, "<$i" )
+                 open( IN, '+<', $i )
+              || open( IN, '<',  $i )
               || open( IN, "<&STDIN" );
 
             # read/write/create/clobber out, or write/create/clobber out,
             # or merge with STDERR, or merge with STDOUT.
-                 open( OUT, "+>$o" )
-              || open( OUT, ">$o" )
+                 open( OUT, '+>', $o )
+              || open( OUT, '>',  $o )
               || open( OUT, ">&STDERR" )
               || open( OUT, ">&STDOUT" );    # so we don't dongle stdout
 
@@ -1867,7 +1871,10 @@ sub _DB__trim_command_and_return_first_component {
     $cmd =~ s/\A\s+//s;    # trim annoying leading whitespace
     $cmd =~ s/\s+\z//s;    # trim annoying trailing whitespace
 
-    my ($verb, $args) = $cmd =~ m{\A(\S*)\s*(.*)}s;
+    # A single-character debugger command can be immediately followed by its
+    # argument if they aren't both alphanumeric; otherwise require space
+    # between commands and arguments:
+    my ($verb, $args) = $cmd =~ m{\A(.\b|\S*)\s*(.*)}s;
 
     $obj->cmd_verb($verb);
     $obj->cmd_args($args);
@@ -1951,7 +1958,10 @@ sub _DB__handle_y_command {
         = $obj->cmd_args =~ /\A(?:(\d*)\s*(.*))?\z/) {
 
         # See if we've got the necessary support.
-        if (!eval { require PadWalker; PadWalker->VERSION(0.08) }) {
+        if (!eval {
+            local @INC = @INC;
+            pop @INC if $INC[-1] eq '.';
+            require PadWalker; PadWalker->VERSION(0.08) }) {
             my $Err = $@;
             _db_warn(
                 $Err =~ /locate/
@@ -6621,9 +6631,9 @@ sub dump_trace {
         $i++
     )
     {
-
-        # Go through the arguments and save them for later.
-        my $save_args = _dump_trace_calc_save_args($nothard);
+        # if the sub has args ($h true), make an anonymous array of the
+        # dumped args.
+        my $args = $h ? _dump_trace_calc_save_args($nothard) : undef;
 
         # If context is true, this is array (@)context.
         # If context is false, this is scalar ($) context.
@@ -6631,10 +6641,6 @@ sub dump_trace {
         # happen' trap.)
         $context = $context ? '@' : ( defined $context ? "\$" : '.' );
 
-        # if the sub has args ($h true), make an anonymous array of the
-        # dumped args.
-        $args = $h ? $save_args : undef;
-
         # remove trailing newline-whitespace-semicolon-end of line sequence
         # from the eval text, if any.
         $e =~ s/\n\s*\;\s*\Z// if $e;
@@ -6824,8 +6830,8 @@ sub setterm {
         if ($tty) {
             my ( $i, $o ) = split $tty, /,/;
             $o = $i unless defined $o;
-            open( IN,  "<$i" ) or die "Cannot open TTY '$i' for read: $!";
-            open( OUT, ">$o" ) or die "Cannot open TTY '$o' for write: $!";
+            open( IN,  '<', $i ) or die "Cannot open TTY '$i' for read: $!";
+            open( OUT, '>', $o ) or die "Cannot open TTY '$o' for write: $!";
             $IN  = \*IN;
             $OUT = \*OUT;
             _autoflush($OUT);
@@ -7748,8 +7754,8 @@ sub TTY {
         }
 
         # Open file onto the debugger's filehandles, if you can.
-        open IN,  $in     or die "cannot open '$in' for read: $!";
-        open OUT, ">$out" or die "cannot open '$out' for write: $!";
+        open IN,  '<', $in or die "cannot open '$in' for read: $!";
+        open OUT, '>', $out or die "cannot open '$out' for write: $!";
 
         # Swap to the new filehandles.
         reset_IN_OUT( \*IN, \*OUT );
@@ -9441,7 +9447,10 @@ if PadWalker could be loaded.
 
 =cut
 
-        if (not $text =~ /::/ and eval { require PadWalker } ) {
+        if (not $text =~ /::/ and eval {
+            local @INC = @INC;
+            pop @INC if $INC[-1] eq '.';
+            require PadWalker } ) {
             my $level = 1;
             while (1) {
                 my @info = caller($level);