Megatest

Check-in [34d675ae1f]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Added some safety checks
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | defstruct-srehman
Files: files | file ages | folders
SHA1: 34d675ae1f0509e3f650dc4ee8c4b44f27038e2d
User & Date: mrwellan on 2016-10-04 11:34:37
Other Links: branch diff | manifest | tags
Context
2016-10-05
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
2016-10-03
15:40
fixed db_records to account for modifications to test datatype update check-in: 8718070900 user: srehman tags: defstruct-srehman
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified api.scm from [d744d47aad] to [0846354bc1].

︙︙
115
116
117
118
119
120
121

122




123
124
125
126
127
128
129

       (vector #f #f "remote must be called with a vector")       
       (vector                                   ;; return a vector + the returned data structure
	#t 
	(let ((cmd    (vector-ref dat 0))
	      (params (vector-ref dat 1)))
	  (case (if (symbol? cmd)
		    cmd

		    (string->symbol cmd))





	    ;;===============================================
	    ;; READ/WRITE QUERIES
	    ;;===============================================

	    ;; SERVERS
	    ((start-server)                    (apply server:kind-run params))








>
|
>
>
>
>








115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134

       (vector #f #f "remote must be called with a vector")       
       (vector                                   ;; return a vector + the returned data structure
	#t 
	(let ((cmd    (vector-ref dat 0))
	      (params (vector-ref dat 1)))
	  (case (if (symbol? cmd)
		    cmd
		    (if (string? cmd)
			(string->symbol cmd)
			(begin
			  (debug:print 0 *default-log-port* "ERROR: received bad data in execute-requests \"" cmd "\""
				       "   and params " params)
			  (exit 1))))

	    ;;===============================================
	    ;; READ/WRITE QUERIES
	    ;;===============================================

	    ;; SERVERS
	    ((start-server)                    (apply server:kind-run params))
︙︙

Modified db.scm from [6d3f9a01cd] to [2c5f13a26c].

︙︙
2888
2889
2890
2891
2892
2893
2894











2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909

;; foo,bal,   1.2,  1.2, <   ,     ,Check for overload
;; foo,alb,   1.2,  1.2, <=  , Amps,This is the high power circuit test
;; foo,abl,   1.2,  1.3, 0.1
;; foo,bra,   1.2, pass, silly stuff
;; faz,bar,    10,  8mA,     ,     ,"this is a comment"
;; EOF












(define (db:csv->test-data dbstruct run-id test-id csvdata)
  (debug:print 4 *default-log-port* "test-id " test-id ", csvdata: " csvdata)
  (let* ((dbdat   (db:get-db dbstruct run-id))
	 (db      (db:dbdat-get-db dbdat))
	 (csvlist (csv->list (make-csv-reader
			      (open-input-string csvdata)
			      '((strip-leading-whitespace? #t)
				(strip-trailing-whitespace? #t)))))) ;; (csv->list csvdata)))
    (for-each
     (lambda (csvrow)
       (let* ((padded-row  (take (append csvrow (list #f #f #f #f #f #f #f #f #f)) 9))
	      (category    (list-ref padded-row 0))
	      (variable    (list-ref padded-row 1))
	      (value       (any->number-if-possible (list-ref padded-row 2)))
	      (expected    (any->number-if-possible (list-ref padded-row 3)))








>
>
>
>
>
>
>
>
>
>
>




|
<
<
<








2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910



2911
2912
2913
2914
2915
2916
2917

;; foo,bal,   1.2,  1.2, <   ,     ,Check for overload
;; foo,alb,   1.2,  1.2, <=  , Amps,This is the high power circuit test
;; foo,abl,   1.2,  1.3, 0.1
;; foo,bra,   1.2, pass, silly stuff
;; faz,bar,    10,  8mA,     ,     ,"this is a comment"
;; EOF


(define (db:csv->list-safe csvdata)
  (if (string? csvdata)
      (csv->list (make-csv-reader
		  (open-input-string csvdata)
		  '((strip-leading-whitespace? #t)
		    (strip-trailing-whitespace? #t))))      
      (begin
	(debug:print 0 *default-log-port* "ERROR: received non-string data for csv")
	'())))

(define (db:csv->test-data dbstruct run-id test-id csvdata)
  (debug:print 4 *default-log-port* "test-id " test-id ", csvdata: " csvdata)
  (let* ((dbdat   (db:get-db dbstruct run-id))
	 (db      (db:dbdat-get-db dbdat))
	 (csvlist (db:csv->list-safe csvdata)))



    (for-each
     (lambda (csvrow)
       (let* ((padded-row  (take (append csvrow (list #f #f #f #f #f #f #f #f #f)) 9))
	      (category    (list-ref padded-row 0))
	      (variable    (list-ref padded-row 1))
	      (value       (any->number-if-possible (list-ref padded-row 2)))
	      (expected    (any->number-if-possible (list-ref padded-row 3)))
︙︙

Modified db_records.scm from [760ea62c74] to [6e4d1adc75].

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

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

"id"           "run_id"        "testname"  "state"      "status"      "event_time"
				"host"         "cpuload"       "diskfree"  "uname"      "rundir"      "item_path"
                                "run_duration" "final_logf"    "comment"   "shortdir"   "attemptnum"  "archived"

(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

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

Modified tests/fullrun/megatest.config from [73b1295a6b] to [a2007aff6f].

︙︙
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160


# XTERM   [system xterm]
# RUNDEAD [system exit 56]

[server]

# force use of server always
# required yes

# Use http instead of direct filesystem access
transport http
# transport fs
# transport nmsg

synchronous 0








|








146
147
148
149
150
151
152
153
154
155
156
157
158
159
160


# XTERM   [system xterm]
# RUNDEAD [system exit 56]

[server]

# force use of server always
required yes

# Use http instead of direct filesystem access
transport http
# transport fs
# transport nmsg

synchronous 0
︙︙

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