Megatest

Diff
Login

Differences From Artifact [da9f606770]:

To Artifact [b678c3717d]:


1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669









1670
1671
1672
1673
1674
1675

1676
1677
1678
1679





1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690

1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1659
1660
1661
1662
1663
1664
1665




1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679

1680
1681
1682


1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697

1698
1699
1700
1701
1702
1703
1704
1705

1706
1707
1708
1709
1710
1711
1712







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





-
+


-
-
+
+
+
+
+










-
+







-







     ((not target)
      (debug:print 0 "ERROR: Missing required parameter for " switchname ", you must specify the target with -target")
      (exit 3))
     ((not runname)
      (debug:print 0 "ERROR: Missing required parameter for " switchname ", you must specify the run name with -runname runname")
      (exit 3))
     (else
      (let (;; (db   #f)
	    (keys #f))
	(if (launch:setup-for-run)
	    (launch:cache-config)
      (let* ((keys #f)
	     (testsuite-data (common:multi-setup-for-run))
	     (configdat      (common_records:testsuite-get-configdat testsuite-data))
	     (toppath        (common_records:testsuite-get-toppath   testsuite-data)))
	(if testsuite-data
	    (common:with-vars 
	     testsuite-data
	     (lambda ()
	       (launch:cache-config testsuite-data)))
	    (begin 
	      (debug:print 0 "Failed to setup, exiting")
	      (exit 1)))
	;; (if (args:get-arg "-server")
	;;     (cdb:remote-run server:start db (args:get-arg "-server")))
	(set! keys (keys:config-get-fields *configdat*))
	(set! keys (keys:config-get-fields configdat))
	;; have enough to process -target or -reqtarg here
	(if (args:get-arg "-reqtarg")
	    (let* ((runconfigf (conc  *toppath* "/runconfigs.config")) ;; DO NOT EVALUATE ALL 
		   (runconfig  (read-config runconfigf #f #t environ-patt: #f)))
	    (let* ((runconfigf (conc  toppath "/runconfigs.config")) ;; DO NOT EVALUATE ALL 
		   (runconfig  (common:with-vars
				testsuite-data
				(lambda ()
				  (read-config runconfigf #f #t environ-patt: #f)))))
	      (if (hash-table-ref/default runconfig (args:get-arg "-reqtarg") #f)
		  (keys:target-set-args keys (args:get-arg "-reqtarg") args:arg-hash)
		    
		  (begin
		    (debug:print 0 "ERROR: [" (args:get-arg "-reqtarg") "] not found in " runconfigf)
		    ;; (if db (sqlite3:finalize! db))
		    (exit 1)
		    )))
	    (if (args:get-arg "-target")
		(keys:target-set-args keys (args:get-arg "-target" args:arg-hash) args:arg-hash)))
	(if (not (car *configinfo*))
	(if testsuite-data ;; (not (car *configinfo*))
	    (begin
	      (debug:print 0 "ERROR: Attempted to " action-desc " but run area config file not found")
	      (exit 1))
	    ;; Extract out stuff needed in most or many calls
	    ;; here then call proc
	    (let* ((keyvals    (keys:target->keyval keys target)))
	      (proc target runname keys keyvals)))
	;; (if db (sqlite3:finalize! db))
	(set! *didsomething* #t))))))

;;======================================================================
;; Lock/unlock runs
;;======================================================================

(define (runs:handle-locking target keys runname lock unlock user)