Megatest

Diff
Login

Differences From Artifact [69ba5c8444]:

To Artifact [4af2fd651e]:


83
84
85
86
87
88
89
90

91
92
93
94
95
96



97
98
99
100
101
102
103
83
84
85
86
87
88
89

90






91
92
93
94
95
96
97
98
99
100







-
+
-
-
-
-
-
-
+
+
+







    
    (create-symbolic-link ra symlink-target)

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

(define (subrun:set-state-status test-run-dir state status new-state-status)
  (if (and (not (subrun:subrun-removed? test-run-dir)) (subrun:subrun-test-initialized? test-run-dir))
      (let* ((action-switches-str
      (let* ((log-prefix (subrun:sanitize-path
              (conc "-set-state-status "new-state-status
                    (if state (conc " -state "state) "")
                    (if status (conc " -status "status) "")))
             (log-prefix (conc "set-state-status="new-state-status
                    (if state (conc ":state="state) "")
                    (if status (conc "+status="status) "")))
                          (conc "set-state-status="new-state-status
                                (if state (conc ":state="(state) "")
                                    (if status (conc "+status="status) "")))))
             (submt-result 
              (subrun:exec-sub-megatest test-run-dir action-switches-str log-prefix)))
        submt-result)))

(define (subrun:remove-subrun test-run-dir keep-records )
  (if (and (not (subrun:subrun-removed? test-run-dir)) (subrun:subrun-test-initialized? test-run-dir))
      (let* ((action-switches-str
120
121
122
123
124
125
126






127
128
129
130
131
132
133
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136







+
+
+
+
+
+







  (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))


(define (subrun:sanitize-path inpath)
  (let* ((insane-pattern (irregex "[^[a-zA-Z0-9_\\-]")))
    (regex#string-substitute insane-pattern "_" inpath #t)))

(subrun:sanitize-path "a/b/c-d/e*f")

(define (subrun:get-runarea test-run-dir)
  (if (subrun:subrun-test-initialized? test-run-dir)
      (let* ((info-alist (subrun:selector+log-alist
                          test-run-dir
                          "foo"))
             (run-area   (if (list? info-alist)
165
166
167
168
169
170
171
172
173
174
175
176
177






178
179
180

181
182
183
184
185
186
187
168
169
170
171
172
173
174






175
176
177
178
179
180
181
182

183
184
185
186
187
188
189
190







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


-
+







                                                                               ;; 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"))))
         (compact-stem  (subrun:sanitize-path
                         (conc
                          target
                          "-"
                          runname
                          "-" (or testpatt mode-patt tag-expr "NO-TESTPATT"))))
         (logfile       (conc
                         test-run-dir "/"
                         (or log-prefix "")
                         (or (subrun:sanitize-path log-prefix) "")
                         (if log-prefix "-" "")
                         compact-stem
                         ".log"))
         ;; swap out testpatt with modified test-patt and add -log
         (switch-alist  (cons
                         (cons "-log" logfile)
                         (map (lambda (item)