Megatest

Check-in [7e67a7638f]
Login
Overview
Comment:Beginnings of fix for testconfig disks issue
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | testconfig-disks-fix
Files: files | file ages | folders
SHA1: 7e67a7638fdcb905f80f1bf38975bef8ba074a27
User & Date: mrwellan on 2016-11-17 16:27:55
Other Links: branch diff | manifest | tags
Context
2016-11-17
16:27
Beginnings of fix for testconfig disks issue Closed-Leaf check-in: 7e67a7638f user: mrwellan tags: testconfig-disks-fix
2016-11-16
13:48
Try using md5sum instead of sha1. Much faster but what is the collison risk? check-in: 3e767a9aad user: mrwellan tags: v1.62, v1.6208
Changes

Modified common.scm from [41eb86f112] to [c960a0bc97].

975
976
977
978
979
980
981
982

983
984
985
986
987
988
989
975
976
977
978
979
980
981

982
983
984
985
986
987
988
989







-
+







			    (if (common:low-noise-print 300 "disks not a proper path " disk-num)
				(debug:print 0 *default-log-port* "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! best     (cons disk-num dirpath))  ;; NOTE: different storage style!
	       (set! bestsize freespc)))))
     (map car disks))
    (if (and best (> bestsize minsize))
	best
	#f))) ;; #f means no disk candidate found

;;======================================================================

Modified launch.scm from [53f264e03f] to [d59bd31ac3].

837
838
839
840
841
842
843
844
845


846
847
848
849
850
851
852



853

854
855
856
857
858
859
860
837
838
839
840
841
842
843


844
845
846
847
848
849
850
851
852
853
854
855

856
857
858
859
860
861
862
863







-
-
+
+







+
+
+
-
+







	(begin
	  (debug:print-error 0 *default-log-port* "failed to find the top path to your Megatest area.")))
    *toppath*))

(define (get-best-disk confdat testconfig)
  (let* ((disks   (or (and testconfig (hash-table-ref/default testconfig "disks" #f))
		      (hash-table-ref/default confdat "disks" #f)))
	 (minspace (let ((m (configf:lookup confdat "setup" "minspace")))
		     (string->number (or m "10000")))))
	 (minspace   (string->number (or (configf:lookup confdat "setup" "minspace")
                                         "10000"))))
    (if disks 
	(let ((res (common:get-disk-with-most-free-space disks minspace))) ;; min size of 1000, seems tad dumb
	  (if res
	      (cdr res)
	      (begin
		(if (common:low-noise-print 20 "No valid disks or no disk with enough space")
		    (debug:print-error 0 *default-log-port* "No valid disks found in megatest.config. Please add some to your [disks] section and ensure the directory exists and has enough space!\n    You can change minspace in the [setup] section of megatest.config. Current setting is: " minspace))
		(exit 1))))
        (begin
          (debug:print-error 0 *default-log-port* "No valid disks found in megatest.config. Please add some to your [disks] section and ensure the directory exists and has enough space!\n    You can change minspace in the [setup] section of megatest.config. Current setting is: " minspace)
		(exit 1)))))))
          (exit 1)))))

;; Desired directory structure:
;;
;;  <linkdir> - <target> - <testname> -.
;;                                     |
;;                                     v
;;  <rundir>  -  <target>  -    <testname> -|- <itempath(s)>

Modified tests.scm from [8d5f3a1ead] to [96ea51b20e].

987
988
989
990
991
992
993

994
995
996
997
998
999
1000
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001







+







			    #f ;; any issues, just give up with the cached version and re-read
			    (configf:read-alist cache-file))
			   #f)))
    (if cached-dat
	cached-dat
	(let ((dat (hash-table-ref/default *testconfigs* test-name #f)))
	  (if (and  dat ;; have a locally cached version
                    (not force-create)
		    (hash-table-ref/default dat "have fulldata" #f)) ;; marked as good data?
	      dat
	      ;; no cached data available
	      (let* ((treg         (or test-registry
				       (tests:get-all)))
		     (test-path    (or (hash-table-ref/default treg test-name #f)
				       (conc *toppath* "/tests/" test-name)))