| ︙ | | |
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
-
+
+
|
(defstruct remote
(hh-dat (common:get-homehost)) ;; homehost record ( addr . hhflag )
(server-url (if *toppath* (server:check-if-running *toppath*))) ;; (server:check-if-running *toppath*) #f))
(last-server-check 0) ;; last time we checked to see if the server was alive
(conndat #f)
(transport *transport-type*)
(server-timeout (or (server:get-timeout) 100))) ;; default to 100 seconds
(server-timeout (or (server:get-timeout) 100))
(force-server #f)) ;; default to 100 seconds
;; launching and hosts
(defstruct host
(reachable #f)
(last-update 0)
(last-used 0)
(last-cpuload 1))
|
| ︙ | | |
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
|
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/"
|
| ︙ | | |
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
|
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"))))
(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))
|
| ︙ | | |
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
|
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
|
+
+
+
+
+
+
+
+
+
+
+
+
|
;; do we honor the caches of the config files?
;;
(define (common:use-cache?)
(not (or (args:get-arg "-no-cache")
(and *configdat*
(equal? (configf:lookup *configdat* "setup" "use-cache") "no")))))
;; force use of server?
;;
(define (common:force-server?)
(let* ((force-setting (configf:lookup "server" "force"))
(force-type (if force-setting (string->symbol force-setting) #f)))
(case force-type
((#f) #f)
((always) #t)
((test) (if (args:get-arg "-execute") ;; we are in a test
#t
#f)))))
;;======================================================================
;; M I S C L I S T S
;;======================================================================
;; items in lista are matched value and position in listb
;; return the remaining items in listb or #f
|
| ︙ | | |