Skip Carp tests on VMS.

[perl5.git] / dist / Carp / t / Carp.t

diff --git a/dist/Carp/t/Carp.t b/dist/Carp/t/Carp.t
index d20ca22..06e9770 100644 (file)
--- a/dist/Carp/t/Carp.t
+++ b/dist/Carp/t/Carp.t
@@ -3,7 +3,7 @@ no warnings "once";
 use Config;
 
 use IPC::Open3 1.0103 qw(open3);
-use Test::More tests => 59;
+use Test::More tests => 60;
 
 sub runperl {
     my(%args) = @_;
@@ -29,7 +29,7 @@ BEGIN {
 
 {
     local $SIG{__WARN__} = sub {
-        like $_[0], qr/ok (\d+)\n at.+\b(?i:carp\.t) line \d+$/, 'ok 2\n';
+        like $_[0], qr/ok (\d+)\n at.+\b(?i:carp\.t) line \d+\.$/, 'ok 2\n';
     };
 
     carp "ok 2\n";
@@ -37,7 +37,7 @@ BEGIN {
 
 {
     local $SIG{__WARN__} = sub {
-        like $_[0], qr/(\d+) at.+\b(?i:carp\.t) line \d+$/, 'carp 3';
+        like $_[0], qr/(\d+) at.+\b(?i:carp\.t) line \d+\.$/, 'carp 3';
     };
 
     carp 3;
@@ -46,7 +46,7 @@ BEGIN {
 sub sub_4 {
     local $SIG{__WARN__} = sub {
         like $_[0],
-            qr/^(\d+) at.+\b(?i:carp\.t) line \d+\n\tmain::sub_4\(\) called at.+\b(?i:carp\.t) line \d+$/,
+            qr/^(\d+) at.+\b(?i:carp\.t) line \d+\.\n\tmain::sub_4\(\) called at.+\b(?i:carp\.t) line \d+$/,
             'cluck 4';
     };
 
@@ -58,7 +58,7 @@ sub_4;
 {
     local $SIG{__DIE__} = sub {
         like $_[0],
-            qr/^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+$/,
+            qr/^(\d+) at.+\b(?i:carp\.t) line \d+\.\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+$/,
             'croak 5';
     };
 
@@ -68,7 +68,7 @@ sub_4;
 sub sub_6 {
     local $SIG{__DIE__} = sub {
         like $_[0],
-            qr/^(\d+) at.+\b(?i:carp\.t) line \d+\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+\n\tmain::sub_6\(\) called at.+\b(?i:carp\.t) line \d+$/,
+            qr/^(\d+) at.+\b(?i:carp\.t) line \d+\.\n\teval \Q{...}\E called at.+\b(?i:carp\.t) line \d+\n\tmain::sub_6\(\) called at.+\b(?i:carp\.t) line \d+$/,
             'confess 6';
     };
 
@@ -193,8 +193,8 @@ sub w { cluck @_ }
 # $Carp::Verbose;
 {
     my $aref = [
-        qr/t at \S*(?i:carp.t) line \d+/,
-        qr/t at \S*(?i:carp.t) line \d+\n\s*main::x\('t'\) called at \S*(?i:carp.t) line \d+/
+        qr/t at \S*(?i:carp.t) line \d+\./,
+        qr/t at \S*(?i:carp.t) line \d+\.\n\s*main::x\('t'\) called at \S*(?i:carp.t) line \d+/
     ];
     my $i = 0;
 
@@ -247,8 +247,8 @@ sub w { cluck @_ }
 {
     my $i    = 0;
     my $aref = [
-        qr/1234 at \S*(?i:carp.t) line \d+\n\s*main::w\(1, 2, 3, 4\) called at \S*(?i:carp.t) line \d+/,
-        qr/1234 at \S*(?i:carp.t) line \d+\n\s*main::w\(1, 2, \.\.\.\) called at \S*(?i:carp.t) line \d+/,
+        qr/1234 at \S*(?i:carp.t) line \d+\.\n\s*main::w\(1, 2, 3, 4\) called at \S*(?i:carp.t) line \d+/,
+        qr/1234 at \S*(?i:carp.t) line \d+\.\n\s*main::w\(1, 2, \.\.\.\) called at \S*(?i:carp.t) line \d+/,
     ];
 
     for (@$aref) {
@@ -266,8 +266,8 @@ sub w { cluck @_ }
 {
     my $i    = 0;
     my $aref = [
-        qr/1 at \S*(?i:carp.t) line \d+\n\s*main::w\(1\) called at \S*(?i:carp.t) line \d+/,
-        qr/1 at \S*(?i:carp.t) line \d+$/,
+        qr/1 at \S*(?i:carp.t) line \d+\.\n\s*main::w\(1\) called at \S*(?i:carp.t) line \d+/,
+        qr/1 at \S*(?i:carp.t) line \d+\.$/,
     ];
 
     for (@$aref) {
@@ -281,8 +281,9 @@ sub w { cluck @_ }
     }
 }
 
+SKIP:
 {
-    local $TODO = "VMS exit status semantics don't work this way" if $Is_VMS;
+    skip "IPC::Open3::open3 needs porting", 2 if $Is_VMS;
 
     # Check that croak() and confess() don't clobber $!
     runperl(
@@ -305,7 +306,7 @@ sub cluck_undef {
 
     local $SIG{__WARN__} = sub {
         like $_[0],
-            qr/^Bang! at.+\b(?i:carp\.t) line \d+\n\tmain::cluck_undef\(0, 'undef', 2, undef, 4\) called at.+\b(?i:carp\.t) line \d+$/,
+            qr/^Bang! at.+\b(?i:carp\.t) line \d+\.\n\tmain::cluck_undef\(0, 'undef', 2, undef, 4\) called at.+\b(?i:carp\.t) line \d+$/,
             "cluck doesn't quote undef";
     };
 
@@ -392,21 +393,26 @@ SKIP: {
 
 # UTF8-flagged strings should not cause Carp to try to load modules (even
 # implicitly via utf8_heavy.pl) after a syntax error [perl #82854].
-like(
-  runperl(
-    prog => q<
-      use utf8; use strict; use Carp;
-      BEGIN { $SIG{__DIE__} = sub { Carp::croak qq(aaaaa$_[0]) } }
-      $c
-    >,
-    stderr=>1,
-  ),
-  qr/aaaaa/,
-  'Carp can handle UTF8-flagged strings after a syntax error',
-);
+SKIP:
+{
+    skip "IPC::Open3::open3 needs porting", 1 if $Is_VMS;
+    like(
+      runperl(
+        prog => q<
+          use utf8; use strict; use Carp;
+          BEGIN { $SIG{__DIE__} = sub { Carp::croak qq(aaaaa$_[0]) } }
+          $c
+        >,
+        stderr=>1,
+      ),
+      qr/aaaaa/,
+      'Carp can handle UTF8-flagged strings after a syntax error',
+    );
+}
 
 SKIP:
 {
+    skip "IPC::Open3::open3 needs porting", 1 if $Is_VMS;
     skip("B:: always created when static", 1)
       if $Config{static_ext} =~ /\bB\b/;
     is(
@@ -427,9 +433,26 @@ SKIP:
 <D::DATA> for 1..2;
 eval { croak 'heek' };
 $@ =~ s/\n.*//; # just check first line
-is $@, "heek at ".__FILE__." line ".(__LINE__-2).", <DATA> line 2\n",
+is $@, "heek at ".__FILE__." line ".(__LINE__-2).", <DATA> line 2.\n",
     'last handle line num is mentioned';
 
+SKIP:
+{
+    skip "IPC::Open3::open3 needs porting", 1 if $Is_VMS;
+    like(
+      runperl(
+        prog => q<
+          open FH, q-Makefile.PL-;
+          <FH>;  # set PL_last_in_gv
+          BEGIN { *CORE::GLOBAL::die = sub { die Carp::longmess(@_) } };
+          use Carp;
+          die fumpts;
+        >,
+      ),
+      qr 'fumpts',
+      'Carp::longmess works inside CORE::GLOBAL::die',
+    );
+}
 
 # New tests go here