Megatest

Diff
Login

Differences From Artifact [6cea658ad9]:

To Artifact [f48ffb3bcd]:


2010
2011
2012
2013
2014
2015
2016
2017

2018
2019
2020
2021
2022
2023
2024
2010
2011
2012
2013
2014
2015
2016

2017
2018
2019
2020
2021
2022
2023
2024







-
+







;;
(define (runs:get-hash-by-target target-patts runpatt)
  (let* ((targets (string-split target-patts ","))
	 (keys    (rmt:get-keys))
	 (res-ht  (make-hash-table))) ;; target -> ( runrecord1 runrecord2 ... )
    (for-each
     (lambda (target-patt)
       (let ((runs     (rmt:simple-get-runs runpatt #f #f target-patt)))
       (let ((runs     (rmt:simple-get-runs runpatt #f #f target-patt #f)))
	 (for-each
	  (lambda (run)
	    (let ((target (simple-run-target run)))
	      (hash-table-set! res-ht target (cons run (hash-table-ref/default res-ht target '())))))
	  runs)))
     targets)
    res-ht))
2167
2168
2169
2170
2171
2172
2173
2174


2175
2176

2177
2178



2179
2180
2181


2182
2183
2184
2185
2186
2187
2188
2167
2168
2169
2170
2171
2172
2173

2174
2175
2176

2177
2178

2179
2180
2181
2182


2183
2184
2185
2186
2187
2188
2189
2190
2191







-
+
+

-
+

-
+
+
+

-
-
+
+







		   ((run-wait)
		    (debug:print 1 *default-log-port* "Waiting for run " runkey ", run=" runnamepatt " to complete"))
		   ((archive)
		    (debug:print 1 *default-log-port* "Archiving/restoring (" (args:get-arg "-archive") ") data for run: " runkey " " (db:get-value-by-header run header "runname"))
		    (set! worker-thread
			  (make-thread
			   (lambda ()
			     (case (string->symbol (args:get-arg "-archive"))
			     (let ((op (string->symbol (args:get-arg "-archive"))))
			       (case op
			       ((save save-remove keep-html)
				(archive:run-bup (args:get-arg "-archive") run-id run-name tests rp-mutex bup-mutex))
				(archive:run-bup op run-id run-name tests rp-mutex bup-mutex))
			       ((restore)
				(archive:bup-restore (args:get-arg "-archive") run-id run-name tests rp-mutex bup-mutex))
				(archive:bup-restore op run-id run-name tests rp-mutex bup-mutex))
			       ((get)
				(archive:bup-get-data op run-id run-name tests rp-mutex bup-mutex))
			       (else 
				(debug:print-error 0 *default-log-port* "unrecognised sub command to -archive. Run \"megatest\" to see help")
				(exit))))
				(debug:print-error 0 *default-log-port* "unrecognised sub command " op " for -archive. Run \"megatest\" to see help")
				(exit)))))
			   "archive-bup-thread"))
		    (thread-start! worker-thread))
		   (else
		    (debug:print-info 0 *default-log-port* "action not recognised " action)))
		 
		 ;; actions that operate on one test at a time can be handled below
		 ;;
2498
2499
2500
2501
2502
2503
2504
2505

2506
2507
2508
2509
2510
2511
2512
2501
2502
2503
2504
2505
2506
2507

2508
2509
2510
2511
2512
2513
2514
2515







-
+







;;======================================================================
;; Routines for manipulating runs
;;======================================================================

;; Since many calls to a run require pretty much the same setup 
;; this wrapper is used to reduce the replication of code
(define (general-run-call switchname action-desc proc)
  (let ((runname (or (args:get-arg "-runname")(args:get-arg ":runname")))
  (let ((runname (common:args-get-runname))
	(target  (common:args-get-target)))
    (cond
     ((not target)
      (debug:print-error 0 *default-log-port* "Missing required parameter for " switchname ", you must specify the target with -target")
      (exit 3))
     ((not runname)
      (debug:print-error 0 *default-log-port* "Missing required parameter for " switchname ", you must specify the run name with -runname runname")