| ︙ | | |
530
531
532
533
534
535
536
537
538
539
540
541
542
543
|
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
|
+
+
+
+
+
+
+
+
+
|
(runs:update-all-test_meta #f)
;; run the run prehook if there are no tests yet run for this run:
;;
(runs:run-pre-hook run-id)
;; mark all test launced flag as false in the meta table
(rmt:set-var (conc "lunch-complete-" run-id) "no")
(debug:print-info 1 *default-log-port* "Setting end-of-run to no")
(let* ((config-reruns (let ((x (configf:lookup *configdat* "setup" "reruns")))
(if x (string->number x) #f)))
(config-rerun-cnt (if config-reruns
config-reruns
1)))
(if (eq? config-rerun-cnt run-count)
(rmt:set-var (conc "end-of-run-" run-id) "no")))
(rmt:set-run-state-status run-id "new" "n/a")
;; now add non-directly referenced dependencies (i.e. waiton)
;;======================================================================
;; refactoring this block into tests:get-full-data
;;
;; What happended, this code is now duplicated in tests!?
;;
|
| ︙ | | |
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
|
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
|
-
+
+
-
+
-
-
+
|
(if (> run-count 0) ;; handle reruns
(begin
(if (not (hash-table-ref/default flags "-preclean" #f))
(hash-table-set! flags "-preclean" #t))
(if (not (hash-table-ref/default flags "-rerun" #f))
(hash-table-set! flags "-rerun" "STUCK/DEAD,n/a,ZERO_ITEMS"))
;; recursive call to self
(runs:run-tests target runname test-patts user flags run-count: (- run-count 1)))))
(runs:run-tests target runname test-patts user flags run-count: (- run-count 1)))
(launch:end-of-run-check run-id)))
(debug:print-info 0 *default-log-port* "No tests to run")))
(debug:print-info 4 *default-log-port* "All done by here")
;; TODO: try putting post hook call here
;(if (eq? run-count 0)
; (begin
; (debug:print-info 0 *default-log-port* "Calling Post Hook")
|
| ︙ | | |
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
|
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
|
-
-
+
+
|
(debug:print-info 0 *default-log-port* "Have leftovers!")
(loop (car reg)(cdr reg) '() reruns))
(else
(debug:print-info 4 *default-log-port* "cond branch - " "rtq-9")
(debug:print-info 4 *default-log-port* "Exiting loop with...\n hed=" hed "\n tal=" tal "\n reruns=" reruns))
))) ;; end loop on sorted test names
;; this is the point where everything is launched and now you can mark the run in metadata table as all launched
(rmt:set-var (conc "lunch-complete-" run-id) "yes")
(rmt:set-var (conc "lunch-complete-" run-id) "yes")
;; now *if* -run-wait we wait for all tests to be done
;; Now wait for any RUNNING tests to complete (if in run-wait mode)
(thread-sleep! 10) ;; I think there is a race condition here. Let states/statuses settle
(let wait-loop ((num-running (rmt:get-count-tests-running-for-run-id run-id))
(prev-num-running 0))
;; (debug:print-info 13 *default-log-port* "num-running=" num-running ", prev-num-running=" prev-num-running)
(if (and (or (args:get-arg "-run-wait")
|
| ︙ | | |
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
|
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
|
+
+
+
+
+
+
|
)
(begin
(debug:print 2 *default-log-port* "Not removing directory " rundir " because either it doesn't exist or has a bad name")
(debug:print 2 *default-log-port* "Is /tmp/badname: " (string= rundir "/tmp/badname"))
(debug:print 2 *default-log-port* "Exists: " (file-exists? rundir))
(debug:print 2 *default-log-port* "Has run-name: " (substring-index run-name rundir))
(debug:print 2 *default-log-port* "Has target: " (substring-index target rundir))
;;PJH remove record from db no need to cleanup directory
(case mode
((remove-data-only)(mt:test-set-state-status-by-id (db:test-get-run_id test)(db:test-get-id test) (db:test-get-state test)(db:test-get-status test) #f))
((archive-remove) (mt:test-set-state-status-by-id (db:test-get-run_id test)(db:test-get-id test) "ARCHIVED" #f #f))
(else (rmt:delete-test-records (db:test-get-run_id test) (db:test-get-id test))))
)
)
)
(if (not (null? tal))
(loop (car tal)(cdr tal)))))))
(rmt:update-run-stats run-id (rmt:get-raw-run-stats run-id)))
|
| ︙ | | |
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
|
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
|
+
+
-
-
+
+
|
(debug:print 1 *default-log-port* "Removing target " target "run: " run-name)
(if (not keep-records)
(begin
(debug:print 1 *default-log-port* "Removing DB records for the run.")
(rmt:delete-run run-id)
(rmt:delete-old-deleted-test-records))
)
(if (not (equal? linkspath "/does/not/exist/I"))
(begin
(debug:print 1 *default-log-port* "Recursively removing links dir " linkspath)
(runs:recursive-delete-with-error-msg linkspath)
|
| ︙ | | |
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
|
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
|
-
+
-
-
-
-
-
+
+
+
+
+
-
+
-
-
|
(define doc-template
'(*TOP*
(*PI* xml "version='1.0'")
(testsuite)))
(define (runs:update-junit-test-reporter-xml run-id)
(let* (
(junit-test-reporter (configf:lookup *configdat* "runs" "junit-test-reporter-xml"))
(junit-test-reporter (configf:lookup *configdat* "runs" "junit-test-reporter-xml"))
(junit-test-report-dir (configf:lookup *configdat* "runs" "junit-test-report-dir"))
(xml-dir (if (and junit-test-reporter (equal? junit-test-reporter "yes" ))
(if junit-test-report-dir
junit-test-report-dir
(conc (getenv "MT_LINKTREE") "/" (getenv "MT_TARGET") "/" (getenv "MT_RUNNAME")))
#f))
(xml-dir (if (and junit-test-reporter (equal? junit-test-reporter "yes" ))
(if junit-test-report-dir
junit-test-report-dir
(conc (getenv "MT_LINKTREE") "/" (getenv "MT_TARGET") "/" (getenv "MT_RUNNAME")))
#f))
(xml-ts-name (if xml-dir
(conc (getenv "MT_TESTSUITENAME")"."(string-translate (getenv "MT_TARGET") "/" ".") "." (getenv "MT_RUNNAME"))
#f))
(keyname (if xml-ts-name
(keyname (if xml-ts-name (common:get-signature xml-ts-name) #f))
(common:get-signature xml-ts-name)
#f))
|
| ︙ | | |