1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
|
(use test)
;; (require-library args)
(include "../megatest.scm")
(include "../common.scm")
(include "../keys.scm")
(include "../db.scm")
(include "../configf.scm")
(include "../process.scm")
(include "../launch.scm")
(include "../items.scm")
(include "../runs.scm")
(include "../runconfig.scm")
(include "../megatest-version.scm")
|
<
|
<
<
<
<
<
<
<
<
<
<
<
<
|
1
2
3
4
5
6
7
8
|
(require-extension test)
(define test-work-dir (current-directory))
(define conffile #f)
(test "Read a config" #t (hash-table? (read-config "test.config" #f #f)))
(test "Read a config that doesn't exist" #t (hash-table? (read-config "nada.config" #f #f)))
|
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
|
(list "pass" "fail" "n/a"))
(test "write env files" "nada.csh" (begin
(save-environment-as-files "nada")
(and (file-exists? "nada.sh")
(file-exists? "nada.csh"))))
(test "get all legal tests" (list "runfirst" "runwithfirst" "singletest" "singletest2" "sqlitespeed") (sort (get-all-legal-tests) string<=?))
(test "register-test, test info" "NOT_STARTED"
(begin
(register-test *db* 1 "nada" "" '("tag1" "tag2" "tag3"))
(test:get-state (db:get-test-info *db* 1 "nada" ""))))
(test "get-keys" "sysname" (key:get-fieldname (car (sort (db-get-keys *db*)(lambda (a b)(string>=? (vector-ref a 0)(vector-ref b 0)))))))
(define remargs (args:get-args
'("bar" "foo" ":runname" "bob" ":sysname" "ubuntu" ":fsname" "nfs" ":datapath" "blah/foo" "nada")
(list ":runname" ":state" ":status")
(list "-h")
args:arg-hash
0))
(test "register-run" #t (number? (register-run *db* (db-get-keys *db*))))
(define keys (db-get-keys *db*))
;;(test "update-test-info" #t (test-update-meta-info *db* 1 "nada"
(setenv "BLAHFOO" "1234")
(unsetenv "NADAFOO")
(test "env temp overrides" "xyz" (let ((prevvals (alist->env-vars '(("BLAHFOO" 4321)("NADAFOO" xyz))))
(result (get-environment-variable "NADAFOO")))
(alist->env-vars prevvals)
|
|
|
|
|
|
|
>
>
>
>
>
>
|
46
47
48
49
50
51
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
|
(list "pass" "fail" "n/a"))
(test "write env files" "nada.csh" (begin
(save-environment-as-files "nada")
(and (file-exists? "nada.sh")
(file-exists? "nada.csh"))))
(test "get all legal tests" (list "test1" "test2") (sort (get-all-legal-tests) string<=?))
(test "register-test, test info" "NOT_STARTED"
(begin
(tests:register-test *db* 1 "nada" "")
(vector-ref (db:get-test-info *db* 1 "nada" "") 3)))
(test "get-keys" "SYSTEM" (vector-ref (car (db:get-keys *db*)) 0));; (key:get-fieldname (car (sort (db-get-keys *db*)(lambda (a b)(string>=? (vector-ref a 0)(vector-ref b 0)))))))
(define remargs (args:get-args
'("bar" "foo" ":runname" "bob" ":sysname" "ubuntu" ":fsname" "nfs" ":datapath" "blah/foo" "nada")
(list ":runname" ":state" ":status")
(list "-h")
args:arg-hash
0))
(test "register-run" #t (number? (runs:register-run *db*
(db:get-keys *db*)
'(("SYSTEM" "key1")("OS" "key2"))
"myrun"
"new"
"n/a"
"bob")))
(define keys (db:get-keys *db*))
;;(test "update-test-info" #t (test-update-meta-info *db* 1 "nada"
(setenv "BLAHFOO" "1234")
(unsetenv "NADAFOO")
(test "env temp overrides" "xyz" (let ((prevvals (alist->env-vars '(("BLAHFOO" 4321)("NADAFOO" xyz))))
(result (get-environment-variable "NADAFOO")))
(alist->env-vars prevvals)
|