Megatest

Check-in [f5247f6684]
Login
Overview
Comment:fixed error with db.scm
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | defstruct-srehman
Files: files | file ages | folders
SHA1: f5247f66842a4b9b1e88c6424a29d8fee4be2129
User & Date: srehman on 2016-09-19 17:49:02
Other Links: branch diff | manifest | tags
Context
2016-09-20
13:25
updateded db:get-tests-for-run method with defstruct check-in: d5c885ef29 user: srehman tags: defstruct-srehman
2016-09-19
17:49
fixed error with db.scm check-in: f5247f6684 user: srehman tags: defstruct-srehman
11:13
merged with v1.62 latest build check-in: d854ad72ea user: srehman tags: defstruct-srehman
Changes

Modified dashboard.scm from [7743efb660] to [50a3705d51].

1394
1395
1396
1397
1398
1399
1400
1401
1402


1403
1404

1405
1406
1407
1408
1409
1410
1411
1394
1395
1396
1397
1398
1399
1400


1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412







-
-
+
+


+







					     (if (dboard:tabdat-filters-changed tabdat)
						 0
						 last-update)
					     *dashboard-mode*)
		  '()))) ;; get 'em all
    ;; (debug:print 0 *default-log-port* "dboard:get-tests-dat: got " (length tdat) " test records for run " run-id)
    (sort tdat (lambda (a b)
		 (let* ((aval (vector-ref a 2))
			(bval (vector-ref b 2))
		 (let* ((aval (db:test-get-testname a));;(vector-ref a 2))
			(bval (db:test-get-testname b));;(vector-ref b 2))
			(anum (string->number aval))
			(bnum (string->number bval)))
		 	(print a b)
		   (if (and anum bnum)
		       (< anum bnum)
		       (string<= aval bval)))))))


(define (dashboard:safe-cadr-assoc name lst)
  (let ((res (assoc name lst)))

Modified db.scm from [c566a984d2] to [a28e3b57c0].

2249
2250
2251
2252
2253
2254
2255
2256







2257
2258
2259
2260
2261
2262
2263
2249
2250
2251
2252
2253
2254
2255

2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269







-
+
+
+
+
+
+
+







				    ";"
				    )))
	(debug:print-info 8 *default-log-port* "db:get-tests-for-run run-id=" run-id ", qry=" qry)
	(db:with-db dbstruct run-id #f
		    (lambda (db)
		      (sqlite3:for-each-row 
		       (lambda (a . b) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment)
			 (set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
			 ;;(set! res (cons (apply vector a b) res))) ;; id run-id testname state status event-time host cpuload diskfree uname rundir item-path run-duration final-logf comment) res)))
			 ;;(print (cons a b))
		      	 (set! res (alist->db:test-rec (db:qry-gen-alist qryvalstr (cons a b))))

		      	 (print (db:test-rec->alist res)))


		       db
		       qry
		       run-id
		       )))
	(case qryvals
	  ((shortlist)(map db:test-short-record->norm res))
	  ((#f)       res)

Modified db_records.scm from [d34e97aebf] to [2b001bb132].

78
79
80
81
82
83
84
85
















86
87
88
89
90
91
92
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
106
107







-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







					((uname "") : string)
					((rundir "") : string)
					((item_path "") : string)
					((run_duration -1) : number)
					((final_logf "") : string)
					((comment "") : string)
					((process_id -1) : number)
					((archived #f) : boolean))
					((archived -1) : number))

(define (db:qry-gen-alist qrystr listvals)
	(define listqry (string-split qrystr ","))
	(if (null? listqry)
	      '()
	      (let loop ((strhead (car listqry))
			 (strtail (cdr listqry))
			 (valhead (car listvals))
			 (valtail (cdr listvals))
			 (res '()))
		(let* ((slot-val-pair (cons (string->symbol strhead) valhead)))
		  (if (or (null? strtail)
		  		(null? valtail))
		      (cons slot-val-pair res);;(print strhead valhead));;(cons (cons (string->symbol strhead) valhead) res))
		      (loop (car strtail)(cdr strtail)(car valtail)(cdr valtail)(cons slot-val-pair res)))))))

(define (db:test-get-id			typed-rec)   (db:test-rec-id 		typed-rec))
(define (db:test-get-run_id 	typed-rec)	 (db:test-rec-run_id 	typed-rec))
(define (db:test-get-testname   typed-rec)   (db:test-rec-testname 	typed-rec))
(define (db:test-get-state      typed-rec)   (db:test-rec-state 	typed-rec))
(define (db:test-get-status     typed-rec)   (db:test-rec-status 	typed-rec))
(define (db:test-get-event_time typed-rec)   (db:test-rec-event_time typed-rec))