Megatest

Diff
Login

Differences From Artifact [4a152668df]:

To Artifact [5380b387e8]:


1050
1051
1052
1053
1054
1055
1056
1057

1058
1059
1060
1061


1062
1063
1064
1065
1066
1067
1068
1050
1051
1052
1053
1054
1055
1056

1057
1058
1059


1060
1061
1062
1063
1064
1065
1066
1067
1068







-
+


-
-
+
+







				(if tests-match-qry (conc " AND (" tests-match-qry ") ") "")
				(case sort-by
				  ((rundir)      " ORDER BY length(rundir) ")
				  ((testname)    (conc " ORDER BY testname " (if sort-order (conc sort-order ",") "") " item_path "))
				  ((statestatus) (conc " ORDER BY state " (if  sort-order (conc sort-order ",") "") " status "))
				  ((event_time)  " ORDER BY event_time ")
				  (else          (if (string? sort-by)
						     (conc " ORDER BY " sort-by)
						     (conc " ORDER BY " sort-by " ")
						     " ")))
				(if sort-order sort-order " ")
				(if limit  (conc " LIMIT " limit)   "")
				(if offset (conc " OFFSET " offset) "")
				(if limit  (conc " LIMIT " limit)   " ")
				(if offset (conc " OFFSET " offset) " ")
				";"
				)))
    (debug:print-info 8 "db:get-tests-for-run qry=" qry)
    (sqlite3:for-each-row 
     (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
       (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
     db 
1084
1085
1086
1087
1088
1089
1090
1091
1092





1093
1094
1095
1096
1097
1098

1099
1100
1101
1102
1103
1104
1105
1106
1084
1085
1086
1087
1088
1089
1090


1091
1092
1093
1094
1095
1096
1097
1098
1099
1100

1101

1102
1103
1104
1105
1106
1107
1108







-
-
+
+
+
+
+





-
+
-







	  (vector-ref inrec 5) ;; status
	  -1 "" -1 -1 "" "-" 
	  (vector-ref inrec 3) ;; item-path
	  -1 "-" "-"))


(define (db:get-tests-for-run-state-status db run-id testpatt)
  (let ((res            '())
	(tests-match-qry (tests:match->sqlqry testpatt)))
  (let* ((res            '())
	 (tests-match-qry (tests:match->sqlqry testpatt))
	 (qry             (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? " 
				(if tests-match-qry (conc " AND (" tests-match-qry ") ") ""))))
    (debug:print-info 8 "db:get-tests-for-run qry=" qry)
    (sqlite3:for-each-row
     (lambda (id testname item-path state status)
       ;; id,run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment
       (set! res (cons (vector id run-id testname state status -1 "" -1 -1 "" "-" item-path -1 "-" "-") res)))
     db 
     (conc "SELECT id,testname,item_path,state,status FROM tests WHERE run_id=? " 
     qry
	   (if tests-match-qry (conc " AND (" tests-match-qry ") ") ""))
     run-id)
    res))

(define (db:get-testinfo-state-status db test-id)
  (let ((res            #f))
    (sqlite3:for-each-row
     (lambda (run-id testname item-path state status)
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600







1601
1602
1603
1604
1605
1606
1607
1589
1590
1591
1592
1593
1594
1595







1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609







-
-
-
-
-
-
-
+
+
+
+
+
+
+







;; 	  res))))))
;; 
;; ;; (define (cdb:set-verbosity serverdat val)
;;   (cdb:client-call serverdat 'set-verbosity #f *default-numtries* val))
;; 
;; (define (cdb:num-clients serverdat)
;;   (cdb:client-call serverdat 'numclients #t *default-numtries*))
;; 
;; (define (db:test-set-status-state db test-id status state msg)
;;   (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
;;       (db:general-call db 'set-test-start-time (list test-id)))
;;   (if msg
;;       (db:general-call db 'state-status-msg (list state status msg test-id))
;;       (db:general-call db 'state-status     (list state status test-id))))

(define (db:test-set-status-state db test-id status state msg)
  (if (member state '("LAUNCHED" "REMOTEHOSTSTART"))
      (db:general-call db 'set-test-start-time (list test-id)))
  (if msg
      (db:general-call db 'state-status-msg (list state status msg test-id))
      (db:general-call db 'state-status     (list state status test-id))))
;; 
;; (define (cdb:test-rollup-test_data-pass-fail serverdat test-id)
;;   (cdb:client-call serverdat 'test_data-pf-rollup #t *default-numtries* test-id test-id test-id test-id))
;; 
;; (define (cdb:tests-register-test serverdat run-id test-name item-path)
;;   (cdb:client-call serverdat 'register-test #t *default-numtries* run-id test-name item-path))
;;