@INC = '../lib';
}
-my $Invoke_Perl = qq(MCR $^X "-I[-.lib]");
+my $perl = $^X;
+$perl = VMS::Filespec::vmsify($perl) if $^O eq 'VMS';
-require "./test.pl";
-plan(tests => 25);
+my $Invoke_Perl = qq(MCR $perl "-I[-.lib]");
+
+use Test::More tests => 29;
SKIP: {
skip("tests for non-VMS only", 1) if $^O eq 'VMS';
}
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]");
$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"');
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");
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";
eval "END { \$ENV{'SYS\$TIMEZONE_DIFFERENTIAL'} = $oldtz; }";
gmtime(0); # Force reset of tz offset
}
- # This test script might have been invoked in at least one of four different ways:
- # perl lib/vmsish.t
- # perl [.lib]vmsish.t
- # set def [.t] && perl ../lib/vmsish.t
- # set def [.t] && perl [-.lib]vmsish.t
- # In the following we attempt to find ourselves without resorting to VMS::Filespec.
- # Note that the chdir in the BEGIN block above complicates matters.
- my $self = $0;
- if ( ! -e $self && -e "../$0" ) { $self = "../$0"; }
- if ( ! -e $self ) {
- $self =~ s/\[//;
- $self = "[-$self";
- }
+
+ # Unless we are prepared to parse the timezone rules here and figure out
+ # what the correct offset was when the file was last revised, we need to
+ # use a file for which the current offset is known to be valid. That's why
+ # 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";
+ 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);
$vmstime = time;
@vmslocal = localtime($vmstime);
@vmsgmtime = gmtime($vmstime);
- $vmsmtime = (stat $self)[9];
+ $vmsmtime = (stat $file)[9];
}
$utctime = time;
@utclocal = localtime($vmstime);
@utcgmtime = gmtime($vmstime);
- $utcmtime = (stat $self)[9];
+ $utcmtime = (stat $file)[9];
$offset = $ENV{'SYS$TIMEZONE_DIFFERENTIAL'};
# 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";