diff options
| author | John E. Malmberg <wb8tyw@qsl.net> | 2005-08-10 19:26:03 -0400 |
|---|---|---|
| committer | H.Merijn Brand <h.m.brand@xs4all.nl> | 2005-08-11 07:35:27 +0000 |
| commit | 16ed468695c21630f18883bfbedc3d5170ddc8b2 (patch) | |
| tree | dc0fb151b14d61b21fd69a495a06aee634f4f01a /vms | |
| parent | 6cd63c21c135f707c2046a8512b70b74c3e1000c (diff) | |
| download | perl-16ed468695c21630f18883bfbedc3d5170ddc8b2.tar.gz | |
[patch] blead@25282 - VMS specific fixes. [2nd try]
From: "John E. Malmberg" <wb8tyw@qsl.net>
Message-ID: <42FAC54B.2050207@qsl.net>
p4raw-id: //depot/perl@25284
Diffstat (limited to 'vms')
| -rwxr-xr-x | vms/ext/Stdio/test.pl | 13 |
1 files changed, 11 insertions, 2 deletions
diff --git a/vms/ext/Stdio/test.pl b/vms/ext/Stdio/test.pl index 2b2f7beba4..77505d8fac 100755 --- a/vms/ext/Stdio/test.pl +++ b/vms/ext/Stdio/test.pl @@ -5,6 +5,10 @@ import VMS::Stdio qw(&flush &getname &rewind &sync &tmpnam); print "1..18\n"; print +(defined(&getname) ? '' : 'not '), "ok 1\n"; +#VMS can pretend that it is UNIX. +my $perl = $^X; +$perl = VMS::Filespec::vmsify($perl) if $^O eq 'VMS'; + $name = "test$$"; $name++ while -e "$name.tmp"; $fh = VMS::Stdio::vmsopen("+>$name",'ctx=rec','shr=put','fop=dlt','dna=.tmp'); @@ -28,6 +32,11 @@ chop($line = <$fh>); print +($line eq localtime($time) ? '' : 'not '), "ok 9\n"; ($gotname) = (getname($fh) =~/\](.*);/); + +#we may be in UNIX emulation mode. +if (!defined($gotname)) { + ($gotname) = (VMS::Filespec::vmsify(getname($fh)) =~/\](.*)/); +} print +("\U$gotname" eq "\U$name.tmp" ? '' : 'not '), "ok 10\n"; $sfh = VMS::Stdio::vmssysopen($name, O_RDONLY, 0, @@ -43,7 +52,7 @@ print +(stat("$name.tmp") ? 'not ' : ''),"ok 13\n"; print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n"; -#if (open(P, qq[| MCR $^X -e "1 while (<STDIN>);print 'Foo';1 while (<STDIN>); print 'Bar'" >$name.tmp])) { +#if (open(P, qq[| $^X -e "1 while (<STDIN>);print 'Foo';1 while (<STDIN>); print 'Bar'" >$name.tmp])) { # print P "Baz\nQuux\n"; # print +(VMS::Stdio::writeof(P) ? '' : 'not '),"ok 15\n"; # print P "Baz\nQuux\n"; @@ -59,7 +68,7 @@ print "ok 15\nok 16\nok 17\n"; #} $sfh = VMS::Stdio::vmsopen(">$name.tmp"); -$setuperl = "\$ MCR $^X\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);"; +$setuperl = "\$ MCR $perl\nBEGIN { \@INC = qw(@INC) };\nuse VMS::Stdio qw(&setdef);"; print $sfh qq[\$ here = F\$Environment("Default")\n]; print $sfh "$setuperl\nsetdef();\n\$ Show Default\n\$ Set Default 'here'\n"; print $sfh "$setuperl\nsetdef('..');\n\$ Show Default\n"; |