Remove warnings dealing with GT.M. Should not be interactive.
This commit is contained in:
Sam Habiel
parent
b11692b51e
commit
1dfc30b421
|
|
@ -1,152 +1,114 @@
|
||||||
%utPOST ;VEN-SMH/JLI - post install for M-Unit Test software ;12/16/15 08:58
|
%utPOST ;VEN-SMH/JLI - post install for M-Unit Test software ;09/14/15 12:39
|
||||||
;;1.3;MASH UTILITIES;;DEC 16,2015;Build 1
|
;;0.2;MASH UTILITIES;;;Build 7
|
||||||
; Submitted to OSEHRA DEC 16, 2015 by Joel L. Ivey under the Apache 2 license (http://www.apache.org/licenses/LICENSE-2.0.html)
|
; Submitted to OSEHRA Sep 14, 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
|
; Original routine authored by Sam H. Habiel 07/2013-04/2014
|
||||||
; Additions and modifications made by Joel L. Ivey 05/2014-08/2015
|
; Additions and modifications made by Joel L. Ivey 05/2014-08/2015
|
||||||
;
|
;
|
||||||
N X,I
|
N X,I
|
||||||
I +$SY=47 D R X:$G(DTIME,300) D MES^XPDUTL(" ")
|
D RENAME
|
||||||
. S X(1)=" "
|
;
|
||||||
. S X(2)="In the next section, as it tries to copy the ut* routines"
|
RENAME ;
|
||||||
. S X(3)="to %ut* routines watch for text that indicates the following:"
|
N %S,%D ; Source, destination
|
||||||
. S X(4)=" "
|
S U="^"
|
||||||
. S X(5)="cp: cannot create regular file `/_ut.m': Permission denied"
|
S %S="ut^ut1^utcover^utt1^utt2^utt3^utt4^utt5^utt6^uttcovr"
|
||||||
. S X(6)=" "
|
S %D="%ut^%ut1^%utcover^%utt1^%utt2^%utt3^%utt4^%utt5^%utt6^%uttcovr"
|
||||||
. S X(7)="If this is seen, respond Yes at the prompt after the attempt:"
|
;
|
||||||
. S X(8)=" Press ENTER to continue: "
|
MOVE ; rename % routines
|
||||||
. F I=1:1:18 D MES^XPDUTL(" ") ; create a blank screen for text
|
N %,X,Y,M
|
||||||
. D MES^XPDUTL(.X)
|
F %=1:1:$L(%D,"^") D D MES(M) I +$SY=47 D MES(" ")
|
||||||
. Q
|
. S M="",X=$P(%S,U,%) ; from
|
||||||
D RENAME
|
. S Y=$P(%D,U,%) ; to
|
||||||
I +$SY=47 D R X:$G(DTIME,300) I "Yy"[$E($G(X)) D GTMPROB
|
. Q:X=""
|
||||||
. K X
|
. S M="Routine: "_$J(X,8)
|
||||||
. S X(1)=" "
|
. Q:Y="" I $T(^@X)="" S M=M_" Missing" Q
|
||||||
. S X(2)=" Your entry on the next line may not echo"
|
. S M=M_" Loaded, "
|
||||||
. S X(3)="If error text was seen enter Y (and RETURN): NO// "
|
. D COPY(X,Y)
|
||||||
. D MES^XPDUTL(.X)
|
. S M=M_"Saved as "_$J(Y,8)
|
||||||
. Q
|
;
|
||||||
Q
|
QUIT ; END
|
||||||
;
|
;
|
||||||
RENAME ;
|
COPY(FROM,TO) ;
|
||||||
N %S,%D ; Source, destination
|
N XVAL
|
||||||
S U="^"
|
I +$SYSTEM=0 S XVAL="ZL @FROM ZS @TO" X XVAL QUIT
|
||||||
S %S="ut^ut1^utcover^utt1^utt2^utt3^utt4^utt5^utt6^uttcovr"
|
I +$SYSTEM=47 DO QUIT
|
||||||
S %D="%ut^%ut1^%utcover^%utt1^%utt2^%utt3^%utt4^%utt5^%utt6^%uttcovr"
|
. S FROM=$$PATH(FROM)
|
||||||
;
|
. S TO=$$PATH(TO,"WRITE")
|
||||||
MOVE ; rename % routines
|
. N CMD S CMD="cp "_FROM_" "_TO
|
||||||
N %,X,Y,M
|
. O "cp":(shell="/bin/sh":command=CMD:WRITEONLY)::"PIPE"
|
||||||
F %=1:1:$L(%D,"^") D D MES(M) I +$SY=47 D MES(" ")
|
. U "cp" C "cp"
|
||||||
. S M="",X=$P(%S,U,%) ; from
|
QUIT
|
||||||
. S Y=$P(%D,U,%) ; to
|
;
|
||||||
. Q:X=""
|
PATH(ROUTINE,MODE) ; for GT.M return source file with path for a routine
|
||||||
. S M="Routine: "_$J(X,8)
|
;input: ROUTINE=Name of routine
|
||||||
. Q:Y="" I $T(^@X)="" S M=M_" Missing" Q
|
; MODE="READ" or "WRITE" defaults to READ
|
||||||
. S M=M_" Loaded, "
|
;output: Full filename
|
||||||
. D COPY(X,Y)
|
;
|
||||||
. S M=M_"Saved as "_$J(Y,8)
|
S MODE=$G(MODE,"READ") ;set MODE to default value
|
||||||
;
|
N FILE S FILE=$TR(ROUTINE,"%","_")_".m" ;convert rtn name to filename
|
||||||
QUIT ; END
|
N ZRO S ZRO=$ZRO
|
||||||
;
|
;
|
||||||
COPY(FROM,TO) ;
|
; Get source routine
|
||||||
N XVAL
|
N %ZR
|
||||||
I +$SYSTEM=0 S XVAL="ZL @FROM ZS @TO" X XVAL QUIT
|
I MODE="READ" D SILENT^%RSEL(ROUTINE,"SRC") Q %ZR(ROUTINE)_FILE
|
||||||
I +$SYSTEM=47 DO QUIT
|
;
|
||||||
. S FROM=$$PATH(FROM)
|
; We are writing. Parse directories and get 1st routine directory
|
||||||
. S TO=$$PATH(TO,"WRITE")
|
N DIRS
|
||||||
. N CMD S CMD="cp "_FROM_" "_TO
|
D PARSEZRO(.DIRS,ZRO)
|
||||||
. O "cp":(shell="/bin/sh":command=CMD:WRITEONLY)::"PIPE"
|
N PATH S PATH=$$ZRO1ST(.DIRS)
|
||||||
. U "cp" C "cp"
|
;
|
||||||
QUIT
|
QUIT PATH_FILE ;end of PATH return directory and filename
|
||||||
;
|
;
|
||||||
PATH(ROUTINE,MODE) ; for GT.M return source file with path for a routine
|
;
|
||||||
;input: ROUTINE=Name of routine
|
PARSEZRO(DIRS,ZRO) ; Parse $zroutines properly into an array
|
||||||
; MODE="READ" or "WRITE" defaults to READ
|
N PIECE
|
||||||
;output: Full filename
|
N I
|
||||||
;
|
F I=1:1:$L(ZRO," ") S PIECE(I)=$P(ZRO," ",I)
|
||||||
S MODE=$G(MODE,"READ") ;set MODE to default value
|
N CNT S CNT=1
|
||||||
N FILE S FILE=$TR(ROUTINE,"%","_")_".m" ;convert rtn name to filename
|
F I=0:0 S I=$O(PIECE(I)) Q:'I D
|
||||||
N ZRO S ZRO=$ZRO
|
. S DIRS(CNT)=$G(DIRS(CNT))_PIECE(I)
|
||||||
;
|
. I DIRS(CNT)["("&(DIRS(CNT)[")") S CNT=CNT+1 QUIT
|
||||||
; Get source routine
|
. I DIRS(CNT)'["("&(DIRS(CNT)'[")") S CNT=CNT+1 QUIT
|
||||||
N %ZR
|
. S DIRS(CNT)=DIRS(CNT)_" " ; prep for next piece
|
||||||
I MODE="READ" D SILENT^%RSEL(ROUTINE,"SRC") Q %ZR(ROUTINE)_FILE
|
QUIT
|
||||||
;
|
;
|
||||||
; We are writing. Parse directories and get 1st routine directory
|
ZRO1ST(DIRS) ; $$ Get first routine directory
|
||||||
N DIRS
|
N OUT ; $$ return
|
||||||
D PARSEZRO(.DIRS,ZRO)
|
N %1 S %1=DIRS(1) ; 1st directory
|
||||||
N PATH S PATH=$$ZRO1ST(.DIRS)
|
; Parse with (...)
|
||||||
;
|
I %1["(" DO
|
||||||
QUIT PATH_FILE ;end of PATH return directory and filename
|
. S OUT=$P(%1,"(",2)
|
||||||
;
|
. I OUT[" " S OUT=$P(OUT," ")
|
||||||
;
|
. E S OUT=$P(OUT,")")
|
||||||
PARSEZRO(DIRS,ZRO) ; Parse $zroutines properly into an array
|
; no parens
|
||||||
N PIECE
|
E S OUT=%1
|
||||||
N I
|
;
|
||||||
F I=1:1:$L(ZRO," ") S PIECE(I)=$P(ZRO," ",I)
|
; Add trailing slash
|
||||||
N CNT S CNT=1
|
I $E(OUT,$L(OUT))'="/" S OUT=OUT_"/"
|
||||||
F I=0:0 S I=$O(PIECE(I)) Q:'I D
|
QUIT OUT
|
||||||
. S DIRS(CNT)=$G(DIRS(CNT))_PIECE(I)
|
;
|
||||||
. I DIRS(CNT)["("&(DIRS(CNT)[")") S CNT=CNT+1 QUIT
|
MES(T,B) ;Write message.
|
||||||
. I DIRS(CNT)'["("&(DIRS(CNT)'[")") S CNT=CNT+1 QUIT
|
S B=$G(B)
|
||||||
. S DIRS(CNT)=DIRS(CNT)_" " ; prep for next piece
|
I $L($T(BMES^XPDUTL)) D BMES^XPDUTL(T):B,MES^XPDUTL(T):'B Q
|
||||||
QUIT
|
W:B ! W !,T
|
||||||
;
|
Q
|
||||||
ZRO1ST(DIRS) ; $$ Get first routine directory
|
;
|
||||||
N OUT ; $$ return
|
TEST ; @TEST - TESTING TESTING
|
||||||
N %1 S %1=DIRS(1) ; 1st directory
|
;
|
||||||
; Parse with (...)
|
N ZR S ZR="o(p r) /var/abc(/var/abc/r/) /abc/def $gtm_dist/libgtmutl.so vista.so"
|
||||||
I %1["(" DO
|
N DIRS D PARSEZRO(.DIRS,ZR)
|
||||||
. S OUT=$P(%1,"(",2)
|
N FIRSTDIR S FIRSTDIR=$$ZRO1ST(.DIRS)
|
||||||
. I OUT[" " S OUT=$P(OUT," ")
|
I FIRSTDIR'="p" S $EC=",U1,"
|
||||||
. E S OUT=$P(OUT,")")
|
;
|
||||||
; no parens
|
N ZR S ZR="/var/abc(/var/abc/r/) o(p r) /abc/def $gtm_dist/libgtmutl.so vista.so"
|
||||||
E S OUT=%1
|
N DIRS D PARSEZRO(.DIRS,ZR)
|
||||||
;
|
N FIRSTDIR S FIRSTDIR=$$ZRO1ST(.DIRS)
|
||||||
; Add trailing slash
|
I FIRSTDIR'="/var/abc/r/" S $EC=",U1,"
|
||||||
I $E(OUT,$L(OUT))'="/" S OUT=OUT_"/"
|
;
|
||||||
QUIT OUT
|
N ZR S ZR="/abc/def /var/abc(/var/abc/r/) o(p r) $gtm_dist/libgtmutl.so vista.so"
|
||||||
;
|
N DIRS D PARSEZRO(.DIRS,ZR)
|
||||||
MES(T,B) ;Write message.
|
N FIRSTDIR S FIRSTDIR=$$ZRO1ST(.DIRS)
|
||||||
S B=$G(B)
|
I FIRSTDIR'="/abc/def" S $EC=",U1,"
|
||||||
I $L($T(BMES^XPDUTL)) D BMES^XPDUTL(T):B,MES^XPDUTL(T):'B Q
|
;
|
||||||
W:B ! W !,T
|
WRITE "All tests have run successfully!",!
|
||||||
Q
|
QUIT
|
||||||
;
|
;
|
||||||
TEST ; @TEST - TESTING TESTING
|
|
||||||
;
|
|
||||||
N ZR S ZR="o(p r) /var/abc(/var/abc/r/) /abc/def $gtm_dist/libgtmutl.so vista.so"
|
|
||||||
N DIRS D PARSEZRO(.DIRS,ZR)
|
|
||||||
N FIRSTDIR S FIRSTDIR=$$ZRO1ST(.DIRS)
|
|
||||||
I FIRSTDIR'="p" S $EC=",U1,"
|
|
||||||
;
|
|
||||||
N ZR S ZR="/var/abc(/var/abc/r/) o(p r) /abc/def $gtm_dist/libgtmutl.so vista.so"
|
|
||||||
N DIRS D PARSEZRO(.DIRS,ZR)
|
|
||||||
N FIRSTDIR S FIRSTDIR=$$ZRO1ST(.DIRS)
|
|
||||||
I FIRSTDIR'="/var/abc/r/" S $EC=",U1,"
|
|
||||||
;
|
|
||||||
N ZR S ZR="/abc/def /var/abc(/var/abc/r/) o(p r) $gtm_dist/libgtmutl.so vista.so"
|
|
||||||
N DIRS D PARSEZRO(.DIRS,ZR)
|
|
||||||
N FIRSTDIR S FIRSTDIR=$$ZRO1ST(.DIRS)
|
|
||||||
I FIRSTDIR'="/abc/def" S $EC=",U1,"
|
|
||||||
;
|
|
||||||
WRITE "All tests have run successfully!",!
|
|
||||||
QUIT
|
|
||||||
;
|
|
||||||
GTMPROB ; come here in case of error trying to run unit tests - checks whether renaming worked
|
|
||||||
N X
|
|
||||||
S X(1)=" "
|
|
||||||
S X(2)="*** An error occurred during renaming of routines to %ut*."
|
|
||||||
S X(3)="*** The renaming has been seen to fail on one type of Linux system."
|
|
||||||
S X(4)="*** In this case, at the Linux command line copy each ut*.m routine"
|
|
||||||
S X(5)="*** (ut.m, ut1.m, utt1.m, utt2.m, utt3.m, utt4.m, utt5.m, utt6.m, and "
|
|
||||||
S X(6)="*** uttcovr.m) to _ut*.m (e.g., 'cp ut.m _ut.m', 'cp ut1.m _ut1.m',"
|
|
||||||
S X(7)="*** 'cp utt1.m _utt1.m', etc., to 'cp uttcovr.m _uttcovr.m'). Then in GT.M"
|
|
||||||
S X(8)="*** use the command 'ZLINK %ut', then 'ZLINK %ut1', etc., these may"
|
|
||||||
S X(9)="*** indicate an undefined local variable error, but continue doing it."
|
|
||||||
S X(10)="*** When complete, use the M command 'DO ^%utt1' to run the unit tests on"
|
|
||||||
S X(11)="*** the %ut and %ut1 routines to confirm they are working"
|
|
||||||
S X(12)=" "
|
|
||||||
S X(13)=" Press Enter to continue: "
|
|
||||||
D MES^XPDUTL(.X)
|
|
||||||
R X:$G(DTIME,300)
|
|
||||||
Q
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue