develooper Front page | perl.perl5.porters | Postings from September 2003

[PATCH 5.8.1 @21379] debugger fixes

Thread Next
From:
Ilya Zakharevich
Date:
September 25, 2003 19:49
Subject:
[PATCH 5.8.1 @21379] debugger fixes
Message ID:
20030926024912.GA27496@math.berkeley.edu
This patch fixes several problems with the debugger:

  a) POD docs and new-comments are very wrong quite often.  I fixed
     only one or two of the errors which were at hand when I was doing
     other stuff;

     [I wonder: what is the point of having more docs if these
     additions are wrong?]

  b) Be extra cautious to strip trailing \r from the command lines if
     it manages to come through;

  c) Better message if PadWalker is missing;

  d) Move most of the support of extra-window on OS2 to OS2::Process;

  e) Better docs for `B';

  f) Fit the output of `h' into 24 lines again;

Thanks,
Ilya

--- ./lib/perl5db.pl-pre	Fri Jul 25 00:22:40 2003
+++ ./lib/perl5db.pl	Fri Sep 19 19:41:38 2003
@@ -1498,7 +1498,7 @@ Console> if not. (Note that Mac OS X ret
 
 Several other systems don't use a specific console. We C<undef $console>
 for those (Windows using a slave editor/graphical debugger, NetWare, OS/2
-with a slave editor, Epoc).
+with a slave editor or xterm, Epoc).
 
 =cut
 
@@ -1512,10 +1512,8 @@ with a slave editor, Epoc).
         $console = undef;
     }
 
-    # In OS/2, we need to use STDIN to get textmode too, even though
-    # it pretty much looks like Unix otherwise.
-    if (defined $ENV{OS2_SHELL} and ($slave_editor or $ENV{WINDOWID}))
-    {    # In OS/2
+    if ($^O eq 'os2' and ($slave_editor or $ENV{WINDOWID}))
+    {    # uncomplete support of /dev/con on xterm and other X terminals
         $console = undef;
     }
     # EPOC also falls into the 'got to use STDIN' camp.
@@ -2054,6 +2052,8 @@ the new command. This is faster, but per
             # No signal is active.
             $signal = 0;
 
+	    $cmd =~ s/\r+\z//;	# Remove spurious \r due to wrong binmode...
+
             # Handle continued commands (ending with \):
             $cmd =~ s/\\$/\n/ && do {
                 $cmd .= &readline("  cont: ");
@@ -2397,7 +2397,10 @@ above the current one and then displays 
                     eval { require PadWalker; PadWalker->VERSION(0.08) }
                       or &warn(
                         $@ =~ /locate/
-                        ? "PadWalker module not found - please install\n"
+                        ? <<EOM
+PadWalker module not found - please install; try the command
+  perl -MCPAN -e "install PadWalker"
+EOM
                         : $@
                       )
                       and next CMD;
@@ -5788,69 +5791,70 @@ qq[3>&1 xterm -title "Daughter Perl debu
 
 XXX It behooves an OS/2 expert to write the necessary documentation for this!
 
+Starts a separate session (so a new console) with a kid Perl program; this
+program mirrors user's input of this session to one filehandle ($out), and
+displays data coming through $in filehandle.
+
+Since this kid program should not be debugged, we massage C<PERL5OPT>
+and C<PERL5LIB> environment variables to make the kid as reliable as possible.
+
+B<LIMITATIONS>: with the current logic the kid should inherit the filehandles
+created by pipe() calls; this we can't start it with C<P_INDEPENDENT> flag.
+However, in any session only one process can start a new session without
+this flag; thus only one window per session can be created.  (To fix this,
+one should communicate via named pipes or sockets...)
+
+Since the depended-sessions are killed when a parent terminates, the kids
+print C<Process terminated by SIGKILL> (?) messages; they are visible for a
+moment before the session closes.
+
 =cut
 
 # This example function resets $IN, $OUT itself
 sub os2_get_fork_TTY {
-    local $^F = 40;     # XXXX Fixme!
-    local $\  = '';
-    my ($in1, $out1, $in2, $out2);
-
     # Having -d in PERL5OPT would lead to a disaster...
     local $ENV{PERL5OPT} = $ENV{PERL5OPT} if $ENV{PERL5OPT};
     $ENV{PERL5OPT} =~ s/(?:^|(?<=\s))-d\b//  if $ENV{PERL5OPT};
     $ENV{PERL5OPT} =~ s/(?:^|(?<=\s))-d\B/-/ if $ENV{PERL5OPT};
     print $OUT "Making kid PERL5OPT->`$ENV{PERL5OPT}'.\n" if $ENV{PERL5OPT};
+
+    # Propagate libraries
     local $ENV{PERL5LIB} = $ENV{PERL5LIB} ? $ENV{PERL5LIB} : $ENV{PERLLIB};
     $ENV{PERL5LIB} = '' unless defined $ENV{PERL5LIB};
-    $ENV{PERL5LIB} = join ';', @ini_INC, split /;/, $ENV{PERL5LIB};
+    $ENV{PERL5LIB} = join ';', @INC, @ini_INC, split /;/, $ENV{PERL5LIB};
+
     (my $name = $0) =~ s,^.*[/\\],,s;
-    my @args;
 
-    if (
-            pipe $in1, $out1
-        and pipe $in2, $out2
-
-        # system P_SESSION will fail if there is another process
-        # in the same session with a "dependent" asynchronous child session.
-        and @args = (
-            $rl, fileno $in1, fileno $out2,
-            "Daughter Perl debugger $pids $name"
-        )
-        and (
-            ($kpid = CORE::system 4, $^X, '-we',
-                <<'ES', @args) >= 0    # P_SESSION
-END {sleep 5 unless $loaded}
-BEGIN {open STDIN,  '</dev/con' or warn "reopen stdin: $!"}
-use OS2::Process;
-
-my ($rl, $in) = (shift, shift);        # Read from $in and pass through
-set_title pop;
-system P_NOWAIT, $^X, '-we', <<EOS or die "Cannot start a grandkid";
-  open IN, '<&=$in' or die "open <&=$in: \$!";
-  \$| = 1; print while sysread IN, \$_, 1<<16;
+    # What follows until <<<<< is mostly almost exactly
+    #  require OS2::Process; my ($in, $out, $pid) = OS2::Process::io_term @args
+    local $^F = 40;     # XXXX Fixme!
+    local $\  = '';
+    my ($in1, $out1, $in2, $out2);
+
+    pipe $in1, $out1 or return;
+    pipe $in2, $out2 or do { close($in1), close($out1), return };
+
+    # system P_SESSION=4 will fail if there is another process
+    # in the same session with a "dependent" asynchronous child session.
+    my @args = (($rl ? (read_by_key => 1) : ()),
+		# scrsize => '40,50',
+		title => "Daughter Perl debugger $pids $name");
+    my $kpid = system 4, $^X, '-we', <<'EOS', fileno $in1, fileno $out2, @args;
+       END {sleep($sleep || 5)}
+       use OS2::Process; $sleep = 1;
+       OS2::Process::__term_mirror(@ARGV);
 EOS
+    close $in1 or warn;
+    close $out2 or warn;
+    warn "system P_SESSION, $^X: $!, $^E" and do { close($in2), close($out1), return }
+      unless $kpid > 0;
+    # <<<<<<<<<<<<<
 
-my $out = shift;
-open OUT, ">&=$out" or die "Cannot open &=$out for writing: $!";
-select OUT;    $| = 1;
-require Term::ReadKey if $rl;
-Term::ReadKey::ReadMode(4) if $rl; # Nodelay on kbd.  Pipe is automatically nodelay...
-print while sysread STDIN, $_, 1<<($rl ? 16 : 0);
-ES
-            or warn "system P_SESSION: $!, $^E" and 0
-        )
-        and close $in1
-        and close $out2
-      )
-    {
-        $pidprompt = '';    # Shown anyway in titlebar
-        reset_IN_OUT($in2, $out1);
-        $tty = '*reset*';
-        return '';          # Indicate that reset_IN_OUT is called
-    } ## end if (pipe $in1, $out1 and...
-    return;
-} ## end sub os2_get_fork_TTY
+    $pidprompt = '';    # Shown anyway in titlebar
+    reset_IN_OUT($in2, $out1);
+    $tty = '*reset*';
+    return '';          # Indicate that reset_IN_OUT is called
+}
 
 =head2 C<create_IN_OUT($flags)>
 
@@ -6763,8 +6767,8 @@ B<m> I<expr>		Evals expression in list c
 		on the first element of the result.
 B<m> I<class>		Prints methods callable via the given class.
 B<M>		Show versions of loaded modules.
-B<y> [I<n> [I<Vars>]]   List lexicals in higher scope <n>.  Vars same as B<V>.
-
+B<y> [I<n> [I<Vars>]]    List lexicals in higher scope <n>.  Vars same as B<V>.
+		Requires the module B<PadWalker>.
 B<<> ?			List Perl commands to run before each prompt.
 B<<> I<expr>		Define Perl command to run before each prompt.
 B<<<> I<expr>		Add to the list of Perl commands to run before each prompt.
@@ -6801,7 +6805,7 @@ B<R>		Pure-man-restart of debugger, some
 		and command-line options may be lost.
 		Currently the following settings are preserved:
 		history, breakpoints and actions, debugger B<O>ptions 
-		and the following command-line options: I<-w>, I<-I>, I<-e>.
+		and the following command-line options: I<-w>, I<-I>, I<-T>, I<-e>.
 
 B<o> [I<opt>] ...	Set boolean option to true
 B<o> [I<opt>B<?>]	Query options
@@ -6869,12 +6873,11 @@ I<Debugger controls:>                   
   B<|>[B<|>]I<db_cmd>  Send output to pager        B<$psh>\[B<$psh>\] I<syscmd> Run cmd in a subprocess
   B<q> or B<^D>     Quit                        B<R>           Attempt a restart
 I<Data Examination:>     B<expr>     Execute perl code, also see: B<s>,B<n>,B<t> I<expr>
-  B<x>|B<m> I<expr>       Evals expr in list context, dumps the result or lists methods.
-  B<p> I<expr>         Print expression (uses script's current package).
-  B<S> [[B<!>]I<pat>]     List subroutine names [not] matching pattern
-  B<V> [I<Pk> [I<Vars>]]  List Variables in Package.  Vars can be ~pattern or !pattern.
-  B<X> [I<Vars>]       Same as \"B<V> I<current_package> [I<Vars>]\".
-  B<y> [I<n> [I<Vars>]]   List lexicals in higher scope <n>.  Vars same as B<V>.
+  B<x>|B<m> I<expr>     Evals I<expr> in list context, dumps the result or lists methods.
+  B<p> I<expr>       Print expression I<expr> (uses script's current package).
+  B<S> [[B<!>]I<pat>]   List subroutine names [not] matching pattern I<pat>.
+  B<X> [I<Vars>]     List Variables in current package.  I<Vars> can be ~pattern or !pat
+  B<V> [I<Pk> [I<Vars>]] Same as B<X> for package I<Pk>.  Type B<h y> for access to lexicals.
 For more help, type B<h> I<cmd_letter>, or run B<$doccmd perldebug> for all docs.
 END_SUM
 
--- ./os2/OS2/Process/Process.pm-pre	Thu Sep 11 14:48:24 2003
+++ ./os2/OS2/Process/Process.pm	Fri Sep 19 19:54:24 2003
@@ -573,6 +573,64 @@ sub kbdhStatus_set {
   _kbdStatus_set($o,$h);
 }
 
+# Large buffer works at least for read from pipes
+sub __term_mirror_screen {   # Read from fd=$in and write to the console
+  my $in = shift;
+  open IN, "<&=$in" or die "open <&=$in: $!";
+  # Attempt to redirect to STDERR/OUT is not very useful, but try this anyway...
+  open OUT, '>', '/dev/con' or open OUT, '>&STDERR' or open OUT, '>&STDOUT'
+        or warn "Cannot reopen STDOUT to /dev/con or STDERR/STDOUT";
+  select OUT; $| = 1; local $SIG{TERM} = sub { die "screenwriter exits...\n"};
+  eval { print while sysread IN, $_, 1<<16; }
+}
+
+sub __term_mirror {   # Read from fd=$in and pass through; same for $out
+  my $pid;
+  local $SIG{TERM} = sub { die "keyreader exits...\n" };
+  my ($in, $out) = (shift, shift);
+  my %in = @_;
+  Title_set $in{title}			if exists $in{title};
+  &scrsize_set(split /,/, $in{scrsize})	if exists $in{scrsize};
+
+  $pid = system 1, $^X, '-MOS2::Process',
+	 '-we', 'OS2::Process::__term_mirror_screen shift', $in;
+  $pid > 0 or die "Cannot start a grandkid";
+
+  open STDIN, '</dev/con' or warn "reopen stdin: $!";
+  open OUT, ">&=$out" or die "Cannot open &=$out for writing: $!";
+  select OUT;    $| = 1;  binmode OUT;	# need binmode since sysread() is bin
+  $SIG{PIPE} = sub { die "writing to a closed pipe" };
+  # Turn Nodelay on kbd.  Pipe is automatically nodelay...
+  if ($in{read_by_key}) {
+    if (eval {require Term::ReadKey; 1}) {
+      Term::ReadKey::ReadMode(4);
+    } else { warn }
+  }
+  print while sysread STDIN, $_, 1<<($flag ? 16 : 0);
+}
+
+sub io_term {	# arguments: hash with keys read_by_key/title/scrsize
+  local $^F = 40;     # XXXX Fixme!
+  local $\  = '';
+  my ($in1, $out1, $in2, $out2);
+
+  pipe $in1, $out1 or return;
+  pipe $in2, $out2 or do { close($in1), close($out1), return };
+
+  # system P_SESSION will fail if there is another process
+  # in the same session with a "dependent" asynchronous child session.
+  my @i = map +('-I', $_), @INC;	# Propagate @INC
+  my $kpid = system 4, $^X, @i, '-we', <<'EOS', fileno $in1, fileno $out2, @_;
+     END {sleep($sleep || 5)}
+     use OS2::Process; $sleep = 1;
+     OS2::Process::__term_mirror(@ARGV);
+EOS
+  close $in1 or warn;
+  close $out2 or warn;
+  warn "system P_SESSION, $^X: $!, $^E" and do { close($in2), close($out1), return }
+    unless $kpid > 0;
+  return ($in2, $out1, $kpid);
+}
 
 # Autoload methods go after __END__, and are processed by the autosplit program.
 

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About