forked from KRMAssociatesInc/JDS-GTM
-
Notifications
You must be signed in to change notification settings - Fork 2
/
VPRJT.m
115 lines (115 loc) · 5.19 KB
/
VPRJT.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
VPRJT ;SLC/KCM -- Unit test driver
;
;with acknowlegements to XTMUNIT, Imitation is the sincerest form of flattery
;
ALL ; Run all the tests
N ZZLINE,ZZNAME,ZZLIST,ZZLISTEXC
S ZZLINE=0,ZZLIST=""
F S ZZLINE=ZZLINE+1 S ZZNAME=$T(EACH+ZZLINE) Q:'$L(ZZNAME) S ZZNAME=$P($P(ZZNAME,";;",2,99)," ") Q:ZZNAME="zzzzz" D
. I $L($T(^%ut)) S ZZLIST(ZZNAME)=""
. E S ZZLIST=ZZLIST_$S($L(ZZLIST):",",1:"")_ZZNAME
I $L($T(^%ut)) D
. M ZZLISTEXC=ZZLIST
. S ZZLISTEXC("VPRJT")=""
. S ZZLISTEXC("VPRJCONV")=""
. S ZZLISTEXC("VPRJTCONV")=""
. S ZZLISTEXC("VPRJTX")=""
. S ZZLISTEXC("VPRJTZ")=""
I $L($T(^%ut)) D COVERAGE^%ut("VPR*",.ZZLIST,.ZZLISTEXC) QUIT
D EN(ZZLIST)
Q
EN(ZZRSET) ; Run tests for set of routines passed in
N ZZFAILED,ZZROU,ZZPIECE
F ZZPIECE=1:1:$L(ZZRSET,",") D TEST($P(ZZRSET,",",ZZPIECE))
I $L($T(^%ut)) QUIT
W !,$S($G(ZZFAILED):"Tests FAILED",1:"Tests PASSED")
Q
TEST(ZZROU) ; Run tests in a specific routine
I $L($T(^%ut)) D EN^%ut(ZZROU) QUIT
W !!,">> "_ZZROU,?10,$P($T(@(ZZROU_"^"_ZZROU)),"--",2,99)
N ZZI,ZZK,ZZX,ZZLABEL,ZZCODE,ZZCMT,ZZSET,ZZTEAR
S ZZK=$T(@("STARTUP^"_ZZROU)) I $L(ZZK) D @("STARTUP^"_ZZROU)
;
F ZZI=1:1 S ZZX=$T(@("+"_ZZI_"^"_ZZROU)) Q:ZZX="" D
. S ZZLABEL=$P(ZZX," "),ZZCODE=$$LTRIM($P(ZZX," ",2,99))
. I $L(ZZLABEL),($E(ZZCODE,1,2)=";;"),($$UP($E(ZZCODE,1,9))["@TEST") D
. . S ZZCMT=$E($P(ZZCODE,"@",2,99),5,$L(ZZCODE))
. . W !,"Testing"_ZZCMT_" ["_ZZLABEL_"^"_ZZROU_"]"
. . S ZZK=$T(@("SETUP^"_ZZROU)) I $L(ZZK) D @("SETUP^"_ZZROU)
. . D @(ZZLABEL_"^"_ZZROU) ; run the unit test
. . S ZZK=$T(@("TEARDOWN^"_ZZROU)) I $L(ZZK) D @("TEARDOWN^"_ZZROU)
. . ;W ! ZWRITE ; normally comment out except when looking for non-newed variables
;
S ZZK=$T(@("SHUTDOWN^"_ZZROU)) I $L(ZZK) D @("SHUTDOWN^"_ZZROU)
Q
EQ(EXPECT,ACTUAL,MSG) ;
I $L($T(^%ut)) D CHKEQ^%ut(EXPECT,ACTUAL,$G(MSG)) QUIT
I EXPECT=ACTUAL W "." Q
S ZZFAILED=1
W:$X>1 ! W "expected: ",EXPECT," actual: ",ACTUAL," ",$G(MSG),!
Q
NE(EXPECT,ACTUAL,MSG) ;
I EXPECT'=ACTUAL W "." Q
S ZZFAILED=1
W:$X>1 ! W "not equal failed, value: ",ACTUAL," ",$G(MSG),!
Q
UP(X) ; return uppercase for X
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;
LTRIM(X) ; remove spaces from left side
N POS F POS=1:1:$L(X) Q:$E(X,POS)'=" "
Q $E(X,POS,$L(X))
;
EACH ; run each test one at a time
;;VPRJUJD -- Unit tests for JSON decoding
;;VPRJUJE -- Unit tests for JSON encoding
;;VPRJUREQ -- Unit tests for HTTP listener request handling
;;VPRJURSP -- Unit tests for HTTP listener response handling
;;VPRJURUT -- Unit tests for HTTP listener utilities
;;VPRJUCU -- Unit tests for common utilities
;;VPRJUCV -- Unit tests for extracting values from objects
;;VPRJUCD -- Unit tests for building meta-data
;;VPRJUCD1 -- Unit tests for building templates
;;VPRJUCT -- Unit tests for applying templates
;;VPRJUCF -- Unit tests for filter parameter
;;VPRJUCR -- Unit tests for range parameter parsing
;;VPRJUFPS -- Unit tests for index functions
;;VPRJTCF -- Integration tests for query filters
;;VPRJTCT -- Integration tests for templates
;;VPRJTCT1 -- Integration tests for rel/rev templates
;;VPRJTDS -- Integration tests for saving objects to ODC
;;VPRJTDR -- Integration tests for ODS RESTful queries
;;VPRJTDR2 -- Integration tests for ODS RESTful templates
;;VPRJTDM -- Integration tests for ODS management tools
;;VPRJTPS -- Integration tests for saving patient objects
;;VPRJTPQ -- Integration tests for query indexes
;;VPRJTPR -- Integration tests for RESTful queries
;;VPRJTPR1 -- Integration tests for RESTful paging
;;VPRJTPR2 -- Integration tests for RESTful templates
;;VPRJTPR3 -- Integration tests for multi-patient RESTful queries
;;VPRJTPDI -- Integration tests for document indexes
;;VPRJTSYST -- Unit tests for GET Patient Sync Status
;;VPRJTSYSS -- Unit tests for SET Patient Sync Status
;;VPRJTJOB -- Unit tests for Job Status
;;VPRJTPATID -- Unit tests for Patient Indentifiers
;;VPRJTSES -- Unit tests for Session Storage
;;VPRJTODM -- Unit tests for Operational Data Mutable Storage
;;VPRJTSYNCOD -- Unit tests for Operational Sync Status
;;VPRJTHDR -- Integration tests for Patient Data and HDR
;;VPRJTGC -- Unit tests for Garbage Collection
;;VPRJTERR -- Unit tests for Error Storage
;;VPRJTGDS -- Unit tests for Generic Data Storage
;;VPRJTPL -- Integration tests for RESTful patient list queries
;;VPRJTPSTATUS -- Unit/Integration tests for simple patient sync status
;;VPRJTAR -- Special tests for RESTful queries across patients
;;VPRJTQP -- Integration tests for POST queries
;;VPRJT2D -- Integration tests for operational utilities
;;VPRJT2P -- Integration tests for patient utilities
;;VPRJTPRN -- Unit tests for individual patient data wrapper code for jdsClient using cache.node
;;VPRJTDRN -- Unit tests for operational data wrapper code for jdsClient using cache.node
;;VPRJTGDSN -- Unit tests for generic data store wrapper code for pjdsClient using cache.node
;;zzzzz
;;
N ZZZ S ZZZ=0
F S ZZZ=ZZZ+1 Q:$P($P($T(EACH+ZZZ),";;",2,99)," ")="zzzzz" D EN($P($P($T(EACH+ZZZ),";;",2,99)," ")) ;W ! ZWRITE
Q