Megatest

Diff
Login

Differences From Artifact [981beda2c1]:

To Artifact [ea2d212442]:


486
487
488
489
490
491
492
493
494
495
496
497




498
499
500
501
502
503
504
(define (db:test-set-comment db run-id test-name item-path comment)
  (sqlite3:execute 
   db 
   "UPDATE tests SET comment=? WHERE run_id=? AND testname=? AND item_path=?;"
   comment run-id test-name item-path))

;;
(define (db:test-set-rundir! db run-id testname item-path rundir)
  (sqlite3:execute 
   db 
   "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;"
   rundir run-id testname item-path))





;;======================================================================
;; Misc. test related queries
;;======================================================================

(define (db:test-get-paths-matching db keynames target)
  (let* ((res '())







|



|
>
>
>
>







486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
(define (db:test-set-comment db run-id test-name item-path comment)
  (sqlite3:execute 
   db 
   "UPDATE tests SET comment=? WHERE run_id=? AND testname=? AND item_path=?;"
   comment run-id test-name item-path))

;;
(define (db:test-set-rundir! db run-id test-name item-path rundir)
  (sqlite3:execute 
   db 
   "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;"
   rundir run-id test-name item-path))

(define (db:test-set-log! db run-id test-name item-path logf)
  (sqlite3:execute db "UPDATE tests SET final_logf=? WHERE run_id=? AND testname=? AND item_path=?;" 
		   logf run-id test-name item-path))

;;======================================================================
;; Misc. test related queries
;;======================================================================

(define (db:test-get-paths-matching db keynames target)
  (let* ((res '())
571
572
573
574
575
576
577
578

579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
    (sqlite3:for-each-row 
     (lambda (p)
       (set! res (cons p res)))
     db 
     qrystr)
    res))

(define (db:test-update-meta-info db run-id testname item-path minutes cpuload diskfree tmpfree)

  (if (not item-path)(begin (debug:print 0 "WARNING: ITEMPATH not set.")   (set! item-path "")))
  ;; (let ((testinfo (db:get-test-info db run-id testname item-path)))
  ;;   (if (and (not (equal? (db:test-get-status testinfo) "COMPLETED"))
  ;;            (not (equal? (db:test-get-status testinfo) "KILLREQ"))
  (sqlite3:execute
   db
   "UPDATE tests SET cpuload=?,diskfree=?,run_duration=?,state='RUNNING' WHERE run_id=? AND testname=? AND item_path=? AND state NOT IN ('COMPLETED','KILLREQ','KILLED');"
   cpuload
   diskfree
   minutes
   run-id
   testname
   item-path))

(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (or (equal? status "PASS")
	       (equal? status "WARN")
	       (equal? status "FAIL")







|
>
|
|
<
<







|







575
576
577
578
579
580
581
582
583
584
585


586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
    (sqlite3:for-each-row 
     (lambda (p)
       (set! res (cons p res)))
     db 
     qrystr)
    res))

(define (db:test-update-meta-info db run-id test-name item-path minutes cpuload diskfree tmpfree)
  (if (not item-path)
      (begin (debug:print 0 "WARNING: ITEMPATH not set.")   
	     (set! item-path "")))


  (sqlite3:execute
   db
   "UPDATE tests SET cpuload=?,diskfree=?,run_duration=?,state='RUNNING' WHERE run_id=? AND testname=? AND item_path=? AND state NOT IN ('COMPLETED','KILLREQ','KILLED');"
   cpuload
   diskfree
   minutes
   run-id
   test-name
   item-path))

(define (db:roll-up-pass-fail-counts db run-id test-name item-path status)
  (if (and (not (equal? item-path ""))
	   (or (equal? status "PASS")
	       (equal? status "WARN")
	       (equal? status "FAIL")
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
    (if *runremote*
	(let ((host (vector-ref *runremote* 0))
	      (port (vector-ref *runremote* 1)))
	  ((rpc:procedure 'rdb:teststep-set-status! host port)
	   run-id test-name teststep-name state-in status-in item-path comment logfile))
	(db:teststep-set-status! db run-id test-name teststep-name state-in status-in item-path comment logfile))))

(define (rdb:test-update-meta-info db run-id testname itemdat minutes cpuload diskfree tmpfree)
  (let ((item-path (item-list->path itemdat)))
    (if *runremote*
	(let ((host (vector-ref *runremote* 0))
	      (port (vector-ref *runremote* 1)))
	  ((rpc:procedure 'rdb:test-update-meta-info host port)
	   run-id testname itemdat minutes cpuload diskfree tmpfree))
	(db:test-update-meta-info db run-id testname item-path minutes cpuload diskfree tmpfree))))

(define (rdb:test-set-state-status-by-run-id-testname db run-id test-name item-path status state)
  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (port (vector-ref *runremote* 1)))
	((rpc:procedure 'rdb:test-set-state-status-by-run-id-testname host port)
	  run-id test-name item-path status state))







|





|
|







1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
    (if *runremote*
	(let ((host (vector-ref *runremote* 0))
	      (port (vector-ref *runremote* 1)))
	  ((rpc:procedure 'rdb:teststep-set-status! host port)
	   run-id test-name teststep-name state-in status-in item-path comment logfile))
	(db:teststep-set-status! db run-id test-name teststep-name state-in status-in item-path comment logfile))))

(define (rdb:test-update-meta-info db run-id test-name itemdat minutes cpuload diskfree tmpfree)
  (let ((item-path (item-list->path itemdat)))
    (if *runremote*
	(let ((host (vector-ref *runremote* 0))
	      (port (vector-ref *runremote* 1)))
	  ((rpc:procedure 'rdb:test-update-meta-info host port)
	   run-id test-name item-path minutes cpuload diskfree tmpfree))
	(db:test-update-meta-info db run-id test-name item-path minutes cpuload diskfree tmpfree))))

(define (rdb:test-set-state-status-by-run-id-testname db run-id test-name item-path status state)
  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (port (vector-ref *runremote* 1)))
	((rpc:procedure 'rdb:test-set-state-status-by-run-id-testname host port)
	  run-id test-name item-path status state))
1104
1105
1106
1107
1108
1109
1110








(define (rdb:test-set-comment db run-id test-name item-path comment)
  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (port (vector-ref *runremote* 1)))
	((rpc:procedure 'rdb:test-set-comment host port)
	 run-id test-name item-path comment))
      (db:test-set-comment db run-id test-name item-path comment)))















>
>
>
>
>
>
>
>
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
(define (rdb:test-set-comment db run-id test-name item-path comment)
  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (port (vector-ref *runremote* 1)))
	((rpc:procedure 'rdb:test-set-comment host port)
	 run-id test-name item-path comment))
      (db:test-set-comment db run-id test-name item-path comment)))

(define (rdb:test-set-log! db run-id test-name item-path logf)
  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (port (vector-ref *runremote* 1)))
	((rpc:procedure 'rpc:test-set-log! host port)
	 run-id test-name item-path logf))
      (db:test-set-log! db run-id test-name item-path logf)))