Megatest

Check-in [04064e6f49]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:test-set-log converted to support rpc
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | archiving
Files: files | file ages | folders
SHA1: 04064e6f491673e6aab9da14c788a7975bb98bbd
User & Date: matt on 2012-02-23 23:14:44
Other Links: branch diff | manifest | tags
Context
2012-02-23
23:44
Switch to using ip address instead of host name for rpc check-in: 31334b02f8 user: matt tags: archiving
23:14
test-set-log converted to support rpc check-in: 04064e6f49 user: matt tags: archiving
22:53
test-set-status convertered to support rpc check-in: 965b1962fe user: matt tags: archiving
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [981beda2c1] to [ea2d212442].

︙
486
487
488
489
490
491
492
493

494
495
496
497





498
499
500
501
502
503
504

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 testname item-path rundir)
(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 testname 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

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 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)))
(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 "")))
  ;;   (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
   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

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 testname itemdat minutes cpuload diskfree tmpfree)
(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 testname itemdat minutes cpuload diskfree tmpfree))
	(db:test-update-meta-info db run-id testname item-path minutes cpuload diskfree tmpfree))))
	   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









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

Modified server.scm from [cc91f8dbd5] to [41b2a60811].

︙
80
81
82
83
84
85
86





87
88
89
90
91
92
93

80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98








+
+
+
+
+








     (lambda (run-id test-name item-path status)
       (db:roll-up-pass-fail-counts db run-id test-name item-path status)))

    (rpc:publish-procedure!
     'rdb:test-set-comment 
     (lambda (run-id test-name item-path comment)
       (db:test-set-comment db run-id test-name item-path comment)))
    
    (rpc:publish-procedure!
     'rpc:test-set-log!
     (lambda (run-id test-name item-path logf)
       (db:test-set-log! db run-id test-name item-path logf)))

    (set! *rpc:listener* rpc:listener)
    (on-exit (lambda ()
	       (sqlite3:execute db "DELETE FROM metadat WHERE var='SERVER' and val=?;" host:port)
	       (sqlite3:finalize! db)))
    (thread-start! th1)
    (thread-join! th1))) ;; rpc:server)))
︙

Modified tests.scm from [7f3d6c325a] to [a1ec853995].

︙
185
186
187
188
189
190
191
192
193

194
195
196
197
198
199
200

185
186
187
188
189
190
191


192
193
194
195
196
197
198
199








-
-
+








		 (string-match (regexp "\\S+") comment))
	    waived)
	(rdb:test-set-comment db  run-id test-name item-path (if waived waived comment)))
    ))

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

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

(define (tests:summarize-items db run-id test-name force)
  ;; if not force then only update the record if one of these is true:
︙

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