899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
|
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
|
-
+
|
(define (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests reglen-in all-tests-registry area-dat)
;; At this point the list of parent tests is expanded
;; NB// Should expand items here and then insert into the run queue.
(debug:print 5 "test-records: " test-records ", flags: " (hash-table->alist flags))
;; Do mark-and-find clean up of db before starting runing of quue
;;
;; (cdb:remote-run db:find-and-mark-incomplete #f)
;; (rmt:find-and-mark-incomplete)
(let* ((configdat (megatest:area-configdat area-dat))
(toppath (megatest:area-path area-dat))
(run-info (rmt:get-run-info run-id area-dat))
(tests-info (mt:get-tests-for-run run-id #f '() '() area-dat)) ;; qryvals: "id,testname,item_path"))
(sorted-test-names (tests:sort-by-priority-and-waiton test-records))
(test-registry (make-hash-table))
|
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
|
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
|
-
+
|
(let* ((dparts (string-split lasttpath "/"))
(runpath (conc "/" (string-intersperse
(take dparts (- (length dparts) 1))
"/"))))
(debug:print 1 "Removing run: " runkey " " (db:get-value-by-header run header "runname") " and related record")
(rmt:delete-run run-id area-dat)
(rmt:delete-old-deleted-test-records area-dat)
;; (cdb:remote-run db:set-var db "DELETED_TESTS" (current-seconds))
;; (rmt:set-var "DELETED_TESTS" (current-seconds))
;; need to figure out the path to the run dir and remove it if empty
;; (if (null? (glob (conc runpath "/*")))
;; (begin
;; (debug:print 1 "Removing run dir " runpath)
;; (system (conc "rmdir -p " runpath))))
)))))
))
|
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
|
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
|
-
-
|
(let (;; (db #f)
(keys #f))
(if (launch:setup-for-run area-dat)
(launch:cache-config area-dat)
(begin
(debug:print 0 "Failed to setup, exiting")
(exit 1)))
;; (if (args:get-arg "-server")
;; (cdb:remote-run server:start db (args:get-arg "-server")))
(set! keys (keys:config-get-fields configdat))
;; have enough to process -target or -reqtarg here
(if (args:get-arg "-reqtarg")
(let* ((runconfigf (conc toppath "/runconfigs.config")) ;; DO NOT EVALUATE ALL
(runconfig (read-config runconfigf #f #t environ-patt: #f)))
(if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f)
(keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash)
|
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
|
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
|
-
+
|
(conc "INSERT OR REPLACE INTO tests (run_id,testname,state,status,event_time,host,cpuload,diskfree,uname,rundir,item_path,run_duration,final_logf,comment) "
"VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?);")
new-run-id (cddr (vector->list testdat)))
(set! new-testdat (car (mt:get-tests-for-run new-run-id (conc testname "/" item-path) '() '())))
(hash-table-set! curr-tests-hash full-name new-testdat) ;; this could be confusing, which record should go into the lookup table?
;; Now duplicate the test steps
(debug:print 4 "Copying records in test_steps from test_id=" (db:test-get-id testdat) " to " (db:test-get-id new-testdat))
(cdb:remote-run
(cdb:remote-run ;; to be replaced, note: this routine is not used currently
(lambda ()
(sqlite3:execute
db
(conc "INSERT OR REPLACE INTO test_steps (test_id,stepname,state,status,event_time,comment) "
"SELECT " (db:test-get-id new-testdat) ",stepname,state,status,event_time,comment FROM test_steps WHERE test_id=?;")
(db:test-get-id testdat))
;; Now duplicate the test data
|