Megatest

Check-in [b077e2bbcd]
Login
Overview
Comment:Added helpful (hopefully) output on system and shell from config processing and launch processes
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b077e2bbcd891acd09509ac461d90e17fd65f9c6
User & Date: mrwellan on 2012-04-12 16:14:02
Other Links: manifest | tags
Context
2012-04-17
17:53
Put megatest into wrapper check-in: c06a5da0d3 user: mrwellan tags: trunk
2012-04-12
16:14
Added helpful (hopefully) output on system and shell from config processing and launch processes check-in: b077e2bbcd user: mrwellan tags: trunk
00:55
Added -set-state-status to enable setting state and status check-in: 29cc9e826e user: matt tags: trunk
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 
	(let ((outres (string-intersperse 
	 res
	 "\n")
		       "\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].

whitespace changes only