Make tables for Perl-tailored Unicode Line_Break property

[perl5.git] / lib / perl5db.pl

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index e8d7751..68f7e50 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -528,7 +528,7 @@ BEGIN {
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 use vars qw($VERSION $header);
 
-$VERSION = '1.46';
+$VERSION = '1.49_02';
 
 $header = "perl5db.pl version $VERSION";
 
@@ -871,6 +871,7 @@ BEGIN {
         lock($DBGR);
         print "Threads support enabled\n";
     } else {
+        *lock = sub(*) {};
         *share = sub(\[$@%]) {};
     }
 }
@@ -2489,7 +2490,11 @@ EOP
 # 'm' is method.
 # 'v' is the value (i.e: method name or subroutine ref).
 # 's' is subroutine.
-my %cmd_lookup =
+my %cmd_lookup;
+
+BEGIN
+{
+    %cmd_lookup =
 (
     '-' => { t => 'm', v => '_handle_dash_command', },
     '.' => { t => 's', v => \&_DB__handle_dot_command, },
@@ -2522,6 +2527,7 @@ my %cmd_lookup =
     (map { $_ => {t => 'm', v => '_handle_cmd_wrapper_commands' }, }
         qw(a A b B e E h i l L M o O v w W)),
 );
+};
 
 sub DB {
 
@@ -3318,6 +3324,9 @@ B<h q>, B<h R> or B<h o> to get additional info.
 EOP
 
         # Set the DB::eval context appropriately.
+        # At program termination disable any user actions.
+        $DB::action = undef;
+
         $DB::package     = 'main';
         $DB::usercontext = DB::_calc_usercontext($DB::package);
     } ## end elsif ($package eq 'DB::fake')
@@ -6540,11 +6549,10 @@ sub _dump_trace_calc_saved_single_arg
         s/(.*)/'$1'/s
         unless /^(?: -?[\d.]+ | \*[\w:]* )$/x;
 
-        # Turn high-bit characters into meta-whatever.
-        s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
-
-        # Turn control characters into ^-whatever.
-        s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
+        # Turn high-bit characters into meta-whatever, and controls into like
+        # '^D'.
+        require 'meta_notation.pm';
+        $_ = _meta_notation($_) if /[[:^print:]]/a;
 
         return $_;
     }
@@ -6737,24 +6745,24 @@ sub _db_system {
 
     # We save, change, then restore STDIN and STDOUT to avoid fork() since
     # some non-Unix systems can do system() but have problems with fork().
-    open( SAVEIN,  "<&STDIN" )  || db_warn("Can't save STDIN");
-    open( SAVEOUT, ">&STDOUT" ) || db_warn("Can't save STDOUT");
-    open( STDIN,   "<&IN" )     || db_warn("Can't redirect STDIN");
-    open( STDOUT,  ">&OUT" )    || db_warn("Can't redirect STDOUT");
+    open( SAVEIN,  "<&STDIN" )  || _db_warn("Can't save STDIN");
+    open( SAVEOUT, ">&STDOUT" ) || _db_warn("Can't save STDOUT");
+    open( STDIN,   "<&IN" )     || _db_warn("Can't redirect STDIN");
+    open( STDOUT,  ">&OUT" )    || _db_warn("Can't redirect STDOUT");
 
     # XXX: using csh or tcsh destroys sigint retvals!
     system(@_);
-    open( STDIN,  "<&SAVEIN" )  || db_warn("Can't restore STDIN");
-    open( STDOUT, ">&SAVEOUT" ) || db_warn("Can't restore STDOUT");
+    open( STDIN,  "<&SAVEIN" )  || _db_warn("Can't restore STDIN");
+    open( STDOUT, ">&SAVEOUT" ) || _db_warn("Can't restore STDOUT");
     close(SAVEIN);
     close(SAVEOUT);
 
     # most of the $? crud was coping with broken cshisms
     if ( $? >> 8 ) {
-        db_warn( "(Command exited ", ( $? >> 8 ), ")\n" );
+        _db_warn( "(Command exited ", ( $? >> 8 ), ")\n" );
     }
     elsif ($?) {
-        db_warn(
+        _db_warn(
             "(Command died of SIG#",
             ( $? & 127 ),
             ( ( $? & 128 ) ? " -- core dumped" : "" ),
@@ -7573,7 +7581,7 @@ variables during a restart.
 Set_list packages up items to be stored in a set of environment variables
 (VAR_n, containing the number of items, and VAR_0, VAR_1, etc., containing
 the values). Values outside the standard ASCII charset are stored by encoding
-then as hexadecimal values.
+them as hexadecimal values.
 
 =cut
 
@@ -7589,7 +7597,9 @@ sub set_list {
     for my $i ( 0 .. $#list ) {
         $val = $list[$i];
         $val =~ s/\\/\\\\/g;
-        $val =~ s/([\0-\37\177\200-\377])/"\\0x" . unpack('H2',$1)/eg;
+        no warnings 'experimental::regex_sets';
+        $val =~ s/ ( (?[ [\000-\xFF] & [:^print:] ]) ) /
+                                                "\\0x" . unpack('H2',$1)/xaeg;
         $ENV{"${stem}_$i"} = $val;
     } ## end for $i (0 .. $#list)
 } ## end sub set_list
@@ -8429,7 +8439,7 @@ sub print_help {
     # wide.  If it's wider than that, an extra space will be added.
     $help_str =~ s{
         ^                       # only matters at start of line
-          ( \040{4} | \t )*     # some subcommands are indented
+          ( \ {4} | \t )*       # some subcommands are indented
           ( < ?                 # so <CR> works
             [BI] < [^\t\n] + )  # find an eeevil ornament
           ( \t+ )               # original separation, discarded