This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PATCH: [perl #133997] Assert fail with script runs
[perl5.git] / lib / vmsish.t
index f40e434..7681f07 100644 (file)
@@ -10,8 +10,7 @@ $perl = VMS::Filespec::vmsify($perl) if $^O eq 'VMS';
 
 my $Invoke_Perl = qq(MCR $perl "-I[-.lib]");
 
-require "./test.pl";
-plan(tests => 25);
+use Test::More tests => 29;
 
 SKIP: {
     skip("tests for non-VMS only", 1) if $^O eq 'VMS';
@@ -25,11 +24,11 @@ SKIP: {
 }
 
 SKIP: {
-    skip("tests for VMS only", 24) unless $^O eq 'VMS';
+    skip("tests for VMS only", 28) unless $^O eq 'VMS';
 
 #========== vmsish status ==========
 `$Invoke_Perl -e 1`;  # Avoid system() from a pipe from harness.  Mutter.
-is($?,0,"simple Perl invokation: POSIX success status");
+is($?,0,"simple Perl invocation: POSIX success status");
 {
   use vmsish qw(status);
   is(($? & 1),1, "importing vmsish [vmsish status]");
@@ -53,7 +52,7 @@ is($?,0,"outer lex scope of vmsish [POSIX status]");
 
   $msg = do_a_perl('-e "exit 1"');
     $msg =~ s/\n/\\n/g; # keep output on one line
-  like($msg,'ABORT', "POSIX ERR exit, DCL error message check");
+  like($msg, qr/ABORT/, "POSIX ERR exit, DCL error message check");
   is($?&1,0,"vmsish status check, POSIX ERR exit");
 
   $msg = do_a_perl('-e "use vmsish qw(exit); exit 1"');
@@ -61,27 +60,43 @@ is($?,0,"outer lex scope of vmsish [POSIX status]");
   ok(length($msg)==0,"vmsish OK exit, DCL error message check");
   is($?&1,1, "vmsish status check, vmsish OK exit");
 
+  $msg = do_a_perl('-e "\&CORE::exit;use vmsish qw(exit);&CORE::exit(1)"');
+    $msg =~ s/\n/\\n/g; # keep output on one line
+  ok(length($msg)==0,"vmsish OK exit (via &CORE::), DCL err msg check");
+  is($?&1,1, "vmsish status check, vmsish OK exit (&CORE::exit)");
+
   $msg = do_a_perl('-e "use vmsish qw(exit); exit 44"');
     $msg =~ s/\n/\\n/g; # keep output on one line
-  like($msg, 'ABORT', "vmsish ERR exit, DCL error message check");
+  like($msg, qr/ABORT/, "vmsish ERR exit, DCL error message check");
   is($?&1,0,"vmsish ERR exit, vmsish status check");
 
   $msg = do_a_perl('-e "use vmsish qw(hushed); exit 1"');
   $msg =~ s/\n/\\n/g; # keep output on one line
   ok(($msg !~ /ABORT/),"POSIX ERR exit, vmsish hushed, DCL error message check");
 
+  $msg = do_a_perl('-e "\&CORE::exit; use vmsish qw(hushed); '
+                  .'vmsish::hushed(0); &CORE::exit 1"');
+  $msg =~ s/\n/\\n/g; # keep output on one line
+  ok(($msg !~ /ABORT/),
+   "POSIX ERR exit, vmsish hushed, DCL error message check (&CORE::exit)");
+
   $msg = do_a_perl('-e "use vmsish qw(exit hushed); exit 44"');
     $msg =~ s/\n/\\n/g; # keep output on one line
   ok(($msg !~ /ABORT/),"vmsish ERR exit, vmsish hushed, DCL error message check");
 
   $msg = do_a_perl('-e "use vmsish qw(exit hushed); no vmsish qw(hushed); exit 44"');
   $msg =~ s/\n/\\n/g; # keep output on one line
-  like($msg,'ABORT',"vmsish ERR exit, no vmsish hushed, DCL error message check");
+  like($msg, qr/ABORT/,"vmsish ERR exit, no vmsish hushed, DCL error message check");
 
   $msg = do_a_perl('-e "use vmsish qw(hushed); die(qw(blah));"');
   $msg =~ s/\n/\\n/g; # keep output on one line
   ok(($msg !~ /ABORT/),"die, vmsish hushed, DCL error message check");
 
+  $msg = do_a_perl('-e "\&CORE::die; use vmsish qw(hushed); '
+                  .'vmsish::hushed(0); &CORE::die(qw(blah));"');
+  $msg =~ s/\n/\\n/g; # keep output on one line
+  ok(($msg !~ /ABORT/),"&CORE::die, vmsish hushed, DCL error msg check");
+
   $msg = do_a_perl('-e "use vmsish qw(hushed); use Carp; croak(qw(blah));"');
   $msg =~ s/\n/\\n/g; # keep output on one line
   ok(($msg !~ /ABORT/),"croak, vmsish hushed, DCL error message check");
@@ -91,7 +106,7 @@ is($?,0,"outer lex scope of vmsish [POSIX status]");
   ok(($msg !~ /ABORT/),"vmsish ERR exit, vmsish hushed at runtime, DCL error message check");
 
   local *TEST;
-  open(TEST,'>vmsish_test.pl') || die('not ok ?? : unable to open "vmsish_test.pl" for writing');  
+  open(TEST,'>','vmsish_test.pl') || die('not ok ?? : unable to open "vmsish_test.pl" for writing');  
   print TEST "#! perl\n";
   print TEST "use vmsish qw(hushed);\n";
   print TEST "\$obvious = (\$compile(\$error;\n";
@@ -122,12 +137,12 @@ is($?,0,"outer lex scope of vmsish [POSIX status]");
   # we create a file rather than using an existing one for the stat() test.
 
   my $file = 'sys$scratch:vmsish_t_flirble.tmp';
-  open TMP, ">$file" or die "Couldn't open file $file";
+  open TMP, '>', $file or die "Couldn't open file $file";
   close TMP;
   END { 1 while unlink $file; }
 
   {
-     use_ok('vmsish qw(time)');
+     use_ok('vmsish', 'time');
 
      # but that didn't get it in our current scope
      use vmsish qw(time);
@@ -172,7 +187,7 @@ is($?,0,"outer lex scope of vmsish [POSIX status]");
 #       they were turned off in invoking procedure
 sub do_a_perl {
     local *P;
-    open(P,'>vmsish_test.com') || die('not ok ?? : unable to open "vmsish_test.com" for writing');
+    open(P,'>','vmsish_test.com') || die('not ok ?? : unable to open "vmsish_test.com" for writing');
     print P "\$ set message/facil/sever/ident/text\n";
     print P "\$ define/nolog/user sys\$error _nla0:\n";
     print P "\$ $Invoke_Perl @_\n";