Megatest

Diff
Login

Differences From Artifact [2146ce57ec]:

To Artifact [fe39965c84]:


554
555
556
557
558
559
560

561

562
563

564
565
566
567
568
569
570
554
555
556
557
558
559
560
561

562
563

564
565
566
567
568
569
570
571







+
-
+

-
+








(define (assoc/default key lst . default)
  (let ((res (assoc key lst)))
    (if res (cadr res)(if (null? default) #f (car default)))))

(define (common:get-testsuite-name)
  (or (configf:lookup *configdat* "setup" "testsuite" )
      (getenv "MT_TESTSUITE_NAME")
      (if (string? *toppath* )
      (if *toppath*
          (pathname-file *toppath*)
          (pathname-file (current-directory)))))
          #f))) ;; (pathname-file (current-directory)))))

(define (common:get-db-tmp-area)
  (if *db-cache-path*
      *db-cache-path*
      (if *toppath*
	  (let ((dbpath (create-directory (conc "/tmp/" (current-user-name)
						"/megatest_localdb/"
948
949
950
951
952
953
954
955


956
957
958
959
960
961
962
949
950
951
952
953
954
955

956
957
958
959
960
961
962
963
964







-
+
+







                             message: (conc "Unable to access path: " path-string)
                             ))


(define (common:get-linktree)
  (or (getenv "MT_LINKTREE")
      (if *configdat*
	  (configf:lookup *configdat* "setup" "linktree"))))
	  (configf:lookup *configdat* "setup" "linktree")
	  #f)))

(define (common:args-get-runname)
  (let ((res (or (args:get-arg "-runname")
		 (args:get-arg ":runname")
		 (getenv "MT_RUNNAME"))))
    ;; (if res (set-environment-variable "MT_RUNNAME" res)) ;; not sure if this is a good idea. side effect and all ...
    res))