Megatest

Diff
Login

Differences From Artifact [5cc50f038e]:

To Artifact [d7026e5f70]:


826
827
828
829
830
831
832
833

834
835
836
837
838
839
840

;; (use trace)(trace create-run-pkt)
(define (contains list x) (cond ((null? list) #f) ((eq? (car list) x) #t) (else (contains (cdr list) x))))

;; collect all needed data and create run pkts for contours with changed inputs
;;
(define (generate-run-pkts mtconf toppath)
  (let ((std-runname (conc "sched"  (time->string (seconds->local-time (current-seconds)) "%M%H%d"))))

    (common:with-queue-db
     mtconf
     (lambda (pktsdirs pktsdir pdb)
       (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"))







|
>







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

;; (use trace)(trace create-run-pkt)
(define (contains list x) (cond ((null? list) #f) ((eq? (car list) x) #t) (else (contains (cdr list) x))))

;; collect all needed data and create run pkts for contours with changed inputs
;;
(define (generate-run-pkts mtconf toppath)
  (let ((std-runname (conc "sched"  (time->string (seconds->local-time (current-seconds)) "%M%H%d")))
        (packets-generated 0))
    (common:with-queue-db
     mtconf
     (lambda (pktsdirs pktsdir pdb)
       (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"))
1009
1010
1011
1012
1013
1014
1015

1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
		       (lambda (cmd)
			 ;;(print "cmd: " cmd)
                         ;;(print "Areas: " all-areas)
                         (for-each 
                           (lambda (area) 
;Add code to check whether area is valid
			     (if 

                   (if (args:get-arg "-target") 
                     (if (string= (args:get-arg "-target") runkey) (area-allowed? area "area-needs-to-be-run" runkey contour #f) #f) 
                     (area-allowed? area "area-needs-to-be-run" runkey contour #f))
       
			     (let* ((script (car cmd))
				(params (cdr cmd))
				(cmd    (conc script " " contour " " area " " runkey " " std-runname " " action " " params))
				(res    (handle-exceptions
					    exn
					    #f







>
|

|







1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
		       (lambda (cmd)
			 ;;(print "cmd: " cmd)
                         ;;(print "Areas: " all-areas)
                         (for-each 
                           (lambda (area) 
;Add code to check whether area is valid
			     (if 
                   ;; This code checks whether the target has been passed in via argument, and only runs the specified target
                   (and (< packets-generated 4)  (if (args:get-arg "-target") 
                     (if (string= (args:get-arg "-target") runkey) (area-allowed? area "area-needs-to-be-run" runkey contour #f) #f) 
                     (area-allowed? area "area-needs-to-be-run" runkey contour #f)))
       
			     (let* ((script (car cmd))
				(params (cdr cmd))
				(cmd    (conc script " " contour " " area " " runkey " " std-runname " " action " " params))
				(res    (handle-exceptions
					    exn
					    #f
1094
1095
1096
1097
1098
1099
1100

1101
1102
1103


1104
1105
1106
1107
1108
1109
1110
							  ;;(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 new-runname mode-patt
                                                      tag-expr pktsdir reason contour sched dbdest append
                                                      runtrans)) targets)


					;; Add filter for targets

                                       ;;(create-run-pkt mtconf action area runkey target runname
                                       ;;               pktsdir reason contour dbdest append
                                       ;;               runtrans)
				       (print "key-msg: " key-msg)
				       ;;(push-run-spec torun contour







>
|

|
>
>







1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
							  ;;(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 new-runname mode-patt
                                                      tag-expr pktsdir reason contour sched dbdest append
                                                      runtrans)
                                                     (set! packets-generated (+ packets-generated 1))
                                                  ) targets)
					;; Add filter for targets

                                       ;;(create-run-pkt mtconf action area runkey target runname
                                       ;;               pktsdir reason contour dbdest append
                                       ;;               runtrans)
				       (print "key-msg: " key-msg)
				       ;;(push-run-spec torun contour