Megatest

Diff
Login

Differences From Artifact [403df89532]:

To Artifact [ca5a9de19f]:


50
51
52
53
54
55
56
57
58

59
60
61
62
63
64
65
66
67
68
                                      (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 #f "NOT_STARTED"    
      (begin
	(open-run-close tests:register-test #f 1 "nada" "")
	(vector-ref (open-run-close db:get-test-info #f 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")







|

>


|







50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
                                      (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
	(db:tests-register-test *db* 1 "nada" "")
	(vector-ref (db:get-test-info *db* 1 "nada" "") 3)))

(test #f "NOT_STARTED"    
      (begin
	(open-run-close db:tests-register-test #f 1 "nada" "")
	(vector-ref (open-run-close db:get-test-info #f 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")
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140



141
142
143
144
145
146
147
(sqlite3#finalize! *tdb*)

;; (test "Remove the rollup run" #t (begin (remove-runs) #t))

(test "Run a test" #t (general-run-call 
		       "-runtests" 
		       "run a test"
		       (lambda (db target runname keys keynames keyvallst)
			 (let ((test-patts "runfirst"))
			   (runs:run-tests  db target runname test-patts user (make-hash-table))))))

(change-directory test-work-dir)
(test "Add a step"  #t
      (begin
	(teststep-set-status! db 1 "runfirst" "firststep" "start" 0 '() "This is a comment")
	(sleep 2)
	(teststep-set-status! db 1 "runfirst" "firststep" "end" "pass" '() "This is a different comment")
	(set! test-id (db:test-get-id (car (db-get-tests-for-run db 1 "runfirst" ""))))



	(number? test-id)))

(test "Get nice table for steps" "2.0s"
      (begin
	(vector-ref (hash-table-ref (db:get-steps-table db test-id) "firststep") 4)))

(hash-table-set! args:arg-hash ":runname" "rollup")







|

|




|

|
|
>
>
>







124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
(sqlite3#finalize! *tdb*)

;; (test "Remove the rollup run" #t (begin (remove-runs) #t))

(test "Run a test" #t (general-run-call 
		       "-runtests" 
		       "run a test"
		       (lambda (target runname keys keynames keyvallst)
			 (let ((test-patts "runfirst"))
			   (runs:run-tests target runname test-patts user (make-hash-table))))))

(change-directory test-work-dir)
(test "Add a step"  #t
      (begin
	(db:teststep-set-status! db 1 "runfirst" "firststep" "start" 0 '() "This is a comment")
	(sleep 2)
	(db:teststep-set-status! db 1 "runfirst" "firststep" "end" "pass" '() "This is a different comment")
	(set! test-id (vector-ref (car (let ((tests (open-run-close db:get-tests-for-run #f 1 "runfirst" "" '() '())))
					 (print "tests: " tests)
					 tests))
				  0))
	(number? test-id)))

(test "Get nice table for steps" "2.0s"
      (begin
	(vector-ref (hash-table-ref (db:get-steps-table db test-id) "firststep") 4)))

(hash-table-set! args:arg-hash ":runname" "rollup")