Megatest

Check-in [e0413b29e1]
Login
Overview
Comment:Fixed -m missing from args
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: e0413b29e1092642bb0d64c108915a3f91d5864a
User & Date: matt on 2011-05-05 01:37:58
Other Links: manifest | tags
Context
2011-05-05
01:46
Fixed -m for test steps check-in: 1146144d5b user: matt tags: trunk
01:37
Fixed -m missing from args check-in: e0413b29e1 user: matt tags: trunk
2011-05-04
23:48
Added pattern selectors for use with -list-runs check-in: c4edfbcd13 user: mrwellan tags: trunk
Changes

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

104
105
106
107
108
109
110




111
112
113
114
115
116
117
      (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) ","







>
>
>
>







104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
      (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) ","
148
149
150
151
152
153
154



155
156
157
158
159
160
161
     (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))







>
>
>







152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
     (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"