From: Rafael Garcia-Suarez Date: Fri, 15 Oct 2004 14:09:54 +0000 (+0000) Subject: Implement a new -dt command-line flag, to enable threads under the X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2cbb2ee1d6d1dc9f375107de4b70573ece8a4e13;p=p5sagit%2Fp5-mst-13.2.git Implement a new -dt command-line flag, to enable threads under the debugger (bug #31666). Subject: RE: [PATCH] debugger handles threads [perl #31666] From: Date: Wed, 13 Oct 2004 13:01:18 +0200 Message-ID: Subject: Re: [PATCH] debugger handles threads [perl #31666] From: Yitzchak Scott-Thoennes Date: Wed, 13 Oct 2004 02:49:58 -0700 Message-ID: <20041013094957.GA17184@efn.org> p4raw-id: //depot/perl@23372 --- diff --git a/lib/perl5db.pl b/lib/perl5db.pl index cb91066..8777e08 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -493,7 +493,7 @@ package DB; use IO::Handle; # Debugger for Perl 5.00x; perl5db.pl patch level: -$VERSION = 1.27; +$VERSION = 1.28; $header = "perl5db.pl version $VERSION"; @@ -679,8 +679,6 @@ sub eval { # Note that no subroutine call is possible until &DB::sub is defined # (for subroutines defined outside of the package DB). In fact the same is # true if $deep is not defined. -# -# $Log: perldb.pl,v $ # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich) @@ -919,6 +917,8 @@ sub eval { # + removed windowid restriction for forking into an xterm. # + more whitespace again. # + wrapped restart and enabled rerun [-n] (go back n steps) command. +# Changes: 1.28: Oct 12, 2004 Richard Foley +# + Added threads support (inc. e and E commands) #################################################################### =head1 DEBUGGER INITIALIZATION @@ -956,12 +956,57 @@ BEGIN { local ($^W) = 0; # Switch run-time warnings off during init. +=head2 THREADS SUPPORT + +If we are running under a threaded Perl, we require threads and threads::shared +if the environment variable C is set, to enable proper +threaded debugger control. C<-dt> can also be used to set this. + +Each new thread will be announced and the debugger prompt will always inform +you of each new thread created. It will also indicate the thread id in which +we are currently running within the prompt like this: + + [tid] DB<$i> + +Where C<[tid]> is an integer thread id and C<$i> is the familiar debugger +command prompt. The prompt will show: C<[0]> when running under threads, but +not actually in a thread. C<[tid]> is consistent with C usage. + +While running under threads, when you set or delete a breakpoint (etc.), this +will apply to all threads, not just the currently running one. When you are +in a currently executing thread, you will stay there until it completes. With +the current implementation it is not currently possible to hop from one thread +to another. + +The C and C commands are currently fairly minimal - see C and C. + +Note that threading support was built into the debugger as of Perl version +C<5.8.6> and debugger version C<1.2.8>. + +=cut + +BEGIN { + # ensure we can share our non-threaded variables or no-op + if ($ENV{PERL5DB_THREADED}) { + require threads; + require threads::shared; + import threads::shared qw(share); + $DBGR; + share(\$DBGR); + lock($DBGR); + print "Threads support enabled\n"; + } else { + *lock = sub(*) {}; + *share = sub(*) {}; + } +} + # This would probably be better done with "use vars", but that wasn't around # when this code was originally written. (Neither was "use strict".) And on # the principle of not fiddling with something that was working, this was # left alone. warn( # Do not ;-) - # These variables control the execution of 'dumpvar.pl'. + # These variables control the execution of 'dumpvar.pl'. $dumpvar::hashDepth, $dumpvar::arrayDepth, $dumpvar::dumpDBFiles, @@ -987,6 +1032,10 @@ warn( # Do not ;-) ) if 0; +foreach my $k (keys (%INC)) { + &share(\$main::{'_<'.$filename}); +}; + # Command-line + PERLLIB: # Save the contents of @INC before they are modified elsewhere. @ini_INC = @INC; @@ -1154,6 +1203,17 @@ $pretype = [] unless defined $pretype; $CreateTTY = 3 unless defined $CreateTTY; $CommandSet = '580' unless defined $CommandSet; +share($rl); +share($warnLevel); +share($dieLevel); +share($signalLevel); +share($pre); +share($post); +share($pretype); +share($rl); +share($CreateTTY); +share($CommandSet); + =pod The default C, C, and C handlers are set up. @@ -1429,6 +1489,11 @@ if ( exists $ENV{PERLDB_RESTART} ) { %break_on_load = get_list("PERLDB_ON_LOAD"); %postponed = get_list("PERLDB_POSTPONE"); + share(@hist); + share(@truehist); + share(%break_on_load); + share(%postponed); + # restore breakpoints/actions my @had_breakpoints = get_list("PERLDB_VISITED"); for ( 0 .. $#had_breakpoints ) { @@ -1465,6 +1530,7 @@ to be anyone there to enter commands. if ($notty) { $runnonstop = 1; + share($runnonstop); } =pod @@ -1678,6 +1744,8 @@ and if we can. # and a I/O description to keep track of. $LINEINFO = $OUT unless defined $LINEINFO; $lineinfo = $console unless defined $lineinfo; + # share($LINEINFO); # <- unable to share globs + share($lineinfo); # =pod @@ -1746,6 +1814,13 @@ see what's happening in any given command. sub DB { + # lock the debugger and get the thread id for the prompt + lock($DBGR); + my $tid; + if ($ENV{PERL5DB_THREADED}) { + $tid = eval { "[".threads->self->tid."]" }; + } + # Check for whether we should be running continuously or not. # _After_ the perl program is compiled, $single is set to 1: if ( $single and not $second_time++ ) { @@ -2114,7 +2189,7 @@ the new command. This is faster, but perhaps a bit more convoluted. # ... and we got a line of command input ... defined( $cmd = &readline( - "$pidprompt DB" + "$pidprompt $tid DB" . ( '<' x $level ) . ( $#hist + 1 ) . ( '>' x $level ) . " " @@ -2123,6 +2198,7 @@ the new command. This is faster, but perhaps a bit more convoluted. ) { + share($cmd); # ... try to execute the input as debugger commands. # Don't stop running. @@ -2153,6 +2229,8 @@ it up. chomp($cmd); # get rid of the annoying extra newline push( @hist, $cmd ) if length($cmd) > 1; push( @truehist, $cmd ); + share(@hist); + share(@truehist); # This is a restart point for commands that didn't arrive # via direct user input. It allows us to 'redo PIPE' to @@ -2461,7 +2539,7 @@ deal with them instead of processing them in-line. # All of these commands were remapped in perl 5.8.0; # we send them off to the secondary dispatcher (see below). - $cmd =~ /^([aAbBhilLMoOPvwW]\b|[<>\{]{1,2})\s*(.*)/so && do { + $cmd =~ /^([aAbBeEhilLMoOPvwW]\b|[<>\{]{1,2})\s*(.*)/so && do { &cmd_wrapper( $1, $2, $line ); next CMD; }; @@ -3500,10 +3578,16 @@ arguments with which the subroutine was invoked sub sub { + # lock ourselves under threads + lock($DBGR); + # Whether or not the autoloader was running, a scalar to put the # sub's return value in (if needed), and an array to put the sub's # return value in (if needed). my ( $al, $ret, @ret ) = ""; + if ($sub =~ /^threads::new$/ && $ENV{PERL5DB_THREADED}) { + print "creating new thread\n"; + } # If the last ten characters are C'::AUTOLOAD', note we've traced # into AUTOLOAD for $sub. @@ -4506,6 +4590,53 @@ sub cmd_stop { # As on ^C, but not signal-safy. $signal = 1; } +=head3 C - threads + +Display the current thread id: + + e + +This could be how (when implemented) to send commands to this thread id (e cmd) +or that thread id (e tid cmd). + +=cut + +sub cmd_e { + my $cmd = shift; + my $line = shift; + unless (exists($INC{'threads.pm'})) { + print "threads not loaded($ENV{PERL5DB_THREADED}) + please run the debugger with PERL5DB_THREADED=1 set in the environment\n"; + } else { + my $tid = threads->self->tid; + print "thread id: $tid\n"; + } +} ## end sub cmd_e + +=head3 C - list of thread ids + +Display the list of available thread ids: + + E + +This could be used (when implemented) to send commands to all threads (E cmd). + +=cut + +sub cmd_E { + my $cmd = shift; + my $line = shift; + unless (exists($INC{'threads.pm'})) { + print "threads not loaded($ENV{PERL5DB_THREADED}) + please run the debugger with PERL5DB_THREADED=1 set in the environment\n"; + } else { + my $tid = threads->self->tid; + print "thread ids: ".join(', ', + map { ($tid == $_->tid ? '<'.$_->tid.'>' : $_->tid) } threads->list + )."\n"; + } +} ## end sub cmd_E + =head3 C - help command (command) Does the work of either @@ -6959,6 +7090,8 @@ B I Evals expression in list context, prints methods callable B I Prints methods callable via the given class. B Show versions of loaded modules. B I Prints nested parents of given class. +B Display current thread id. +B Display all thread ids the current one will be identified: . B [I [I]] List lexicals in higher scope . Vars same as B. B

Something to do with assertions... @@ -7076,6 +7209,7 @@ I B Execute perl code, also see: B,B,B B [I [I]] List Variables in Package. Vars can be ~pattern or !pattern. B [I] Same as \"B I [I]\". B I inheritance tree. B [I [I]] List lexicals in higher scope . Vars same as B. + B Display thread id B Display all thread ids. For more help, type B I, or run B<$doccmd perldebug> for all docs. END_SUM diff --git a/perl.c b/perl.c index 5321758..dba06b2 100644 --- a/perl.c +++ b/perl.c @@ -2504,6 +2504,13 @@ Perl_moreswitches(pTHX_ char *s) case 'd': forbid_setid("-d"); s++; + + /* -dt indicates to the debugger that threads will be used */ + if (*s == 't' && !isALNUM(s[1])) { + ++s; + my_setenv("PERL5DB_THREADED", "1"); + } + /* The following permits -d:Mod to accepts arguments following an = in the fashion that -MSome::Mod does. */ if (*s == ':' || *s == '=') { diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 3cc8d3d..1d0d55b 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -6,7 +6,7 @@ perlrun - how to execute the Perl interpreter B S<[ B<-sTtuUWX> ]> S<[ B<-hv> ] [ B<-V>[:I] ]> - S<[ B<-cw> ] [ B<-d>[:I] ] [ B<-D>[I] ]> + S<[ B<-cw> ] [ B<-d>[B][:I] ] [ B<-D>[I] ]> S<[ B<-pna> ] [ B<-F>I ] [ B<-l>[I] ] [ B<-0>[I] ]> S<[ B<-I>I

] [ B<-m>[B<->]I ] [ B<-M>[B<->]I<'module...'> ]> S<[ B<-P> ]> @@ -342,16 +342,24 @@ be skipped. =item B<-d> +=item B<-dt> + runs the program under the Perl debugger. See L. +If B is specified, it indicates to the debugger that threads +will be used in the code being debugged. =item B<-d:>I +=item B<-dt:>I + runs the program under the control of a debugging, profiling, or tracing module installed as Devel::foo. E.g., B<-d:DProf> executes the program using the Devel::DProf profiler. As with the B<-M> flag, options may be passed to the Devel::foo package where they will be received and interpreted by the Devel::foo::import routine. The comma-separated list of options must follow a C<=> character. +If B is specified, it indicates to the debugger that threads +will be used in the code being debugged. See L. =item B<-D>I @@ -1095,6 +1103,11 @@ The command used to load the debugger code. The default is: BEGIN { require 'perl5db.pl' } +=item PERL5DB_THREADED + +If set to a true value, indicates to the debugger that the code being +debugged uses threads. + =item PERL5SHELL (specific to the Win32 port) May be set to an alternative shell that perl must use internally for