554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
|
(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" )
(if (string? *toppath* )
(pathname-file *toppath*)
(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/"
|
>
|
|
|
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 *toppath*
(pathname-file *toppath*)
#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/"
|
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
|
(debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
rtestpatt)
(else args-testpatt))))
(define (common:get-linktree)
(or (getenv "MT_LINKTREE")
(if *configdat*
(configf:lookup *configdat* "setup" "linktree"))))
(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))
|
|
>
|
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
|
(debug:print-info 0 *default-log-port* "testpatt defined in "testpatt-key" from runconfigs: " rtestpatt)
rtestpatt)
(else args-testpatt))))
(define (common:get-linktree)
(or (getenv "MT_LINKTREE")
(if *configdat*
(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))
|