Megatest

Check-in [a556b1654d]
Login
Overview
Comment:Oops, left in a bit of broken debugging code.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: a556b1654d5d32c7239354fc476bf39d054016b1
User & Date: mrwellan on 2015-10-12 14:43:48
Other Links: branch diff | manifest | tags
Context
2015-10-13
09:20
Force regen of .testconfig when launching check-in: 3f98dd071c user: mrwellan tags: v1.60
2015-10-12
14:43
Oops, left in a bit of broken debugging code. check-in: a556b1654d user: mrwellan tags: v1.60
2015-10-09
00:53
Use dot for sorting tests check-in: 7a86111233 user: matt tags: v1.60
Changes

Modified launch.scm from [116fbde43b] to [ce6bfd9d0c].

212
213
214
215
216
217
218
219

220
221
222
223
224
225
226
212
213
214
215
216
217
218

219
220
221
222
223
224
225
226







-
+







                                              runscript))))) ;; assume it is on the path
	       ;; (rollup-status 0)
	       )

	  ;; NFS might not have propagated the directory meta data to the run host - give it time if needed
	  (let loop ((count 0))
	    (if (or (file-exists? top-path)
		    (< count 10))
		    (> count 10))
		(change-directory top-path)
		(begin
		  (debug:print 0 "INFO: Not starting job yet - directory " top-path " not found")
		  (thread-sleep! 10)
		  (loop (+ count 1)))))

	  (let ((sighand (lambda (signum)
291
292
293
294
295
296
297
298

299
300
301
302
303
304
305

306
307
308
309
310
311
312
291
292
293
294
295
296
297

298
299
300
301
302
303
304

305
306
307
308
309
310
311
312







-
+






-
+







					  (debug:print 0 "ERROR: bad variable spec, " var "=" val))))
				  (configf:get-section rconfig section)))
		      (list "default" target)))

	  ;; NFS might not have propagated the directory meta data to the run host - give it time if needed
	  (let loop ((count 0))
	    (if (or (file-exists? work-area)
		    (< count 10))
		    (> count 10))
		(change-directory work-area)
		(begin
		  (debug:print 0 "INFO: Not starting job yet - directory " work-area " not found")
		  (thread-sleep! 10)
		  (loop (+ count 1)))))

	  (change-directory work-area) 
	  ;; (change-directory work-area) 
	  (set! keyvals    (keys:target->keyval keys target))
	  ;; apply pre-overrides before other variables. The pre-override vars must not
	  ;; clobbers things from the official sources such as megatest.config and runconfigs.config
	  (if (string? set-vars)
	      (let ((varpairs (string-split set-vars ",")))
		(debug:print 4 "varpairs: " varpairs)
		(map (lambda (varpair)

Modified tests.scm from [528a547e4b] to [fd964d81a0].

821
822
823
824
825
826
827
828
829
830
831
832
833
834







835
836
837
838
839
840
841
821
822
823
824
825
826
827







828
829
830
831
832
833
834
835
836
837
838
839
840
841







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







	 
	 (sort-fn2
	  (lambda (a b)
	    (> (mungepriority (tests:testqueue-get-priority (hash-table-ref test-records a)))
	       (mungepriority (tests:testqueue-get-priority (hash-table-ref test-records b)))))))
    ;; (let ((dot-res (tests:run-dot (tests:tests->dot test-records) "plain")))
    ;;   (debug:print "dot-res=" dot-res))
    (let ((data (map cdr (filter
			  (lambda (x)(equal? "node" (car x)))
			  (map string-split (tests:easy-dot test-records "plain"))))))
      (map car (sort data (lambda (a b)
			    (> (string->number (caddr a))(string->number (caddr b)))))))
    ))
    ;; (sort all-tests sort-fn1))) ;; avoid dealing with deleted tests, look at the hash table
    ;; (let ((data (map cdr (filter
    ;;     		  (lambda (x)(equal? "node" (car x)))
    ;;     		  (map string-split (tests:easy-dot test-records "plain"))))))
    ;;   (map car (sort data (lambda (a b)
    ;;     		    (> (string->number (caddr a))(string->number (caddr b)))))))
    ;; ))
    (sort all-tests sort-fn1))) ;; avoid dealing with deleted tests, look at the hash table

(define (tests:easy-dot test-records outtype)
  (let-values (((fd temp-path) (file-mkstemp (conc "/tmp/" (current-user-name) ".XXXXXX"))))
    (let ((all-testnames (hash-table-keys test-records))
	  (temp-port     (open-output-file* fd)))
      ;; (format temp-port "This file is ~A.~%" temp-path)
      (format temp-port "digraph tests {\n")