Check-in [8f2a9bcf7c]
Not logged in
Overview
SHA1 Hash:8f2a9bcf7c2031ad9c3143f488f0fa8d5ba25c6e
Date: 2012-04-20 22:29:54
User: mrwellan
Comment:Extend test get path
Timelines: family | ancestors | descendants | both | extend-test-get-path
Diffs: root of this branch
Downloads: Tarball | ZIP archive
Other Links: files | file ages | manifest
Tags And Properties
Changes

Modified configf.scm from [26cad9ffd1215520] to [2c4fe9609e82377a].

231 231 232 (define (configf:section-vars cfgdat section) 232 (define (configf:section-vars cfgdat section) 233 (let ((sectdat (hash-table-ref/default cfgdat section '()))) 233 (let ((sectdat (hash-table-ref/default cfgdat section '()))) 234 (if (null? sectdat) 234 (if (null? sectdat) 235 '() 235 '() 236 (map car sectdat)))) 236 (map car sectdat)))) 237 237 > 238 (define (configf:get-section cfdat section) > 239 (hash-table-ref/default cfgdat section '())) > 240 238 (define (setup) 241 (define (setup) 239 (let* ((configf (find-config)) 242 (let* ((configf (find-config)) 240 (config (if configf (read-config configf #f #t) #f))) 243 (config (if configf (read-config configf #f #t) #f))) 241 (if config 244 (if config 242 (setenv "RUN_AREA_HOME" (pathname-directory configf))) 245 (setenv "RUN_AREA_HOME" (pathname-directory configf))) 243 config)) 246 config)) 244 247

Modified db.scm from [2c88e7344f9bad2f] to [92d14b406bf60a5d].

609 logf test-id) 609 logf test-id) 610 (debug:print 0 "ERROR: db:test-set-log! called with non-string log file na 610 (debug:print 0 "ERROR: db:test-set-log! called with non-string log file na 611 611 612 ;;====================================================================== 612 ;;====================================================================== 613 ;; Misc. test related queries 613 ;; Misc. test related queries 614 ;;====================================================================== 614 ;;====================================================================== 615 615 616 (define (db:test-get-paths-matching db keynames target) | 616 (define (db:test-get-paths-matching db keynames target fnamepatt #!key (res '()) 617 (let* ((res '()) < 618 (itempatt (if (args:get-arg "-itempatt")(args:get-arg "-itempatt") "% | 617 (let* ((itempatt (if (args:get-arg "-itempatt")(args:get-arg "-itempatt") "% 619 (testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "% 618 (testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "% 620 (statepatt (if (args:get-arg ":state") (args:get-arg ":state") "% 619 (statepatt (if (args:get-arg ":state") (args:get-arg ":state") "% 621 (statuspatt (if (args:get-arg ":status") (args:get-arg ":status") "% 620 (statuspatt (if (args:get-arg ":status") (args:get-arg ":status") "% 622 (runname (if (args:get-arg ":runname") (args:get-arg ":runname") "% 621 (runname (if (args:get-arg ":runname") (args:get-arg ":runname") "% 623 (keystr (string-intersperse 622 (keystr (string-intersperse 624 (map (lambda (key val) 623 (map (lambda (key val) 625 (conc "r." key " like '" val "'")) 624 (conc "r." key " like '" val "'")) ................................................................................................................................................................................ 632 "'ORDER BY t.event_time ASC;"))) 631 "'ORDER BY t.event_time ASC;"))) 633 (debug:print 3 "qrystr: " qrystr) 632 (debug:print 3 "qrystr: " qrystr) 634 (sqlite3:for-each-row 633 (sqlite3:for-each-row 635 (lambda (p) 634 (lambda (p) 636 (set! res (cons p res))) 635 (set! res (cons p res))) 637 db 636 db 638 qrystr) 637 qrystr) > 638 (if fnamepatt > 639 (apply append > 640 (map (lambda (p) > 641 (glob (conc p "/" fnamepatt))) 639 res)) | 642 res)) > 643 res))) > 644 > 645 ;; look through tests from matching runs for a file > 646 (define (db:test-get-first-path-matching db keynames target fname) > 647 ;; [refpaths] is the section where references to other megatest databases are > 648 (let ((mt-paths (configf:get-section "refpaths")) > 649 (res (db:test-get-paths-matching db keynames target fname))) > 650 (let loop ((pathdat (if (null? paths) #f (car mt-paths))) > 651 (tal (if (null? paths) '()(cdr mt-paths)))) > 652 (if (not (null? res)) > 653 (car res) ;; return first found > 654 (if path > 655 (let* ((db (open-db path: (cadr pathdat))) > 656 (newres (db:test-get-paths-matching db keynames target fnam > 657 (debug:print 4 "INFO: Trying " (car pathdat) " at " (cadr pathda > 658 (sqlite3:finalize! db) > 659 (if (not (null? newres)) > 660 (car newres) > 661 (if (null? tal) > 662 #f > 663 (loop (car tal)(cdr tal)))))))))) > 664 640 665 641 (define (db:test-get-test-records-matching db keynames target) 666 (define (db:test-get-test-records-matching db keynames target) 642 (let* ((res '()) 667 (let* ((res '()) 643 (itempatt (if (args:get-arg "-itempatt")(args:get-arg "-itempatt") "% 668 (itempatt (if (args:get-arg "-itempatt")(args:get-arg "-itempatt") "% 644 (testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "% 669 (testpatt (if (args:get-arg "-testpatt")(args:get-arg "-testpatt") "% 645 (statepatt (if (args:get-arg ":state") (args:get-arg ":state") "% 670 (statepatt (if (args:get-arg ":state") (args:get-arg ":state") "% 646 (statuspatt (if (args:get-arg ":status") (args:get-arg ":status") "% 671 (statuspatt (if (args:get-arg ":status") (args:get-arg ":status") "%

Modified megatest.scm from [7edaf0bfca18d3a1] to [22a45f314b9b40a9].

71 -set-values : update or set values in the testdata table 71 -set-values : update or set values in the testdata table 72 :category : set the category field (optional) 72 :category : set the category field (optional) 73 :variable : set the variable name (optional) 73 :variable : set the variable name (optional) 74 :value : value measured (required) 74 :value : value measured (required) 75 :expected : value expected (required) 75 :expected : value expected (required) 76 :tol : |value-expect| <= tol (required, can be <, >, >=, <= 76 :tol : |value-expect| <= tol (required, can be <, >, >=, <= 77 :units : name of the units for value, expected_value etc. (op 77 :units : name of the units for value, expected_value etc. (op 78 < 79 -load-test-data : read test specific data for storage in the test_data 78 -load-test-data : read test specific data for storage in the test_data 80 from standard in. Each line is comma delimited with 79 from standard in. Each line is comma delimited with 81 fields category,variable,value,comment 80 fields category,variable,value,comment 82 81 83 Queries 82 Queries 84 -list-runs patt : list runs matching pattern \"patt\", % is the wildca 83 -list-runs patt : list runs matching pattern \"patt\", % is the wildca 85 -showkeys : show the keys used in this megatest setup 84 -showkeys : show the keys used in this megatest setup

Modified tests/megatest.config from [1f4eabb06da802cd] to [507b18874c445a0c].

1 [fields] 1 [fields] 2 sysname TEXT 2 sysname TEXT 3 fsname TEXT 3 fsname TEXT 4 datapath TEXT 4 datapath TEXT > 5 > 6 # refareas can be searched to find previous runs > 7 # the path points to where megatest.db exists > 8 [refareas] > 9 area1 /tmp/oldarea/megatest 5 10 6 [setup] 11 [setup] 7 # exectutable /path/to/megatest 12 # exectutable /path/to/megatest 8 max_concurrent_jobs 200 13 max_concurrent_jobs 200 9 linktree /tmp/mt_links 14 linktree /tmp/mt_links 10 15 11 [jobtools] 16 [jobtools]