iSharkFly-Open
/
M-Unit
mirror of https://github.com/joelivey/M-Unit.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Version bump 1.3 -> 1.4

This commit is contained in:
Sam Habiel 2016-02-27 14:00:15 -08:00
parent 3ee0682664
commit bd1e639620
11 changed files with 1502 additions and 1502 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Routines/%ut.m
View File

@ -1,5 +1,5 @@
%ut ;VEN-SMH/JLI - PRIMARY PROGRAM FOR M-UNIT TESTING ;2015-12-31 10:46 PM
;;1.4;MASH UTILITIES;;Feb 25, 2016;Build 1
;;1.4;MASH;;Feb 27, 2016;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Joel L. Ivey as XTMUNIT while working for U.S. Department of Veterans Affairs 2003-2012
; Includes addition of %utVERB and %utBREAK arguments and code related to them as well as other substantial additions authored by Sam Habiel 07/2013-04/2014

848
Routines/%ut1.m
View File

@ -1,424 +1,424 @@
%ut1 ;VEN/SMH/JLI - CONTINUATION OF M-UNIT PROCESSING ;12/16/15 08:38
;;1.3;MASH UTILITIES;;Dec 16, 2015;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Joel L. Ivey as XTMUNIT1 while working for U.S. Department of Veterans Affairs 2003-2012
; Includes addition of original COV entry and code related coverage analysis as well as other substantial additions authored by Sam Habiel 07/2013?04/2014
; Additions and modifications made by Joel L. Ivey 05/2014-12/2015
;
D ^%utt6 ; runs unit tests from several perspectives
Q
;
;following is original header from XTMUNIT1 in unreleased patch XT*7.3*81 VA code
;XTMUNIT1 ;JLI/FO-OAK-CONTINUATION OF UNIT TEST ROUTINE ;2014-04-17 5:26 PM
;;7.3;TOOLKIT;**81**;APR 25 1995;Build 24
;
;
; Original by Dr. Joel Ivey
; Major contributions by Dr. Sam Habiel
;
;
CHEKTEST(%utROU,%ut,%utUETRY) ; Collect Test list.
; %utROU - input - Name of routine to check for tags with @TEST attribute
; %ut - input/output - passed by reference
; %utUETRY - input/output - passed by reference
;
; Test list collected in two ways:
; - @TEST on labellines
; - Offsets of XTENT
;
S %ut("ENTN")=0 ; Number of test, sub to %utUETRY.
;
; This stanza and everything below is for collecting @TEST.
; VEN/SMH - block refactored to use $TEXT instead of ^%ZOSF("LOAD")
N I,LIST
S I=$L($T(@(U_%utROU))) I I<0 Q "-1^Invalid Routine Name"
D NEWSTYLE(.LIST,%utROU)
F I=1:1:LIST S %ut("ENTN")=%ut("ENTN")+1,%utUETRY(%ut("ENTN"))=$P(LIST(I),U),%utUETRY(%ut("ENTN"),"NAME")=$P(LIST(I),U,2,99)
;
; This Stanza is to collect XTENT offsets
N %utUI F %utUI=1:1 S %ut("ELIN")=$T(@("XTENT+"_%utUI_"^"_%utROU)) Q:$P(%ut("ELIN"),";",3)="" D
. S %ut("ENTN")=%ut("ENTN")+1,%utUETRY(%ut("ENTN"))=$P(%ut("ELIN"),";",3),%utUETRY(%ut("ENTN"),"NAME")=$P(%ut("ELIN"),";",4)
. Q
;
QUIT
;
; VEN/SMH 26JUL2013 - Moved GETTREE here.
GETTREE(%utROU,%utULIST) ;
; first get any other routines this one references for running subsequently
; then any that they refer to as well
; this builds a tree of all routines referred to by any routine including each only once
N %utUK,%utUI,%utUJ,%utURNAM,%utURLIN
F %utUK=1:1 Q:'$D(%utROU(%utUK)) D
. F %utUI=1:1 S %utURLIN=$T(@("XTROU+"_%utUI_"^"_%utROU(%utUK))) S %utURNAM=$P(%utURLIN,";",3) Q:%utURNAM="" D
. . F %utUJ=1:1:%utULIST I %utROU(%utUJ)=%utURNAM S %utURNAM="" Q
. . I %utURNAM'="",$T(@("+1^"_%utURNAM))="" W:'$D(XWBOS) "Referenced routine ",%utURNAM," not found.",! Q
. . S:%utURNAM'="" %utULIST=%utULIST+1,%utROU(%utULIST)=%utURNAM
QUIT
;
NEWSTYLE(LIST,ROUNAME) ; JLI 140726 identify and return list of newstyle tags or entries for this routine
; LIST - input, passed by reference - returns containing array with list of tags identified as tests
; LIST indicates number of tags identified, LIST(n)=tag^test_info where tag is entry point for test
; ROUNAME - input - routine name in which tests should be identified
;
N I,VALUE,LINE
K LIST S LIST=0
; search routine by line for a tag and @TEST declaration
F I=1:1 S LINE=$T(@("+"_I_"^"_ROUNAME)) Q:LINE="" S VALUE=$$CHECKTAG(LINE) I VALUE'="" S LIST=LIST+1,LIST(LIST)=VALUE
Q
;
CHECKTAG(LINE) ; JLI 140726 check line to determine @test TAG
; LINE - input - Line of code to be checked
; returns null line if not @TEST line, otherwise TAG^NOTE
N TAG,NOTE,CHAR
I $E(LINE)=" " Q "" ; test entry must have a tag
I $$UP(LINE)'["@TEST" Q "" ; must have @TEST declaration
I $P($$UP(LINE),"@TEST")["(" Q "" ; can't have an argument
S TAG=$P(LINE," "),LINE=$P(LINE," ",2,400),NOTE=$P($$UP(LINE),"@TEST"),LINE=$E(LINE,$L(NOTE)+5+1,$L(LINE))
F Q:NOTE="" S CHAR=$E(NOTE),NOTE=$E(NOTE,2,$L(NOTE)) I " ;"'[CHAR Q ;
I $L(NOTE)'=0 Q "" ; @TEST must be first text on line
F Q:$E(LINE)'=" " S LINE=$E(LINE,2,$L(LINE)) ; remove leading spaces from test info
S TAG=TAG_U_LINE
Q TAG
;
FAIL(XTERMSG) ; Entry point for generating a failure message
; ZEXCEPT: %utERRL,%utGUI -CREATED IN SETUP, KILLED IN END
; ZEXCEPT: %ut -- NEWED ON ENTRY
; ZEXCEPT: XTGUISEP - newed in GUINEXT
I $G(XTERMSG)="" S XTERMSG="no failure message provided"
S %ut("CHK")=%ut("CHK")+1
I '$D(%utGUI) D
. D SETIO
. W !,%ut("ENT")," - " W:%ut("NAME")'="" %ut("NAME")," - " W XTERMSG,! D
. . S %ut("FAIL")=%ut("FAIL")+1,%utERRL(%ut("FAIL"))=%ut("NAME"),%utERRL(%ut("FAIL"),"MSG")=XTERMSG,%utERRL(%ut("FAIL"),"ENTRY")=%ut("ENT")
. . I $D(%ut("BREAK")) BREAK ; Break upon failure
. . Q
. D RESETIO
. Q
I $D(%utGUI) S %ut("CNT")=%ut("CNT")+1,@%ut("RSLT")@(%ut("CNT"))=%ut("LOC")_XTGUISEP_"FAILURE"_XTGUISEP_XTERMSG,%ut("FAIL")=%ut("FAIL")+1
Q
;
NVLDARG(API) ; generate message for invalid arguments to test
N XTERMSG
; ZEXCEPT: %ut -- NEWED ON ENTRY
; ZEXCEPT: %utERRL,%utGUI -CREATED IN SETUP, KILLED IN END
; ZEXCEPT: XTGUISEP - newed in GUINEXT
S XTERMSG="NO VALUES INPUT TO "_API_"^%ut - no evaluation possible"
I '$D(%utGUI) D
. D SETIO
. W !,%ut("ENT")," - " W:%ut("NAME")'="" %ut("NAME")," - " W XTERMSG,! D
. . S %ut("FAIL")=%ut("FAIL")+1,%utERRL(%ut("FAIL"))=%ut("NAME"),%utERRL(%ut("FAIL"),"MSG")=XTERMSG,%utERRL(%ut("FAIL"),"ENTRY")=%ut("ENT")
. . Q
. D RESETIO
. Q
I $D(%utGUI) S %ut("CNT")=%ut("CNT")+1,@%ut("RSLT")@(%ut("CNT"))=%ut("LOC")_XTGUISEP_"FAILURE"_XTGUISEP_XTERMSG,%ut("FAIL")=%ut("FAIL")+1
Q
;
SETIO ; Set M-Unit Device to write the results to...
; ZEXCEPT: %ut -- NEWED ON ENTRY
I $IO'=%ut("IO") S (IO(0),%ut("DEV","OLD"))=$IO USE %ut("IO") SET IO=$IO
QUIT
;
RESETIO ; Reset $IO back to the original device if we changed it.
; ZEXCEPT: %ut -- NEWED ON ENTRY
I $D(%ut("DEV","OLD")) S IO(0)=%ut("IO") U %ut("DEV","OLD") S IO=$IO K %ut("DEV","OLD")
QUIT
;
; VEN/SMH 17DEC2013 - Remove dependence on VISTA - Uppercase here instead of XLFSTR.
UP(X) ;
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;
COV(NMSP,COVCODE,VERBOSITY) ; VEN/SMH - PUBLIC ENTRY POINT; Coverage calculations
; NMSP: Namespace of the routines to analyze. End with * to include all routines.
; Not using * will only include the routine with NMSP name.
; e.g. PSOM* will include all routines starting with PSOM
; PSOM will only include PSOM.
; COVCODE: Mumps code to run over which coverage will be calculated. Typically Unit Tests.
; VERBOSITY (optional): Scalar from -1 to 3.
; - -1 = Global output in ^TMP("%utCOVREPORT",$J)
; - 0 = Print only total coverage
; - 1 = Break down by routine
; - 2 = Break down by routine and tag
; - 3 = Break down by routine and tag, and print lines that didn't execute for each tag.
;
; ZEXCEPT: %utcovxx - SET and KILLED in this code at top level
; ZEXCEPT: %Monitor,%apiOBJ,DecomposeStatus,LineByLine,Start,Stop,System,class - not variables parts of classes
N COVER,COVERSAV,I,NMSP1,RTN,RTNS,ERR,STATUS
I (+$SY=47) D ; GT.M only!
. N %ZR ; GT.M specific
. D SILENT^%RSEL(NMSP,"SRC") ; GT.M specific. On Cache use $O(^$R(RTN)).
. N RN S RN=""
. W !,"Loading routines to test coverage...",!
. F S RN=$O(%ZR(RN)) Q:RN="" W RN," " D
. . N L2 S L2=$T(+2^@RN)
. . S L2=$TR(L2,$C(9,32)) ; Translate spaces and tabs out
. . I $E(L2,1,2)'=";;" K %ZR(RN) ; Not a human produced routine
. ;
. M RTNS=%ZR
. K %ZR
. Q
;
I (+$SY=0) D ; CACHE SPECIFIC
. S NMSP1=NMSP I NMSP["*" S NMSP1=$P(NMSP,"*")
. I $D(^$R(NMSP1)) S RTNS(NMSP1)=""
. I NMSP["*" S RTN=NMSP1 F S RTN=$O(^$R(RTN)) Q:RTN'[NMSP1 S RTNS(RTN)=""
. Q
;
; ZEXCEPT: CTRAP - not really a variable
S VERBOSITY=+$G(VERBOSITY) ; Get 0 if not passed.
;
;
N GL
S GL=$NA(^TMP("%utCOVCOHORT",$J))
I '$D(^TMP("%utcovrunning",$J)) K @GL
D RTNANAL(.RTNS,GL) ; save off any current coverage data
I '$D(^TMP("%utcovrunning",$J)) N EXIT S EXIT=0 D Q:EXIT
. K ^TMP("%utCOVCOHORTSAV",$J)
. M ^TMP("%utCOVCOHORTSAV",$J)=^TMP("%utCOVCOHORT",$J)
. K ^TMP("%utCOVRESULT",$J)
. S ^TMP("%utcovrunning",$J)=1,%utcovxx=1
. ;
. I (+$SY=47) VIEW "TRACE":1:$NA(^TMP("%utCOVRESULT",$J)) ; GT.M START PROFILING
. ;
. I (+$SY=0) D ; CACHE CODE TO START PROFILING
. . S STATUS=##class(%Monitor.System.LineByLine).Start($lb(NMSP),$lb("RtnLine"),$lb($j))
. . I +STATUS'=1 D DecomposeStatus^%apiOBJ(STATUS,.ERR,"-d") F I=1:1:ERR W ERR(I),!
. . I +STATUS'=1 K ERR S EXIT=1
. . Q
. Q
DO ; Run the code, but keep our variables to ourselves.
. NEW $ETRAP,$ESTACK
. I (+$SY=47) D ; GT.M SPECIFIC
. . SET $ETRAP="Q:($ES&$Q) -9 Q:$ES W ""CTRL-C ENTERED"""
. . USE $PRINCIPAL:(CTRAP=$C(3))
. . Q
. NEW (DUZ,IO,COVCODE,U,DILOCKTM,DISYS,DT,DTIME,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY)
. XECUTE COVCODE
. Q
; GT.M STOP PROFILING if this is the original level that started it
I $D(^TMP("%utcovrunning",$J)),$D(%utcovxx) D
. I (+$SY=47) VIEW "TRACE":0:$NA(^TMP("%utCOVRESULT",$J)) ; GT.M SPECIFIC
. I (+$SY=0) ; CACHE SPECIFIC
. K %utcovxx,^TMP("%utcovrunning",$J)
. Q
;
I '$D(^TMP("%utcovrunning",$J)) D
. I (+$SY=0) D ; CACHE SPECIFIC CODE
. . S COVERSAV=$NA(^TMP("%utCOVCOHORTSAV",$J)) K @COVERSAV
. . S COVER=$NA(^TMP("%utCOVCOHORT",$J)) K @COVER
. . D CACHECOV(COVERSAV,COVER)
. . D TOTAGS(COVERSAV,0),TOTAGS(COVER,1)
. . D ##class(%Monitor.System.LineByLine).Stop()
. . Q
. D COVCOV($NA(^TMP("%utCOVCOHORT",$J)),$NA(^TMP("%utCOVRESULT",$J))) ; Venn diagram matching between globals
. ; Report
. I VERBOSITY=-1 D
. . K ^TMP("%utCOVREPORT",$J)
. . D COVRPTGL($NA(^TMP("%utCOVCOHORTSAV",$J)),$NA(^TMP("%utCOVCOHORT",$J)),$NA(^TMP("%utCOVRESULT",$J)),$NA(^TMP("%utCOVREPORT",$J)))
. . Q
. E D COVRPT($NA(^TMP("%utCOVCOHORTSAV",$J)),$NA(^TMP("%utCOVCOHORT",$J)),$NA(^TMP("%utCOVRESULT",$J)),VERBOSITY)
. Q
QUIT
;
CACHECOV(GLOBSAV,GLOB) ;
; ZEXCEPT: %Monitor,GetMetrics,GetRoutineCount,GetRoutineName,LineByLine,System,class - not variable names, part of classes
N DIF,I,METRIC,METRICNT,METRICS,MTRICNUM,ROUNAME,ROUNUM,X,XCNP,XXX
I $$ISUTEST(),'$D(^TMP("%utt4val",$J)) S ROUNUM=1,METRICS="RtnLine",METRICNT=1,ROUNAME="%ut"
I $D(^TMP("%utt4val",$J))!'$$ISUTEST() S ROUNUM=##class(%Monitor.System.LineByLine).GetRoutineCount(),METRICS=##class(%Monitor.System.LineByLine).GetMetrics(),METRICNT=$l(METRICS,",")
; if only running to do coverage, should be 1
S MTRICNUM=0 F I=1:1:METRICNT S METRIC=$P(METRICS,",",I) I METRIC="RtnLine" S MTRICNUM=I Q
;
F I=1:1:ROUNUM D
. I $D(^TMP("%utt4val",$J))!'$$ISUTEST() S ROUNAME=##class(%Monitor.System.LineByLine).GetRoutineName(I)
. ; get routine loaded into location
. S DIF=$NA(@GLOBSAV@(ROUNAME)),DIF=$E(DIF,1,$L(DIF)-1)_",",XCNP=0,X=ROUNAME
. X ^%ZOSF("LOAD")
. M @GLOB@(ROUNAME)=@GLOBSAV@(ROUNAME)
. Q
;
I $D(^TMP("%utt4val",$J))!'$$ISUTEST() F XXX=1:1:ROUNUM D GETVALS(XXX,GLOB,MTRICNUM)
Q
;
GETVALS(ROUNUM,GLOB,MTRICNUM) ; get data on number of times a line seen (set into VAL)
; ZEXCEPT: %Monitor,%New,%ResultSet,Execute,GetData,GetRoutineName,LineByLine,Next,System,class - not variables parts of Cache classes
N LINE,MORE,ROUNAME,RSET,VAL,X
;
S RSET=##class(%ResultSet).%New("%Monitor.System.LineByLine:Result")
S ROUNAME=##class(%Monitor.System.LineByLine).GetRoutineName(ROUNUM)
S LINE=RSET.Execute(ROUNAME)
F LINE=1:1 S MORE=RSET.Next() Q:'MORE D
. S X=RSET.GetData(1)
. S VAL=$LI(X,MTRICNUM)
. S @GLOB@(ROUNAME,LINE,"C")=+VAL ; values are 0 if not seen, otherwises positive number
. Q
D RSET.Close()
Q
;
TOTAGS(GLOBAL,ACTIVE) ; convert to lines from tags and set value only if not seen
N ACTIVCOD,LINE,LINENUM,ROU,ROUCODE
S ROU="" F S ROU=$O(@GLOBAL@(ROU)) Q:ROU="" D
. M ROUCODE(ROU)=@GLOBAL@(ROU) K @GLOBAL@(ROU)
. N TAG,OFFSET,OLDTAG S TAG="",OFFSET=0,OLDTAG=""
. F LINENUM=1:1 Q:'$D(ROUCODE(ROU,LINENUM,0)) D
. . S LINE=ROUCODE(ROU,LINENUM,0)
. . S ACTIVCOD=$$LINEDATA(LINE,.TAG,.OFFSET)
. . I TAG'=OLDTAG S @GLOBAL@(ROU,TAG)=TAG
. . I ACTIVE,ACTIVCOD,(+$G(ROUCODE(ROU,LINENUM,"C"))'>0) S @GLOBAL@(ROU,TAG,OFFSET)=LINE
. . I 'ACTIVE,ACTIVCOD S @GLOBAL@(ROU,TAG,OFFSET)=LINE
. . Q
. Q
Q
;
LINEDATA(LINE,TAG,OFFSET) ;
; LINE - input - the line of code
; TAG - passed by reference -
; OFFSET - passed by reference
N CODE,NEWTAG
S NEWTAG=""
S OFFSET=$G(OFFSET)+1
F Q:$E(LINE,1)=" " Q:$E(LINE,1)=$C(9) Q:LINE="" S NEWTAG=NEWTAG_$E(LINE,1),LINE=$E(LINE,2,$L(LINE))
S NEWTAG=$P(NEWTAG,"(")
I NEWTAG'="" S TAG=NEWTAG,OFFSET=0
S CODE=1
F S:(LINE="")!($E(LINE)=";") CODE=0 Q:'CODE Q:(" ."'[$E(LINE)) S LINE=$E(LINE,2,$L(LINE))
Q CODE
;
RTNANAL(RTNS,GL) ; [Private] - Routine Analysis
; Create a global similar to the trace global produced by GT.M in GL
; Only non-comment lines are stored.
; A tag is always stored. Tag,0 is stored only if there is code on the tag line (format list or actual code).
; tags by themselves don't count toward the total.
;
N RTN S RTN=""
F S RTN=$O(RTNS(RTN)) Q:RTN="" D ; for each routine
. N TAG
. S TAG=RTN ; start the tags at the first
. N I,LN F I=2:1 S LN=$T(@TAG+I^@RTN) Q:LN="" D ; for each line, starting with the 3rd line (2 off the first tag)
. . I $E(LN)?1A D QUIT ; formal line
. . . N T ; Terminator
. . . N J F J=1:1:$L(LN) S T=$E(LN,J) Q:T'?1AN ; Loop to...
. . . S TAG=$E(LN,1,J-1) ; Get tag
. . . S @GL@(RTN,TAG)=TAG ; store line
. . . ;I T="(" S @GL@(RTN,TAG,0)=LN ; formal list
. . . I T="(" D ; formal list
. . . . N PCNT,STR,CHR S PCNT=0,STR=$E(LN,J+1,$L(LN))
. . . . F S CHR=$E(STR),STR=$E(STR,2,$L(STR)) Q:(PCNT=0)&(CHR=")") D
. . . . . I CHR="(" S PCNT=PCNT+1
. . . . . I CHR=")" S PCNT=PCNT-1
. . . . . Q
. . . . S STR=$TR(STR,$C(9,32))
. . . . I $E(STR)=";" QUIT
. . . . S @GL@(RTN,TAG,0)=LN
. . . . Q
. . . E D ; No formal list
. . . . N LNTR S LNTR=$P(LN,TAG,2,999),LNTR=$TR(LNTR,$C(9,32)) ; Get rest of line, Remove spaces and tabs
. . . . I $E(LNTR)=";" QUIT ; Comment
. . . . S @GL@(RTN,TAG,0)=LN ; Otherwise, store for testing
. . . S I=0 ; Start offsets from zero (first one at the for will be 1)
. . I $C(32,9)[$E(LN) D QUIT ; Regular line
. . . N LNTR S LNTR=$TR(LN,$C(32,9,46)) ; Remove all spaces and tabs - JLI 150202 remove periods as well
. . . I $E(LNTR)=";" QUIT ; Comment line -- don't want.
. . . S @GL@(RTN,TAG,I)=LN ; Record line
QUIT
;
ACTLINES(GL) ; [Private] $$ ; Count active lines
;
N CNT S CNT=0
N REF S REF=GL
N GLQL S GLQL=$QL(GL)
F S REF=$Q(@REF) Q:REF="" Q:(GL'=$NA(@REF,GLQL)) D
. N REFQL S REFQL=$QL(REF)
. N LASTSUB S LASTSUB=$QS(REF,REFQL)
. I LASTSUB?1.N S CNT=CNT+1
QUIT CNT
;
COVCOV(C,R) ; [Private] - Analyze coverage Cohort vs Result
N RTN S RTN=""
F S RTN=$O(@C@(RTN)) Q:RTN="" D ; For each routine in cohort set
. I '$D(@R@(RTN)) QUIT ; Not present in result set
. N TAG S TAG=""
. F S TAG=$O(@R@(RTN,TAG)) Q:TAG="" D ; For each tag in the routine in the result set
. . N LN S LN=""
. . F S LN=$O(@R@(RTN,TAG,LN)) Q:LN="" D ; for each line in the tag in the routine in the result set
. . . I $D(@C@(RTN,TAG,LN)) K ^(LN) ; if present in cohort, kill off
QUIT
;
COVRPT(C,S,R,V) ; [Private] - Coverage Report
; C = COHORT - Global name
; S = SURVIVORS - Global name
; R = RESULT - Global name
; V = Verbosity - Scalar from -1 to 3
; JLI 150702 - modified to be able to do unit tests on setting up the text via COVRPTLS
N X,I
S X=$NA(^TMP("%ut1-covrpt",$J)) K @X
D COVRPTLS(C,S,R,V,X)
I '$$ISUTEST^%ut() F I=1:1 W:$D(@X@(I)) !,@X@(I) I '$D(@X@(I)) K @X Q
Q
;
COVRPTLS(C,S,R,V,X) ;
;
N LINNUM S LINNUM=0
N ORIGLINES S ORIGLINES=$$ACTLINES(C)
N LEFTLINES S LEFTLINES=$$ACTLINES(S)
;W !!
S LINNUM=LINNUM+1,@X@(LINNUM)="",LINNUM=LINNUM+1,@X@(LINNUM)=""
;W "ORIG: "_ORIGLINES,!
S LINNUM=LINNUM+1,@X@(LINNUM)="ORIG: "_ORIGLINES
;W "LEFT: "_LEFTLINES,!
S LINNUM=LINNUM+1,@X@(LINNUM)="LEFT: "_LEFTLINES
;W "COVERAGE PERCENTAGE: "_$S(ORIGLINES:$J(ORIGLINES-LEFTLINES/ORIGLINES*100,"",2),1:100.00),!
S LINNUM=LINNUM+1,@X@(LINNUM)="COVERAGE PERCENTAGE: "_$S(ORIGLINES:$J((ORIGLINES-LEFTLINES)/ORIGLINES*100,"",2),1:100.00)
;W !!
S LINNUM=LINNUM+1,@X@(LINNUM)="",LINNUM=LINNUM+1,@X@(LINNUM)=""
;W "BY ROUTINE:",!
S LINNUM=LINNUM+1,@X@(LINNUM)="BY ROUTINE:"
I V=0 QUIT ; No verbosity. Don't print routine detail
N RTN S RTN=""
F S RTN=$O(@C@(RTN)) Q:RTN="" D
. N O S O=$$ACTLINES($NA(@C@(RTN)))
. N L S L=$$ACTLINES($NA(@S@(RTN)))
. ;W ?3,RTN,?21,$S(O:$J(O-L/O*100,"",2),1:"100.00"),!
. N XX,XY S XX=" "_RTN_" ",XX=$E(XX,1,12)
. S XY=" "_$S(O:$J((O-L)/O*100,"",2)_"%",1:"------"),XY=$E(XY,$L(XY)-11,$L(XY))
. ;S LINNUM=LINNUM+1,@X@(LINNUM)=XX_$S(O:$J((O-L)/O*100,"",2)_"%",1:"------")_" "_(O-L)_" out of "_O
. S LINNUM=LINNUM+1,@X@(LINNUM)=XX_XY_" "_(O-L)_" out of "_O
. I V=1 QUIT ; Just print the routine coverage for V=1
. N TAG S TAG=""
. F S TAG=$O(@C@(RTN,TAG)) Q:TAG="" D
. . N O S O=$$ACTLINES($NA(@C@(RTN,TAG)))
. . N L S L=$$ACTLINES($NA(@S@(RTN,TAG)))
. . ;W ?5,TAG,?21,$S(O:$J(O-L/O*100,"",2),1:"100.00"),!
. . S XX=" "_TAG_" ",XX=$E(XX,1,20)
. . ;S XY=" ("_(O-L)_"/"_O_")",XY=$E(XY,$L(XY)-11,$L(XY)),XX=XX_XY
. . S XY=" "_$S(O:$J((O-L)/O*100,"",2)_"%",1:"------"),XY=$E(XY,$L(XY)-7,$L(XY))
. . S LINNUM=LINNUM+1,@X@(LINNUM)=XX_XY_" "_(O-L)_" out of "_O
. . I V=2 QUIT ; Just print routine/tags coverage for V=2; V=3 print uncovered lines
. . N LN S LN=""
. . ;F S LN=$O(@S@(RTN,TAG,LN)) Q:LN="" W TAG_"+"_LN_": "_^(LN),!
. . F S LN=$O(@S@(RTN,TAG,LN)) Q:LN="" S LINNUM=LINNUM+1,@X@(LINNUM)=TAG_"+"_LN_": "_^(LN)
. . Q
. Q
QUIT
;
COVRPTGL(C,S,R,OUT) ; [Private] - Coverage Global for silent invokers
; C = COHORT - Global name
; S = SURVIVORS - Global name
; R = RESULT - Global name
; OUT = OUTPUT - Global name
;
N O S O=$$ACTLINES(C)
N L S L=$$ACTLINES(S)
S @OUT=(O-L)_"/"_O
N RTN,TAG,LN S (RTN,TAG,LN)=""
F S RTN=$O(@C@(RTN)) Q:RTN="" D
. N O S O=$$ACTLINES($NA(@C@(RTN)))
. N L S L=$$ACTLINES($NA(@S@(RTN)))
. S @OUT@(RTN)=(O-L)_"/"_O
. F S TAG=$O(@C@(RTN,TAG)) Q:TAG="" D
. . N O S O=$$ACTLINES($NA(@C@(RTN,TAG)))
. . N L S L=$$ACTLINES($NA(@S@(RTN,TAG)))
. . S @OUT@(RTN,TAG)=(O-L)_"/"_O
. . F S LN=$O(@S@(RTN,TAG,LN)) Q:LN="" S @OUT@(RTN,TAG,LN)=@S@(RTN,TAG,LN)
QUIT
;
ISUTEST() ;
Q $$ISUTEST^%ut()
%ut1 ;VEN/SMH/JLI - CONTINUATION OF M-UNIT PROCESSING ;12/16/15 08:38
;;1.4;MASH;;Feb 27, 2016;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Joel L. Ivey as XTMUNIT1 while working for U.S. Department of Veterans Affairs 2003-2012
; Includes addition of original COV entry and code related coverage analysis as well as other substantial additions authored by Sam Habiel 07/2013?04/2014
; Additions and modifications made by Joel L. Ivey 05/2014-12/2015
;
D ^%utt6 ; runs unit tests from several perspectives
Q
;
;following is original header from XTMUNIT1 in unreleased patch XT*7.3*81 VA code
;XTMUNIT1 ;JLI/FO-OAK-CONTINUATION OF UNIT TEST ROUTINE ;2014-04-17 5:26 PM
;;7.3;TOOLKIT;**81**;APR 25 1995;Build 24
;
;
; Original by Dr. Joel Ivey
; Major contributions by Dr. Sam Habiel
;
;
CHEKTEST(%utROU,%ut,%utUETRY) ; Collect Test list.
; %utROU - input - Name of routine to check for tags with @TEST attribute
; %ut - input/output - passed by reference
; %utUETRY - input/output - passed by reference
;
; Test list collected in two ways:
; - @TEST on labellines
; - Offsets of XTENT
;
S %ut("ENTN")=0 ; Number of test, sub to %utUETRY.
;
; This stanza and everything below is for collecting @TEST.
; VEN/SMH - block refactored to use $TEXT instead of ^%ZOSF("LOAD")
N I,LIST
S I=$L($T(@(U_%utROU))) I I<0 Q "-1^Invalid Routine Name"
D NEWSTYLE(.LIST,%utROU)
F I=1:1:LIST S %ut("ENTN")=%ut("ENTN")+1,%utUETRY(%ut("ENTN"))=$P(LIST(I),U),%utUETRY(%ut("ENTN"),"NAME")=$P(LIST(I),U,2,99)
;
; This Stanza is to collect XTENT offsets
N %utUI F %utUI=1:1 S %ut("ELIN")=$T(@("XTENT+"_%utUI_"^"_%utROU)) Q:$P(%ut("ELIN"),";",3)="" D
. S %ut("ENTN")=%ut("ENTN")+1,%utUETRY(%ut("ENTN"))=$P(%ut("ELIN"),";",3),%utUETRY(%ut("ENTN"),"NAME")=$P(%ut("ELIN"),";",4)
. Q
;
QUIT
;
; VEN/SMH 26JUL2013 - Moved GETTREE here.
GETTREE(%utROU,%utULIST) ;
; first get any other routines this one references for running subsequently
; then any that they refer to as well
; this builds a tree of all routines referred to by any routine including each only once
N %utUK,%utUI,%utUJ,%utURNAM,%utURLIN
F %utUK=1:1 Q:'$D(%utROU(%utUK)) D
. F %utUI=1:1 S %utURLIN=$T(@("XTROU+"_%utUI_"^"_%utROU(%utUK))) S %utURNAM=$P(%utURLIN,";",3) Q:%utURNAM="" D
. . F %utUJ=1:1:%utULIST I %utROU(%utUJ)=%utURNAM S %utURNAM="" Q
. . I %utURNAM'="",$T(@("+1^"_%utURNAM))="" W:'$D(XWBOS) "Referenced routine ",%utURNAM," not found.",! Q
. . S:%utURNAM'="" %utULIST=%utULIST+1,%utROU(%utULIST)=%utURNAM
QUIT
;
NEWSTYLE(LIST,ROUNAME) ; JLI 140726 identify and return list of newstyle tags or entries for this routine
; LIST - input, passed by reference - returns containing array with list of tags identified as tests
; LIST indicates number of tags identified, LIST(n)=tag^test_info where tag is entry point for test
; ROUNAME - input - routine name in which tests should be identified
;
N I,VALUE,LINE
K LIST S LIST=0
; search routine by line for a tag and @TEST declaration
F I=1:1 S LINE=$T(@("+"_I_"^"_ROUNAME)) Q:LINE="" S VALUE=$$CHECKTAG(LINE) I VALUE'="" S LIST=LIST+1,LIST(LIST)=VALUE
Q
;
CHECKTAG(LINE) ; JLI 140726 check line to determine @test TAG
; LINE - input - Line of code to be checked
; returns null line if not @TEST line, otherwise TAG^NOTE
N TAG,NOTE,CHAR
I $E(LINE)=" " Q "" ; test entry must have a tag
I $$UP(LINE)'["@TEST" Q "" ; must have @TEST declaration
I $P($$UP(LINE),"@TEST")["(" Q "" ; can't have an argument
S TAG=$P(LINE," "),LINE=$P(LINE," ",2,400),NOTE=$P($$UP(LINE),"@TEST"),LINE=$E(LINE,$L(NOTE)+5+1,$L(LINE))
F Q:NOTE="" S CHAR=$E(NOTE),NOTE=$E(NOTE,2,$L(NOTE)) I " ;"'[CHAR Q ;
I $L(NOTE)'=0 Q "" ; @TEST must be first text on line
F Q:$E(LINE)'=" " S LINE=$E(LINE,2,$L(LINE)) ; remove leading spaces from test info
S TAG=TAG_U_LINE
Q TAG
;
FAIL(XTERMSG) ; Entry point for generating a failure message
; ZEXCEPT: %utERRL,%utGUI -CREATED IN SETUP, KILLED IN END
; ZEXCEPT: %ut -- NEWED ON ENTRY
; ZEXCEPT: XTGUISEP - newed in GUINEXT
I $G(XTERMSG)="" S XTERMSG="no failure message provided"
S %ut("CHK")=%ut("CHK")+1
I '$D(%utGUI) D
. D SETIO
. W !,%ut("ENT")," - " W:%ut("NAME")'="" %ut("NAME")," - " W XTERMSG,! D
. . S %ut("FAIL")=%ut("FAIL")+1,%utERRL(%ut("FAIL"))=%ut("NAME"),%utERRL(%ut("FAIL"),"MSG")=XTERMSG,%utERRL(%ut("FAIL"),"ENTRY")=%ut("ENT")
. . I $D(%ut("BREAK")) BREAK ; Break upon failure
. . Q
. D RESETIO
. Q
I $D(%utGUI) S %ut("CNT")=%ut("CNT")+1,@%ut("RSLT")@(%ut("CNT"))=%ut("LOC")_XTGUISEP_"FAILURE"_XTGUISEP_XTERMSG,%ut("FAIL")=%ut("FAIL")+1
Q
;
NVLDARG(API) ; generate message for invalid arguments to test
N XTERMSG
; ZEXCEPT: %ut -- NEWED ON ENTRY
; ZEXCEPT: %utERRL,%utGUI -CREATED IN SETUP, KILLED IN END
; ZEXCEPT: XTGUISEP - newed in GUINEXT
S XTERMSG="NO VALUES INPUT TO "_API_"^%ut - no evaluation possible"
I '$D(%utGUI) D
. D SETIO
. W !,%ut("ENT")," - " W:%ut("NAME")'="" %ut("NAME")," - " W XTERMSG,! D
. . S %ut("FAIL")=%ut("FAIL")+1,%utERRL(%ut("FAIL"))=%ut("NAME"),%utERRL(%ut("FAIL"),"MSG")=XTERMSG,%utERRL(%ut("FAIL"),"ENTRY")=%ut("ENT")
. . Q
. D RESETIO
. Q
I $D(%utGUI) S %ut("CNT")=%ut("CNT")+1,@%ut("RSLT")@(%ut("CNT"))=%ut("LOC")_XTGUISEP_"FAILURE"_XTGUISEP_XTERMSG,%ut("FAIL")=%ut("FAIL")+1
Q
;
SETIO ; Set M-Unit Device to write the results to...
; ZEXCEPT: %ut -- NEWED ON ENTRY
I $IO'=%ut("IO") S (IO(0),%ut("DEV","OLD"))=$IO USE %ut("IO") SET IO=$IO
QUIT
;
RESETIO ; Reset $IO back to the original device if we changed it.
; ZEXCEPT: %ut -- NEWED ON ENTRY
I $D(%ut("DEV","OLD")) S IO(0)=%ut("IO") U %ut("DEV","OLD") S IO=$IO K %ut("DEV","OLD")
QUIT
;
; VEN/SMH 17DEC2013 - Remove dependence on VISTA - Uppercase here instead of XLFSTR.
UP(X) ;
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;
COV(NMSP,COVCODE,VERBOSITY) ; VEN/SMH - PUBLIC ENTRY POINT; Coverage calculations
; NMSP: Namespace of the routines to analyze. End with * to include all routines.
; Not using * will only include the routine with NMSP name.
; e.g. PSOM* will include all routines starting with PSOM
; PSOM will only include PSOM.
; COVCODE: Mumps code to run over which coverage will be calculated. Typically Unit Tests.
; VERBOSITY (optional): Scalar from -1 to 3.
; - -1 = Global output in ^TMP("%utCOVREPORT",$J)
; - 0 = Print only total coverage
; - 1 = Break down by routine
; - 2 = Break down by routine and tag
; - 3 = Break down by routine and tag, and print lines that didn't execute for each tag.
;
; ZEXCEPT: %utcovxx - SET and KILLED in this code at top level
; ZEXCEPT: %Monitor,%apiOBJ,DecomposeStatus,LineByLine,Start,Stop,System,class - not variables parts of classes
N COVER,COVERSAV,I,NMSP1,RTN,RTNS,ERR,STATUS
I (+$SY=47) D ; GT.M only!
. N %ZR ; GT.M specific
. D SILENT^%RSEL(NMSP,"SRC") ; GT.M specific. On Cache use $O(^$R(RTN)).
. N RN S RN=""
. W !,"Loading routines to test coverage...",!
. F S RN=$O(%ZR(RN)) Q:RN="" W RN," " D
. . N L2 S L2=$T(+2^@RN)
. . S L2=$TR(L2,$C(9,32)) ; Translate spaces and tabs out
. . I $E(L2,1,2)'=";;" K %ZR(RN) ; Not a human produced routine
. ;
. M RTNS=%ZR
. K %ZR
. Q
;
I (+$SY=0) D ; CACHE SPECIFIC
. S NMSP1=NMSP I NMSP["*" S NMSP1=$P(NMSP,"*")
. I $D(^$R(NMSP1)) S RTNS(NMSP1)=""
. I NMSP["*" S RTN=NMSP1 F S RTN=$O(^$R(RTN)) Q:RTN'[NMSP1 S RTNS(RTN)=""
. Q
;
; ZEXCEPT: CTRAP - not really a variable
S VERBOSITY=+$G(VERBOSITY) ; Get 0 if not passed.
;
;
N GL
S GL=$NA(^TMP("%utCOVCOHORT",$J))
I '$D(^TMP("%utcovrunning",$J)) K @GL
D RTNANAL(.RTNS,GL) ; save off any current coverage data
I '$D(^TMP("%utcovrunning",$J)) N EXIT S EXIT=0 D Q:EXIT
. K ^TMP("%utCOVCOHORTSAV",$J)
. M ^TMP("%utCOVCOHORTSAV",$J)=^TMP("%utCOVCOHORT",$J)
. K ^TMP("%utCOVRESULT",$J)
. S ^TMP("%utcovrunning",$J)=1,%utcovxx=1
. ;
. I (+$SY=47) VIEW "TRACE":1:$NA(^TMP("%utCOVRESULT",$J)) ; GT.M START PROFILING
. ;
. I (+$SY=0) D ; CACHE CODE TO START PROFILING
. . S STATUS=##class(%Monitor.System.LineByLine).Start($lb(NMSP),$lb("RtnLine"),$lb($j))
. . I +STATUS'=1 D DecomposeStatus^%apiOBJ(STATUS,.ERR,"-d") F I=1:1:ERR W ERR(I),!
. . I +STATUS'=1 K ERR S EXIT=1
. . Q
. Q
DO ; Run the code, but keep our variables to ourselves.
. NEW $ETRAP,$ESTACK
. I (+$SY=47) D ; GT.M SPECIFIC
. . SET $ETRAP="Q:($ES&$Q) -9 Q:$ES W ""CTRL-C ENTERED"""
. . USE $PRINCIPAL:(CTRAP=$C(3))
. . Q
. NEW (DUZ,IO,COVCODE,U,DILOCKTM,DISYS,DT,DTIME,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY)
. XECUTE COVCODE
. Q
; GT.M STOP PROFILING if this is the original level that started it
I $D(^TMP("%utcovrunning",$J)),$D(%utcovxx) D
. I (+$SY=47) VIEW "TRACE":0:$NA(^TMP("%utCOVRESULT",$J)) ; GT.M SPECIFIC
. I (+$SY=0) ; CACHE SPECIFIC
. K %utcovxx,^TMP("%utcovrunning",$J)
. Q
;
I '$D(^TMP("%utcovrunning",$J)) D
. I (+$SY=0) D ; CACHE SPECIFIC CODE
. . S COVERSAV=$NA(^TMP("%utCOVCOHORTSAV",$J)) K @COVERSAV
. . S COVER=$NA(^TMP("%utCOVCOHORT",$J)) K @COVER
. . D CACHECOV(COVERSAV,COVER)
. . D TOTAGS(COVERSAV,0),TOTAGS(COVER,1)
. . D ##class(%Monitor.System.LineByLine).Stop()
. . Q
. D COVCOV($NA(^TMP("%utCOVCOHORT",$J)),$NA(^TMP("%utCOVRESULT",$J))) ; Venn diagram matching between globals
. ; Report
. I VERBOSITY=-1 D
. . K ^TMP("%utCOVREPORT",$J)
. . D COVRPTGL($NA(^TMP("%utCOVCOHORTSAV",$J)),$NA(^TMP("%utCOVCOHORT",$J)),$NA(^TMP("%utCOVRESULT",$J)),$NA(^TMP("%utCOVREPORT",$J)))
. . Q
. E D COVRPT($NA(^TMP("%utCOVCOHORTSAV",$J)),$NA(^TMP("%utCOVCOHORT",$J)),$NA(^TMP("%utCOVRESULT",$J)),VERBOSITY)
. Q
QUIT
;
CACHECOV(GLOBSAV,GLOB) ;
; ZEXCEPT: %Monitor,GetMetrics,GetRoutineCount,GetRoutineName,LineByLine,System,class - not variable names, part of classes
N DIF,I,METRIC,METRICNT,METRICS,MTRICNUM,ROUNAME,ROUNUM,X,XCNP,XXX
I $$ISUTEST(),'$D(^TMP("%utt4val",$J)) S ROUNUM=1,METRICS="RtnLine",METRICNT=1,ROUNAME="%ut"
I $D(^TMP("%utt4val",$J))!'$$ISUTEST() S ROUNUM=##class(%Monitor.System.LineByLine).GetRoutineCount(),METRICS=##class(%Monitor.System.LineByLine).GetMetrics(),METRICNT=$l(METRICS,",")
; if only running to do coverage, should be 1
S MTRICNUM=0 F I=1:1:METRICNT S METRIC=$P(METRICS,",",I) I METRIC="RtnLine" S MTRICNUM=I Q
;
F I=1:1:ROUNUM D
. I $D(^TMP("%utt4val",$J))!'$$ISUTEST() S ROUNAME=##class(%Monitor.System.LineByLine).GetRoutineName(I)
. ; get routine loaded into location
. S DIF=$NA(@GLOBSAV@(ROUNAME)),DIF=$E(DIF,1,$L(DIF)-1)_",",XCNP=0,X=ROUNAME
. X ^%ZOSF("LOAD")
. M @GLOB@(ROUNAME)=@GLOBSAV@(ROUNAME)
. Q
;
I $D(^TMP("%utt4val",$J))!'$$ISUTEST() F XXX=1:1:ROUNUM D GETVALS(XXX,GLOB,MTRICNUM)
Q
;
GETVALS(ROUNUM,GLOB,MTRICNUM) ; get data on number of times a line seen (set into VAL)
; ZEXCEPT: %Monitor,%New,%ResultSet,Execute,GetData,GetRoutineName,LineByLine,Next,System,class - not variables parts of Cache classes
N LINE,MORE,ROUNAME,RSET,VAL,X
;
S RSET=##class(%ResultSet).%New("%Monitor.System.LineByLine:Result")
S ROUNAME=##class(%Monitor.System.LineByLine).GetRoutineName(ROUNUM)
S LINE=RSET.Execute(ROUNAME)
F LINE=1:1 S MORE=RSET.Next() Q:'MORE D
. S X=RSET.GetData(1)
. S VAL=$LI(X,MTRICNUM)
. S @GLOB@(ROUNAME,LINE,"C")=+VAL ; values are 0 if not seen, otherwises positive number
. Q
D RSET.Close()
Q
;
TOTAGS(GLOBAL,ACTIVE) ; convert to lines from tags and set value only if not seen
N ACTIVCOD,LINE,LINENUM,ROU,ROUCODE
S ROU="" F S ROU=$O(@GLOBAL@(ROU)) Q:ROU="" D
. M ROUCODE(ROU)=@GLOBAL@(ROU) K @GLOBAL@(ROU)
. N TAG,OFFSET,OLDTAG S TAG="",OFFSET=0,OLDTAG=""
. F LINENUM=1:1 Q:'$D(ROUCODE(ROU,LINENUM,0)) D
. . S LINE=ROUCODE(ROU,LINENUM,0)
. . S ACTIVCOD=$$LINEDATA(LINE,.TAG,.OFFSET)
. . I TAG'=OLDTAG S @GLOBAL@(ROU,TAG)=TAG
. . I ACTIVE,ACTIVCOD,(+$G(ROUCODE(ROU,LINENUM,"C"))'>0) S @GLOBAL@(ROU,TAG,OFFSET)=LINE
. . I 'ACTIVE,ACTIVCOD S @GLOBAL@(ROU,TAG,OFFSET)=LINE
. . Q
. Q
Q
;
LINEDATA(LINE,TAG,OFFSET) ;
; LINE - input - the line of code
; TAG - passed by reference -
; OFFSET - passed by reference
N CODE,NEWTAG
S NEWTAG=""
S OFFSET=$G(OFFSET)+1
F Q:$E(LINE,1)=" " Q:$E(LINE,1)=$C(9) Q:LINE="" S NEWTAG=NEWTAG_$E(LINE,1),LINE=$E(LINE,2,$L(LINE))
S NEWTAG=$P(NEWTAG,"(")
I NEWTAG'="" S TAG=NEWTAG,OFFSET=0
S CODE=1
F S:(LINE="")!($E(LINE)=";") CODE=0 Q:'CODE Q:(" ."'[$E(LINE)) S LINE=$E(LINE,2,$L(LINE))
Q CODE
;
RTNANAL(RTNS,GL) ; [Private] - Routine Analysis
; Create a global similar to the trace global produced by GT.M in GL
; Only non-comment lines are stored.
; A tag is always stored. Tag,0 is stored only if there is code on the tag line (format list or actual code).
; tags by themselves don't count toward the total.
;
N RTN S RTN=""
F S RTN=$O(RTNS(RTN)) Q:RTN="" D ; for each routine
. N TAG
. S TAG=RTN ; start the tags at the first
. N I,LN F I=2:1 S LN=$T(@TAG+I^@RTN) Q:LN="" D ; for each line, starting with the 3rd line (2 off the first tag)
. . I $E(LN)?1A D QUIT ; formal line
. . . N T ; Terminator
. . . N J F J=1:1:$L(LN) S T=$E(LN,J) Q:T'?1AN ; Loop to...
. . . S TAG=$E(LN,1,J-1) ; Get tag
. . . S @GL@(RTN,TAG)=TAG ; store line
. . . ;I T="(" S @GL@(RTN,TAG,0)=LN ; formal list
. . . I T="(" D ; formal list
. . . . N PCNT,STR,CHR S PCNT=0,STR=$E(LN,J+1,$L(LN))
. . . . F S CHR=$E(STR),STR=$E(STR,2,$L(STR)) Q:(PCNT=0)&(CHR=")") D
. . . . . I CHR="(" S PCNT=PCNT+1
. . . . . I CHR=")" S PCNT=PCNT-1
. . . . . Q
. . . . S STR=$TR(STR,$C(9,32))
. . . . I $E(STR)=";" QUIT
. . . . S @GL@(RTN,TAG,0)=LN
. . . . Q
. . . E D ; No formal list
. . . . N LNTR S LNTR=$P(LN,TAG,2,999),LNTR=$TR(LNTR,$C(9,32)) ; Get rest of line, Remove spaces and tabs
. . . . I $E(LNTR)=";" QUIT ; Comment
. . . . S @GL@(RTN,TAG,0)=LN ; Otherwise, store for testing
. . . S I=0 ; Start offsets from zero (first one at the for will be 1)
. . I $C(32,9)[$E(LN) D QUIT ; Regular line
. . . N LNTR S LNTR=$TR(LN,$C(32,9,46)) ; Remove all spaces and tabs - JLI 150202 remove periods as well
. . . I $E(LNTR)=";" QUIT ; Comment line -- don't want.
. . . S @GL@(RTN,TAG,I)=LN ; Record line
QUIT
;
ACTLINES(GL) ; [Private] $$ ; Count active lines
;
N CNT S CNT=0
N REF S REF=GL
N GLQL S GLQL=$QL(GL)
F S REF=$Q(@REF) Q:REF="" Q:(GL'=$NA(@REF,GLQL)) D
. N REFQL S REFQL=$QL(REF)
. N LASTSUB S LASTSUB=$QS(REF,REFQL)
. I LASTSUB?1.N S CNT=CNT+1
QUIT CNT
;
COVCOV(C,R) ; [Private] - Analyze coverage Cohort vs Result
N RTN S RTN=""
F S RTN=$O(@C@(RTN)) Q:RTN="" D ; For each routine in cohort set
. I '$D(@R@(RTN)) QUIT ; Not present in result set
. N TAG S TAG=""
. F S TAG=$O(@R@(RTN,TAG)) Q:TAG="" D ; For each tag in the routine in the result set
. . N LN S LN=""
. . F S LN=$O(@R@(RTN,TAG,LN)) Q:LN="" D ; for each line in the tag in the routine in the result set
. . . I $D(@C@(RTN,TAG,LN)) K ^(LN) ; if present in cohort, kill off
QUIT
;
COVRPT(C,S,R,V) ; [Private] - Coverage Report
; C = COHORT - Global name
; S = SURVIVORS - Global name
; R = RESULT - Global name
; V = Verbosity - Scalar from -1 to 3
; JLI 150702 - modified to be able to do unit tests on setting up the text via COVRPTLS
N X,I
S X=$NA(^TMP("%ut1-covrpt",$J)) K @X
D COVRPTLS(C,S,R,V,X)
I '$$ISUTEST^%ut() F I=1:1 W:$D(@X@(I)) !,@X@(I) I '$D(@X@(I)) K @X Q
Q
;
COVRPTLS(C,S,R,V,X) ;
;
N LINNUM S LINNUM=0
N ORIGLINES S ORIGLINES=$$ACTLINES(C)
N LEFTLINES S LEFTLINES=$$ACTLINES(S)
;W !!
S LINNUM=LINNUM+1,@X@(LINNUM)="",LINNUM=LINNUM+1,@X@(LINNUM)=""
;W "ORIG: "_ORIGLINES,!
S LINNUM=LINNUM+1,@X@(LINNUM)="ORIG: "_ORIGLINES
;W "LEFT: "_LEFTLINES,!
S LINNUM=LINNUM+1,@X@(LINNUM)="LEFT: "_LEFTLINES
;W "COVERAGE PERCENTAGE: "_$S(ORIGLINES:$J(ORIGLINES-LEFTLINES/ORIGLINES*100,"",2),1:100.00),!
S LINNUM=LINNUM+1,@X@(LINNUM)="COVERAGE PERCENTAGE: "_$S(ORIGLINES:$J((ORIGLINES-LEFTLINES)/ORIGLINES*100,"",2),1:100.00)
;W !!
S LINNUM=LINNUM+1,@X@(LINNUM)="",LINNUM=LINNUM+1,@X@(LINNUM)=""
;W "BY ROUTINE:",!
S LINNUM=LINNUM+1,@X@(LINNUM)="BY ROUTINE:"
I V=0 QUIT ; No verbosity. Don't print routine detail
N RTN S RTN=""
F S RTN=$O(@C@(RTN)) Q:RTN="" D
. N O S O=$$ACTLINES($NA(@C@(RTN)))
. N L S L=$$ACTLINES($NA(@S@(RTN)))
. ;W ?3,RTN,?21,$S(O:$J(O-L/O*100,"",2),1:"100.00"),!
. N XX,XY S XX=" "_RTN_" ",XX=$E(XX,1,12)
. S XY=" "_$S(O:$J((O-L)/O*100,"",2)_"%",1:"------"),XY=$E(XY,$L(XY)-11,$L(XY))
. ;S LINNUM=LINNUM+1,@X@(LINNUM)=XX_$S(O:$J((O-L)/O*100,"",2)_"%",1:"------")_" "_(O-L)_" out of "_O
. S LINNUM=LINNUM+1,@X@(LINNUM)=XX_XY_" "_(O-L)_" out of "_O
. I V=1 QUIT ; Just print the routine coverage for V=1
. N TAG S TAG=""
. F S TAG=$O(@C@(RTN,TAG)) Q:TAG="" D
. . N O S O=$$ACTLINES($NA(@C@(RTN,TAG)))
. . N L S L=$$ACTLINES($NA(@S@(RTN,TAG)))
. . ;W ?5,TAG,?21,$S(O:$J(O-L/O*100,"",2),1:"100.00"),!
. . S XX=" "_TAG_" ",XX=$E(XX,1,20)
. . ;S XY=" ("_(O-L)_"/"_O_")",XY=$E(XY,$L(XY)-11,$L(XY)),XX=XX_XY
. . S XY=" "_$S(O:$J((O-L)/O*100,"",2)_"%",1:"------"),XY=$E(XY,$L(XY)-7,$L(XY))
. . S LINNUM=LINNUM+1,@X@(LINNUM)=XX_XY_" "_(O-L)_" out of "_O
. . I V=2 QUIT ; Just print routine/tags coverage for V=2; V=3 print uncovered lines
. . N LN S LN=""
. . ;F S LN=$O(@S@(RTN,TAG,LN)) Q:LN="" W TAG_"+"_LN_": "_^(LN),!
. . F S LN=$O(@S@(RTN,TAG,LN)) Q:LN="" S LINNUM=LINNUM+1,@X@(LINNUM)=TAG_"+"_LN_": "_^(LN)
. . Q
. Q
QUIT
;
COVRPTGL(C,S,R,OUT) ; [Private] - Coverage Global for silent invokers
; C = COHORT - Global name
; S = SURVIVORS - Global name
; R = RESULT - Global name
; OUT = OUTPUT - Global name
;
N O S O=$$ACTLINES(C)
N L S L=$$ACTLINES(S)
S @OUT=(O-L)_"/"_O
N RTN,TAG,LN S (RTN,TAG,LN)=""
F S RTN=$O(@C@(RTN)) Q:RTN="" D
. N O S O=$$ACTLINES($NA(@C@(RTN)))
. N L S L=$$ACTLINES($NA(@S@(RTN)))
. S @OUT@(RTN)=(O-L)_"/"_O
. F S TAG=$O(@C@(RTN,TAG)) Q:TAG="" D
. . N O S O=$$ACTLINES($NA(@C@(RTN,TAG)))
. . N L S L=$$ACTLINES($NA(@S@(RTN,TAG)))
. . S @OUT@(RTN,TAG)=(O-L)_"/"_O
. . F S LN=$O(@S@(RTN,TAG,LN)) Q:LN="" S @OUT@(RTN,TAG,LN)=@S@(RTN,TAG,LN)
QUIT
;
ISUTEST() ;
Q $$ISUTEST^%ut()

418
Routines/%utcover.m
View File

@ -1,209 +1,209 @@
%utcover ;JLI - generic coverage and unit test runner ;12/16/15 08:42
;;1.3;MASH UTILITIES;;Dec 16, 2015;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Joel L. Ivey 08/15. Additional work 08/15-12/15.
;
; Changes: (Moved from %ut and %ut1)
; 130726 SMH - Moved test collection logic from %utUNIT to here (multiple places)
; 131218 SMH - dependence on XLFSTR removed
; 131218 SMH - CHEKTEST refactored to use $TEXT instead of ^%ZOSF("LOAD")
; 131218 SMH - CATCHERR now nulls out $ZS if on GT.M
;
; ------- COMMENTS moved from %ut due to space requirements
;
; 100622 JLI - corrected typo in comments where %utINPT was listed as %utINP
; 100622 JLI - removed a comment which indicated data could potentially be returned from the called routine
; in the %utINPT array.
; 100622 JLI - added code to handle STARTUP and SHUTDOWN from GUI app
; 110719 JLI - modified separators in GUI handling from ^ to ~~^~~
; in the variable XTGUISEP if using a newer version of the
; GUI app (otherwise, it is simply set to ^) since results
; with a series of ^ embedded disturbed the output reported
; 130726 SMH - Fixed SETUP and TEARDOWN so that they run before/after each
; test rather than once. General refactoring.
; 130726 SMH - SETUT initialized IO in case it's not there to $P. Inits vars
; using DT^DICRW.
; 131217 SMH - Change call in SETUP to S U="^" instead of DT^DICRW
; 131218 SMH - Any checks to $ZE will also check $ZS for GT.M.
; 131218 SMH - Remove calls to %ZISUTL to manage devices to prevent dependence on VISTA.
; Use %utNIT("DEV","OLD") for old devices
; 140109 SMH - Add parameter %utBREAK - Break upon error
; 1402 SMH - Break will cause the break to happen even on failed tests.
; 140401 SMH - Added Succeed entry point for take it into your hands tester.
; 140401 SMH - Reformatted the output of M-Unit so that the test's name
; will print BEFORE the execution of the test. This has been
; really confusing for beginning users of M-Unit, so this was
; necessary.
; 140401 SMH - OK message gets printed at the end of --- as [OK].
; 140401 SMH - FAIL message now prints. Previously, OK failed to be printed.
; Unfortunately, that's rather passive aggressive. Now it
; explicitly says that a test failed.
; 140503 SMH - Fixed IO issues all over the routine. Much simpler now.
; 140731 JLI - Combined routine changes between JLI and SMH
; Moved routines from %utNIT and %utNIT1 to %ut and %ut1
; Updated unit test routines (%utt1 to %utt6)
; Created M-UNIT TEST GROUP file at 17.9001 based on the 17.9001 file
; 141030 JLI - Removed tag TESTCOVR and code under it, not necessary
; since %uttcovr can handle all of the calling needed
; Added call to run routine %utt6 if run from the top,
; since this will run the full range of unit tests
; Modified STARTUP and SHUTDOWN commands to handle in
; each routine where they are available, since only
; running one STARTUP and SHUTDOWN (the first seen by
; the program) restricted their use in suites of multiple
; tests.
; 150101 JLI - Added COV entry to %ut (in addition to current in %ut1) so it is easier
; to remember how to use it.
; 150621 JLI - Added a global location to pick up summary data for a unit test call, so
; programs running multiple calls can generate a summary if desired.
;
;
D EN^%ut("%uttcovr") ; unit tests
Q
;
MULTAPIS(TESTROUS) ; RUN TESTS FOR SPECIFIED ROUTINES AND ENTRY POINTS
; can be run from %ut using D MULTAPIS^%ut(.TESTROUS)
; input TESTROUS - passed by reference - array of routine names to run tests for
; specify those to be called directly by including ^ as part of
; TAG^ROUTINE or ^ROUTINE.
; ROUTINE names without a ^ will be called as EN^%ut("ROUTINE")
; Sometimes to get complete coverage, different entry points may
; need to be called (e.g., at top and for VERBOSE), these should each
; be included.
; If the subscript is a number, it will take the list of comma separated
; values as the routines. If the the subscript is not a number, it will
; take it as a routine to be added to the list, then if the value of the
; contains a comma separated list of routines, they will be added as well.
; Thus a value of
; TESTROUS(1)="A^ROU1,^ROU1,^ROU2,ROU3"
; or a value of
; TESTROUS("A^ROU1")="^ROU1,^ROU2,ROU3"
; will both result in tests for
; D A^ROU1,^ROU1,^ROU2,EN^%ut("ROU3")
K ^TMP("%utcover",$J,"TESTROUS")
M ^TMP("%utcover",$J,"TESTROUS")=TESTROUS
D COVENTRY
K ^TMP("%utcover",$J,"TESTROUS")
Q
;
COVENTRY ; setup of COVERAGE NEWs most variables, so TESTROUS passed by global
;
N I,ROU,VAL,VALS,UTDATA,TESTS,TESTROUS
M TESTROUS=^TMP("%utcover",$J,"TESTROUS")
S ROU="" F S ROU=$O(TESTROUS(ROU)) Q:ROU="" D
. I ROU'=+ROU S TESTS(ROU)=""
. F I=1:1 S VAL=$P(TESTROUS(ROU),",",I) Q:VAL="" S TESTS(VAL)=""
. Q
S ROU="" F S ROU=$O(TESTS(ROU)) Q:ROU="" D
. W !!,"------------------- RUNNING ",ROU," -------------------"
. I ROU[U D @ROU
. I ROU'[U D @("EN^%ut("""_ROU_""")")
. D GETUTVAL^%ut(.UTDATA)
. Q
I $D(UTDATA) D LSTUTVAL^%ut(.UTDATA)
Q
;
COVERAGE(ROUNMSP,TESTROUS,XCLDROUS,RESLTLVL) ; run coverage analysis for multiple routines and entry points
; can be run from %ut using D COVERAGE^%ut(ROUNMSP,.TESTROUS,.XCLDROUS,RESLTLVL)
; input ROUNMSP - Namespace for routine(s) to be analyzed
; ROUNAME will result in only the routine ROUNAME being analyzed
; ROUN* will result in all routines beginning with ROUN being analyzed
; input TESTROUS - passed by reference - see TESTROUS description for JUSTTEST
; input XCLDROUS - passed by reference - routines passed in a manner similar to TESTROUS,
; but only the routine names, whether as arguments or a comma separated
; list of routines, will be excluded from the analysis of coverage. These
; would normally be names of routines which are only for unit tests, or
; others which should not be included in the analysis for some reason.
; input RESLTLVL - This value determines the amount of information to be generated for the
; analysis. A missing or null value will be considered to be level 1
; 1 - Listing of analysis only for routine overall
; 2 - Listing of analysis for routine overall and for each TAG
; 3 - Full analysis for each tag, and lists out those lines which were
; not executed during the analysis
;
N I,ROU,TYPE,XCLUDE
S RESLTLVL=$G(RESLTLVL,1)
I (RESLTLVL<1) S RESLTLVL=1
I (RESLTLVL>3) S RESLTLVL=3
M ^TMP("%utcover",$J,"TESTROUS")=TESTROUS ;
D COV^%ut1(ROUNMSP,"D COVENTRY^%utcover",-1)
K ^TMP("%utcover",$J,"TESTROUS")
S ROU="" F S ROU=$O(XCLDROUS(ROU)) Q:ROU="" D SETROUS(.XCLUDE,.XCLDROUS,ROU)
N TEXTGLOB S TEXTGLOB=$NA(^TMP("%utcover-text",$J)) K @TEXTGLOB
D LIST(.XCLUDE,RESLTLVL,TEXTGLOB)
F I=1:1 Q:'$D(@TEXTGLOB@(I)) W !,@TEXTGLOB@(I)
K @TEXTGLOB
Q
;
SETROUS(XCLUDE,XCLDROUS,ROU) ;
; XCLUDE - passed by reference - on return contains array with indices as routines to exclude from analysis
; XCLDROUS - passed by referenc - array may contain a comma-delimited list of routines to exclude from analysis
; ROU - input - if non-numberic is name of routine to exclude from analysis
N I,VAL
I ROU'=+ROU S XCLUDE(ROU)=""
F I=1:1 S VAL=$P(XCLDROUS(ROU),",",I) Q:VAL="" S XCLUDE(VAL)=""
Q
;
LIST(XCLDROUS,TYPE,TEXTGLOB,GLOB,LINNUM) ;
; ZEXCEPT: TYPE1 - NEWed and set below for recursion
; input - ROULIST - a comma separated list of routine names that will
; be used to identify desired routines. Any name
; that begins with one of the specified values will
; be included
; input - TYPE - value indicating amount of detail desired
; 3=full with listing of untouched lines
; 2=moderated with listing by tags
; 1=summary with listing by routine
; input - TEXTGLOB - closed global location in which text is returned
; input - GLOB - used for unit tests - specifies global to work with
; so that coverage data is not impacted
;
N CURRCOV,CURRLIN,LINCOV,LINE,LINTOT,ROULIST,ROUNAME,TAG,TOTCOV,TOTLIN,XVAL
;
I '$D(LINNUM) S LINNUM=0 ; initialize on first entry
I '$D(GLOB) N GLOB S GLOB=$NA(^TMP("%utCOVREPORT",$J))
D TRIMDATA(.XCLDROUS,GLOB) ; remove undesired routines from data
;
N JOB,NAME,BASE,TEXT,VAL
S TOTCOV=0,TOTLIN=0
; F NAME="%utCOVREPORT","%utCOVRESULT","%utCOVCOHORT","%utCOVCOHORTSAV" D
I TYPE>1 S ROUNAME="" F S ROUNAME=$O(@GLOB@(ROUNAME)) Q:ROUNAME="" S XVAL=^(ROUNAME) D
. S CURRCOV=$P(XVAL,"/"),CURRLIN=$P(XVAL,"/",2)
. S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)="",LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=""
. S TEXT="Routine "_ROUNAME_" ",TEXT=$E(TEXT,1,20)
. I CURRLIN>0 S VAL=" ("_$J((100*CURRCOV)/CURRLIN,"",2),VAL=$E(VAL,$L(VAL)-6,$L(VAL))
. S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=TEXT_" "_$S(CURRLIN>0:VAL_"%)",1:" ------ ")_" "_CURRCOV_" out of "_CURRLIN_" lines covered"
. I TYPE>1 S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=" - "_$S(TYPE=2:"Summary",1:"Detailed Breakdown")
. S TAG="" F S TAG=$O(@GLOB@(ROUNAME,TAG)) Q:TAG="" S XVAL=^(TAG) D
. . S LINCOV=$P(XVAL,"/"),LINTOT=$P(XVAL,"/",2)
. . S TEXT=" Tag "_TAG_"^"_ROUNAME_" ",TEXT=$E(TEXT,1,26)
. . I LINTOT>0 S VAL=" ("_$J((100*LINCOV)/LINTOT,"",2),VAL=$E(VAL,$L(VAL)-6,$L(VAL))
. . S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=TEXT_$S(LINTOT>0:VAL_"%)",1:" ------ ")_" "_LINCOV_" out of "_LINTOT_" lines covered"
. . I TYPE=2 Q
. . I LINCOV=LINTOT Q
. . S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=" the following is a list of the lines **NOT** covered"
. . S LINE="" F S LINE=$O(@GLOB@(ROUNAME,TAG,LINE)) Q:LINE="" D
. . . I LINE=0 S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=" "_TAG_" "_@GLOB@(ROUNAME,TAG,LINE) Q
. . . S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=" "_TAG_"+"_LINE_" "_@GLOB@(ROUNAME,TAG,LINE)
. . . Q
. . Q
. Q
; for type=3 generate a summary at bottom after detail
I TYPE=3 N TYPE1 S TYPE1=2 D LIST(.XCLDROUS,2,TEXTGLOB,GLOB,.LINNUM) K TYPE1
I TYPE=2,$G(TYPE1) Q ; CAME IN FROM ABOVE LINE
; summarize by just routine name
S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)="",LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=""
S ROUNAME="" F S ROUNAME=$O(@GLOB@(ROUNAME)) Q:ROUNAME="" S XVAL=^(ROUNAME) D
. S CURRCOV=$P(XVAL,"/"),CURRLIN=$P(XVAL,"/",2)
. S TOTCOV=TOTCOV+CURRCOV,TOTLIN=TOTLIN+CURRLIN
. I CURRLIN>0 S VAL=" ("_$J((100*CURRCOV)/CURRLIN,"",2),VAL=$E(VAL,$L(VAL)-6,$L(VAL))
. S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)="Routine "_ROUNAME_" "_$S(CURRLIN>0:VAL_"%)",1:" ------ ")_" "_CURRCOV_" out of "_CURRLIN_" lines covered"
S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)="",LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=""
S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)="Overall Analysis "_TOTCOV_" out of "_TOTLIN_" lines covered"_$S(TOTLIN>0:" ("_$P((100*TOTCOV)/TOTLIN,".")_"% coverage)",1:"")
Q
;
TRIMDATA(ROULIST,GLOB) ;
N ROUNAME
S ROUNAME="" F S ROUNAME=$O(ROULIST(ROUNAME)) Q:ROUNAME="" K @GLOB@(ROUNAME)
Q
;
%utcover ;JLI - generic coverage and unit test runner ;12/16/15 08:42
;;1.4;MASH;;Feb 27, 2016;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Joel L. Ivey 08/15. Additional work 08/15-12/15.
;
; Changes: (Moved from %ut and %ut1)
; 130726 SMH - Moved test collection logic from %utUNIT to here (multiple places)
; 131218 SMH - dependence on XLFSTR removed
; 131218 SMH - CHEKTEST refactored to use $TEXT instead of ^%ZOSF("LOAD")
; 131218 SMH - CATCHERR now nulls out $ZS if on GT.M
;
; ------- COMMENTS moved from %ut due to space requirements
;
; 100622 JLI - corrected typo in comments where %utINPT was listed as %utINP
; 100622 JLI - removed a comment which indicated data could potentially be returned from the called routine
; in the %utINPT array.
; 100622 JLI - added code to handle STARTUP and SHUTDOWN from GUI app
; 110719 JLI - modified separators in GUI handling from ^ to ~~^~~
; in the variable XTGUISEP if using a newer version of the
; GUI app (otherwise, it is simply set to ^) since results
; with a series of ^ embedded disturbed the output reported
; 130726 SMH - Fixed SETUP and TEARDOWN so that they run before/after each
; test rather than once. General refactoring.
; 130726 SMH - SETUT initialized IO in case it's not there to $P. Inits vars
; using DT^DICRW.
; 131217 SMH - Change call in SETUP to S U="^" instead of DT^DICRW
; 131218 SMH - Any checks to $ZE will also check $ZS for GT.M.
; 131218 SMH - Remove calls to %ZISUTL to manage devices to prevent dependence on VISTA.
; Use %utNIT("DEV","OLD") for old devices
; 140109 SMH - Add parameter %utBREAK - Break upon error
; 1402 SMH - Break will cause the break to happen even on failed tests.
; 140401 SMH - Added Succeed entry point for take it into your hands tester.
; 140401 SMH - Reformatted the output of M-Unit so that the test's name
; will print BEFORE the execution of the test. This has been
; really confusing for beginning users of M-Unit, so this was
; necessary.
; 140401 SMH - OK message gets printed at the end of --- as [OK].
; 140401 SMH - FAIL message now prints. Previously, OK failed to be printed.
; Unfortunately, that's rather passive aggressive. Now it
; explicitly says that a test failed.
; 140503 SMH - Fixed IO issues all over the routine. Much simpler now.
; 140731 JLI - Combined routine changes between JLI and SMH
; Moved routines from %utNIT and %utNIT1 to %ut and %ut1
; Updated unit test routines (%utt1 to %utt6)
; Created M-UNIT TEST GROUP file at 17.9001 based on the 17.9001 file
; 141030 JLI - Removed tag TESTCOVR and code under it, not necessary
; since %uttcovr can handle all of the calling needed
; Added call to run routine %utt6 if run from the top,
; since this will run the full range of unit tests
; Modified STARTUP and SHUTDOWN commands to handle in
; each routine where they are available, since only
; running one STARTUP and SHUTDOWN (the first seen by
; the program) restricted their use in suites of multiple
; tests.
; 150101 JLI - Added COV entry to %ut (in addition to current in %ut1) so it is easier
; to remember how to use it.
; 150621 JLI - Added a global location to pick up summary data for a unit test call, so
; programs running multiple calls can generate a summary if desired.
;
;
D EN^%ut("%uttcovr") ; unit tests
Q
;
MULTAPIS(TESTROUS) ; RUN TESTS FOR SPECIFIED ROUTINES AND ENTRY POINTS
; can be run from %ut using D MULTAPIS^%ut(.TESTROUS)
; input TESTROUS - passed by reference - array of routine names to run tests for
; specify those to be called directly by including ^ as part of
; TAG^ROUTINE or ^ROUTINE.
; ROUTINE names without a ^ will be called as EN^%ut("ROUTINE")
; Sometimes to get complete coverage, different entry points may
; need to be called (e.g., at top and for VERBOSE), these should each
; be included.
; If the subscript is a number, it will take the list of comma separated
; values as the routines. If the the subscript is not a number, it will
; take it as a routine to be added to the list, then if the value of the
; contains a comma separated list of routines, they will be added as well.
; Thus a value of
; TESTROUS(1)="A^ROU1,^ROU1,^ROU2,ROU3"
; or a value of
; TESTROUS("A^ROU1")="^ROU1,^ROU2,ROU3"
; will both result in tests for
; D A^ROU1,^ROU1,^ROU2,EN^%ut("ROU3")
K ^TMP("%utcover",$J,"TESTROUS")
M ^TMP("%utcover",$J,"TESTROUS")=TESTROUS
D COVENTRY
K ^TMP("%utcover",$J,"TESTROUS")
Q
;
COVENTRY ; setup of COVERAGE NEWs most variables, so TESTROUS passed by global
;
N I,ROU,VAL,VALS,UTDATA,TESTS,TESTROUS
M TESTROUS=^TMP("%utcover",$J,"TESTROUS")
S ROU="" F S ROU=$O(TESTROUS(ROU)) Q:ROU="" D
. I ROU'=+ROU S TESTS(ROU)=""
. F I=1:1 S VAL=$P(TESTROUS(ROU),",",I) Q:VAL="" S TESTS(VAL)=""
. Q
S ROU="" F S ROU=$O(TESTS(ROU)) Q:ROU="" D
. W !!,"------------------- RUNNING ",ROU," -------------------"
. I ROU[U D @ROU
. I ROU'[U D @("EN^%ut("""_ROU_""")")
. D GETUTVAL^%ut(.UTDATA)
. Q
I $D(UTDATA) D LSTUTVAL^%ut(.UTDATA)
Q
;
COVERAGE(ROUNMSP,TESTROUS,XCLDROUS,RESLTLVL) ; run coverage analysis for multiple routines and entry points
; can be run from %ut using D COVERAGE^%ut(ROUNMSP,.TESTROUS,.XCLDROUS,RESLTLVL)
; input ROUNMSP - Namespace for routine(s) to be analyzed
; ROUNAME will result in only the routine ROUNAME being analyzed
; ROUN* will result in all routines beginning with ROUN being analyzed
; input TESTROUS - passed by reference - see TESTROUS description for JUSTTEST
; input XCLDROUS - passed by reference - routines passed in a manner similar to TESTROUS,
; but only the routine names, whether as arguments or a comma separated
; list of routines, will be excluded from the analysis of coverage. These
; would normally be names of routines which are only for unit tests, or
; others which should not be included in the analysis for some reason.
; input RESLTLVL - This value determines the amount of information to be generated for the
; analysis. A missing or null value will be considered to be level 1
; 1 - Listing of analysis only for routine overall
; 2 - Listing of analysis for routine overall and for each TAG
; 3 - Full analysis for each tag, and lists out those lines which were
; not executed during the analysis
;
N I,ROU,TYPE,XCLUDE
S RESLTLVL=$G(RESLTLVL,1)
I (RESLTLVL<1) S RESLTLVL=1
I (RESLTLVL>3) S RESLTLVL=3
M ^TMP("%utcover",$J,"TESTROUS")=TESTROUS ;
D COV^%ut1(ROUNMSP,"D COVENTRY^%utcover",-1)
K ^TMP("%utcover",$J,"TESTROUS")
S ROU="" F S ROU=$O(XCLDROUS(ROU)) Q:ROU="" D SETROUS(.XCLUDE,.XCLDROUS,ROU)
N TEXTGLOB S TEXTGLOB=$NA(^TMP("%utcover-text",$J)) K @TEXTGLOB
D LIST(.XCLUDE,RESLTLVL,TEXTGLOB)
F I=1:1 Q:'$D(@TEXTGLOB@(I)) W !,@TEXTGLOB@(I)
K @TEXTGLOB
Q
;
SETROUS(XCLUDE,XCLDROUS,ROU) ;
; XCLUDE - passed by reference - on return contains array with indices as routines to exclude from analysis
; XCLDROUS - passed by referenc - array may contain a comma-delimited list of routines to exclude from analysis
; ROU - input - if non-numberic is name of routine to exclude from analysis
N I,VAL
I ROU'=+ROU S XCLUDE(ROU)=""
F I=1:1 S VAL=$P(XCLDROUS(ROU),",",I) Q:VAL="" S XCLUDE(VAL)=""
Q
;
LIST(XCLDROUS,TYPE,TEXTGLOB,GLOB,LINNUM) ;
; ZEXCEPT: TYPE1 - NEWed and set below for recursion
; input - ROULIST - a comma separated list of routine names that will
; be used to identify desired routines. Any name
; that begins with one of the specified values will
; be included
; input - TYPE - value indicating amount of detail desired
; 3=full with listing of untouched lines
; 2=moderated with listing by tags
; 1=summary with listing by routine
; input - TEXTGLOB - closed global location in which text is returned
; input - GLOB - used for unit tests - specifies global to work with
; so that coverage data is not impacted
;
N CURRCOV,CURRLIN,LINCOV,LINE,LINTOT,ROULIST,ROUNAME,TAG,TOTCOV,TOTLIN,XVAL
;
I '$D(LINNUM) S LINNUM=0 ; initialize on first entry
I '$D(GLOB) N GLOB S GLOB=$NA(^TMP("%utCOVREPORT",$J))
D TRIMDATA(.XCLDROUS,GLOB) ; remove undesired routines from data
;
N JOB,NAME,BASE,TEXT,VAL
S TOTCOV=0,TOTLIN=0
; F NAME="%utCOVREPORT","%utCOVRESULT","%utCOVCOHORT","%utCOVCOHORTSAV" D
I TYPE>1 S ROUNAME="" F S ROUNAME=$O(@GLOB@(ROUNAME)) Q:ROUNAME="" S XVAL=^(ROUNAME) D
. S CURRCOV=$P(XVAL,"/"),CURRLIN=$P(XVAL,"/",2)
. S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)="",LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=""
. S TEXT="Routine "_ROUNAME_" ",TEXT=$E(TEXT,1,20)
. I CURRLIN>0 S VAL=" ("_$J((100*CURRCOV)/CURRLIN,"",2),VAL=$E(VAL,$L(VAL)-6,$L(VAL))
. S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=TEXT_" "_$S(CURRLIN>0:VAL_"%)",1:" ------ ")_" "_CURRCOV_" out of "_CURRLIN_" lines covered"
. I TYPE>1 S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=" - "_$S(TYPE=2:"Summary",1:"Detailed Breakdown")
. S TAG="" F S TAG=$O(@GLOB@(ROUNAME,TAG)) Q:TAG="" S XVAL=^(TAG) D
. . S LINCOV=$P(XVAL,"/"),LINTOT=$P(XVAL,"/",2)
. . S TEXT=" Tag "_TAG_"^"_ROUNAME_" ",TEXT=$E(TEXT,1,26)
. . I LINTOT>0 S VAL=" ("_$J((100*LINCOV)/LINTOT,"",2),VAL=$E(VAL,$L(VAL)-6,$L(VAL))
. . S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=TEXT_$S(LINTOT>0:VAL_"%)",1:" ------ ")_" "_LINCOV_" out of "_LINTOT_" lines covered"
. . I TYPE=2 Q
. . I LINCOV=LINTOT Q
. . S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=" the following is a list of the lines **NOT** covered"
. . S LINE="" F S LINE=$O(@GLOB@(ROUNAME,TAG,LINE)) Q:LINE="" D
. . . I LINE=0 S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=" "_TAG_" "_@GLOB@(ROUNAME,TAG,LINE) Q
. . . S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=" "_TAG_"+"_LINE_" "_@GLOB@(ROUNAME,TAG,LINE)
. . . Q
. . Q
. Q
; for type=3 generate a summary at bottom after detail
I TYPE=3 N TYPE1 S TYPE1=2 D LIST(.XCLDROUS,2,TEXTGLOB,GLOB,.LINNUM) K TYPE1
I TYPE=2,$G(TYPE1) Q ; CAME IN FROM ABOVE LINE
; summarize by just routine name
S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)="",LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=""
S ROUNAME="" F S ROUNAME=$O(@GLOB@(ROUNAME)) Q:ROUNAME="" S XVAL=^(ROUNAME) D
. S CURRCOV=$P(XVAL,"/"),CURRLIN=$P(XVAL,"/",2)
. S TOTCOV=TOTCOV+CURRCOV,TOTLIN=TOTLIN+CURRLIN
. I CURRLIN>0 S VAL=" ("_$J((100*CURRCOV)/CURRLIN,"",2),VAL=$E(VAL,$L(VAL)-6,$L(VAL))
. S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)="Routine "_ROUNAME_" "_$S(CURRLIN>0:VAL_"%)",1:" ------ ")_" "_CURRCOV_" out of "_CURRLIN_" lines covered"
S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)="",LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)=""
S LINNUM=LINNUM+1,@TEXTGLOB@(LINNUM)="Overall Analysis "_TOTCOV_" out of "_TOTLIN_" lines covered"_$S(TOTLIN>0:" ("_$P((100*TOTCOV)/TOTLIN,".")_"% coverage)",1:"")
Q
;
TRIMDATA(ROULIST,GLOB) ;
N ROUNAME
S ROUNAME="" F S ROUNAME=$O(ROULIST(ROUNAME)) Q:ROUNAME="" K @GLOB@(ROUNAME)
Q
;

370
Routines/%utt1.m
View File

@ -1,188 +1,188 @@
%utt1 ; VEN/SMH-JLI - Testing routines for M-Unit;2015-12-31 10:33 PM
;;1.3;MASH UTILITIES;;Dec 16, 2015;Build 4
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Sam H. Habiel 07/2013-04/2014
; Additions and modifications made by Joel L. Ivey 05/2014-12/2015
;
; THIS ROUTINE IS THE UNIFIED UNIT TESTER FOR ALL OF M-UNIT.
;
; Dear Users,
;
; I know about about the irony of a test suite for the testing suite,
; so stop snikering. Aside from that, it's actually going to be hard.
;
; Truly yours,
;
; Sam H
;
D EN^%ut($T(+0),1) ; Run tests here, be verbose.
%utt1 ; VEN/SMH-JLI - Testing routines for M-Unit;2015-12-31 10:33 PM
;;1.4;MASH;;Feb 27, 2016;Build 4
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Sam H. Habiel 07/2013-04/2014
; Additions and modifications made by Joel L. Ivey 05/2014-12/2015
;
; THIS ROUTINE IS THE UNIFIED UNIT TESTER FOR ALL OF M-UNIT.
;
; Dear Users,
;
; I know about about the irony of a test suite for the testing suite,
; so stop snikering. Aside from that, it's actually going to be hard.
;
; Truly yours,
;
; Sam H
;
D EN^%ut($T(+0),1) ; Run tests here, be verbose.
N % S $P(%,"-",80)="-"
W !!,%,!,%,!,%,!,%,!!
K %
D EN^%ut($T(+0),2) ; Run tests here, be verbose with timings for each piece of code.
QUIT
;
STARTUP ; M-Unit Start-Up - This runs before anything else.
; ZEXCEPT: KBANCOUNT - created here, removed in SHUTDOWN
S ^TMP($J,"%ut","STARTUP")=""
S KBANCOUNT=1
QUIT
;
SHUTDOWN ; M-Unit Shutdown - This runs after everything else is done.
; ZEXCEPT: KBANCOUNT - created in STARTUP, removed here
K ^TMP($J,"%ut","STARTUP")
K KBANCOUNT
QUIT
;
;
;
SETUP ; This runs before every test.
; ZEXCEPT: KBANCOUNT - created in STARTUP, removed in SHUTDOWN
S KBANCOUNT=KBANCOUNT+1
QUIT
;
TEARDOWN ; This runs after every test
; ZEXCEPT: KBANCOUNT - created in STARTUP, removed in SHUTDOWN
S KBANCOUNT=KBANCOUNT-1
QUIT
;
;
;
T1 ; @TEST - Make sure Start-up Ran
D CHKTF($D(^TMP($J,"%ut","STARTUP")),"Start-up node on ^TMP must exist")
QUIT
;
T2 ; @TEST - Make sure Set-up runs
; ZEXCEPT: KBANCOUNT - created in STARTUP, removed in SHUTDOWN
D CHKEQ(KBANCOUNT,2,"KBANCount not incremented properly at SETUP")
QUIT
;
T3 ; @TEST - Make sure Teardown runs
; ZEXCEPT: KBANCOUNT - created in STARTUP, removed in SHUTDOWN
D CHKEQ(KBANCOUNT,2,"KBANCount not decremented properly at TEARDOWN")
QUIT
;
T4 ; Specified in XTMTAG
; 140731 JLI - note that this will fail when run from the GUI runner, since it calls each tag separately
; ZEXCEPT: %utETRY - newed and created in EN1^%ut
; ZEXCEPT: %utGUI -- CONDITIONALLY DEFINED BY GUINEXT^%ut
I $G(%utGUI) D CHKEQ(%utETRY,"T4","T4 should be the value for %utETRY in the GUI Runner")
I '$G(%utGUI) D CHKEQ(%utETRY(4),"T4","T4 should be the collected as the fourth entry in %utETRY")
QUIT
;
T5 ; ditto
; ZEXCEPT: %ut - NEWed and created in EN1^%ut
D CHKTF(0,"This is an intentional failure.")
D CHKEQ(%ut("FAIL"),1,"By this point, we should have failed one test")
D FAIL^%ut("Intentionally throwing a failure")
D CHKEQ(%ut("FAIL"),2,"By this point, we should have failed two tests")
; S %ut("FAIL")=0 ; Okay... Boy's and Girls... as the developer I can do that.
QUIT
;
T6 ; ditto
; ZEXCEPT: %ut - NEWed and created in EN1^%ut
N TESTCOUNT S TESTCOUNT=%ut("CHK")
D SUCCEED^%ut
D SUCCEED^%ut
D CHKEQ(%ut("CHK"),TESTCOUNT+2,"Succeed should increment the number of tests")
QUIT
;
T7 ; Make sure we write to principal even though we are on another device
; This is a rather difficult test to carry out for GT.M and Cache...
; ZEXCEPT: GetEnviron,Util,delete,newversion,readonly - not really variables
N D
I +$SY=47 S D="/tmp/test.txt" ; All GT.M ; VMS not supported.
I +$SY=0 D ; All Cache
. I $ZVERSION(1)=2 S D=$SYSTEM.Util.GetEnviron("temp")_"\test.txt" I 1 ; Windows
. E S D="/tmp/test.txt" ; not windows; VMS not supported.
I +$SY=0 O D:"NWS" ; Cache new file
I +$SY=47 O D:(newversion) ; GT.M new file
U D
WRITE "HELLO",!
WRITE "HELLO",!
C D
;
; Now open back the file, and read the hello, but open in read only so
; M-Unit will error out if it will write something out there.
;
I +$SY=0 O D:"R"
I +$SY=47 O D:(readonly)
U D
N X READ X:1
D CHKTF(X="HELLO") ; This should write to the screen the dot not to the file.
D CHKTF(($$LO($IO)=$$LO(D)),"IO device didn't get reset back") ; $$LO is b/c of a bug in Cache/Windows. $IO is not the same cas D.
I +$SY=0 C D:"D"
I +$SY=47 C D:(delete)
U $P
S IO=$IO
QUIT
;
; At the moment T8^%utt1 throws a fail, with no message
; in the GUI runner. For some reason, both X and Y
; variables are returned as null strings, while in the
; command line runner, Y has a value containing the
; word being sought
;
T8 ; If IO starts with another device, write to that device as if it's the pricipal device
; ZEXCEPT: GetEnviron,Util,delete,newversion,readonly - not really variables
N D
I +$SY=47 S D="/tmp/test.txt" ; All GT.M ; VMS not supported.
I +$SY=0 D ; All Cache
. I $ZVERSION(1)=2 S D=$SYSTEM.Util.GetEnviron("temp")_"\test.txt" I 1 ; Windows
. E S D="/tmp/test.txt" ; not windows; VMS not supported.
I +$SY=0 O D:"NWS" ; Cache new file
I +$SY=47 O D:(newversion) ; GT.M new file
S IO=D
U D
D ^%utt4 ; Run some Unit Tests
C D
I +$SY=0 O D:"R" ; Cache read only
I +$SY=47 O D:(readonly) ; GT.M read only
U D
N X,Y,Z R X:1,Y:1,Z:1
I +$SY=0 C D:"D"
I +$SY=47 C D:(delete)
;D CHKTF(Y["MAIN") ; JLI 140829 commented out, gui doesn't run verbose
D CHKTF((Y["MAIN")!(Z["T2 - Test 2"),"Write to system during test didn't work")
S IO=$P
QUIT
;
COVRPTGL ;
N GL1,GL2,GL3,GL4
S GL1=$NA(^TMP("%utCOVCOHORTSAVx",$J)) K @GL1
S GL2=$NA(^TMP("%utCOVCOHORTx",$J)) K @GL2
S GL3=$NA(^TMP("%utCOVRESULTx",$J)) K @GL3
S GL4=$NA(^TMP("%utCOVREPORTx",$J)) K @GL4
D SETGLOBS^%uttcovr(GL1,GL2)
D COVRPTGL^%ut1(GL1,GL2,GL3,GL4)
D CHKEQ($G(@GL4@("%ut1","ACTLINES")),"0/9","Wrong number of lines covered f>>or ACTLINES")
D CHKEQ($G(@GL4@("%ut1","ACTLINES",9))," QUIT CNT","Wrong result for last l>>ine not covered for ACTLINES")
D CHKEQ($G(@GL4@("%ut1","CHEKTEST")),"8/10","Wrong number of lines covered >>for CHEKTEST")
D CHKEQ($G(@GL4@("%ut1","CHEKTEST",39))," . Q","Wrong result for last line >>not covered for CHEKTEST")
K @GL1,@GL2,@GL3,@GL4
Q
;
LO(X) Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
; Shortcut methods for M-Unit
CHKTF(X,Y) ;
D CHKTF^%ut(X,$G(Y))
QUIT
;
CHKEQ(A,B,M) ;
D CHKEQ^%ut(A,B,$G(M))
QUIT
;
XTENT ; Entry points
;;T4;Entry point using XTMENT
;;T5;Error count check
;;T6;Succeed Entry Point
;;T7;Make sure we write to principal even though we are on another device
;;T8;If IO starts with another device, write to that device as if it's the pricipal device
;;COVRPTGL;coverage report returning global
;
XTROU ; Routines containing additional tests
;;%utt2; old %utNITU
;;%utt4; old %utNITW
;;%utt5;
;;%utt6;
;;%uttcovr;coverage related tests
D EN^%ut($T(+0),2) ; Run tests here, be verbose with timings for each piece of code.
QUIT
;
STARTUP ; M-Unit Start-Up - This runs before anything else.
; ZEXCEPT: KBANCOUNT - created here, removed in SHUTDOWN
S ^TMP($J,"%ut","STARTUP")=""
S KBANCOUNT=1
QUIT
;
SHUTDOWN ; M-Unit Shutdown - This runs after everything else is done.
; ZEXCEPT: KBANCOUNT - created in STARTUP, removed here
K ^TMP($J,"%ut","STARTUP")
K KBANCOUNT
QUIT
;
;
;
SETUP ; This runs before every test.
; ZEXCEPT: KBANCOUNT - created in STARTUP, removed in SHUTDOWN
S KBANCOUNT=KBANCOUNT+1
QUIT
;
TEARDOWN ; This runs after every test
; ZEXCEPT: KBANCOUNT - created in STARTUP, removed in SHUTDOWN
S KBANCOUNT=KBANCOUNT-1
QUIT
;
;
;
T1 ; @TEST - Make sure Start-up Ran
D CHKTF($D(^TMP($J,"%ut","STARTUP")),"Start-up node on ^TMP must exist")
QUIT
;
T2 ; @TEST - Make sure Set-up runs
; ZEXCEPT: KBANCOUNT - created in STARTUP, removed in SHUTDOWN
D CHKEQ(KBANCOUNT,2,"KBANCount not incremented properly at SETUP")
QUIT
;
T3 ; @TEST - Make sure Teardown runs
; ZEXCEPT: KBANCOUNT - created in STARTUP, removed in SHUTDOWN
D CHKEQ(KBANCOUNT,2,"KBANCount not decremented properly at TEARDOWN")
QUIT
;
T4 ; Specified in XTMTAG
; 140731 JLI - note that this will fail when run from the GUI runner, since it calls each tag separately
; ZEXCEPT: %utETRY - newed and created in EN1^%ut
; ZEXCEPT: %utGUI -- CONDITIONALLY DEFINED BY GUINEXT^%ut
I $G(%utGUI) D CHKEQ(%utETRY,"T4","T4 should be the value for %utETRY in the GUI Runner")
I '$G(%utGUI) D CHKEQ(%utETRY(4),"T4","T4 should be the collected as the fourth entry in %utETRY")
QUIT
;
T5 ; ditto
; ZEXCEPT: %ut - NEWed and created in EN1^%ut
D CHKTF(0,"This is an intentional failure.")
D CHKEQ(%ut("FAIL"),1,"By this point, we should have failed one test")
D FAIL^%ut("Intentionally throwing a failure")
D CHKEQ(%ut("FAIL"),2,"By this point, we should have failed two tests")
; S %ut("FAIL")=0 ; Okay... Boy's and Girls... as the developer I can do that.
QUIT
;
T6 ; ditto
; ZEXCEPT: %ut - NEWed and created in EN1^%ut
N TESTCOUNT S TESTCOUNT=%ut("CHK")
D SUCCEED^%ut
D SUCCEED^%ut
D CHKEQ(%ut("CHK"),TESTCOUNT+2,"Succeed should increment the number of tests")
QUIT
;
T7 ; Make sure we write to principal even though we are on another device
; This is a rather difficult test to carry out for GT.M and Cache...
; ZEXCEPT: GetEnviron,Util,delete,newversion,readonly - not really variables
N D
I +$SY=47 S D="/tmp/test.txt" ; All GT.M ; VMS not supported.
I +$SY=0 D ; All Cache
. I $ZVERSION(1)=2 S D=$SYSTEM.Util.GetEnviron("temp")_"\test.txt" I 1 ; Windows
. E S D="/tmp/test.txt" ; not windows; VMS not supported.
I +$SY=0 O D:"NWS" ; Cache new file
I +$SY=47 O D:(newversion) ; GT.M new file
U D
WRITE "HELLO",!
WRITE "HELLO",!
C D
;
; Now open back the file, and read the hello, but open in read only so
; M-Unit will error out if it will write something out there.
;
I +$SY=0 O D:"R"
I +$SY=47 O D:(readonly)
U D
N X READ X:1
D CHKTF(X="HELLO") ; This should write to the screen the dot not to the file.
D CHKTF(($$LO($IO)=$$LO(D)),"IO device didn't get reset back") ; $$LO is b/c of a bug in Cache/Windows. $IO is not the same cas D.
I +$SY=0 C D:"D"
I +$SY=47 C D:(delete)
U $P
S IO=$IO
QUIT
;
; At the moment T8^%utt1 throws a fail, with no message
; in the GUI runner. For some reason, both X and Y
; variables are returned as null strings, while in the
; command line runner, Y has a value containing the
; word being sought
;
T8 ; If IO starts with another device, write to that device as if it's the pricipal device
; ZEXCEPT: GetEnviron,Util,delete,newversion,readonly - not really variables
N D
I +$SY=47 S D="/tmp/test.txt" ; All GT.M ; VMS not supported.
I +$SY=0 D ; All Cache
. I $ZVERSION(1)=2 S D=$SYSTEM.Util.GetEnviron("temp")_"\test.txt" I 1 ; Windows
. E S D="/tmp/test.txt" ; not windows; VMS not supported.
I +$SY=0 O D:"NWS" ; Cache new file
I +$SY=47 O D:(newversion) ; GT.M new file
S IO=D
U D
D ^%utt4 ; Run some Unit Tests
C D
I +$SY=0 O D:"R" ; Cache read only
I +$SY=47 O D:(readonly) ; GT.M read only
U D
N X,Y,Z R X:1,Y:1,Z:1
I +$SY=0 C D:"D"
I +$SY=47 C D:(delete)
;D CHKTF(Y["MAIN") ; JLI 140829 commented out, gui doesn't run verbose
D CHKTF((Y["MAIN")!(Z["T2 - Test 2"),"Write to system during test didn't work")
S IO=$P
QUIT
;
COVRPTGL ;
N GL1,GL2,GL3,GL4
S GL1=$NA(^TMP("%utCOVCOHORTSAVx",$J)) K @GL1
S GL2=$NA(^TMP("%utCOVCOHORTx",$J)) K @GL2
S GL3=$NA(^TMP("%utCOVRESULTx",$J)) K @GL3
S GL4=$NA(^TMP("%utCOVREPORTx",$J)) K @GL4
D SETGLOBS^%uttcovr(GL1,GL2)
D COVRPTGL^%ut1(GL1,GL2,GL3,GL4)
D CHKEQ($G(@GL4@("%ut1","ACTLINES")),"0/9","Wrong number of lines covered f>>or ACTLINES")
D CHKEQ($G(@GL4@("%ut1","ACTLINES",9))," QUIT CNT","Wrong result for last l>>ine not covered for ACTLINES")
D CHKEQ($G(@GL4@("%ut1","CHEKTEST")),"8/10","Wrong number of lines covered >>for CHEKTEST")
D CHKEQ($G(@GL4@("%ut1","CHEKTEST",39))," . Q","Wrong result for last line >>not covered for CHEKTEST")
K @GL1,@GL2,@GL3,@GL4
Q
;
LO(X) Q $TR(X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
; Shortcut methods for M-Unit
CHKTF(X,Y) ;
D CHKTF^%ut(X,$G(Y))
QUIT
;
CHKEQ(A,B,M) ;
D CHKEQ^%ut(A,B,$G(M))
QUIT
;
XTENT ; Entry points
;;T4;Entry point using XTMENT
;;T5;Error count check
;;T6;Succeed Entry Point
;;T7;Make sure we write to principal even though we are on another device
;;T8;If IO starts with another device, write to that device as if it's the pricipal device
;;COVRPTGL;coverage report returning global
;
XTROU ; Routines containing additional tests
;;%utt2; old %utNITU
;;%utt4; old %utNITW
;;%utt5;
;;%utt6;
;;%uttcovr;coverage related tests

30
Routines/%utt2.m
View File

@ -1,15 +1,15 @@
%utt2 ; VEN/SMH - Bad Ass Continuation of Unit Tests;12/16/15 08:44
;;1.3;MASH UTILITIES;;Dec 16, 2015;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Sam H. Habiel
; Modifications made by Joel L. Ivey 05/2014-09/2015
;
;
T11 ; @TEST An @TEST Entry point in Another Routine invoked through XTROU offsets
D CHKTF^%ut(1)
QUIT
T12 ;
D CHKTF^%ut(1)
QUIT
XTENT ;
;;T12;An XTENT offset entry point in Another Routine invoked through XTROU offsets
%utt2 ; VEN/SMH - Bad Ass Continuation of Unit Tests;12/16/15 08:44
;;1.4;MASH;;Feb 27, 2016;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Sam H. Habiel
; Modifications made by Joel L. Ivey 05/2014-09/2015
;
;
T11 ; @TEST An @TEST Entry point in Another Routine invoked through XTROU offsets
D CHKTF^%ut(1)
QUIT
T12 ;
D CHKTF^%ut(1)
QUIT
XTENT ;
;;T12;An XTENT offset entry point in Another Routine invoked through XTROU offsets

94
Routines/%utt3.m
View File

@ -1,47 +1,47 @@
%utt3 ; VEN/SMH-JLI - Unit Tests Coverage Tests;12/16/15 08:45
;;1.3;MASH UTILITIES;;Dec 16, 2015;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Sam H. Habiel 07/2013-04/2014
; Additions and modifications made by Joel L. Ivey 05/2014-08/2015
;
XTMUNITV ; VEN/SMH - Unit Tests Coverage Tests;2014-04-16 7:14 PM
;
; *** BE VERY CAREFUL IN MODIFIYING THIS ROUTINE ***
; *** THE UNIT TEST COUNTS ACTIVE AND INACTIVE LINES OF CODE ***
; *** IF YOU MODIFY THIS, MODIFY XTMUNITW AS WELL ***
;
; Coverage tester in %utt4
; 20 Lines of code
; 5 do not run as they are dead code
; Expected Coverage: 15/20 = 75%
;
STARTUP ; Doesn't count
N X ; Counts
S X=1 ; Counts
QUIT ; Counts
;
SHUTDOWN K X,Y QUIT ; Counts; ZEXCEPT: X,Y
;
SETUP S Y=$G(Y)+1 QUIT ; Counts
;
TEARDOWN ; Doesn't count
S Y=Y-1 ; Counts
QUIT ; Counts
;
T1 ; @TEST Test 1
D CHKTF^%ut($D(Y)) ; Counts
QUIT ; Counts
;
T2 ; @TEST Test 2
D INTERNAL(1) ; Counts
D CHKTF^%ut(1) ; Counts
QUIT ; Counts
S X=1 ; Dead code
QUIT ; Dead code
;
INTERNAL(A) ; Counts
S A=A+1 ; Counts
QUIT ; Counts
S A=2 ; Dead code
S Y=2 ; Dead code
QUIT ; Dead code
%utt3 ; VEN/SMH-JLI - Unit Tests Coverage Tests;12/16/15 08:45
;;1.4;MASH;;Feb 27, 2016;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Sam H. Habiel 07/2013-04/2014
; Additions and modifications made by Joel L. Ivey 05/2014-08/2015
;
XTMUNITV ; VEN/SMH - Unit Tests Coverage Tests;2014-04-16 7:14 PM
;
; *** BE VERY CAREFUL IN MODIFIYING THIS ROUTINE ***
; *** THE UNIT TEST COUNTS ACTIVE AND INACTIVE LINES OF CODE ***
; *** IF YOU MODIFY THIS, MODIFY XTMUNITW AS WELL ***
;
; Coverage tester in %utt4
; 20 Lines of code
; 5 do not run as they are dead code
; Expected Coverage: 15/20 = 75%
;
STARTUP ; Doesn't count
N X ; Counts
S X=1 ; Counts
QUIT ; Counts
;
SHUTDOWN K X,Y QUIT ; Counts; ZEXCEPT: X,Y
;
SETUP S Y=$G(Y)+1 QUIT ; Counts
;
TEARDOWN ; Doesn't count
S Y=Y-1 ; Counts
QUIT ; Counts
;
T1 ; @TEST Test 1
D CHKTF^%ut($D(Y)) ; Counts
QUIT ; Counts
;
T2 ; @TEST Test 2
D INTERNAL(1) ; Counts
D CHKTF^%ut(1) ; Counts
QUIT ; Counts
S X=1 ; Dead code
QUIT ; Dead code
;
INTERNAL(A) ; Counts
S A=A+1 ; Counts
QUIT ; Counts
S A=2 ; Dead code
S Y=2 ; Dead code
QUIT ; Dead code

44
Routines/%utt4.m
View File

@ -1,22 +1,22 @@
%utt4 ; VEN/SMH/JLI - Coverage Test Runner;12/16/15 08:45
;;1.3;MASH UTILITIES;;Dec 16, 2015;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Sam H. Habiel 07/2013-04/2014
; Additions and modifications made by Joel L. Ivey 05/2014-08/2015
;
XTMUNITW ; VEN/SMH - Coverage Test Runner;2014-04-17 3:30 PM
;;7.3;KERNEL TOOLKIT;;
;
; This tests code in XTMUNITV for coverage
D EN^%ut($T(+0),1) QUIT
;
MAIN ; @TEST - Test coverage calculations
Q:$D(^TMP("%uttcovr",$J)) ; already running coverage analysis from %uttcovr
S ^TMP("%utt4val",$J)=1
D COV^%ut("%utt3","D EN^%ut(""%utt3"",1)",-1) ; Only produce output global.
D CHKEQ^%ut("14/19",^TMP("%utCOVREPORT",$J))
D CHKEQ^%ut("2/5",^TMP("%utCOVREPORT",$J,"%utt3","INTERNAL"))
D CHKTF^%ut($D(^TMP("%utCOVREPORT",$J,"%utt3","T2",4)))
D CHKEQ^%ut("1/1",^TMP("%utCOVREPORT",$J,"%utt3","SETUP"))
K ^TMP("%utt4val",$J)
QUIT
%utt4 ; VEN/SMH/JLI - Coverage Test Runner;12/16/15 08:45
;;1.4;MASH;;Feb 27, 2016;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Sam H. Habiel 07/2013-04/2014
; Additions and modifications made by Joel L. Ivey 05/2014-08/2015
;
XTMUNITW ; VEN/SMH - Coverage Test Runner;2014-04-17 3:30 PM
;;7.3;KERNEL TOOLKIT;;
;
; This tests code in XTMUNITV for coverage
D EN^%ut($T(+0),1) QUIT
;
MAIN ; @TEST - Test coverage calculations
Q:$D(^TMP("%uttcovr",$J)) ; already running coverage analysis from %uttcovr
S ^TMP("%utt4val",$J)=1
D COV^%ut("%utt3","D EN^%ut(""%utt3"",1)",-1) ; Only produce output global.
D CHKEQ^%ut("14/19",^TMP("%utCOVREPORT",$J))
D CHKEQ^%ut("2/5",^TMP("%utCOVREPORT",$J,"%utt3","INTERNAL"))
D CHKTF^%ut($D(^TMP("%utCOVREPORT",$J,"%utt3","T2",4)))
D CHKEQ^%ut("1/1",^TMP("%utCOVREPORT",$J,"%utt3","SETUP"))
K ^TMP("%utt4val",$J)
QUIT

276
Routines/%utt5.m
View File

@ -1,138 +1,138 @@
%utt5 ;JLI - test for aspects of MUnit functionality ;12/16/15 08:47
;;1.3;MASH UTILITIES;;Dec 16, 2015;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Joel L. Ivey 05/2014-12/2015.
;
Q
;
OLDSTYLE ;
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %ut("ENT")="OLDSTYLE",%utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"OLDSTYLE")=""
D CHKEQ^%ut(5,5,"SET EQUAL ON PURPOSE - OLDSTYLE DONE")
D CHKTF^%ut(4=4,"MY EQUAL VALUE")
Q
;
OLDSTYL1 ;
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %ut("ENT")="OLDSTYL1",%utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"OLDSTYL1")=""
D CHKEQ^%ut(4,4,"SET EQUAL ON PURPOSE - OLDSTYL1 DONE")
Q
;
NEWSTYLE ; @TEST identify new style test indicator functionality
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %ut("ENT")="NEWSTYLE" S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"NEWSTYLE")=""
D CHKEQ^%ut(4,4,"SET EQUAL ON PURPOSE - NEWSTYLE DONE")
Q
;
BADCHKEQ ;
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %ut("ENT")="BADCHKEQ" S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"BADCHKEQ")=""
D CHKEQ^%ut(4,3,"SET UNEQUAL ON PURPOSE - SHOULD FAIL")
Q
;
BADCHKTF ;
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %ut("ENT")="BADCHKTF" S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"BADCHKTF")=""
D CHKTF^%ut(0,"SET FALSE (0) ON PURPOSE - SHOULD FAIL")
Q
;
BADERROR ;
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
N X
I $D(%utt6var) S %ut("ENT")="BADERROR" S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"BADERROR")=""
; following syntax error is on purpose to throw an error
S X= ; syntax error on purpose
Q
;
CALLFAIL ;
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
N X
I $D(%utt6var) S %ut("ENT")="CALLFAIL" S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"CALLFAIL")=""
D FAIL^%ut("Called FAIL to test it")
Q
;
LEAKSOK ;
N CODE,LOCATN,MYVALS,X
S CODE="S X=$$NOW^XLFDT()",LOCATN="LEAKSOK TEST",MYVALS("X")=""
D CHKLEAKS^%ut(CODE,LOCATN,.MYVALS) ; should find no leaks
Q
;
LEAKSBAD ;
N CODE,LOCATN,MYVALS,X
S CODE="S X=$$NOW^XLFDT()",LOCATN="LEAKSBAD TEST - X NOT SPECIFIED"
D CHKLEAKS^%ut(CODE,LOCATN,.MYVALS) ; should find X since it isn't indicated
Q
;
NVLDARG1 ;
D CHKEQ^%ut(1)
Q
;
ISUTEST ;
D CHKTF^%ut($$ISUTEST^%ut,"ISUTEST returned FALSE!")
Q
;
BADFORM1(X) ; @TEST should not be selected - arguments
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %ut("ENT")="NEWSTYLE" S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"BADFORM1")=""
D CHKEQ^%ut(4,3,"SHOULD NOT BE SELECTED - ARGUMENTS - BADFORM1")
Q
;
BADFORM2 ; ABC @TEST should not be selected - @TEST NOT FIRST
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"BADFORM2")=""
D CHKEQ^%ut(4,3,"SHOULD NOT BE SELECTED - @TEST NOT FIRST - BADFORM2")
Q
;
STARTUP ;
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
; ZEXCEPT: KBANCOUNT created here, killed in SHUTDOWN
I $D(%utt6var),$D(^TMP("%utt5",$J)) K ^TMP("%utt5",$J)
I $D(%utt6var) S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"STARTUP")=""
; following brought from %utt1, since only one STARTUP can RUN in a set
I '$D(%utt6var) D
. S ^TMP($J,"%ut","STARTUP")=""
. S KBANCOUNT=1
. Q
Q
;
SHUTDOWN ;
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
; ZEXCEPT: KBANCOUNT created in STARTUP, killed here
I $D(%utt6var) S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"SHUTDOWN")=""
; following brought from %utt1, since only one SHUTDOWN can RUN in a set
I '$D(%utt6var) D
. K ^TMP($J,"%ut","STARTUP")
. K KBANCOUNT
. Q
Q
;
SETUP ;
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"SETUP")=""
Q
;
TEARDOWN ;
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"TEARDOWN")=""
Q
;
XTENT ;
;;OLDSTYLE; identify old style test indicator functionality
;;OLDSTYL1; identify old style test indicator 2
;;BADCHKEQ; CHKEQ should fail on unequal value
;;BADCHKTF; CHKTF should fail on false value
;;BADERROR; throws an error on purpose
;;CALLFAIL; called FAIL to test it
;;LEAKSOK;check leaks should be ok
;;LEAKSBAD;check leaks with leak
;;NVLDARG1;check invalid arg in CHKEQ
;;ISUTEST;check ISUTEST inside unit test
%utt5 ;JLI - test for aspects of MUnit functionality ;12/16/15 08:47
;;1.4;MASH;;Feb 27, 2016;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Joel L. Ivey 05/2014-12/2015.
;
Q
;
OLDSTYLE ;
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %ut("ENT")="OLDSTYLE",%utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"OLDSTYLE")=""
D CHKEQ^%ut(5,5,"SET EQUAL ON PURPOSE - OLDSTYLE DONE")
D CHKTF^%ut(4=4,"MY EQUAL VALUE")
Q
;
OLDSTYL1 ;
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %ut("ENT")="OLDSTYL1",%utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"OLDSTYL1")=""
D CHKEQ^%ut(4,4,"SET EQUAL ON PURPOSE - OLDSTYL1 DONE")
Q
;
NEWSTYLE ; @TEST identify new style test indicator functionality
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %ut("ENT")="NEWSTYLE" S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"NEWSTYLE")=""
D CHKEQ^%ut(4,4,"SET EQUAL ON PURPOSE - NEWSTYLE DONE")
Q
;
BADCHKEQ ;
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %ut("ENT")="BADCHKEQ" S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"BADCHKEQ")=""
D CHKEQ^%ut(4,3,"SET UNEQUAL ON PURPOSE - SHOULD FAIL")
Q
;
BADCHKTF ;
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %ut("ENT")="BADCHKTF" S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"BADCHKTF")=""
D CHKTF^%ut(0,"SET FALSE (0) ON PURPOSE - SHOULD FAIL")
Q
;
BADERROR ;
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
N X
I $D(%utt6var) S %ut("ENT")="BADERROR" S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"BADERROR")=""
; following syntax error is on purpose to throw an error
S X= ; syntax error on purpose
Q
;
CALLFAIL ;
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
N X
I $D(%utt6var) S %ut("ENT")="CALLFAIL" S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"CALLFAIL")=""
D FAIL^%ut("Called FAIL to test it")
Q
;
LEAKSOK ;
N CODE,LOCATN,MYVALS,X
S CODE="S X=$$NOW^XLFDT()",LOCATN="LEAKSOK TEST",MYVALS("X")=""
D CHKLEAKS^%ut(CODE,LOCATN,.MYVALS) ; should find no leaks
Q
;
LEAKSBAD ;
N CODE,LOCATN,MYVALS,X
S CODE="S X=$$NOW^XLFDT()",LOCATN="LEAKSBAD TEST - X NOT SPECIFIED"
D CHKLEAKS^%ut(CODE,LOCATN,.MYVALS) ; should find X since it isn't indicated
Q
;
NVLDARG1 ;
D CHKEQ^%ut(1)
Q
;
ISUTEST ;
D CHKTF^%ut($$ISUTEST^%ut,"ISUTEST returned FALSE!")
Q
;
BADFORM1(X) ; @TEST should not be selected - arguments
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %ut("ENT")="NEWSTYLE" S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"BADFORM1")=""
D CHKEQ^%ut(4,3,"SHOULD NOT BE SELECTED - ARGUMENTS - BADFORM1")
Q
;
BADFORM2 ; ABC @TEST should not be selected - @TEST NOT FIRST
; ZEXCEPT: %ut - Newed in EN^%zu
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"BADFORM2")=""
D CHKEQ^%ut(4,3,"SHOULD NOT BE SELECTED - @TEST NOT FIRST - BADFORM2")
Q
;
STARTUP ;
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
; ZEXCEPT: KBANCOUNT created here, killed in SHUTDOWN
I $D(%utt6var),$D(^TMP("%utt5",$J)) K ^TMP("%utt5",$J)
I $D(%utt6var) S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"STARTUP")=""
; following brought from %utt1, since only one STARTUP can RUN in a set
I '$D(%utt6var) D
. S ^TMP($J,"%ut","STARTUP")=""
. S KBANCOUNT=1
. Q
Q
;
SHUTDOWN ;
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
; ZEXCEPT: KBANCOUNT created in STARTUP, killed here
I $D(%utt6var) S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"SHUTDOWN")=""
; following brought from %utt1, since only one SHUTDOWN can RUN in a set
I '$D(%utt6var) D
. K ^TMP($J,"%ut","STARTUP")
. K KBANCOUNT
. Q
Q
;
SETUP ;
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"SETUP")=""
Q
;
TEARDOWN ;
; ZEXCEPT: %utt6cnt,%utt6var - if present, NEWED following top entry of routine %utt6
I $D(%utt6var) S %utt6cnt=$G(%utt6cnt)+1,^TMP("%utt5",$J,%utt6cnt,"TEARDOWN")=""
Q
;
XTENT ;
;;OLDSTYLE; identify old style test indicator functionality
;;OLDSTYL1; identify old style test indicator 2
;;BADCHKEQ; CHKEQ should fail on unequal value
;;BADCHKTF; CHKTF should fail on false value
;;BADERROR; throws an error on purpose
;;CALLFAIL; called FAIL to test it
;;LEAKSOK;check leaks should be ok
;;LEAKSBAD;check leaks with leak
;;NVLDARG1;check invalid arg in CHKEQ
;;ISUTEST;check ISUTEST inside unit test

276
Routines/%utt6.m
View File

@ -1,138 +1,138 @@
%utt6 ;JLI - Unit tests for MUnit functionality ;12/16/15 08:47
;;1.3;MASH UTILITIES;;Dec 16, 2015;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Joel L. Ivey 05/2014-12/2015
;
;
; This routine uses ZZUTJLI2 as a test routine, it does not include the routine as an extension,
; since it uses it for tests.
;
; ZZUTJLI2 currently contains 3 tests (2 old style, 1 new style), it also specifies STARTUP and
; SHUTDOWN (should be 1 each) and SETUP and TEARDOWN (should be 3 each, 1 for each test) enteries, each of these
; creates an entry under the ^TMP("ZZUTJLI2" global node, indicating function then continues the process.
; Should be 2+3n entries (1+1 for STARTUP and SHUTDOWN, then 3 for each of the tests (SETUP, test,
; and TEARDOWN).
;
; This first section is more of a functional test, since it checks the full unit test processing from both
; a command line and a GUI call approach. Data for analysis is saved under ^TMP("ZZUTJLI2_C", for command
; line and ^TMP("ZZUTJLI2_G", for gui processing.
;
; The counts for the command line processing are based on the number of unit test tags
; determined for the GUI processing as well. The numbers are 2 (startup and shutdown)
; + 3 x the number of tests present.
;
; run unit tests by command line
N VERBOSE
S VERBOSE=0
VERBOSE ;
I '$D(VERBOSE) N VERBOSE S VERBOSE=1
N ZZUTCNT,JLICNT,JLIEXPCT,JLII,JLIX,ZZUTRSLT,%utt5,%utt6,%utt6var
W !!,"RUNNING COMMAND LINE TESTS VIA DOSET^%ut",!
D DOSET^%ut(1,VERBOSE) ; run `1 in M-UNIT TEST GROUP file
;
W !!!,"Running command line tests by RUNSET^%ut",!
D RUNSET^%ut("TESTS FOR UNIT TEST ROUTINES")
;
; Call GUISET to obtain list of tags via entry in M-UNIT TEST GROUP file
; silent to the user
D GUISET^%ut(.%utt6,1)
K ^TMP("%utt6_GUISET",$J) M ^TMP("%utt6_GUISET",$J)=@%utt6
;
W !!!,"RUNNING COMMAND LINE UNIT TESTS FOR %utt5",!
N ZZUTCNT,JLICNT,JLIEXPCT,JLII,JLIX,ZZUTRSLT
S ZZUTCNT=0
K ^TMP("%utt5",$J) ; kill any contents of data storage
D EN^%ut("%utt5",VERBOSE) ; should do STARTUP(1x), then SETUP, test, TEARDOWN (each together 3x) and SHUTDOWN (1x)
K ^TMP("%utt5_C",$J) M ^TMP("%utt5_C",$J)=^TMP("%utt5",$J)
;
; now run unit tests by GUI - first determines unit test tags
W !!!,"RUNNING UNIT TESTS FOR %utt5 VIA GUI CALLS - Silent",!
S ZZUTCNT=0
K ^TMP("%utt5",$J),^TMP("%utt6",$J)
D GUILOAD^%ut(.%utt6,"%utt5")
M ^TMP("%utt6",$J)=@%utt6
S %utt6=$NA(^TMP("%utt6",$J))
; then run each tag separately
; JLICNT is count of unit test tags, which can be determined for GUI call for each unit test tag
S JLICNT=0 F JLII=1:1 S JLIX=$G(@%utt6@(JLII)) Q:JLIX="" I $P(JLIX,U,2)'="" S JLICNT=JLICNT+1 D GUINEXT^%ut(.ZZUTRSLT,$P(JLIX,U,2)_U_$P(JLIX,U))
; and close it with a null routine name
D GUINEXT^%ut(.ZZUTRSLT,"")
K ^TMP("%utt5_G",$J) M ^TMP("%utt5_G",$J)=^TMP("%utt5",$J)
S JLIEXPCT=2+(3*JLICNT) ; number of lines that should be in the global nodes for command line and GUI
;
W !!,"NOW RUNNING UNIT TESTS FOR %uttcovr",!!
D EN^%ut("%uttcovr",VERBOSE)
;
; now run the unit tests in this routine
W !!,"NOW RUNNING UNIT TESTS FOR %utt6",!!
D EN^%ut("%utt6",VERBOSE)
K ^TMP("%utt5",$J),^TMP("%utt5_C",$J),^TMP("%utt5_G",$J),^TMP("%utt6",$J),^TMP("%utt6_GUISET",$J)
; clean up after GUI calls as well
K ^TMP("GUI-MUNIT",$J),^TMP("GUINEXT",$J),^TMP("MUNIT-%utRSLT",$J)
Q
;
;
; WARNING -- WARNING -- WARNING
; If the number of NEW STYLE tests in %utt5 is increased (it is currently 1), then the following
; test will need to be updated to reflect the change(s)
; END OF WARNING -- END OF WARNING -- END OF WARNING
;
SETROUS ; @TEST - generate array with indices of routines to exclude
N ROU,XCLDROUS,ROULIST
S XCLDROUS(1)="ROU1NAME,ROU2NAME"
S XCLDROUS("ROUNAME3")="ROUNAME4,ROUNAME5"
D SETROUS^%utcover(.ROULIST,.XCLDROUS,1)
D CHKTF('$D(ROULIST(1)),"SETROUS returned number for routine")
D CHKTF($D(ROULIST("ROU1NAME")),"Didn't get first name on numeric subscript")
D CHKTF($D(ROULIST("ROU2NAME")),"Didn't get second name on numeric subscript")
D SETROUS^%utcover(.ROULIST,.XCLDROUS,"ROUNAME3")
D CHKTF($D(ROULIST("ROUNAME3")),"Didn't get name for routine argument")
D CHKTF($D(ROULIST("ROUNAME4")),"Didn't get first name on routine subscript")
D CHKTF($D(ROULIST("ROUNAME5")),"Didn't get second name on routine subscript")
Q
;
NEWSTYLE ; tests return of valid new style or @TEST indicators
N LIST
D NEWSTYLE^%ut1(.LIST,"%utt5")
D CHKEQ^%ut(LIST,1,"Returned an incorrect number ("_LIST_") of New Style indicators - should be one")
I LIST>0 D CHKEQ^%ut(LIST(1),"NEWSTYLE^identify new style test indicator functionality","Returned incorrect TAG^reason "_LIST(1))
I LIST>0 D CHKEQ^%ut($G(LIST(2)),"","Returned a value for LIST(2) - should not have any value (i.e., null)")
; the following is basically just for coverage
D PICKSET^%ut
Q
;
CKGUISET ;
; ZEXCEPT: %utt6var - if present, is NEWed and created in code following VERBOSE
I '$D(%utt6var) Q
N MAX
S MAX=$O(^TMP("%utt6_GUISET",$J,""),-1)
D CHKTF(^TMP("%utt6_GUISET",$J,MAX)["%utt6^NEWSTYLE","GUISET returned incorrect list")
Q
;
CHKCMDLN ; check command line processing of %utt5
; ZEXCEPT: JLIEXPCT,%utt6var - if present NEWed and created in code following VERBOSE tag
I '$D(%utt6var) Q
D CHKTF($D(^TMP("%utt5_C",$J,JLIEXPCT))=10,"Not enough entries in %utt5 expected "_JLIEXPCT)
D CHKTF($D(^TMP("%utt5_C",$J,JLIEXPCT+1))=0,"Too many entries in %utt5 expected "_JLIEXPCT)
D CHKTF($O(^TMP("%utt5_C",$J,1,""))="STARTUP","Incorrect function for entry 1,'"_$O(^TMP("%utt5_C",$J,1,""))_"' should be 'STARTUP'")
D CHKTF($O(^TMP("%utt5_C",$J,JLIEXPCT,""))="SHUTDOWN","Incorrect function for entry "_JLIEXPCT_", '"_$O(^TMP("%utt5_C",$J,JLIEXPCT,""))_"' should be 'SHUTDOWN'")
Q
;
CHKGUI ; check GUI processing of %utt5
; ZEXCEPT: JLIEXPCT,%utt6var - if present NEWed and created in code following VERBOSE tag
I '$D(%utt6var) Q
D CHKTF($D(^TMP("%utt5_G",$J,JLIEXPCT))=10,"Not enough entries in %utt5 expected "_JLIEXPCT)
D CHKTF($D(^TMP("%utt5_G",$J,JLIEXPCT+1))=0,"Too many entries in %utt5 expected "_JLIEXPCT)
D CHKTF($O(^TMP("%utt5_G",$J,1,""))="STARTUP","Incorrect function for entry 1,'"_$O(^TMP("%utt5Z_G",1,""))_"' should be 'STARTUP'")
D CHKTF($O(^TMP("%utt5_G",$J,JLIEXPCT,""))="SHUTDOWN","Incorrect function for entry "_JLIEXPCT_", '"_$O(^TMP("%utt5_G",$J,JLIEXPCT,""))_"' should be 'SHUTDOWN'")
Q
;
CHKTF(VALUE,MESSAGE) ;
D CHKTF^%ut($G(VALUE),$G(MESSAGE))
Q
;
XTENT ;
;;CHKCMDLN;check command line processing of %utt5
;;CHKGUI;check GUI processing of %utt5
;;CKGUISET;check list of tests returned by GUISET
;;NEWSTYLE;test return of valid new style or @TEST indicators
%utt6 ;JLI - Unit tests for MUnit functionality ;12/16/15 08:47
;;1.4;MASH;;Feb 27, 2016;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Joel L. Ivey 05/2014-12/2015
;
;
; This routine uses ZZUTJLI2 as a test routine, it does not include the routine as an extension,
; since it uses it for tests.
;
; ZZUTJLI2 currently contains 3 tests (2 old style, 1 new style), it also specifies STARTUP and
; SHUTDOWN (should be 1 each) and SETUP and TEARDOWN (should be 3 each, 1 for each test) enteries, each of these
; creates an entry under the ^TMP("ZZUTJLI2" global node, indicating function then continues the process.
; Should be 2+3n entries (1+1 for STARTUP and SHUTDOWN, then 3 for each of the tests (SETUP, test,
; and TEARDOWN).
;
; This first section is more of a functional test, since it checks the full unit test processing from both
; a command line and a GUI call approach. Data for analysis is saved under ^TMP("ZZUTJLI2_C", for command
; line and ^TMP("ZZUTJLI2_G", for gui processing.
;
; The counts for the command line processing are based on the number of unit test tags
; determined for the GUI processing as well. The numbers are 2 (startup and shutdown)
; + 3 x the number of tests present.
;
; run unit tests by command line
N VERBOSE
S VERBOSE=0
VERBOSE ;
I '$D(VERBOSE) N VERBOSE S VERBOSE=1
N ZZUTCNT,JLICNT,JLIEXPCT,JLII,JLIX,ZZUTRSLT,%utt5,%utt6,%utt6var
W !!,"RUNNING COMMAND LINE TESTS VIA DOSET^%ut",!
D DOSET^%ut(1,VERBOSE) ; run `1 in M-UNIT TEST GROUP file
;
W !!!,"Running command line tests by RUNSET^%ut",!
D RUNSET^%ut("TESTS FOR UNIT TEST ROUTINES")
;
; Call GUISET to obtain list of tags via entry in M-UNIT TEST GROUP file
; silent to the user
D GUISET^%ut(.%utt6,1)
K ^TMP("%utt6_GUISET",$J) M ^TMP("%utt6_GUISET",$J)=@%utt6
;
W !!!,"RUNNING COMMAND LINE UNIT TESTS FOR %utt5",!
N ZZUTCNT,JLICNT,JLIEXPCT,JLII,JLIX,ZZUTRSLT
S ZZUTCNT=0
K ^TMP("%utt5",$J) ; kill any contents of data storage
D EN^%ut("%utt5",VERBOSE) ; should do STARTUP(1x), then SETUP, test, TEARDOWN (each together 3x) and SHUTDOWN (1x)
K ^TMP("%utt5_C",$J) M ^TMP("%utt5_C",$J)=^TMP("%utt5",$J)
;
; now run unit tests by GUI - first determines unit test tags
W !!!,"RUNNING UNIT TESTS FOR %utt5 VIA GUI CALLS - Silent",!
S ZZUTCNT=0
K ^TMP("%utt5",$J),^TMP("%utt6",$J)
D GUILOAD^%ut(.%utt6,"%utt5")
M ^TMP("%utt6",$J)=@%utt6
S %utt6=$NA(^TMP("%utt6",$J))
; then run each tag separately
; JLICNT is count of unit test tags, which can be determined for GUI call for each unit test tag
S JLICNT=0 F JLII=1:1 S JLIX=$G(@%utt6@(JLII)) Q:JLIX="" I $P(JLIX,U,2)'="" S JLICNT=JLICNT+1 D GUINEXT^%ut(.ZZUTRSLT,$P(JLIX,U,2)_U_$P(JLIX,U))
; and close it with a null routine name
D GUINEXT^%ut(.ZZUTRSLT,"")
K ^TMP("%utt5_G",$J) M ^TMP("%utt5_G",$J)=^TMP("%utt5",$J)
S JLIEXPCT=2+(3*JLICNT) ; number of lines that should be in the global nodes for command line and GUI
;
W !!,"NOW RUNNING UNIT TESTS FOR %uttcovr",!!
D EN^%ut("%uttcovr",VERBOSE)
;
; now run the unit tests in this routine
W !!,"NOW RUNNING UNIT TESTS FOR %utt6",!!
D EN^%ut("%utt6",VERBOSE)
K ^TMP("%utt5",$J),^TMP("%utt5_C",$J),^TMP("%utt5_G",$J),^TMP("%utt6",$J),^TMP("%utt6_GUISET",$J)
; clean up after GUI calls as well
K ^TMP("GUI-MUNIT",$J),^TMP("GUINEXT",$J),^TMP("MUNIT-%utRSLT",$J)
Q
;
;
; WARNING -- WARNING -- WARNING
; If the number of NEW STYLE tests in %utt5 is increased (it is currently 1), then the following
; test will need to be updated to reflect the change(s)
; END OF WARNING -- END OF WARNING -- END OF WARNING
;
SETROUS ; @TEST - generate array with indices of routines to exclude
N ROU,XCLDROUS,ROULIST
S XCLDROUS(1)="ROU1NAME,ROU2NAME"
S XCLDROUS("ROUNAME3")="ROUNAME4,ROUNAME5"
D SETROUS^%utcover(.ROULIST,.XCLDROUS,1)
D CHKTF('$D(ROULIST(1)),"SETROUS returned number for routine")
D CHKTF($D(ROULIST("ROU1NAME")),"Didn't get first name on numeric subscript")
D CHKTF($D(ROULIST("ROU2NAME")),"Didn't get second name on numeric subscript")
D SETROUS^%utcover(.ROULIST,.XCLDROUS,"ROUNAME3")
D CHKTF($D(ROULIST("ROUNAME3")),"Didn't get name for routine argument")
D CHKTF($D(ROULIST("ROUNAME4")),"Didn't get first name on routine subscript")
D CHKTF($D(ROULIST("ROUNAME5")),"Didn't get second name on routine subscript")
Q
;
NEWSTYLE ; tests return of valid new style or @TEST indicators
N LIST
D NEWSTYLE^%ut1(.LIST,"%utt5")
D CHKEQ^%ut(LIST,1,"Returned an incorrect number ("_LIST_") of New Style indicators - should be one")
I LIST>0 D CHKEQ^%ut(LIST(1),"NEWSTYLE^identify new style test indicator functionality","Returned incorrect TAG^reason "_LIST(1))
I LIST>0 D CHKEQ^%ut($G(LIST(2)),"","Returned a value for LIST(2) - should not have any value (i.e., null)")
; the following is basically just for coverage
D PICKSET^%ut
Q
;
CKGUISET ;
; ZEXCEPT: %utt6var - if present, is NEWed and created in code following VERBOSE
I '$D(%utt6var) Q
N MAX
S MAX=$O(^TMP("%utt6_GUISET",$J,""),-1)
D CHKTF(^TMP("%utt6_GUISET",$J,MAX)["%utt6^NEWSTYLE","GUISET returned incorrect list")
Q
;
CHKCMDLN ; check command line processing of %utt5
; ZEXCEPT: JLIEXPCT,%utt6var - if present NEWed and created in code following VERBOSE tag
I '$D(%utt6var) Q
D CHKTF($D(^TMP("%utt5_C",$J,JLIEXPCT))=10,"Not enough entries in %utt5 expected "_JLIEXPCT)
D CHKTF($D(^TMP("%utt5_C",$J,JLIEXPCT+1))=0,"Too many entries in %utt5 expected "_JLIEXPCT)
D CHKTF($O(^TMP("%utt5_C",$J,1,""))="STARTUP","Incorrect function for entry 1,'"_$O(^TMP("%utt5_C",$J,1,""))_"' should be 'STARTUP'")
D CHKTF($O(^TMP("%utt5_C",$J,JLIEXPCT,""))="SHUTDOWN","Incorrect function for entry "_JLIEXPCT_", '"_$O(^TMP("%utt5_C",$J,JLIEXPCT,""))_"' should be 'SHUTDOWN'")
Q
;
CHKGUI ; check GUI processing of %utt5
; ZEXCEPT: JLIEXPCT,%utt6var - if present NEWed and created in code following VERBOSE tag
I '$D(%utt6var) Q
D CHKTF($D(^TMP("%utt5_G",$J,JLIEXPCT))=10,"Not enough entries in %utt5 expected "_JLIEXPCT)
D CHKTF($D(^TMP("%utt5_G",$J,JLIEXPCT+1))=0,"Too many entries in %utt5 expected "_JLIEXPCT)
D CHKTF($O(^TMP("%utt5_G",$J,1,""))="STARTUP","Incorrect function for entry 1,'"_$O(^TMP("%utt5Z_G",1,""))_"' should be 'STARTUP'")
D CHKTF($O(^TMP("%utt5_G",$J,JLIEXPCT,""))="SHUTDOWN","Incorrect function for entry "_JLIEXPCT_", '"_$O(^TMP("%utt5_G",$J,JLIEXPCT,""))_"' should be 'SHUTDOWN'")
Q
;
CHKTF(VALUE,MESSAGE) ;
D CHKTF^%ut($G(VALUE),$G(MESSAGE))
Q
;
XTENT ;
;;CHKCMDLN;check command line processing of %utt5
;;CHKGUI;check GUI processing of %utt5
;;CKGUISET;check list of tests returned by GUISET
;;NEWSTYLE;test return of valid new style or @TEST indicators

644
Routines/%uttcovr.m
View File

@ -1,322 +1,322 @@
%uttcovr ;JIVEYSOFT/JLI - runs coverage tests on %ut and %ut1 routines via unit tests ;12/16/15 08:48
;;1.3;MASH UTILITIES;;Dec 16, 2015;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Joel L. Ivey 05/2014-12/2015
;
;
; ZEXCEPT: DTIME - if present the value is Kernel timeout for reads
N RUNCODE,XCLUDE
;
; Have it run the following entry points or, if no ^, call EN^%ut with routine name
S RUNCODE(1)="^%utt1,%utt1,^%utt6,VERBOSE^%utt6,%uttcovr,^%ut,^%ut1,^%utcover"
S RUNCODE("ENTRY^%uttcovr")=""
; Have the analysis EXCLUDE the following routines from coverage - unit test routines
S XCLUDE(1)="%utt1,%utt2,%utt3,%utt4,%utt5,%utt6,%uttcovr"
S XCLUDE(2)="%utf2hex" ; a GT.M system file, although it wasn't showing up anyway
M ^TMP("%uttcovr",$J,"XCLUDE")=XCLUDE
D COVERAGE^%ut("%ut*",.RUNCODE,.XCLUDE,3)
Q
;
ENTRY ;
K ^TMP("ENTRY^%uttcovr",$J,"VALS")
M ^TMP("ENTRY^%uttcovr",$J,"VALS")=^TMP("%ut",$J,"UTVALS")
K ^TMP("%ut",$J,"UTVALS")
; these tests run outside of unit tests to handle CHKLEAKS calls not in unit tests
; they need data set, so they are called in here
; LEAKSOK ;
N CODE,LOCATN,MYVALS,X,I
S CODE="S X=$$NOW^XLFDT()",LOCATN="LEAKSOK TEST",MYVALS("X")=""
D CHKLEAKS^%ut(CODE,LOCATN,.MYVALS) ; should find no leaks
; LEAKSBAD ;
N CODE,LOCATN,MYVALS,X
S CODE="S X=$$NOW^XLFDT()",LOCATN="LEAKSBAD TEST - X NOT SPECIFIED"
D CHKLEAKS^%ut(CODE,LOCATN,.MYVALS) ; should find X since it isn't indicated
; try to run coverage
W !,"xxxxxxxxxxxxxxxxxxxx GOING TO COV^%ut FOR %utt5 at 3",!!!
D COV^%ut("%ut1","D EN^%ut(""%utt5"")",3)
W !,"xxxxxxxxxxxxxxxxxxxx GOING TO COV^%ut FOR %utt5 at -1",!!!
D COV^%ut("%ut1","D EN^%ut(""%utt5"")",-1)
N RUNCODE S RUNCODE(1)="^%utt4,^%ut"
N XCLUDE M XCLUDE=^TMP("%uttcovr",$J,"XCLUDE")
W !,"xxxxxxxxxxxxxxxxxxxx GOING TO MULTAPIS for %utt4 and %ut",!!!
D MULTAPIS^%ut(.RUNCODE)
W !,"xxxxxxxxxxxxxxxxxxxx GOING TO COVERAGE for %utt4 and %ut at 3",!!!
D COVERAGE^%ut("%ut*",.RUNCODE,.XCLUDE,3)
N GLT S GLT=$NA(^TMP("%uttcovr-text",$J)) K @GLT
W !,"xxxxxxxxxxxxxxxxxxxx LISTING DATA VIA LIST",!!!
D LIST^%utcover(.XCLUDE,3,GLT) ; get coverage for listing and trimdata in %utcover
F I=1:1 Q:'$D(@GLT@(I)) W !,@GLT@(I)
K @GLT
; restore unit test totals from before entry
K ^TMP("%ut",$J,"UTVALS")
M ^TMP("%ut",$J,"UTVALS")=^TMP("ENTRY^%uttcovr",$J,"VALS")
K ^TMP("ENTRY^%uttcovr",$J,"VALS")
W !,"xxxxxxxxxxxxxxxxxxxx Finished in ENTRY^%uttcovr",!!!
Q
;
RTNANAL ; @TEST - routine analysis
N ROUS,GLB
S ROUS("%utt4")=""
S GLB=$NA(^TMP("%uttcovr-rtnanal",$J)) K @GLB
D RTNANAL^%ut1(.ROUS,GLB)
D CHKTF($D(@GLB@("%utt4","MAIN"))>1,"Not enough 'MAIN' nodes found")
D CHKTF($G(@GLB@("%utt4","MAIN",3))["D COV^%ut(""%utt3"",""D EN^%ut(""""%utt3"""",1)"",-1)","Incorrect data for line 2 in MAIN")
D CHKTF($G(@GLB@("%utt4","MAIN",9))=" QUIT","Final QUIT not on expected line")
K @GLB
Q
;
COVCOV ; @TEST - check COVCOV - remove seen lines
N C,R
S C=$NA(^TMP("%uttcovr_C",$J))
S R=$NA(^TMP("%uttcovr_R",$J))
S @C@("ROU1")=""
S @C@("ROU2")="",@R@("ROU2")=""
S @C@("ROU2","TAG1")="",@R@("ROU2","TAG1")=""
S @C@("ROU2","TAG1",1)="AAA"
S @C@("ROU2","TAG1",2)="AAA",@R@("ROU2","TAG1",2)="AAA"
S @C@("ROU2","TAG1",3)="ABB",@R@("ROU2","TAG1",3)="ABB"
S @C@("ROU2","TAG2",6)="ACC"
S @C@("ROU2","TAG2",7)="ADD",@R@("ROU2","TAG2",7)="ADD"
S @C@("ROU3","TAG1",2)="BAA",@R@("ROU3","TAG1",2)="BAA"
S @C@("ROU3","TAG1",3)="CAA"
S @C@("ROU3","TAG1",4)="DAA"
S @C@("ROU3","TAG1",5)="EAA",@R@("ROU3","TAG1",5)="EAA"
S @C@("ROU3","TAG1",6)="FAA",@R@("ROU3","TAG1",6)="FAA"
D COVCOV^%ut1(C,R)
D CHKTF($D(@C@("ROU2","TAG1",1)),"Invalid value for ""ROU2"",""TAG1"",1")
D CHKTF('$D(@C@("ROU2","TAG1",2)),"Unexpected value for ""ROU2"",""TAG1"",1")
D CHKTF($D(@C@("ROU2","TAG2",6)),"Invalid value for ""ROU2"",""TAG1"",1")
D CHKTF('$D(@C@("ROU2","TAG2",7)),"Unexpected value for ""ROU2"",""TAG1"",1")
D CHKTF($D(@C@("ROU3","TAG1",4)),"Invalid value for ""ROU2"",""TAG1"",1")
D CHKTF('$D(@C@("ROU3","TAG1",5)),"Unexpected value for ""ROU2"",""TAG1"",1")
K @C,@R
Q
;
COVRPT ; @TEST
N GL1,GL2,GL3,GL4,VRBOSITY,GL5
S GL1=$NA(^TMP("%utCOVCOHORTSAVx",$J)) K @GL1
S GL2=$NA(^TMP("%utCOVCOHORTx",$J)) K @GL2
S GL3=$NA(^TMP("%utCOVRESULTx",$J)) K @GL3
S GL4=$NA(^TMP("%utCOVREPORTx",$J)) K @GL4
S GL5=$NA(^TMP("%ut1-covrpt",$J)) K @GL5
D SETGLOBS(GL1,GL2)
S VRBOSITY=1
D COVRPT^%ut1(GL1,GL2,GL3,VRBOSITY)
D CHKEQ("COVERAGE PERCENTAGE: 42.11",$G(@GL5@(5)),"Verbosity 1 - not expected percentage value")
D CHKEQ(" %ut1 42.11% 8 out of 19",$G(@GL5@(9)),"Verbosity 1 - not expected value for line 9")
D CHKTF('$D(@GL5@(10)),"Verbosity 1 - unexpected data in 10th line")
;
S VRBOSITY=2
D COVRPT^%ut1(GL1,GL2,GL3,VRBOSITY)
D CHKEQ(" ACTLINES 0.00% 0 out of 9",$G(@GL5@(10)),"Verbosity 2 - not expected value for 10th line")
D CHKEQ(" CHEKTEST 80.00% 8 out of 10",$G(@GL5@(11)),"Verbosity 2 - not expected value for 11th line")
D CHKTF('$D(@GL5@(12)),"Verbosity 2 - unexpected data for 12th line")
;
S VRBOSITY=3
D COVRPT^%ut1(GL1,GL2,GL3,VRBOSITY)
D CHKEQ(" ACTLINES 0.00% 0 out of 9",$G(@GL5@(10)),"Verbosity 3 - unexpected value for line 10")
D CHKEQ("ACTLINES+9: QUIT CNT",$G(@GL5@(19)),"Verbosity 3 - unexpected value for line 19")
D CHKEQ(" CHEKTEST 80.00% 8 out of 10",$G(@GL5@(20)),"Verbosity 3 - unexpected value for line 20")
D CHKEQ("CHEKTEST+39: . Q",$G(@GL5@(22)),"Verbosity 3 - unexpected value for line 22")
D CHKTF('$D(@GL5@(23)),"Verbosity 3 - unexpected line 23")
K @GL1,@GL2,@GL3,@GL4,@GL5
Q
;
COVRPTLS ; @TEST - coverage report returning text in global
N GL1,GL2,GL3,GL4,VRBOSITY
S GL1=$NA(^TMP("%utCOVCOHORTSAVx",$J)) K @GL1
S GL2=$NA(^TMP("%utCOVCOHORTx",$J)) K @GL2
S GL3=$NA(^TMP("%utCOVRESULTx",$J)) K @GL3
S GL4=$NA(^TMP("%utCOVREPORTx",$J)) K @GL4
D SETGLOBS(GL1,GL2)
S VRBOSITY=1
D COVRPTLS^%ut1(GL1,GL2,GL3,VRBOSITY,GL4)
D CHKEQ("COVERAGE PERCENTAGE: 42.11",$G(@GL4@(5)),"Verbosity 1 - not expected percentage value")
D CHKEQ(" %ut1 42.11% 8 out of 19",$G(@GL4@(9)),"Verbosity 1 - not expected value for line 9")
D CHKTF('$D(@GL4@(10)),"Verbosity 1 - unexpected data in 10th line")
K @GL4
;
S VRBOSITY=2
D COVRPTLS^%ut1(GL1,GL2,GL3,VRBOSITY,GL4)
D CHKEQ(" ACTLINES 0.00% 0 out of 9",$G(@GL4@(10)),"Verbosity 2 - not expected value for 10th line")
D CHKEQ(" CHEKTEST 80.00% 8 out of 10",$G(@GL4@(11)),"Verbosity 2 - not expected value for 11th line")
D CHKTF('$D(@GL4@(12)),"Verbosity 2 - unexpected data for 12th line")
K @GL4
;
S VRBOSITY=3
D COVRPTLS^%ut1(GL1,GL2,GL3,VRBOSITY,GL4)
D CHKEQ(" ACTLINES 0.00% 0 out of 9",$G(@GL4@(10)),"Verbosity 3 - unexpected value for line 10")
D CHKEQ("ACTLINES+9: QUIT CNT",$G(@GL4@(19)),"Verbosity 3 - unexpected value for line 19")
D CHKEQ(" CHEKTEST 80.00% 8 out of 10",$G(@GL4@(20)),"Verbosity 3 - unexpected value for line 20")
D CHKEQ("CHEKTEST+39: . Q",$G(@GL4@(22)),"Verbosity 3 - unexpected value for line 22")
D CHKTF('$D(@GL4@(23)),"Verbosity 3 - unexpected line 23")
;
K @GL1,@GL2,@GL3,@GL4
Q
;
TRIMDATA ; @TEST - TRIMDATA in %utcover
N GL1,XCLUD
S GL1=$NA(^TMP("%uttcovr-trimdata",$J)) K @GL1
S @GL1@("GOOD",1)="1"
S @GL1@("BAD",1)="1"
S XCLUD("BAD")=""
D TRIMDATA^%utcover(.XCLUD,GL1)
D CHKTF($D(@GL1@("GOOD")),"GOOD ENTRY WAS REMOVED")
D CHKTF('$D(@GL1@("BAD")),"ENTRY WAS NOT TRIMMED")
K @GL1,XCLUD
Q
;
LIST ; @TEST - LIST in %utcover
N GL1,GLT S GL1=$NA(^TMP("%uttcovr-list",$J)),GLT=$NA(^TMP("%uttcovr-text",$J))
S @GL1@("%ut1")="89/160"
S @GL1@("%ut1","%ut1")="2/2"
S @GL1@("%ut1","ACTLINES")="0/8"
S @GL1@("%ut1","ACTLINES",2)=" N CNT S CNT=0"
S @GL1@("%ut1","ACTLINES",3)=" N REF S REF=GL"
S @GL1@("%ut1","ACTLINES",4)=" N GLQL S GLQL=$QL(GL)"
S @GL1@("%ut1","ACTLINES",5)=" F S REF=$Q(@REF) Q:REF="""" Q:(GL'=$NA(@REF,GLQL)) D"
S @GL1@("%ut1","ACTLINES",6)=" . N REFQL S REFQL=$QL(REF)"
S @GL1@("%ut1","ACTLINES",7)=" . N LASTSUB S LASTSUB=$QS(REF,REFQL)"
S @GL1@("%ut1","ACTLINES",8)=" . I LASTSUB?1.N S CNT=CNT+1"
S @GL1@("%ut1","ACTLINES",9)=" QUIT CNT"
S @GL1@("%ut1","CHECKTAG")="11/11"
S @GL1@("%ut1","CHEKTEST")="10/10"
N XCLUD S XCLUD("%utt1")=""
D LIST^%utcover(.XCLUD,1,GLT,GL1)
D CHKEQ("Routine %ut1 (55.63%) 89 out of 160 lines covered",$G(@GLT@(3)),"Verbosity 1 - Unexpected text for line 3")
D CHKEQ("Overall Analysis 89 out of 160 lines covered (55% coverage)",$G(@GLT@(6)),"Verbosity 1 - unexpected text for line 6")
D CHKTF('$D(@GLT@(7)),"Verbosity 1 - Unexpected line 7 present")
K @GLT
;
D LIST^%utcover(.XCLUD,2,GLT,GL1)
D CHKEQ(" - Summary",$G(@GLT@(4)),"Verbosity 2 - unexpected text at line 4")
D CHKEQ(" Tag ACTLINES^%ut1 (0.00%) 0 out of 8 lines covered",$G(@GLT@(6)),"Verbosity 2 - unexpected text at line 6")
D CHKEQ(" Tag CHEKTEST^%ut1 (100.00%) 10 out of 10 lines covered",$G(@GLT@(8)),"Verbosity 2 - unexpected text at line 8")
D CHKTF($D(@GLT@(14)),"Verbosity 2 - expected line at line 14")
D CHKTF('$D(@GLT@(15)),"Verbosity 2 - unexpected line at line 15")
K @GLT
;
D LIST^%utcover(.XCLUD,3,GLT,GL1)
D CHKEQ(" Tag %ut1^%ut1 (100.00%) 2 out of 2 lines covered",$G(@GLT@(5)),"Verbosity 3 - Incorrect text at line 5")
D CHKEQ(" ACTLINES+9 QUIT CNT",$G(@GLT@(15)),"Verbosity 3 - incorrect line 15")
D CHKTF($D(@GLT@(31)),"Verbosity 3 - expected data in line 31")
D CHKTF('$D(@GLT@(32)),"Verbosity 3 - did not expect a line 32")
;
K @GL1,@GLT
Q
;
SETGLOBS(GL1,GL2) ;
S @GL1@("%ut1","ACTLINES")="ACTLINES"
S @GL1@("%ut1","ACTLINES",0)="ACTLINES(GL) ; [Private] $$ ; Count active lines"
S @GL1@("%ut1","ACTLINES",2)=" N CNT S CNT=0"
S @GL1@("%ut1","ACTLINES",3)=" N REF S REF=GL"
S @GL1@("%ut1","ACTLINES",4)=" N GLQL S GLQL=$QL(GL)"
S @GL1@("%ut1","ACTLINES",5)=" F S REF=$Q(@REF) Q:REF="""" Q:(GL'=$NA(@REF,GLQL)) D"
S @GL1@("%ut1","ACTLINES",6)=" . N REFQL S REFQL=$QL(REF)"
S @GL1@("%ut1","ACTLINES",7)=" . N LASTSUB S LASTSUB=$QS(REF,REFQL)"
S @GL1@("%ut1","ACTLINES",8)=" . I LASTSUB?1.N S CNT=CNT+1"
S @GL1@("%ut1","ACTLINES",9)=" QUIT CNT"
S @GL1@("%ut1","CHEKTEST")="CHEKTEST"
S @GL1@("%ut1","CHEKTEST",0)="CHEKTEST(%utROU,%ut,%utUETRY) ; Collect Test list."
S @GL1@("%ut1","CHEKTEST",13)=" N I,LIST"
S @GL1@("%ut1","CHEKTEST",14)=" S I=$L($T(@(U_%utROU))) I I<0 Q ""-1^Invalid Routine Name"""
S @GL1@("%ut1","CHEKTEST",31)=" D NEWSTYLE(.LIST,%utROU)"
S @GL1@("%ut1","CHEKTEST",32)=" F I=1:1:LIST S %ut(""ENTN"")=%ut(""ENTN"")+1,%utUETRY(%ut(""ENTN""))=$P(LIST(I),U),%utUETRY(%ut(""ENTN""),""NAME"")=$P(LIST(I),U,2,99)"
S @GL1@("%ut1","CHEKTEST",37)=" N %utUI F %utUI=1:1 S %ut(""ELIN"")=$T(@(""XTENT+""_%utUI_""^""_%utROU)) Q:$P(%ut(""ELIN""),"";"",3)="""" D"
S @GL1@("%ut1","CHEKTEST",38)=" . S %ut(""ENTN"")=%ut(""ENTN"")+1,%utUETRY(%ut(""ENTN""))=$P(%ut(""ELIN""),"";"",3),%utUETRY(%ut(""ENTN""),""NAME"")=$P(%ut(""ELIN""),"";"",4)"
S @GL1@("%ut1","CHEKTEST",39)=" . Q"
S @GL1@("%ut1","CHEKTEST",41)=" QUIT"
S @GL1@("%ut1","CHEKTEST",9)=" S %ut(""ENTN"")=0 ; Number of test, sub to %utUETRY."
S @GL2@("%ut1","ACTLINES")="ACTLINES"
S @GL2@("%ut1","ACTLINES",0)="ACTLINES(GL) ; [Private] $$ ; Count active lines"
S @GL2@("%ut1","ACTLINES",2)=" N CNT S CNT=0"
S @GL2@("%ut1","ACTLINES",3)=" N REF S REF=GL"
S @GL2@("%ut1","ACTLINES",4)=" N GLQL S GLQL=$QL(GL)"
S @GL2@("%ut1","ACTLINES",5)=" F S REF=$Q(@REF) Q:REF="""" Q:(GL'=$NA(@REF,GLQL)) D"
S @GL2@("%ut1","ACTLINES",6)=" . N REFQL S REFQL=$QL(REF)"
S @GL2@("%ut1","ACTLINES",7)=" . N LASTSUB S LASTSUB=$QS(REF,REFQL)"
S @GL2@("%ut1","ACTLINES",8)=" . I LASTSUB?1.N S CNT=CNT+1"
S @GL2@("%ut1","ACTLINES",9)=" QUIT CNT"
S @GL2@("%ut1","CHEKTEST")="CHEKTEST"
S @GL2@("%ut1","CHEKTEST",38)=" . S %ut(""ENTN"")=%ut(""ENTN"")+1,%utUETRY(%ut(""ENTN""))=$P(%ut(""ELIN""),"";"",3),%utUETRY(%ut(""ENTN""),""NAME"")=$P(%ut(""ELIN""),"";"",4)"
S @GL2@("%ut1","CHEKTEST",39)=" . Q"
Q
;
;
CACHECOV ;@TEST - set up routine for analysis in globals
N GLOB,GLOBT
S GLOB=$NA(^TMP("%uttcovr1",$J)),GLOBT=$NA(@GLOB@("uttcovr2",$J)) K @GLOB,@GLOBT
D CACHECOV^%ut1(GLOB,GLOBT)
D CHKEQ($T(+1^%ut),@GLOB@("%ut",1,0),"BAD FIRST LINE LOADED FOR %ut")
D CHKEQ($T(+14^%ut),@GLOBT@("%ut",14,0),"Bad 14th line loaded for %ut")
K @GLOB,@GLOBT
Q
;
GETVALS ; no test - primarily calls to Cache classes
Q
;
LINEDATA ; @TEST - convert code line to based on tags and offset, and identify active code lines
N CODE,LINE,OFFSET,TAG
S LINE="TEST1 ; COMMENT ON TAG",TAG="",OFFSET=0
S CODE=$$LINEDATA^%ut1(LINE,.TAG,.OFFSET) ;
D CHKEQ(0,CODE,"Tag with comment identified as active code")
D CHKEQ("TEST1",TAG,"Bad tag returned for TEST1")
D CHKEQ(0,OFFSET,"Bad OFFSET returned for TEST1")
;
S LINE=" ; COMMENT ONLY"
S CODE=$$LINEDATA^%ut1(LINE,.TAG,.OFFSET) ;
D CHKEQ(0,CODE,"Comment line identified as active code")
D CHKEQ("TEST1",TAG,"Bad tag returned for TEST1+1")
D CHKEQ(1,OFFSET,"Bad OFFSET returned for TEST1+1")
;
S LINE=" S X=VALUE"
S CODE=$$LINEDATA^%ut1(LINE,.TAG,.OFFSET) ;
D CHKEQ(1,CODE,"Code line NOT identified as active code")
D CHKEQ("TEST1",TAG,"Bad tag returned for TEST1+2")
D CHKEQ(2,OFFSET,"Bad OFFSET returned for TEST1+2")
;
S LINE="TEST2 S X=VALUE"
S CODE=$$LINEDATA^%ut1(LINE,.TAG,.OFFSET) ;
D CHKEQ(1,CODE,"Tag line with code NOT identified as active code")
D CHKEQ("TEST2",TAG,"Bad tag returned for TEST2")
D CHKEQ(0,OFFSET,"Bad OFFSET returned for TEST2")
;
Q
;
TOTAGS ;@TEST - convert from lines of code by line number to lines ordered by tag, line from tag, and only not covered
N ACTIVE,GLOB,GLOBT,X1,X0
S GLOB=$NA(^TMP("%uttcovr",$J)),GLOBT=$NA(@GLOB@("TEST1")) K @GLOB
S @GLOBT@(1,0)="LINE1 ; CODE1 LINE1+0 NOT ACTIVE"
S @GLOBT@(2,0)=" CODE2 LINE+1 SEEN"
S @GLOBT@(2,"C")=2
S @GLOBT@(3,0)=" CODE3 LINE1+2 NOT SEEN"
S @GLOBT@(4,0)="LINE4 CODE4 LINE4+0 SEEN"
S @GLOBT@(4,"C")=5
S @GLOBT@(5,0)=" ; CODE5 LINE4+1 NOT ACTIVE"
S @GLOBT@(6,0)=" CODE6 LINE4+2 COVERED"
S @GLOBT@(6,"C")=2
S @GLOBT@(7,0)="LINE7 CODE7 LINE7+0 NOT COVERED"
S @GLOBT@(8,0)=" CODE8 LINE7+1 NOT COVERED"
S ACTIVE=1
D TOTAGS^%ut1(GLOB,ACTIVE)
D CHKEQ(1,($D(@GLOBT@("LINE1"))#2),"LINE1 TAG NOT IDENTIFIED")
D CHKEQ(1,($D(@GLOBT@("LINE4"))#2),"LINE4 TAG NOT IDENTIFIED")
D CHKEQ(1,($D(@GLOBT@("LINE7"))#2),"LINE7 TAG NOT IDENTIFIED")
D CHKEQ(0,$D(@GLOBT@("LINE1",0)),"LINE1+0 SHOULD NOT BE INCLUDED - IT IS A COMMENT")
D CHKEQ(0,$D(@GLOBT@("LINE1",1)),"LINE1+1 SHOULD NOT BE INCLUDED - IT WAS COVERED")
D CHKEQ(1,$D(@GLOBT@("LINE1",2)),"LINE1+2 SHOULD BE INCLUDED - IT WAS NOT COVERED")
D CHKEQ(0,$D(@GLOBT@("LINE4",0)),"LINE4+0 SHOULD NOT BE INCLUDED - IT WAS COVERED")
D CHKEQ(0,$D(@GLOBT@("LINE4",1)),"LINE4+1 SHOULD NOT BE INCLUDED - IT IS A COMMENT")
D CHKEQ(0,$D(@GLOBT@("LINE4",2)),"LINE4+2 SHOULD NOT BE INCLUDED - IT WAS COVERED")
D CHKEQ(1,$D(@GLOBT@("LINE7",0)),"LINE7+0 SHOULD BE INCLUDED - IT IS NOT COVERED")
D CHKEQ(1,$D(@GLOBT@("LINE7",1)),"LINE7+1 SHOULD BE INCLUDED - IT IS NOT COVERED")
K @GLOB,@GLOBT
Q
;
CHKEQ(EXPECTED,SEEN,COMMENT) ;
D CHKEQ^%ut(EXPECTED,SEEN,$G(COMMENT))
Q
;
CHKTF(VALUE,COMMENT) ;
D CHKTF^%ut(VALUE,$G(COMMENT))
Q
%uttcovr ;JIVEYSOFT/JLI - runs coverage tests on %ut and %ut1 routines via unit tests ;12/16/15 08:48
;;1.4;MASH;;Feb 27, 2016;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Joel L. Ivey 05/2014-12/2015
;
;
; ZEXCEPT: DTIME - if present the value is Kernel timeout for reads
N RUNCODE,XCLUDE
;
; Have it run the following entry points or, if no ^, call EN^%ut with routine name
S RUNCODE(1)="^%utt1,%utt1,^%utt6,VERBOSE^%utt6,%uttcovr,^%ut,^%ut1,^%utcover"
S RUNCODE("ENTRY^%uttcovr")=""
; Have the analysis EXCLUDE the following routines from coverage - unit test routines
S XCLUDE(1)="%utt1,%utt2,%utt3,%utt4,%utt5,%utt6,%uttcovr"
S XCLUDE(2)="%utf2hex" ; a GT.M system file, although it wasn't showing up anyway
M ^TMP("%uttcovr",$J,"XCLUDE")=XCLUDE
D COVERAGE^%ut("%ut*",.RUNCODE,.XCLUDE,3)
Q
;
ENTRY ;
K ^TMP("ENTRY^%uttcovr",$J,"VALS")
M ^TMP("ENTRY^%uttcovr",$J,"VALS")=^TMP("%ut",$J,"UTVALS")
K ^TMP("%ut",$J,"UTVALS")
; these tests run outside of unit tests to handle CHKLEAKS calls not in unit tests
; they need data set, so they are called in here
; LEAKSOK ;
N CODE,LOCATN,MYVALS,X,I
S CODE="S X=$$NOW^XLFDT()",LOCATN="LEAKSOK TEST",MYVALS("X")=""
D CHKLEAKS^%ut(CODE,LOCATN,.MYVALS) ; should find no leaks
; LEAKSBAD ;
N CODE,LOCATN,MYVALS,X
S CODE="S X=$$NOW^XLFDT()",LOCATN="LEAKSBAD TEST - X NOT SPECIFIED"
D CHKLEAKS^%ut(CODE,LOCATN,.MYVALS) ; should find X since it isn't indicated
; try to run coverage
W !,"xxxxxxxxxxxxxxxxxxxx GOING TO COV^%ut FOR %utt5 at 3",!!!
D COV^%ut("%ut1","D EN^%ut(""%utt5"")",3)
W !,"xxxxxxxxxxxxxxxxxxxx GOING TO COV^%ut FOR %utt5 at -1",!!!
D COV^%ut("%ut1","D EN^%ut(""%utt5"")",-1)
N RUNCODE S RUNCODE(1)="^%utt4,^%ut"
N XCLUDE M XCLUDE=^TMP("%uttcovr",$J,"XCLUDE")
W !,"xxxxxxxxxxxxxxxxxxxx GOING TO MULTAPIS for %utt4 and %ut",!!!
D MULTAPIS^%ut(.RUNCODE)
W !,"xxxxxxxxxxxxxxxxxxxx GOING TO COVERAGE for %utt4 and %ut at 3",!!!
D COVERAGE^%ut("%ut*",.RUNCODE,.XCLUDE,3)
N GLT S GLT=$NA(^TMP("%uttcovr-text",$J)) K @GLT
W !,"xxxxxxxxxxxxxxxxxxxx LISTING DATA VIA LIST",!!!
D LIST^%utcover(.XCLUDE,3,GLT) ; get coverage for listing and trimdata in %utcover
F I=1:1 Q:'$D(@GLT@(I)) W !,@GLT@(I)
K @GLT
; restore unit test totals from before entry
K ^TMP("%ut",$J,"UTVALS")
M ^TMP("%ut",$J,"UTVALS")=^TMP("ENTRY^%uttcovr",$J,"VALS")
K ^TMP("ENTRY^%uttcovr",$J,"VALS")
W !,"xxxxxxxxxxxxxxxxxxxx Finished in ENTRY^%uttcovr",!!!
Q
;
RTNANAL ; @TEST - routine analysis
N ROUS,GLB
S ROUS("%utt4")=""
S GLB=$NA(^TMP("%uttcovr-rtnanal",$J)) K @GLB
D RTNANAL^%ut1(.ROUS,GLB)
D CHKTF($D(@GLB@("%utt4","MAIN"))>1,"Not enough 'MAIN' nodes found")
D CHKTF($G(@GLB@("%utt4","MAIN",3))["D COV^%ut(""%utt3"",""D EN^%ut(""""%utt3"""",1)"",-1)","Incorrect data for line 2 in MAIN")
D CHKTF($G(@GLB@("%utt4","MAIN",9))=" QUIT","Final QUIT not on expected line")
K @GLB
Q
;
COVCOV ; @TEST - check COVCOV - remove seen lines
N C,R
S C=$NA(^TMP("%uttcovr_C",$J))
S R=$NA(^TMP("%uttcovr_R",$J))
S @C@("ROU1")=""
S @C@("ROU2")="",@R@("ROU2")=""
S @C@("ROU2","TAG1")="",@R@("ROU2","TAG1")=""
S @C@("ROU2","TAG1",1)="AAA"
S @C@("ROU2","TAG1",2)="AAA",@R@("ROU2","TAG1",2)="AAA"
S @C@("ROU2","TAG1",3)="ABB",@R@("ROU2","TAG1",3)="ABB"
S @C@("ROU2","TAG2",6)="ACC"
S @C@("ROU2","TAG2",7)="ADD",@R@("ROU2","TAG2",7)="ADD"
S @C@("ROU3","TAG1",2)="BAA",@R@("ROU3","TAG1",2)="BAA"
S @C@("ROU3","TAG1",3)="CAA"
S @C@("ROU3","TAG1",4)="DAA"
S @C@("ROU3","TAG1",5)="EAA",@R@("ROU3","TAG1",5)="EAA"
S @C@("ROU3","TAG1",6)="FAA",@R@("ROU3","TAG1",6)="FAA"
D COVCOV^%ut1(C,R)
D CHKTF($D(@C@("ROU2","TAG1",1)),"Invalid value for ""ROU2"",""TAG1"",1")
D CHKTF('$D(@C@("ROU2","TAG1",2)),"Unexpected value for ""ROU2"",""TAG1"",1")
D CHKTF($D(@C@("ROU2","TAG2",6)),"Invalid value for ""ROU2"",""TAG1"",1")
D CHKTF('$D(@C@("ROU2","TAG2",7)),"Unexpected value for ""ROU2"",""TAG1"",1")
D CHKTF($D(@C@("ROU3","TAG1",4)),"Invalid value for ""ROU2"",""TAG1"",1")
D CHKTF('$D(@C@("ROU3","TAG1",5)),"Unexpected value for ""ROU2"",""TAG1"",1")
K @C,@R
Q
;
COVRPT ; @TEST
N GL1,GL2,GL3,GL4,VRBOSITY,GL5
S GL1=$NA(^TMP("%utCOVCOHORTSAVx",$J)) K @GL1
S GL2=$NA(^TMP("%utCOVCOHORTx",$J)) K @GL2
S GL3=$NA(^TMP("%utCOVRESULTx",$J)) K @GL3
S GL4=$NA(^TMP("%utCOVREPORTx",$J)) K @GL4
S GL5=$NA(^TMP("%ut1-covrpt",$J)) K @GL5
D SETGLOBS(GL1,GL2)
S VRBOSITY=1
D COVRPT^%ut1(GL1,GL2,GL3,VRBOSITY)
D CHKEQ("COVERAGE PERCENTAGE: 42.11",$G(@GL5@(5)),"Verbosity 1 - not expected percentage value")
D CHKEQ(" %ut1 42.11% 8 out of 19",$G(@GL5@(9)),"Verbosity 1 - not expected value for line 9")
D CHKTF('$D(@GL5@(10)),"Verbosity 1 - unexpected data in 10th line")
;
S VRBOSITY=2
D COVRPT^%ut1(GL1,GL2,GL3,VRBOSITY)
D CHKEQ(" ACTLINES 0.00% 0 out of 9",$G(@GL5@(10)),"Verbosity 2 - not expected value for 10th line")
D CHKEQ(" CHEKTEST 80.00% 8 out of 10",$G(@GL5@(11)),"Verbosity 2 - not expected value for 11th line")
D CHKTF('$D(@GL5@(12)),"Verbosity 2 - unexpected data for 12th line")
;
S VRBOSITY=3
D COVRPT^%ut1(GL1,GL2,GL3,VRBOSITY)
D CHKEQ(" ACTLINES 0.00% 0 out of 9",$G(@GL5@(10)),"Verbosity 3 - unexpected value for line 10")
D CHKEQ("ACTLINES+9: QUIT CNT",$G(@GL5@(19)),"Verbosity 3 - unexpected value for line 19")
D CHKEQ(" CHEKTEST 80.00% 8 out of 10",$G(@GL5@(20)),"Verbosity 3 - unexpected value for line 20")
D CHKEQ("CHEKTEST+39: . Q",$G(@GL5@(22)),"Verbosity 3 - unexpected value for line 22")
D CHKTF('$D(@GL5@(23)),"Verbosity 3 - unexpected line 23")
K @GL1,@GL2,@GL3,@GL4,@GL5
Q
;
COVRPTLS ; @TEST - coverage report returning text in global
N GL1,GL2,GL3,GL4,VRBOSITY
S GL1=$NA(^TMP("%utCOVCOHORTSAVx",$J)) K @GL1
S GL2=$NA(^TMP("%utCOVCOHORTx",$J)) K @GL2
S GL3=$NA(^TMP("%utCOVRESULTx",$J)) K @GL3
S GL4=$NA(^TMP("%utCOVREPORTx",$J)) K @GL4
D SETGLOBS(GL1,GL2)
S VRBOSITY=1
D COVRPTLS^%ut1(GL1,GL2,GL3,VRBOSITY,GL4)
D CHKEQ("COVERAGE PERCENTAGE: 42.11",$G(@GL4@(5)),"Verbosity 1 - not expected percentage value")
D CHKEQ(" %ut1 42.11% 8 out of 19",$G(@GL4@(9)),"Verbosity 1 - not expected value for line 9")
D CHKTF('$D(@GL4@(10)),"Verbosity 1 - unexpected data in 10th line")
K @GL4
;
S VRBOSITY=2
D COVRPTLS^%ut1(GL1,GL2,GL3,VRBOSITY,GL4)
D CHKEQ(" ACTLINES 0.00% 0 out of 9",$G(@GL4@(10)),"Verbosity 2 - not expected value for 10th line")
D CHKEQ(" CHEKTEST 80.00% 8 out of 10",$G(@GL4@(11)),"Verbosity 2 - not expected value for 11th line")
D CHKTF('$D(@GL4@(12)),"Verbosity 2 - unexpected data for 12th line")
K @GL4
;
S VRBOSITY=3
D COVRPTLS^%ut1(GL1,GL2,GL3,VRBOSITY,GL4)
D CHKEQ(" ACTLINES 0.00% 0 out of 9",$G(@GL4@(10)),"Verbosity 3 - unexpected value for line 10")
D CHKEQ("ACTLINES+9: QUIT CNT",$G(@GL4@(19)),"Verbosity 3 - unexpected value for line 19")
D CHKEQ(" CHEKTEST 80.00% 8 out of 10",$G(@GL4@(20)),"Verbosity 3 - unexpected value for line 20")
D CHKEQ("CHEKTEST+39: . Q",$G(@GL4@(22)),"Verbosity 3 - unexpected value for line 22")
D CHKTF('$D(@GL4@(23)),"Verbosity 3 - unexpected line 23")
;
K @GL1,@GL2,@GL3,@GL4
Q
;
TRIMDATA ; @TEST - TRIMDATA in %utcover
N GL1,XCLUD
S GL1=$NA(^TMP("%uttcovr-trimdata",$J)) K @GL1
S @GL1@("GOOD",1)="1"
S @GL1@("BAD",1)="1"
S XCLUD("BAD")=""
D TRIMDATA^%utcover(.XCLUD,GL1)
D CHKTF($D(@GL1@("GOOD")),"GOOD ENTRY WAS REMOVED")
D CHKTF('$D(@GL1@("BAD")),"ENTRY WAS NOT TRIMMED")
K @GL1,XCLUD
Q
;
LIST ; @TEST - LIST in %utcover
N GL1,GLT S GL1=$NA(^TMP("%uttcovr-list",$J)),GLT=$NA(^TMP("%uttcovr-text",$J))
S @GL1@("%ut1")="89/160"
S @GL1@("%ut1","%ut1")="2/2"
S @GL1@("%ut1","ACTLINES")="0/8"
S @GL1@("%ut1","ACTLINES",2)=" N CNT S CNT=0"
S @GL1@("%ut1","ACTLINES",3)=" N REF S REF=GL"
S @GL1@("%ut1","ACTLINES",4)=" N GLQL S GLQL=$QL(GL)"
S @GL1@("%ut1","ACTLINES",5)=" F S REF=$Q(@REF) Q:REF="""" Q:(GL'=$NA(@REF,GLQL)) D"
S @GL1@("%ut1","ACTLINES",6)=" . N REFQL S REFQL=$QL(REF)"
S @GL1@("%ut1","ACTLINES",7)=" . N LASTSUB S LASTSUB=$QS(REF,REFQL)"
S @GL1@("%ut1","ACTLINES",8)=" . I LASTSUB?1.N S CNT=CNT+1"
S @GL1@("%ut1","ACTLINES",9)=" QUIT CNT"
S @GL1@("%ut1","CHECKTAG")="11/11"
S @GL1@("%ut1","CHEKTEST")="10/10"
N XCLUD S XCLUD("%utt1")=""
D LIST^%utcover(.XCLUD,1,GLT,GL1)
D CHKEQ("Routine %ut1 (55.63%) 89 out of 160 lines covered",$G(@GLT@(3)),"Verbosity 1 - Unexpected text for line 3")
D CHKEQ("Overall Analysis 89 out of 160 lines covered (55% coverage)",$G(@GLT@(6)),"Verbosity 1 - unexpected text for line 6")
D CHKTF('$D(@GLT@(7)),"Verbosity 1 - Unexpected line 7 present")
K @GLT
;
D LIST^%utcover(.XCLUD,2,GLT,GL1)
D CHKEQ(" - Summary",$G(@GLT@(4)),"Verbosity 2 - unexpected text at line 4")
D CHKEQ(" Tag ACTLINES^%ut1 (0.00%) 0 out of 8 lines covered",$G(@GLT@(6)),"Verbosity 2 - unexpected text at line 6")
D CHKEQ(" Tag CHEKTEST^%ut1 (100.00%) 10 out of 10 lines covered",$G(@GLT@(8)),"Verbosity 2 - unexpected text at line 8")
D CHKTF($D(@GLT@(14)),"Verbosity 2 - expected line at line 14")
D CHKTF('$D(@GLT@(15)),"Verbosity 2 - unexpected line at line 15")
K @GLT
;
D LIST^%utcover(.XCLUD,3,GLT,GL1)
D CHKEQ(" Tag %ut1^%ut1 (100.00%) 2 out of 2 lines covered",$G(@GLT@(5)),"Verbosity 3 - Incorrect text at line 5")
D CHKEQ(" ACTLINES+9 QUIT CNT",$G(@GLT@(15)),"Verbosity 3 - incorrect line 15")
D CHKTF($D(@GLT@(31)),"Verbosity 3 - expected data in line 31")
D CHKTF('$D(@GLT@(32)),"Verbosity 3 - did not expect a line 32")
;
K @GL1,@GLT
Q
;
SETGLOBS(GL1,GL2) ;
S @GL1@("%ut1","ACTLINES")="ACTLINES"
S @GL1@("%ut1","ACTLINES",0)="ACTLINES(GL) ; [Private] $$ ; Count active lines"
S @GL1@("%ut1","ACTLINES",2)=" N CNT S CNT=0"
S @GL1@("%ut1","ACTLINES",3)=" N REF S REF=GL"
S @GL1@("%ut1","ACTLINES",4)=" N GLQL S GLQL=$QL(GL)"
S @GL1@("%ut1","ACTLINES",5)=" F S REF=$Q(@REF) Q:REF="""" Q:(GL'=$NA(@REF,GLQL)) D"
S @GL1@("%ut1","ACTLINES",6)=" . N REFQL S REFQL=$QL(REF)"
S @GL1@("%ut1","ACTLINES",7)=" . N LASTSUB S LASTSUB=$QS(REF,REFQL)"
S @GL1@("%ut1","ACTLINES",8)=" . I LASTSUB?1.N S CNT=CNT+1"
S @GL1@("%ut1","ACTLINES",9)=" QUIT CNT"
S @GL1@("%ut1","CHEKTEST")="CHEKTEST"
S @GL1@("%ut1","CHEKTEST",0)="CHEKTEST(%utROU,%ut,%utUETRY) ; Collect Test list."
S @GL1@("%ut1","CHEKTEST",13)=" N I,LIST"
S @GL1@("%ut1","CHEKTEST",14)=" S I=$L($T(@(U_%utROU))) I I<0 Q ""-1^Invalid Routine Name"""
S @GL1@("%ut1","CHEKTEST",31)=" D NEWSTYLE(.LIST,%utROU)"
S @GL1@("%ut1","CHEKTEST",32)=" F I=1:1:LIST S %ut(""ENTN"")=%ut(""ENTN"")+1,%utUETRY(%ut(""ENTN""))=$P(LIST(I),U),%utUETRY(%ut(""ENTN""),""NAME"")=$P(LIST(I),U,2,99)"
S @GL1@("%ut1","CHEKTEST",37)=" N %utUI F %utUI=1:1 S %ut(""ELIN"")=$T(@(""XTENT+""_%utUI_""^""_%utROU)) Q:$P(%ut(""ELIN""),"";"",3)="""" D"
S @GL1@("%ut1","CHEKTEST",38)=" . S %ut(""ENTN"")=%ut(""ENTN"")+1,%utUETRY(%ut(""ENTN""))=$P(%ut(""ELIN""),"";"",3),%utUETRY(%ut(""ENTN""),""NAME"")=$P(%ut(""ELIN""),"";"",4)"
S @GL1@("%ut1","CHEKTEST",39)=" . Q"
S @GL1@("%ut1","CHEKTEST",41)=" QUIT"
S @GL1@("%ut1","CHEKTEST",9)=" S %ut(""ENTN"")=0 ; Number of test, sub to %utUETRY."
S @GL2@("%ut1","ACTLINES")="ACTLINES"
S @GL2@("%ut1","ACTLINES",0)="ACTLINES(GL) ; [Private] $$ ; Count active lines"
S @GL2@("%ut1","ACTLINES",2)=" N CNT S CNT=0"
S @GL2@("%ut1","ACTLINES",3)=" N REF S REF=GL"
S @GL2@("%ut1","ACTLINES",4)=" N GLQL S GLQL=$QL(GL)"
S @GL2@("%ut1","ACTLINES",5)=" F S REF=$Q(@REF) Q:REF="""" Q:(GL'=$NA(@REF,GLQL)) D"
S @GL2@("%ut1","ACTLINES",6)=" . N REFQL S REFQL=$QL(REF)"
S @GL2@("%ut1","ACTLINES",7)=" . N LASTSUB S LASTSUB=$QS(REF,REFQL)"
S @GL2@("%ut1","ACTLINES",8)=" . I LASTSUB?1.N S CNT=CNT+1"
S @GL2@("%ut1","ACTLINES",9)=" QUIT CNT"
S @GL2@("%ut1","CHEKTEST")="CHEKTEST"
S @GL2@("%ut1","CHEKTEST",38)=" . S %ut(""ENTN"")=%ut(""ENTN"")+1,%utUETRY(%ut(""ENTN""))=$P(%ut(""ELIN""),"";"",3),%utUETRY(%ut(""ENTN""),""NAME"")=$P(%ut(""ELIN""),"";"",4)"
S @GL2@("%ut1","CHEKTEST",39)=" . Q"
Q
;
;
CACHECOV ;@TEST - set up routine for analysis in globals
N GLOB,GLOBT
S GLOB=$NA(^TMP("%uttcovr1",$J)),GLOBT=$NA(@GLOB@("uttcovr2",$J)) K @GLOB,@GLOBT
D CACHECOV^%ut1(GLOB,GLOBT)
D CHKEQ($T(+1^%ut),@GLOB@("%ut",1,0),"BAD FIRST LINE LOADED FOR %ut")
D CHKEQ($T(+14^%ut),@GLOBT@("%ut",14,0),"Bad 14th line loaded for %ut")
K @GLOB,@GLOBT
Q
;
GETVALS ; no test - primarily calls to Cache classes
Q
;
LINEDATA ; @TEST - convert code line to based on tags and offset, and identify active code lines
N CODE,LINE,OFFSET,TAG
S LINE="TEST1 ; COMMENT ON TAG",TAG="",OFFSET=0
S CODE=$$LINEDATA^%ut1(LINE,.TAG,.OFFSET) ;
D CHKEQ(0,CODE,"Tag with comment identified as active code")
D CHKEQ("TEST1",TAG,"Bad tag returned for TEST1")
D CHKEQ(0,OFFSET,"Bad OFFSET returned for TEST1")
;
S LINE=" ; COMMENT ONLY"
S CODE=$$LINEDATA^%ut1(LINE,.TAG,.OFFSET) ;
D CHKEQ(0,CODE,"Comment line identified as active code")
D CHKEQ("TEST1",TAG,"Bad tag returned for TEST1+1")
D CHKEQ(1,OFFSET,"Bad OFFSET returned for TEST1+1")
;
S LINE=" S X=VALUE"
S CODE=$$LINEDATA^%ut1(LINE,.TAG,.OFFSET) ;
D CHKEQ(1,CODE,"Code line NOT identified as active code")
D CHKEQ("TEST1",TAG,"Bad tag returned for TEST1+2")
D CHKEQ(2,OFFSET,"Bad OFFSET returned for TEST1+2")
;
S LINE="TEST2 S X=VALUE"
S CODE=$$LINEDATA^%ut1(LINE,.TAG,.OFFSET) ;
D CHKEQ(1,CODE,"Tag line with code NOT identified as active code")
D CHKEQ("TEST2",TAG,"Bad tag returned for TEST2")
D CHKEQ(0,OFFSET,"Bad OFFSET returned for TEST2")
;
Q
;
TOTAGS ;@TEST - convert from lines of code by line number to lines ordered by tag, line from tag, and only not covered
N ACTIVE,GLOB,GLOBT,X1,X0
S GLOB=$NA(^TMP("%uttcovr",$J)),GLOBT=$NA(@GLOB@("TEST1")) K @GLOB
S @GLOBT@(1,0)="LINE1 ; CODE1 LINE1+0 NOT ACTIVE"
S @GLOBT@(2,0)=" CODE2 LINE+1 SEEN"
S @GLOBT@(2,"C")=2
S @GLOBT@(3,0)=" CODE3 LINE1+2 NOT SEEN"
S @GLOBT@(4,0)="LINE4 CODE4 LINE4+0 SEEN"
S @GLOBT@(4,"C")=5
S @GLOBT@(5,0)=" ; CODE5 LINE4+1 NOT ACTIVE"
S @GLOBT@(6,0)=" CODE6 LINE4+2 COVERED"
S @GLOBT@(6,"C")=2
S @GLOBT@(7,0)="LINE7 CODE7 LINE7+0 NOT COVERED"
S @GLOBT@(8,0)=" CODE8 LINE7+1 NOT COVERED"
S ACTIVE=1
D TOTAGS^%ut1(GLOB,ACTIVE)
D CHKEQ(1,($D(@GLOBT@("LINE1"))#2),"LINE1 TAG NOT IDENTIFIED")
D CHKEQ(1,($D(@GLOBT@("LINE4"))#2),"LINE4 TAG NOT IDENTIFIED")
D CHKEQ(1,($D(@GLOBT@("LINE7"))#2),"LINE7 TAG NOT IDENTIFIED")
D CHKEQ(0,$D(@GLOBT@("LINE1",0)),"LINE1+0 SHOULD NOT BE INCLUDED - IT IS A COMMENT")
D CHKEQ(0,$D(@GLOBT@("LINE1",1)),"LINE1+1 SHOULD NOT BE INCLUDED - IT WAS COVERED")
D CHKEQ(1,$D(@GLOBT@("LINE1",2)),"LINE1+2 SHOULD BE INCLUDED - IT WAS NOT COVERED")
D CHKEQ(0,$D(@GLOBT@("LINE4",0)),"LINE4+0 SHOULD NOT BE INCLUDED - IT WAS COVERED")
D CHKEQ(0,$D(@GLOBT@("LINE4",1)),"LINE4+1 SHOULD NOT BE INCLUDED - IT IS A COMMENT")
D CHKEQ(0,$D(@GLOBT@("LINE4",2)),"LINE4+2 SHOULD NOT BE INCLUDED - IT WAS COVERED")
D CHKEQ(1,$D(@GLOBT@("LINE7",0)),"LINE7+0 SHOULD BE INCLUDED - IT IS NOT COVERED")
D CHKEQ(1,$D(@GLOBT@("LINE7",1)),"LINE7+1 SHOULD BE INCLUDED - IT IS NOT COVERED")
K @GLOB,@GLOBT
Q
;
CHKEQ(EXPECTED,SEEN,COMMENT) ;
D CHKEQ^%ut(EXPECTED,SEEN,$G(COMMENT))
Q
;
CHKTF(VALUE,COMMENT) ;
D CHKTF^%ut(VALUE,$G(COMMENT))
Q

2
Routines/ZZUTPRE.m
View File

@ -1,5 +1,5 @@
%utPRE ;VEN/SMH/JLI - pre installation routine to set up MASH UTILITIES package and assign %ut routines and globals ;12/16/15 08:59
;;1.3;MASH UTILITIES;;DEC 16, ;Build 1
;;1.4;MASH;;Feb 27, 2016;Build 1
; Submitted to OSEHRA Dec 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
; Original routine authored by Sam H. Habiel 07/2013-04/2014
;