Overview
Comment: | Merge, needs more clean up |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | v1.60-v1.55-partial-merge |
Files: | files | file ages | folders |
SHA1: |
0b420c6656ffe6277a2fc2765105c9d1 |
User & Date: | matt on 2014-04-02 07:15:57 |
Other Links: | branch diff | manifest | tags |
Context
2014-04-02
| ||
07:15 | Merge, needs more clean up Closed-Leaf check-in: 0b420c6656 user: matt tags: v1.60-v1.55-partial-merge | |
2014-03-30
| ||
01:10 | Merged f8e4 from branch v1.55 into v1.60 check-in: bc0f8a61c7 user: matt tags: v1.60 | |
2014-03-27
| ||
11:14 | Merged sqlite-trials work to v1.55 check-in: 2b3cd8f3ca user: mrwellan tags: v1.55, v1.5516rc2 | |
Changes
Modified dashboard.scm from [289eaba234] to [f68dd2fe09].
︙ | ︙ | |||
163 164 165 166 167 168 169 170 171 172 173 174 175 176 | (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)) (define (message-window msg) (iup:show (iup:dialog (iup:vbox (iup:label msg #:margin "40x40"))))) | > > | 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 [facfabab82].
︙ | ︙ | |||
139 140 141 142 143 144 145 | (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)) (handler (make-busy-timeout 136000))) (if (and dbexists (not write-access)) | | | 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 | (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)) (handler (make-busy-timeout 136000))) (if (and dbexists (not write-access)) (set! *db-write-access* #f)) ;; only unset so other db's lso can use this control (if write-access (begin (if (not dbexists) (begin (db:initialize-run-id-db db) (sqlite3:execute db |
︙ | ︙ | |||
478 479 480 481 482 483 484 | (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 | > > > | > > | | > > | | | | | | | 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 506 507 508 509 510 511 | (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 ((busy) (thread-sleep! sleep-time)) (else (debug:print 0 "EXCEPTION: database probably overloaded or unreadable.") (debug:print 0 " message: " ((condition-property-accessor 'exn 'message) exn)) (print "exn=" (condition->list exn)) (debug:print 0 " status: " ((condition-property-accessor 'sqlite3 'status) exn)) (print-call-chain) (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"))) (apply open-run-close-exception-handling proc idb params)) (apply open-run-close-no-exception-handling proc idb params))) ;; (define open-run-close (define open-run-close open-run-close-exception-handling) ;; open-run-close-no-exception-handling ;; open-run-close-exception-handling) ;;) (define (db:initialize-main-db db) (let* ((configdat (car *configinfo*)) ;; tut tut, global warning... (keys (keys:config-get-fields configdat)) (havekeys (> (length keys) 0)) (keystr (keys->keystr keys)) |
︙ | ︙ | |||
609 610 611 612 613 614 615 616 617 618 619 620 621 622 | 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 ( 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);") | > > | 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);") |
︙ | ︙ | |||
1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 | (> (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)))))))))) (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))) | > > > > > > > > > > > > > > > > > > > > > > > > > | 1983 1984 1985 1986 1987 1988 1989 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 | (> (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 runs.scm from [e243ff4cf9] to [4d37f89e14].
︙ | ︙ | |||
451 452 453 454 455 456 457 | ;; (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 | > > | | | | > | | 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 478 479 | ;; (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)) (for-each (lambda (prereq) (if (eq? (hash-table-ref/default test-registry prereq 'justfine) 'CANNOTRUN) (set! give-up #t))) prereqstrs)) (if (and give-up (not (and (null? tal)(null? reg)))) (let ((trimmed-tal (mt:discard-blocked-tests run-id hed tal test-records)) (trimmed-reg (mt:discard-blocked-tests run-id hed reg test-records))) (debug:print 1 "WARNING: test " hed " has discarded prerequisites, removing it from the queue") (let ((test-id (rmt:get-test-id run-id hed ""))) (mt:test-set-state-status-by-id test-id "DEQUEUED" "PREQ_FAIL" "Failed to run due to failed prerequisites")) (if (and (null? trimmed-tal) (null? trimmed-reg)) #f (list (runs:queue-next-hed trimmed-tal trimmed-reg reglen regfull) (runs:queue-next-tal trimmed-tal trimmed-reg reglen regfull) (runs:queue-next-reg trimmed-tal trimmed-reg reglen regfull) |
︙ | ︙ |