893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
|
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
|
-
+
|
(define (runs:run-tests-queue run-id runname test-records keyvals flags test-patts required-tests reglen-in all-tests-registry)
;; 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 ((run-info (rmt:get-run-info run-id))
(tests-info (mt:get-tests-for-run run-id #f '() '())) ;; qryvals: "id,testname,item_path"))
(sorted-test-names (tests:sort-by-priority-and-waiton test-records))
(test-registry (make-hash-table))
(registry-mutex (make-mutex))
(num-retries 0)
|
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
|
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
|
-
+
|
(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)
(rmt:delete-old-deleted-test-records)
;; (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))))
)))))
))
|
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
|
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
|
-
-
|
(let (;; (db #f)
(keys #f))
(if (launch:setup-for-run)
(launch:cache-config)
(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)
|
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
|
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
|
-
+
|
(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
|