diff options
Diffstat (limited to 'vms/ext/Stdio')
| -rw-r--r-- | vms/ext/Stdio/Stdio.pm | 21 | ||||
| -rw-r--r-- | vms/ext/Stdio/Stdio.xs | 4 | ||||
| -rw-r--r-- | vms/ext/Stdio/test.pl | 23 |
3 files changed, 25 insertions, 23 deletions
diff --git a/vms/ext/Stdio/Stdio.pm b/vms/ext/Stdio/Stdio.pm index af71f0bb9e..ad16af366f 100644 --- a/vms/ext/Stdio/Stdio.pm +++ b/vms/ext/Stdio/Stdio.pm @@ -1,8 +1,8 @@ # VMS::Stdio - VMS extensions to Perl's stdio calls # # Author: Charles Bailey bailey@genetics.upenn.edu -# Version: 2.0 -# Revised: 28-Feb-1996 +# Version: 2.01 +# Revised: 10-Dec-1996 package VMS::Stdio; @@ -12,7 +12,7 @@ use Carp '&croak'; use DynaLoader (); use Exporter (); -$VERSION = '2.0'; +$VERSION = '2.01'; @ISA = qw( Exporter DynaLoader IO::File ); @EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL &O_NDELAY &O_NOWAIT &O_RDONLY &O_RDWR &O_TRUNC &O_WRONLY ); @@ -32,15 +32,14 @@ sub AUTOLOAD { if ($constname =~ /^O_/) { my($val) = constant($constname); defined $val or croak("Unknown VMS::Stdio constant $constname"); + *$AUTOLOAD = sub { val; } } else { # We don't know about it; hand off to IO::File require IO::File; - my($obj) = shift(@_); - my($val) = eval "\$obj->IO::File::$constname(@_)"; - croak "Error autoloading $constname: $@" if $@; + *$AUTOLOAD = eval "sub { shift->IO::File::$constname(\@_) }"; + croak "Error autoloading IO::File::$constname: $@" if $@; } - *$AUTOLOAD = sub { $val }; goto &$AUTOLOAD; } @@ -189,9 +188,9 @@ reason, it is unable to generate a name, it returns C<undef>. =item vmsopen The C<vmsopen> function enables you to specify optional RMS arguments -to the VMS CRTL when opening a file. It is similar to the built-in +to the VMS CRTL when opening a file. Its operation is similar to the built-in Perl C<open> function (see L<perlfunc> for a complete description), -but will only open normal files; it cannot open pipes or duplicate +but it will only open normal files; it cannot open pipes or duplicate existing I/O handles. Up to 8 optional arguments may follow the file name. These arguments should be strings which specify optional file characteristics as allowed by the CRTL. (See the @@ -199,7 +198,7 @@ CRTL reference manual description of creat() and fopen() for details.) If successful, C<vmsopen> returns a VMS::Stdio file handle; if an error occurs, it returns C<undef>. -You can use the file handle returned by C<vmsfopen> just as you +You can use the file handle returned by C<vmsopen> just as you would any other Perl file handle. The class VMS::Stdio ISA IO::File, so you can call IO::File methods using the handle returned by C<vmsopen>. However, C<use>ing VMS::Stdio does not @@ -232,6 +231,6 @@ task by calling the CRTL routine fwait(). =head1 REVISION -This document was last revised on 28-Jan-1996, for Perl 5.002. +This document was last revised on 10-Dec-1996, for Perl 5.004. =cut diff --git a/vms/ext/Stdio/Stdio.xs b/vms/ext/Stdio/Stdio.xs index a1ec91f500..200268c7f1 100644 --- a/vms/ext/Stdio/Stdio.xs +++ b/vms/ext/Stdio/Stdio.xs @@ -100,7 +100,7 @@ newFH(FILE *fp, char type) { gv_init(gv,stash,"__FH__",6,0); io = GvIOp(gv) = newIO(); IoIFP(io) = fp; - if (type != '>') IoOFP(io) = fp; + if (type != '<') IoOFP(io) = fp; IoTYPE(io) = type; rv = newRV((SV *)gv); SvREFCNT_dec(gv); @@ -225,7 +225,7 @@ vmsopen(spec,...) break; } if (fp != Nullfp) { - SV *fh = newFH(fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : '>'))); + SV *fh = newFH(fp,(mode[1] ? '+' : (mode[0] == 'r' ? '<' : (mode[0] == 'a' ? 'a' : '>')))); ST(0) = (fh ? sv_2mortal(fh) : &sv_undef); } else { ST(0) = &sv_undef; } diff --git a/vms/ext/Stdio/test.pl b/vms/ext/Stdio/test.pl index 12e508aa1f..0b50d63e3a 100644 --- a/vms/ext/Stdio/test.pl +++ b/vms/ext/Stdio/test.pl @@ -1,8 +1,8 @@ -# Tests for VMS::Stdio v2.0 +# Tests for VMS::Stdio v2.01 use VMS::Stdio; import VMS::Stdio qw(&flush &getname &rewind &sync); -print "1..13\n"; +print "1..14\n"; print +(defined(&getname) ? '' : 'not '), "ok 1\n"; $name = "test$$"; @@ -16,26 +16,29 @@ print +(sync($fh) ? '' : 'not '),"ok 4\n"; $time = (stat("$name.tmp"))[9]; print +($time ? '' : 'not '), "ok 5\n"; -print 'not ' unless print $fh scalar(localtime($time)),"\n"; +$fh->autoflush; # Can we autoload autoflush from IO::File? Do or die. print "ok 6\n"; -print +(rewind($fh) ? '' : 'not '),"ok 7\n"; +print 'not ' unless print $fh scalar(localtime($time)),"\n"; +print "ok 7\n"; + +print +(rewind($fh) ? '' : 'not '),"ok 8\n"; chop($line = <$fh>); -print +($line eq localtime($time) ? '' : 'not '), "ok 8\n"; +print +($line eq localtime($time) ? '' : 'not '), "ok 9\n"; ($gotname) = (getname($fh) =~/\](.*);/); -print +($gotname eq "\U$name.tmp" ? '' : 'not '), "ok 9\n"; +print +($gotname eq "\U$name.tmp" ? '' : 'not '), "ok 10\n"; $sfh = VMS::Stdio::vmssysopen($name, O_RDONLY, 0, 'ctx=rec', 'shr=put', 'dna=.tmp'); -print +($sfh ? '' : 'not ($!) '), "ok 10\n"; +print +($sfh ? '' : 'not ($!) '), "ok 11\n"; close($fh); sysread($sfh,$line,24); -print +($line eq localtime($time) ? '' : 'not '), "ok 11\n"; +print +($line eq localtime($time) ? '' : 'not '), "ok 12\n"; undef $sfh; -print +(stat("$name.tmp") ? 'not ' : ''),"ok 12\n"; +print +(stat("$name.tmp") ? 'not ' : ''),"ok 13\n"; -print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 13\n"; +print +(&VMS::Stdio::tmpnam ? '' : 'not '),"ok 14\n"; |