view release on metacpan or  search on metacpan

test.pl  view on Meta::CPAN

print +(($dcb{'filename'} eq "'$dcb{'dsname'}'") ? '' : 'not '),"ok $t\n"; $t++;
                                           #filename = 'PVHP.TEST3858.TEST3858'
                                           # add single quotation marks
print +(($dcb{'maxreclen'} > 0) ? '' : 'not '),"ok $t\n"; $t++;
                                           #maxreclen = 1024
print +(($dcb{'modeflag'} eq "UPDATEWRITE") ? '' : 'not '),"ok $t\n"; $t++;
                                           #modeflag = UPDATEWRITE
print +(($dcb{'openmode'} eq "TEXT") ? '' : 'not '),"ok $t\n"; $t++;
                                           #openmode = TEXT
print +(($dcb{'recfm'} eq "Blk") ? '' : 'not '),"ok $t\n"; $t++;
                                           #recfm = Blk
print +(($dcb{'vsamkeylen'}==0) ? '' : 'not '),"ok $t\n"; $t++;
                                           #vsamkeylen = 0
print +(($dcb{'vsamtype'} eq "NOTVSAM") ? '' : 'not '),"ok $t\n"; $t++;
                                           #vsamtype = NOTVSAM
print +(($dcb{'vsamRKP'}==0) ? '' : 'not '),"ok $t\n"; $t++; 
                                           #vsamRKP = 0
if ($DIAG) { print "# dcb was:\n"; for(sort(keys(%dcb))) { print "## $_ = $dcb{$_}\n"; } }

print "#$t attempts to rewind\n" if $DIAG;
print +(rewind($fh) ? '' : 'not '),"ok $t\n"; $t++;

#
# Grab a scalar version of the system time for use as a string
#
my $date_str = scalar(localtime(time()));

print "#$t attempts to mvswrite $date_str\n" if $DIAG;
# let's pretend the extra character is C's '\0':
my $numwritten = mvswrite( $fh, $date_str, length($date_str)+1);
print +(($numwritten == (length($date_str)+1)) ? '' : 'not '),"ok $t\n"; $t++;
print "#$t numwritten=>$numwritten<=\n" if $DIAG;

print "#$t tries to flush the \$fh\n" if $DIAG;
print +(flush($fh) ? '' : 'not '),"ok $t\n"; $t++;

print "#$t attempts to rewind\n" if $DIAG;
print +(rewind($fh) ? '' : 'not '),"ok $t\n"; $t++;

my $line;
chop($line = <$fh>);
if ($DIAG) {
print "#$t attempts to compare the line read to =>$date_str<=\n";
}
if ($GORY) {
print <<"EOGORY0"
#$t attempts to compare the line read 
#=>$line<=
#to
#=>$date_str<=
EOGORY0
}
print +($line eq $date_str ? '' : 'not '), "ok $t\n"; $t++;

my $gotname = getname($fh);            # e.g. 'PVHP.TEST3355.TEST3355'
my $gotname_name = getname($name);     # e.g. 'PVHP.TEST3355.TEST3355'
print "#$t gotname=>$gotname<= and gotname_name '=>'$gotname_name'<=\n" if $DIAG;
print +($gotname eq $gotname_name ? '' : 'not '), "ok $t\n"; $t++;
my $sans_slash = $name;                # e.g. //TEST3355.TEST3355
$sans_slash =~ s#\Q//\E##;             # e.g. TEST3355.TEST3355
my $hlq = (getpwuid($<))[0];           # e.g. PVHP
print "#$t gotname=>$gotname<= and 'hlq.sans_slash'=>'$hlq.$sans_slash'<=\n" if $DIAG;
print +($gotname eq "'$hlq.$sans_slash'" ? '' : 'not '), "ok $t\n"; $t++;

my $slash_name = '//' . getname($fh);  # e.g. //'PVHP.TEST3355.TEST3355'
$slash_name =~ s/$hlq\.//;             # e.g. //'TEST3355.TEST3355'
$slash_name =~ s/\'//g;                # e.g. //TEST3355.TEST3355
print "#$t slash_name=>$slash_name<= and name=>$name<=\n" if $DIAG;
print +($slash_name eq "$name" ? '' : 'not '), "ok $t\n"; $t++;

print "#$t attempts to close the ds handle\n" if $DIAG;
print +(defined(close($fh)) ? '' : 'not '), "ok $t\n"; $t++;

#
# unlike other C RTLs we do not have an open() that can be used to access 
# data sets hence wrappered to provide a 'mvssysopen'.  So we just use the 
# regular mvsopen, that is, our wrapper around fopen() (and we don't 
# bother with a wrapper for freopen()).
#
print "#$t attempts to reopen $name for reading\n" if $DIAG;
my $mode = "r";
my $sfh = OS390::Stdio::mvsopen($name, $mode);
print +($sfh ? '' : 'not ($!) '), "ok $t\n"; $t++;

$line = '';
read($sfh,$line,24);             # e.g. Fri Sep 11 14:35:14 1998
if ($DIAG) {
print "#$t attempts to compare the line read to =>$date_str<=\n";
}
if ($GORY) {
print <<"EOGORY1"
#$t attempts to compare the line read 
#=>$line<=
#to
#=>$date_str<=
EOGORY1
}
print +($line eq $date_str ? '' : 'not '), "ok $t\n"; $t++;

undef $sfh;

print "# alas we can't stat a ds but should be able to sysdsnr it:\n" if $DIAG;
print "#$t sysdsnr(\"$name\") =>",sysdsnr("$name"),"<=\n" if $DIAG;
print +(sysdsnr("$name") ? '' : 'not '),"ok $t\n"; $t++;

print "#$t attempts to remove the data set used for testing\n" if $DIAG;
print +(remove("$name") ? '' : 'not '),"ok $t\n"; $t++;

print "#$t attempts to generate an HFS tmpnam\n" if $DIAG;
my $tmpnam = &OS390::Stdio::tmpnam();
print +($tmpnam ? '' : 'not '),"ok $t\n";
print "#$t tempnam=>$tmpnam<=\n" if $DIAG; $t++;

my $tmp_name = '//&&TST' . substr($$,0,3);
print "#$t attempts to open a temporary dataset: $tmp_name\n" if $DIAG;
my $tmp_dsh = mvsopen($tmp_name, "w+");
print +($tmp_dsh ? '' : 'not '),"ok $t\n";
print "#$t tmp_name=>$tmp_name<=\n" if $DIAG; $t++;

print "#$t finds name of temporary dataset\n" if $DIAG;
my $alloc_name = getname($tmp_dsh);