1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
|
;; Copyright 2006-2016, Matthew Welland.
;;
;; This program is made available under the GNU GPL version 2.0 or
;; greater. See the accompanying file COPYING for details.
;;
;; This program is distributed WITHOUT ANY WARRANTY; without even the
;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;; PURPOSE.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18)
posix-extras directory-utils pathname-expand typed-records format)
(declare (unit runs))
|
|
|
>
>
>
>
>
|
|
>
|
>
>
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
|
;; Copyright 2006-2016, Matthew Welland.
;;
;; This file is part of Megatest.
;;
;; Megatest is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; Megatest is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with Megatest. If not, see <http://www.gnu.org/licenses/>.
;; strftime('%m/%d/%Y %H:%M:%S','now','localtime')
(use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 (srfi 18)
posix-extras directory-utils pathname-expand typed-records format)
(declare (unit runs))
|
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
((can-run-more-tests-count 0) : fixnum))
(defstruct runs:testdat
hed tal reg reruns test-record
test-name item-path jobgroup
waitons testmode newtal itemmaps prereqs-not-met)
;; set up needed environment variables given a run-id and optionally a target, itempath etc.
;;
(define (runs:set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f)(inkeyvals #f)(intarget #f)(testname #f)(itempath #f))
;;(bb-check-path msg: "runs:set-megatest-env-vars entry")
(let* ((target (or intarget
(common:args-get-target)
(get-environment-variable "MT_TARGET")))
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
((can-run-more-tests-count 0) : fixnum))
(defstruct runs:testdat
hed tal reg reruns test-record
test-name item-path jobgroup
waitons testmode newtal itemmaps prereqs-not-met)
(define (runs:get-mt-env-alist run-id runname target testname itempath)
;;(bb-check-path msg: "runs:set-megatest-env-vars entry")
`(("MT_TEST_NAME" . ,testname)
("MT_ITEMPATH" . ,itempath)
("MT_TARGET" . ,target)
("MT_RUNNAME" . ,runname)
("MT_RUN_AREA_HOME" . ,*toppath*)
,@(let* ((link-tree (common:get-linktree))) ;; (configf:lookup *configdat* "setup" "linktree")))
(if link-tree
(list (cons "MT_LINKTREE" link-tree)
(cons "MT_TEST_RUN_DIR"
(conc link-tree "/" target "/" runname "/" testname
(if (and (string? itempath) (not (equal? itempath "")))
(conc "/" itempath)
"")))
)
'()))
,@(map
(lambda (key)
(cons (car key) (cadr key)))
(keys:target->keyval (rmt:get-keys) target))
,@(map (lambda (var)
(let ((val (configf:lookup *configdat* "env-override" var)))
(cons var val)))
(configf:section-vars *configdat* "env-override"))))
;; set up needed environment variables given a run-id and optionally a target, itempath etc.
;;
(define (runs:set-megatest-env-vars run-id #!key (inkeys #f)(inrunname #f)(inkeyvals #f)(intarget #f)(testname #f)(itempath #f))
;;(bb-check-path msg: "runs:set-megatest-env-vars entry")
(let* ((target (or intarget
(common:args-get-target)
(get-environment-variable "MT_TARGET")))
|