Megatest

Check-in [8fd408420b]
Login
Overview
Comment:Fix issue with megatest finding it's own exectuable under dashboard (triggered by recent build improvements)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.65-broken
Files: files | file ages | folders
SHA1: 8fd408420ba2b46d851b409832a4b0eb55f33a19
User & Date: mrwellan on 2020-05-04 14:02:45
Other Links: branch diff | manifest | tags
Context
2020-05-04
16:06
Fixed the ../megatest ../dashboard issue. check-in: 19f75192e2 user: mrwellan tags: v1.65-broken
14:02
Fix issue with megatest finding it's own exectuable under dashboard (triggered by recent build improvements) check-in: 8fd408420b user: mrwellan tags: v1.65-broken
2020-05-01
23:51
Updated nanomsg and dbi dependencies check-in: 2e3a570e3e user: jmoon18 tags: v1.65-broken
Changes

Modified common.scm from [7eb16cae49] to [a60f4b1566].

226
227
228
229
230
231
232






















233
234
235
236
237
238
239
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







            (caddr argv))
           (else (car argv))))
         (fullpath (realpath this-script)))
    fullpath))
(define *common:this-exe-fullpath* (common:get-this-exe-fullpath))
(define *common:this-exe-dir*      (pathname-directory *common:this-exe-fullpath*))
(define *common:this-exe-name*     (pathname-strip-directory *common:this-exe-fullpath*))

;; when called from a wrapper I need sometimes to find the calling
;; wrapper, this is for dashboard to find the correct megatest.
;;
(define (common:find-local-megatest)
  (let ((res (filter file-exists?
		     (map (lambda (updir)
			    (let* ((lm  (car (argv)))
				   (dir (pathname-directory lm))
				   (exe (pathname-strip-directory lm)))
			      (conc (if dir (conc dir "/") "")
				    (case (string->symbol exe)
				      ((dboard)    (conc updir "megatest"))
				      ((mtest)     (conc updir "megatest"))
				      ((dashboard) "megatest")
				      (else exe)))))
			  '("../" "../../")))))
    (if (null? res)
	(begin
	  (debug:print 0 *current-log-port* "Failed to find this executable! Using what can be found on the path")
	  "megatest")
	(car res))))

(define *common:logpro-exit-code->status-sym-alist*
  '( ( 0 . pass )
     ( 1 . fail )
     ( 2 . warn )
     ( 3 . check )
     ( 4 . waived )

Modified launch.scm from [b881cd615c] to [69546387ce].

1579
1580
1581
1582
1583
1584
1585
1586

1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1579
1580
1581
1582
1583
1584
1585

1586








1587
1588
1589
1590
1591
1592
1593







-
+
-
-
-
-
-
-
-
-







	   (remote-megatest (configf:lookup *configdat* "setup" "executable"))
	   (run-time-limit  (or (configf:lookup  tconfig   "requirements" "runtimelim")
				(configf:lookup  *configdat* "setup" "runtimelim")))
	   ;; FIXME SOMEDAY: not good how this is so obtuse, this hack is to 
	   ;;                allow running from dashboard. Extract the path
	   ;;                from the called megatest and convert dashboard
	   ;;             	  or dboard to megatest
	   (local-megatest  (let* ((lm  (car (argv)))
	   (local-megatest  (common:find-local-megatest))
				   (dir (pathname-directory lm))
				   (exe (pathname-strip-directory lm)))
			      (conc (if dir (conc dir "/") "")
				    (case (string->symbol exe)
				      ((dboard)    "../megatest")
				      ((mtest)     "../megatest")
				      ((dashboard) "megatest")
				      (else exe)))))
	   (launcher        (common:get-launcher *configdat* test-name item-path)) ;; (configf:lookup *configdat* "jobtools"     "launcher"))
	   (test-sig        (conc (common:get-testsuite-name) ":" test-name ":" item-path)) ;; (item-list->path itemdat))) ;; test-path is the full path including the item-path
	   (work-area       #f)
	   (toptest-work-area #f) ;; for iterated tests the top test contains data relevant for all
	   (diskpath   #f)
	   (cmdparms   #f)
	   (fullcmd    #f) ;; (define a (with-output-to-string (lambda ()(write x))))