Megatest

Diff
Login

Differences From Artifact [eee64ce859]:

To Artifact [d946026e4f]:


638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
(define common:get-area-name common:get-testsuite-name)

;; WARNING: This code falls back to using the global Megatest
;;          variable *toppath*
;; 
(define (common:get-db-tmp-area dbstruct)
  (if (and dbstruct (dbr:dbstruct-tmpdb-path dbstruct)) ;; *db-cache-path*
      (dbr:dbstruct-tmpdb-path) ;; *db-cache-path*
      (let ((toppath (or (and dbstruct (dbr:dbstruct-area-path dbstruct)) *toppath*))
	    (tsname  (or (and dbstruct (dbr:dbstruct-area-name dbstruct))(common:get-testsuite-name))))
	(if toppath ;; common:get-create-writeable-dir
	    (handle-exceptions
		exn
		(begin
		  (debug:print-error 0 *default-log-port* "Couldn't create path to " dbdir)







|







638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
(define common:get-area-name common:get-testsuite-name)

;; WARNING: This code falls back to using the global Megatest
;;          variable *toppath*
;; 
(define (common:get-db-tmp-area dbstruct)
  (if (and dbstruct (dbr:dbstruct-tmpdb-path dbstruct)) ;; *db-cache-path*
      (dbr:dbstruct-tmpdb-path dbstruct) ;; *db-cache-path*
      (let ((toppath (or (and dbstruct (dbr:dbstruct-area-path dbstruct)) *toppath*))
	    (tsname  (or (and dbstruct (dbr:dbstruct-area-name dbstruct))(common:get-testsuite-name))))
	(if toppath ;; common:get-create-writeable-dir
	    (handle-exceptions
		exn
		(begin
		  (debug:print-error 0 *default-log-port* "Couldn't create path to " dbdir)
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
;; check space in dbdir and in megatest dir
;; returns: ok/not dbspace required-space
;;
(define (common:check-db-dir-space)
  (let* ((required (string->number 
		    (or (configf:lookup *configdat* "setup" "dbdir-space-required")
			"100000")))
	 (dbdir    (common:get-db-tmp-area)) ;; (db:get-dbdir))
	 (tdbspace (common:check-space-in-dir dbdir required))
	 (mdbspace (common:check-space-in-dir *toppath* required)))
    (sort (list tdbspace mdbspace) (lambda (a b)
				     (< (cadr a)(cadr b))))))
    
;; check available space in dbdir, exit if insufficient
;;







|







1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
;; check space in dbdir and in megatest dir
;; returns: ok/not dbspace required-space
;;
(define (common:check-db-dir-space)
  (let* ((required (string->number 
		    (or (configf:lookup *configdat* "setup" "dbdir-space-required")
			"100000")))
	 (dbdir    (common:get-db-tmp-area #f)) ;; (db:get-dbdir))
	 (tdbspace (common:check-space-in-dir dbdir required))
	 (mdbspace (common:check-space-in-dir *toppath* required)))
    (sort (list tdbspace mdbspace) (lambda (a b)
				     (< (cadr a)(cadr b))))))
    
;; check available space in dbdir, exit if insufficient
;;