Check-in [5cecd7e1d4]
Not logged in
Overview
SHA1 Hash:5cecd7e1d48b51fcc10f68dfaa7166694bbf5a4a
Date: 2011-08-11 00:53:10
User: matt
Comment:Added test_meta data populating
Timelines: family | ancestors | descendants | both | rollup-runs
Diffs: root of this branch
Downloads: Tarball | ZIP archive
Other Links: files | file ages | manifest
Tags And Properties
Changes

Modified Makefile from [6c62140a069b7271] to [6d582f371e59c7d0].

1 FILES=$(glob *.scm) 1 FILES=$(glob *.scm) 2 2 3 megatest: common.scm configf.scm db.scm keys.scm launch.scm megatest.scm process 3 megatest: common.scm configf.scm db.scm keys.scm launch.scm megatest.scm process 4 csc megatest.scm 4 csc megatest.scm 5 5 6 dashboard: megatest dashboard.scm dashboard-tests.scm | 6 dashboard: dashboard.scm dashboard-tests.scm 7 csc dashboard.scm 7 csc dashboard.scm 8 8 9 $(PREFIX)/bin/megatest : megatest 9 $(PREFIX)/bin/megatest : megatest 10 @echo Installing to PREFIX=$(PREFIX), use ^C to cancel and change 10 @echo Installing to PREFIX=$(PREFIX), use ^C to cancel and change 11 sleep 5 11 sleep 5 12 cp megatest $(PREFIX)/bin/megatest 12 cp megatest $(PREFIX)/bin/megatest 13 13

Modified configf.scm from [9fba368c47f23947] to [2d522c454ccb1e1a].

85 (let ((newval (conc 85 (let ((newval (conc 86 (config-looku 86 (config-looku 87 ;; trim lead 87 ;; trim lead 88 (if lead 88 (if lead 89 (string-s 89 (string-s 90 "") 90 "") 91 val))) 91 val))) 92 (print "val: " val "\nnewv | 92 ;; (print "val: " val "\nn 93 (hash-table-set! res curr- 93 (hash-table-set! res curr- 94 (config:a 94 (config:a 95 (loop (read-line inp) curr 95 (loop (read-line inp) curr 96 (loop (read-line inp) curr-s 96 (loop (read-line inp) curr-s 97 (else (debug:print 0 "ERROR: problem parsing " path ",\n \"" in 97 (else (debug:print 0 "ERROR: problem parsing " path ",\n \"" in 98 (set! var-flag #f) 98 (set! var-flag #f) 99 (loop (read-line inp) curr-section-name)))))))) | 99 (loop (read-line inp) curr-section-name #f #f)))))))) 100 100 101 (define (find-and-read-config fname) 101 (define (find-and-read-config fname) 102 (let* ((curr-dir (current-directory)) 102 (let* ((curr-dir (current-directory)) 103 (configinfo (find-config fname)) 103 (configinfo (find-config fname)) 104 (toppath (car configinfo)) 104 (toppath (car configinfo)) 105 (configfile (cadr configinfo))) 105 (configfile (cadr configinfo))) 106 (if toppath (change-directory toppath)) 106 (if toppath (change-directory toppath))

Modified db.scm from [b3bfe37375138bd3] to [d996c6fe14e81ea7].

78 comment TEXT DEFAULT '', 78 comment TEXT DEFAULT '', 79 CONSTRAINT test_steps_constraint UNIQUE (test_id, 79 CONSTRAINT test_steps_constraint UNIQUE (test_id, 80 (sqlite3:execute db "CREATE TABLE extradat (id INTEGER PRIMARY KEY, ru 80 (sqlite3:execute db "CREATE TABLE extradat (id INTEGER PRIMARY KEY, ru 81 (sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var 81 (sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var 82 CONSTRAINT metadat_constraint UNIQUE (id,var)) 82 CONSTRAINT metadat_constraint UNIQUE (id,var)) 83 (db:set-var db "MEGATEST_VERSION" megatest-version) 83 (db:set-var db "MEGATEST_VERSION" megatest-version) 84 (sqlite3:execute db "CREATE TABLE access_log (id INTEGER PRIMARY KEY, 84 (sqlite3:execute db "CREATE TABLE access_log (id INTEGER PRIMARY KEY, 85 (sqlite3:execute db "CREATE TABLE test_meta (id INTEGER PRIMARY KEY, | 85 (patch-db db))) 86 testname TEXT DEFAULT '', < 87 author TEXT DEFAULT '', < 88 owner TEXT DEFAULT '', < 89 description TEXT DEFAULT '', < 90 reviewed TIMESTAMP, < 91 iterated TEXT DEFAULT '', < 92 avg_runtime REAL, < 93 avg_disk REAL, < 94 CONSTRAINT test_meta_contstraint UNIQUE (id,test < 95 < 96 )) < 97 db)) 86 db)) 98 87 99 ;;====================================================================== 88 ;;====================================================================== 100 ;; TODO: 89 ;; TODO: 101 ;; put deltas into an assoc list with version numbers 90 ;; put deltas into an assoc list with version numbers 102 ;; apply all from last to current 91 ;; apply all from last to current 103 ;;====================================================================== 92 ;;====================================================================== ................................................................................................................................................................................ 105 (handle-exceptions 94 (handle-exceptions 106 exn 95 exn 107 (begin 96 (begin 108 (print "Exception: " exn) 97 (print "Exception: " exn) 109 (print "ERROR: Possible out of date schema, attempting to add table metadat 98 (print "ERROR: Possible out of date schema, attempting to add table metadat 110 (sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var TEXT 99 (sqlite3:execute db "CREATE TABLE metadat (id INTEGER PRIMARY KEY, var TEXT 111 CONSTRAINT metadat_constraint UNIQUE (id,var)) 100 CONSTRAINT metadat_constraint UNIQUE (id,var)) 112 (sqlite3:execute db "ALTER TABLE tests ADD COLUMN tags TEXT DEFAULT '';") < 113 (db:set-var db "MEGATEST_VERSION" 1.17) 101 (db:set-var db "MEGATEST_VERSION" 1.17) 114 ) 102 ) 115 (let ((mver (db:get-var db "MEGATEST_VERSION"))) 103 (let ((mver (db:get-var db "MEGATEST_VERSION"))) > 104 (print "Current schema version: " mver " current megatest version: " megate 116 (if (not mver) 105 (if (not mver) 117 (begin 106 (begin 118 (print "Adding megatest-version to metadata") 107 (print "Adding megatest-version to metadata") 119 (sqlite3:execute db (db:set-var db "MEGATEST_VERSION" megatest-version 108 (sqlite3:execute db (db:set-var db "MEGATEST_VERSION" megatest-version 120 (if (< mver 1.18) | 109 ;; (if (< mver 1.18) 121 (begin | 110 ;; (begin 122 (print "Adding tags column to tests table") | 111 ;; (print "Adding tags column to tests table") 123 (sqlite3:execute db "ALTER TABLE tests ADD COLUMN tags TEXT DEFAULT ' | 112 ;; (sqlite3:execute db "ALTER TABLE tests ADD COLUMN tags TEXT D > 113 (if (< mver 1.20) > 114 (sqlite3:execute db "CREATE TABLE test_meta (id INTEGER PRIMARY KEY, > 115 testname TEXT DEFAULT '', > 116 author TEXT DEFAULT '', > 117 owner TEXT DEFAULT '', > 118 description TEXT DEFAULT '', > 119 reviewed TIMESTAMP, > 120 iterated TEXT DEFAULT '', > 121 avg_runtime REAL, > 122 avg_disk REAL, > 123 tags TEXT DEFAULT '', > 124 CONSTRAINT test_meta_contstraint UNIQUE (id,test > 125 (if (< mver megatest-version) 124 (db:set-var db "MEGATEST_VERSION" megatest-version) | 126 (db:set-var db "MEGATEST_VERSION" megatest-version))))) 125 ))) < 126 127 127 ;;====================================================================== 128 ;;====================================================================== 128 ;; meta get and set vars 129 ;; meta get and set vars 129 ;;====================================================================== 130 ;;====================================================================== 130 131 131 ;; returns number if string->number is successful, string otherwise 132 ;; returns number if string->number is successful, string otherwise 132 (define (db:get-var db var) 133 (define (db:get-var db var) ................................................................................................................................................................................ 348 ;; 349 ;; 349 (define (db:test-set-rundir! db run-id testname item-path rundir) 350 (define (db:test-set-rundir! db run-id testname item-path rundir) 350 (sqlite3:execute 351 (sqlite3:execute 351 db 352 db 352 "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;" 353 "UPDATE tests SET rundir=? WHERE run_id=? AND testname=? AND item_path=?;" 353 rundir run-id testname item-path)) 354 rundir run-id testname item-path)) 354 355 > 356 ;;====================================================================== > 357 ;; Tests meta data > 358 ;;====================================================================== > 359 > 360 ;; make-vector-record db testmeta id testname author owner description reviewed > 361 (define (make-db:testmeta)(make-vector 10)) > 362 (define-inline (db:testmeta-get-id vec) (vector-ref vec 0)) > 363 (define-inline (db:testmeta-get-testname vec) (vector-ref vec 1)) > 364 (define-inline (db:testmeta-get-author vec) (vector-ref vec 2)) > 365 (define-inline (db:testmeta-get-owner vec) (vector-ref vec 3)) > 366 (define-inline (db:testmeta-get-description vec) (vector-ref vec 4)) > 367 (define-inline (db:testmeta-get-reviewed vec) (vector-ref vec 5)) > 368 (define-inline (db:testmeta-get-iterated vec) (vector-ref vec 6)) > 369 (define-inline (db:testmeta-get-avg_runtime vec) (vector-ref vec 7)) > 370 (define-inline (db:testmeta-get-avg_disk vec) (vector-ref vec 8)) > 371 (define-inline (db:testmeta-get-tags vec) (vector-ref vec 9)) > 372 (define-inline (db:testmeta-set-id! vec val)(vector-set! vec 0 val)) > 373 (define-inline (db:testmeta-set-testname! vec val)(vector-set! vec 1 val)) > 374 (define-inline (db:testmeta-set-author! vec val)(vector-set! vec 2 val)) > 375 (define-inline (db:testmeta-set-owner! vec val)(vector-set! vec 3 val)) > 376 (define-inline (db:testmeta-set-description! vec val)(vector-set! vec 4 val)) > 377 (define-inline (db:testmeta-set-reviewed! vec val)(vector-set! vec 5 val)) > 378 (define-inline (db:testmeta-set-iterated! vec val)(vector-set! vec 6 val)) > 379 (define-inline (db:testmeta-set-avg_runtime! vec val)(vector-set! vec 7 val)) > 380 (define-inline (db:testmeta-set-avg_disk! vec val)(vector-set! vec 8 val)) > 381 > 382 ;; read the record given a testname > 383 (define (db:testmeta-get-record db testname) > 384 (let ((res #f)) > 385 (sqlite3:for-each-row > 386 (lambda (id testname author owner description reviewed iterated avg_runtime > 387 (set! res (vector id testname author owner description reviewed iterated > 388 db "SELECT id,testname,author,owner,description,reviewed,iterated,avg_runti > 389 testname) > 390 res)) > 391 > 392 ;; create a new record for a given testname > 393 (define (db:testmeta-add-record db testname) > 394 (sqlite3:execute db "INSERT OR IGNORE INTO test_meta (testname) VALUES (?);" t > 395 > 396 ;; update one of the testmeta fields > 397 (define (db:testmeta-update-field db testname field value) > 398 (sqlite3:execute db (conc "UPDATE test_meta SET " field "=? WHERE testname=?;" > 399 355 ;;====================================================================== 400 ;;====================================================================== 356 ;; Steps 401 ;; Steps 357 ;;====================================================================== 402 ;;====================================================================== 358 ;; Run steps 403 ;; Run steps 359 ;; make-vector-record "Run steps" db step id test_id stepname step_complete step 404 ;; make-vector-record "Run steps" db step id test_id stepname step_complete step 360 (define (make-db:step)(make-vector 6)) 405 (define (make-db:step)(make-vector 6)) 361 (define-inline (db:step-get-id vec) (vector-ref vec 0)) 406 (define-inline (db:step-get-id vec) (vector-ref vec 0))

Modified megatest-version.scm from [c09e9a5825137ebd] to [ebeb01abfb9afbb7].

> 1 ;; Always use two digit decimal > 2 ;; 1.01, 1.02...1.10,1.11 ... 1.99,2.00.. 1 (define megatest-version 1.19) | 3 (define megatest-version 1.20)

Modified runs.scm from [4f776d58bd4f6777] to [a71e17f8a888b3e2].

424 (if (>= *verbosity* 1)(pp allitems)) 424 (if (>= *verbosity* 1)(pp allitems)) 425 (if (>= *verbosity* 5) 425 (if (>= *verbosity* 5) 426 (begin 426 (begin 427 (print "items: ")(pp (item-assoc->item-list items)) 427 (print "items: ")(pp (item-assoc->item-list items)) 428 (print "itestable: ")(pp (item-table->item-list itemstable)))) 428 (print "itestable: ")(pp (item-table->item-list itemstable)))) 429 (if (args:get-arg "-m") 429 (if (args:get-arg "-m") 430 (db:set-comment-for-run db run-id (args:get-arg "-m"))) 430 (db:set-comment-for-run db run-id (args:get-arg "-m"))) > 431 431 ;; Here is where the test_meta table is best updated 432 ;; Here is where the test_meta table is best updated > 433 (let ((currrecord (db:testmeta-get-record db test-name))) > 434 (if (not currrecord) > 435 (begin > 436 (set! currrecord (make-vector 10 #f)) > 437 (db:testmeta-add-record db test-name))) 432 (for-each | 438 (for-each 433 (lambda (key) | 439 (lambda (key) > 440 (let* ((idx (cadr key)) > 441 (fld (car key)) 434 (let ((val (config-lookup *configdat* "test_meta" key))) | 442 (val (config-lookup test-conf "test_meta" fld))) 435 < > 443 (if (and val (not (equal? (vector-ref currrecord idx) val))) > 444 (begin > 445 (print "Updating " test-name " " fld " to " val) > 446 (db:testmeta-update-field db test-name fld val))))) > 447 '(("author" 2)("owner" 3)("description" 4)("reviewed" 5)("tags" 9)) 436 448 437 ;; braindead work-around for poorly specified allitems list BUG!!! FIX 449 ;; braindead work-around for poorly specified allitems list BUG!!! FIX 438 (if (null? allitems)(set! allitems '(()))) 450 (if (null? allitems)(set! allitems '(()))) 439 (let loop ((itemdat (car allitems)) 451 (let loop ((itemdat (car allitems)) 440 (tal (cdr allitems))) 452 (tal (cdr allitems))) 441 ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") 453 ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") 442 ;; Handle lists of items 454 ;; Handle lists of items