Megatest

Diff
Login

Differences From Artifact [92a59bf1dc]:

To Artifact [3dab83a5af]:


456
457
458
459
460
461
462
463

464
465
466
467
468
469
470
471
472
473
474
456
457
458
459
460
461
462

463




464
465
466
467
468
469
470







-
+
-
-
-
-







		  ;; (print "[" x "]"))
		  (print x))
		targets)
      (set! *didsomething* #t)))

(define (full-runconfigs-read)
  (let* ((keys   (cdb:remote-run db:get-keys #f))
	 (target (if (args:get-arg "-reqtarg")
	 (target (common:args-get-target))
		     (args:get-arg "-reqtarg")
		     (if (args:get-arg "-target")
			 (args:get-arg "-target")
			 #f)))
	 (key-vals (if target (keys:target->keyval keys target) #f))
	 (sections (if target (list "default" target) #f))
	 (data     (begin
		     (setenv "MT_RUN_AREA_HOME" *toppath*)
		     (if key-vals
			 (for-each (lambda (kt)
				     (setenv (car kt) (cadr kt)))
520
521
522
523
524
525
526
527

528
529
530
531
532
533
534
535
516
517
518
519
520
521
522

523

524
525
526
527
528
529
530







-
+
-







;; Remove old run(s)
;;======================================================================

;; since several actions can be specified on the command line the removal
;; is done first
(define (operate-on action)
  (let* ((runrec (runs:runrec-make-record))
	 (target (or (args:get-arg "-reqtarg")
	 (target (common:args-get-target)))
		     (args:get-arg "-target"))))
    (cond
     ((not target)
      (debug:print 0 "ERROR: Missing required parameter for " action ", you must specify -target or -reqtarg")
      (exit 1))
     ((not (args:get-arg ":runname"))
      (debug:print 0 "ERROR: Missing required parameter for " action ", you must specify the run name pattern with :runname patt")
      (exit 2))
567
568
569
570
571
572
573
574
575



576
577
578
579
580
581
582
562
563
564
565
566
567
568


569
570
571
572
573
574
575
576
577
578







-
-
+
+
+








(if (or (args:get-arg "-set-run-status")
	(args:get-arg "-get-run-status"))
    (general-run-call
     "-set-run-status"
     "set run status"
     (lambda (target runname keys keyvals)
       (let* ((runsdat  (cdb:remote-run db:get-runs-by-patt #f keys runname (or (args:get-arg "-target")
									       (args:get-arg "-reqtarg")) #f #f))
       (let* ((runsdat  (cdb:remote-run db:get-runs-by-patt #f keys runname 
					(common:args-get-target)
					#f #f))
	      (header   (vector-ref runsdat 0))
	      (rows     (vector-ref runsdat 1)))
	 (if (null? rows)
	     (begin
	       (debug:print-info 0 "No matching run found.")
	       (exit 1))
	     (let* ((row      (car (vector-ref runsdat 1)))
595
596
597
598
599
600
601
602
603



604
605
606
607
608
609
610
591
592
593
594
595
596
597


598
599
600
601
602
603
604
605
606
607







-
-
+
+
+







    (if (setup-for-run)
	(let* ((db       #f)
	       (runpatt  (args:get-arg "-list-runs"))
	       (testpatt (if (args:get-arg "-testpatt") 
			     (args:get-arg "-testpatt") 
			     "%"))
	       (keys     (cdb:remote-run db:get-keys #f))
	       (runsdat  (cdb:remote-run db:get-runs-by-patt #f keys runpatt (or (args:get-arg "-target")
										 (args:get-arg "-reqtarg")) #f #f))
	       (runsdat  (cdb:remote-run db:get-runs-by-patt #f keys runpatt
					 (common:args-get-target)
					 #f #f))
		;; (cdb:remote-run db:get-runs #f runpatt #f #f '()))
	       (runs     (db:get-rows runsdat))
	       (header   (db:get-header runsdat))
	       (db-targets (args:get-arg "-list-db-targets"))
	       (seen     (make-hash-table)))
	  ;; Each run
	  (for-each