Check-in [39b53fe321]
Not logged in
Overview
SHA1 Hash:39b53fe321dfcd3f442630ecc27feb7d851af079
Date: 2012-03-25 14:41:27
User: matt
Comment:Fixed updating of test run meta data
Timelines: family | ancestors | descendants | both | trunk
Downloads: Tarball | ZIP archive
Other Links: files | file ages | manifest
Tags And Properties
Changes

Modified db.scm from [64f23143e9346f51] to [d9dab9adc2a913ed].

646 646 647 (define (db:updater db) 647 (define (db:updater db) 648 (let loop ((start-time (current-time))) 648 (let loop ((start-time (current-time))) 649 (thread-sleep! 0.5) ;; move save time around to minimize regular collisions? 649 (thread-sleep! 0.5) ;; move save time around to minimize regular collisions? 650 (db:write-cached-data db) 650 (db:write-cached-data db) 651 (loop start-time))) 651 (loop start-time))) 652 652 653 (define (db:test-update-meta-info db run-id test-name item-path minutes cpuload | 653 (define (db:test-update-meta-info db test-id minutes cpuload diskfree tmpfree) 654 (if (not item-path) < 655 (begin (debug:print 0 "WARNING: ITEMPATH not set.") < 656 (set! item-path ""))) < 657 (mutex-lock! *incoming-mutex*) 654 (mutex-lock! *incoming-mutex*) 658 (set! *incoming-data* (cons (vector 'meta-info 655 (set! *incoming-data* (cons (vector 'meta-info 659 (current-seconds) 656 (current-seconds) 660 (list cpuload 657 (list cpuload 661 diskfree 658 diskfree 662 minutes 659 minutes 663 run-id < 664 test-name < 665 item-path)) ;; run-id test-name item | 660 test-id)) ;; run-id test-name item-p 666 *incoming-data*)) 661 *incoming-data*)) 667 (mutex-unlock! *incoming-mutex*) 662 (mutex-unlock! *incoming-mutex*) > 663 (if *cache-on* > 664 (debug:print 6 "INFO: *cache-on* is " *cache-on* ", skipping cache write a 668 (if (not *cache-on*)(db:write-cached-data db))) | 665 (db:write-cached-data db))) 669 666 670 (define (db:write-cached-data db) 667 (define (db:write-cached-data db) 671 (let ((meta-stmt (sqlite3:prepare db "UPDATE tests SET cpuload=?,diskfree=?,ru | 668 (let ((meta-stmt (sqlite3:prepare db "UPDATE tests SET cpuload=?,diskfree=?,ru 672 (step-stmt (sqlite3:prepare db "INSERT OR REPLACE into test_steps (test_ 669 (step-stmt (sqlite3:prepare db "INSERT OR REPLACE into test_steps (test_ 673 (data (sort *incoming-data* (lambda (a b)(< (vector-ref a 1)(vector-ref 670 (data (sort *incoming-data* (lambda (a b)(< (vector-ref a 1)(vector-ref 674 (if (> (length data) 0) 671 (if (> (length data) 0) 675 (debug:print 4 "Writing cached data " data)) 672 (debug:print 4 "Writing cached data " data)) 676 (mutex-lock! *incoming-mutex*) 673 (mutex-lock! *incoming-mutex*) 677 (sqlite3:with-transaction 674 (sqlite3:with-transaction 678 db 675 db ................................................................................................................................................................................ 1139 (if *runremote* 1136 (if *runremote* 1140 (let ((host (vector-ref *runremote* 0)) 1137 (let ((host (vector-ref *runremote* 0)) 1141 (port (vector-ref *runremote* 1))) 1138 (port (vector-ref *runremote* 1))) 1142 ((rpc:procedure 'rdb:teststep-set-status! host port) 1139 ((rpc:procedure 'rdb:teststep-set-status! host port) 1143 test-id teststep-name state-in status-in item-path comment logfile)) 1140 test-id teststep-name state-in status-in item-path comment logfile)) 1144 (db:teststep-set-status! db test-id teststep-name state-in status-in ite 1141 (db:teststep-set-status! db test-id teststep-name state-in status-in ite 1145 1142 1146 (define (rdb:test-update-meta-info db run-id test-name itemdat minutes cpuload d | 1143 (define (rdb:test-update-meta-info db test-id minutes cpuload diskfree tmpfree) 1147 (let ((item-path (item-list->path itemdat))) < 1148 (if *runremote* | 1144 (if *runremote* 1149 (let ((host (vector-ref *runremote* 0)) | 1145 (let ((host (vector-ref *runremote* 0)) 1150 (port (vector-ref *runremote* 1))) | 1146 (port (vector-ref *runremote* 1))) 1151 ((rpc:procedure 'rdb:test-update-meta-info host port) | 1147 ((rpc:procedure 'rdb:test-update-meta-info host port) 1152 run-id test-name item-path minutes cpuload diskfree tmpfree)) | 1148 test-id minutes cpuload diskfree tmpfree)) 1153 (db:test-update-meta-info db run-id test-name item-path minutes cpuload | 1149 (db:test-update-meta-info db test-id minutes cpuload diskfree tmpfree))) 1154 1150 1155 (define (rdb:test-set-state-status-by-run-id-testname db run-id test-name item-p 1151 (define (rdb:test-set-state-status-by-run-id-testname db run-id test-name item-p 1156 (if *runremote* 1152 (if *runremote* 1157 (let ((host (vector-ref *runremote* 0)) 1153 (let ((host (vector-ref *runremote* 0)) 1158 (port (vector-ref *runremote* 1))) 1154 (port (vector-ref *runremote* 1))) 1159 ((rpc:procedure 'rdb:test-set-state-status-by-run-id-testname host port) 1155 ((rpc:procedure 'rdb:test-set-state-status-by-run-id-testname host port) 1160 run-id test-name item-path status state)) 1156 run-id test-name item-path status state))

Modified launch.scm from [587849e94b49d432] to [2790622feb53bb52].

62 (runname (assoc/default 'runname cmdinfo)) 62 (runname (assoc/default 'runname cmdinfo)) 63 (megatest (assoc/default 'megatest cmdinfo)) 63 (megatest (assoc/default 'megatest cmdinfo)) 64 (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo)) 64 (mt-bindir-path (assoc/default 'mt-bindir-path cmdinfo)) 65 (fullrunscript (if runscript (conc testpath "/" runscript) #f)) 65 (fullrunscript (if runscript (conc testpath "/" runscript) #f)) 66 (db #f) 66 (db #f) 67 (rollup-status 0)) 67 (rollup-status 0)) 68 68 69 (debug:print 2 "Exectuing " test-name " on " (get-host-name)) | 69 (debug:print 2 "Exectuing " test-name " (id: " test-id ") on " (get-ho 70 (change-directory testpath) 70 (change-directory testpath) 71 ;; apply pre-overrides before other variables. The pre-override vars m 71 ;; apply pre-overrides before other variables. The pre-override vars m 72 ;; clobbers things from the official sources such as megatest.config a 72 ;; clobbers things from the official sources such as megatest.config a 73 (if (string? set-vars) 73 (if (string? set-vars) 74 (let ((varpairs (string-split set-vars ","))) 74 (let ((varpairs (string-split set-vars ","))) 75 (debug:print 4 "varpairs: " varpairs) 75 (debug:print 4 "varpairs: " varpairs) 76 (map (lambda (varpair) 76 (map (lambda (varpair) ................................................................................................................................................................................ 92 (begin 92 (begin 93 (debug:print 0 "Failed to setup, exiting") 93 (debug:print 0 "Failed to setup, exiting") 94 (exit 1))) 94 (exit 1))) 95 ;; now can find our db 95 ;; now can find our db 96 (set! db (open-db)) 96 (set! db (open-db)) 97 (if (not (args:get-arg "-server")) 97 (if (not (args:get-arg "-server")) 98 (server:client-setup db)) 98 (server:client-setup db)) 99 (set! *cache-on* #t) | 99 ;; (set! *cache-on* #t) 100 (set-megatest-env-vars db run-id) ;; these may be needed by the launch 100 (set-megatest-env-vars db run-id) ;; these may be needed by the launch 101 (change-directory work-area) 101 (change-directory work-area) 102 (set-run-config-vars db run-id) 102 (set-run-config-vars db run-id) 103 ;; environment overrides are done *before* the remaining critical enva 103 ;; environment overrides are done *before* the remaining critical enva 104 (alist->env-vars env-ovrd) 104 (alist->env-vars env-ovrd) 105 (set-megatest-env-vars db run-id) 105 (set-megatest-env-vars db run-id) 106 (set-item-env-vars itemdat) 106 (set-item-env-vars itemdat) ................................................................................................................................................................................ 258 (diskfree (get-df (current-directory 258 (diskfree (get-df (current-directory 259 (tmpfree (get-df "/tmp"))) 259 (tmpfree (get-df "/tmp"))) 260 (if (not (args:get-arg "-server")) 260 (if (not (args:get-arg "-server")) 261 (server:client-setup db)) 261 (server:client-setup db)) 262 (if (not cpuload) (begin (debug:print 0 262 (if (not cpuload) (begin (debug:print 0 263 (if (not diskfree) (begin (debug:print 0 263 (if (not diskfree) (begin (debug:print 0 264 (set! kill-job? (test-get-kill-request db 264 (set! kill-job? (test-get-kill-request db 265 (rdb:test-update-meta-info db run-id test | 265 (rdb:test-update-meta-info db test-id min 266 (if kill-job? 266 (if kill-job? 267 (begin 267 (begin 268 (mutex-lock! m) 268 (mutex-lock! m) 269 (let* ((pid (vector-ref exit-info 0 269 (let* ((pid (vector-ref exit-info 0 270 (if (number? pid) 270 (if (number? pid) 271 (begin 271 (begin 272 (debug:print 0 "WARNING: Re 272 (debug:print 0 "WARNING: Re ................................................................................................................................................................................ 434 ;; 4. remotely run the test on allocated host 434 ;; 4. remotely run the test on allocated host 435 ;; - could be ssh to host from hosts table (update regularly with load) 435 ;; - could be ssh to host from hosts table (update regularly with load) 436 ;; - could be netbatch 436 ;; - could be netbatch 437 ;; (launch-test db (cadr status) test-conf)) 437 ;; (launch-test db (cadr status) test-conf)) 438 (define (launch-test db run-id runname test-conf keyvallst test-name test-path i 438 (define (launch-test db run-id runname test-conf keyvallst test-name test-path i 439 (change-directory *toppath*) 439 (change-directory *toppath*) 440 (let* ((useshell (config-lookup *configdat* "jobtools" "useshell")) 440 (let* ((useshell (config-lookup *configdat* "jobtools" "useshell")) 441 (launcher (config-lookup *configdat* "jobtools" "launcher")) | 441 (launcher (config-lookup *configdat* "jobtools" "launcher")) 442 (runscript (config-lookup test-conf "setup" "runscript")) | 442 (runscript (config-lookup test-conf "setup" "runscript")) 443 (ezsteps (> (length (hash-table-ref/default test-conf "ezsteps" '())) | 443 (ezsteps (> (length (hash-table-ref/default test-conf "ezsteps" '()) 444 (diskspace (config-lookup test-conf "requirements" "diskspace")) | 444 (diskspace (config-lookup test-conf "requirements" "diskspace")) 445 (memory (config-lookup test-conf "requirements" "memory")) | 445 (memory (config-lookup test-conf "requirements" "memory")) 446 (hosts (config-lookup *configdat* "jobtools" "workhosts")) | 446 (hosts (config-lookup *configdat* "jobtools" "workhosts")) 447 (remote-megatest (config-lookup *configdat* "setup" "executable")) | 447 (remote-megatest (config-lookup *configdat* "setup" "executable")) 448 ;; FIXME SOMEDAY: not good how this is so obtuse, this hack is to | 448 ;; FIXME SOMEDAY: not good how this is so obtuse, this hack is to 449 ;; allow running from dashboard. Extract the path | 449 ;; allow running from dashboard. Extract the path 450 ;; from the called megatest and convert dashboard | 450 ;; from the called megatest and convert dashboard 451 ;; or dboard to megatest | 451 ;; or dboard to megatest 452 (local-megatest (let* ((lm (car (argv))) | 452 (local-megatest (let* ((lm (car (argv))) 453 (dir (pathname-directory lm)) | 453 (dir (pathname-directory lm)) 454 (exe (pathname-strip-directory lm))) | 454 (exe (pathname-strip-directory lm))) 455 (conc (if dir (conc dir "/") "") | 455 (conc (if dir (conc dir "/") "") 456 (case (string->symbol exe) | 456 (case (string->symbol exe) 457 ((dboard) "megatest") | 457 ((dboard) "megatest") 458 ((dashboard) "megatest") | 458 ((dashboard) "megatest") 459 (else exe))))) | 459 (else exe))))) 460 (test-sig (conc test-name ":" (item-list->path itemdat))) ;; test-path | 460 (test-sig (conc test-name ":" (item-list->path itemdat))) ;; test-pat 461 (work-area #f) | 461 (work-area #f) 462 (toptest-work-area #f) ;; for iterated tests the top test contains data | 462 (toptest-work-area #f) ;; for iterated tests the top test contains data 463 (diskpath #f) | 463 (diskpath #f) 464 (cmdparms #f) | 464 (cmdparms #f) 465 (fullcmd #f) ;; (define a (with-output-to-string (lambda ()(write x)) | 465 (fullcmd #f) ;; (define a (with-output-to-string (lambda ()(write x) 466 (mt-bindir-path #f) | 466 (mt-bindir-path #f) 467 (item-path (item-list->path itemdat)) | 467 (item-path (item-list->path itemdat)) 468 (testinfo (rdb:get-test-info db run-id test-name item-path)) | 468 (testinfo (rdb:get-test-info db run-id test-name item-path)) 469 (test-id (db:test-get-id testinfo))) | 469 (test-id (db:test-get-id testinfo))) 470 (if hosts (set! hosts (string-split hosts))) 470 (if hosts (set! hosts (string-split hosts))) 471 ;; set the megatest to be called on the remote host 471 ;; set the megatest to be called on the remote host 472 (if (not remote-megatest)(set! remote-megatest local-megatest)) ;; "megatest 472 (if (not remote-megatest)(set! remote-megatest local-megatest)) ;; "megatest 473 (set! mt-bindir-path (pathname-directory remote-megatest)) 473 (set! mt-bindir-path (pathname-directory remote-megatest)) 474 (if launcher (set! launcher (string-split launcher))) 474 (if launcher (set! launcher (string-split launcher))) 475 ;; set up the run work area for this test 475 ;; set up the run work area for this test 476 (set! diskpath (get-best-disk *configdat*)) 476 (set! diskpath (get-best-disk *configdat*))

Modified megatest.scm from [58ffc597e072ad12] to [f3f42fd5f01c5212].

625 (set! db (open-db)) 625 (set! db (open-db)) 626 (if (not (args:get-arg "-server")) 626 (if (not (args:get-arg "-server")) 627 (server:client-setup db)) 627 (server:client-setup db)) 628 (if (args:get-arg "-load-test-data") 628 (if (args:get-arg "-load-test-data") 629 ;; has sub commands that are rdb: 629 ;; has sub commands that are rdb: 630 (db:load-test-data db test-id)) 630 (db:load-test-data db test-id)) 631 (if (args:get-arg "-setlog") 631 (if (args:get-arg "-setlog") 632 (rtests:test-set-log! db test-id (args:get-arg "-setlog"))) | 632 (let ((logfname (args:get-arg "-setlog"))) > 633 (rdb:test-set-log! db test-id logfname))) 633 (if (args:get-arg "-set-toplog") 634 (if (args:get-arg "-set-toplog") 634 (rtests:test-set-toplog! db run-id test-name (args:get-arg "-set-t 635 (rtests:test-set-toplog! db run-id test-name (args:get-arg "-set-t 635 (if (args:get-arg "-summarize-items") 636 (if (args:get-arg "-summarize-items") 636 (rdb:tests:summarize-items db run-id test-name #t)) ;; do force he 637 (rdb:tests:summarize-items db run-id test-name #t)) ;; do force he 637 (if (args:get-arg "-runstep") 638 (if (args:get-arg "-runstep") 638 (if (null? remargs) 639 (if (null? remargs) 639 (begin 640 (begin

Modified tests.scm from [18d52e02c6056e6f] to [ae091a19dca7e5b5].

398 398 399 (define (rtests:test-set-toplog! db run-id test-name logf) 399 (define (rtests:test-set-toplog! db run-id test-name logf) 400 (if *runremote* 400 (if *runremote* 401 (let ((host (vector-ref *runremote* 0)) 401 (let ((host (vector-ref *runremote* 0)) 402 (port (vector-ref *runremote* 1))) 402 (port (vector-ref *runremote* 1))) 403 ((rpc:procedure 'rtests:test-set-toplog! host port) run-id test-name log 403 ((rpc:procedure 'rtests:test-set-toplog! host port) run-id test-name log 404 (test-set-toplog! db run-id test-name logf))) 404 (test-set-toplog! db run-id test-name logf))) 405 < 406 405

Modified tests/Makefile from [7122e406414be480] to [1e238049954caf42].

1 # run some tests 1 # run some tests 2 2 3 BINPATH=$(shell realpath ../bin) 3 BINPATH=$(shell realpath ../bin) 4 MEGATEST=$(BINPATH)/megatest 4 MEGATEST=$(BINPATH)/megatest 5 PATH := $(BINPATH):$(PATH) 5 PATH := $(BINPATH):$(PATH) 6 RUNNAME := $(shell date +w%V.%u.%H) 6 RUNNAME := $(shell date +w%V.%u.%H) 7 IPADDR :="-" | 7 IPADDR := "-" > 8 # Set SERVER to "-server $(IPADDR)" > 9 SERVER := "" 8 10 9 runall : test1 test2 11 runall : test1 test2 10 12 11 test1 : cleanprep 13 test1 : cleanprep 12 $(MEGATEST) -runtests ez_pass -target ubuntu/nfs/none :runname $(RUNNAME | 14 $(MEGATEST) -runtests ez_pass -target ubuntu/nfs/none :runname $(RUNNAME 13 15 14 test2 : cleanprep 16 test2 : cleanprep 15 $(MEGATEST) -runtests runfirst -target ubuntu/nfs/none :runname $(RUNNAM | 17 $(MEGATEST) -runtests runfirst -target ubuntu/nfs/none :runname $(RUNNAM 16 18 17 test3 : cleanprep 19 test3 : cleanprep 18 $(MEGATEST) -runall -target ubuntu/nfs/none :runname $(RUNNAME)_b -m "Th | 20 $(MEGATEST) -runall -target ubuntu/nfs/none :runname $(RUNNAME)_b -m "Th 19 21 20 cleanprep : ../*.scm 22 cleanprep : ../*.scm 21 sqlite3 megatest.db "delete from metadat where var='SERVER';" 23 sqlite3 megatest.db "delete from metadat where var='SERVER';" 22 mkdir -p /tmp/mt_runs /tmp/mt_links 24 mkdir -p /tmp/mt_runs /tmp/mt_links 23 cd ..;make 25 cd ..;make 24 @sleep 1 26 @sleep 1 25 @if ps -def |awk '{print $8}'|grep megatest; then \ 27 @if ps -def |awk '{print $8}'|grep megatest; then \

Modified tests/megatest.config from [75d2bf7273d2314a] to [58f01c3e22653e95].

18 18 19 ## use "xterm -e csi -- " as a launcher to examine the launch environment. 19 ## use "xterm -e csi -- " as a launcher to examine the launch environment. 20 ## exit with (exit) 20 ## exit with (exit) 21 ## get a shell with (system "bash") 21 ## get a shell with (system "bash") 22 # launcher xterm -e csi -- 22 # launcher xterm -e csi -- 23 23 24 [validvalues] 24 [validvalues] 25 state start end completed 0 | 25 state start end 26 status pass fail n/a 0 1 | 26 status pass fail n/a 0 1 running 27 27 28 # These are set before all tests, override them 28 # These are set before all tests, override them 29 # in the testconfig [pre-launch-env-overrides] section 29 # in the testconfig [pre-launch-env-overrides] section 30 [env-override] 30 [env-override] 31 SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs 31 SPECIAL_ENV_VARS overide them here - should be seen at launch and in the runs 32 TESTVAR [system realpath .] 32 TESTVAR [system realpath .] 33 DEADVAR [system ls] 33 DEADVAR [system ls]

Modified utils/mt_ezstep from [dc6e288c61060e14] to [d882ace026d12446].

1 #!/bin/bash 1 #!/bin/bash 2 2 > 3 usage="mt_ezstep stepname prevstepname command [args ...]" > 4 3 if [ "$MT_CMDINFO" == "" ];then 5 if [ "$MT_CMDINFO" == "" ];then 4 echo "ERROR: $0 should be run within a megatest test environment" 6 echo "ERROR: $0 should be run within a megatest test environment" > 7 echo "Usage: $usage" 5 exit 8 exit 6 fi 9 fi 7 10 8 # Purpose: This is for the [ezsteps] secton in your testconfig file. 11 # Purpose: This is for the [ezsteps] secton in your testconfig file. 9 # DO NOT USE IN YOUR SCRIPTS! 12 # DO NOT USE IN YOUR SCRIPTS! 10 # 13 # 11 # Call like this: 14 # Call like this: 12 # mt_ezstep stepname prevstepname command .... 15 # mt_ezstep stepname prevstepname command .... 13 # 16 # > 17 if [ "x$1" == "x" ];then > 18 echo "Usage: $usage" > 19 exit > 20 fi > 21 14 stepname=$1;shift 22 stepname=$1;shift 15 prevstepname=$1;shift 23 prevstepname=$1;shift 16 24 17 command=$* 25 command=$* 18 26 19 allstatus=99 27 allstatus=99 20 runstatus=99 28 runstatus=99