summaryrefslogtreecommitdiff
path: root/vms/ext
diff options
context:
space:
mode:
Diffstat (limited to 'vms/ext')
-rw-r--r--vms/ext/DCLsym/0README.txt21
-rw-r--r--vms/ext/DCLsym/DCLsym.pm268
-rw-r--r--vms/ext/DCLsym/DCLsym.xs151
-rw-r--r--vms/ext/DCLsym/Makefile.PL3
-rw-r--r--vms/ext/DCLsym/test.pl41
-rw-r--r--vms/ext/Stdio/Stdio.pm21
-rw-r--r--vms/ext/Stdio/Stdio.xs4
-rw-r--r--vms/ext/Stdio/test.pl23
8 files changed, 509 insertions, 23 deletions
diff --git a/vms/ext/DCLsym/0README.txt b/vms/ext/DCLsym/0README.txt
new file mode 100644
index 0000000000..9dc721d36b
--- /dev/null
+++ b/vms/ext/DCLsym/0README.txt
@@ -0,0 +1,21 @@
+VMS::DCLsym is an extension to Perl 5 which allows it to manipulate DCL symbols
+via an object-oriented or tied-hash interface.
+
+In order to build the extension, just say
+
+$ Perl Makefile.PL
+$ MMK
+
+in the directory containing the source files. Once it's built, you can run the
+test script by saying
+
+$ Perl "-Iblib" test.pl
+
+Finally, if you want to make it part of your regular Perl library, you can say
+$ MMK install
+
+If you have any problems or suggestions, please feel free to let me know.
+
+Regards,
+Charles Bailey bailey@genetics.upenn.edu
+17-Aug-1995
diff --git a/vms/ext/DCLsym/DCLsym.pm b/vms/ext/DCLsym/DCLsym.pm
new file mode 100644
index 0000000000..057951dd99
--- /dev/null
+++ b/vms/ext/DCLsym/DCLsym.pm
@@ -0,0 +1,268 @@
+package VMS::DCLsym;
+
+use Carp;
+use DynaLoader;
+use vars qw( @ISA $VERSION );
+use strict;
+
+# Package globals
+@ISA = ( 'DynaLoader' );
+$VERSION = '1.01';
+my(%Locsyms) = ( ':ID' => 'LOCAL' );
+my(%Gblsyms) = ( ':ID' => 'GLOBAL');
+my $DoCache = 1;
+my $Cache_set = 0;
+
+
+#====> OO methods
+
+sub new {
+ my($pkg,$type) = @_;
+ bless { TYPE => $type }, $pkg;
+}
+
+sub DESTROY { }
+
+sub getsym {
+ my($self,$name) = @_;
+ my($val,$table);
+
+ if (($val,$table) = _getsym($name)) {
+ if ($table eq 'GLOBAL') { $Gblsyms{$name} = $val; }
+ else { $Locsyms{$name} = $val; }
+ }
+ wantarray ? ($val,$table) : $val;
+}
+
+sub setsym {
+ my($self,$name,$val,$table) = @_;
+
+ $table = $self->{TYPE} unless $table;
+ if (_setsym($name,$val,$table)) {
+ if ($table eq 'GLOBAL') { $Gblsyms{$name} = $val; }
+ else { $Locsyms{$name} = $val; }
+ 1;
+ }
+ else { 0; }
+}
+
+sub delsym {
+ my($self,$name,$table) = @_;
+
+ $table = $self->{TYPE} unless $table;
+ if (_delsym($name,$table)) {
+ if ($table eq 'GLOBAL') { delete $Gblsyms{$name}; }
+ else { delete $Locsyms{$name}; }
+ 1;
+ }
+ else { 0; }
+}
+
+sub clearcache {
+ my($self,$perm) = @_;
+ my($old);
+
+ $Cache_set = 0;
+ %Locsyms = ( ':ID' => 'LOCAL');
+ %Gblsyms = ( ':ID' => 'GLOBAL');
+ $old = $DoCache;
+ $DoCache = $perm if defined($perm);
+ $old;
+}
+
+#====> TIEHASH methods
+
+sub TIEHASH {
+ $_[0]->new(@_);
+}
+
+sub FETCH {
+ my($self,$name) = @_;
+ if ($name eq ':GLOBAL') { $self->{TYPE} eq 'GLOBAL'; }
+ elsif ($name eq ':LOCAL' ) { $self->{TYPE} eq 'LOCAL'; }
+ else { scalar($self->getsym($name)); }
+}
+
+sub STORE {
+ my($self,$name,$val) = @_;
+ if ($name eq ':GLOBAL') { $self->{TYPE} = 'GLOBAL'; }
+ elsif ($name eq ':LOCAL' ) { $self->{TYPE} = 'LOCAL'; }
+ else { $self->setsym($name,$val); }
+}
+
+sub DELETE {
+ my($self,$name) = @_;
+
+ $self->delsym($name);
+}
+
+sub FIRSTKEY {
+ my($self) = @_;
+ my($name,$eqs,$val);
+
+ if (!$DoCache || !$Cache_set) {
+ # We should eventually replace this with a C routine which walks the
+ # CLI symbol table directly. If I ever get 'hold of an I&DS manual . . .
+ open(P,'Show Symbol * |');
+ while (<P>) {
+ ($name,$eqs,$val) = /^\s+(\S+) (=+) (.+)/
+ or carp "VMS::CLISym: unparseable line $_";
+ $name =~ s#\*##;
+ $val =~ s/"(.*)"$/$1/ or $val =~ s/^(\S+).*/$1/;
+ if ($eqs eq '==') { $Gblsyms{$name} = $val; }
+ else { $Locsyms{$name} = $val; }
+ }
+ close P;
+ $Cache_set = 1;
+ }
+ $self ->{IDX} = 0;
+ $self->{CACHE} = $self->{TYPE} eq 'GLOBAL' ? \%Gblsyms : \%Locsyms;
+ while (($name,$val) = each(%{$self->{CACHE}}) and !defined($name)) {
+ if ($self->{CACHE}{':ID'} eq 'GLOBAL') { return undef; }
+ $self->{CACHE} = \%Gblsyms;
+ }
+ $name;
+}
+
+sub NEXTKEY {
+ my($self) = @_;
+ my($name,$val);
+
+ while (($name,$val) = each(%{$self->{CACHE}}) and !defined($name)) {
+ if ($self->{CACHE}{':ID'} eq 'GLOBAL') { return undef; }
+ $self->{CACHE} = \%Gblsyms;
+ }
+ $name;
+}
+
+
+sub EXISTS { defined($_[0]->FETCH(@_)) ? 1 : 0 }
+
+sub CLEAR { }
+
+
+bootstrap VMS::DCLsym;
+
+1;
+
+__END__
+
+=head1 NAME
+
+VMS::DCLsym - Perl extension to manipulate DCL symbols
+
+=head1 SYNOPSIS
+
+ tie %allsyms, VMS::DCLsym;
+ tie %cgisyms, VMS::DCLsym, 'GLOBAL';
+
+
+ $handle = new VMS::DCLsyms;
+ $value = $handle->getsym($name);
+ $handle->setsym($name,$value,'GLOBAL') or die "Can't create symbol: $!\n";
+ $handle->delsym($name,'LOCAL') or die "Can't delete symbol: $!\n";
+ $handle->clearcache();
+
+=head1 DESCRIPTION
+
+The VMS::DCLsym extension provides access to DCL symbols using a
+tied hash interface. This allows Perl scripts to manipulate symbols in
+a manner similar to the way in which logical names are manipulated via
+the built-in C<%ENV> hash. Alternatively, one can call methods in this
+package directly to read, create, and delete symbols.
+
+=head2 Tied hash interface
+
+This interface lets you treat the DCL symbol table as a Perl associative array,
+in which the key of each element is the symbol name, and the value of the
+element is that symbol's value. Case is not significant in the key string, as
+DCL converts symbol names to uppercase, but it is significant in the value
+string. All of the usual operations on associative arrays are supported.
+Reading an element retrieves the current value of the symbol, assigning to it
+defines a new symbol (or overwrites the old value of an existing symbol), and
+deleting an element deletes the corresponding symbol. Setting an element to
+C<undef>, or C<undef>ing it directly, sets the corresponding symbol to the null
+string. You may also read the special keys ':GLOBAL' and ':LOCAL' to find out
+whether a default symbol table has been specified for this hash (see C<table>
+below), or set either or these keys to specify a default symbol table.
+
+When you call the C<tie> function to bind an associative array to this package,
+you may specify as an optional argument the symbol table in which you wish to
+create and delete symbols. If the argument is the string 'GLOBAL', then the
+global symbol table is used; any other string causes the local symbol table to
+be used. Note that this argument does not affect attempts to read symbols; if
+a symbol with the specified name exists in the local symbol table, it is always
+returned in preference to a symbol by the same name in the global symbol table.
+
+=head2 Object interface
+
+Although it's less convenient in some ways than the tied hash interface, you
+can also call methods directly to manipulate individual symbols. In some
+cases, this allows you finer control than using a tied hash aggregate. The
+following methods are supported:
+
+=item new
+
+This creates a C<VMS::DCLsym> object which can be used as a handle for later
+method calls. The single optional argument specifies the symbol table used
+by default in future method calls, in the same way as the optional argument to
+C<tie> described above.
+
+=item getsym
+
+If called in a scalar context, C<getsym> returns the value of the symbol whose
+name is given as the argument to the call, or C<undef> if no such symbol
+exists. Symbols in the local symbol table are always used in preference to
+symbols in the global symbol table. If called in an array context, C<getsym>
+returns a two-element list, whose first element is the value of the symbol, and
+whose second element is the string 'GLOBAL' or 'LOCAL', indicating the table
+from which the symbol's value was read.
+
+=item setsym
+
+The first two arguments taken by this method are the name of the symbol and the
+value which should be assigned to it. The optional third argument is a string
+specifying the symbol table to be used; 'GLOBAL' specifies the global symbol
+table, and any other string specifies the local symbol table. If this argument
+is omitted, the default symbol table for the object is used. C<setsym> returns
+TRUE if successful, and FALSE otherwise.
+
+=item delsym
+
+This method deletes the symbol whose name is given as the first argument. The
+optional second argument specifies the symbol table, as described above under
+C<setsym>. It returns TRUE if the symbol was successfully deleted, and FALSE
+if it was not.
+
+=item clearcache
+
+Because of the overhead associated with obtaining the list of defined symbols
+for the tied hash iterator, it is only done once, and the list is reused for
+subsequent iterations. Changes to symbols made through this package are
+recorded, but in the rare event that someone changes the process' symbol table
+from outside (as is possible using some software from the net), the iterator
+will be out of sync with the symbol table. If you expect this to happen, you
+can reset the cache by calling this method. In addition, if you pass a FALSE
+value as the first argument, caching will be disabled. It can be reenabled
+later by calling C<clearcache> again with a TRUE value as the first argument.
+It returns TRUE or FALSE to indicate whether caching was previously enabled or
+disabled, respectively.
+
+This method is a stopgap until we can incorporate code into this extension to
+traverse the process' symbol table directly, so it may disappear in a future
+version of this package.
+
+=head1 AUTHOR
+
+Charles Bailey bailey@genetics.upenn.edu
+
+=head1 VERSION
+
+1.01 08-Dec-1996
+
+=head1 BUGS
+
+The list of symbols for the iterator is assembled by spawning off a
+subprocess, which can be slow. Ideally, we should just traverse the
+process' symbol table directly from C.
+
diff --git a/vms/ext/DCLsym/DCLsym.xs b/vms/ext/DCLsym/DCLsym.xs
new file mode 100644
index 0000000000..3918eb11e5
--- /dev/null
+++ b/vms/ext/DCLsym/DCLsym.xs
@@ -0,0 +1,151 @@
+/* VMS::DCLsym - manipulate DCL symbols
+ *
+ * Version: 1.0
+ * Author: Charles Bailey bailey@genetics.upenn.edu
+ * Revised: 17-Aug-1995
+ *
+ *
+ * Revision History:
+ *
+ * 1.0 17-Aug-1995 Charles Bailey bailey@genetics.upenn.edu
+ * original production version
+ */
+
+#include <descrip.h>
+#include <lib$routines.h>
+#include <libclidef.h>
+#include <libdef.h>
+#include <ssdef.h>
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+MODULE = VMS::DCLsym PACKAGE = VMS::DCLsym
+
+void
+_getsym(name)
+ SV * name
+ PPCODE:
+ {
+ struct dsc$descriptor_s namdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
+ valdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
+ STRLEN namlen;
+ int tbltype;
+ unsigned long int retsts;
+ SETERRNO(0,SS$_NORMAL);
+ if (!name) {
+ PUSHs(sv_newmortal());
+ SETERRNO(EINVAL,LIB$_INVARG);
+ return;
+ }
+ namdsc.dsc$a_pointer = SvPV(name,namlen);
+ namdsc.dsc$w_length = (unsigned short int) namlen;
+ retsts = lib$get_symbol(&namdsc,&valdsc,0,&tbltype);
+ if (retsts & 1) {
+ PUSHs(sv_2mortal(newSVpv(valdsc.dsc$w_length ?
+ valdsc.dsc$a_pointer : "",valdsc.dsc$w_length)));
+ if (GIMME) {
+ EXTEND(sp,2); /* just in case we're at the end of the stack */
+ if (tbltype == LIB$K_CLI_LOCAL_SYM)
+ PUSHs(sv_2mortal(newSVpv("LOCAL",5)));
+ else
+ PUSHs(sv_2mortal(newSVpv("GLOBAL",6)));
+ }
+ _ckvmssts(lib$sfree1_dd(&valdsc));
+ }
+ else {
+ ST(0) = &sv_undef; /* error - we're returning undef, if anything */
+ switch (retsts) {
+ case LIB$_NOSUCHSYM:
+ break; /* nobody home */;
+ case LIB$_INVSYMNAM: /* user errors; set errno return undef */
+ case LIB$_INSCLIMEM:
+ case LIB$_NOCLI:
+ set_errno(EVMSERR);
+ set_vaxc_errno(retsts);
+ break;
+ default: /* bail out */
+ { _ckvmssts(retsts); }
+ }
+ }
+ }
+
+
+void
+_setsym(name,val,typestr="LOCAL")
+ SV * name
+ SV * val
+ char * typestr
+ CODE:
+ {
+ struct dsc$descriptor_s namdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0},
+ valdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
+ STRLEN slen;
+ int type;
+ unsigned long int retsts;
+ SETERRNO(0,SS$_NORMAL);
+ if (!name || !val) {
+ SETERRNO(EINVAL,LIB$_INVARG);
+ XSRETURN_UNDEF;
+ }
+ namdsc.dsc$a_pointer = SvPV(name,slen);
+ namdsc.dsc$w_length = (unsigned short int) slen;
+ valdsc.dsc$a_pointer = SvPV(val,slen);
+ valdsc.dsc$w_length = (unsigned short int) slen;
+ type = strNE(typestr,"GLOBAL") ?
+ LIB$K_CLI_LOCAL_SYM : LIB$K_CLI_GLOBAL_SYM;
+ retsts = lib$set_symbol(&namdsc,&valdsc,&type);
+ if (retsts & 1) { XSRETURN_YES; }
+ else {
+ switch (retsts) {
+ case LIB$_AMBSYMDEF: /* user errors; set errno and return */
+ case LIB$_INSCLIMEM:
+ case LIB$_INVSYMNAM:
+ case LIB$_NOCLI:
+ set_errno(EVMSERR);
+ set_vaxc_errno(retsts);
+ XSRETURN_NO;
+ break; /* NOTREACHED */
+ default: /* bail out */
+ { _ckvmssts(retsts); }
+ }
+ }
+ }
+
+
+void
+_delsym(name,typestr="LOCAL")
+ SV * name
+ char * typestr
+ CODE:
+ {
+ struct dsc$descriptor_s namdsc = {0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
+ STRLEN slen;
+ int type;
+ unsigned long int retsts;
+ SETERRNO(0,SS$_NORMAL);
+ if (!name || !typestr) {
+ SETERRNO(EINVAL,LIB$_INVARG);
+ XSRETURN_UNDEF;
+ }
+ namdsc.dsc$a_pointer = SvPV(name,slen);
+ namdsc.dsc$w_length = (unsigned short int) slen;
+ type = strNE(typestr,"GLOBAL") ?
+ LIB$K_CLI_LOCAL_SYM : LIB$K_CLI_GLOBAL_SYM;
+ retsts = lib$delete_symbol(&namdsc,&type);
+ if (retsts & 1) { XSRETURN_YES; }
+ else {
+ switch (retsts) {
+ case LIB$_INVSYMNAM: /* user errors; set errno and return */
+ case LIB$_NOCLI:
+ case LIB$_NOSUCHSYM:
+ set_errno(EVMSERR);
+ set_vaxc_errno(retsts);
+ XSRETURN_NO;
+ break; /* NOTREACHED */
+ default: /* bail out */
+ { _ckvmssts(retsts); }
+ }
+ }
+ }
+
diff --git a/vms/ext/DCLsym/Makefile.PL b/vms/ext/DCLsym/Makefile.PL
new file mode 100644
index 0000000000..8e6f5bce40
--- /dev/null
+++ b/vms/ext/DCLsym/Makefile.PL
@@ -0,0 +1,3 @@
+use ExtUtils::MakeMaker;
+
+WriteMakefile( 'VERSION_FROM' => 'DCLsym.pm' );
diff --git a/vms/ext/DCLsym/test.pl b/vms/ext/DCLsym/test.pl
new file mode 100644
index 0000000000..57f2afbd20
--- /dev/null
+++ b/vms/ext/DCLsym/test.pl
@@ -0,0 +1,41 @@
+print "1..15\n";
+
+require VMS::DCLsym or die "failed 1\n";
+print "ok 1\n";
+
+tie %syms, VMS::DCLsym or die "failed 2\n";
+print "ok 2\n";
+
+$name = 'FOO_'.time();
+$syms{$name} = 'Perl_test';
+print +($! ? "(\$! = $!) not " : ''),"ok 3\n";
+
+print +($syms{$name} eq 'Perl_test' ? '' : 'not '),"ok 4\n";
+
+($val) = `Show Symbol $name` =~ /(\w+)"$/;
+print +($val eq 'Perl_test' ? '' : 'not '),"ok 5\n";
+
+while (($sym,$val) = each %syms) {
+ last if $sym eq $name && $val eq 'Perl_test';
+}
+print +($sym ? '' : 'not '),"ok 6\n";
+
+delete $syms{$name};
+print +($! ? "(\$! = $!) not " : ''),"ok 7\n";
+
+print +(defined($syms{$name}) ? 'not ' : ''),"ok 8\n";
+undef %syms;
+
+$obj = new VMS::DCLsym 'GLOBAL';
+print +($obj ? '' : 'not '),"ok 9\n";
+
+print +($obj->clearcache(0) ? '' : 'not '),"ok 10\n";
+print +($obj->clearcache(1) ? 'not ' : ''),"ok 11\n";
+
+print +($obj->setsym($name,'Another_test') ? '' : 'not '),"ok 12\n";
+
+($val,$tab) = $obj->getsym($name);
+print +($val eq 'Another_test' && $tab eq 'GLOBAL' ? '' : 'not '),"ok 13\n";
+
+print +($obj->delsym($name,'LOCAL') ? 'not ' : ''),"ok 14\n";
+print +($obj->delsym($name,'GLOBAL') ? '' : 'not '),"ok 15\n";
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";