This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[patch]perl5db.pl, perl5db.t - LINUX/UNIX/CYGWIN/VMS
authorJohn E. Malmberg <wb8tyw@qsl.net>
Mon, 28 Apr 2008 00:39:16 +0000 (19:39 -0500)
committerRafael Garcia-Suarez <rgarciasuarez@gmail.com>
Wed, 30 Apr 2008 11:56:36 +0000 (11:56 +0000)
From: "John E. Malmberg" <wb8tyw@qsl.net>
Message-id: <48156304.30201@qsl.net>

p4raw-id: //depot/perl@33771

lib/perl5db.pl
lib/perl5db.t

index 2167f78..40d2361 100644 (file)
@@ -1363,7 +1363,9 @@ running interactively, this is C<.perldb>; if not, it's C<perldb.ini>.
 # As noted, this test really doesn't check accurately that the debugger
 # is running at a terminal or not.
 
-if ( -e "/dev/tty" ) {                      # this is the wrong metric!
+my $dev_tty = '/dev/tty';
+   $dev_tty = 'TT:' if ($^O eq 'VMS');
+if ( -e $dev_tty ) {                      # this is the wrong metric!
     $rcfile = ".perldb";
 }
 else {
@@ -6100,6 +6102,16 @@ qq[3>&1 xterm -title "Daughter Perl debugger $pids $name" -e sh -c 'tty 1>&3;\
 
     $pidprompt = '';    # Shown anyway in titlebar
 
+    # We need $term defined or we can not switch to the newly created xterm
+    if ($tty ne '' && !defined $term) {
+        eval { require Term::ReadLine } or die $@;
+        if ( !$rl ) {
+            $term = new Term::ReadLine::Stub 'perldb', $IN, $OUT;
+        }
+        else {
+            $term = new Term::ReadLine 'perldb', $IN, $OUT;
+        }
+    }
     # There's our new TTY.
     return $tty;
 } ## end sub xterm_get_fork_TTY
@@ -6766,18 +6778,6 @@ we go ahead and set C<$console> and C<$tty> to the file indicated.
 
 sub TTY {
 
-    # With VMS we can get here with $term undefined, so we do not
-    # switch to this terminal.  There may be a better place to make
-    # sure that $term is defined on VMS
-    if ( @_ and ($^O eq 'VMS') and !defined($term) ) {
-       eval { require Term::ReadLine } or die $@;
-        if ( !$rl ) {
-           $term = new Term::ReadLine::Stub 'perldb', $IN, $OUT;
-       }
-       else {
-           $term = new Term::ReadLine 'perldb', $IN, $OUT;
-       }
-    }
     if ( @_ and $term and $term->Features->{newTTY} ) {
 
         # This terminal supports switching to a new TTY.
index 4553e02..12a090a 100644 (file)
@@ -14,8 +14,10 @@ BEGIN {
        print "1..0 # Skip: no /dev/null\n";
        exit 0;
     }
-    if (!-c "/dev/tty") {
-       print "1..0 # Skip: no /dev/tty\n";
+my $dev_tty = '/dev/tty';
+   $dev_tty = 'TT:' if ($^O eq 'VMS');
+    if (!-c $dev_tty) {
+       print "1..0 # Skip: no $dev_tty\n";
        exit 0;
     }
 }