import
OS390::Stdio
qw(&dynalloc &dynfree &flush &forward &getname &get_dcb
&mvsopen &mvswrite &pds_mem &remove &resetpos &rewind
&smf_record &sysdsnr &svc99 &tmpnam
)
;
my
$DIAG
=
$ENV
{
'OS390_STDIO_DIAG'
};
my
$GORY
=
$ENV
{
'OS390_STDIO_GORY'
};
print
"1..161\n"
;
my
$t
= 1;
print
"# OK how did the import go?\n"
if
$DIAG
;
print
+(
defined
(
&dynalloc
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&dynfree
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&flush
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&forward
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&getname
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&get_dcb
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&mvsopen
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&mvswrite
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&pds_mem
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&remove
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&resetpos
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&rewind
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&smf_record
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&sysdsnr
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&svc99
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
&tmpnam
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# we didn't yet ask for the unimplemented subs:\n"
if
$DIAG
;
print
+(!
defined
(
&dsname_level
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(!
defined
(
&vol_ser
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(!
defined
(
&vsamdelrec
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(!
defined
(
&vsamlocate
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(!
defined
(
&vsamupdate
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# and what became of those EXPORTed constants?\n"
if
$DIAG
;
my
$junk
=
undef
;
$junk
=
&KEY_FIRST
;
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
=
&KEY_LAST
;
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
=
&KEY_EQ
;
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
=
&KEY_EQ_BWD
;
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
=
&KEY_GE
;
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
=
&RBA_EQ
;
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
=
&RBA_EQ_BWD
;
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# and what became of those non exported constants?\n"
if
$DIAG
;
print
"# ALCUNIT_CONSTANTS\n"
if
$GORY
;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'ALCUNIT_CYL'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'ALCUNIT_TRK'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# DISP_CONSTANTS\n"
if
$GORY
;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DISP_OLD'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DISP_MOD'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DISP_NEW'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DISP_SHR'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DISP_UNCATLG'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DISP_CATLG'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DISP_DELETE'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DISP_KEEP'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# DSORG_CONSTANTS\n"
if
$GORY
;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSORG_unknown'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSORG_VSAM'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSORG_GS'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSORG_PO'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSORG_POU'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSORG_DA'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSORG_DAU'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSORG_PS'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSORG_PSU'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSORG_IS'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSORG_ISU'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# RECFM_CONSTANTS\n"
if
$GORY
;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'RECFM_M'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'RECFM_A'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'RECFM_S'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'RECFM_B'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'RECFM_D'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'RECFM_V'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'RECFM_F'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'RECFM_U'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'RECFM_FB'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'RECFM_VB'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'RECFM_FBS'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'RECFM_VBS'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# MISCFL_CONSTANTS\n"
if
$GORY
;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'MISCFL_CLOSE'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'MISCFL_RELEASE'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'MISCFL_PERM'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'MISCFL_CONTIG'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'MISCFL_ROUND'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'MISCFL_TERM'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'MISCFL_DUMMY_DSN'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'MISCFL_HOLDQ'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# VSAM_CONSTANTS\n"
if
$GORY
;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'VSAM_KS'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'VSAM_ES'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'VSAM_RR'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'VSAM_LS'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# DSNT_CONSTANTS\n"
if
$GORY
;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSNT_HFS'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSNT_PIPE'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSNT_PDS'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'DSNT_LIBRARY'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# PATH_CONSTANTS\n"
if
$GORY
;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'PATH_OCREAT'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'PATH_OEXCL'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'PATH_ONOCTTY'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'PATH_OTRUNC'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'PATH_OAPPEND'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'PATH_ONONBLOCK'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'PATH_ORDWR'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'PATH_ORDONLY'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'PATH_OWRONLY'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'PATH_SISUID'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
'PATH_SISGID'
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
for
(
qw(
PATH_SIRUSR PATH_SIWUSR PATH_SIXUSR PATH_SIRWXU PATH_SIRGRP
PATH_SIWGRP PATH_SIXGRP PATH_SIRWXG PATH_SIROTH PATH_SIWOTH
PATH_SIXOTH PATH_SIRWXO
)
) {
$junk
=
undef
;
$junk
= OS390::Stdio::constant(
$_
);
print
+(
defined
(
$junk
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
}
my
$name
=
"//"
.
substr
(
"TEST$$"
,0,8) .
'.'
.
substr
(
"TEST$$"
,0,8);
if
(sysdsnr(
$name
)) {
die
"name $name already exists, tests cannot proceed"
;
}
print
"#$t filehandle returns from mvsopen for name=>$name<=\n"
if
$DIAG
;
my
$fh
= mvsopen(
"$name"
,
"wt+"
);
print
+(
$fh
?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#$t tries to flush the \$fh\n"
if
$DIAG
;
print
+(flush(
$fh
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#$t attempts to ->autoflush (from IO::File)\n"
if
$DIAG
;
$fh
->autoflush;
print
"ok $t\n"
;
$t
++;
print
"#$t trys get_dcb(dsh)\n"
if
$DIAG
;
my
%dcb
= get_dcb(
$fh
);
print
+(
defined
(
%dcb
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+((
$dcb
{
'blksize'
} > 0) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+((
$dcb
{
'device'
} eq
"DISK"
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+(
defined
(
$dcb
{
'dsname'
}) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+((
$dcb
{
'dsorg'
} eq
"PS"
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+((
$dcb
{
'filename'
} eq
"'$dcb{'dsname'}'"
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+((
$dcb
{
'maxreclen'
} > 0) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+((
$dcb
{
'modeflag'
} eq
"UPDATEWRITE"
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+((
$dcb
{
'openmode'
} eq
"TEXT"
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+((
$dcb
{
'recfm'
} eq
"Blk"
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+((
$dcb
{
'vsamkeylen'
}==0) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+((
$dcb
{
'vsamtype'
} eq
"NOTVSAM"
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
+((
$dcb
{
'vsamRKP'
}==0) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
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
++;
my
$date_str
=
scalar
(
localtime
(
time
()));
print
"#$t attempts to mvswrite $date_str\n"
if
$DIAG
;
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
);
my
$gotname_name
= getname(
$name
);
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
;
$sans_slash
=~ s
my
$hlq
= (
getpwuid
($<))[0];
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
);
$slash_name
=~ s/
$hlq
\.//;
$slash_name
=~ s/\'//g;
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
++;
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);
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
);
my
$tmp_getname
=
"'$tmp_name'"
;
$tmp_getname
=~ s
print
+((
$alloc_name
eq
$tmp_getname
) ?
''
:
'not '
),
"ok $t\n"
;
print
"#$t alloc_name=>$alloc_name<=\n"
if
$DIAG
;
$t
++;
print
"#$t mvswrite 3 records there\n"
if
$DIAG
;
$numwritten
= mvswrite(
$tmp_dsh
,
$date_str
.
"\n"
.
$date_str
.
"\r"
.
$date_str
.
"\n"
,
3*(
length
(
$date_str
)+1));
print
+((
$numwritten
== (3*(
length
(
$date_str
)+1))) ?
''
:
'not '
),
"ok $t\n"
;
print
"#$t numwritten=>$numwritten<=\n"
if
$DIAG
;
$t
++;
print
"#$t flush write\n"
if
$DIAG
;
print
+(flush(
$tmp_dsh
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#$t rewind\n"
if
$DIAG
;
print
+(rewind(
$tmp_dsh
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#$t read\n"
if
$DIAG
;
$line
=
''
;
chomp
(
$line
= <
$tmp_dsh
>);
print
+(
$line
eq
$date_str
?
''
:
'not '
),
"ok $t\n"
;
print
"#$t line=>$line<=\n"
if
$GORY
;
$t
++;
print
"#$t checking list context: date_str . linefeed x 2\n"
if
$DIAG
;
my
@lines
= <
$tmp_dsh
>;
print
+(
join
(
''
,
@lines
) eq
"$date_str\n"
x 2 ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#lines=>\n"
,
map
{
"## $_"
}
@lines
,
"<=\n"
if
$DIAG
;
print
"#$t rewind\n"
if
$DIAG
;
print
+(rewind(
$tmp_dsh
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
$line
=
''
;
chomp
(
$line
= <
$tmp_dsh
>);
print
+(
$line
eq
$date_str
?
''
:
'not '
),
"ok $t\n"
;
print
"#$t line=>$line<=\n"
if
$GORY
;
$t
++;
print
"#$t resetpos\n"
if
$DIAG
;
print
+(resetpos(
$tmp_dsh
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
my
$new_date_str
=
scalar
(
localtime
(
time
()));
if
(
$new_date_str
eq
$date_str
) {
$new_date_str
=
reverse
(
$new_date_str
);
}
print
"#$t mvswrite one record there\n"
if
$DIAG
;
$numwritten
= mvswrite(
$tmp_dsh
,
$new_date_str
,
length
(
$new_date_str
));
print
+((
$numwritten
==
length
(
$new_date_str
) ) ?
''
:
'not '
),
"ok $t\n"
;
print
"#$t numwritten=>$numwritten<=\n"
if
$DIAG
;
$t
++;
print
"#$t flush write\n"
if
$DIAG
;
print
+(flush(
$tmp_dsh
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
@lines
= ();
@lines
= <
$tmp_dsh
>;
print
"#$t number of lines -1 in dataset from here =>$#lines<=\n"
if
$DIAG
;
print
+((
$#lines
== 1 ) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#$t rewind\n"
if
$DIAG
;
print
+(rewind(
$tmp_dsh
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#$t forward\n"
if
$DIAG
;
print
+(forward(
$tmp_dsh
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#$t mvswrite one record there\n"
if
$DIAG
;
$numwritten
= mvswrite(
$tmp_dsh
,
$new_date_str
,
length
(
$new_date_str
));
print
+((
$numwritten
==
length
(
$new_date_str
) ) ?
''
:
'not '
),
"ok $t\n"
;
print
"#$t numwritten=>$numwritten<=\n"
if
$DIAG
;
$t
++;
print
"#$t flush write\n"
if
$DIAG
;
print
+(flush(
$tmp_dsh
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#$t rewind\n"
if
$DIAG
;
print
+(rewind(
$tmp_dsh
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
@lines
= ();
@lines
= <
$tmp_dsh
>;
print
"#$t check number of lines -1 in whole dataset =>$#lines<=\n"
if
$DIAG
;
print
+((
$#lines
== 3 ) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# lines =>\n"
,
map
{
"## $_"
}
@lines
,
"<=\n"
if
$DIAG
;
print
"#$t closes (and deallocates) temp dataset\n"
if
$DIAG
;
close
(
$tmp_dsh
);
print
+($! ?
''
:
'not ($1)'
),
"ok $t\n"
;
$t
++;
print
"#$t after closing sysdsnr ing =>$alloc_name<=\n"
if
$DIAG
;
print
+(sysdsnr(
"$alloc_name"
) ?
'not '
:
''
),
"ok $t\n"
;
$t
++;
print
"#$t attempts to dynalloc a temporary PDS: $gotname\n"
if
$DIAG
;
my
$tmp_dynhsh
= {(
ddname
=>
"MYDD"
,
dsname
=>
"$gotname"
,
status
=> 0x04,
normdisp
=> 0x02,
alcunit
=>
'\x01'
,
primary
=> 1,
dirblk
=> 1,
misc_flags
=> (0x02|0x08),
recfm
=> 0x80 + 0x10,
lrecl
=> 80,
blksize
=> 6080
)};
print
+(dynalloc(
$tmp_dynhsh
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
my
$new_name
=
$gotname
;
$new_name
=~ s/'//g;
print
"# attempt to write into \"//'$new_name(MEM1)'\"\n"
if
$DIAG
;
my
$tfh
= OS390::Stdio::mvsopen(
"//'$new_name(MEM1)'"
,
"w"
);
$numwritten
= mvswrite(
$tfh
,
$new_date_str
,
length
(
$new_date_str
));
close
(
$tfh
);
print
"# $numwritten were written into MEM1\n"
if
$DIAG
;
print
"# attempt to write into \"//'$new_name(MEM2)'\"\n"
if
$DIAG
;
my
$ufh
= OS390::Stdio::mvsopen(
"//'$new_name(MEM2)'"
,
"w"
);
my
$numwritten2
= mvswrite(
$ufh
,
$new_date_str
,
length
(
$new_date_str
));
close
(
$ufh
);
print
"# $numwritten2 were written into MEM2\n"
if
$DIAG
;
print
+(((
$numwritten
+
$numwritten2
) == 2 *
length
(
$new_date_str
) ) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#$t attempts to list members with pds_mem(\"//$gotname\")\n"
if
$DIAG
;
my
@pds_mem
= pds_mem(
"//$gotname"
);
my
%my_pds
= ();
my
$pds_tot
= 0;
for
(
sort
(
@pds_mem
)) {
$my_pds
{
$_
}++;
$pds_tot
+=
$my_pds
{
$_
}; }
print
+(
defined
(
$my_pds
{
'MEM1'
}) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# members seen:\n"
,
map
{
"## $_\n"
}
@pds_mem
if
$DIAG
;
print
"# members defined:\n"
,
map
{
"## $_ = $my_pds{$_}\n"
}
sort
(
keys
(
%my_pds
))
if
$DIAG
;
print
"#$t makes sure list total: $pds_tot is equal to "
,
scalar
(
@pds_mem
),
"\n"
if
$DIAG
;
print
+((
scalar
(
@pds_mem
) ==
$pds_tot
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# check that dsorg in DCB is 'POPDSdir' \n"
if
$DIAG
;
%dcb
=get_dcb(
"//'$new_name'"
);
print
+((
$dcb
{
'dsorg'
} eq
"POPDSdir"
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"# dsorg eq $dcb{'dsorg'}\n"
if
$DIAG
;
print
"#$t attempts to dynfree a temporary PDS: $gotname\n"
if
$DIAG
;
print
+(dynfree(
$tmp_dynhsh
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#$t verify removal of the data set used for pds_mem,dyn* testing\n"
if
$DIAG
;
print
+(sysdsnr(
"$gotname"
) ?
'not '
:
''
),
"ok $t\n"
;
$t
++;
print
"#$t attempts to svc99 alloc a DS: $new_name\n"
if
$DIAG
;
my
$length
=
chr
(
length
(
$new_name
));
my
$svc99_hr
= {(
S99RBLN
=> 20,
S99VERB
=> 1,
S99FLAG1
=> 16384,
S99TXTPP
=>
[ (
"\0\x02\0\x01\0$length$new_name"
,
"\0\x05\0\x01\0\x01\x02"
,
"\0\x07\0\0"
,
"\0\x0A\0\x01\0\x03\0\0\x14"
,
"\0\x0B\0\x01\0\x03\0\0\x01"
,
"\0\x30\0\x01\0\x02\0\x50"
,
"\0\x3C\0\x01\0\x02\0\x40\0"
,
"\0\x42\0\x01\0\x02\0\x50"
,
"\0\x49\0\x01\0\x01\x80"
) ],
)};
if
(
$GORY
) {
for
(
keys
(
%$svc99_hr
)) {
print
"# $_ => $$svc99_hr{$_}\n"
;
if
(
$_
eq
'S99TXTPP'
) {
my
@foo
;
@foo
= @{
$svc99_hr
->{
$_
}};
foreach
my
$bar
(
@foo
) {
print
"#\t"
;
my
@buz
=
split
(//,
$bar
);
foreach
my
$buz
(
@buz
) {
print
ord
(
$buz
),
" "
;
}
print
"\n"
;
}
}
}
}
print
+(svc99(
$svc99_hr
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#$t attempts to remove the data set used for svc99 testing\n"
if
$DIAG
;
print
+(remove(
"//'$new_name'"
) ?
''
:
'not '
),
"ok $t\n"
;
$t
++;
print
"#$t verify removal of the data set used for svc99 testing\n"
if
$DIAG
;
print
+(sysdsnr(
"//'$new_name'"
) ?
'not '
:
''
),
"ok $t\n"
;
$t
++;
print
"#t at end =>$t<=\n"
if
$DIAG
;