Megatest

Diff
Login

Differences From Artifact [15a97345bd]:

To Artifact [ba7f6d2131]:


488
489
490
491
492
493
494
495




496



497
498

499


500
501
502
503
504
505
506
507
508

509
510
511
512
513
514
515
516
  (let* ((disks    (hash-table-ref/default confdat "disks" #f))
	 (best     #f)
	 (bestsize 0))
    (if disks 
	(for-each 
	 (lambda (disk-num)
	   (let* ((dirpath    (cadr (assoc disk-num disks)))
		  (freespc    (if (and (directory? dirpath)




				       (file-write-access? dirpath))



				  (get-df dirpath)
				  (begin

				    (debug:print 0 "WARNING: path " dirpath " in [disks] section not valid or writable")


				    0))))
	     (if (> freespc bestsize)
		 (begin
		   (set! best     dirpath)
		   (set! bestsize freespc)))))
	 (map car disks)))
    (if best
	best
	(begin

	  (debug:print 0 "ERROR: No valid disks found in megatest.config. Please add some to your [disks] section")
	  (exit 1)))))

;; Desired directory structure:
;;
;;  <linkdir> - <target> - <testname> -.
;;                                     |
;;                                     v







|
>
>
>
>
|
>
>
>
|
<
>
|
>
>
|





|


>
|







488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504

505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
  (let* ((disks    (hash-table-ref/default confdat "disks" #f))
	 (best     #f)
	 (bestsize 0))
    (if disks 
	(for-each 
	 (lambda (disk-num)
	   (let* ((dirpath    (cadr (assoc disk-num disks)))
		  (freespc    (cond
			       ((not (directory? dirpath))
				(if (common:low-noise-print 20 "disks" disk-num)
				    (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 20 "disks" disk-num)
				    (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 20 "disks" disk-num)
				    (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     dirpath)
		   (set! bestsize freespc)))))
	 (map car disks)))
    (if (and best (> bestsize 0))
	best
	(begin
	  (if (common:low-noise-print 20 "disks" disk-num)
	      (debug:print 0 "ERROR: No valid disks found in megatest.config. Please add some to your [disks] section and ensure the directory exists!"))
	  (exit 1)))))

;; Desired directory structure:
;;
;;  <linkdir> - <target> - <testname> -.
;;                                     |
;;                                     v