Megatest

Check-in [beccdd88ab]
Login
Overview
Comment:Better testconfig handling
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: beccdd88aba3234e71e7513eac80f62caa73bda7
User & Date: mrwellan on 2015-11-04 14:38:08
Other Links: branch diff | manifest | tags
Context
2015-11-10
08:23
better message for initial info on target, runname, and testpatt in starting a run check-in: e56f95067b user: mrwellan tags: v1.60
2015-11-05
04:16
Convert get run stats to NOT use local access, ALL db busy checks hard turned off check-in: ffdb01323d user: matt tags: v1.60-zero-local-access
2015-11-04
14:38
Better testconfig handling check-in: beccdd88ab user: mrwellan tags: v1.60
08:17
Reduced debug noise a little check-in: c443f71228 user: mrwellan tags: v1.60
Changes

Modified launch.scm from [58b47c99b7] to [2693075ecf].

353
354
355
356
357
358
359


360

361

362
363
364
365
366
367
368
353
354
355
356
357
358
359
360
361

362
363
364
365
366
367
368
369
370
371







+
+
-
+

+







	  ;; (tests:set-full-meta-info test-id run-id 0 work-area)
	  (tests:set-full-meta-info #f test-id run-id 0 work-area 10)

	  (thread-sleep! 0.3) ;; NFS slowness has caused grief here

	  (if (args:get-arg "-xterm")
	      (set! fullrunscript "xterm")
	      (if (and fullrunscript 
		       (file-exists? fullrunscript)
	      (if (and fullrunscript (not (file-execute-access? fullrunscript)))
		       (not (file-execute-access? fullrunscript)))
		  (system (conc "chmod ug+x " fullrunscript))))

	  ;; We are about to actually kick off the test
	  ;; so this is a good place to remove the records for 
	  ;; any previous runs
	  ;; (db:test-remove-steps db run-id testname itemdat)
	  
	  (let* ((m            (make-mutex))
		 (kill-job?    #f)
513
514
515
516
517
518
519
520

521
522
523
524
525
526
527
516
517
518
519
520
521
522

523
524
525
526
527
528
529
530







-
+







	    (set! job-thread th2)
	    (thread-start! th1)
	    (thread-start! th2)
	    (thread-join! th2)
	    (debug:print-info 0 "Megatest exectute of test " test-name ", item path " item-path " complete. Notifying the db ...")
	    (set! keep-going #f)
	    (thread-join! th1)
	    (thread-sleep! 1)       ;; give thread th1 a chance to be done TODO: Verify this is needed. At 0.1 I was getting fail to stop, increased to total of 1.1 sec.
	    (thread-sleep! 1)       ;; givbe thread th1 a chance to be done TODO: Verify this is needed. At 0.1 I was getting fail to stop, increased to total of 1.1 sec.
	    (mutex-lock! m)
	    (let* ((item-path (item-list->path itemdat))
		   ;; only state and status needed - use lazy routine
		   (testinfo  (rmt:get-testinfo-state-status run-id test-id)))
	      ;; Am I completed?
	      (if (member (db:test-get-state testinfo) '("REMOTEHOSTSTART" "RUNNING")) ;; NOTE: It should *not* be REMOTEHOSTSTART but for reasons I don't yet understand it sometimes gets stuck in that state ;; (not (equal? (db:test-get-state testinfo) "COMPLETED"))
		  (let ((new-state  (if kill-job? "KILLED" "COMPLETED") ;; (if (eq? (vector-ref exit-info 2) 0) ;; exited with "good" status

Modified tests.scm from [45bbca6979] to [3f7ba45550].

728
729
730
731
732
733
734


735
736


737
738
739
740
741
742
743
744
745

746

747
748
749
750
751

752
753
754
755
756
757
758
728
729
730
731
732
733
734
735
736


737
738
739
740
741
742
743
744
745
746
747
748

749
750
751
752
753

754
755
756
757
758
759
760
761







+
+
-
-
+
+









+
-
+




-
+







	     (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 #!key (force-create #f))
  (let* ((treg              (or test-registry
				(tests:get-all)))
  (let* ((test-path         (hash-table-ref/default 
			     test-registry test-name 
	 (test-path         (hash-table-ref/default 
			     treg 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 
			    (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 (not force-create)
			   (or (and cache-exists
				    cache-exists
				    (handle-exceptions
				     exn
				     (begin
				       (debug:print 0 "WARNING: Failed to read " cache-file) 
				       #f)
				       (make-hash-table)) ;; better to return a hash and keep going - I think
				     (configf:read-alist cache-file)))
			       (read-config test-configf #f system-allowed environ-patt: (if system-allowed
											     "pre-launch-env-vars"
											     #f)))
			   #f)))
    (hash-table-set! *testconfigs* test-name tcfg)
    (if (and testexists