Megatest

Check-in [8ba591abbd]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:hardcoded qry-string to typed record
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | defstruct-srehman
Files: files | file ages | folders
SHA1: 8ba591abbdfca5fcb359008f974f3640701451d8
User & Date: srehman on 2016-10-05 13:33:24
Other Links: branch diff | manifest | tags
Context
2016-10-05
13:34
merged with latest v1.62 Closed-Leaf check-in: abcfb9550d user: srehman tags: defstruct-srehman
13:33
hardcoded qry-string to typed record check-in: 8ba591abbd user: srehman tags: defstruct-srehman
2016-10-04
11:34
Added some safety checks check-in: 34d675ae1f user: mrwellan tags: defstruct-srehman
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified db.scm from [2c5f13a26c] to [25662aed6c].

︙︙
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293

	(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)))
			 ;;(print (cons a b))
		      	 (set! res (cons (alist->db:test-rec (db:qry-gen-alist qryvalstr (cons a b))) res)))
		       
		       db
		       qry
		       run-id
		       )))
	(case qryvals
	  ((shortlist)(map db:test-short-record->norm res))








|








2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293

	(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)))
			 ;;(print (cons a b))
		      	 (set! res (cons (db:test-rec-from-qry-long (cons a b)) res)))
		       
		       db
		       qry
		       run-id
		       )))
	(case qryvals
	  ((shortlist)(map db:test-short-record->norm res))
︙︙
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726

   run-id
   #f
   (lambda (db)
     (let ((res '()))
       (sqlite3:for-each-row
	(lambda (a . b)
	  ;;                 0    1       2      3      4        5       6      7        8     9     10      11          12          13       14
	  (set! res (cons (alist->db:test-rec (db:qry-gen-alist db:test-record-qry-selector (cons a b))) res)))
	  ;;(set! res (cons (apply vector a b) res)))
	db
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id in ("
	      (string-intersperse (map conc test-ids) ",") ");"))
       res))))

(define (db:get-test-info dbstruct run-id testname item-path)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (let ((res #f))
       (sqlite3:for-each-row
	(lambda (a . b)
	  (set! res (alist->db:test-rec (db:qry-gen-alist db:test-record-qry-selector (cons a b)))))
	  ;;(set! res (apply vector a b)))
	db
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE testname=? AND item_path=?;")
	test-name item-path)
       res))))

(define (db:test-get-rundir-from-test-id dbstruct run-id test-id)








|















|








2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726

   run-id
   #f
   (lambda (db)
     (let ((res '()))
       (sqlite3:for-each-row
	(lambda (a . b)
	  ;;                 0    1       2      3      4        5       6      7        8     9     10      11          12          13       14
	  (set! res (cons (db:test-rec-from-qry-long (cons a b)) res)))
	  ;;(set! res (cons (apply vector a b) res)))
	db
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE id in ("
	      (string-intersperse (map conc test-ids) ",") ");"))
       res))))

(define (db:get-test-info dbstruct run-id testname item-path)
  (db:with-db
   dbstruct
   run-id
   #f
   (lambda (db)
     (let ((res #f))
       (sqlite3:for-each-row
	(lambda (a . b)
	  (set! res (db:test-rec-from-qry-long (cons a b))))
	  ;;(set! res (apply vector a b)))
	db
	(conc "SELECT " db:test-record-qry-selector " FROM tests WHERE testname=? AND item_path=?;")
	test-name item-path)
       res))))

(define (db:test-get-rundir-from-test-id dbstruct run-id test-id)
︙︙

Modified db_records.scm from [6e4d1adc75] to [8b4987b241].

︙︙
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
91
92
93
94
95
96
97
98
99
100
101
102
103
104















105
106
107
108
109
110
111

  (hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f))

(define (dbr:dbstruct-localdb-set! v run-id db)
  (hash-table-set! (dbr:dbstruct-locdbs v) run-id db))

(require-extension typed-records)
(defstruct db:test-rec ((id -1) : number)
  ((run_id -1) : number) 
  ((testname "") : string)
  ((state "") : string)
  ((status "") : string)
  ((event_time -1) : number)
  ((host "") : string)
  ((cpuload -1) : number)
  ((diskfree -1) : number)
  ((uname "") : string)
  ((rundir "") : string)
  ((item_path "") : string)
  ((run_duration -1) : number)
  ((final_logf "") : string)
  ((comment "") : string)
  ((process-id -1) : number)
  ((archived -1) : number)
  ((shortdir -1) : number)
  ((attemptnum -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))








|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|


|
|
|
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126

  (hash-table-ref/default (dbr:dbstruct-locdbs v) run-id #f))

(define (dbr:dbstruct-localdb-set! v run-id db)
  (hash-table-set! (dbr:dbstruct-locdbs v) run-id db))

(require-extension typed-records)
(defstruct db:test-rec ((id -1) : number)
					((run_id -1) : number) 
					((testname "") : string)
					((state "") : string)
					((status "") : string)
					((event_time -1) : number)
					((host "") : string)
					((cpuload -1) : number)
					((diskfree -1) : number)
					((uname "") : string)
					((rundir "") : string)
					((item_path "") : string)
					((run_duration -1) : number)
					((final_logf "") : string)
					((comment "") : string)
					((process-id -1) : number)
					((archived -1) : number)
					((shortdir -1) : number)
					((attemptnum -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-rec-from-qry-long listvals)
	(make-db:test-rec id: (list-ref listvals 0) run_id: (list-ref listvals 1) testname: (list-ref listvals 2) 
		state: (list-ref listvals 3) status: (list-ref listvals 4) event_time: (list-ref listvals 5)
       		host: (list-ref listvals 6) cpuload: (list-ref listvals 7) diskfree: (list-ref listvals 8) 
       		uname: (list-ref listvals 9) rundir: (list-ref listvals 10) item_path: (list-ref listvals 11)
       		run_duration: (list-ref listvals 12) final_logf: (list-ref listvals 13) comment: (list-ref listvals 14) 
       		shortdir: (list-ref listvals 15) attemptnum: (list-ref listvals 16) archived: (list-ref listvals 17)))

(define (db:test-rec-from-qry-short listvals)
	(make-db:test-rec id: (list-ref listvals 0) run_id: (list-ref listvals 1) testname: (list-ref listvals 2) 
		state: (list-ref listvals 3) status: (list-ref listvals 4) event_time: (list-ref listvals 5)
       		host: (list-ref listvals 6) cpuload: (list-ref listvals 7) diskfree: (list-ref listvals 8) 
       		uname: (list-ref listvals 9) rundir: (list-ref listvals 10) item_path: (list-ref listvals 11)
       		run_duration: (list-ref listvals 12) final_logf: (list-ref listvals 13) comment: (list-ref listvals 14)))  

(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))
︙︙

This page was generated in about 0.107s by Fossil 2.24 [452f8e1ffc] 2024-03-26 15:36:00