Megatest

Check-in [d6e2d2990e]
Login
☰Home Timeline Files Branches Tags Tickets Wiki Login
Overview
Comment:Minor cleanup
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.6569-multi-db-wip
Files: files | file ages | folders
SHA1: d6e2d2990e3b240434dc90b7bc1c84cb6c88477a
User & Date: matt on 2021-02-14 20:26:48
Other Links: branch diff | manifest | tags
Context
2021-02-14
22:34
Sync bunch of minor changes with v1.65-real check-in: 0bf123a8c3 user: matt tags: v1.6569-multi-db-wip (unpublished)
20:26
Minor cleanup check-in: d6e2d2990e user: matt tags: v1.6569-multi-db-wip (unpublished)
19:39
cleanup some duplicated functions check-in: a1bb05ec00 user: matt tags: v1.6569-multi-db-wip (unpublished)
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified api.scm from [c2151cc626] to [d5cec96c4e].

︙
100
101
102
103
104
105
106
107

108
109
110
111
112
113
114
115

100
101
102
103
104
105
106

107

108
109
110
111
112
113
114








-
+
-








                     (list-ref params 2) ; state
                     (list-ref params 3) ; status
                     (list-ref params 4) ; comment
                     ))
                   
                   ((delete-test-records)             (apply db:delete-test-records dbstruct params))
                   ((delete-old-deleted-test-records) (apply db:delete-old-deleted-test-records dbstruct params))
                   ((test-set-state-status)           (apply db:test-set-state-status dbstruct params)
                   ((test-set-state-status)           (apply db:test-set-state-status dbstruct params))
		    )
                   ((test-set-top-process-pid)        (apply db:test-set-top-process-pid dbstruct params))
                   ((set-state-status-and-roll-up-items) (apply db:set-state-status-and-roll-up-items dbstruct params))
                   ((set-state-status-and-roll-up-run) (apply db:set-state-status-and-roll-up-run dbstruct params)) 
                   ((top-test-set-per-pf-counts)      (apply db:top-test-set-per-pf-counts dbstruct params))
                   ((test-set-archive-block-id)       (apply db:test-set-archive-block-id dbstruct params))

                   ;; RUNS
︙
227
228
229
230
231
232
233
234

235
236
237
238
239
240
241

226
227
228
229
230
231
232

233
234
235
236
237
238
239
240








-
+








                   ;; STEPS
                   ((get-steps-data)               (apply db:get-steps-data dbstruct params))
                   ((get-steps-for-test)           (apply db:get-steps-for-test dbstruct params))
		   ((get-steps-info-by-id)         (apply db:get-steps-info-by-id dbstruct params))

                   ;; TEST DATA
                   ((read-test-data)               (apply db:read-test-data dbstruct params))
                   ((read-test-data-alt)              (apply db:read-test-data-alt dbstruct params))
                   ((read-test-data-varpatt)       (apply db:read-test-data-varpatt dbstruct params))
                   ((get-data-info-by-id)          (apply db:get-data-info-by-id dbstruct params)) 

                   ;; MISC
                   ((get-latest-host-load)         (apply db:get-latest-host-load dbstruct params))
                   ((have-incompletes?)            (apply db:have-incompletes? dbstruct params))
                   ((login)                        (apply db:login dbstruct params))
                   ((general-call)                 (let ((stmtname   (car params))
︙

Modified commonmod.scm from [13fee5dc62] to [10014721ab].

︙
298
299
300
301
302
303
304
305
306

307
308
309
310
311
312
313
314

315
316
317
318
319
320
321

298
299
300
301
302
303
304


305
306
307
308
309
310
311
312

313
314
315
316
317
318
319
320








-
-
+







-
+








  (handle-exceptions exn
                     (begin
                       (if message
                           (debug:print-info 0 *default-log-port* message))
                       #f) (thunk) ))

(define (common:file-exists? path-string #!key (silent #f))
  ;; this avoids stack dumps in the case where 
  ;;;; TODO: catch permission denied exceptions and emit appropriate warnings, eg:  system error while trying to access file: "/nfs/pdx/disks/icf_env_disk001/bjbarcla/gwa/issues/mtdev/randy-slow/reproduce/q...
  ;;;; TODO: catch permission denied exceptions and emit appropriate warnings. Might be able to get rid of with chicken 5?
  (common:false-on-exception (lambda () (file-exists? path-string))
                             message: (if (not silent)
                                          (conc "Unable to access path: " path-string)
                                          #f)
                             ))

(define (common:directory-exists? path-string)
  ;;;; TODO: catch permission denied exceptions and emit appropriate warnings, eg:  system error while trying to access file: "/nfs/pdx/disks/icf_env_disk001/bjbarcla/gwa/issues/mtdev/randy-slow/reproduce/q...
  ;;;; TODO: catch permission denied exceptions and emit appropriate warnings
  (common:false-on-exception (lambda () (directory-exists? path-string))
                             message: (conc "Unable to access path: " path-string)
                             ))

;; does the directory exist and do we have write access?
;;
;;    returns the directory or #f
︙

Modified dbmod.scm from [c47894a6b4] to [32c65e5abc].

︙
3551
3552
3553
3554
3555
3556
3557
3558

3559
3560
3561
3562
3563
3564
3565

3551
3552
3553
3554
3555
3556
3557

3558
3559
3560
3561
3562
3563
3564
3565








-
+








	  (set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
	db
	"SELECT id,test_id,category,variable,value,expected,tol,units,comment,status,type FROM test_data WHERE test_id=? AND category LIKE ? ORDER BY category,variable;" test-id categorypatt)
       (reverse res)))))

;; This routine moved from tdb.scm, :read-test-data
;;
(define (db:read-test-data-alt dbstruct run-id test-id categorypatt varpatt)
(define (db:read-test-data-varpatt dbstruct run-id test-id categorypatt varpatt)
  (let* ((res '()))
    (db:with-db
     dbstruct #f #f
     (lambda (db)
       (sqlite3:for-each-row 
	(lambda (id test_id category variable value expected tol units comment status type)
	  (set! res (cons (vector id test_id category variable value expected tol units comment status type) res)))
︙

Modified megatest.scm from [d545af0e1a] to [09f7c5d29d].

︙
1351
1352
1353
1354
1355
1356
1357
1358

1359
1360
1361
1362
1363
1364
1365

1351
1352
1353
1354
1355
1356
1357

1358
1359
1360
1361
1362
1363
1364
1365








-
+








                                                    (test-id      (if (member "id"           tests-spec)(get-value-by-fieldname test test-field-index "id"          ) #f)) ;; (db:test-get-id         test))
                                                    (testname     (if (member "testname"     tests-spec)(get-value-by-fieldname test test-field-index "testname"    ) #f)) ;; (db:test-get-testname   test))
                                                    (itempath     (if (member "item_path"    tests-spec)(get-value-by-fieldname test test-field-index "item_path"   ) #f)) ;; (db:test-get-item-path  test))
                                                    (fullname     (conc testname
                                                                        (if (equal? itempath "")
                                                                            "" 
                                                                            (conc "/" itempath ))))
                                                    (testdat-raw (map vector->list (rmt:read-test-data-alt run-id test-id categorypatt setvarpatt)))
                                                    (testdat-raw (map vector->list (rmt:read-test-data-varpatt run-id test-id categorypatt setvarpatt)))
                                                    (testdat (filter
                                                              (lambda (x)
                                                                (not (equal? "logpro"
                                                                             (list-ref x 10))))
                                                              testdat-raw)))
                                               (map 
                                                (lambda (item)
︙

Modified rmt.scm from [30f81906bb] to [b5361867f1].

︙
910
911
912
913
914
915
916

917
918


919
920
921
922
923
924
925

910
911
912
913
914
915
916
917


918
919
920
921
922
923
924
925
926








+
-
-
+
+









;;======================================================================
;;  T E S T   D A T A 
;;======================================================================

(define (rmt:read-test-data run-id test-id categorypatt #!key (work-area #f)) 
  (rmt:send-receive 'read-test-data run-id (list run-id test-id categorypatt)))

(define (rmt:read-test-data-alt run-id test-id categorypatt varpatt #!key (work-area #f)) 
  (rmt:send-receive 'read-test-data-alt run-id (list run-id test-id categorypatt varpatt)))
(define (rmt:read-test-data-varpatt run-id test-id categorypatt varpatt #!key (work-area #f)) 
  (rmt:send-receive 'read-test-data-varpatt run-id (list run-id test-id categorypatt varpatt)))

(define (rmt:get-data-info-by-id test-data-id)
   (rmt:send-receive 'get-data-info-by-id #f (list test-data-id)))

(define (rmt:testmeta-add-record testname)
  (rmt:send-receive 'testmeta-add-record #f (list testname)))
︙

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