Megatest

Check-in [b95936eb28]
Login
Overview
Comment:Improvements to -list-targets for RobertG
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.60
Files: files | file ages | folders
SHA1: b95936eb28386c28a35c88fbe46d5580bb558a5d
User & Date: mrwellan on 2015-11-04 08:09:34
Other Links: branch diff | manifest | tags
Context
2015-11-04
08:17
Reduced debug noise a little check-in: c443f71228 user: mrwellan tags: v1.60
08:09
Improvements to -list-targets for RobertG check-in: b95936eb28 user: mrwellan tags: v1.60
2015-11-02
09:36
Don't updated stored cpu/disk space unless changed more than 200 Meg or .6 load check-in: c7ef1b27a4 user: mrwellan tags: v1.60
Changes

Modified common.scm from [1ec3dc239a] to [2955bbfc6b].

393
394
395
396
397
398
399
400
401
402
403
404
405












406
407
408
409
410
411
412
393
394
395
396
397
398
399






400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418







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







		 (set! res #t))))
	 (string-split patts ","))
	res)
      #t))

;; (map print (map car (hash-table->alist (read-config "runconfigs.config" #f #t))))
(define (common:get-runconfig-targets #!key (configf #f))
  (sort (map car (hash-table->alist
		  (or configf
		      (read-config (conc *toppath* "/runconfigs.config")
			       #f #t)
		      (make-hash-table))))
	string<?))
  (let ((targs       (sort (map car (hash-table->alist
				     (or configf
					 (read-config (conc *toppath* "/runconfigs.config")
						      #f #t)
					 (make-hash-table))))
			   string<?))
	(target-patt (args:get-arg "-target")))
    (if target-patt
	(filter (lambda (x)
		  (patt-list-match x target-patt))
		targs)
	targs)))

;; '(print (string-intersperse (map cadr (hash-table-ref/default (read-config "megatest.config" \#f \#t) "disks" '"'"'("none" ""))) "\n"))'
(define (common:get-disks #!key (configf #f))
  (hash-table-ref/default 
   (or configf (read-config "megatest.config" #f #t))
   "disks" '("none" "")))

662
663
664
665
666
667
668
669

670
671
672
673

674
675
676
677

678
679
680
681
682
683
684
668
669
670
671
672
673
674

675
676
677
678

679
680
681
682

683
684
685
686
687
688
689
690







-
+



-
+



-
+







	(bestsize 0))
    (for-each 
     (lambda (disk-num)
       (let* ((dirpath    (cadr (assoc disk-num disks)))
	      (freespc    (cond
			   ((not (directory? dirpath))
			    (if (common:low-noise-print 50 "disks not a dir " disk-num)
				(debug:print 0 "WARNING: disk " disk-num " at path " dirpath " is not a directory - ignoring it."))
				(debug:print 0 "WARNING: disk " disk-num " at path \"" dirpath "\" is not a directory - ignoring it."))
			    -1)
			   ((not (file-write-access? dirpath))
			    (if (common:low-noise-print 50 "disks not writeable " disk-num)
				(debug:print 0 "WARNING: disk " disk-num " at path " dirpath " is not writeable - ignoring it."))
				(debug:print 0 "WARNING: disk " disk-num " at path \"" dirpath "\" is not writeable - ignoring it."))
			    -1)
			   ((not (eq? (string-ref dirpath 0) #\/))
			    (if (common:low-noise-print 50 "disks not a proper path " disk-num)
				(debug:print 0 "WARNING: disk " disk-num " at path " dirpath " is not a fully qualified path - ignoring it."))
				(debug:print 0 "WARNING: disk " disk-num " at path \"" dirpath "\" is not a fully qualified path - ignoring it."))
			    -1)
			   (else
			    (get-df dirpath)))))
	 (if (> freespc bestsize)
	     (begin
	       (set! best     (cons disk-num dirpath))
	       (set! bestsize freespc)))))

Modified megatest.scm from [be504e6804] to [47f4506230].

756
757
758
759
760
761
762
763

764
765
766
767
768
769
770
756
757
758
759
760
761
762

763
764
765
766
767
768
769
770







-
+








;;======================================================================
;; Weird special calls that need to run *after* the server has started?
;;======================================================================

(if (args:get-arg "-list-targets")
    (let ((targets (common:get-runconfig-targets)))
      (print "Found "(length targets) " targets")
      (debug:print 1 "Found "(length targets) " targets")
      (case (string->symbol (or (args:get-arg "-dumpmode") "alist"))
	((alist)
	 (for-each (lambda (x)
		     ;; (print "[" x "]"))
		     (print x))
		   targets))
	((json)
939
940
941
942
943
944
945


946
947
948
949
950
951
952
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954







+
+







    (if indx
	(if (>= indx (vector-length datavec))
	    #f ;; index to high, should raise an error I suppose
	    (vector-ref datavec indx))
	#f)))

;; NOTE: list-runs and list-db-targets operate on local db!!!
;;
;; IDEA: megatest list -runname blah% ...
;;
(if (or (args:get-arg "-list-runs")
	(args:get-arg "-list-db-targets"))
    (if (launch:setup-for-run)
	(let* (;; (dbstruct    (make-dbr:dbstruct path: *toppath* local: (args:get-arg "-local")))
	       (runpatt     (args:get-arg "-list-runs"))
	       (testpatt    (common:args-get-testpatt #f))