Megatest

Changes On Branch 7a8dbd329924b2c3
Login

Changes In Branch v1.6512a Excluding Merge-Ins

This is equivalent to a diff from fb7e6638f8 to 7a8dbd3299

2018-08-10
16:31
Merged mtutil changes into main 1.65 branch check-in: 058bef1510 user: jmoon18 tags: v1.65
11:52
Trimmed mtutil chattiness Leaf check-in: 7a8dbd3299 user: jmoon18 tags: v1.6512a
2018-08-01
10:58
Cherry-picked b04e check-in: 52591d24f4 user: mrwellan tags: v1.6512a
2018-07-10
13:47
Add a condition such that,the polling stops when it crosses 5000. check-in: 97716c5057 user: raghavki tags: v1.65
2018-07-02
11:44
Updated megatest version file check-in: fb7e6638f8 user: jmoon18 tags: v1.65, v1.6512
11:41
Updates to area-script trigger to filter packets by area check-in: d55ba5cbfd user: jmoon18 tags: v1.65

Modified common.scm from [2027cc1cac] to [eee99cc654].

57
58
59
60
61
62
63
64
65


66
67
68
69
70
71
72
57
58
59
60
61
62
63


64
65
66
67
68
69
70
71
72







-
-
+
+







                                              (print-error-message exn) ))))
     (debug:print-info 0 *default-log-port* "    -- continuing after nonfatal condition...")
     #f)
   (thunk)))

(define getenv get-environment-variable)
(define (safe-setenv key val)
  (if (substring-index ":" key) ;; variables containing : are for internal use and cannot be environment variables.
      (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\"")
  (if (or (substring-index "!" key) (substring-index ":" key)) ;; variables containing : are for internal use and cannot be environment variables.
      (debug:print-error 4 *default-log-port* "skip setting internal use only variables containing \":\" or starting with \"!\"")
      (if (and (string? val)
	       (string? key))
	  (handle-exceptions
	      exn
	      (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val)
	    (setenv key val))
	  (debug:print-error 0 *default-log-port* "bad value for setenv, key=" key ", value=" val))))

Modified launch.scm from [46cdbaf4d6] to [7244e4f2ae].

652
653
654
655
656
657
658
659

660
661
662
663
664
665
666
652
653
654
655
656
657
658

659
660
661
662
663
664
665
666







-
+







	     (lambda (section)
	       (for-each
		(lambda (varval)
		  (let ((var (car varval))
			(val (cadr varval)))
		    (if (and (string? var)(string? val))
			(begin
			  (setenv var (config:eval-string-in-environment val))) ;; val)
			  (safe-setenv var (config:eval-string-in-environment val))) ;; val)
			(debug:print-error 0 *default-log-port* "bad variable spec, " var "=" val))))
		(configf:get-section rconfig section)))
	     (list "default" target)))
          ;;(bb-check-path msg: "launch:execute post block 1")

	  ;; NFS might not have propagated the directory meta data to the run host - give it time if needed
	  (let loop ((count 0))

Modified mtut.scm from [9ba5c38876] to [2156541bf3].

786
787
788
789
790
791
792
793

794
795
796
797
798
799
800
786
787
788
789
790
791
792

793
794
795
796
797
798
799
800







-
+







       (let* ((rgconfdat (find-and-read-config (conc toppath "/runconfigs.config")))
	      (rgconf    (car rgconfdat))
	      (all-areas (map car (configf:get-section mtconf "areas")))
	      (contours  (configf:get-section mtconf "contours"))
	      (torun     (make-hash-table)) ;; target => ( ... info ... )
	      (rgentargs (hash-table-keys rgconf))) ;; these are the targets registered for automatically triggering

	 (print "rgentargs: " rgentargs)
	 ;;(print "rgentargs: " rgentargs)
	 
	 (for-each
	  (lambda (runkey)
	    (let* ((keydats   (configf:get-section rgconf runkey)))
	      (for-each
	       (lambda (sense) ;; these are the sense rules
		 (let* ((key        (car sense))
946
947
948
949
950
951
952
953
954


955
956
957
958
959
960
961
946
947
948
949
950
951
952


953
954
955
956
957
958
959
960
961







-
-
+
+







		     ;;
		     ((area-script)
		      ;; syntax is a little different here. It is a list of commands to run, "scriptname = extra_parameters;scriptname = ..."
		      ;; where scriptname may be repeated multiple times. The script must return unix-epoch of last change, new-target-name and new-run-name
		      ;; the script is called like this:  scriptname contour runkey std-runname action extra_param1 extra_param2 ...
		      (for-each
		       (lambda (cmd)
			 (print "cmd: " cmd)
                         (print "Areas: " all-areas)
			 ;;(print "cmd: " cmd)
                         ;;(print "Areas: " all-areas)
                         (for-each 
                           (lambda (area) 
			     (if (area-allowed? area "area-needs-to-be-run" runkey contour #f) ;; is this area to be handled (from areas=a,b,c OR using areafn=abcfn and *area-checks* ...)
       
			     (let* ((script (car cmd))
				(params (cdr cmd))
				(cmd    (conc script " " contour " " area " " runkey " " std-runname " " action " " params))
1025
1026
1027
1028
1029
1030
1031
1032

1033
1034
1035
1036
1037
1038
1039
1025
1026
1027
1028
1029
1030
1031

1032
1033
1034
1035
1036
1037
1038
1039







-
+







							  ;;(target   . ,(list new-target)) ;; overriding with result from runing the script
                                                          ))
							(aval       (or (configf:lookup mtconf "areas" area) ""))
                                    			(aval-alist (common:val->alist aval))

							(targets (map-targets mtconf aval-alist runkey area contour)))
                                        (pp targets)
				        (for-each (lambda (target) (create-run-pkt mtconf action area runkey target runname mode-patt
				        (for-each (lambda (target) (create-run-pkt mtconf action area runkey target new-runname mode-patt
                                                      tag-expr pktsdir reason contour sched dbdest append
                                                      runtrans)) targets)

                                       ;;(create-run-pkt mtconf action area runkey target runname
                                       ;;               pktsdir reason contour dbdest append
                                       ;;               runtrans)
				       (print "key-msg: " key-msg)
1184
1185
1186
1187
1188
1189
1190
1191
1192


1193
1194
1195
1196
1197
1198
1199
1184
1185
1186
1187
1188
1189
1190


1191
1192
1193
1194
1195
1196
1197
1198
1199







-
-
+
+







                                    (dbdest     (alist-ref 'dbdest  runkeydat))
                                    (append     (alist-ref 'append  runkeydat))
                                    (targets    ;;(or (alist-ref 'target  runkeydat)
                                                    (map-targets mtconf aval-alist runkey area contour))) ;; override with target if forced
                                    ;;(targets    (or (alist-ref 'target  runkeydat)
                                    ;;                (map-targets mtconf aval-alist runkey area contour)))) ;; override with target if forced
                               ;; NEED TO EXPAND RUNKEY => ALL TARGETS MAPPED AND THEN FOREACH .... 
                               (print "Targets: " targets)
                               (print "alist: " (alist-ref 'target runkeydat))
                               ;;(print "Targets: " targets)
                               ;;(print "alist: " (alist-ref 'target runkeydat))
                               (for-each
                                (lambda (target)
                                  (print "Creating pkt for runkey=" runkey " target=" target " contour=" contour " area=" area " action=" action " tag-expr=" tag-expr " mode-patt=" mode-patt)
                                  (if (case (or (and action (string->symbol action)) 'noaction)  ;; ensure we have the needed data to run this action
                                        ((noaction)           #f)
                                        ((run)                (and runname reason))
                                        ((sync sync-prepend)  (and reason dbdest))