/*   */
parse upper arg Pgm .
'ERASE' Pgm 'COVERAGE A'
'STATE' Pgm 'TEST1 A'
IF rc ^= 0 then do
   say Pgm 'TEST1 A not found'
   exit 69
end
'STATE' Pgm 'COVCOB *'
IF rc ^= 0 then do
   say Pgm 'COVCOB * not found'
   exit 69
end
/* Combine test runs */
TestNum = 1
DO WHILE rc = 0
   'EXECIO * DISKR' Pgm 'TEST'||TestNum 'A (FINIS STEM TLINE.'
   IF TestNum = 1 then do
      call Init
   end
   ELSE do
      call Combine
   end
   TestNum = TestNum + 1
   'STATE' Pgm 'TEST'||TestNum 'A'
end
/* Count verbs and times executed */
VerbExec = 0
ModExec  = 0
DO i = 1 to cline.0
   IF word(cline.i,1) ^= 0 then VerbExec = VerbExec + 1
   IF word(cline.i,1) ^= 0 & word(cline.i,2) ^= 'U' then ModExec = ModExec + 1
end
/* Calculate percentages */
PCtoFix = (VerbExec * 100) / cline.0
call FixPC
TotCovPC = FixedPC
IF ModV
erbs = 0 then do
   ModCovPC = 'N/A'
end
ELSE do
   PCtoFix = (ModExec  * 100) / ModVerbs
   call FixPC
   ModCovPC = FixedPC
end
/* Write summary report */
queue 'Coverage Summary for Cobol program' Pgm
queue 'Number of Test Runs                      :' TestNum - 1
queue 'Number of COBOL Verbs                    :' cline.0
queue 'Number of COBOL Verbs Executed           :' VerbExec
queue 'Code Coverage                            :' TotCovPC
queue 'Statements Amended by Thesaurus          :' ModVerbs
queue 'Statements Amended by Thesaurus Executed :' ModExec
queue 'Thesaurus Amended Code Coverage          :' ModCovPC
queue ' '
queue 'Coverage Details for Cobol program' Pgm
queue ' '
queue 'Stmt Flags Count Code' q = queued()
'EXECIO' q 'DISKW' Pgm 'COVERAGE A' /* Write detail report */ 'EXECIO * DISKR' Pgm 'COVCOB * (FINIS STEM PLINE.' Proc = 'NO' LastVerb = '0000000' DO i = 1 to pline.0 IF substr(pline.i,7,1) = ' ' & substr(pline.i,73,8) ^= 'COVERAGE' then do CodeLine = substr(pline.i,8,65) Verbno = substr(pline.i,76,4) call TestLine end end 'EXECIO 0 DISKW' Pgm 'COVERAGE A (FINIS' exit Init: ModVerbs = 0 DO i = 1 to tline.0 parse upper var tline.i PgmT VerbT UseT Col80T . Junk IF Junk = '' & PgmT = Pgm & VerbT > 0 then do c = VerbT IF Col80T ^= 'U' then ModVerbs = ModVerbs + 1 cline.0 = c cline.c = UseT Col80T end end return Combine: DO i = 1 to tline.0 parse upper var tline.i PgmT VerbT UseT . . Junk IF Junk = '' & PgmT = Pgm & VerbT > 0 & VerbT < ( cline.0 + 1 ) then do c = VerbT CombUse = word(cline.c,1) + UseT CombCol80 = word(cline.c,2) cline.c = CombUse CombCol80 end end return FixPC: IF PCtoFix < 1 then do FixedPC = '< 1%' return end IF PCtoFix < 10 then do FixedPC = left(PCtoFix,1)'%' return end IF PCtoFix < 100 then do FixedPC = left(PCtoFix,2)'%' return end FixedPC = '100%' return Testline: IF VerbNo = ' ' then VerbNo = '0000' IF word(CodeLine,1) ^> ' ' then return IF left(word(CodeLine,1),4) = 'SKIP' then return IF word(CodeLine,1) = 'EJECT' then return IF Proc = 'NO' then do IF word(CodeLine,1) = 'PROCEDURE' then do Proc = 'YES' VerbNo = ' ' Y2K = ' ' Flag = ' ' ExecCount = ' ' call PutLine return end ELSE do return end end IF VerbNo = LastVerb then do VerbNo = ' ' Y2K = ' ' Flag = ' ' ExecCount = ' ' call PutLine return end LastVerb = VerbNo c = VerbNo + 0 IF word(cline.c,2) = 'U' then do Y2K = ' ' end ELSE do Y2K = 'Y2K' end IF word(cline.c,1) = '0' then do Flag = '*' end ELSE do Flag = ' ' end ExecCount = right(' 'word(cline.c,1),6) call PutLine return PutLine: queue VerbNo Y2K Flag ExecCount ' ' Codeline 'EXECIO 1 DISKW' Pgm 'COVERAGE A' return

© Copyright IT Doctors.co.uk. 2002