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