Megatest

Check-in [daa2117aac]
Login
Overview
Comment:Merged from v1.60
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | use-dot
Files: files | file ages | folders
SHA1: daa2117aac8ea2608f956c7f3b87fc74adbb2ee8
User & Date: mrwellan on 2015-10-13 11:53:24
Other Links: branch diff | manifest | tags
Context
2015-10-13
11:54
Merged use-dot check-in: 7845036a88 user: mrwellan tags: v1.60
11:53
Merged from v1.60 Closed-Leaf check-in: daa2117aac user: mrwellan tags: use-dot
09:53
Added notes on where not to rely on testconfig cache check-in: 0e441c579d user: mrwellan tags: v1.60
2015-10-09
15:25
using dot mostly workign check-in: 719147565e user: mrwellan tags: use-dot
Changes

Modified launch.scm from [116fbde43b] to [8d485e0358].

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)
402
403
404
405
406
407
408


409

410
411
412
413
414
415
416
402
403
404
405
406
407
408
409
410

411
412
413
414
415
416
417
418







+
+
-
+







						(thread-sleep! 2)
						(loop (+ i 1)))
					      )))))
				 ;; then, if runscript ran ok (or did not get called)
				 ;; do all the ezsteps (if any)
				 (if ezsteps
				     (let* ((testconfig ;; (read-config (conc work-area "/testconfig") #f #t environ-patt: "pre-launch-env-vars")) ;; FIXME??? is allow-system ok here?
					     ;; NOTE: it is tempting to turn off force-create of testconfig but dynamic
					     ;;       ezstep names need a full re-eval here.
					     (tests:get-testconfig test-name tconfigreg #t)) ;; 'return-procs)))
					     (tests:get-testconfig test-name tconfigreg #t force-create: #t)) ;; 'return-procs)))
					    (ezstepslst (hash-table-ref/default testconfig "ezsteps" '())))
				       (hash-table-set! *testconfigs* test-name testconfig) ;; cached for lazy reads later ...
				       (if (not (file-exists? ".ezsteps"))(create-directory ".ezsteps"))
				       ;; if ezsteps was defined then we are sure to have at least one step but check anyway
				       (if (not (> (length ezstepslst) 0))
					   (debug:print 0 "ERROR: ezsteps defined but ezstepslst is zero length")
					   (let loop ((ezstep (car ezstepslst))
854
855
856
857
858
859
860
861

862
863
864
865
866
867
868
856
857
858
859
860
861
862

863
864
865
866
867
868
869
870







-
+







    (list "MT_RUNNAME"   runname)
    ;; (list "MT_TARGET"    mt_target)
    ))
  (let* ((tregistry       (tests:get-all))
	 (item-path       (let ((ip (item-list->path itemdat)))
			    (alist->env-vars (list (list "MT_ITEMPATH" ip)))
			    ip))
	 (tconfig         (or (tests:get-testconfig test-name tregistry #t)
	 (tconfig         (or (tests:get-testconfig test-name tregistry #t force-create: #t)
			      test-conf)) ;; force re-read now that all vars are set
	 (useshell        (let ((ush (config-lookup *configdat* "jobtools"     "useshell")))
			    (if ush 
				(if (equal? ush "no") ;; must use "no" to NOT use shell
				    #f
				    ush)
				#t)))     ;; default is yes

Modified tests.scm from [e3bfdc8511] to [74bec393f0].

726
727
728
729
730
731
732
733

734
735
736
737
738
739
740



741
742
743
744
745
746
747
726
727
728
729
730
731
732

733
734
735
736
737
738
739

740
741
742
743
744
745
746
747
748
749







-
+






-
+
+
+







	     (getenv "MT_TARGET")    "/"
	     (getenv "MT_RUNNAME")   "/"
	     (getenv "MT_TEST_NAME") "/"
	     (if (or (getenv "MT_ITEMPATH")
		     (not (string=? "" (getenv "MT_ITEMPATH"))))
		 (conc "/" (getenv "MT_ITEMPATH"))))))

(define (tests:get-testconfig test-name test-registry system-allowed)
(define (tests:get-testconfig test-name test-registry system-allowed #!key (force-create #f))
  (let* ((test-path         (hash-table-ref/default 
			     test-registry test-name 
			     (conc *toppath* "/tests/" test-name)))
	 (test-configf (conc test-path "/testconfig"))
	 (testexists   (and (file-exists? test-configf)(file-read-access? test-configf)))
	 (cache-path   (tests:get-test-path-from-environment))
	 (cache-exists (and cache-path (file-exists? (conc cache-path "/.testconfig"))))
	 (cache-exists (and cache-path 
			    (not force-create)  ;; if force-create then pretend there is no cache to read
			    (file-exists? (conc cache-path "/.testconfig"))))
	 (cache-file   (conc cache-path "/.testconfig"))
	 (tcfg         (if testexists
			   (or (and cache-exists
				    (handle-exceptions
				     exn
				     (begin
				       (debug:print 0 "WARNING: Failed to read " cache-file) 
821
822
823
824
825
826
827
828
829
830
831
832
833
834







835
836
837
838
839
840
841
823
824
825
826
827
828
829







830
831
832
833
834
835
836
837
838
839
840
841
842
843







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







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