Megatest

Diff
Login

Differences From Artifact [a1062addd1]:

To Artifact [41b5b06e44]:


32
33
34
35
36
37
38
39



40
41
42
43
44
45
46

47
48
49
50
51
52
53
54
    ((delete-test-records)             (apply db:delete-test-records db params))
    ((delete-old-deleted-test-records) (db:delete-old-deleted-test-records db))
    ((test-set-status-state)           (apply db:test-set-status-state db params))
    ((get-previous-test-run-record)    (apply db:get-previous-test-run-record db params))
    ((get-matching-previous-test-run-records)(map vector->list (apply db:get-matching-previous-test-run-records db params)))
    ((db:test-get-logfile-info)        (apply db:test-get-logfile-info db params))
    ((test-get-records-for-index-file  (apply db:test-get-records-for-index-file db params)))
    ((get-testinfo-state-status)       (apply db:get-testinfo-state-status db params))



    ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new db params))
    ((get-prereqs-not-met)             (let ((res (apply db:get-prereqs-not-met db params)))
					 (map (lambda (x)
						(if (vector? x)
						    (vector->list x)
						    x))
					      res)))

					 

    ;; RUNS
    ((get-run-info)                 (let ((res (apply db:get-run-info db params)))
				      (list (vector-ref res 0)
					    (vector->list (vector-ref res 1)))))
    ((register-run)                 (apply db:register-run db params))
    ((set-tests-state-status)       (apply db:set-tests-state-status db params))







|
>
>
>







>
|







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
    ((delete-test-records)             (apply db:delete-test-records db params))
    ((delete-old-deleted-test-records) (db:delete-old-deleted-test-records db))
    ((test-set-status-state)           (apply db:test-set-status-state db params))
    ((get-previous-test-run-record)    (apply db:get-previous-test-run-record db params))
    ((get-matching-previous-test-run-records)(map vector->list (apply db:get-matching-previous-test-run-records db params)))
    ((db:test-get-logfile-info)        (apply db:test-get-logfile-info db params))
    ((test-get-records-for-index-file  (apply db:test-get-records-for-index-file db params)))
    ((get-testinfo-state-status)       (let ((res (apply db:get-testinfo-state-status db params)))
					 (if (vector? res)
					     (vector->list res)
					     res)))
    ((test-get-paths-matching-keynames-target-new) (apply db:test-get-paths-matching-keynames-target-new db params))
    ((get-prereqs-not-met)             (let ((res (apply db:get-prereqs-not-met db params)))
					 (map (lambda (x)
						(if (vector? x)
						    (vector->list x)
						    x))
					      res)))
    ((roll-up-pass-fail-counts)        (apply db:roll-up-pass-fail-counts db params))
    

    ;; RUNS
    ((get-run-info)                 (let ((res (apply db:get-run-info db params)))
				      (list (vector-ref res 0)
					    (vector->list (vector-ref res 1)))))
    ((register-run)                 (apply db:register-run db params))
    ((set-tests-state-status)       (apply db:set-tests-state-status db params))
69
70
71
72
73
74
75

76
77
78
79
80
81
82
    ((update-run-event_time)        (apply db:update-run-event_time db params))

    ;; MISC
    ((login)                        (apply db:login db params))
    ((general-call)                 (let ((stmtname   (car params))
					  (realparams (cdr params)))
				      (db:general-call db stmtname realparams)))

    ((kill-server)
     (db:sync-to *inmemdb* *db*)
     (let ((hostname (car  *runremote*))
	   (port     (cadr *runremote*))
	   (pid      (if (null? params) #f (car params)))
	   (th1      (make-thread (lambda ()(thread-sleep! 3)(debug:print 0 "Server exiting!")(exit 0)) "Server exit thread")))
       (debug:print 0 "WARNING: Server on " hostname ":" port " going down by user request!")







>







73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
    ((update-run-event_time)        (apply db:update-run-event_time db params))

    ;; MISC
    ((login)                        (apply db:login db params))
    ((general-call)                 (let ((stmtname   (car params))
					  (realparams (cdr params)))
				      (db:general-call db stmtname realparams)))
    ((sync-inmem->db)               (db:sync-back))
    ((kill-server)
     (db:sync-to *inmemdb* *db*)
     (let ((hostname (car  *runremote*))
	   (port     (cadr *runremote*))
	   (pid      (if (null? params) #f (car params)))
	   (th1      (make-thread (lambda ()(thread-sleep! 3)(debug:print 0 "Server exiting!")(exit 0)) "Server exit thread")))
       (debug:print 0 "WARNING: Server on " hostname ":" port " going down by user request!")