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))
|