This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Win32 is playing to hard to get but I do not have
[perl5.git] / lib / perl5db / de0.t
index d626dd4..989c92e 100644 (file)
@@ -1,16 +1,13 @@
 #!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*-
 
 BEGIN {
-    require Config; import Config;
-    if (!$Config{'d_fork'}
-       # open2/3 supported on win32 (but not Borland due to CRT bugs)
-       && (($^O ne 'MSWin32' && $^O ne 'NetWare') || $Config{'cc'} =~ /^bcc/i))
-    {
-       print "1..0\n";
-       exit 0;
-    }
     chdir 't' if -d 't';
     @INC = '../lib';
+    require Config; import Config;
+    if ($^O eq 'VMS') {
+       print "1..0 # skip on $^O, no piped open\n";
+        exit 0;
+    }
     $ENV{PERL5LIB} = '../lib';    # so children will see it too
 }
 
@@ -43,20 +40,21 @@ for (@prgs){
     my($prog,$expected) = split(/\nEXPECT\n?/, $_);
     print $wtrfh $prog, "\n";
     my $got;
-    while (not defined $got) {
-       while ($ios->can_read(0.25)) {
-           sysread $rdrfh, $got, 1024, length($got);
-       }
+    while ($ios->can_read(0.25)) {
+       last unless sysread $rdrfh, $got, 1024, length($got);
     }
-    $got =~ s/^\s*Loading.*\nEditor.*\n\nEnter.*\n\nmain::\(-e:1\):\s0\n//;
-    unless (defined $ornament1) {
-         $got =~ s/^\s*Loading.*\nEditor.*\n\nEnter.*\n\nmain::\(-e:1\):\s0\n//;
-         ($ornament1,$ornament2) = $got =~
-             /(.*?)0\s+'reserved example for calibrating the ornaments'\n(.*)/
+    SKIP: {
+       skip("failed to read debugger", 1) unless defined $got;
+       $got =~ s/^\s*Loading.*\r?\n?Editor.*\r?\n?\r?\n?Enter.*\r?\n?\r?\n?main::\(-e:1\):\s+0\r?\n?//;
+       unless (defined $ornament1) {
+           $got =~ s/^\s*Loading.*\r?\n?Editor.*\r?\n?\r?\n?Enter.*\r?\n?\r?\n?main::\(-e:1\):\s+0\r?\n?//;
+           ($ornament1,$ornament2) = $got =~
+               /(.*?)0\s+'reserved example for calibrating the ornaments'\r?\n?(.*)/
+           }
+       $got =~ s/^\Q$ornament1\E//;
+       $got =~ s/\Q$ornament2\E\z//;
+       like($got, qr:$expected:i, $prog);
     }
-    $got =~ s/^\Q$ornament1\E//;
-    $got =~ s/\Q$ornament2\E\z//;
-    like($got, qr:$expected:i, $prog);
 }
 
 __END__