source: trunk/essentials/dev-lang/perl/lib/vmsish.t@ 3280

#!./perl

BEGIN {
    chdir 't' if -d 't';
    @INC = '../lib'; 
}

my $Invoke_Perl = qq(MCR $^X "-I[-.lib]");

require "./test.pl";
plan(tests => 25);

SKIP: {
    skip("tests for non-VMS only", 1) if $^O eq 'VMS';

    no utf8;

    BEGIN { $Orig_Bits = $^H }

    # make sure that all those 'use vmsish' calls didn't do anything.
    is( $Orig_Bits, $^H,    'use vmsish a no-op' );
}

SKIP: {
    skip("tests for VMS only", 24) 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");
{
  use vmsish qw(status);
  is(($? & 1),1, "importing vmsish [vmsish status]");
  {
    no vmsish qw(status); # check unimport function
    is($?,0, "unimport vmsish [POSIX STATUS]");
  }
  # and lexical scoping
  is(($? & 1),1,"lex scope of vmsish [vmsish status]");
}
is($?,0,"outer lex scope of vmsish [POSIX status]");

{
  use vmsish qw(exit);  # check import function
  is($?,0,"importing vmsish exit [POSIX status]");
}

#========== vmsish exit, messages ==========
{
  use vmsish qw(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");
  is($?&1,0,"vmsish status check, POSIX ERR exit");

  $msg = do_a_perl('-e "use vmsish qw(exit); exit 1"');
    $msg =~ s/\n/\\n/g; # keep output on one line
  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 "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");
  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 "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");

  $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 "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");

  $msg = do_a_perl('-e "use vmsish qw(exit); vmsish::hushed(1); exit 44;"');
  $msg =~ s/\n/\\n/g; # keep output on one line
  ok(($msg !~ /ABORT/),"vmsish ERR exit, vmsish hushed at runtime, DCL error message check");

  local *TEST;