Index: genexample.scm ================================================================== --- genexample.scm +++ genexample.scm @@ -365,12 +365,11 @@ ;; ;; specify target, runname etc to use specific runs for the template ;; (define (genexample:extract-skeleton-area dest-path) (let* ((target (args:get-arg "-target")) - (runname (args:get-arg "-runname")) - ) + (runname (args:get-arg "-runname"))) (if (not (and target runname)) (debug:print 0 *default-log-port* "WARNING: For best results please specifiy -target and -runname for a good run to use as a template.")) (if (not (and (file-exists? "megatest.config") (file-exists? "megatest.db"))) (begin @@ -389,50 +388,99 @@ ;; dump the config files from this area to the dest area (system (conc "megatest -show-config > " dest-path "/megatest.config")) (system (conc "megatest -show-runconfig > " dest-path "/runconfigs.config")) - ;; create a refdb, some stuff has to be done due to refdb not initing area - ;; sheet row col value - ;; test itempath stepname steptime - (if (not (file-exists? (conc dest-path "/stepsinfo"))) - (begin - (create-directory (conc dest-path "/stepsinfo/sxml") #t) - (with-output-to-file (conc dest-path "/stepsinfo/sheet-names.cfg") (lambda ()(print))))) - - ;; rmt:get-tests-for-run - ;; rmt:get-tests-for-run-mindata run-id testpatt states status not-in - ;; rmt:simple-get-runs - ;; (define-record simple-run target id runname state status owner event_time) - (let* ((runs (rmt:simple-get-runs (or runname "%") #f #f (or target "%"))) - (tests (make-hash-table)) - (refdb (conc dest-path "/stepsinfo"))) + ;; create stepsinfo and items refdbs, some stuff has to be done due to refdb not initing area + ;; + ;; sheet row col value + ;; stepsinfo testname itempath stepname steptime + ;; miscinfo "itemsinfo" testname itempath "x" + ;; + (for-each + (lambda (rdbname) + (if (not (file-exists? (conc dest-path "/" rdbname))) + (begin + (create-directory (conc dest-path "/" rdbname "/sxml") #t) + (with-output-to-file (conc dest-path "/" rdbname "/sheet-names.cfg") + (lambda ()(print)))))) + '("stepsinfo" "miscinfo")) + + (let* ((runs (rmt:simple-get-runs (or runname "%") #f #f (or target "%"))) + (tests (make-hash-table)) ;; just tests + (fullt (make-hash-table)) ;; all test/items + (testreg (make-hash-table)) ;; for the testconfigs + (stepsrdb (conc dest-path "/stepsinfo")) + (miscrdb (conc dest-path "/miscinfo"))) (if (> (length runs) 1) (debug:print-info 0 *default-log-port* "More than one run matches, first found data will be used.")) ;; get all testnames (for-each (lambda (run-id) - (let* ((tests-data (rmt:get-tests-for-run-mindata run-id "%" '() '() #f))) + (let* ((tests-data (rmt:get-tests-for-run run-id "%" '() '() #f #f #f #f #f #f #f #f))) (for-each (lambda (testdat) - (let* ((test-id (db:mintest-get-id testdat)) - (testname (db:mintest-get-testname testdat)) - (item-path (db:mintest-get-item_path testdat)) + (let* ((test-id (db:test-get-id testdat)) + (testname (db:test-get-testname testdat)) + (item-path (db:test-get-item-path testdat)) + (tlevel (db:test-get-is-toplevel testdat)) + (tfullname (db:test-get-fullname testdat)) ;; now get steps info - (test-steps (tests:get-compressed-steps run-id test-id))) - (if (not (hash-table-exists? tests testname)) - (begin - (print "\n" testname) + (test-steps (tests:get-compressed-steps run-id test-id)) + (testconfig (tests:get-testconfig testname item-path testreg #f))) + + + (if (not (hash-table-exists? fullt tfullname)) + ;; do the work for this test if not previously done + (let* ((new-test-dir (conc dest-path "/tests/" testname)) + (tconfigf (conc new-test-dir "/testconfig"))) + (print "Analyzing and extracting info for " tfullname) + (print " toplevel: " (if tlevel "yes" "no")) + (hash-table-set! fullt tfullname #t) ;; track that this one has been seen + (if (not (directory-exists? new-test-dir)) + (create-directory new-test-dir #t)) + + ;; create the testconfig IIF we are a toplevel or an item AND the testconfig has not been previously created + (if (and (or (not tlevel) + (not (equal? item-path ""))) + (not (file-exists? tconfigf))) + (with-output-to-file tconfigf + (lambda () + ;; first the ezsteps + (print "[ezsteps]") + (for-each + (lambda (teststep) + (let* ((step-name (vector-ref teststep 0))) + (print step-name " sleep [refdb lookup #{getenv MT_RUN_AREA_HOME}/" stepsrdb " " testname " $MT_ITEM_PATH " step-name "]"))) + test-steps) + + ;; now the requirements section + (print "\n[requirements]") + (for-each + (lambda (entry) + (print (car entry) " " (cadr entry))) ;; it is not an alist + (configf:get-section testconfig "requirements")) + + (print "[items]") + (print "THE_ITEM [refdb getrow #{getenv MT_RUN_AREA_HOME}/miscinfo itemsinfo #{getenv MT_TESTNAME}| awk '{print $1}'") + ))) + + ;; fill the stepsrdb (for-each (lambda (teststep) (let* ((step-name (vector-ref teststep 0)) (step-duration (hrs-min-sec->seconds (vector-ref teststep 4)))) - (system (conc "refdb set " refdb " " testname " '" (if (equal? item-path "") + + (system (conc "refdb set " stepsrdb " " testname " '" (if (equal? item-path "") "no-item-path" item-path) - "' " step-name " " step-duration)) - )) - test-steps)) - (else (debug:print-info 0 *default-log-port* "Skipping already seen test " testname))))) + "' " step-name " " step-duration)))) + test-steps) + + ;; miscinfo "itemsinfo" testname itempath "x" + (if (not (equal? item-path "")) + (system (conc "refdb set " miscrdb " itemsinfo " testname " " item-path " x"))) + + )))) tests-data))) (map (lambda (runrec)(simple-run-id runrec)) runs))) ))