Megatest
Check-in [e0413b29e1]
Not logged in
Overview
SHA1:e0413b29e1092642bb0d64c108915a3f91d5864a
Date: 2011-05-05 01:37:58
User: matt
Comment:Fixed -m missing from args
Timelines: family | ancestors | descendants | both | trunk
Downloads: Tarball | ZIP archive
Other Links: files | file ages | folders | manifest
Tags And Properties
Context
2011-05-05
01:46
[1146144d5b] Fixed -m for test steps (user: matt, tags: trunk)
01:37
[e0413b29e1] Fixed -m missing from args (user: matt, tags: trunk)
2011-05-04
23:48
[c4edfbcd13] Added pattern selectors for use with -list-runs (user: mrwellan, tags: trunk)
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified db.scm from [514fa0af1c] to [499db9fa5f].

104
105
106
107
108
109
110




111
112
113
114
115
116
117
...
148
149
150
151
152
153
154



155
156
157
158
159
160
161
      (let loop ((hed (car header))
		 (tal (cdr header))
		 (n   0))
	(if (equal? hed field)
	    (vector-ref row n)
	    (if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1)))))))
	    




(define (db-get-runs db runpatt . count)
  (let* ((res      '())
	 (keys      (db-get-keys db))
	 (remfields (list "id" "runname" "state" "status" "owner" "event_time"))
	 (header    (append (map key:get-fieldname keys)
			    remfields))
	 (keystr    (conc (keys->keystr keys) ","
................................................................................
     (lambda (a . x)
       (set! res (apply vector a x)))
     db
     (conc "SELECT " keystr " FROM runs WHERE id=?;")
     run-id)
    (vector header res)))




;;======================================================================
;;  T E S T S
;;======================================================================

(define (make-db:test)(make-vector 6))
(define-inline (db:test-get-id           vec) (vector-ref vec 0))
(define-inline (db:test-get-run_id       vec) (vector-ref vec 1))







>
>
>
>







 







>
>
>







104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
...
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
      (let loop ((hed (car header))
		 (tal (cdr header))
		 (n   0))
	(if (equal? hed field)
	    (vector-ref row n)
	    (if (null? tal) #f (loop (car tal)(cdr tal)(+ n 1)))))))
	    
;;======================================================================
;;  R U N S
;;======================================================================

(define (db-get-runs db runpatt . count)
  (let* ((res      '())
	 (keys      (db-get-keys db))
	 (remfields (list "id" "runname" "state" "status" "owner" "event_time"))
	 (header    (append (map key:get-fieldname keys)
			    remfields))
	 (keystr    (conc (keys->keystr keys) ","
................................................................................
     (lambda (a . x)
       (set! res (apply vector a x)))
     db
     (conc "SELECT " keystr " FROM runs WHERE id=?;")
     run-id)
    (vector header res)))

(define (db:set-comment-for-run db run-id comment)
  (sqlite3:execute db "UPDATE runs SET comment=? WHERE id=?;" comment run-id))

;;======================================================================
;;  T E S T S
;;======================================================================

(define (make-db:test)(make-vector 6))
(define-inline (db:test-get-id           vec) (vector-ref vec 0))
(define-inline (db:test-get-run_id       vec) (vector-ref vec 1))

Modified megatest.scm from [864689325a] to [beb9f35b7d].

73
74
75
76
77
78
79

80
81
82
83
84
85
86
			"-list-runs"
			"-testpatt" 
			"-itempatt"
			"-setlog"
			"-runstep"
			"-logpro"
			"-remove-run"

			) 
		 (list  "-h"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-test-status"
		        "-gui"







>







73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
			"-list-runs"
			"-testpatt" 
			"-itempatt"
			"-setlog"
			"-runstep"
			"-logpro"
			"-remove-run"
			"-m"
			) 
		 (list  "-h"
		        "-force"
		        "-xterm"
		        "-showkeys"
		        "-test-status"
		        "-gui"

Modified runs.scm from [6b9a177db2] to [689752ec03].

216
217
218
219
220
221
222


223
224
225
226
227
228
229
	       (keys        (db-get-keys db))
	       (keyvallst   (keys->vallist keys #t))
	       (items       (hash-table-ref/default test-conf "items" #f))
	       (allitems    (item-assoc->item-list items))
	       (run-id      (register-run db keys)) ;;  test-name)))
	       (runconfigf  (conc  *toppath* "/runconfigs.config")))
	  ;; (print "items: ")(pp allitems)


	  (let loop ((itemdat (car allitems))
		     (tal     (cdr allitems)))
	    ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
	    (let* ((item-path     (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
		   (new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))
		   (new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique
		   (test-status   #f)







>
>







216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
	       (keys        (db-get-keys db))
	       (keyvallst   (keys->vallist keys #t))
	       (items       (hash-table-ref/default test-conf "items" #f))
	       (allitems    (item-assoc->item-list items))
	       (run-id      (register-run db keys)) ;;  test-name)))
	       (runconfigf  (conc  *toppath* "/runconfigs.config")))
	  ;; (print "items: ")(pp allitems)
	  (if (args:get-arg "-m")
	      (db:set-comment-for-run db run-id (args:get-arg "-m")))
	  (let loop ((itemdat (car allitems))
		     (tal     (cdr allitems)))
	    ;; (lambda (itemdat) ;;; ((ripeness "overripe") (temperature "cool") (season "summer"))
	    (let* ((item-path     (item-list->path itemdat)) ;; (string-intersperse (map cadr itemdat) "/"))
		   (new-test-path (string-intersperse (cons test-path (map cadr itemdat)) "/"))
		   (new-test-name (if (equal? item-path "") test-name (conc test-name "/" item-path))) ;; just need it to be unique
		   (test-status   #f)

Modified tests/Makefile from [9d37a344c8] to [89065be368].

1
2
3

4
5
# run some tests

runall :

	megatest -runall :sysname ubuntu :fsname nfs :datapath none :runname `date +%GWW%V.%u`




>
|

1
2
3
4
5
6
# run some tests

runall :
	cd ../;make 
	../megatest -runall :sysname ubuntu :fsname nfs :datapath none :runname `date +%GWW%V.%u` -m "This is a comment specific to a run"