Megatest

Diff
Login

Differences From Artifact [96b6893599]:

To Artifact [706a072116]:


13
14
15
16
17
18
19
20

21




22
23
24
25
26
27
28
13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28
29
30
31
32







-
+

+
+
+
+








(declare (unit rmt))
(declare (uses api))
(declare (uses tdb))
(declare (uses http-transport))

;;
;; These are all called on the client side
;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!!
;;

;;======================================================================
;;  S U P P O R T   F U N C T I O N S
;;======================================================================

;; cmd is a symbol
;; vars is a json string encoding the parameters for the call
;;
(define (rmt:send-receive cmd params)
  (case *transport-type* 
    ((fs)
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










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







+

-
+

+
+
+
+
+
+
+
+
+
+
+
+





-
-
-










+
+
+
+

+
+
+
+
+
+
+
+
+
-
+
















+
+
+
+
+
+
+
+
+
+
      (json-write dat))))

(define (rmt:json-str->dat json-str)
  (with-input-from-string json-str
    (lambda ()
      (json-read))))

;;======================================================================
;;
;; Actual api calls 
;; A C T U A L   A P I   C A L L S  
;;
;;======================================================================

;;======================================================================
;;  K E Y S 
;;======================================================================

(define (rmt:get-key-val-pairs run-id)
  (rmt:send-receive 'get-key-val-pairs (list run-id)))

;;======================================================================
;;  T E S T S
;;======================================================================

(define (rmt:get-test-info-by-id test-id)
  (list->vector
   (rmt:send-receive 'get-test-info-by-id (list test-id))))

(define (rmt:get-key-val-pairs run-id)
  (rmt:send-receive 'get-key-val-pairs (list run-id)))

(define (rmt:test-get-rundir-from-test-id test-id)
  (rmt:send-receive 'test-get-rundir-from-test-id (list test-id)))

(define (rmt:open-test-db-by-test-id test-id #!key (work-area #f))
  (let* ((test-path (if (string? work-area)
			work-area
			(rmt:test-get-rundir-from-test-id test-id))))
    (debug:print 3 "TEST PATH: " test-path)
    (open-test-db test-path)))

(define (rmt:testmeta-get-record testname)
  (list->vector
   (rmt:send-receive 'testmeta-get-record (list testname))))

;;======================================================================
;;  R U N S
;;======================================================================

(define (rmt:get-run-info run-id)
  (let ((res (rmt:send-receive 'get-run-info (list run-id))))
    (vector (car res)
	    (list->vector (cadr res)))))

;;======================================================================
;; S T E P S
;;  S T E P S
;;======================================================================

;; Getting steps is more complicated.
;;
;; If given work area 
;;  1. Find the testdat.db file
;;  2. Open the testdat.db file and do the query
;; If not given the work area
;;  1. Do a remote call to get the test path
;;  2. Continue as above
;; 
(define (rmt:get-steps-for-test test-id #!key (work-area #f))
  (let* ((tdb (rmt:open-test-db-by-test-id test-id work-area: work-area)))
    (if tdb
	(tdb:get-steps-data tdb test-id)
	'())))

;;======================================================================
;;  T E S T   D A T A 
;;======================================================================

(define (rmt:read-test-data test-id categorypatt #!key (work-area #f)) 
  (let ((tdb  (rmt:open-test-db-by-test-id test-id work-area: work-area)))
    (if tdb
	(tdb:read-test-data tdb test-id categorypatt)
	'())))