Overview
Comment: | Merge of v1.55 into v1.60 but too many conflicts, saving on branch confict-merge-v1.60 |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | confict-merge-v1.60 |
Files: | files | file ages | folders |
SHA1: |
70e753f237721b21969a5a8012be0bc7 |
User & Date: | matt on 2014-03-30 01:07:57 |
Other Links: | branch diff | manifest | tags |
Context
2014-03-30
| ||
01:07 | Merge of v1.55 into v1.60 but too many conflicts, saving on branch confict-merge-v1.60 Closed-Leaf check-in: 70e753f237 user: matt tags: confict-merge-v1.60 | |
2014-03-29
| ||
19:11 | Increased retries in client:start to 100, minor edits? check-in: 18d165c8c7 user: matt tags: v1.60 | |
13:31 | Improved an error message check-in: aa13991ded user: matt tags: v1.55 | |
Changes
Modified Makefile from [ed1f2297ca] to [e9add66050].
︙ | |||
25 26 27 28 29 30 31 | 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 | - + | CKPATH=$(shell dirname $(shell dirname $(CSIPATH))) # ARCHSTR=$(shell uname -m)_$(shell uname -r) # BASH_MACHTYPE=$(shell bash -c "echo \$$MACHTYPE") # ARCHSTR=$(BASH_MACHTYPE)_$(shell lsb_release -sr) ARCHSTR=$(shell lsb_release -sr) # ARCHSTR=$(shell bash -c "echo \$$MACHTYPE") |
︙ |
Modified common.scm from [f2071ae50f] to [c74c09ea7d].
︙ | |||
232 233 234 235 236 237 238 239 240 241 242 243 244 245 | 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 | + + + + + + + + + + + + + + + + + + + + + + + + + | #f #t))) string<?)) ;; '(print (string-intersperse (map cadr (hash-table-ref/default (read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))' (define (common:get-disks) (hash-table-ref/default (read-config "megatest.config" #f #t) "disks" '("none" ""))) ;;====================================================================== ;; T A R G E T S ;;====================================================================== (define (common:args-get-target #!key (split #f)) (let* ((target (if (args:get-arg "-reqtarg") (args:get-arg "-reqtarg") (if (args:get-arg "-target") (args:get-arg "-target") #f))) (tlist (if target (string-split target "/" #t) '())) (valid (if target (and (not (null? tlist)) (null? (filter string-null? tlist))) #f))) (if valid (if split tlist target) (if target (begin (debug:print 0 "ERROR: Invalid target, spaces or blanks not allowed \"" target "\"") #f) #f)))) ;;====================================================================== ;; M I S C L I S T S ;;====================================================================== ;; items in lista are matched value and position in listb ;; return the remaining items in listb or #f |
︙ | |||
358 359 360 361 362 363 364 | 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 | - + - - - - + + + + + + - - - - + + + + + + | (define (get-uname . params) (let* ((uname-res (cmd-run->list (conc "uname " (if (null? params) "-a" (car params))))) (uname #f)) (if (null? (car uname-res)) "unknown" (caar uname-res)))) |
︙ |
Modified common_records.scm from [8d360e8ca7] to [785b03b237].
1 2 3 4 5 6 7 8 9 10 11 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 | - + | ;;====================================================================== ;; Copyright 2006-2012, Matthew Welland. ;; ;; This program is made available under the GNU GPL version 2.0 or ;; greater. See the accompanying file COPYING for details. ;; ;; This program is distributed WITHOUT ANY WARRANTY; without even the ;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR ;; PURPOSE. ;;====================================================================== |
︙ |
Modified dashboard.scm from [289eaba234] to [f68dd2fe09].
︙ | |||
163 164 165 166 167 168 169 170 171 172 173 174 175 176 | 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 | + + | (define uidat #f) (define-inline (dboard:uidat-get-keycol vec)(vector-ref vec 0)) (define-inline (dboard:uidat-get-lftcol vec)(vector-ref vec 1)) (define-inline (dboard:uidat-get-header vec)(vector-ref vec 2)) (define-inline (dboard:uidat-get-runsvec vec)(vector-ref vec 3)) (if (get-environment-variable "MT_RUN_AREA_HOME")(change-directory (get-environment-variable "MT_RUN_AREA_HOME"))) (define (message-window msg) (iup:show (iup:dialog (iup:vbox (iup:label msg #:margin "40x40"))))) |
︙ |
Modified db.scm from [82609fed05] to [0253d08df7].
︙ | |||
137 138 139 140 141 142 143 | 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | - + | (let* ((dbpath (db:dbfile-path run-id)) ;; (conc toppath "/db/" run-id ".db")) (dbexists (file-exists? dbpath)) (inmem (if local #f (db:open-inmem-db))) (refdb (if local #f (db:open-inmem-db))) (db (sqlite3:open-database dbpath)) (olddb (db:open-megatest-db)) (write-access (file-write-access? dbpath)) |
︙ | |||
478 479 480 481 482 483 484 | 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 | + + + - - - - - - - + + + + + + + + + + + | (debug:print-info 11 "open-run-close-no-exception-handling END" ) res) #f)) (define (open-run-close-exception-handling proc idb . params) (handle-exceptions exn (let ((sleep-time (random 30)) (err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) (case err-status |
︙ | |||
609 610 611 612 613 614 615 616 617 618 619 620 621 622 | 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 | + + | tol REAL, units TEXT, comment TEXT DEFAULT '', status TEXT DEFAULT 'n/a', type TEXT DEFAULT '', CONSTRAINT test_data_constraint UNIQUE (test_id,category,variable));") (sqlite3:execute db "CREATE TABLE IF NOT EXISTS test_rundat ( ;; Why use FULL here? This data is not that critical ;; (sqlite3:execute db "PRAGMA synchronous = FULL;") id INTEGER PRIMARY KEY, test_id INTEGER, update_time TIMESTAMP, cpuload INTEGER DEFAULT -1, diskfree INTEGER DEFAULT -1, diskusage INTGER DEFAULT -1, run_duration INTEGER DEFAULT 0);") |
︙ | |||
1805 1806 1807 1808 1809 1810 1811 1812 1813 1814 1815 1816 1817 1818 | 1814 1815 1816 1817 1818 1819 1820 1821 1822 1823 1824 1825 1826 1827 1828 1829 1830 1831 1832 1833 1834 | + + + + + + + | (db:general-call db 'top-test-set-running (list test-name)) (db:general-call db 'top-test-set-per-pf-counts (list test-name test-name test-name))) #f) #f)) (define (db:tests-register-test dbstruct run-id test-name item-path) (sqlite3:execute (db:get-db dbstruct run-id) 'register-test run-id test-name item-path)) (let ((sleep-time (random 20)) (err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) (case err-status ((busy)(thread-sleep! 4)) (else (debug:print 0 "WARNING: possible problem with call to cdb:remote-run, database may be read-only and locked, waiting and trying again ...") (thread-sleep! sleep-time))) (define (db:test-get-logfile-info dbstruct run-id test-name) (let ((res #f)) (sqlite3:for-each-row (lambda (path final_logf) ;; (let ((path (sdb:qry 'getstr path-id)) ;; (final_logf (sdb:qry 'getstr final_logf-id))) |
︙ | |||
1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 | 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 2021 2022 2023 2024 2025 2026 2027 2028 | + + + + + + + + + + + + + + + + + + + + + + + + + | (> (db:test-get-event_time testdat)(db:test-get-event_time stored-test)))) ;; this test is younger, store it in the hash (hash-table-set! tests-hash full-testname testdat)))) results) (if (null? tal) (map cdr (hash-table->alist tests-hash)) ;; return a list of the most recent tests (loop (car tal)(cdr tal)))))))))) (let* ((remtries 10) (proc #f)) (set! proc (lambda (remtries) (if (> remtries 0) (handle-exceptions exn (let ((sleep-time (random 30)) (err-status ((condition-property-accessor 'sqlite3 'status #f) exn))) (case err-status ((busy) (thread-sleep! sleep-time) (proc 10)) ;; we never give up on busy (else (debug:print 0 "EXCEPTION: database probably overloaded or unreadable.") (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn)) (debug:print 0 " status: " ((condition-property-accessor 'sqlite3 'status) exn)) (print-call-chain) (debug:print 0 "Sleeping for " sleep-time) (thread-sleep! sleep-time) (debug:print-info 0 "trying db call one more time....this may never recover, if necessary kill process " (current-process-id) " on host " (get-host-name) " to clean up") (proc (- remtries 1))))) (apply sqlite3:execute db query params)) (debug:print 0 "ERROR: too many attempts to access db were made and no sucess. query: " query ", params: " params)))) (proc remtries)) (define (db:test-get-records-for-index-file dbstruct run-id test-name) (let ((res '())) (sqlite3:for-each-row (lambda (id itempath state status run_duration logf-id comment-id) (let ((logf (db:get-string dbstruct logf-id)) (comment (db:get-string dbstruct comment-id))) |
︙ |
Modified launch.scm from [59d0d6772c] to [108aa8951e].
︙ | |||
142 143 144 145 146 147 148 | 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 | - + | (set-run-config-vars run-id keyvals target) ;; (db:get-target db run-id)) ;; environment overrides are done *before* the remaining critical envars. (alist->env-vars env-ovrd) (set-megatest-env-vars run-id inkeys: keys inkeyvals: keyvals) (set-item-env-vars itemdat) (save-environment-as-files "megatest") ;; open-run-close not needed for test-set-meta-info |
︙ | |||
300 301 302 303 304 305 306 | 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 | - + + + - + + + + + - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + - - + + | (calc-minutes (lambda () (inexact->exact (round (- (current-seconds) start-seconds))))) (kill-tries 0)) |
︙ |
Modified megatest.scm from [f4ec5dd5d1] to [5f5a87a965].
︙ | |||
455 456 457 458 459 460 461 | 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 | - + - - - - | ;; (print "[" x "]")) (print x)) targets) (set! *didsomething* #t))) (define (full-runconfigs-read) (let* ((keys (rmt:get-keys)) |
︙ | |||
519 520 521 522 523 524 525 | 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 | - + - | ;; Remove old run(s) ;;====================================================================== ;; since several actions can be specified on the command line the removal ;; is done first (define (operate-on action) (let* ((runrec (runs:runrec-make-record)) |
︙ | |||
566 567 568 569 570 571 572 | 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 | - - + + + | (if (or (args:get-arg "-set-run-status") (args:get-arg "-get-run-status")) (general-run-call "-set-run-status" "set run status" (lambda (target runname keys keyvals) |
︙ | |||
597 598 599 600 601 602 603 | 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 | - - + + | (let* ((dbstruct (make-dbr:dbstruct path: *toppath* local: #t)) (runpatt (args:get-arg "-list-runs")) (testpatt (if (args:get-arg "-testpatt") (args:get-arg "-testpatt") "%")) (keys (db:get-keys dbstruct)) ;; (runsdat (db:get-runs dbstruct runpatt #f #f '())) |
︙ | |||
989 990 991 992 993 994 995 | 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 | - + + + + | (exit 6)) (let* ((stepname (args:get-arg "-runstep")) (logprofile (args:get-arg "-logpro")) (logfile (conc stepname ".log")) (cmd (if (null? remargs) #f (car remargs))) (params (if cmd (cdr remargs) '())) (exitstat #f) |
︙ |
Modified runconfig.scm from [4e3a96ccb1] to [d97360c67a].
︙ | |||
9 10 11 12 13 14 15 | 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | - + - | (declare (uses common)) (include "common_records.scm") (define (setup-env-defaults fname run-id already-seen keyvals #!key (environ-patt #f)(change-env #t)) (let* ((keys (map car keyvals)) (thekey (if keyvals (string-intersperse (map (lambda (x)(if x x "-na-")) (map cadr keyvals)) "/") |
︙ | |||
58 59 60 61 62 63 64 | 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 | - + - | (debug:print 2 "---") (set! *already-seen-runconfig-info* #t))) finaldat)) (define (set-run-config-vars run-id keyvals targ-from-db) (push-directory *toppath*) ;; the push/pop doesn't appear to do anything ... (let ((runconfigf (conc *toppath* "/runconfigs.config")) |
Modified runs.scm from [88c42814b9] to [c22e67eca1].
︙ | |||
41 42 43 44 45 46 47 | 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 | - + - | *configdat* (if (setup-for-run) *configdat* (begin (debug:print 0 "ERROR: Called setup in a non-megatest area, exiting") (exit 1))))) (runrec (runs:runrec-make-record)) |
︙ | |||
88 89 90 91 92 93 94 | 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 | - + - | (set! envdat (append envdat (list varval))) (safe-setenv (car varval)(cadr varval))) (configf:get-section runconfig section))) (list "default" target)) (vector target runname testpatt keys keyvals envdat mconfig runconfig serverdat transport db toppath run-id))) (define (set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f)(inkeyvals #f)) |
︙ | |||
201 202 203 204 205 206 207 | 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 | - - + + | ;; (define (runs:run-tests target runname test-patts user flags) ;; test-names (let* ((keys (keys:config-get-fields *configdat*)) (keyvals (keys:target->keyval keys target)) (run-id (rmt:register-run keyvals runname "new" "n/a" user)) ;; test-name))) (deferred '()) ;; delay running these since they have a waiton clause (runconfigf (conc *toppath* "/runconfigs.config")) |
︙ | |||
395 396 397 398 399 400 401 | 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 | + - - + + | "\n items: " items "\n can-run-more: " can-run-more) (cond ;; all prereqs met, fire off the test ;; or, if it is a 'toplevel test and all prereqs not met are COMPLETED then launch ((and (not (member 'toplevel testmode)) |
︙ | |||
450 451 452 453 454 455 456 | 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 477 | + + - - - - + + + + + - + | ;; (notinqueue (filter (lambda (x) ;; (not (member x allinqueue))) ;; prereqstrs)) (give-up #f)) ;; We can get here when a prereq has not been run due to *it* having a prereq that failed. ;; We need to use this to dequeue this item as CANNOTRUN ;; (if (member testmode '(toplevel)) |
︙ | |||
1384 1385 1386 1387 1388 1389 1390 | 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 | - + - - - - + - - | ;; Routines for manipulating runs ;;====================================================================== ;; Since many calls to a run require pretty much the same setup ;; this wrapper is used to reduce the replication of code (define (general-run-call switchname action-desc proc) (let ((runname (args:get-arg ":runname")) |
︙ |
Modified tests.scm from [6b6e58b833] to [2b62908fb8].
︙ | |||
66 67 68 69 70 71 72 | 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 | - - + + | ;; tests:glob-like-match (define (tests:glob-like-match patt str) (let ((like (substring-index "%" patt))) (let* ((notpatt (equal? (substring-index "~" patt) 0)) (newpatt (if notpatt (substring patt 1) patt)) (finpatt (if like |
︙ | |||
634 635 636 637 638 639 640 | 634 635 636 637 638 639 640 641 642 643 644 645 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 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 | + - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + + + + + + + + + + + + + + | (rmt:general-call 'update-cpuload-diskfree run-id cpuload diskfree test-id) (if minutes (rmt:general-call 'update-run-duration run-id minutes test-id)) (if (and uname hostname) (rmt:general-call 'update-uname-host run-id uname hostname test-id))) ;; This one is for running with no db access (i.e. via rmt: internally) (define (tests:set-full-meta-info db test-id run-id minutes work-area remtries) |
Modified tests/Makefile from [6a1442238d] to [6898a8bdcb].
︙ | |||
58 59 60 61 62 63 64 65 66 67 68 69 70 71 | 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | + + + | @echo Run all_toplevel and all waitons cd fullrun;$(MEGATEST) -runtests all_toplevel -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_c test4 : cleanprep @echo "WARNING: No longer running fullprep, test converage may be lessened" cd fullrun;time $(MEGATEST) -debug $(DEBUG) -runtests % -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(LOGGING) test4a : cleanprep cd fullrun;time $(MEGATEST) -debug $(DEBUG) -runtests all_toplevel -reqtarg ubuntu/nfs/none :runname $(RUNNAME)_b -m "This is a comment specific to a run" -v $(LOGGING) # NOTE: Only one instance can be a server test5 : cleanprep @echo "WARNING: No longer running fullprep, test converage may be lessened" cd fullrun;sleep 0;$(MEGATEST) -runtests % -target $(TARGET) :runname $(RUNNAME)_aa -debug $(DEBUG) $(LOGGING) > aa.log 2> aa.log & cd fullrun;sleep 3;$(MEGATEST) -runtests % -target $(TARGET) :runname $(RUNNAME)_ab -debug $(DEBUG) $(LOGGING) > ab.log 2> ab.log & cd fullrun;sleep 6;$(MEGATEST) -runtests % -target $(TARGET) :runname $(RUNNAME)_ac -debug $(DEBUG) $(LOGGING) > ac.log 2> ac.log & cd fullrun;sleep 9;$(MEGATEST) -runtests % -target $(TARGET) :runname $(RUNNAME)_ad -debug $(DEBUG) $(LOGGING) > ad.log 2> ad.log & |
︙ |
Modified tests/tests.scm from [a780d57ffe] to [ceeda9f906].
︙ | |||
29 30 31 32 33 34 35 36 | 29 30 31 32 33 34 35 36 37 38 39 40 | + + + + | (define *runremote* #f) (let* ((unit-test-name (list-ref (argv) 4)) (fname (conc "../unittests/" unit-test-name ".scm"))) (if (file-exists? fname) (load fname) (print "ERROR: Unit test " unit-test-name " not found in unittests directory"))) (list "abc" "abc/%" "ab%/c%" "~abc/c%" "abc/~c%" "a,b/c,%/d" "%/,%/a" "%/,%/a" "%/,%/a" "%" "%" "%/" "%/" "%abc%") (list "abc" "abc" "abcd" "abc" "abc" "a" "abc" "def" "ghi" "a" "a" "a" "a" "abc") (list "" "" "cde" "cde" "cde" "" "" "a" "b" "" "b" "" "b" "abc") (list #t #t #t #f #f #t #t #t #f #t #t #t #f #t)) |