vms/ext/Stdio/test.pl

   1 # Tests for VMS::Stdio v2.2
   2 use VMS::Stdio;
   3 import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam);
   4
   5 print "1..18\n";
   6 print +(defined(&getname) ? '' : 'not '), "ok 1\n";
   7
   8 #VMS can pretend that it is UNIX.
   9 my $perl = $^X;
  10 $perl = VMS::Filespec::vmsify($perl) if $^O eq 'VMS';
  11
  12 $name = "test$$";
  13 $name++ while -e "$name.tmp";
  14 $fh = VMS::Stdio::vmsopen("+>$name",'ctx=rec','shr=put','fop=dlt','dna=.tmp');
  15 print +($fh ? '' : 'not '), "ok 2\n";
  16
  17 print +(flush($fh) ? '' : 'not '),"ok 3\n";
  18 print +(sync($fh) ? '' : 'not '),"ok 4\n";
  19
  20 $time = (stat("$name.tmp"))[9];
  21 print +($time ? '' : 'not '), "ok 5\n";
  22
  23 $fh->autoflush;  # Can we autoload autoflush from IO::File?  Do or die.
  24 print "ok 6\n";
  25
  26 print 'not ' unless print $fh scalar(localtime($time)),"\n";
  27 print "ok 7\n";
  28
  29 print +(rewind($fh) ? '' : 'not '),"ok 8\n";
  30
  31 chop($line = <$fh>);
  32 print +($line eq localtime($time) ? '' : 'not '), "ok 9\n";
  33
  34 ($gotname) = (getname($fh) =~/\](.*);/);
  35
  36 #we may be in UNIX emulation mode.
  37 if (!defined($gotname)) {
  38    ($gotname) = (VMS::Filespec::vmsify(getname($fh)) =~/\](.*)/);
  39 }
  40 print +("\U$gotname" eq "\U$name.tmp" ? '' : 'not '), "ok 10\n";
  41
  42 $sfh = VMS::Stdio::vmssysopen($name, O_RDONLY, 0,
  43                               'ctx=rec', 'shr=put', 'dna=.tmp');
  44 print +($sfh ? '' : 'not ($!) '), "ok 11\n";
  45
  46 close($fh);
  47 sysread($sfh,$line,24);
  48 print +($line eq localtime($time) ? '' : 'not '), "ok 12\n";
  49
  50 undef $sfh;
  51 print +(stat("$name.tmp") ? 'not ' : ''),"ok 13\n";
  52
  53 print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n";
  54
  55 #if (open(P, qq[| $^X -e "1 while (<STDIN>);print 'Foo';1 while (<STDIN>); print 'Bar'" >$name.tmp])) {
  56 #  print P "Baz\nQuux\n";
  57 #  print +(VMS::Stdio::writeof(P) ? '' : 'not '),"ok 15\n";
  58 #  print P "Baz\nQuux\n";
  59 #  print +(close(P) ? '' : ''),"ok 16\n";
  60 #  $fh = VMS::Stdio::vmsopen("$name.tmp");
  61 #  chomp($line = <$fh>);
  62 #  close $fh;
  63 #  unlink("$name.tmp");
  64 #  print +($line eq 'FooBar' ? '' : 'not '),"ok 17\n";
  65 #}
  66 #else {
  67 print "ok 15\nok 16\nok 17\n";
  68 #}
  69
  70 $sfh = VMS::Stdio::vmsopen(">$name.tmp");
  71 $setuperl = "\$ MCR $perl\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);";
  72 print $sfh qq[\$ here = F\$Environment("Default")\n];
  73 print $sfh "$setuperl\nsetdef();\n\$ Show Default\n\$ Set Default 'here'\n";
  74 print $sfh "$setuperl\nsetdef('..');\n\$ Show Default\n";
  75 close $sfh;
  76 @defs = map { /(\S+)/ && $1 } `\@$name.tmp`;
  77 unlink("$name.tmp");
  78 print +($defs[0] eq uc($ENV{'SYS$LOGIN'}) ? '' : "not ($defs[0]) "),"ok 18\n";
  79 #print +($defs[1] eq VMS::Filespec::rmsexpand('[-]') ? '' : "not ($defs[1]) "),"ok 19\n";