This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[patch] blead@25282 - VMS specific fixes. [2nd try]
[perl5.git] / vms / ext / Stdio / test.pl
CommitLineData
562a7b0c 1# Tests for VMS::Stdio v2.2
17421385 2use VMS::Stdio;
17f28c40 3import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam);
17421385 4
13789a15 5print "1..18\n";
17421385
PP
6print +(defined(&getname) ? '' : 'not '), "ok 1\n";
7
16ed4686
JM
8#VMS can pretend that it is UNIX.
9my $perl = $^X;
10$perl = VMS::Filespec::vmsify($perl) if $^O eq 'VMS';
11
17421385
PP
12$name = "test$$";
13$name++ while -e "$name.tmp";
14$fh = VMS::Stdio::vmsopen("+>$name",'ctx=rec','shr=put','fop=dlt','dna=.tmp');
15print +($fh ? '' : 'not '), "ok 2\n";
16
17print +(flush($fh) ? '' : 'not '),"ok 3\n";
18print +(sync($fh) ? '' : 'not '),"ok 4\n";
19
20$time = (stat("$name.tmp"))[9];
21print +($time ? '' : 'not '), "ok 5\n";
22
5f05dabc 23$fh->autoflush; # Can we autoload autoflush from IO::File? Do or die.
17421385
PP
24print "ok 6\n";
25
5f05dabc
PP
26print 'not ' unless print $fh scalar(localtime($time)),"\n";
27print "ok 7\n";
28
29print +(rewind($fh) ? '' : 'not '),"ok 8\n";
17421385
PP
30
31chop($line = <$fh>);
5f05dabc 32print +($line eq localtime($time) ? '' : 'not '), "ok 9\n";
17421385
PP
33
34($gotname) = (getname($fh) =~/\](.*);/);
16ed4686
JM
35
36#we may be in UNIX emulation mode.
37if (!defined($gotname)) {
38 ($gotname) = (VMS::Filespec::vmsify(getname($fh)) =~/\](.*)/);
39}
ab6cc5a9 40print +("\U$gotname" eq "\U$name.tmp" ? '' : 'not '), "ok 10\n";
17421385
PP
41
42$sfh = VMS::Stdio::vmssysopen($name, O_RDONLY, 0,
43 'ctx=rec', 'shr=put', 'dna=.tmp');
5f05dabc 44print +($sfh ? '' : 'not ($!) '), "ok 11\n";
17421385
PP
45
46close($fh);
47sysread($sfh,$line,24);
5f05dabc 48print +($line eq localtime($time) ? '' : 'not '), "ok 12\n";
17421385
PP
49
50undef $sfh;
5f05dabc 51print +(stat("$name.tmp") ? 'not ' : ''),"ok 13\n";
17421385 52
5f05dabc 53print +(&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
HM
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 {
67print "ok 15\nok 16\nok 17\n";
68#}
17f28c40
CB
69
70$sfh = VMS::Stdio::vmsopen(">$name.tmp");
16ed4686 71$setuperl = "\$ MCR $perl\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);";
17f28c40
CB
72print $sfh qq[\$ here = F\$Environment("Default")\n];
73print $sfh "$setuperl\nsetdef();\n\$ Show Default\n\$ Set Default 'here'\n";
74print $sfh "$setuperl\nsetdef('..');\n\$ Show Default\n";
75close $sfh;
76@defs = map { /(\S+)/ && $1 } `\@$name.tmp`;
77unlink("$name.tmp");
78print +($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";