Commit | Line | Data |
562a7b0c |
1 | # Tests for VMS::Stdio v2.2 |
17421385 |
2 | use VMS::Stdio; |
17f28c40 |
3 | import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam); |
17421385 |
4 | |
13789a15 |
5 | print "1..18\n"; |
17421385 |
6 | print +(defined(&getname) ? '' : 'not '), "ok 1\n"; |
7 | |
16ed4686 |
8 | #VMS can pretend that it is UNIX. |
9 | my $perl = $^X; |
10 | $perl = VMS::Filespec::vmsify($perl) if $^O eq 'VMS'; |
11 | |
17421385 |
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 | |
5f05dabc |
23 | $fh->autoflush; # Can we autoload autoflush from IO::File? Do or die. |
17421385 |
24 | print "ok 6\n"; |
25 | |
5f05dabc |
26 | print 'not ' unless print $fh scalar(localtime($time)),"\n"; |
27 | print "ok 7\n"; |
28 | |
29 | print +(rewind($fh) ? '' : 'not '),"ok 8\n"; |
17421385 |
30 | |
31 | chop($line = <$fh>); |
5f05dabc |
32 | print +($line eq localtime($time) ? '' : 'not '), "ok 9\n"; |
17421385 |
33 | |
34 | ($gotname) = (getname($fh) =~/\](.*);/); |
16ed4686 |
35 | |
36 | #we may be in UNIX emulation mode. |
37 | if (!defined($gotname)) { |
38 | ($gotname) = (VMS::Filespec::vmsify(getname($fh)) =~/\](.*)/); |
39 | } |
ab6cc5a9 |
40 | print +("\U$gotname" eq "\U$name.tmp" ? '' : 'not '), "ok 10\n"; |
17421385 |
41 | |
42 | $sfh = VMS::Stdio::vmssysopen($name, O_RDONLY, 0, |
43 | 'ctx=rec', 'shr=put', 'dna=.tmp'); |
5f05dabc |
44 | print +($sfh ? '' : 'not ($!) '), "ok 11\n"; |
17421385 |
45 | |
46 | close($fh); |
47 | sysread($sfh,$line,24); |
5f05dabc |
48 | print +($line eq localtime($time) ? '' : 'not '), "ok 12\n"; |
17421385 |
49 | |
50 | undef $sfh; |
5f05dabc |
51 | print +(stat("$name.tmp") ? 'not ' : ''),"ok 13\n"; |
17421385 |
52 | |
5f05dabc |
53 | print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n"; |
17f28c40 |
54 | |
16ed4686 |
55 | #if (open(P, qq[| $^X -e "1 while (<STDIN>);print 'Foo';1 while (<STDIN>); print 'Bar'" >$name.tmp])) { |
13789a15 |
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 | #} |
17f28c40 |
69 | |
70 | $sfh = VMS::Stdio::vmsopen(">$name.tmp"); |
16ed4686 |
71 | $setuperl = "\$ MCR $perl\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);"; |
17f28c40 |
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"; |
13789a15 |
79 | #print +($defs[1] eq VMS::Filespec::rmsexpand('[-]') ? '' : "not ($defs[1]) "),"ok 19\n"; |