zOs/REXX.O08/TSTALL
/* copy tstAll begin *************************************************/
/* copx tstSql end ***************************************************/
tstAll: procedure expose m.
call sqlOIni
call compIni
call tstBase
call tstComp
call tstPlus
return 0
endProcedure tstAll
tstPlus:
call tstSort
call tstMatch
call sqlIni
call tstSql
call tstSqlO
call tstSqlEnv
call tstTotal
return
tstWshBatch:
call adrTso 'alloc dd(WSH) shr dsn(WK.TEXT(WSHBATCH))'
call wshBatch
return adrTso('free dd(WSH)')
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.dsn '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.dsn)
/* oo = csiCla(strip(m.s.dsn))
if oo <> nn then
say nn '<>' oo m.s.dsn
*/ if i // 1000 = 0 then
say timing() i nn m.s.dsn
end
say timing() (i-1) nn m.s.dsn
return
tstTypePara:
b = jBuf()
say 'b typePara undef' oGetTypePara(b)
ty = oFldNew('Ty*', '=', '=', 'A = B =')
call oSetTypePara b, ty
say 'b argCla def' oGetTypePara(b)
call tstJ2
return
tstSort: procedure expose m.
call tst t, "tstSort" ,
, "sort 29 c ACHT DREI DREIZEHN EINS ELF FUENF M.I.25 M.I.26",
|| " M.I.27 M.I.29 NEUN SECHS SIEBEN VIER VIERZEHN ZEHN ZWEI Z",
|| "WOELF 0 1 1 1 2 2 3 3 4 4",
, "sort 22 c ACHT DREIZEHN ELF M.I.25 M.I.26 M.I.27 M.I.29 N",
|| "EUN VIERZEHN ZEHN ZWOELF 0 1 1 1 2 2 3 3 4 4",
, "sort 15 c M.I.25 M.I.26 M.I.27 M.I.29 0 1 1 1 2 2 3 3 4 4",
, "sort 8 c M.I.25 M.I.26 M.I.27 M.I.29 0 1 1",
, "sort 1 M.I.29"
m.i.1 = eins
m.i.2 = zwei
m.i.3 = drei
m.i.4 = vier
m.i.5 = fuenf
m.i.6 = sechs
m.i.7 = sieben
m.i.8 = acht
m.i.9 = neun
m.i.10 = zehn
m.i.11 = elf
m.i.12 = zwoelf
m.i.13 = dreizehn
m.i.14 = vierzehn
m.i.15 = 1
m.i.16 = 2
m.i.17 = 3
m.i.18 = 4
m.i.19 = 4
m.i.20 = 3
m.i.21 = 2
m.i.22 = 1
m.i.23 = 0
m.i.24 = 1
m.i.28 = 'c'
yy = 29
do while yy > 0
do x = 0 to yy
m.i.0 = x
call sort i, o
m = ''
la = ''
if x <> m.o.0 then
call err 'size mismatch' x '<>' m.o.0
do y=1 to m.o.0
m = m m.o.y
if ^ (la << m.o.y) then
call err 'sort mismatch' yy x y '^' la '<<' m.o.y
end
end
if yy // 7 = 1 then
call tstOut t, 'sort' yy m
do x = 2 to yy
x1 = x-1
m.i.x1 = m.i.x
end
yy = yy-1
end
call tstEnd t
return
endProcedure tstSort
tstMatch: procedure expose m.
call tst t, "tstMatch" ,
, "match(eins, e?n*) 1 1 2,i,s trans(E?N*) EiNs",
, "match(eins, eins) 1 1 0 trans(EINS) EINS",
, "match(e1nss, e?n*) 1 1 2,1,ss trans(?*) 1ss",
, "match(eiinss, e?n*) 0 0 -9",
, "match(einss, e?n *) 0 0 -9",
, "match(ein s, e?n *) 1 1 2,i,s trans(E?N *) EiN s",
, "match(ein abss , ?i*b*) 1 1 3,e,n a,ss trans(?I*B*) eIn",
|| " aBss ",
, "match(ein abss wie gehtsssxdirx und auch , ) 0 0 -9",
, "match(ies000, *000) 1 1 1,ies trans(*000) ies000",
, "match(xx0x0000, *000) 1 1 1,xx0x0 trans(*000) xx0x0000",
, "match(000x00000xx, 000*) 1 1 1,x00000xx trans(000*) 000x00",
|| "000xx",
, "match(000xx, *0*) 1 1 2,00,xx trans(ab*cd*ef) ab00cdxxef"
call tstOut t, matchTest1('eins', 'e?n*' )
call tstOut t, matchTest1('eins', 'eins' )
call tstOut t, matchTest1('e1nss', 'e?n*', '?*' )
call tstOut t, matchTest1('eiinss', 'e?n*' )
call tstOut t, matchTest1('einss', 'e?n *' )
call tstOut t, matchTest1('ein s', 'e?n *' )
call tstOut t, matchTest1('ein abss ', '?i*b*' )
call tstOut t, matchTest1('ein abss wie gehtsssxdirx und auch ' )
call tstOut t, matchTest1('ies000', '*000' )
call tstOut t, matchTest1('xx0x0000', '*000' )
call tstOut t, matchTest1('000x00000xx', '000*' )
call tstOut t, matchTest1('000xx', '*0*', 'ab*cd*ef' )
call tstEnd t
return
matchTest1:
parse arg w, m, m2
r = 'match('w',' m')' match(w, m) match(w, m, vv) m.vv.0
do x=1 to m.vv.0
r = r','m.vv.x
end
if m2 = '' then
m2 = translate(m)
if m.vv.0 >= 0 then
r = r 'trans('m2')' matchTrans(m2, vv)
return r
endProcedure matchTest1
tstSqlUtils: procedure expose m.
call sqlConnect 'DBAF'
id = 'A540769.dsnUtils'
rst = 'NO'
retcode = -9876
e = ''
z = 0
st = "TEMPLATE TCOPYD",
"DSN('&SSID..&JO..&US..P&PART(2)..D&DATE(3)..T&TIME.')",
"DATACLAS(NULL12) MGMTCLAS(COM#A011) STORCLAS(FAR$N)",
"SPACE (150,3750) TRK UNCNT 59;",
"listdef abc include tablespace DA540769.A002* partlevel;",
"listdef mf include tablespace MF01A1A.A110A partlevel;",
"copy list abc copyddn(tcopyd) shrlevel change;"
upper st
call sqlExec "call SYSPROC.DSNUTILS ( :id, :rst,",
":st,:retcode, :ANY" copies(',:e,:e,:z',12) ")"
call sqlExec ,
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE SYSPROC.DSNUTILS'
say 'results' results
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS'
say 'allocated c111'
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0
say 'sysPrint' seq strip(txt, 't')
end
call sqlExec 'close c111'
say 'closed'
call sqlDisconnect
exit
endProcedure tstSqlUtils
tstSqlStored: procedure expose m.
call sqlConnect 'DBAF'
rst = 'NO'
retcode = -9876
e = ''
z = 0
st = "abc"
call sqlExec "call SYSPROC.COMMAND ( :st, :rst)"
say 'after call st='st 'rst='rst
call sqlExec ,
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE SYSPROC.COMMAND'
say 'results' results
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS'
say 'allocated c111'
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0
say 'sysPrint' seq strip(txt, 't')
end
call sqlExec 'close c111'
say 'closed'
call sqlDisconnect
return
endProcedure tstSqlStored
tstSqlStoredWK: procedure expose m.
call sqlConnect 'DBAF'
/* st = "direct wkUtiSub"
rst = 'NO'
say 'before call st='st 'rst='rst
call sqlExec "call A540769.WKUTILSUB ( :st, :rst)"
say 'after call st='st 'rst='rst
*/ rst = 'NO'
retcode = -9876
e = ''
z = 0
prc = 'DB2UTIL.DB2UTIL'
st = "DA540769.A2*" /* DA540769.A1*" */
say "call" prc "("st", ...)"
call sqlExec "call" prc "(:st, :rst)"
say 'after call st='st 'rst='rst
call sqlExec ,
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE' prc
/* say 'results' results */
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS'
say ''
say '***** utility output'
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0
say 'sysPrint' seq strip(txt, 't')
end
call sqlExec 'close c111'
say '***** end output'
call sqlDisconnect
return 0
endProcedure tstSqlStoredWK
tstSqlStoredSQL1: procedure expose m.
call sqlConnect 'DBIA'
rst = 'NO'
retcode = -9876
e = ''
z = 0
st = "DA540769.A2* DA540769.A1*"
call sqlExec "call A540769.WKSQL1 ( :st, :rst)"
say 'after call st='st 'rst='rst
call sqlExec ,
'ASSOCIATE LOCATOR (:RESULTS) WITH PROCEDURE A540769.WKUTIL'
say 'results' results
call sqlExec 'ALLOCATE C111 CURSOR FOR RESULT SET :RESULTS'
say 'allocated c111'
do while sqlExec('fetch c111 into :seq, :txt', 0 100) = 0
say 'sysPrint' seq strip(txt, 't')
end
call sqlExec 'close c111'
say 'closed'
call sqlDisconnect
return
endProcedure tstSqlStoredSQL1
tstSqlTriggerTiming:
parse upper arg tb ni
m.noInsert = ni == 0
cnt = 200000
if tb = '' then
TB = 'GDB9998.TWK511TRI'
call sqlConnect dbaf
say timing() 'noInsert' m.noInsert 'tb' tb
call sql2St 49, '*', cc, 'select max(pri) MX from' tb
if m.cc.1.mx == m.sqlNull then
m.cc.1.mx = 0
von = m.cc.1.mx + 1
bis = m.cc.1.mx + cnt
say m.cc.0 'max' m.cc.1.mx 'von' von 'bis' bis 'count' cnt tb
if right(tb, 2) = 'A1' then do
call sqlPrepare 3, 'insert into' tb '(pri, short, long, par)' ,
'values (?, ?, ?, ?)'
do ax=von to bis
call sqlExecute 3, ax,
, ax 'wsh short', ax 'wsh long long long long long ',
, (ax-1) // 1000 + 1
end
end
else do
call sqlPrepare 3, 'insert into' tb '(pri, short, long)' ,
'values (?, ?, ?)'
do ax=von to bis
call sqlExecute 3, ax,
, ax 'wsh short', ax 'wsh long long long long long ',
, (ax-1) // 1000 + 1
end
end
/* call sqlLn 5,,, 'select * from' tb 'where pri >=' von */
call sqlExImm 'commit'
say timing()
call sqlDisconnect
return
endProcedure tstSqlTriggerTiming
tstSql: procedure expose m.
cx = 2
call tst t, "tstSql",
, "*** err: sqlCode -204 A540769.SYSDUMMY IS AN UNDEFINED NAM",
|| "E ",
, " e 1: warnings",
, " e 2: state 42704",
, " e 3: stmt = execSql prepare s7 from :src",
, " e 4: with src = select * from sysdummy",
, "fetchA 1 ab= m.abcdef.123.AB abc ef= efg",
, "fetchA 0 ab= m.abcdef.123.AB abc ef= efg",
, "sqlVars :M.STST.A :M.STST.A.SQLIND, :M.STST.B :M.STST.B.SQ",
|| "LIND, :M.STST.C :M.STST.C.SQLIND",
, "1 all from dummy1",
, "a=a b=2 c=0",
, "sqlVarsNull 1",
, "a=a b=2 c=---",
, "fetchBT 1 SYSTABLES",
, "fetchBT 0 SYSTABLES",
, "fetchBI 1 SYSINDEXES",
, "fetchBI 0 SYSINDEXES"
call mAdd t.cmp,
, "opAllCl 3",
, "fetchC 1 SYSTABLES",
, "fetchC 2 SYSTABLESPACE",
, "fetchC 3 SYSTABLESPACESTATS",
, "PreAllCl 3",
, "fetchD 1 SYSIBM.SYSTABLES",
, "fetchD 2 SYSIBM.SYSTABLESPACE",
, "fetchD 3 SYSIBM.SYSTABLESPACESTATS"
call sqlConnect 'DBAF'
src = 'select * from sysdummy'
call sqlExec 'prepare s7 from :src'
call sqlPrepare cx, "select 'abc' , 'efg'",
'from sysibm.sysDummy1'
call sqlExec 'declare c'cx 'cursor for s'cx
call sqlOpen cx
a = 'abcdef'
b = 123
do i=1 to 2
call jOut 'fetchA' sqlFetchInto(cx, ':m.a.b.ab, :m.a.b.ef') ,
'ab= m.'a'.' || b'.'ab m.a.b.ab 'ef=' m.a.b.ef
end
call sqlClose cx
drop stst a b c m.stst.a m.stst.b m.stst.c
sv = sqlVars('M.STST', A B C , 1)
call jOut 'sqlVars' sv
call jOut sqlPreAllCl(cx,
, "select 'a', 2, case when 1=0 then 1 else null end ",
"from sysibm.sysDummy1",
, stst, sv) 'all from dummy1'
call jOut 'a='m.stst.a 'b='m.stst.b 'c='m.stst.c
call jOut 'sqlVarsNull' sqlVarsNull(stst, A B C)
call jOut 'a='m.stst.a 'b='m.stst.b 'c='m.stst.c
call sqlPreDeclare cx, "select name" ,
"from sysibm.sysTables" ,
"where creator = 'SYSIBM' and name = ?"
call sqlOpen cx, 'SYSTABLES'
call jOut 'fetchBT' sqlFetchInto(cx, ':NM') nm
call jOut 'fetchBT' sqlFetchInto(cx, ':NM') nm
call sqlClose cx
call sqlOpen cx, 'SYSINDEXES'
a = 'a b c'
b = 1234565687687234
call jOut 'fetchBI' sqlFetchInto(cx, ':NM') nm
call jOut 'fetchBI' sqlFetchInto(cx, ':NM') nm
call sqlClose cx
src = "select name" ,
"from sysibm.sysTables" ,
"where creator = 'SYSIBM' and name like 'SYSTABLES%'",
"fetch first 3 rows only"
call sqlPreDeclare cx, src
st = 'wie geht'' s'
call jOut 'opAllCl' sqlOpAllCl(cx, st, ':M.ST.SX.NAME')
do x=1 to m.st.0
call jOut 'fetchC' x m.st.x.name
end
st = 'auch noch'
src = "select strip(creator) || '.' || strip(name)" substr(src,12)
call jOut 'PreAllCl' sqlPreAllCl(cx+11, src, st, ':M.ST.SX.NAME')
do x=1 to m.st.0
call jOut 'fetchD' x m.st.x.name
end
call sqlDisconnect
call tstEnd t
return
endProcedure tstSql
tstSqlO: procedure expose m.
call tst t, "tstSqlO",
, "*** err: sqlCode -204 A540769.SYSDUMMY IS AN UNDEFINED NAM",
|| "E ",
, " e 1: warnings",
, " e 2: state 42704",
, " e 3: stmt = execSql prepare s7 from :src",
, " e 4: with src = select * from sysdummy",
, "REQD=Y col=123 case=--- col5=anonym",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE ",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE ",
, "SYSTABLEPART_HI T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE ",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE",
, "SYSTABLEPART_HIST T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE"
call sqlConnect 'DBAF'
src = 'select * from sysdummy'
call sqlExec 'prepare s7 from :src'
call sql2Cursor 13,
, 'select d.*, 123, current timestamp "jetzt und heute",',
'case when 1=0 then 1 else null end caseNull,',
"'anonym'" ,
'from sysibm.sysdummy1 d'
call sqlOpen 13
do while sqlFetch(13, abc)
call jOut 'REQD='m.ABC.IBMREQD 'col='m.ABC.col2,
'case='m.ABC.CASENULL,
'col5='m.ABC.col5
je = 'jetzt'
jetzt = m.ABC.je
dd = date('s')
dd = left(dd, 4)'-'substr(dd, 5, 2)'-'right(dd, 2)'-' ,
|| left(time(), 2)'.'
say 'jetzt='jetzt 'date time' dd
if ^ abbrev(jetzt, dd) then
call err 'date mismatch abbrev' dd
end
call sqlClose 13
call sql2Cursor 13 ,
, 'select name, type, dbName, tsName' ,
/* ,alteredTS, obid, cardf'*/ ,
'from sysibm.systables' ,
"where creator = 'SYSIBM' and name like 'SYSTA%'" ,
"fetch first 5 rows only",
, , 'sl<15'
call sqlOpen 13
call jOut fmtFldTitle(m.sql.13.fmt)
do while sqlFetchLn(13, li)
call jOut m.li
end
call sqlClose 13
call sqlGenFmt m.sql.13.fmt, 13, 'sst'
call sqlOpen 13
do ix=1 while sqlFetch(13, fe.ix)
end
m.fe.0 = ix-1
call fmtFldSquash sqFmt, sqlType(13), fe
call jOut fmtFldTitle(sqFmt)
do ix=1 to m.fe.0
call jOut oFldCat(sqlType(13), fe.ix, sqFmt)
end
call sqlClose 13
if 0 then do
call sql2Cursor 13 ,
, 'select *',
'from sysibm.systables' ,
"where creator = 'SYSIBM' and name like 'SYSTA%'" ,
"fetch first 1 rows only",
, , 'sl<15'
call sqlOpen 13
call jOut fmtFldTitle(m.sql.13.fmt)
do while sqlFetchLn(13, li)
call jOut m.li
end
call sqlClose 13
end
call sqlDisconnect
call tstEnd t
return
endProcedure tstSqlO
tstSqlEnv: procedure expose m.
call tst t, "tstSqlEnv",
, "REQD=Y COL2=123 case=--- COL5=anonym",
, "sql fmtFldRw sl<15",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE ",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE ",
, "SYSTABLEPART_HI T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE ",
, "sql fmtFldSquashRW",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE",
, "SYSTABLEPART_HIST T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE",
, "sqlLn sl=",
, "COL1 T DBNAME COL4 ",
, "SYSTABAUTH T DSNDB06 SYSDBASE"
call mAdd t.cmp,
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE",
, "SYSTABLEPART_ T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE",
, "sqlLn ---",
, "NAME T DBNAME TSNAME ",
, "SYSTABAUTH T DSNDB06 SYSDBASE",
, "SYSTABCONST T DSNDB06 SYSOBJ ",
, "SYSTABLEPART T DSNDB06 SYSDBASE",
, "SYSTABLEPART_HIST T DSNDB06 SYSHIST ",
, "SYSTABLES T DSNDB06 SYSDBASE"
call sqlConnect 'DBAF'
call envBarBegin
call jOut 'select d.*, 123, current timestamp "jetzt und heute",'
call jOut 'case when 1=0 then 1 else null end caseNull,'
call jOut "'anonym'"
call jOut 'from sysibm.sysdummy1 d'
call envBar
call sql 13
call envBarLast
do while envRead(abc)
call jOut 'REQD='envGet('ABC.IBMREQD'),
'COL2='envGet('ABC.COL2'),
'case='envGet('ABC.CASENULL'),
'COL5='envGet('ABC.COL5')
jetzt = envGet('ABC.jetzt')
say 'jetzt='jetzt
dd = date('s')
dd = left(dd, 4)'-'substr(dd, 5, 2)'-'right(dd, 2)'-' ,
|| left(time(), 2)'.'
if ^ abbrev(jetzt, dd) then
call err 'date mismatch abbrev' dd
end
call envBarEnd
call jOut 'sql fmtFldRw sl<15'
call envBarBegin
call jOut 'select name, type, dbName, tsName'
/* ,alteredTS, obid, cardf'*/
call jOut 'from sysibm.systables'
call jOut "where creator = 'SYSIBM' and name like 'SYSTA%'"
call jOut "fetch first 5 rows only"
call envBar
call sql 13
call envBarLast
call fmtFldRW sqlGenFmt(fmtAbc, 13, 'sl<15')
call envBarEnd
call jOut 'sql fmtFldSquashRW'
call envBarBegin
call jOut 'select name, type, dbName, tsName'
/* ,alteredTS, obid, cardf'*/
call jOut 'from sysibm.systables'
call jOut "where creator = 'SYSIBM' and name like 'SYSTA%'"
call jOut "fetch first 5 rows only"
call envBar
call sql 13
call envBarLast
call fmtFldSquashRW
call envBarEnd
call jOut 'sqlLn sl='
call envBarBegin
call jOut 'select char(name, 13), type, dbName, char(tsName, 8)'
/* ,alteredTS, obid, cardf'*/
call jOut 'from sysibm.systables'
call jOut "where creator = 'SYSIBM' and name like 'SYSTA%'"
call jOut "fetch first 5 rows only"
call envBarLast
call sqlLn 13, , ,'sl='
call envBarEnd
call jOut 'sqlLn ---'
call envBarBegin
call jOut 'select name, type, dbName, tsName'
/* ,alteredTS, obid, cardf'*/
call jOut 'from sysibm.systables'
call jOut "where creator = 'SYSIBM' and name like 'SYSTA%'"
call jOut "fetch first 5 rows only"
call envBarLast
call sqlLn 13
call envBarEnd
call sqlDisconnect
call tstEnd t
return
endProcedure tstSqlEnv
/* copx tstSql end ***************************************************/
/* copx tstComp begin **************************************************
test the wsh comp
***********************************************************************/
tstComp: procedure expose m.
call compIni
call tstCompDataConst
call tstCompDataVars
call tstCompShell
call tstCompPrimary
call tstCompStmt
call tstCompDataIO
call tstCompPipe
call tstCompRedir
call tstCompComp
call tstTotal
return
endProcedure tstComp
tstCompRun: procedure expose m.
parse arg type cnt
src = jBuf()
call jOpen src, 'w'
do sx=2 to arg()
call jWrite src, arg(sx)
end
cmp = comp(src)
call jOut 'compile' type',' (sx-2) 'lines:' arg(2)
r = compile(cmp, type)
say "compiled: >>>>" r "<<<<" m.r.code
call jOut "run without input"
call mCut 'T.IN', 0
call oRun r
if cnt == 3 then do
call jOut "run with 3 inputs"
call mAdd 'T.IN', "eins zwei drei", "zehn elf zwoelf?",
, "zwanzig 21 22 23 24 ... 29|"
m.t.inIx = 0
call oRun r
end
return
endProcedure tstCompRun
tstCompDataConst: procedure expose m.
call tst t, 'tstCompDataConst',
, "compile d, 8 lines: Lline one, $** asdf",
, "run without input",
, " Lline one, ",
, "line two.",
, "line threecontinued on 4",
, "line five fortsetzung",
, "line six fortsetzung"
call tstCompRun 'd' ,
, ' Lline one, $** asdf',
, 'line two.',
, 'line three$*+ bla bla' ,
, 'continued on 4',
, 'line five $*( und so',
, 'weiter $abc $? $''$*)'' $"$*)" und weiter $*) fortsetzung',
, 'line six $*( und $*( $** $*( so',
, 'weiter $abc $? $*)'' $"$*)" und weiter $*) fortsetzung'
call tstEnd t
return
endProcedure tstCompDataComm
tstCompDataVars: procedure expose m.
call tst t, 'tstCompDataVars',
, "compile d, 4 lines: Lline one, $** asdf",
, "run without input",
, " Lline one, ",
, "lline zwei output",
, "lline 3 ",
, "variable v1 = valueV1 ${v1}= valueV1| "
call tstCompRun 'd' ,
, ' Lline one, $** asdf',
, ' $$ lline zwei output',
, 'lline 3 $=v1= valueV1 ' ,
, 'variable v1 = $v1 $"${v1}=" ${ v1 }| '
call tstEnd t
return
endProcedure tstCompDataVars
tstCompShell: procedure expose m.
call tst t, 'tstCompShell',
, "compile s, 9 lines: $$ Lline one, $** asdf",
, "run without input",
, "Lline one,",
, "lline zwei output",
, "v1 = valueV1 ${v1}= valueV1|",
, "REXX JOUT L5 CONTINUED L6 CONTINUED L7",
, "L8 ONE",
, "L9 END"
call tstCompRun 's' ,
, ' $$ Lline one, $** asdf',
, ' $$ lline zwei output',
, ' $=v1= valueV1 ' ,
, '$$ v1 = $v1 $"${v1}=" ${ v1 }| ' ,
, 'call jOut rexx jout l5, ' ,
, ' continued l6 , ' ,
, ' continued l7 ' ,
, 'call jOut l8 one ' ,
, 'call jOut l9 end'
call tstEnd t
return
endProcedure tstCompDataVars
tstCompPrimary: procedure expose m.
call tst t, 'tstCompPrimary',
, "compile d, 11 lines: Strings $""$""""$""""""""$"""""" $'$'",
|| "'$''''$'''",
, "run without input",
, "Strings $""$""""$"" $'$''$'",
, "rexx 3*5 = 15",
, "data line three line four bis hier",
, "shell line five line six bis hier",
, "var get v1 value Eins, v1 value Eins ",
, "var isDef v1 1, v2 0 ",
, "jIn eof 1",
, "var read >1 0 rr undefined",
, "jIn eof 2",
, "var read >2 0 rr undefined",
, "run with 3 inputs",
, "Strings $""$""""$"" $'$''$'",
, "rexx 3*5 = 15",
, "data line three line four bis hier",
, "shell line five line six bis hier",
, "var get v1 value Eins, v1 value Eins "
call mAdd t.cmp,
, "var isDef v1 1, v2 0 ",
, "<jIn 1< eins zwei drei",
, "var read >1 1 rr eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "var read >2 1 rr zehn elf zwoelf?"
call envRemove 'v2'
call tstCompRun 'd' 3 ,
, 'Strings $"$""$""""$"""' "$'$''$''''$'''",
, 'rexx 3*5 = $( 3 * 5 $)',
, 'data $-[ line three',
, 'line four $] bis hier',
, 'shell $-{ $$ line five',
, '$$ line six $} bis hier',
, '$= v1 = value Eins $=rr=undefined',
, 'var get v1 $v1, v1 ${ v1 } ',
, 'var isDef v1 ${? v$( 1 * 1 + 0 $) }, v2 ${?v2 } ',
, 'var read >1 ${> rr} rr $rr' ,
, 'var read >2 ${> rr} rr $rr'
call tstEnd t
return
endProcedure tstCompPrimary
tstCompStmt: procedure expose m.
call tst t, 'tstCompStmt1',
, "compile s, 8 lines: $= v1 = value eins $= v2 £ 3*5*7 ",
, "run without input",
, "data v1 value eins v2 105",
, "eins",
, "zwei",
, "drei",
, "vier",
, "fuenf",
, "elf",
, "zwoelf dreiZ ",
, "vierZ ",
, "fuenfZ",
, "lang v1 value eins v2 945",
, "oRun ouput 1"
call envPut 'oRun', oRunner('call jOut "oRun ouput" (1*1)')
call envRemove 'v2'
call tstCompRun 's' ,
, '$= v1 = value eins $= v2 £ 3*5*7 ',
, '$$ data v1 $v1 v2 ${ v2 }',
, '$$eins $@{$$ zwei $$ drei ',
, ' $@{ $} $@{ $@{ $$vier $} $} $} $$fuenf',
, '$$elf $@[ zwoelf dreiZ ',
, ' $@[ $] $@[ $@[ vierZ $] $] $] $$fuenfZ',
, '$£ "lang v1" $v1 "v2" ${v2}*9',
, '$@run $oRun'
call tstEnd t
call tst t, 'tstCompStmt2',
, "compile s, 1 lines: $@for qq $$ loop qq $qq",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "loop qq eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "loop qq zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "loop qq zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4"
call tstCompRun 's' 3 ,
, '$@for qq $$ loop qq $qq'
call tstEnd t
return
endProcedure tstCompStmt
tstCompDataIO: procedure expose m.
call tst t, 'tstCompDataHereData',
, "compile d, 13 lines: herdata $<<stop ",
, "run without input",
, " herdata ",
, "heredata 1 $x",
, "heredata 2 $y",
, "nach heredata",
, " herdata [ ",
, "heredata 1 xValue",
, "heredata 2 yValueY",
, "nach heredata [",
, " herdata { ",
, "HEREDATA 1 xValue",
, "heredata 2 yValueY",
, "nach heredata {"
call tstCompRun 'd' ,
, ' herdata $<<stop ',
, 'heredata 1 $x',
, 'heredata 2 $y',
, 'stop $$ nach heredata',
, ' herdata [ $<<[stop ',
, '$=x=xValue$=y=yValueY',
, 'heredata 1 $x',
, 'heredata 2 $y',
, 'stop $$ nach heredata [',
, ' herdata { $<<{st',
, 'call jOut heredata 1 $x',
, '$$heredata 2 $y',
, 'st $$ nach heredata {'
call tstEnd t
dsn = tstDsn('lib37', 'r')'(readInp)'
call mAdd mCut(abc, 0), 'readInp line 1', 'readInp line 2'
call writeDsn dsn '::f37', m.abc., ,1
call envPut 'dsn', dsn
call tst t, 'tstCompDataIO',
, "compile d, 4 lines: input 1 $<$dsn ::fb ",
, "run without input",
, " input 1 ",
, "readInp line 1 ",
, "readInp line 2 ",
, " nach dsn input und nochmals mit & ",
, "readInp line 1 ",
, "readInp line 2 ",
, " und schluiss."
call tstCompRun 'd' ,
, ' input 1 $<$dsn ::fb ',
, ' nach dsn input und nochmals mit & ' ,
, ' $<&dsn('dsn2jcl(dsn)') dd(xyz)',
, ' und schluiss.'
call tstEnd t
return
endProcedure tstCompDataIO
tstCompPipe: procedure expose m.
call tst t, 'tstCompPipe1',
, "compile s, 1 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "(1 eins zwei drei 1)",
, "<jIn 2< zehn elf zwoelf?",
, "(1 zehn elf zwoelf? 1)",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "(1 zwanzig 21 22 23 24 ... 29| 1)",
, "jIn eof 4"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"'
call tstEnd t
call tst t, 'tstCompPipe2',
, "compile s, 2 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "[2 (1 eins zwei drei 1) 2]",
, "[2 (1 zehn elf zwoelf? 1) 2]",
, "[2 (1 zwanzig 21 22 23 24 ... 29| 1) 2]"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"' ,
, ' $! call envPreSuf "[2 ", " 2]"'
call tstEnd t
call tst t, 'tstCompPipe3',
, "compile s, 3 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "<3 [2 (1 eins zwei drei 1) 2] 3>",
, "<3 [2 (1 zehn elf zwoelf? 1) 2] 3>",
, "<3 [2 (1 zwanzig 21 22 23 24 ... 29| 1) 2] 3>"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"' ,
, ' $! call envPreSuf "[2 ", " 2]"',
, ' $! call envPreSuf "<3 ", " 3>"'
call tstEnd t
call tst t, 'tstCompPipe4',
, "compile s, 7 lines: call envPreSuf ""(1 "", "" 1)""",
, "run without input",
, "jIn eof 1",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "<3 [222 [221 [21 [20 (1 eins zwei drei 1) 20] 21] 221] 222",
|| "] 3>",
, "<3 [222 [221 [21 [20 (1 zehn elf zwoelf? 1) 20] 21] 221] 22",
|| "2] 3>",
, "<3 [222 [221 [21 [20 (1 zwanzig 21 22 23 24 ... 29| 1) 20]",
|| " 21] 221] 222] 3>"
call tstCompRun 's' 3 ,
, ' call envPreSuf "(1 ", " 1)"' ,
, ' $! $@{ call envPreSuf "[20 ", " 20]"',
, ' $! call envPreSuf "[21 ", " 21]"',
, ' $! $@{ call envPreSuf "[221 ", " 221]"',
, ' $! call envPreSuf "[222 ", " 222]"',
, '$} $} ',
, ' $! call envPreSuf "<3 ", " 3>"'
call tstEnd t
return
endProcedure tstCompPipe
tstCompRedir: procedure expose m.
call tst t, 'tstCompRedir',
, "compile s, 5 lines: $>#eins $@for vv $$<$vv> $; ",
, "run without input",
, "jIn eof 1",
, "output eins ",
, "output piped zwei ",
, "run with 3 inputs",
, "<jIn 1< eins zwei drei",
, "<jIn 2< zehn elf zwoelf?",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "jIn eof 4",
, "output eins <eins zwei drei> <zehn elf zwoelf?> <zwanzig 2",
|| "1 22 23 24 ... 29|>",
, "output piped zwei ab<eins zwei drei>yz ab<zehn elf zwoelf?",
|| ">yz ab<zwanzig 21 22 23 24 ... 29|>yz"
dsn = tstDsn('libvb', 'r')'(redir1)'
call envPut 'dsn', dsn
call tstCompRun 's' 3 ,
, ' $>#eins $@for vv $$<$vv> $; ',
, ' $$ output eins $-{$<#eins$}$; ',
, ' $@for ww $$b${ww}y ',
, ' $> $dsn ::v $! call envPreSuf "a", "z" $<# eins',
, '$;$$ output piped zwei $-{$<$dsn$} '
call tstEnd t
return
endProcedure tstCompRedir
tstCompComp: procedure expose m.
call tst t, 'tstCompCompShell',
, "compile s, 5 lines: $$compiling shell $; $= rrr = $-cmpShe",
|| "ll $<<aaa",
, "run without input",
, "compiling shell",
, "running einmal",
, "RUN 1 COMPILED einmal",
, "jIn eof 1",
, "running zweimal",
, "RUN 1 COMPILED zweimal",
, "jIn eof 2",
, "run with 3 inputs",
, "compiling shell",
, "running einmal",
, "RUN 1 COMPILED einmal",
, "<jIn 1< eins zwei drei",
, "compRun eins zwei dreieinmal"
call mAdd t'.CMP',
, "<jIn 2< zehn elf zwoelf?",
, "compRun zehn elf zwoelf?einmal",
, "<jIn 3< zwanzig 21 22 23 24 ... 29|",
, "compRun zwanzig 21 22 23 24 ... 29|einmal",
, "jIn eof 4",
, "running zweimal",
, "RUN 1 COMPILED zweimal",
, "jIn eof 5"
call tstCompRun 's' 3 ,
, "$$compiling shell $; $= rrr = $-cmpShell $<<aaa",
, "call jOut run 1*1*1 compiled $cc; $@for v $$ compRun $v$cc",
, "aaa $;",
, "$=cc=einmal $$ running $cc $@run $rrr",
, "$=cc=zweimal $$ running $cc $@run $rrr"
call tstEnd t
call tst t, 'tstCompCompData',
, "compile s, 5 lines: $$compiling data $; $= rrr = $-cmpData",
|| " $<<aaa",
, "run without input",
, "compiling data",
, "running einmal",
, "call jOut run 1*1*1 compiled einmal",
, "running zweimal",
, "call jOut run 1*1*1 compiled zweimal",
, "run with 3 inputs",
, "compiling data",
, "running einmal",
, "call jOut run 1*1*1 compiled einmal",
, "running zweimal",
, "call jOut run 1*1*1 compiled zweimal"
call tstCompRun 's' 3 ,
, "$$compiling data $; $= rrr = $-cmpData $<<aaa",
, "call jOut run 1*1*1 compiled $cc",
, "aaa $;",
, "$=cc=einmal $$ running $cc $@run $rrr",
, "$=cc=zweimal $$ running $cc $@run $rrr"
call tstEnd t
return
endProcedure tstCompComp
/* copx tstComp end *************************************************/
/* copx tstBase begin **************************************************
test the basic classes
***********************************************************************/
tstBase: procedure expose m.
call tstM
call tstMap
call tstMapVia
call tstScan
call tstO
call tstJsay
call tstJ
call tstJ2
call tstCat
call tstScanRead
call tstScanWin
call tstScanSQL
call tstEnv
call tstEnvCat
call tstEnvLazy
call tstEnvVars
call tstCatDsn
call tstTotal
return
endProcedure tstBase
tstTstSay: procedure
call tst x, 'test eins', "test eins einzige testZeile"
call tstOut x, "test eins einzige testZeile"
call tstEnd x
call tst x, 'test zwei', "zwei 1. testZeile",
, "zwei 2. und letsdfazte testZeile"
call tstOut x, "zwei 1. testZeile"
call tstOut x, "zwei 2. und letzte testZeile"
call tstEnd x
call tst y, 'test drei',
, "drei 1. testZeile",
, "drei 2. tEstZeile",
, "drei 3. testZeile test line drei ganz lang 1 ",
|| " ...line drei ganz lang 2 ",
|| " ...line drei ganz lang 3 .",
|| "..line drei ganz lang 4 und schluss."
call tstOut y, 'drei 1. testZeile'
call tstOut y, 'drei 2. testZeile'
call tstOut y, 'drei 3. testZeile',
'test line drei ganz lang 1 ',
' ...line drei ganz lang 2 ',
' ...line drei ganz lang 3 ',
' ...line drei ganz lang 4 und schluss.'
call tstEnd y
call tstTotal
endProcedure tstTstSay
tstM: procedure
call tst t, 'tstM',
, "symbol m.b LIT",
, "mInc b 2 m.b 2",
, "symbol m.a LIT",
, "mAdd a A.2",
, "mAdd a A.3",
, "m.a: 3: 1=eins 2=zwei 3=drei 4=M.A.4",
, "m.c: 5: 1=c vor AddSt a 2=eins 3=zwei",
, " 4=drei 5=c nach addSt a 6=M.C.6"
call tstOut t, 'symbol m.b' symbol('m.b')
m.b = 1
call tstOut t, 'mInc b' mInc(b) 'm.b' m.b
call tstOut t, 'symbol m.a' symbol('m.a')
call tstOut t, 'mAdd a' mAdd(mCut(a, 0), 'eins', 'zwei')
call tstOut t, 'mAdd a' mAdd(a, 'drei')
call tstOut t, 'm.a:' m.a.0': 1='m.a.1 '2='m.a.2 '3='m.a.3 '4='m.a.4
call mAdd mCut(c, 0), 'c vor AddSt a'
call mAddSt c, a
call mAdd c, 'c nach addSt a'
call tstOut t, 'm.c:' m.c.0': 1='m.c.1 '2='m.c.2 '3='m.c.3
call tstOut t, ' 4='m.c.4 '5='m.c.5 '6='m.c.6
call tstEnd t
return
endProcedure tstM
tstMap: procedure expose m.
m = mapNew('K')
ky = mapKeys(m)
say '***mapNew' m 'keys' ky
call tst t, 'tstMap',
, "map "m": zwei --> 2",
, "map "m": Zwei is not defined",
, "map stem "ky" 4",
, "map "m": eins --> 1",
, "map "m": zwei --> 2",
, "map "m": drei --> 3",
, "map "m": vier --> 4",
, "*** err: duplicate key in mAdd("m", eins, 1)",
, "map "m": zwei is not defined",
, "q 2 zw dr",
, "map stem Q 2",
, "map Q: zw --> 2Q",
, "map Q: dr --> 3Q",
, "map stem "m" 3",
, "map "m": eins --> 1",
, "map "m": zwei --> 2PUT",
, "map "m": vier --> 4PUT",
, "*** err: duplicate key in mAdd("m", zwei, 2ADDDUP)"
call mapAdd m, 'eins', 1
call mapAdd m, 'zwei', 2
call mapAdd m, 'drei', 3
call mapAdd m, 'vier', 4
call tstMapShow m, 'zwei'
call tstMapShow m, 'Zwei'
call tstMapShowSt m, mapKeys(m)
call mapAdd m, 'eins', 1
call mapReset m, '='
call tstMapShow m, 'zwei'
call mapAdd m, 'eins', 1
call mapAdd m, 'zwei', 2
call mapPut m, 'zwei', 2Put
call mapPut m, 'vier', 4Put
call mapReset q, '='
call mapAdd q, 'zw', 2q
call mapAdd q, 'dr', 3q
call tstOut t, 'q' m.q.0 m.q.1 m.q.2
call tstMapShowSt q, mapKeys(q)
call tstMapShowSt m, mapKeys(m)
call mapAdd m, 'zwei', 2addDup
call tstEnd t
return
endProcedure tstMap
tstMapVia: procedure expose m.
call tst t, 'tstMap',
, "map M: K --> A",
, "mapVia(m, K) A",
, "*** err: missing m.A at 3 in mapVia(M, K*)",
, "mapVia(m, K*) M.A",
, "mapVia(m, K*) valAt m.a",
, "mapVia(m, K*) valAt m.a",
, "*** err: missing m.A.aB at 5 in mapVia(M, K*aB)",
, "mapVia(m, K*aB) M.A.aB",
, "mapVia(m, K*aB) valAt m.A.aB",
, "*** err: missing m.valAt m.a at 4 in mapVia(M, K**)",
, "mapVia(m, K**) M.valAt m.a",
, "mapVia(m, K**) valAt m.valAt m.a",
, "mapVia(m, K**F) valAt m.valAt m.a.F"
drop m.a.
call mapReset m
call mapAdd m, k, a
call tstMapShow m, k
call tstOut t, 'mapVia(m, K) ' mapVia(m, 'K')
call tstOut t, 'mapVia(m, K*) ' mapVia(m, 'K*')
m.a = 'valAt m.a'
call tstOut t, 'mapVia(m, K*) ' mapVia(m, 'K*')
call tstOut t, 'mapVia(m, K*) ' mapVia(m, 'K*')
call tstOut t, 'mapVia(m, K*aB) ' mapVia(m, 'K*aB')
u='A.aB'
m.u = 'valAt m.'u
call tstOut t, 'mapVia(m, K*aB) ' mapVia(m, 'K*aB')
call tstOut t, 'mapVia(m, K**) ' mapVia(m, 'K**')
u= m.a
m.u = 'valAt m.'u
m.u.f = 'valAt m.'u'.F'
call tstOut t, 'mapVia(m, K**) ' mapVia(m, 'K**')
call tstOut t, 'mapVia(m, K**F) ' mapVia(m, 'K**F')
call tstEnd t
return
endProcedure tstMapVia
tstMapShow: procedure expose m.
parse arg a, key
if mapHasKey(a, key) then
call tstOut t, 'map' a':' key '-->' mapGet(a, key)
else
call tstOut t, 'map' a':' key 'is not defined'
return
endProcedure tstMapShow
tstMapShowSt: procedure expose m.
parse arg a, st
call tstOut t, 'map stem' st m.st.0
do wx=1 to m.st.0
call tstMapShow a, m.st.wx
end
return
endProcedure tstMapShow
tstJsay: procedure expose m.
call jIni
call jOut 'out eins'
call jOut 'out zwei jIn' jIn(vv) 'vv='vv
vv = 'value'
call jOut 'out drei jIn' jIn(vv) 'vv='vv 'Schluss'
return
endProcedure tstJsay
tstJ: procedure expose m.
call jIni
oldJin = m.j.jIn
oldJOut = m.j.jOut
m.j.jIn = t
m.j.jOut = t
b = jOpen(jBuf(), 'w')
call tst t, "tstJ",
, "out eins",
, "<jIn 1< tst in line 1 eins ,",
, "1 jIn() tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "2 jIn() tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "3 jIn() tst in line 3 drei |",
, "jIn eof 4",
, "jIn() 3 reads vv VV",
, "line buf line one",
, "line buf line two",
, "line buf line three",
, "line buf line four",
, "*** err: jWrite(" || b", buf line four) but not ope",
|| "ned w"
call jOut 'out eins'
do lx=1 by 1 while jIn(var)
call jOut lx 'jIn()' m.var
end
call jOut 'jIn()' (lx-1) 'reads vv' vv
call jWrite b, 'buf line one'
call mAdd m.b.stem, 'buf line two', 'buf line three'
call jWrite b, 'buf line four'
call jOpen b, 'r'
do while (jRead(b, line))
call jOut 'line' m.line
end
call jWrite b, 'buf line four'
call jClose b
call tstEnd t
return
endProcedure tstJ
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
tstCat: procedure expose m.
call catIni
call tst t, "tstCat",
, "catRead 1 line 1",
, "catRead 2 line 2",
, "catRead 3 line 3",
, "appRead 1 line 1",
, "appRead 2 line 2",
, "appRead 3 line 3",
, "appRead 4 append 4",
, "appRead 5 append 5"
i = cat('£', jBuf('line 1', 'line 2'), '£', jBuf('line 3'))
call jOpen i, 'r'
do lx=1 by 1 while jRead(i, v)
call tstOut t, 'catRead' lx m.v
end
call jOpen i, 'a'
call jWrite i, 'append 4'
call jWrite i, 'append 5'
call jOpen i, 'r'
do lx=1 by 1 while jRead(i, v)
call tstOut t, 'appRead' lx m.v
end
call tstEnd t
return
endProcedure tstCat
tstJ2: procedure expose m.
call jIni
call tst t, "tstJ2",
, "b read EINS feld eins, ZWEI feld zwei, DREI feld drei",
, "b read EINS feld eins, ZWEI feld zwei 2, DREI feld drei",
, "c read EINS feld eins, ZWEI feld zwei, DREI drei cat 1",
, "c read EINS feld eins, ZWEI feld zwei 2, DREI drei cat 2"
ty = oFldNew('Tst*', , , 'EINS = ZWEI = DREI =')
m.qq.eins = 'feld eins'
m.qq.zwei = 'feld zwei'
m.qq.drei = 'feld drei'
b = jBuf()
call oSetTypePara b, ty
call jOpen b, 'w'
call jWrite b, qq
m.qq.zwei = 'feld zwei 2'
call jWrite b, qq
call jOpen b, 'r'
c = jOpen(cat(), 'w')
call oSetTypePara c, ty
do xx=1 while jRead(b, res)
call jOut 'b read EINS' m.res.eins', ZWEI' m.res.zwei,
|| ', DREI' m.res.drei
m.res.drei = 'drei cat' xx
call jWrite c, res
end
call jOpen c, 'r'
do while jRead(c, ccc)
call jOut 'c read EINS' m.ccc.eins', ZWEI' m.ccc.zwei,
|| ', DREI' m.ccc.drei
end
call tstEnd t
return
endProcedure tstJ2
tstCatDsn: procedure expose m.
call catIni
call tst t, "tstCatDsn",
, "write read 0 last 10 vor anfang",
, "write read 1 last 80 links1 1 und rechts | .",
, "write read 2 last 80 liinks2 2 und rechts | .",
, "write read 5 last 80 links5 5 rechts5",
, "write read 99 last 80 links99 99 rechts",
, "write read 100 last 80 links100 100 rechts",
, "write read 101 last 80 links101 101 rechts",
, "write read 999 last 80 links999 999 rechts",
, "write read 1000 last 80 links1000 1000 rechts",
, "write read 1001 last 80 links1001 1001 rechts",
, "write read 2109 last 80 links2109 2109 rechts",
, "out > eins 1 ",
|| " ",
, "out > eins 2 schluss. ",
|| " ",
, "buf eins",
, "buf zwei",
, "buf drei",
, "out > zwei mit einer einzigen Zeile ",
|| " ",
, " links1 1 und rechts | . ",
|| " "
pds = tstDsn('lib', 'r')
call tstCatDsnWr pds, 0, ' links0', ' und rechts | . '
call tstCatDsnWr pds, 1, ' links1', ' und rechts | . '
call tstCatDsnWr pds, 2, 'liinks2', ' und rechts | . '
call tstCatDsnWr pds, 5, 'links5', 'rechts5'
call tstCatDsnWr pds, 99, 'links99', 'rechts'
call tstCatDsnWr pds, 100, 'links100', 'rechts'
call tstCatDsnWr pds, 101, 'links101', 'rechts'
call tstCatDsnWr pds, 999, 'links999', 'rechts'
call tstCatDsnWr pds, 1000, 'links1000', 'rechts'
call tstCatDsnWr pds, 1001, 'links1001', 'rechts'
call tstCatDsnWr pds, 2109, 'links2109', 'rechts'
pd2 = tstDsn('li2', 'r')
call envPush env('>', pd2'(eins) ::F')
call jOut 'out > eins 1'
call jOut 'out > eins 2 schluss.'
call envPop
call envPush env('>', pd2'(zwei) ::F')
call jOut 'out > zwei mit einer einzigen Zeile'
call envPop
b = jBuf("buf eins", "buf zwei", "buf drei")
call envPush env('<+', pd2'(eins) ::F', '+£', b,
,'+£', jBuf(), '+', pd2'(zwei)',
,'+', pds'(WR0)','', pds'(wr1)')
call envReadWrite
call envPop
call tstEnd t
return
endProcedure tstCatDsn
tstCatDsnWR: procedure expose m.
parse arg dsn, num, le, ri
io = catDsn(dsn'(wr'num') ::F')
call jOpen io, 'w'
do x = 1 to num
call jWrite io, le x ri
end
if num > 100 then
call catDsnReset io, dsn'(wr'num') ::F'
call jOpen io, 'r'
m.vv = 'vor anfang'
do x = 1 to num
if ^ jRead(io, vv) then
call err x 'not jRead'
else if m.vv <> le x ri then
call err x 'read mismatch' m.vv
end
if jRead(io, vv) then
call err x 'jRead'
if jRead(io, vv) then
call err x'+1 jRead'
call jClose io
call tstOut t, 'write read' num 'last' length(m.vv) strip(m.vv,'t')
return
endProcedure tstCatDsnRW
tstEnv: procedure expose m.
call envIni
c = jBuf()
call tst t, "tstEnv",
, "before envPush",
, "after envPop",
, "*** err: jWrite("c", write nach pop) but not op",
|| "ened w",
, "<jIn 1< tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "jIn eof 4",
, "before readWrite 2 c --> std",
, "before readWrite 1 b --> c",
, "b line eins",
, "b zwei |",
, "nach readWrite 1 b --> c",
, "add nach pop",
, "after push c only",
, "tst in line 1 eins ,",
, "tst in line 2 zwei ; "
call mAdd t'.CMP',
, "tst in line 3 drei |",
, "nach readWrite 2 c --> std",
, "*** err: jWrite("c", ) but not opened w"
call jOut 'before envPush'
b = jBuf("b line eins", "b zwei |")
call envPush env('<£', b, '>£', c)
call jOut 'before readWrite 1 b --> c'
call envReadWrite
call jOut 'nach readWrite 1 b --> c'
call envPop
call jOut 'after envPop'
call jWrite c, 'write nach pop'
call mAdd c'.BUF', 'add nach pop'
call envPush env('>>£', c)
call jOut 'after push c only'
call envReadWrite
call envPop
call envPush env('<£', c)
call jOut 'before readWrite 2 c --> std'
call envReadWrite
call jOut 'nach readWrite 2 c --> std'
call envPop
call jWrite c
call tstEnd t
return
endProcedure tstEnv
tstEnvCat: procedure expose m.
call tst t, "tstEnvCat",
, "c1 contents",
, "c1 line eins |",
, "before readWrite 1 b* --> c*",
, "b1 line eins|",
, "b2 line eins",
, "b2 zwei |",
, "c2 line eins |",
, "after readWrite 1 b* --> c*",
, "c2 contents",
, "c2 line eins |"
b0= jBuf()
b0= jBuf()
b1= jBuf("b1 line eins|")
b2 = jBuf("b2 line eins", "b2 zwei |")
c1 = jBuf("c1 line eins |")
c2 = jBuf("c2 line eins |")
call envPush env('<+£', b0, '<+£', b1, '<+£', b2, '<£', c2,
,'>>£', c1)
call jOut 'before readWrite 1 b* --> c*'
call envReadWrite
call jOut 'after readWrite 1 b* --> c*'
call envPop
call jOut 'c1 contents'
call envPush env('<£', c1)
call envReadWrite
call envPop
call envPush env('<£', c2)
call jOut 'c2 contents'
call envReadWrite
call envPop
call tstEnd t
return
endProcedure tstEnv
tstEnvBar: procedure expose m.
call tst t, 'tstEnvBar',
, "+0 vor envBarBegin",
, "<jIn 1< tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "jIn eof 4",
, "+7 nach envBarLast",
, "[7 +6 nach envBar 7]",
, "[7 +2 nach envBar 7]",
, "[7 +4 nach nested envBarLast 7]",
, "[7 (4 +3 nach nested envBarBegin 4) 7]",
, "[7 (4 (3 +1 nach envBarBegin 3) 4) 7]",
, "[7 (4 (3 tst in line 1 eins , 3) 4) 7]",
, "[7 (4 (3 tst in line 2 zwei ; 3) 4) 7]",
, "[7 (4 (3 tst in line 3 drei | 3) 4) 7]",
, "[7 (4 (3 +1 nach readWrite vor envBar 3) 4) 7]",
, "[7 (4 +3 nach preSuf vor nested envBarLast 4) 7]",
, "[7 +4 nach preSuf vor nested envBarEnd 7]"
call mAdd t.cmp,
, "[7 +5 nach nested envBarEnd vor envBar 7]",
, "[7 +6 nach readWrite vor envBarLast 7]",
, "+7 nach readWrite vor envBarEnd",
, "+8 nach envBarEnd"
call jOut '+0 vor envBarBegin'
call envBarBegin
call jOut '+1 nach envBarBegin'
call envReadWrite
call jOut '+1 nach readWrite vor envBar'
call envBar
call jOut '+2 nach envBar'
call envBarBegin
call jOut '+3 nach nested envBarBegin'
call envPreSuf '(3 ', ' 3)'
call jOut '+3 nach preSuf vor nested envBarLast'
call envBarLast
call jOut '+4 nach nested envBarLast'
call envPreSuf '(4 ', ' 4)'
call jOut '+4 nach preSuf vor nested envBarEnd'
call envBarEnd
call jOut '+5 nach nested envBarEnd vor envBar'
call envBar
call jOut '+6 nach envBar'
say '?? 6 call envReadWrite'
call envReadWrite
say 'jOut +6 nach readWrite vor envBarLast'
call jOut '+6 nach readWrite vor envBarLast'
call envBarLast
call jOut '+7 nach envBarLast'
call envPreSuf '[7 ', ' 7]'
call jOut '+7 nach readWrite vor envBarEnd'
call envBarEnd
call jOut '+8 nach envBarEnd'
call tstEnd t
return
endProcedure tstEnvBar
tstEnvLazy: procedure expose m.
call tst t, "tstEnvLazy",
, "vor envBarBegin",
, "vor 2 writeAll jIn inIx 0",
, "vor writeAll jBuf",
, "jBuf line 1",
, "jBuf line 2",
, "vor writeAll jIn inIx 0",
, "<jIn 1< tst in line 1 eins ,",
, "tst in line 1 eins ,",
, "<jIn 2< tst in line 2 zwei ; ",
, "tst in line 2 zwei ; ",
, "<jIn 3< tst in line 3 drei |",
, "tst in line 3 drei |",
, "jIn eof 4",
, "vor barLast inIx 0",
, "vor barEnd inIx 4",
, "nach barEnd"
call jOut 'vor envBarBegin'
call envBarBegin
call jOut 'vor writeAll jBuf'
call jWriteAll m.j.jOut, "£", jBuf('jBuf line 1', 'jBuf line 2')
call jOut 'vor writeAll jIn inIx' m.t.inIx
call jWriteAll m.j.jOut, "£-", m.j.jIn
call jOut 'vor barLast inIx' m.t.inIx
call envBarLast
call jOut 'vor 2 writeAll jIn inIx' m.t.inIx
call jWriteAll m.j.jOut, "£-", m.j.jIn
call jOut 'vor barEnd inIx' m.t.inIx
call envBarEnd
call jOut 'nach barEnd'
call tstEnd t
return
endProcedure tstEnvLazy
tstEnvVars: procedure expose m.
call tst t, "tstEnvVars",
, "put v1 value eins",
, "v1 hasKey 1 get value eins",
, "v2 hasKey 0",
, "via v1.fld via value",
, "one to theBur",
, "two to theBuf"
put1 = envPut('v1', 'value eins')
call tstOut t, 'put v1' put1
call tstOut t, 'v1 hasKey' envHasKey('v1') 'get' envGet('v1')
call tstOut t, 'v2 hasKey' envHasKey('v2')
if 0 then
call tstOut t, 'v2 get' envGet('v2')
m.put1.fld = 'via value'
call tstOut t, 'via v1.fld' envVia('v1*FLD')
call envPush env('>#', 'theBuf')
call jOut 'one to theBur'
call jOut 'two to theBuf'
call envPop
call envPush env('<#', 'theBuf')
call envReadWrite
call envPop
call tstEnd t
return
endProcedure tstEnvVars
tstScan: procedure expose m.
call tst t, 'tstScan.1',
, "scan src a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' ",
, "scan n tok 4: a034 key val ",
, "scan 1 tok 1: , key val ",
, "scan n tok 3: Und key val ",
, "scan v tok 1: key val ",
, "scan n tok 10: hr123sdfER key val ",
, "scan q tok 5: ""st1"" key val st1",
, "scan v tok 1: key val st1",
, "scan a tok 19: 'str2''mit''apo''s' key val str2'mit'apo's",
, "scan v tok 1: key val str2'mit'apo's"
call tstScan1 ,'l"litEins"l"litZwei"ndv" "aq1' ,
,"a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' "
call tstEnd t
call tst t, 'tstScan.2',
, "scan src a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' ",
, "scan n tok 4: a034 key val ",
, "scan 1 tok 1: , key val ",
, "scan n tok 3: Und key val ",
, "scan b tok 0: key val ",
, "scan n tok 10: hr123sdfER key val ",
, "scan s tok 5: ""st1"" key val st1",
, "scan b tok 0: key val st1",
, "scan s tok 19: 'str2''mit''apo''s' key val str2'mit'apo's",
, "scan b tok 0: key val str2'mit'apo's"
call tstScan1 , 'ndsb1' ,
,"a034,Und hr123sdfER""st1"" 'str2''mit''apo''s' "
call tstEnd t
call tst t, 'tstScan.3',
, "scan src a034,'wie 789abc",
, "scan n tok 4: a034 key val ",
, "scan 1 tok 1: , key val ",
, "*** err: scanErr ending Apostroph(') missing",
, " e 1: last token scanPosition 'wie 789abc",
, " e 2: pos 6 in string a034,'wie 789abc",
, "scan 1 tok 1: ' key val ",
, "scan n tok 3: wie key val ",
, "scan 1 tok 1: key val ",
, "*** err: scanErr illegal number end",
, " e 1: last token 789 scanPosition abc",
, " e 2: pos 14 in string a034,'wie 789abc",
, "scan d tok 3: 789 key val ",
, "scan n tok 3: abc key val "
call tstScan1 , 'nds1' ,
,"a034,'wie 789abc"
call tstEnd t
call tst t, 'jTestScan.4',
, "scan src litEinsefr 23 sdfER'str1'litZwei ""str2""""mit qu",
|| "o""s ",
, "scan l tok 7: litEins key val ",
, "scan n tok 3: efr key val ",
, "scan b tok 0: key val ",
, "scan d tok 2: 23 key val ",
, "scan b tok 0: key val ",
, "scan n tok 5: sdfER key val ",
, "scan a tok 6: 'str1' key val str1",
, "scan l tok 7: litZwei key val str1",
, "scan b tok 0: key val str1",
, "scan q tok 15: ""str2""""mit quo"" key val str2""mit quo",
, "scan n tok 1: s key val str2""mit quo",
, "scan b tok 0: key val str2""mit quo"
call tstScan1 , 'l"litEins"l"litZwei"ndbaq1' ,
,"litEinsefr 23 sdfER'str1'litZwei ""str2""""mit quo""s "
call tstEnd t
call tst t, 'jTestScan.5',
, "scan src aha;+-=f ab=cdEf eF='strIng' ",
, "scan b tok 0: key val ",
, "scan k tok 4: no= key aha val def",
, "scan 1 tok 1: ; key aha val def",
, "scan 1 tok 1: + key aha val def",
, "scan 1 tok 1: - key aha val def",
, "scan 1 tok 1: = key aha val def",
, "scan k tok 4: no= key f val def",
, "scan k tok 4: cdEf key ab val cdEf",
, "scan b tok 4: cdEf key ab val cdEf",
, "scan k tok 8: 'strIng' key eF val strIng",
, "scan b tok 8: 'strIng' key eF val strIng"
call tstScan1 , 'bk1'," aha;+-=f ab=cdEf eF='strIng' "
call tstEnd t
return
endProcedure tstScan
tstScanRead: procedure expose m.
call tst t, 'jTestScanRead',
, "name erste",
, "space",
, "name Zeile",
, "space",
, "nextLine",
, "nextLine",
, "space",
, "name dritte",
, "space",
, "name Zeile",
, "space",
, "name schluss",
, "space"
b = jBuf('erste Zeile ',,' dritte Zeile schluss ')
s = scanRead(b)
do while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.s.tok
else if scanVerify(s, ' ') then call tstOut t, 'space'
else if scanReadNL(s) then call tstOut t, 'nextLine'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanRead mit spaceLn',
, "name erste",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name dritte",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name schluss",
, "spaceLn"
s = scanRead(b)
do forever
if scanName(s) then call jOut 'name' m.s.tok
else if scanSpaceNL(s) then call jOut 'spaceLn'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
else leave
end
call tstEnd t
return
endProcedure tstScanRead
tstScanWin: procedure expose m.
call scanWinIni
call tst t, 'jTestScanWin',
, "info 0: last token scanPosition erste Zeile ",
|| " dritteZe\npos 1 in line 1: erste Zeile",
, "name erste",
, "spaceNL",
, "name Zeile",
, "spaceNL",
, "name dritteZeeeile",
, "info 5: last token dritteZeeeile scanPosition zeile4 ",
|| " fuenfueberSechs\npos 1 in line 4: zeile4",
, "spaceNL",
, "name zeile4",
, "spaceNL",
, "name fuenfueberSechsUnddSiebenUNDundUndUAcht",
, "spaceNL",
, "info 10: last token scanPosition undZehnueberElfundNochWe",
|| "iterZwoelfundim1\npos 9 in line 10: undZehn",
, "name undZehnueberElfundNochWeiterZwoelfundim13",
, "spaceNL",
, "name Punkt",
, "infoE 14: last token Punkt scanPosition \natEnd after line",
|| " 13: im13 Punkt"
b = jBuf('?erste Zeile?',,'? dritteZeeeile?', '? zeile4 ',
,'? fuenf?', '?ueberSechsUnddS?', '?iebenUNDundUndU?',
,'?Acht ?', '? ?', '? undZehn?',
,'?ueberElfundNoch?', '?WeiterZwoelfund?', '?im13 Punkt?')
s = scanWin(b, , , 2, 15)
call tstOut t, 'info 0:' scanInfo(s)
do sx=1 while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.s.tok
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
if sx // 5 = 0 then
call tstOut t, 'info' sx':' scanInfo(s)
end
call tstOut t, 'infoE' sx':' scanInfo(s)
call tstEnd t
call tst t, 'jTestScanRead',
, "info 0: last token scanPosition erste Zeile ",
|| " z3 com Ze\npos 1 in line 1: erste Zeile",
, "name erste",
, "spaceNL",
, "name Zeile",
, "spaceNL",
, "name z3",
, "info 5: last token z3 scanPosition com Zeeeile z4 come4 ",
|| " fuenf\npos 4 in line 3: z3 com Zeeeile",
, "spaceNL",
, "name z4",
, "spaceNL",
, "name fuenf",
, "spaceNL",
, "info 10: last token scanPosition com Sechs com siebe",
|| "n comAcht com\npos 15 in line 5: fuenf c",
, "name com",
, "spaceNL"
call mAdd t.cmp,
, "name Sechs",
, "spaceNL",
, "name com",
, "info 15: last token com scanPosition sieben comAcht c",
|| "om com com\npos 2 in line 7: m sieben com" ,
, "spaceNL",
, "name sieben",
, "spaceNL",
, "name Acht",
, "spaceNL",
, "info 20: last token scanPosition ueberElfundNochWeit com ",
|| "elfundim13\npos 1 in line 11: ueberElfundNoch",
, "name ueberElfundNochWeit",
, "spaceNL",
, "name im13",
, "spaceNL",
, "name Punkt",
, "info 25: last token Punkt scanPosition \natEnd after line ",
|| "13: im13 Punkt",
, "infoE 26: last token Punkt scanPosition \natEnd after line",
|| " 13: im13 Punkt"
b = jBuf('?erste Zeile?',,'? z3 com Zeeeile?', '? z4 come4 ',
,'? fuenf c?', '?om Sechs co?', '?m sieben com?',
,'?Acht com com ?', '? com ?', '? com undZehn?',
,'?ueberElfundNoch?', '?Weit com elfund?', '?im13 Punkt?')
s = scanWin(b, , , 2, 15)
call scanOpts s, , , 'com'
call tstOut t, 'info 0:' scanInfo(s)
do sx=1 while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.s.tok
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
if sx // 5 = 0 then
call tstOut t, 'info' sx':' scanInfo(s)
end
call tstOut t, 'infoE' sx':' scanInfo(s)
call tstEnd t
return
endProcedure tstScanWin
tstScanSql: procedure expose m.
call scanWinIni
call tst t, 'jTestScanSql id',
, "sqlId ABC",
, "spaceNL",
, "sqlId AB__345EF",
, "spaceNL"
b = jBuf('abc -- kommentar', right('ab_', 72), '_345ef-- kom')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlID(s) then call tstOut t, 'sqlId' m.s.val
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanSql delimited',
, "sqlDeId ABC",
, "spaceNL",
, "sqlDeId AB_3F",
, "spaceNL",
, "sqlDeId abc",
, "spaceNL",
, "sqlDeId ab_Ef",
, "spaceNL"
b = jBuf('abc -- kommentar',,' -- ',,right('ab_', 72),'3F-- kom',
, '"abc" -- ko', ' -- ',,right('"ab_', 72),'Ef"-- kom')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlDeID(s) then call tstOut t, 'sqlDeId' m.s.val
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanSql qualified',
, "sqlQuId ABC 1 ABC",
, "sqlQuId AB_3F 1 AB_3F",
, "sqlQuId abc 1 abc",
, "sqlQuId ab_Ef 1 ab_Ef",
, "sqlQuId EINS.Zwei.DREI 3 EINS",
, "sqlQuId vi er.fu enf 2 vi er"
b = jBuf('abc -- kommentar',,' -- ',,right('ab_', 72),'3F-- kom',
, '"abc" -- ko', ' -- ',right('"ab_', 72),'Ef"-- kom',
, 'eins."Zwei', '" -- com', ' . -- com', ' -- com',
, 'drei -- ko', '"vi er"."fu enf " -- co')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlQuID(s) then
call tstOut t, 'sqlQuId' m.s.val m.s.val.0 m.s.val.1
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanSql Num',
, "sqlNum 1",
, "spaceNL",
, "sqlNum 2",
, "spaceNL",
, "sqlNum .3",
, "spaceNL",
, "sqlNum 4.5",
, "spaceNL",
, "sqlNum +6",
, "spaceNL",
, "sqlNum +7.03",
, "spaceNL",
, "sqlNum -8",
, "spaceNL",
, "sqlNum -.9",
, "spaceNL"
call mAdd t.cmp,
, "sqlNum 1E2",
, "spaceNL",
, "sqlNum -2E-2",
, "spaceNL",
, "sqlNum +.3E+3",
, "spaceNL"
b = jBuf('1 2. .3 4.5 +6 + --kom', , ' -- com ', , ' 7.03 -8 - .9',
'1e2 - 2.e-2 + .3e+3')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlNum(s) then
call tstOut t, 'sqlNum' m.s.val
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else call scanErr s, 'cannot scan'
end
call tstEnd t
call tst t, 'jTestScanSql Num Unit',
, "sqlNumUnit 1 KB",
, "spaceNL",
, "sqlNumUnit .3 MB",
, "sqlNumUnit .5",
, "sqlNumUnit +6E-5 B",
, "spaceNL",
, "sqlNumUnit -7",
, "char *",
, "spaceNL",
, "sqlNumUnit -.8",
, "char T",
, "char B",
, "spaceNL",
, "*** err: scanErr scanSqlNumUnit after +9 bad unit TB",
, " e 1: last token Tb scanPosition ",
, " e 2: pos 41 in line 1: 1 kb .3mB.5 + 6.e-5B -7* -.8 ",
|| "TB + 9.Tb",
, "sqlNumUnit +9",
, "spaceNL"
b = jBuf('1 kb .3mB.5 + 6.e-5B -7* -.8 TB + 9.Tb')
s = scanSql(b)
do sx=1 while ^scanAtEnd(s)
if scanSqlNumUnit(s, 0, 'B KB MB') then
call tstOut t, 'sqlNumUnit' m.s.val
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else if scanChar(s ,1) then call tstOut t, 'char' m.s.tok
else call scanErr s, 'cannot scan'
end
call tstEnd t
return
call tst t, 'jTestScanRead',
, "info 0: last token scanPosition erste Zeile ",
|| " z3 com Ze\npos 1 in line 1: erste Zeile",
, "name erste",
, "spaceNL",
, "name Zeile",
, "spaceNL",
, "name z3",
, "info 5: last token z3 scanPosition com Zeeeile z4 come4 ",
|| " fuenf\npos 4 in line 3: z3 com Zeeeile",
, "spaceNL",
, "name z4",
, "spaceNL",
, "name fuenf",
, "spaceNL",
, "info 10: last token scanPosition com Sechs com siebe",
|| "n comAcht com\npos 15 in line 5: fuenf c",
, "name com",
, "spaceNL"
call mAdd t.cmp,
, "name Sechs",
, "spaceNL",
, "name com",
, "info 15: last token com scanPosition sieben comAcht c",
|| "om com com\npos 2 in line 7: m sieben com" ,
, "spaceNL",
, "name sieben",
, "spaceNL",
, "name Acht",
, "spaceNL",
, "info 20: last token scanPosition ueberElfundNochWeit com ",
|| "elfundim13\npos 1 in line 11: ueberElfundNoch",
, "name ueberElfundNochWeit",
, "spaceNL",
, "name im13",
, "spaceNL",
, "name Punkt",
, "info 25: last token Punkt scanPosition \natEnd after line ",
|| "13: im13 Punkt",
, "infoE 26: last token Punkt scanPosition \natEnd after line",
|| " 13: im13 Punkt"
b = jBuf('?erste Zeile?',,'? z3 com Zeeeile?', '? z4 come4 ',
,'? fuenf c?', '?om Sechs co?', '?m sieben com?',
,'?Acht com com ?', '? com ?', '? com undZehn?',
,'?ueberElfundNoch?', '?Weit com elfund?', '?im13 Punkt?')
s = scanWin(b, , ,'com', , , 2, 15)
call tstOut t, 'info 0:' scanInfo(s)
do sx=1 while ^scanAtEnd(s)
if scanName(s) then call tstOut t, 'name' m.s.tok
else if scanSpaceNL(s) then call tstOut t, 'spaceNL'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
if sx // 5 = 0 then
call tstOut t, 'info' sx':' scanInfo(s)
end
call tstOut t, 'infoE' sx':' scanInfo(s)
call tstEnd t
return
call tst t, 'jTestScanRead mit spaceLn',
, "name erste",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name dritte",
, "spaceLn",
, "name Zeile",
, "spaceLn",
, "name schluss",
, "spaceLn"
s = scanRead(b)
do forever
if scanName(s) then call jOut 'name' m.s.tok
else if scanSpaceNL(s) then call jOut 'spaceLn'
else if ^scanAtEnd(s) then call scanErr s, 'cannot scan'
else leave
end
call tstEnd t
return
endProcedure tstScanSql
/*--- one single test scan with lines to scan in stem ln -------------*/
tstScan1:
parse arg sc, types, ln
if sc == '' then do
call tstOut t, 'scan src' ln
call scanSrc scanReset(s), ln
end
else do
call tstOut t, 'scan scanner' sc
s = sc
end
do forever
x = tstScanType(s, types)
if x == '' then
leave
call tstOut t, 'scan' x 'tok' length(m.s.tok)':' m.s.tok ,
'key' m.s.key 'val' m.s.val
end
return
endProcedure tstScan1
tstScanType: procedure expose m.
parse arg s, opt
cx = 1
a2 = ''
do while cx <= length(opt)
f = substr(opt, cx, 1)
cx = cx + 1
if pos(substr(opt, cx, 1), "'""") > 0 then do
m.scan.type.src = opt
m.scan.type.pos = cx
call scanString 'SCAN.TYPE'
a2 = m.scan.type.val
cx = m.scan.type.pos
end
if f == 'a' then
res = scanString(s, "'")
else if f == 'b' then
res = scanSpaceNl(s)
else if f == 'c' then
res = scanChar(s, a2)
else if f == 'd' then
res = scanNat(s, a2)
else if f == 'k' then
res = scanKeyValue(s, 'def')
else if f == 'l' then
res = scanLit(s, a2)
else if f == 'n' then
res = scanName(s)
else if f == 'q' then
res = scanString(s, '"')
else if f == 's' then
res = scanString(s)
else if f == 'v' then
res = scanVerify(s, a2)
else if f == 'w' then
res = scanWord(s)
else if f == 'y' then
res = scanVerify(s, a2, 'm')
else if pos(f, '123456789') > 0 then
res = scanChar(s, f)
else
call err 'bad scanType' f
if res then
return f
end
return ''
endProcedure tstScanType
tstO: procedure expose m.
cR = oNewClass('R')
iR = 'O.C'm.o.cla.cR'I'
oo = 'call tstOut' t','
call oDecMethods cR, "print" oo "'Rprint' m a1",
, "say" oo "'Rsay ' m a2; return"
cS = oNewClass('S', "R")
is = 'O.C'm.o.cla.cS'I'
call oDecMethods cS, "print" oo "'Sprint' m a1; return",
, "quak" oo "'Squak ' m a3; return 'quak'a3"
call tst t, 'tstO',
, "class R with 2 methods",
, " print call tstOut T, 'Rprint' m a1",
, " say call tstOut T, 'Rsay ' m a2; return",
, "class S with 3 methods",
, " print call tstOut T, 'Sprint' m a1; return",
, " say call tstOut T, 'Rsay ' m a2; return",
, " quak call tstOut T, 'Squak ' m a3; return 'quak'a3",
, "oR.print call tstOut T, 'Rprint' m a1",
, "oS.print call tstOut T, 'Sprint' m a1; return",
, "oS.say call tstOut T, 'Rsay ' m a2; return",
, "Rsay "iR"1 arg oR say",
, "Rprint "iR"1 arg oR print",
, "Rsay "iS"1 arg oS say"
call mAdd t.cmp ,
, "Sprint "iS"1 arg oS print",
, "Squak "iS"1 arg oS quak",
, "quak: quakarg oS quak",
, "Rprint "iS"1 cast(os, R)",
, "Sprint "iS"1 cast(os, R), S)",
, "mutate oS R "iS"1",
, "Rprint "iS"1 mutate R",
, "oRun 7*3 21",
, "oRun 12*12 144"
cc = 'R S'
do cx=1 to words(cc)
cl = word(cc, cx)
call tstOut t, 'class' cl 'with' m.o.cla.cl.met.0 'methods'
do mx=1 to m.o.cla.cl.met.0
me = m.o.cla.cl.met.mx
call tstOut t, ' ' me m.o.cla.cl.met.me
end
end
oR = oNew(cR)
oS = oNew(cS)
call tstOut t, 'oR.print' oObjMethod(oR, 'print')
call tstOut t, 'oS.print' oObjMethod(oS, 'print')
call tstOut t, 'oS.say' oObjMethod(oS, 'say')
call tstClassRsay oR, 'arg oR say'
call tstClassRprint oR, 'arg oR print'
call tstClassRsay oS, 'arg oS say'
call tstClassRprint oS, 'arg oS print'
call tstOut t, 'quak:' tstClassSquak(oS, 'arg oS quak')
q1 = oCast(oS, 'R')
call tstClassRprint q1, 'cast(os, R)'
q2 = oCast(q1, 'S')
call tstClassRprint q2, 'cast(os, R), S)'
call tstOut t, 'mutate oS R' oMutate(oS, 'R')
call tstClassRprint oS, 'mutate R'
rr = oRunner('return 7 * 3')
call tstOut t, 'oRun 7*3' oRun(rr)
call oRunnerReset rr, 'return 12 * 12'
call tstOut t, 'oRun 12*12' oRun(rr)
call tstEnd t
return
endProcedure tstO
tstOType: procedure
call oIni
si = 'Simple'
call oFldNew 'T1', '=', '=', 'A = B ='
m.x.0 = 3
call oSay 'T1', x
call oSay 'Class', 'O.CLA.='
call oSay 'Class', 'O.CLA.Class'
call oClear 'Class', abc, 'abc'
call oSay 'Class', abc
call oTyCopy 'Class', abc, 'O.CLA.Class'
call oSay 'Class', abc
call oCopy efg, 'O.CLA.Class'
call oSay 'Class', efg
ff = oFlds('Class')
x = m.ff.0
say 'fields' x':' m.ff.1 m.ff.2 '...' m.ff.x
return
endProcedure tstOType
tstClassRprint: procedure expose m.
parse arg m, a1
interpret oObjMethod(m, 'print')
return
endProcedure tstClassRprint
tstClassRsay: procedure expose m.
parse arg m, a2
interpret oObjMethod(m, 'say')
endProcedure tstClassRsay
tstClassSquak: procedure expose m.
parse arg m, a3
interpret oObjMethod(m, 'quak')
endProcedure tstClassSquak
/* copx tstBase end *************************************************/
/* copx tst begin ****************************************************
test infrastructure
***********************************************************************/
/*--- return stems ---------------------------------------------------*/
/*--- make writerDescriptor m a testWriter
--- and use remaining lines as compare values -----------------*/
tst: procedure expose m.
parse arg m, nm
if m.tst.ini <> 1 then
call tstIni
m.m.name = nm
m.tst.act = m
m.tst.tests = m.tst.tests+1
call oMutate m, 'Tst'
m.m.jReading = 1
m.m.jWriting = 1
ox = 1
m.m.cmp.ox = left('****** start tst' nm '', 79, '*')
do ax=3 to arg()
ox = ox + 1
m.m.cmp.ox = arg(ax)
end
m.m.cmp.0 = ox
m.m.in.0 = 0
m.m.inIx = 0
m.m.out.0 = 0
m.m.err = 0
call mAdd m'.IN', 'tst in line 1 eins ,' ,
, 'tst in line 2 zwei ; ' ,
, 'tst in line 3 drei |'
call oMutate m, 'Tst'
if m.env.0 <> 1 then
call tstErr m, 'm.env.0' m.env.0 '<> 1'
call envPush env( '<-£', m, '>-£', m)
call tstOut m, m.m.cmp.1
return 'TST.'m
endProcedure tst
tstEnd: procedure expose m.
parse arg m, opt
m.tst.act = ''
call envPop
if m.env.0 <> 1 then
call tstErr m, 'm.env.0' m.env.0 '<> 1'
if m.m.out.0 ^= m.m.cmp.0 then do
call tstErr m, 'old' m.m.cmp.0 'lines ^= new' m.m.out.0
do nx = m.m.out.0 + 1 to min(m.m.out.0+10, m.m.cmp.0)
say 'old - ' m.m.cmp.nx
end
end
if m.m.err > 0 then do
say 'new lines:' (m.m.out.0 - 1)
len = 60
do nx=2 to m.m.out.0
str = quote(m.m.out.nx, '"')
pr = ' , '
do while length(str) > len
l=len
if substr(str, l-1, 1) = '"' then
if posCount('"', left(str, l-1)) // 2 = 0 then
l = l-1
say pr left(str, l-1)'",'
str = '"'substr(str, l)
pr = ' ||'
end
say pr str || left(',', nx < m.m.out.0)
end
end
say left('******' m.m.name 'end with' m.m.err 'errors ', 79,
, '*')
return
endProcedure tstEnd
/*--- write to test: say lines and compare them ----------------------*/
tstWrite: procedure expose m.
parse arg m, arg
call tstOut m, 'jOut:' arg
return
endProcedure tstWrite
tstOut: procedure expose m.
parse arg m, arg
call mAdd m'.OUT', arg
nx = m.m.out.0
if nx > m.m.cmp.0 then do
if nx = m.m.cmp.0+1 then
call tstErr m, 'more new Lines' nx
end
else if m.m.cmp.nx ^== arg then do
call tstErr m, 'next line old' nx '^^^ new overnext'
say m.m.cmp.nx
end
say arg
return
endProcedure tstOut
tstRead: procedure expose m.
parse arg m, arg
ix = m.m.inIx + 1
m.m.inIx = ix
if ix <= m.m.in.0 then do
m.arg = m.m.in.ix
call tstOut m, '<jIn' ix'<' m.arg
return 1
end
call tstOut m, 'jIn eof' ix
return 0
endProcedure tstRead
tstDsn: procedure
parse arg suf, opt
dsn = dsn2jcl('~tmp.tst.'suf)
if opt = 'r' & sysDsn("'"dsn"'") ^== 'DATASET NOT FOUND' then
call adrTso "delete '"dsn"'"
return dsn
endProcedure tstDsn
/*--- say total errors and fail if not zero --------------------------*/
tstTotal: procedure expose m.
say '******'
say '******'
say '******' m.tst.tests 'tests with' ,
m.tst.err 'errors in' m.tst.errNames
say '******'
say '******'
if m.tst.err ^== 0 then
call err m.tst.err 'errors total'
return
endProcedure tstTotal
/*--- test err: message, count it and continue -----------------------*/
tstErr: procedure expose m.
parse arg m, msg
say '*** error' msg
m.m.err = m.m.err + 1
m.tst.err = m.tst.err + 1
nm = m.m.name
if wordPos(nm, m.tst.errNames) < 1 then
m.tst.errNames = m.tst.errNames nm
return
endProcedure tstErr
/*--- tstErrHandler: intercept errors --------------------------------*/
tstErrHandler: procedure expose m.
parse arg ggTxt
if m.tst.act == '' then
call err ggTxt, '*'
call errSay ggTxt, tstErrHandler
call tstOut m.tst.act, '*** err:' m.tstErrHandler.1
do x=2 to m.tstErrHandler.0
call tstOut m.tst.act, ' e' (x-1)':' m.tstErrHandler.x
end
return 12
endSubroutine tstErrHandler
/*--- tstIni: global initialization ----------------------------------*/
tstIni: procedure expose m.
if m.tst.ini == 1 then
return
m.tst.ini = 1
call envIni
m.tst.err = 0
m.tst.errNames = ''
m.tst.tests = 0
m.tst.act = ''
call oDecMethods oNewClass("Tst", 'JRW'),
, "jRead return tstRead(m, var)",
, "jWrite call tstOut m, line"
call errReset 'h', 'return tstErrHandler(ggTxt)'
return
endProcedure tstIni
/*--- return the count of occurrences of needle in heyStack ----------*/
posCount: procedure
parse arg needle, hayStack, start, fin
if start = '' then
start = 1
if fin = '' then
fin = length(hayStack) + 1 - length(needle)
do cnt = 0 by 1
start = pos(needle, haystack, start)
if start < 1 | start > fin then
return cnt
start = start + length(needle)
end
endProcedure posCount
/* copx tst end **************************************************/
/* copy tstAll end **************************************************/