1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
|
(debug:print-info 13 *default-log-port* "after db:setup with dbstruct=" dbstruct)
(cond
((dbr:dbstruct-read-only dbstruct)
(debug:print-info 13 *default-log-port* "loading read-only watchdog")
(common:readonly-watchdog dbstruct))
(else
(debug:print-info 13 *default-log-port* "loading writable-watchdog.")
(let* ((syncer (or (configf:lookup *configdat* "server" "sync-method") "brute-force-sync")))
(cond
((equal? syncer "brute-force-sync")
(server:writable-watchdog-bruteforce dbstruct))
((equal? syncer "delta-sync")
(server:writable-watchdog-deltasync dbstruct))
(else
(debug:print-error 0 *default-log-port* "Unknown server/sync-method specified ("syncer") - valid values are brute-force-sync and delta-sync.")
|
|
|
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
|
(debug:print-info 13 *default-log-port* "after db:setup with dbstruct=" dbstruct)
(cond
((dbr:dbstruct-read-only dbstruct)
(debug:print-info 13 *default-log-port* "loading read-only watchdog")
(common:readonly-watchdog dbstruct))
(else
(debug:print-info 13 *default-log-port* "loading writable-watchdog.")
(let* ((syncer (or (configf:lookup *configdat* "server" "sync-method") "delta-sync"))) ;; "brute-force-sync")))
(cond
((equal? syncer "brute-force-sync")
(server:writable-watchdog-bruteforce dbstruct))
((equal? syncer "delta-sync")
(server:writable-watchdog-deltasync dbstruct))
(else
(debug:print-error 0 *default-log-port* "Unknown server/sync-method specified ("syncer") - valid values are brute-force-sync and delta-sync.")
|
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
|
"returns alist mapping string keys in testconfig/subrun to megatest command line switches; if flavor is switch-symbol, maps tcmt symbolic switches to megatest switches"
(let ((default '(("tag-expr" . "-tagexpr")
("mode-patt" . "-modepatt")
("run-name" . "-runname")
("contour" . "-contour")
("target" . "-target")
("test-patt" . "-testpatt")
("msg" . "-m")
("log" . "-log")
("start-dir" . "-start-dir")
("new" . "-set-state-status"))))
(if (eq? flavor 'switch-symbol)
(map (lambda (x)
(cons (string->symbol (conc "-" (car x))) (cdr x)))
|
>
>
|
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
|
"returns alist mapping string keys in testconfig/subrun to megatest command line switches; if flavor is switch-symbol, maps tcmt symbolic switches to megatest switches"
(let ((default '(("tag-expr" . "-tagexpr")
("mode-patt" . "-modepatt")
("run-name" . "-runname")
("contour" . "-contour")
("target" . "-target")
("test-patt" . "-testpatt")
("rerun" . "-rerun")
("setvars" . "-setvars")
("msg" . "-m")
("log" . "-log")
("start-dir" . "-start-dir")
("new" . "-set-state-status"))))
(if (eq? flavor 'switch-symbol)
(map (lambda (x)
(cons (string->symbol (conc "-" (car x))) (cdr x)))
|
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
|
((string? proc)(system proc))
(proc (proc)))
(hash-table-for-each
vars
(lambda (var val)
(setenv var val)))
vars))
(define (common:run-a-command cmd #!key (with-vars #f) (with-orig-env #f))
(let* ((pre-cmd (dtests:get-pre-command))
(post-cmd (dtests:get-post-command))
(fullcmd (if (or pre-cmd post-cmd)
(conc pre-cmd cmd post-cmd)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
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
|
((string? proc)(system proc))
(proc (proc)))
(hash-table-for-each
vars
(lambda (var val)
(setenv var val)))
vars))
(define (common:propogate-mt-vars-to-subrun proc propogate-vars)
(let ((vars (make-hash-table))
(var-patt "^MT_.*"))
(for-each
(lambda (vardat) ;; each env var
;(for-each
;(lambda (var-patt)
(if (string-match var-patt (car vardat))
(let ((var (car vardat))
(val (cdr vardat)))
(hash-table-set! vars var val)
(if (member var propogate-vars)
(begin
(print var " " (string-substitute "MT_" "PARENT_" var))
(setenv (string-substitute "MT_" "PARENT_" var) val)))
(unsetenv var))))
; var-patts))
(get-environment-variables))
(cond
((string? proc)(system proc))
(proc (proc)))
(hash-table-for-each
vars
(lambda (var val)
(if (member var propogate-vars)
(unsetenv (string-substitute "MT_" "PARENT_" var)))
(setenv var val)))
vars))
(define (common:run-a-command cmd #!key (with-vars #f) (with-orig-env #f))
(let* ((pre-cmd (dtests:get-pre-command))
(post-cmd (dtests:get-post-command))
(fullcmd (if (or pre-cmd post-cmd)
(conc pre-cmd cmd post-cmd)
|