summaryrefslogtreecommitdiff
path: root/lib/perl5db.pl
diff options
context:
space:
mode:
authorShlomi Fish <shlomif@shlomifish.org>2012-10-25 18:29:25 +0200
committerRicardo Signes <rjbs@cpan.org>2012-11-12 09:18:43 -0500
commit262f8b4426598d4913879868f15121818fb9aa15 (patch)
tree69e382e86a55585ba68161cdb0c525bf9590d6bb /lib/perl5db.pl
parentf0bb1409d3a96da8777153c52a5b3c526d682d7f (diff)
downloadperl-262f8b4426598d4913879868f15121818fb9aa15.tar.gz
Extract a closure.
Diffstat (limited to 'lib/perl5db.pl')
-rw-r--r--lib/perl5db.pl50
1 files changed, 25 insertions, 25 deletions
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 99542a2d41..87650b30be 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -4031,6 +4031,7 @@ use vars qw($deep);
# We need to fully qualify the name ("DB::sub") to make "use strict;"
# happy. -- Shlomi Fish
+
sub DB::sub {
# Do not use a regex in this subroutine -> results in corrupted memory
# See: [perl #66110]
@@ -4090,6 +4091,23 @@ sub DB::sub {
)
if $frame;
+ my $print_exit_msg = sub {
+ # Check for exit trace messages...
+ if ($frame & 2)
+ {
+ if ($frame & 4) # Extended exit message
+ {
+ print_lineinfo( ' ' x $stack_depth, "out " );
+ print_trace( $LINEINFO, 0, 1, 1, "$sub$al" );
+ }
+ else
+ {
+ print_lineinfo( ' ' x $stack_depth, "exited $sub$al\n" );
+ }
+ }
+ return;
+ };
+
# Determine the sub's return type, and capture appropriately.
if (wantarray) {
@@ -4104,18 +4122,7 @@ sub DB::sub {
# Pop the single-step value back off the stack.
$single |= $stack[ $stack_depth-- ];
- # Check for exit trace messages...
- (
- $frame & 4 # Extended exit message
- ? (
- print_lineinfo( ' ' x $stack_depth, "out " ),
- print_trace( $LINEINFO, -1, 1, 1, "$sub$al" )
- )
- : print_lineinfo( ' ' x $stack_depth, "exited $sub$al\n" )
-
- # Standard exit message
- )
- if $frame & 2;
+ $print_exit_msg->();
# Print the return info if we need to.
if ( $doret eq $stack_depth or $frame & 16 ) {
@@ -4125,10 +4132,13 @@ sub DB::sub {
my $fh = ( $doret eq $stack_depth ? $OUT : $LINEINFO );
# Indent if we're printing because of $frame tracing.
- print $fh ' ' x $stack_depth if $frame & 16;
+ if ($frame & 16)
+ {
+ print {$fh} ' ' x $stack_depth;
+ }
# Print the return value.
- print $fh "list context return from $sub:\n";
+ print {$fh} "list context return from $sub:\n";
dumpit( $fh, \@ret );
# And don't print it again.
@@ -4156,17 +4166,7 @@ sub DB::sub {
$single |= $stack[ $stack_depth-- ];
# If we're doing exit messages...
- (
- $frame & 4 # Extended messages
- ? (
- print_lineinfo( ' ' x $stack_depth, "out " ),
- print_trace( $LINEINFO, -1, 1, 1, "$sub$al" )
- )
- : print_lineinfo( ' ' x $stack_depth, "exited $sub$al\n" )
-
- # Standard messages
- )
- if $frame & 2;
+ $print_exit_msg->();
# If we are supposed to show the return value... same as before.
if ( $doret eq $stack_depth or $frame & 16 and defined wantarray ) {