In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/1db7f4540e5219c38ecb174e90623710eeb074e2?hp=3b1dc57237c81111c1e0c7f0074e8f20bd277f0c>

- Log -----------------------------------------------------------------
commit 1db7f4540e5219c38ecb174e90623710eeb074e2
Author: Ricardo Signes <[email protected]>
Date:   Sat Mar 16 13:42:28 2013 -0400

    bump version on perl5db.pl

M       lib/perl5db.pl

commit 90fd4c80cc786031a8e6f216b3257a69826f7c8f
Author: Kent Fredric <[email protected]>
Date:   Thu Mar 14 05:17:38 2013 +1300

    lib/perl5db.pl: Workaround rt#116771 by putting DB::Obj inside BEGIN { }

M       lib/perl5db.pl

commit ddd6e33953565b51a20d977ac0d6906add39d3cd
Author: Kent Fredric <[email protected]>
Date:   Thu Feb 21 22:44:04 2013 +1300

    lib/perl5db.t: Add test for bug #116771, autotrace crashes debugger

M       lib/perl5db.t

commit a7d38e6724921b9571a1a95309ad208d35d09d34
Author: Kent Fredric <[email protected]>
Date:   Thu Feb 21 22:41:48 2013 +1300

    lib/perl5db.t: Add test for bug #116769, Frame=2 crashes debugger

M       lib/perl5db.t

commit e004740654087442e0270a2f9b650489ebb9b4e0
Author: Kent Fredric <[email protected]>
Date:   Fri Feb 15 23:24:56 2013 +1300

    lib/perl5db.pl: refactor all calls to IO::Handle via ->autoflush to a short 
local function.
    
    This hopefully resovles 
https://rt.perl.org/rt3/Ticket/Display.html?id=116769
    and any issue similar to that which I may not have been unlucky enough
    to fall upon.

M       lib/perl5db.pl
-----------------------------------------------------------------------

Summary of changes:
 lib/perl5db.pl |   35 +++++++++++++++++++++++++++++------
 lib/perl5db.t  |   16 +++++++++++++++-
 2 files changed, 44 insertions(+), 7 deletions(-)

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index 54d6622..85a5ef4 100644
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -523,7 +523,7 @@ BEGIN {
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 use vars qw($VERSION $header);
 
-$VERSION = '1.39_08';
+$VERSION = '1.39_09';
 
 $header = "perl5db.pl version $VERSION";
 
@@ -1472,6 +1472,15 @@ use vars qw($lineinfo $doccmd);
 
 our ($runnonstop);
 
+# Local autoflush to avoid rt#116769,
+# as calling IO::File methods causes an unresolvable loop
+# that results in debugger failure.
+sub _autoflush {
+    my $o = select($_[0]);
+    $|++;
+    select($o);
+}
+
 if ($notty) {
     $runnonstop = 1;
     share($runnonstop);
@@ -1655,7 +1664,7 @@ and if we can.
     } ## end elsif (from if(defined $remoteport))
 
     # Unbuffer DB::OUT. We need to see responses right away.
-    $OUT->autoflush(1);
+    _autoflush($OUT);
 
     # Line info goes to debugger output unless pointed elsewhere.
     # Pointing elsewhere makes it possible for slave editors to
@@ -2324,7 +2333,7 @@ sub _DB__handle_run_command_in_pager_command {
         if $pager =~ /^\|/
         && ( "" eq $SIG{PIPE} || "DEFAULT" eq $SIG{PIPE} );
 
-        OUT->autoflush(1);
+        _autoflush(\*OUT);
         # Save current filehandle, and put it back.
         $obj->selected(scalar( select(OUT) ));
         # Don't put it back if pager was a pipe.
@@ -3128,6 +3137,18 @@ again.
     ();
 } ## end sub DB
 
+# Because DB::Obj is used above,
+#
+#   my $obj = DB::Obj->new(
+#
+# The following package declaraton must come before that,
+# or else runtime errors will occur with
+#
+#   PERLDB_OPTS="autotrace nonstop"
+#
+# ( rt#116771 )
+BEGIN {
+
 package DB::Obj;
 
 sub new {
@@ -3942,6 +3963,8 @@ sub _handle_special_char_cmd_wrapper_commands {
     return;
 }
 
+} ## end DB::Obj
+
 package DB;
 
 # The following code may be executed now:
@@ -6757,7 +6780,7 @@ sub setterm {
             open( OUT, ">$o" ) or die "Cannot open TTY '$o' for write: $!";
             $IN  = \*IN;
             $OUT = \*OUT;
-            $OUT->autoflush(1);
+            _autoflush($OUT);
         } ## end if ($tty)
 
         # We don't have a TTY - try to find one via Term::Rendezvous.
@@ -7592,7 +7615,7 @@ sub reset_IN_OUT {
     }
 
     # Unbuffer the output filehandle.
-    $OUT->autoflush(1);
+    _autoflush($OUT);
 
     # Point LINEINFO to the same output filehandle if it was there before.
     $LINEINFO = $OUT if $switch_li;
@@ -7870,7 +7893,7 @@ sub LineInfo {
         open ($new_lineinfo_fh , $stream )
             or _db_warn("Cannot open '$stream' for write");
         $LINEINFO = $new_lineinfo_fh;
-        $LINEINFO->autoflush(1);
+        _autoflush($LINEINFO);
     }
 
     return $lineinfo;
diff --git a/lib/perl5db.t b/lib/perl5db.t
index 174554f..fe1031b 100644
--- a/lib/perl5db.t
+++ b/lib/perl5db.t
@@ -28,7 +28,7 @@ BEGIN {
     }
 }
 
-plan(109);
+plan(113);
 
 my $rc_filename = '.perldb';
 
@@ -93,6 +93,20 @@ EOF
     my $output = runperl(switches => [ '-d' ], stderr => 1, progfile => 
'../lib/perl5db/t/rt-66110');
     like($output, "All tests successful.", "[perl #66110]");
 }
+# [ perl #116769] Frame=2
+{
+    local $ENV{PERLDB_OPTS} = "frame=2 nonstop";
+    my $output = runperl( switches => [ '-d' ], prog => 'print q{success}' );
+    is( $?, 0, '[perl #116769] frame=2 does not crash debugger, exit == 0' );
+    like( $output, 'success' , '[perl #116769] code is run' );
+}
+# [ perl #116771] autotrace
+{
+    local $ENV{PERLDB_OPTS} = "autotrace nonstop";
+    my $output = runperl( switches => [ '-d' ], prog => 'print q{success}' );
+    is( $?, 0, '[perl #116771] autotrace does not crash debugger, exit == 0' );
+    like( $output, 'success' , '[perl #116771] code is run' );
+}
 
 {
     rc(<<'EOF');

--
Perl5 Master Repository

Reply via email to