forked from KRMAssociatesInc/JDS-GTM
-
Notifications
You must be signed in to change notification settings - Fork 1
/
_ut.m
468 lines (468 loc) · 19.9 KB
/
_ut.m
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
%ut ;VEN-SMH/JLI - PRIMARY PROGRAM FOR M-UNIT TESTING ;04/08/16 20:35
;;1.4;MASH UTILITIES;;APR 11, 2016;Build 2
; Submitted to OSEHRA Apr 11, 2016 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
; Additions and modifications made by Sam H. Habiel and Joel L. Ivey 02/2016-04/2016
;
; This routine and its companion, %ut1, provide the basic functionality for
; running unit tests on parts of M programs either at the command line level
; or via the M-Unit GUI application for windows operating systems.
;
; Original by Dr. Joel Ivey
; Contributions by Dr. Sam Habiel
; comments moved to %utcover due to space requirements
;
D ^%utt6 ; runs unit tests on all of it
Q
;
EN(%utRNAM,%utVERB,%utBREAK) ; .SR Entry point with primary test routine name
; %utRNAM: (Required) Routine name that contians the tags with @TEST in them or the tag XTROU
; %utVERB: (optional) 1 for verbose output or 2 for verbose and timing info.
; %utBREAK:(optional) bool - Break upon error or upon failure
N %utLIST,%utROU,%ut
S %utLIST=1,%utROU(%utLIST)=%utRNAM
K ^TMP("%ut",$J,"UTVALS")
D SETUT
D EN1(.%utROU,%utLIST)
Q
;
SETUT ;
; VEN/SMH 26JUL2013
I '($D(IO)#2) S IO=$P
S U="^"
; VEN/SMH 26JUL2013 END
;
; ZEXCEPT: %ut -- NEWED ON ENTRY
S %ut("IO")=IO
S %ut=1 ; set to identify unit test being run check with $$ISUTEST^%ut()
;
; ZEXCEPT: %utBREAK
I $G(%utBREAK) S %ut("BREAK")=1
Q
;
EN1(%utROU,%utLIST) ;
; VEN/SMH 26JUL2013 - This block is refactored to fix problems with
; SETUP and TEARDOWN not happening at the right time
N %utERRL,%utK,%utI,%utJ,%utSTRT
; ZEXCEPT: %utVERB -- ARGUMENT TO EN
I '+$G(%utVERB) S %utVERB=0
; ZEXCEPT: %utGUI -- CONDITIONALLY DEFINED BY GUINEXT
; ZEXCEPT: %ut -- NEWED IN EN
; ZEXCEPT: GetCPUTime,Process -- part of Cache method names
;
; Structure map for %ut
; -- CURR = Counter for routine number. Used as sub in %utROU
; -- ECNT = Entry point count in loop (cf. NERT); VEN/SMH - Needed?
; -- FAIL = Number of failures
; -- CHK = Number of checks ran (TF/EQ/FAIL)
; -- NENT = Number of entry points ran
; -- ERRN = Number of errors
S %ut("CURR")=0,%ut("ECNT")=0,%ut("FAIL")=0,%ut("CHK")=0,%ut("NENT")=0,%ut("ERRN")=0
;
; -- GET LIST OF ROUTINES --
; first get any tree of routines from this one
D GETTREE^%ut1(.%utROU,.%utLIST)
;
; Now process each routine that has been referenced
N CURRROU
S %ut("CURR")=0
F S %ut("CURR")=%ut("CURR")+1 Q:'$D(%utROU(%ut("CURR"))) S CURRROU=%utROU(%ut("CURR")) D I $T(@("SHUTDOWN^"_CURRROU))'="" D @("SHUTDOWN^"_CURRROU)
. ; 141018 - add ability to run STARTUP and SHUTDOWN in each routine JLI
. I $T(@("STARTUP^"_CURRROU))'="" D @("STARTUP^"_CURRROU) ; 141018
. N %utETRY ; Test list to run
. ;
. ; Collect Test list.
. D CHEKTEST^%ut1(%utROU(%ut("CURR")),.%ut,.%utETRY)
. ;
. ; if a SETUP entry point exists, save it off in %ut
. S %ut("SETUP")="" ; 141018 need to clear any previous values JLI
. N %utSETUP S %utSETUP="SETUP^"_%utROU(%ut("CURR"))
. S %ut("LINE")=$T(@%utSETUP) I %ut("LINE")'="" S %ut("SETUP")=%utSETUP
. K %utSETUP ; we're done!
. ;
. ; if a TEARDOWN entry point exists, ditto
. S %ut("TEARDOWN")="" ; 141018 need to clear any previous values JLI
. N %utTEARDOWN S %utTEARDOWN="TEARDOWN^"_%utROU(%ut("CURR"))
. S %ut("LINE")=$T(@%utTEARDOWN) I %ut("LINE")'="" S %ut("TEARDOWN")=%utTEARDOWN
. K %utTEARDOWN ; done here.
. ;
. ; VEN/SMH 26JUL2013 - this block changed to correct running of setup and teardown
. ; run each of the specified entry points
. ;
. ; == THIS FOR/DO BLOCK IS THE CENTRAL TEST RUNNER ==
. S %utI=0
. F S %utI=$O(%utETRY(%utI)) Q:%utI'>0 S %ut("ENUM")=%ut("ERRN")+%ut("FAIL") D
. . N $ETRAP S $ETRAP="D ERROR^%ut"
. . ;
. . ; Run Set-up Code (only if present)
. . S %ut("ENT")=$G(%ut("SETUP")) ; Current entry
. . S %ut("NAME")="Set-up Code"
. . D:%ut("ENT")]"" @%ut("ENT")
. . ;
. . ; Run actual test
. . S %ut("ECNT")=%ut("ECNT")+1
. . S %ut("NAME")=%utETRY(%utI,"NAME")
. . S %ut("ENT")=%utETRY(%utI)_"^"_%utROU(%ut("CURR"))
. . I %utVERB,'$D(%utGUI) D VERBOSE1(.%utETRY,%utI) ; Say what we executed.
. . ;
. . I %utVERB=2 N %utStart D ; Time Start
. . . I +$SY=0 S %utStart=$P($SYSTEM.Process.GetCPUTime(),",")+$P($SYSTEM.Process.GetCPUTime(),",",2)
. . . I +$SY=47 S %utStart=$ZGETJPI("","CPUTIM")*10
. . ;
. . ; Run the test!
. . D @%ut("ENT")
. . ;
. . I %utVERB=2 N %utEnd,%utElapsed D ; Time End
. . . I +$SY=0 S %utEnd=$P($SYSTEM.Process.GetCPUTime(),",")+$P($SYSTEM.Process.GetCPUTime(),",",2)
. . . I +$SY=47 S %utEnd=$ZGETJPI("","CPUTIM")*10
. . . S %utElapsed=%utEnd-%utStart_"ms"
. . ;
. . ; Run Teardown Code (only if present)
. . S %ut("ENT")=$G(%ut("TEARDOWN"))
. . S %ut("NAME")="Teardown Code"
. . D:%ut("ENT")]"" @%ut("ENT")
. . ;
. . ; ENUM = Number of errors + failures
. . ; Only print out the success message [OK] If our error number remains
. . ; the same as when we started the loop.
. . I %utVERB,'$D(%utGUI) D
. . . I %ut("ENUM")=(%ut("ERRN")+%ut("FAIL")) D VERBOSE(.%utETRY,1,%utVERB,$G(%utElapsed)) I 1
. . . E D VERBOSE(.%utETRY,0,%utVERB,$G(%utElapsed))
. . . Q
. . Q
. ; keep a %utCNT of number of entry points executed across all routines
. S %ut("NENT")=%ut("NENT")+%ut("ENTN")
. Q
;
; -- SHUTDOWN --
D SETIO^%ut1
W !!,"Ran ",%utLIST," Routine",$S(%utLIST>1:"s",1:""),", ",%ut("NENT")," Entry Tag",$S(%ut("NENT")>1:"s",1:"")
W !,"Checked ",%ut("CHK")," test",$S(%ut("CHK")>1:"s",1:""),", with ",%ut("FAIL")," failure",$S(%ut("FAIL")'=1:"s",1:"")," and encountered ",%ut("ERRN")," error",$S(%ut("ERRN")'=1:"s",1:""),"."
S ^TMP("%ut",$J,"UTVALS")=%utLIST_U_%ut("NENT")_U_%ut("CHK")_U_%ut("FAIL")_U_%ut("ERRN") ; JLI 150621 so programs running several sets of unit tests can generate totals
D RESETIO^%ut1
Q
; -- end EN1
VERBOSE(%utETRY,SUCCESS,%utVERB,%utElapsed) ;Internal only - Say whether we succeeded or failed.
; ZEXCEPT: %ut - NEWED IN EN
D SETIO^%ut1
N RM S RM=73 ; Right Margin
I %utVERB=2,$G(%utElapsed)]"" S RM=RM-$L(%utElapsed)-1
N I F I=$X+3:1:RM W "-"
W ?RM
I $G(SUCCESS) W "[OK]"
E W "[FAIL]"
I %utVERB=2,$G(%utElapsed)]"" W " ",%utElapsed ; add timing
D RESETIO^%ut1
Q
;
VERBOSE1(%utETRY,%utI) ; Print out the entry point info
; ZEXCEPT: %ut - NEWED IN EN
D SETIO^%ut1
W !,%utETRY(%utI) I $G(%utETRY(%utI,"NAME"))'="" W " - ",%utETRY(%utI,"NAME")
D RESETIO^%ut1
Q
;
CHKTF(XTSTVAL,XTERMSG) ; Entry point for checking True or False values
; ZEXCEPT: %utERRL,%utGUI - CREATED IN SETUP, KILLED IN END
; ZEXCEPT: %ut - NEWED IN EN
; ZEXCEPT: XTGUISEP - newed in GUINEXT
I '$D(XTSTVAL) D NVLDARG^%ut1("CHKTF") Q
I $G(XTERMSG)="" S XTERMSG="no failure message provided"
S %ut("CHK")=$G(%ut("CHK"))+1
I '$D(%utGUI) D
. D SETIO^%ut1
. I 'XTSTVAL W !,%ut("ENT")," - " W:%ut("NAME")'="" %ut("NAME")," - " D
. . W XTERMSG,! 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
. I XTSTVAL W "."
. D RESETIO^%ut1
. Q
I $D(%utGUI),'XTSTVAL S %ut("CNT")=%ut("CNT")+1,@%ut("RSLT")@(%ut("CNT"))=%ut("LOC")_XTGUISEP_"FAILURE"_XTGUISEP_XTERMSG,%ut("FAIL")=%ut("FAIL")+1
Q
;
CHKEQ(XTEXPECT,XTACTUAL,XTERMSG) ; Entry point for checking values to see if they are EQUAL
N FAILMSG
; ZEXCEPT: %utERRL,%utGUI -CREATED IN SETUP, KILLED IN END
; ZEXCEPT: %ut -- NEWED IN EN
; ZEXCEPT: XTGUISEP - newed in GUINEXT
I '$D(XTEXPECT)!'$D(XTACTUAL) D NVLDARG^%ut1("CHKEQ") Q
S XTACTUAL=$G(XTACTUAL),XTEXPECT=$G(XTEXPECT)
I $G(XTERMSG)="" S XTERMSG="no failure message provided"
S %ut("CHK")=%ut("CHK")+1
I XTEXPECT'=XTACTUAL S FAILMSG="<"_XTEXPECT_"> vs <"_XTACTUAL_"> - "
I '$D(%utGUI) D
. D SETIO^%ut1
. I XTEXPECT'=XTACTUAL W !,%ut("ENT")," - " W:%ut("NAME")'="" %ut("NAME")," - " W FAILMSG,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
. E W "."
. D RESETIO^%ut1
. Q
I $D(%utGUI),XTEXPECT'=XTACTUAL S %ut("CNT")=%ut("CNT")+1,@%ut("RSLT")@(%ut("CNT"))=%ut("LOC")_XTGUISEP_"FAILURE"_XTGUISEP_FAILMSG_XTERMSG,%ut("FAIL")=%ut("FAIL")+1
Q
;
FAIL(XTERMSG) ; Entry point for generating a failure message
D FAIL^%ut1($G(XTERMSG))
Q
;
SUCCEED ; Entry point for forcing a success (Thx David Whitten)
; ZEXCEPT: %utERRL,%utGUI - CREATED IN SETUP, KILLED IN END
; ZEXCEPT: %ut - NEWED IN EN
; Switch IO and write out the dot for activity
I '$D(%utGUI) D
. D SETIO^%ut1
. W "."
. D RESETIO^%ut1
;
; Increment test counter
S %ut("CHK")=%ut("CHK")+1
QUIT
;
CHKLEAKS(%utCODE,%utLOC,%utINPT) ; functionality to check for variable leaks on executing a section of code
; %utCODE - A string that specifies the code that is to be XECUTED and checked for leaks.
; this should be a complete piece of code (e.g., "S X=$$NOW^XLFDT()" or "D EN^%ut(""ROUNAME"")")
; %utLOC - A string that is used to indicate the code tested for variable leaks
; %utINPT - An optional variable which may be passed by reference. This may
; be used to pass any variable values, etc. into the code to be
; XECUTED. In this case, set the subscript to the variable name and the
; value of the subscripted variable to the desired value of the subscript.
; e.g., (using NAME as my current namespace)
; S CODE="S %utINPT=$$ENTRY^ROUTINE(ZZVALUE1,ZZVALUE2)"
; S NAMELOC="ENTRY^ROUTINE leak test" (or simply "ENTRY^ROUTINE")
; S NAMEINPT("ZZVALUE1")=ZZVALUE1
; S NAMEINPT("ZZVALUE2")=ZZVALUE2
; D CHKLEAKS^%ut(CODE,NAMELOC,.NAMEINPT)
;
; If part of a unit test, any leaked variables in ENTRY^ROUTINE which result
; from running the code with the variables indicated will be shown as FAILUREs.
;
; If called outside of a unit test, any leaked variables will be printed to the
; current device.
;
N (%utCODE,%utLOC,%utINPT,DUZ,IO,U,%utERRL,%ut,%utGUI,%utERR,%utI,%utJ,%utK,%utLIST,%utROU,%utSTRT,XTGUISEP)
; ZEXCEPT: %ut - part of exclusive NEW TESTS FOR EXISTENCE ONLY
; ZEXCEPT: %utVAR - handled by exclusive NEW
;
; ACTIVATE ANY VARIABLES PASSED AS SUBSCRIPTS TO %utINPT TO THEIR VALUES
S %utVAR=" " F S %utVAR=$O(%utINPT(%utVAR)) Q:%utVAR="" S (@%utVAR)=%utINPT(%utVAR)
X %utCODE
N ZZUTVAR S ZZUTVAR="%"
I $G(%ut)=1 D
. I $D(@ZZUTVAR),'$D(%utINPT(ZZUTVAR)) D FAIL^%ut(%utLOC_" VARIABLE LEAK: "_ZZUTVAR)
. F S ZZUTVAR=$O(@ZZUTVAR) Q:ZZUTVAR="" I $E(ZZUTVAR,1,3)'="%ut",'$D(%utINPT(ZZUTVAR)),",DUZ,IO,U,DTIME,ZZUTVAR,DT,%ut,XTGUISEP,"'[(","_ZZUTVAR_",") D FAIL^%ut(%utLOC_" VARIABLE LEAK: "_ZZUTVAR)
. Q
I '($G(%ut)=1) D
. I $D(@ZZUTVAR),'$D(%utINPT(ZZUTVAR)) W !,%utLOC_" VARIABLE LEAK: "_ZZUTVAR
. F S ZZUTVAR=$O(@ZZUTVAR) Q:ZZUTVAR="" I $E(ZZUTVAR,1,3)'="%ut",'$D(%utINPT(ZZUTVAR)),",DUZ,IO,U,DTIME,ZZUTVAR,DT,%ut,XTGUISEP,"'[(","_ZZUTVAR_",") W !,%utLOC_" VARIABLE LEAK: "_ZZUTVAR
. Q
Q
;
ERROR ; record errors
; ZEXCEPT: %utERRL,%utGUI,%utERR -CREATED IN SETUP, KILLED IN END
; ZEXCEPT: %ut -- NEWED ON ENTRY
; ZEXCEPT: XTGUISEP - newed in GUINEXT
S %ut("CHK")=%ut("CHK")+1
I '$D(%utGUI) D ERROR1
I $D(%utGUI) D
. S %ut("CNT")=%ut("CNT")+1
. S %utERR=%utERR+1
. S @%ut("RSLT")@(%ut("CNT"))=%ut("LOC")_XTGUISEP_"ERROR"_XTGUISEP_$S(+$SY=47:$ZS,1:$ZE)
. Q
S @($S(+$SY=47:"$ZS",1:"$ZE")_"="_""""""),$EC=""
Q
;
ERROR1 ;
I $G(%ut("BREAK")) BREAK ; if we are asked to break upon error, please do so!
; ZEXCEPT: %utERRL -CREATED IN SETUP, KILLED IN END
; ZEXCEPT: %ut -- NEWED ON ENTRY
D SETIO^%ut1
W !,%ut("ENT")," - " W:%ut("NAME")'="" %ut("NAME")," - Error: " W $S(+$SY=47:$ZS,1:$ZE),! D
. S %ut("ERRN")=%ut("ERRN")+1,%utERRL(%ut("ERRN"))=%ut("NAME"),%utERRL(%ut("FAIL"),"MSG")=$S(+$SY=47:$ZS,1:$ZE),%utERRL(%ut("FAIL"),"ENTRY")=%ut("ENT")
. Q
D RESETIO^%ut1
Q
;
ISUTEST() ; .SUPPORTED API TO DETERMINE IF CURRENTLY IN UNIT TEST
; ZEXCEPT: %ut -- NEWED ON ENTRY
Q $G(%ut)=1
;
PICKSET ; .OPT Interactive selection of MUnit Test Group
N DIC,Y,%utROU,%utLIST,DIR
I '$$ISUTEST^%ut() S DIC=17.9001,DIC(0)="AEQM" D ^DIC Q:Y'>0 W ! D GETSET(+Y,.%utROU,.%utLIST) N DIC,Y,%ut D SETUT D EN1(.%utROU,%utLIST) S DIR(0)="EA",DIR("A")="Enter RETURN to continue:" D ^DIR K DIR
Q
;
RUNSET(SETNAME,VERBOSE) ; .SR Run with Specified Selection of MUnit Test Group
N Y,%utROU,%utLIST,%utVERB
Q:$G(SETNAME)=""
S %utVERB=$G(VERBOSE,0)
S Y=+$$FIND1^DIC(17.9001,"","X",SETNAME) Q:Y'>0
D GETSET(Y,.%utROU,.%utLIST)
N Y,SETNAME,%ut
D SETUT
D EN1(.%utROU,%utLIST)
Q
;
; DOSET CAN BE USED TO RUN A SET OF TESTS BASED ON THE IEN IN THE MUNIT TEST GROUP file (#17.9001)
DOSET(IEN,%utVERB) ; 140731 JLI added %utVERB as a second argument
; IEN - Internal entry number for selected set of tests in the MUNIT TEST GROUP file (#17.9001)
; %utVERB - optional input that indicates verbose output is permitted
;
N %utROU,%utLIST
I '$D(%utVERB) S %utVERB=0
S %utLIST=0
D GETSET($G(IEN),.%utROU,.%utLIST)
I %utLIST>0 N IEN,%ut D SETUT,EN1(.%utROU,%utLIST)
Q
;
GETSET(IEN,%utROU,%utLIST) ; JLI 140731 - called from PICKSET, RUNSET, DOSET, GUISET
N IENS,%utROOT
S IENS=IEN_"," D GETS^DIQ(17.9001,IENS,"1*","","%utROOT")
S %utLIST=0,IENS="" F S IENS=$O(%utROOT(17.90011,IENS)) Q:IENS="" S %utLIST=%utLIST+1,%utROU(%utLIST)=%utROOT(17.90011,IENS,.01)
Q
;
COV(NMSP,COVCODE,VERBOSITY) ; simply make it callable from %ut1 as well (along with other APIs) JLI 150101
D COV^%ut1(NMSP,COVCODE,+$G(VERBOSITY)) ; see COV^%ut1 for description of arguments
Q
;
MULTAPIS(TESTROUS) ; .SR - RUN TESTS FOR SPECIFIED ROUTINES AND ENTRY POINTS
; input - TESTROUS - passed by reference
; see TESTONLY in routine %utcover for full description of TESTROUS argument
D MULTAPIS^%utcover(.TESTROUS) ; RUN TESTS FOR SPECIFIED ROUTINES AND ENTRY POINTS
Q
;
COVERAGE(ROUNMSP,TESTROUS,XCLDROUS,RESLTLVL) ;.SR - run coverage analysis for multiple routines and entry points
; input ROUNMSP
; input TESTROUS - passed by reference
; input XCLDROUS - passed by reference
; input RESLTLVL
; see COVERAGE in routine %utcover for full description of arguments
D COVERAGE^%utcover(ROUNMSP,.TESTROUS,.XCLDROUS,+$G(RESLTLVL))
Q
;
GETUTVAL(UTDATA) ; .SR - returns totals for current unit test data in cumulative totals
; usage D GETUTVAL^%ut(.UTDATA)
; input - UTDATA - passed by reference
;
; subscripted values returned:
; 1) cumulative number of routines run; 2) cumulative number of entry tags;
; 3) cumulative number of tests; 4) cummulative number of failures;
; 5) cumulative number of errors
N VALS,I,VAL
S VALS=$G(^TMP("%ut",$J,"UTVALS")) I VALS="" Q
F I=1:1 S VAL=$P(VALS,U,I) Q:VAL="" S UTDATA(I)=$G(UTDATA(I))+VAL
K ^TMP("%ut",$J,"UTVALS")
Q
;
LSTUTVAL(UTDATA) ; .SR - lists cumulative totals in UTDATA array
; usage D LSTUTVAL^%ut(.UTDATA)
; input - UTDATA - passed by reference
W !!!,"------------ SUMMARY ------------"
W !,"Ran ",UTDATA(1)," Routine",$S(UTDATA(1)>1:"s",1:""),", ",UTDATA(2)," Entry Tag",$S(UTDATA(2)>1:"s",1:"")
W !,"Checked ",UTDATA(3)," test",$S(UTDATA(3)>1:"s",1:""),", with ",UTDATA(4)," failure",$S(UTDATA(4)'=1:"s",1:"")," and encountered ",UTDATA(5)," error",$S(UTDATA(5)'=1:"s",1:""),"."
Q
;
;
GUISET(%utRSLT,XTSET) ; Entry point for GUI start with selected Test Set IEN - called by %ut-TEST GROUP LOAD rpc
N %utROU,%utLIST,%ut
D SETUT
S %ut("RSLT")=$NA(^TMP("MUNIT-%utRSLT",$J)) K @%ut("RSLT")
D GETSET(XTSET,.%utROU,.%utLIST)
D GETLIST(.%utROU,%utLIST,%ut("RSLT"))
S @%ut("RSLT")@(1)=(@%ut("RSLT")@(1))_"^1" ; 110719 mark as new version
S %utRSLT=%ut("RSLT")
Q
;
GUILOAD(%utRSLT,%utROUN) ; Entry point for GUI start with %utROUN containing primary routine name - called by %ut-TEST LOAD rpc
N %utROU,%ut
D SETUT
S %ut("RSLT")=$NA(^TMP("MUNIT-%utRSLT",$J)) K @%ut("RSLT")
S %utROU(1)=%utROUN
D GETLIST(.%utROU,1,%ut("RSLT"))
S @%ut("RSLT")@(1)=(@%ut("RSLT")@(1))_"^1" ; 110719 mark as new version
S %utRSLT=%ut("RSLT")
Q
;
GETLIST(%utROU,%utLIST,%utRSLT) ; called from GUISET, GUILOAD
N I,%utROUL,%utROUN,%ut,XTCOMNT,XTVALUE,%utCNT
S XTVALUE=$NA(^TMP("GUI-MUNIT",$J)) K @XTVALUE
S %utCNT=0,XTCOMNT=""
D GETTREE^%ut1(.%utROU,%utLIST)
F I=1:1 Q:'$D(%utROU(I)) S %utROUL(%utROU(I))=""
S %utROUN="" F S %utROUN=$O(%utROUL(%utROUN)) Q:%utROUN="" D LOAD(%utROUN,.%utCNT,XTVALUE,XTCOMNT,.%utROUL)
M @%utRSLT=@XTVALUE
K @%utRSLT@("SHUTDOWN")
K @%utRSLT@("STARTUP")
S @XTVALUE@("LASTROU")="" ; Use this to keep track of place in routines
Q
;
; generate list of unit test routines, entry points and comments on test for entry point
LOAD(%utROUN,%utNCNT,XTVALUE,XTCOMNT,%utROUL) ; called from GETLIST, and recursively from LOAD
I $T(@("^"_%utROUN))="" S %utNCNT=%utNCNT+1,@XTVALUE@(%utNCNT)=%utROUN_"^^*** ERROR - ROUTINE NAME NOT FOUND" Q
S %utNCNT=%utNCNT+1,@XTVALUE@(%utNCNT)=%utROUN_U_U_XTCOMNT
;N %utI,XTX1,XTX2,LINE
N %utI,XTX1,XTX2,LINE,LIST,I
; 100622 JLI added code to identify STARTUP and TEARDOWN
I $T(@("STARTUP^"_%utROUN))'="",'$D(@XTVALUE@("STARTUP")) S @XTVALUE@("STARTUP")="STARTUP^"_%utROUN
I $T(@("SHUTDOWN^"_%utROUN))'="",'$D(@XTVALUE@("SHUTDOWN")) S @XTVALUE@("SHUTDOWN")="SHUTDOWN^"_%utROUN
; JLI 140731 handle @TEST identified test tags
D NEWSTYLE^%ut1(.LIST,%utROUN)
F I=1:1:LIST S %utNCNT=%utNCNT+1,@XTVALUE@(%utNCNT)=%utROUN_U_LIST(I)
; JLI 140731 end of @TEST addition
F %utI=1:1 S LINE=$T(@("XTENT+"_%utI_"^"_%utROUN)) S XTX1=$P(LINE,";",3) Q:XTX1="" S XTX2=$P(LINE,";",4),%utNCNT=%utNCNT+1,@XTVALUE@(%utNCNT)=%utROUN_U_XTX1_U_XTX2
F %utI=1:1 S LINE=$T(@("XTROU+"_%utI_"^"_%utROUN)) S XTX1=$P(LINE,";",3) Q:XTX1="" S XTCOMNT=$P(LINE,";",4) I '$D(%utROUL(XTX1)) S %utROUL(XTX1)="" D LOAD(XTX1,.%utNCNT,XTVALUE,XTCOMNT,.%utROUL)
Q
;
GUINEXT(%utRSLT,%utLOC,XTGUISEP) ; Entry point for GUI execute next test - called by %ut-TEST NEXT rpc
; XTGUISEP - added 110719 to provide for changing separator for GUI
; return from ^ to another value ~~^~~ so that data returned
; is not affected by ^ values in the data - if not present
; sets value to default ^
N %utETRY,%utROUT,XTOLROU,XTVALUE,%utERR,%utGUI
N %ut
I $G(XTGUISEP)="" S XTGUISEP="^"
D SETUT
S %ut("LOC")=%utLOC
S %ut("CURR")=0,%ut("ECNT")=0,%ut("FAIL")=0,%ut("CHK")=0,%ut("NENT")=0,%ut("ERRN")=0
S XTVALUE=$NA(^TMP("GUI-MUNIT",$J))
S %ut("RSLT")=$NA(^TMP("GUINEXT",$J)) K @%ut("RSLT")
S %utRSLT=%ut("RSLT")
S %utETRY=$P(%utLOC,U),%utROUT=$P(%utLOC,U,2),XTOLROU=$G(@XTVALUE@("LASTROU"))
S %utGUI=1
S %ut("CHK")=0,%ut("CNT")=1,%utERR=0
; I %utROUT'=XTOLROU D I %utROUT="" S @%utRSLT@(1)="" K @XTVALUE Q ;140731 JLI - commented out
;D I %utROUT="" S @%utRSLT@(1)="" K @XTVALUE Q ; 140731 JLI - replaced previous line - moves check for SHUTDOWN at end of processing
D I %utROUT="" S @%utRSLT@(1)="" Q ; 141018 JLI - Have to leave XTVALUE intact, in case they simply run again for STARTUP, etc.
. I XTOLROU="",$D(@XTVALUE@("STARTUP")) D
. . S %ut("LOC")=@XTVALUE@("STARTUP")
. . N $ETRAP S $ETRAP="D ERROR^%ut"
. . D @(@XTVALUE@("STARTUP"))
. . Q
. S @XTVALUE@("LASTROU")=%utROUT I %utROUT'="",$T(@("SETUP^"_%utROUT))'="" D
. . S %ut("LOC")="SETUP^"_%utROUT
. . N $ETRAP S $ETRAP="D ERROR^%ut"
. . D @("SETUP^"_%utROUT)
. . Q
. I %utROUT="",$D(@XTVALUE@("SHUTDOWN")) D
. . S %ut("LOC")=@XTVALUE@("SHUTDOWN")
. . N $ETRAP S $ETRAP="D ERROR^%ut"
. . D @(@XTVALUE@("SHUTDOWN"))
. . Q
. Q
S %ut("LOC")=%utLOC
S %ut("CHK")=0,%ut("CNT")=1,%utERR=0
D ; to limit range of error trap so we continue through other tests
. N $ETRAP S $ETRAP="D ERROR^%ut"
. D @%ut("LOC")
. Q
I $T(@("TEARDOWN^"_%utROUT))'="" D
. S %ut("LOC")="TEARDOWN^"_%utROUT
. N $ETRAP S $ETRAP="D ERROR^%ut"
. D @("TEARDOWN^"_%utROUT)
. Q
S @%ut("RSLT")@(1)=%ut("CHK")_XTGUISEP_(%ut("CNT")-1-%utERR)_XTGUISEP_%utERR
K ^TMP("%ut",$J,"UTVALS")
Q
;