Overview
Context
Changes
Modified configf.scm
from [aeb220e9e6]
to [f3836ab576].
| ︙ | | |
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
-
-
-
+
+
+
+
+
|
;; Run a shell command and return the output as a string
(define (shell cmd)
(let* ((output (cmd-run->list cmd))
(res (car output))
(status (cadr output)))
(if (equal? status 0)
(string-intersperse
res
"\n")
(let ((outres (string-intersperse
res
"\n")))
(debug:print 4 "INFO: shell result:\n" outres)
outres)
(begin
(with-output-to-port (current-error-port)
(print "ERROR: " cmd " returned bad exit code " status))
""))))
;; Lookup a value in runconfigs based on -reqtarg or -target
(define (runconfigs-get config var)
|
| ︙ | | |
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
|
+
-
+
+
|
(configf:section-rx ( x section-name ) (loop (configf:read-line inp res) section-name #f #f))
(configf:key-sys-pr ( x key cmd ) (if allow-system
(let ((alist (hash-table-ref/default res curr-section-name '()))
(val-proc (lambda ()
(let* ((cmdres (cmd-run->list cmd))
(status (cadr cmdres))
(res (car cmdres)))
(debug:print 4 "INFO: " inl "\n => " (string-intersperse res "\n"))
(if (not (eq? status 0))
(begin
(debug:print 0 "ERROR: problem with " inl ", return code " status)
(debug:print 0 "ERROR: problem with " inl ", return code " status
" output: " cmdres)
(exit 1)))
(if (null? res)
""
(string-intersperse res " "))))))
(hash-table-set! res curr-section-name
(config:assoc-safe-add alist
key
|
| ︙ | | |
Modified launch.scm
from [c99403d780]
to [f72ebdf466].
| ︙ | | |
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
|
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
|
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+
|
(cmdparms #f)
(fullcmd #f) ;; (define a (with-output-to-string (lambda ()(write x))))
(mt-bindir-path #f)
(item-path (item-list->path itemdat))
(testinfo (rdb:get-test-info db run-id test-name item-path))
(test-id (db:test-get-id testinfo))
(debug-param (if (args:get-arg "-debug")(list "-debug" (args:get-arg "-debug")) '())))
(if hosts (set! hosts (string-split hosts)))
(if hosts (set! hosts (string-split hosts)))
;; set the megatest to be called on the remote host
(if (not remote-megatest)(set! remote-megatest local-megatest)) ;; "megatest"))
(set! mt-bindir-path (pathname-directory remote-megatest))
(if launcher (set! launcher (string-split launcher)))
;; set up the run work area for this test
(set! diskpath (get-best-disk *configdat*))
(if diskpath
(let ((dat (create-work-area db run-id test-path diskpath test-name itemdat)))
(set! work-area (car dat))
(set! toptest-work-area (cadr dat))
(debug:print 2 "INFO: Using work area " work-area))
(begin
(set! work-area (conc test-path "/tmp_run"))
(create-directory work-area #t)
(debug:print 0 "WARNING: No disk work area specified - running in the test directory under tmp_run")))
(set! cmdparms (base64:base64-encode (with-output-to-string
(lambda () ;; (list 'hosts hosts)
(write (list (list 'testpath test-path)
(list 'work-area work-area)
(list 'test-name test-name)
(list 'runscript runscript)
(list 'run-id run-id )
(list 'test-id test-id )
(list 'itemdat itemdat )
(list 'megatest remote-megatest)
(list 'ezsteps ezsteps)
(list 'env-ovrd (hash-table-ref/default *configdat* "env-override" '()))
(list 'set-vars (if params (hash-table-ref/default params "-setvars" #f)))
(list 'runname runname)
(list 'mt-bindir-path mt-bindir-path))))))) ;; (string-intersperse keyvallst " "))))
(lambda () ;; (list 'hosts hosts)
(write (list (list 'testpath test-path)
(list 'work-area work-area)
(list 'test-name test-name)
(list 'runscript runscript)
(list 'run-id run-id )
(list 'test-id test-id )
(list 'itemdat itemdat )
(list 'megatest remote-megatest)
(list 'ezsteps ezsteps)
(list 'env-ovrd (hash-table-ref/default *configdat* "env-override" '()))
(list 'set-vars (if params (hash-table-ref/default params "-setvars" #f)))
(list 'runname runname)
(list 'mt-bindir-path mt-bindir-path))))))) ;; (string-intersperse keyvallst " "))))
;; clean out step records from previous run if they exist
(db:delete-test-step-records db run-id test-name itemdat)
(change-directory work-area) ;; so that log files from the launch process don't clutter the test dir
(cond
((and launcher hosts) ;; must be using ssh hostname
(set! fullcmd (append launcher (car hosts)(list remote-megatest test-sig "-execute" cmdparms) debug-param)))
;; (set! fullcmd (append launcher (car hosts)(list remote-megatest test-sig "-execute" cmdparms))))
;; (set! fullcmd (append launcher (list remote-megatest test-sig "-execute" cmdparms))))
;; (set! fullcmd (list remote-megatest test-sig "-execute" cmdparms (if useshell "&" "")))))
|
| ︙ | | |