Megatest

Diff
Login

Differences From Artifact [7767e7bac6]:

To Artifact [5fbd7e058e]:


20
21
22
23
24
25
26
27

28
29
30
31
32
33
34
35
36
37



38
39
40
41
42






43
44
45
46
47
48
49
50
51





52
53
54
55
56
57
58
59
60
61
62
63
64
65

66
67




68
69
70
71
72
73
74
75
76
77
78
79
80











81
82
83
84
85
86












87
88
89
90
91
92
93
94
95
96
97
98









99
100
101

102
103
104
105
106
107
108
109
110
111
112
113
114









115
116
117
118
119
120
121
20
21
22
23
24
25
26

27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54





55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74


75
76
77
78













79
80
81
82
83
84
85
86
87
88
89






90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112

113
114
115
116
117
118
119
120
121
122
123

124













125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140







-
+









-
+
+
+





+
+
+
+
+
+




-
-
-
-
-
+
+
+
+
+














+
-
-
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+











-
+
+
+
+
+
+
+
+
+


-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+







;;(declare (uses runconfig))
;;(declare (uses tests))
;;(declare (uses server))
;;(declare (uses mt))
;;(declare (uses archive))
;; (declare (uses filedb))

(include "common_records.scm")
;(include "common_records.scm")
;;(include "key_records.scm")
;;(include "db_records.scm")
;;(include "run_records.scm")
;;(include "test_records.scm")


(define (subrun:initialize-toprun-test  testconfig test-run-dir)

  (let ((ra (configf:lookup testconfig "subrun" "run-area"))
        (logpro (configf:lookup testconfig "subrun" "logpro")))
        (logpro (configf:lookup testconfig "subrun" "logpro"))
        (symlink-target (conc test-run-dir "/subrun-area"))
        )
  (when (not ra)      ;; when runarea is not set we default to *toppath*. However 
              ;; we need to force the setting in the testconfig so it will
          ;; be preserved in the testconfig.subrun file
      (configf:set-section-var testconfig "subrun" "runarea" *toppath*))
    (configf:set-section-var testconfig "logpro" "subrun" logpro) ;; append the logpro rules to the logpro section as stepname subrun

    (if (common:file-exists? symlink-target)
        (delete-file symlink-target))
    
    (create-symbolic-link ra symlink-target)

    (configf:write-alist testconfig "testconfig.subrun")))


(define (subrun:launch-cmd test-run-dir)
  (let ((log-prefix "run")
        (switches (subrun:selector+log-switches test-run-dir log-prefix))
        (run-wait #t)
        (cmd      (conc "megatest -run "switches" "
                        (if runwait "-run-wait " ""))))
  (let* ((log-prefix "run")
         (switches (subrun:selector+log-switches test-run-dir log-prefix))
         (run-wait #t)
         (cmd      (conc "megatest -run "switches" "
                         (if run-wait "-run-wait " ""))))
    cmd))

;; set state/status of test item
;; fork off megatest
;; set state/status of test item
;;


(define (subrun:selector+log-switches test-run-dir log-prefix)
  (let* ((switch-def-alist (common:get-param-mapping flavor: 'config))
         (subrunfile   (conc test-run-dir "/testconfig.subrun" ))
         (subrundata   (with-input-from-file subrunfile read))
         (subrunconfig (configf:alist->config subrundata))
         (run-area     (configf:lookup subrunconfig "subrun" "run-area"))
         (defvals      `(("start-dir" . ,(or run-area  ;; default values if not specified in subrun section of tconf
         (defvals      `(("-runname" . ,(get-environment-variable "MT_RUNNAME"))
                         ("-target"  . ,(get-environment-variable "MT_TARGET"))))
                                             (get-environment-variable "MT_RUN_AREA_HOME")
                                             "/no/rundir/found")) 
                         ("run-name"  . ,(or (get-environment-variable "MT_RUNNAME") "NO-RUNNAME"))
                         ("target"    . ,(or (get-environment-variable "MT_TARGET")  "NO-TARGET"))))
         (switch-alist (apply
                        append
                        (filter-map (lambda (item)
                                      (let ((config-key (car item))
                                            (switch     (cdr item))
                                            (defval     (alist-ref defvals switch equal?))
                                            (val        (or (configf:lookup subrunconfig switch)
                                                            defval)))
                                        (if val
                                            (list switch val)
                                            #f)))
                                    switch-def-alist)))
         (target        (or (alist-ref "-target" switch-alist  equal? #f) ;; want data-structures alist-ref, not alist-lib alist-ref
         (switch-alist-pre  (filter-map (lambda (item)
                                          (let* ((config-key (car item))
                                                 (switch     (cdr item))
                                                 (defval     (alist-ref config-key defvals equal? #f))
                                                 (val        (or (configf:lookup subrunconfig "subrun" config-key)
                                                                 defval)))
                                            (if val
                                                (cons switch val)
                                                #f)))
                                        switch-def-alist))

                            "NO-TARGET"))
         (runname       (or (alist-ref "-runname" switch-alist equal? #f)
                            "NO-RUNNAME"))
         (testpatt      (alist-ref "-testpatt" switch-alist equal? #f))
         (mode-patt     (alist-ref "-modepatt" switch-alist equal? #f))
         (tag-expr      (alist-ref "-tagexpr" switch-alist equal? #f))
         ;; testpatt may be modified if all three of mode-patt, tag-expr, and testpatt are null
         (mode-patt     (alist-ref "-modepatt" switch-alist-pre equal? #f))
         (tag-expr      (alist-ref "-tagexpr" switch-alist-pre equal? #f))
         (testpatt      (alist-ref "-testpatt" switch-alist-pre equal?
                                   (if (not (or mode-patt tag-expr)) "%" #f))) ;; testpatt is % if not
                                                                               ;; otherwise specified

         ;; define compact-stem for logfile
         (target        (alist-ref "-target" switch-alist-pre equal? #f)) ;; want data-structures alist-ref, not alist-lib alist-ref
         (runname       (alist-ref "-runname" switch-alist-pre equal? #f))


         (compact-stem  (string-substitute "[/*]" "_"
                                           (conc
                                            target
                                            "-"
                                            runname
                                            "-" (or testpatt mode-patt tag-expr "NO-TESTPATT"))))
         (logfile       (conc
                         test-run-dir "/"
                         (or log-prefix "")
                         (if log-prefix "-" "")
                         compact-stem
                         ".log")))
                         ".log"))
         ;; swap out testpatt with modified test-patt and add -log
         (switch-alist  (cons
                         (cons "-log" logfile)
                         (map (lambda (item)
                                (if (equal? (car item) "-testpatt")
                                    (cons "-testpatt" testpatt)
                                    item))
                                switch-alist-pre))))
    ;; note - get precmd from subrun section
    ;;   apply to submegatest commands
    
    (let* ((res
    (conc
     " -start-dir " run-area " "
     " -runname " runname " "
     " -target " target " "
     (if testpatt (conc "-testpatt " testpatt" ") "")
     (if modepatt (conc "-modepatt " modepatt" ") "")
     (if tag-expr (conc "-tag-expr " tag-expr" ") "")
     
     (string-intersperse
      (apply append
           (map (lambda (x) (list (car x) (cdr x))) switch-def-alist))
      " ")
     "-log " logfile)))
            (string-intersperse
             (apply
              append
              (map
               (lambda (x)
                 (list (car x) (cdr x)))
               switch-alist))
              " ")))
      res)))


(define (subrun:exec-sub-megatest test-run-dir switches #!key (logfile #f))
  (let* ((real-logfile (or logfile (conc (test-run-dir) "/subrun-"
                                         (string-substitute "[/*]" "_" (string-intersperse switches "^"))"-"
                                         (number->string (current-seconds)) ".log")))
         (selector-switches  (common:sub-megatest-selector-switches test-run-dir))