Index: db.scm ================================================================== --- db.scm +++ db.scm @@ -2443,18 +2443,19 @@ (remfields (list "id" "runname" "state" "status" "owner" "event_time" "comment" "fail_count" "pass_count" "contour")) ;; "area_id")) (header (append keys remfields)) (keystr (conc (keys->keystr keys) "," (string-intersperse remfields ",")))) (debug:print-info 11 *default-log-port* "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr) + (db:with-db dbstruct #f #f (lambda (db) (sqlite3:for-each-row (lambda (a . x) (set! res (apply vector a x))) db - (conc "SELECT " keystr " FROM runs WHERE id=? AND state != 'deleted';") + (conc "SELECT " keystr " FROM runs WHERE id=?;") run-id))) (debug:print-info 11 *default-log-port* "db:get-run-info run-id: " run-id " header: " header " keystr: " keystr) (let ((finalres (vector header res))) ;; (hash-table-set! *run-info-cache* run-id finalres) finalres))) Index: mt-pg.sql ================================================================== --- mt-pg.sql +++ mt-pg.sql @@ -21,10 +21,14 @@ DROP TABLE IF EXISTS test_data; DROP TABLE IF EXISTS test_rundat; DROP TABLE IF EXISTS archives; DROP TABLE IF EXISTS session_vars; DROP TABLE IF EXISTS sessions; +DROP TABLE IF EXISTS tags; +DROP TABLE IF EXISTS users; +DROP TABLE IF EXISTS webviews; +DROP TABLE IF EXISTS area_tags; CREATE TABLE IF NOT EXISTS session_vars ( id SERIAL PRIMARY KEY, session_id INTEGER, page TEXT, Index: tasks.scm ================================================================== --- tasks.scm +++ tasks.scm @@ -733,26 +733,26 @@ ;; (define (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info) (let* ((runs-ht (hash-table-ref cached-info 'runs)) (runinf (hash-table-ref/default runs-ht run-id #f)) (area-id (vector-ref area-info 0))) - (if runinf + (if runinf runinf ;; already cached (let* ((run-dat (rmt:get-run-info run-id)) ;; NOTE: get-run-info returns a vector < row header > (run-name (rmt:get-run-name-from-id run-id)) (row (db:get-rows run-dat)) ;; yes, this returns a single row (header (db:get-header run-dat)) - (state (db:get-value-by-header row header "state ")) + (state (db:get-value-by-header row header "state")) (status (db:get-value-by-header row header "status")) (owner (db:get-value-by-header row header "owner")) (event-time (db:get-value-by-header row header "event_time")) (comment (db:get-value-by-header row header "comment")) (fail-count (db:get-value-by-header row header "fail_count")) (pass-count (db:get-value-by-header row header "pass_count")) (db-contour (db:get-value-by-header row header "contour")) (contour (if (args:get-arg "-prepend-contour") - (if (> (string-length db-contour) 0) + (if db-contour db-contour (args:get-arg "-contour")))) (keytarg (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target")) (conc "MT_CONTOUR/MT_AREA/" (string-intersperse (rmt:get-keys) "/")) (string-intersperse (rmt:get-keys) "/"))) ;; e.g. version/iteration/platform (target (if (or (args:get-arg "-prepend-contour") (args:get-arg "-prefix-target")) @@ -759,29 +759,33 @@ (conc (or (args:get-arg "-prefix-target") (conc contour "/" (common:get-area-name) "/")) (rmt:get-target run-id)) (rmt:get-target run-id))) ;; e.g. v1.63/a3e1/ubuntu (spec-id (pgdb:get-ttype dbh keytarg)) (new-run-id (pgdb:get-run-id dbh spec-id target run-name area-id)) ;; (area-id (db:get-value-by-header row header "area_id)")) ) - (if new-run-id + (if new-run-id (begin ;; let ((run-record (pgdb:get-run-info dbh new-run-id)) (hash-table-set! runs-ht run-id new-run-id) ;; ensure key fields are up to date (pgdb:refresh-run-info dbh new-run-id state status owner event-time comment fail-count pass-count area-id) new-run-id) - (if (handle-exceptions + (if (equal? state "deleted") + (begin + (print "Warning: Run with id " run-id " was created after previous sync and deleted before the sync") #f) + (if (handle-exceptions exn (begin (print-call-chain) (print ((condition-property-accessor 'exn 'message) exn)) #f) - (pgdb:insert-run + + (pgdb:insert-run dbh spec-id target run-name state status owner event-time comment fail-count pass-count area-id)) (tasks:run-id->mtpg-run-id dbh cached-info run-id area-info) - #f)))))) + #f))))))) (define (tasks:sync-test-steps dbh cached-info test-step-ids) (let ((test-ht (hash-table-ref cached-info 'tests)) (step-ht (hash-table-ref cached-info 'steps))) @@ -861,10 +865,11 @@ (define (tasks:sync-tests-data dbh cached-info test-ids area-info) (let ((test-ht (hash-table-ref cached-info 'tests))) (for-each (lambda (test-id) + (print test-id) (let* ((test-info (rmt:get-test-info-by-id #f test-id)) (run-id (db:test-get-run_id test-info)) ;; look these up in db_records.scm (test-id (db:test-get-id test-info)) (test-name (db:test-get-testname test-info)) (item-path (db:test-get-item-path test-info)) Index: utils/installall.sh ================================================================== --- utils/installall.sh +++ utils/installall.sh @@ -37,12 +37,12 @@ echo echo "Set additional_libpath to help find gtk or other libraries, don't forget a leading :" SYSTEM_TYPE=$(lsb_release -irs |tr ' ' '_' |tr '\n' '-')$(uname -i)-$OPTION -CHICKEN_VERSION=4.12.0 -CHICKEN_BASEVER=4.12.0 +CHICKEN_VERSION=4.10.0 +CHICKEN_BASEVER=4.10.0 # Set up variables # case $SYSTEM_TYPE in Ubuntu-17.04-x86_64-std)