zOs/REXX/T1

/* copx tstZos begin **************************************************/
tstZOs:
    call sqlIni
    call tstSql
    call tstSqlStmt
    call tstSqlStmts
    call tstSqlO1
    call tstSqlO2
    call tstSqls1
    call tstSqlO
    call tstTotal
    return
endProcedure tstZOs

tstWshBatch:
    call adrTso 'alloc dd(WSH) shr dsn(WK.TEXT(WSHBATCH))'
    call wshBatch
    return adrTso('free dd(WSH)')

tstLmdTiming:
parse arg lev
    say timing() lev
    call lmdBegin abc, lev
    c = 0
    do while lmdNext(abc, st.)
        c = c + st.0
        end
    call lmdEnd   abc
    say timing() lev 'with group - without reading' c
    call adrIsp 'lmdinit listid(lmdId) level('lev')'
    do c=0 while adrIsp('lmdlist listid(&lmdId) dataset(abc)', 8) = 0
        end
    call adrIsp 'lmdfree listid(&lmdId)'
    say timing() lev 'with list' c
    return
endProcedure lmdTiming

tstCsi: procedure expose m.
    if 0 then do
        call lmd 'A540769.*K'
        call tstCsiCla 'A540769.WK.REXX'
        call tstCsiCla 'A540769.AAA.DATASETS'
        call tstCsiCla 'A540769.RRR.DATASETS'
        end
    if 0 then do
        call tstCsiOpNx 'A540769.WK.*E*'
        call tstCsiOpNx 'A540769.AAA.DATASETS'
        call tstCsiOpNx 'A540769.RRR.DATASETS'
        end
    if 1 then do
        call tstCsiNxCl 'A540769.WK.**'
        call tstCsiNxCl 'DBTF.M*.**'
        call tstCsiNxCl 'DBTF.BE*.**'
        end
    return
tstCsi: procedure expose m.
 /* call lmd 'A540769.*K' */
    call tstCsi1   'A540769.WK.REXX'
    call tstCsi1   'A540769.AAA.DATASETS'
    call tstCsi1   'A540769.RRR.DATASETS'
    return

tstCsiCla:
parse arg ds
    say ds '-->' csiCla(ds)
    return

tstCsiOpNx: procedure expose m.
parse arg ds
    m = 'NUE123'
    s = 'res89'
    flds = 'devtyp volser mgmtclas comudsiz NOBYTTRK UDATASIZ HARBA'
    say 'csiOpen' ds
    call csiOpen m, ds, flds
    do while csiNext(m, s)
        say m.s     'dev' c2x(m.s.devTyp) ,
                    'vol' m.s.volSer 'cla' m.s.mgmtclas,
                    'comuDsiz' m.s.comuDsiz 'noBytTrk' m.s.noBytTrk,
                    'udatasiz' c2x(m.s.udatasiz) ,
                    'harba' c2x(m.s.harba)
        end
    return

tstCsiNxCl: procedure expose m.
parse arg ds
    m = 'ABC123'
    s = 'efg89'
    flds = 'devtyp volser mgmtclas'
    say 'csiOpen' ds
    call csiOpen m, ds, flds
    say timing() 'begin'
    do i=1 while csiNext(m, s)
        nn = csiArcTape(m.s.volser, m.s.mgmtClas, m.s.devtyp, m.s)
/*      oo = csiCla(strip(m.s))
        if oo <> nn then
            say nn '<>' oo m.s
 */     if i // 1000 = 0 then
            say timing() i nn m.s
        end
    say timing() (i-1) nn m.s
    return
endProcedure tstCsiNxCl

listCatClass: procedure expose m.
parse upper arg dsn
    call outtrap x., '*'
    call adrTso "listcat volume entry('"dsn"')", 4
    rt = rc
    call outtrap off
    /* say 'listct rc =' rt 'lines' x.0 */
    cl = ''
    vo = ''
    if word(x.1, 3) \== dsn then
        call out 'err ??? for dsn' dsn 'bad first line' x.1
    else if pos('NOT FOUND', x.1) > 0 then
        return 'notFound'
    else if word(x.1, 1)\== 'NONVSAM' then
        call out 'err ??? for dsn' dsn 'bad first line' x.1
    do x=2 to x.0 while vo = '' & left(x.x, 1) = ' '
     /* say x.x */
        p = pos('MANAGEMENTCLASS-', x.x)
        if p > 0 then
            vo = strip(word(substr(x.x, p+16), 1), 'l', '-')
        p = pos('VOLSER--', x.x)
        if p > 0 then
            vo = strip(word(substr(x.x, p+6), 1), 'l', '-')
        p = pos('DEVCLASS--', x.x)
            dt = strip(word(substr(x.x, p+8), 1), 'l', '-')
        end
   /*  say 'lc' cl 'vo' vo 'dt' dt 'dsn' dsn */
    if vo = '' then
        call out '??? err no volume for dsn' dsn
    else if vo = 'ARCIVE' then
        res =  'arcive'
    else if cl = '' then
        res = 'tape'
    else
        res = cl
    if   abbrev(res, 'ar') \= abbrev(dt, "X'0") ,
       | abbrev(res, 'ta') \= abbrev(dt, "X'7") ,
       | (left(res, 1) >= 'A') \= abbrev(dt, "X'3") then
       call out 'err ??? mismatch cl' cl 'vo' vo 'dt' dt 'dsn' dsn
    return res
endProcedure listCatClass

/* copx tstZos end   **************************************************/