Megatest

Check-in [39b53fe321]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Fixed updating of test run meta data
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 39b53fe321dfcd3f442630ecc27feb7d851af079
User & Date: matt on 2012-03-25 14:41:27
Other Links: manifest | tags
Context
2012-03-25
15:05
Launch the remove-runs process in an xterm check-in: 1849a06c5d user: matt tags: trunk
14:41
Fixed updating of test run meta data check-in: 39b53fe321 user: matt tags: trunk
2012-03-20
23:28
Got nbfind working on ubuntu check-in: 4cf18277f3 user: matt tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified db.scm from [64f23143e9] to [d9dab9adc2].

︙
646
647
648
649
650
651
652
653

654
655
656
657
658
659
660
661
662
663
664
665

666
667


668

669
670
671

672
673
674
675
676
677
678

646
647
648
649
650
651
652

653



654
655
656
657
658
659



660
661
662
663
664

665
666
667

668
669
670
671
672
673
674
675








-
+
-
-
-






-
-
-
+


+
+
-
+


-
+









(define (db:updater db)
  (let loop ((start-time (current-time)))
    (thread-sleep! 0.5) ;; move save time around to minimize regular collisions?
    (db:write-cached-data db)
    (loop start-time)))
    
(define (db:test-update-meta-info db run-id test-name item-path minutes cpuload diskfree tmpfree)
(define (db:test-update-meta-info db test-id minutes cpuload diskfree tmpfree)
  (if (not item-path)
      (begin (debug:print 0 "WARNING: ITEMPATH not set.")   
	     (set! item-path "")))
  (mutex-lock! *incoming-mutex*)
  (set! *incoming-data* (cons (vector 'meta-info
				      (current-seconds)
				      (list cpuload
					    diskfree
					    minutes
					    run-id
					    test-name
					    item-path)) ;; run-id test-name item-path minutes cpuload diskfree tmpfree) 
					    test-id)) ;; run-id test-name item-path minutes cpuload diskfree tmpfree) 
			      *incoming-data*))
  (mutex-unlock! *incoming-mutex*)
  (if *cache-on*
      (debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write as part of test-update-meta-info")
  (if (not *cache-on*)(db:write-cached-data db)))
      (db:write-cached-data db)))

(define (db:write-cached-data db)
  (let ((meta-stmt (sqlite3:prepare 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');"))
  (let ((meta-stmt (sqlite3:prepare db "UPDATE tests SET cpuload=?,diskfree=?,run_duration=?,state='RUNNING' WHERE id=? AND state NOT IN ('COMPLETED','KILLREQ','KILLED');"))
	(step-stmt (sqlite3:prepare db "INSERT OR REPLACE into test_steps (test_id,stepname,state,status,event_time,comment,logfile) VALUES(?,?,?,?,?,?,?);")) ;; strftime('%s','now')#f)
	(data (sort *incoming-data* (lambda (a b)(< (vector-ref a 1)(vector-ref b 1))))))
    (if (> (length data) 0)
	(debug:print 4 "Writing cached data " data))
    (mutex-lock! *incoming-mutex*)
    (sqlite3:with-transaction 
     db
︙
1139
1140
1141
1142
1143
1144
1145
1146

1147
1148
1149
1150
1151
1152
1153






1154
1155
1156
1157
1158
1159
1160

1136
1137
1138
1139
1140
1141
1142

1143







1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156








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








    (if *runremote*
	(let ((host (vector-ref *runremote* 0))
	      (port (vector-ref *runremote* 1)))
	  ((rpc:procedure 'rdb:teststep-set-status! host port)
	   test-id teststep-name state-in status-in item-path comment logfile))
	(db:teststep-set-status! db test-id 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)
(define (rdb:test-update-meta-info db test-id 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))))
  (if *runremote*
      (let ((host (vector-ref *runremote* 0))
	    (port (vector-ref *runremote* 1)))
	((rpc:procedure 'rdb:test-update-meta-info host port)
	 test-id minutes cpuload diskfree tmpfree))
      (db:test-update-meta-info db test-id 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))
︙

Modified launch.scm from [587849e94b] to [2790622feb].

︙
62
63
64
65
66
67
68
69

70
71
72
73
74
75
76

62
63
64
65
66
67
68

69
70
71
72
73
74
75
76








-
+








	       (runname   (assoc/default 'runname   cmdinfo))
	       (megatest  (assoc/default 'megatest  cmdinfo))
	       (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo))
	       (fullrunscript (if runscript (conc testpath "/" runscript) #f))
	       (db        #f)
	       (rollup-status 0))
	  
	  (debug:print 2 "Exectuing " test-name " on " (get-host-name))
	  (debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-host-name))
	  (change-directory testpath)
	  ;; apply pre-overrides before other variables. The pre-override vars must not
	  ;; clobbers things from the official sources such as megatest.config and runconfigs.config
	  (if (string? set-vars)
	      (let ((varpairs (string-split set-vars ",")))
		(debug:print 4 "varpairs: " varpairs)
		(map (lambda (varpair)
︙
92
93
94
95
96
97
98
99

100
101
102
103
104
105
106

92
93
94
95
96
97
98

99
100
101
102
103
104
105
106








-
+








	      (begin
		(debug:print 0 "Failed to setup, exiting") 
		(exit 1)))
	  ;; now can find our db
	  (set! db (open-db))
	  (if (not (args:get-arg "-server"))
	      (server:client-setup db))
	  (set! *cache-on* #t)
	  ;; (set! *cache-on* #t)
	  (set-megatest-env-vars db run-id) ;; these may be needed by the launching process
	  (change-directory work-area) 
	  (set-run-config-vars db run-id)
	  ;; environment overrides are done *before* the remaining critical envars.
	  (alist->env-vars env-ovrd)
	  (set-megatest-env-vars db run-id)
	  (set-item-env-vars itemdat)
︙
258
259
260
261
262
263
264
265

266
267
268
269
270
271
272

258
259
260
261
262
263
264

265
266
267
268
269
270
271
272








-
+








					    (diskfree (get-df (current-directory)))
					    (tmpfree  (get-df "/tmp")))
				       (if (not (args:get-arg "-server"))
					   (server:client-setup db))
				       (if (not cpuload)  (begin (debug:print 0 "WARNING: CPULOAD not found.")  (set! cpuload "n/a")))
				       (if (not diskfree) (begin (debug:print 0 "WARNING: DISKFREE not found.") (set! diskfree "n/a")))
				       (set! kill-job? (test-get-kill-request db run-id test-name itemdat))
				       (rdb:test-update-meta-info db run-id test-name itemdat minutes cpuload diskfree tmpfree)
				       (rdb:test-update-meta-info db test-id minutes cpuload diskfree tmpfree)
				       (if kill-job? 
					   (begin
					     (mutex-lock! m)
					     (let* ((pid (vector-ref exit-info 0)))
					       (if (number? pid)
						   (begin
						     (debug:print 0 "WARNING: Request received to kill job (attempt # " kill-tries ")")
︙
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469





























470
471
472
473
474
475
476

434
435
436
437
438
439
440





























441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476








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








;; 4. remotely run the test on allocated host
;;    - could be ssh to host from hosts table (update regularly with load)
;;    - could be netbatch
;;      (launch-test db (cadr status) test-conf))
(define (launch-test db run-id runname test-conf keyvallst test-name test-path itemdat params)
  (change-directory *toppath*)
  (let* ((useshell   (config-lookup *configdat* "jobtools"     "useshell"))
	(launcher   (config-lookup *configdat* "jobtools"     "launcher"))
	(runscript  (config-lookup test-conf   "setup"        "runscript"))
	(ezsteps    (> (length (hash-table-ref/default test-conf "ezsteps" '())) 0)) ;; don't send all the steps, could be big
	(diskspace  (config-lookup test-conf   "requirements" "diskspace"))
	(memory     (config-lookup test-conf   "requirements" "memory"))
	(hosts      (config-lookup *configdat* "jobtools"     "workhosts"))
	(remote-megatest (config-lookup *configdat* "setup" "executable"))
	;; FIXME SOMEDAY: not good how this is so obtuse, this hack is to 
	;;                allow running from dashboard. Extract the path
        ;;                from the called megatest and convert dashboard
  	;;             	  or dboard to megatest
	(local-megatest  (let* ((lm  (car (argv)))
				(dir (pathname-directory lm))
				(exe (pathname-strip-directory lm)))
			   (conc (if dir (conc dir "/") "")
				 (case (string->symbol exe)
				   ((dboard) "megatest")
				   ((dashboard) "megatest")
				   (else exe)))))
	(test-sig   (conc test-name ":" (item-list->path itemdat))) ;; test-path is the full path including the item-path
	(work-area  #f)
	(toptest-work-area #f) ;; for iterated tests the top test contains data relevant for all
	(diskpath   #f)
	(cmdparms   #f)
	(fullcmd    #f) ;; (define a (with-output-to-string (lambda ()(write x))))
	(mt-bindir-path #f)
	(item-path (item-list->path itemdat))
	(testinfo   (rdb:get-test-info db run-id test-name item-path))
	(test-id    (db:test-get-id testinfo)))
	 (launcher   (config-lookup *configdat* "jobtools"     "launcher"))
	 (runscript  (config-lookup test-conf   "setup"        "runscript"))
	 (ezsteps    (> (length (hash-table-ref/default test-conf "ezsteps" '())) 0)) ;; don't send all the steps, could be big
	 (diskspace  (config-lookup test-conf   "requirements" "diskspace"))
	 (memory     (config-lookup test-conf   "requirements" "memory"))
	 (hosts      (config-lookup *configdat* "jobtools"     "workhosts"))
	 (remote-megatest (config-lookup *configdat* "setup" "executable"))
	 ;; FIXME SOMEDAY: not good how this is so obtuse, this hack is to 
	 ;;                allow running from dashboard. Extract the path
	 ;;                from the called megatest and convert dashboard
	 ;;             	  or dboard to megatest
	 (local-megatest  (let* ((lm  (car (argv)))
				 (dir (pathname-directory lm))
				 (exe (pathname-strip-directory lm)))
			    (conc (if dir (conc dir "/") "")
				  (case (string->symbol exe)
				    ((dboard) "megatest")
				    ((dashboard) "megatest")
				    (else exe)))))
	 (test-sig   (conc test-name ":" (item-list->path itemdat))) ;; test-path is the full path including the item-path
	 (work-area  #f)
	 (toptest-work-area #f) ;; for iterated tests the top test contains data relevant for all
	 (diskpath   #f)
	 (cmdparms   #f)
	 (fullcmd    #f) ;; (define a (with-output-to-string (lambda ()(write x))))
	 (mt-bindir-path #f)
	 (item-path (item-list->path itemdat))
	 (testinfo   (rdb:get-test-info db run-id test-name item-path))
	 (test-id    (db:test-get-id testinfo)))
  (if hosts (set! hosts (string-split hosts)))
    ;; set the megatest to be called on the remote host
    (if (not remote-megatest)(set! remote-megatest local-megatest)) ;; "megatest"))
    (set! mt-bindir-path (pathname-directory remote-megatest))
    (if launcher (set! launcher (string-split launcher)))
    ;; set up the run work area for this test
    (set! diskpath (get-best-disk *configdat*))
︙

Modified megatest.scm from [58ffc597e0] to [f3f42fd5f0].

︙
625
626
627
628
629
630
631
632


633
634
635
636
637
638
639

625
626
627
628
629
630
631

632
633
634
635
636
637
638
639
640








-
+
+








	  (set! db (open-db))
	  (if (not (args:get-arg "-server"))
	      (server:client-setup db))
	  (if (args:get-arg "-load-test-data")
	      ;; has sub commands that are rdb:
	      (db:load-test-data db test-id))
	  (if (args:get-arg "-setlog")
	      (rtests:test-set-log! db test-id (args:get-arg "-setlog")))
	      (let ((logfname (args:get-arg "-setlog")))
		(rdb:test-set-log! db test-id logfname)))
	  (if (args:get-arg "-set-toplog")
	      (rtests:test-set-toplog! db run-id test-name (args:get-arg "-set-toplog")))
	  (if (args:get-arg "-summarize-items")
	      (rdb:tests:summarize-items db run-id test-name #t)) ;; do force here
	  (if (args:get-arg "-runstep")
	      (if (null? remargs)
		  (begin
︙

Modified tests.scm from [18d52e02c6] to [ae091a19dc].

︙
398
399
400
401
402
403
404
405
406

398
399
400
401
402
403
404

405








-



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

Modified tests/Makefile from [7122e40641] to [1e23804995]. 

1
2
3
4
5
6
7



8
9
10
11
12

13
14
15

16
17
18

19
20
21
22
23
24
25

1
2
3
4
5
6

7
8
9
10
11
12
13

14
15
16

17
18
19

20
21
22
23
24
25
26
27







-
+
+
+




-
+


-
+


-
+








# run some tests

BINPATH=$(shell realpath ../bin)
MEGATEST=$(BINPATH)/megatest
PATH := $(BINPATH):$(PATH)
RUNNAME := $(shell date +w%V.%u.%H)
IPADDR :="-"
IPADDR := "-"
# Set SERVER to "-server $(IPADDR)"
SERVER := ""

runall : test1 test2

test1 : cleanprep
	$(MEGATEST) -runtests ez_pass -target ubuntu/nfs/none :runname $(RUNNAME)_a -server $(IPADDR)
	$(MEGATEST) -runtests ez_pass -target ubuntu/nfs/none :runname $(RUNNAME)_a $(SERVER)

test2 : cleanprep
	$(MEGATEST) -runtests runfirst -target ubuntu/nfs/none :runname $(RUNNAME)_b  -server $(IPADDR) -debug 10
	$(MEGATEST) -runtests runfirst -target ubuntu/nfs/none :runname $(RUNNAME)_b  $(SERVER) -debug 10

test3 : cleanprep
	$(MEGATEST) -runall -target ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v -server $(IPADDR) 
	$(MEGATEST) -runall -target ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(SERVER)

cleanprep : ../*.scm
	sqlite3 megatest.db "delete from metadat where var='SERVER';"
	mkdir -p /tmp/mt_runs /tmp/mt_links
	cd ..;make
	@sleep 1
	@if ps -def |awk '{print $8}'|grep megatest; then \
︙

Modified tests/megatest.config from [75d2bf7273] to [58f01c3e22].

︙
18
19
20
21
22
23
24
25
26


27
28
29
30
31
32
33

18
19
20
21
22
23
24


25
26
27
28
29
30
31
32
33








-
-
+
+









## use "xterm -e csi -- " as a launcher to examine the launch environment.
## exit with (exit)
## get a shell with (system "bash")
# launcher xterm -e csi --

[validvalues]
state start end completed 0
status pass fail n/a 0 1
state start end 
status pass fail n/a 0 1 running

# These are set before all tests, override them 
# in the testconfig [pre-launch-env-overrides] section
[env-override]
SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs
TESTVAR [system realpath .]
DEADVAR [system ls]
︙

Modified utils/mt_ezstep from [dc6e288c61] to [d882ace026]. 

1
2


3
4

5
6
7
8
9
10
11
12
13





14
15
16
17
18
19
20

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28



+
+


+









+
+
+
+
+








#!/bin/bash

usage="mt_ezstep stepname prevstepname command [args ...]"

if [ "$MT_CMDINFO" == "" ];then
  echo "ERROR: $0 should be run within a megatest test environment"
  echo "Usage: $usage"
  exit
fi

# Purpose: This is for the [ezsteps] secton in your testconfig file.
#   DO NOT USE IN YOUR SCRIPTS!
#
# Call like this:
# mt_ezstep stepname prevstepname command ....
# 
if [ "x$1" == "x" ];then
  echo "Usage: $usage"
  exit
fi

stepname=$1;shift
prevstepname=$1;shift

command=$*

allstatus=99
runstatus=99
︙

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