| 1 | XOBVLJU ;; mjk/alb - VistALink JUNIT Testers ; 07/27/2002  13:00
 | 
|---|
| 2 |  ;;1.5;VistALink;;Sep 09, 2005
 | 
|---|
| 3 |  ;;Foundations Toolbox Release v1.5 [Build: 1.5.0.026]
 | 
|---|
| 4 |  ;
 | 
|---|
| 5 |  QUIT
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 |  ; ----------------------------------------------------------
 | 
|---|
| 8 |  ;                 XOB Remote Procedure JUnit Testers
 | 
|---|
| 9 |  ; ----------------------------------------------------------
 | 
|---|
| 10 |  ; 
 | 
|---|
| 11 | VERRP(XOBY) ; -- rpc: XOBV TEST JUNIT RPC VERSION
 | 
|---|
| 12 |  SET XOBY=$GET(XWBAPVER,"XWBAPVER not defined")
 | 
|---|
| 13 |  QUIT
 | 
|---|
| 14 |  ;
 | 
|---|
| 15 |  ; ----------- Switching RPC Format On-The-Fly Tests ---------
 | 
|---|
| 16 | XA2GRP(XOBY,XOBARR) ; -- rpc: XOBV TEST JUNIT SWITCH ARR2GLB
 | 
|---|
| 17 |  NEW X
 | 
|---|
| 18 |  SET XOBY=$NAME(^TMP("XOB VL TEST",$JOB))
 | 
|---|
| 19 |  KILL @XOBY
 | 
|---|
| 20 |  MERGE @XOBY=XOBARR
 | 
|---|
| 21 |  SET X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
 | 
|---|
| 22 |  QUIT
 | 
|---|
| 23 |  ;
 | 
|---|
| 24 | XG2ARP(XOBY,XOBARR) ; -- rpc: XOBV TEST JUNIT SWITCH GLB2ARR
 | 
|---|
| 25 |  NEW X
 | 
|---|
| 26 |  MERGE XOBY=XOBARR
 | 
|---|
| 27 |  SET X=$$RTRNFMT^XWBLIB("ARRAY",1)
 | 
|---|
| 28 |  QUIT
 | 
|---|
| 29 |  ;
 | 
|---|
| 30 | XA2SRP(XOBY,XOBARR) ; -- rpc: XOBV TEST JUNIT SWITCH ARR2SV
 | 
|---|
| 31 |  NEW X,XOBRET,I
 | 
|---|
| 32 |  SET XOBRET=""
 | 
|---|
| 33 |  SET I=""
 | 
|---|
| 34 |  FOR  SET I=$ORDER(XOBARR(I)) QUIT:I=""  SET XOBRET=XOBRET_XOBARR(I)_":"
 | 
|---|
| 35 |  SET XOBY=XOBRET
 | 
|---|
| 36 |  SET X=$$RTRNFMT^XWBLIB("SINGLE VALUE")
 | 
|---|
| 37 |  QUIT
 | 
|---|
| 38 |  ;
 | 
|---|
| 39 | XS2ARP(XOBY,XOBARR) ; -- rpc: XOBV TEST JUNIT SWITCH SV2ARR
 | 
|---|
| 40 |  NEW X
 | 
|---|
| 41 |  MERGE XOBY=XOBARR
 | 
|---|
| 42 |  SET X=$$RTRNFMT^XWBLIB("ARRAY",1)
 | 
|---|
| 43 |  QUIT
 | 
|---|
| 44 |  ;
 | 
|---|
| 45 | XG2SRP(XOBY,XOBARR) ; -- rpc: XOBV TEST JUNIT SWITCH GLB2SV
 | 
|---|
| 46 |  NEW X,Y,I
 | 
|---|
| 47 |  SET Y=""
 | 
|---|
| 48 |  SET I=""
 | 
|---|
| 49 |  FOR  SET I=$ORDER(XOBARR(I)) QUIT:I=""  SET Y=Y_XOBARR(I)_"/"
 | 
|---|
| 50 |  SET XOBY=Y
 | 
|---|
| 51 |  SET X=$$RTRNFMT^XWBLIB("SINGLE VALUE")
 | 
|---|
| 52 |  QUIT
 | 
|---|
| 53 |  ;
 | 
|---|
| 54 | XS2GRP(XOBY,XOBARR) ; -- rpc: XOBV TEST JUNIT SWITCH SV2GLB
 | 
|---|
| 55 |  NEW X
 | 
|---|
| 56 |  SET XOBY=$NAME(^TMP("XOB VL TEST",$JOB))
 | 
|---|
| 57 |  KILL @XOBY
 | 
|---|
| 58 |  MERGE @XOBY=XOBARR
 | 
|---|
| 59 |  SET X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
 | 
|---|
| 60 |  QUIT
 | 
|---|
| 61 |  ;
 | 
|---|
| 62 | RPCTO(XOBY,XOBTTYP) ; -- rpc: graceful timeout : XOBV TEST JUNIT RPC TIMEOUT
 | 
|---|
| 63 |  ; -- used to test graceful but not waiting
 | 
|---|
| 64 |  IF XOBTTYP="NO TIMEOUT CHECK" SET XOBY=$$NOTOCHK() QUIT
 | 
|---|
| 65 |  ; -- used to test timeout reset
 | 
|---|
| 66 |  IF XOBTTYP="RESET TIMEOUT" DO RESET() SET XOBY=$$RESET() QUIT
 | 
|---|
| 67 |  ; -- used to test force timeout
 | 
|---|
| 68 |  IF XOBTTYP="FORCE TIMEOUT" DO FORCE() SET XOBY=$$FORCE() QUIT
 | 
|---|
| 69 |  QUIT
 | 
|---|
| 70 |  ;
 | 
|---|
| 71 | NOTOCHK() ; -- no timeout check
 | 
|---|
| 72 |  QUIT "No Timeout Check Return"
 | 
|---|
| 73 |  ;
 | 
|---|
| 74 | RESET() ; -- reset RPC timeout
 | 
|---|
| 75 |  FOR  HANG 1 IF $$STOP^XOBVLIB() DO  QUIT
 | 
|---|
| 76 |  . NEW TO,I,X
 | 
|---|
| 77 |  . SET TO=$$GETTO^XOBVLIB()
 | 
|---|
| 78 |  . FOR I=2:1 DO  QUIT:'X
 | 
|---|
| 79 |  . . SET X=$$SETTO^XOBVLIB(TO*I)
 | 
|---|
| 80 |  . . SET X=$$STOP^XOBVLIB()
 | 
|---|
| 81 |  QUIT "Reset Timeout Return"
 | 
|---|
| 82 |  ;
 | 
|---|
| 83 | FORCE() ; -- force RPC timeout
 | 
|---|
| 84 |  FOR  HANG 1 IF $$STOP^XOBVLIB() QUIT
 | 
|---|
| 85 |  QUIT "Forced Timeout return"
 | 
|---|
| 86 |  ;
 | 
|---|