Megatest

Check-in [d14c539d9a]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:11 out of 30 calls converted to api
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: d14c539d9ace32ef6f726ab09071327ce3df891e
User & Date: matt on 2013-11-10 23:21:44
Other Links: manifest | tags
Context
2013-11-10
23:28
few more calls converted to api check-in: ece438fcbd user: matt tags: trunk
23:21
11 out of 30 calls converted to api check-in: d14c539d9a user: matt tags: trunk
23:17
11 out of 30 calls converted to api check-in: b9aa1e0ac7 user: matt tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified api.scm from [b213ea4227] to [90d8ff037f].

︙︙
33
34
35
36
37
38
39

40
41
42
43
44
45
46

    ((register-run)                 (apply db:register-run db params))
    ((login)                        (apply db:login db params))
    ((general-call)                 (let ((stmtname   (car params))
					  (realparams (cdr params)))
				      (db:general-call db stmtname realparams)))
    ((set-tests-state-status)       (apply db:set-state-status db params))
    ((get-tests-for-run)            (map vector->list (apply db:get-tests-for-run db params)))

    (else
     (list "ERROR" 0))))

;; http-server  send-response
;;                 api:process-request
;;                    db:*
;;








>








33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

    ((register-run)                 (apply db:register-run db params))
    ((login)                        (apply db:login db params))
    ((general-call)                 (let ((stmtname   (car params))
					  (realparams (cdr params)))
				      (db:general-call db stmtname realparams)))
    ((set-tests-state-status)       (apply db:set-state-status db params))
    ((get-tests-for-run)            (map vector->list (apply db:get-tests-for-run db params)))
    ((get-test-id)                  (apply db:get-test-id-not-cached db params))
    (else
     (list "ERROR" 0))))

;; http-server  send-response
;;                 api:process-request
;;                    db:*
;;
︙︙

Modified rmt.scm from [3d9332e918] to [df44ed0947].

︙︙
84
85
86
87
88
89
90



91
92
93
94
95
96
97

(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)
  (let ((res (rmt:send-receive 'get-test-info-by-id (list test-id))))
    (if (list? res)
	(list->vector res)
	res)))

(define (rmt:test-get-rundir-from-test-id test-id)








>
>
>








84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100

(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-id run-id testname item-path)
  (rmt:send-receive 'get-test-id (list run-id testname item-path)))

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

(define (rmt:test-get-rundir-from-test-id test-id)
︙︙

Modified tests/unittests/server.scm from [6f473a99fc] to [34b89d1e39].

︙︙
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

(test #f #f                       (rmt:get-test-info-by-id 99)) ;; get non-existant test
(test #f 1                        (rmt:register-run  *keyvals* "firstrun" "new" "n/a" (current-user-name)))
(test "get run info"  "firstrun"  (let ((rinfo (rmt:get-run-info 1)))
				    (vector-ref (vector-ref rinfo 1) 3)))
(test "get tests (no data)" '()   (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f))
(test "register test"       #t    (rmt:general-call 'register-test 1 "test1" ""))
(test "get tests (some data)"  1  (length (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f)))


;; ;; (set! *verbosity* 20)
;; (test #f *verbosity* (cadr (cdb:set-verbosity *runremote* *verbosity*)))
;; (test #f #f (cdb:roll-up-pass-fail-counts *runremote* 1 "test1" "" "PASS"))
;; ;; (set! *verbosity* 1)
;; ;; (cdb:set-verbosity *runremote* *verbosity*)
;; 
;; 
;; 
;; (test "get-keys" "SYSTEM" (car (db:get-keys *db*)))
;; 
;; (define remargs (args:get-args
;; 		 '("bar" "foo" ":runname" "bob" ":SYSTEM" "ubuntu" ":RELEASE" "v1.2" ":datapath" "blah/foo" "nada")
;; 		 (list ":runname" ":state" ":status")
;; 		 (list "-h")
;; 		 args:arg-hash
;; 		 0))
;; 
;; (test "register-run" #t (number?
;; 			 (rmt:register-run '(("SYSTEM" "key1")("RELEASE" "key2"))
;; 					   "myrun" 
;; 					   "new"
;; 					   "n/a" 
;; 					   "bob")))
;; 
;; (test #f #t             (cdb:tests-register-test *runremote* 1 "nada" ""))
;; (test #f 1              (cdb:remote-run db:get-test-id #f 1 "nada" ""))
;; (test #f "NOT_STARTED"  (vector-ref (open-run-close db:get-test-info #f 1 "nada" "") 3))
;; (test #f "NOT_STARTED"  (vector-ref (cdb:get-test-info *runremote* 1 "nada" "") 3))

;;======================================================================
;; D B
;;======================================================================

(test #f '(#t "exit process started") (cdb:kill-server *runremote* #f)) ;; *toppath* *my-client-signature* #f)))









>

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<








44
45
46
47
48
49
50
51
52




























53
54
55
56
57
58
59

(test #f #f                       (rmt:get-test-info-by-id 99)) ;; get non-existant test
(test #f 1                        (rmt:register-run  *keyvals* "firstrun" "new" "n/a" (current-user-name)))
(test "get run info"  "firstrun"  (let ((rinfo (rmt:get-run-info 1)))
				    (vector-ref (vector-ref rinfo 1) 3)))
(test "get tests (no data)" '()   (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f))
(test "register test"       #t    (rmt:general-call 'register-test 1 "test1" ""))
(test "get tests (some data)"  1  (length (rmt:get-tests-for-run 1 "%" '() '() #f #f #f #f #f #f)))
(test "get test id"            1  (rmt:get-test-id 1 "test1" ""))






























;;======================================================================
;; D B
;;======================================================================

(test #f '(#t "exit process started") (cdb:kill-server *runremote* #f)) ;; *toppath* *my-client-signature* #f)))

This page was generated in about 0.126s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00