Overview
| Comment: | converted db accessors to procedures |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.6584-ck5 |
| Files: | files | file ages | folders |
| SHA1: |
e2dacbec3a2ca0095c8061716028c44c |
| User & Date: | matt on 2021-04-15 15:23:17 |
| Other Links: | branch diff | manifest | tags |
Context
|
2021-04-15
| ||
| 20:08 | compiles, help and repl work - if you run with path to executable check-in: 97e36f1c29 user: matt tags: v1.6584-ck5 | |
| 15:23 | converted db accessors to procedures check-in: e2dacbec3a user: matt tags: v1.6584-ck5 | |
| 00:08 | added missing file check-in: 471ddaee23 user: matt tags: v1.6584-ck5 | |
Changes
Modified archivemod.scm from [f8a6de6075] to [1c0f8e1665].
| ︙ | ︙ | |||
91 92 93 94 95 96 97 | ;; (use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 format md5 message-digest srfi-18) ;; ;; (declare (unit archive)) ;; (declare (uses db)) ;; (declare (uses common)) ;; ;; (include "common_records.scm") | | | 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | ;; (use (prefix sqlite3 sqlite3:) srfi-1 posix regex regex-case srfi-69 format md5 message-digest srfi-18) ;; ;; (declare (unit archive)) ;; (declare (uses db)) ;; (declare (uses common)) ;; ;; (include "common_records.scm") ;; (include "db_records.scm") ;; ;;====================================================================== ;; ;;====================================================================== ;; NOT CURRENTLY USED ;; |
| ︙ | ︙ |
Modified common_records.scm from [9a86cd2d43] to [9505f2c8b8].
| ︙ | ︙ | |||
65 66 67 68 69 70 71 |
(print-call-chain (current-error-port))
(with-output-to-port (current-error-port)
(lambda ()
(print ((condition-property-accessor 'exn 'message) exn))
(print "Callback error in " procname)
(print "Full condition info:\n" (condition->list exn)))))
(proc)))
| < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < < | 65 66 67 68 69 70 71 |
(print-call-chain (current-error-port))
(with-output-to-port (current-error-port)
(lambda ()
(print ((condition-property-accessor 'exn 'message) exn))
(print "Callback error in " procname)
(print "Full condition info:\n" (condition->list exn)))))
(proc)))
|
Modified commonmod.scm from [1142c0775a] to [2c1167f0dc].
| ︙ | ︙ | |||
90 91 92 93 94 95 96 97 98 99 100 101 102 103 | ;; config file utils ;; misc conversion, data manipulation functions ;; testsuite and area utilites ;; ;;====================================================================== (include "megatest-fossil-hash.scm") ;; these come from processmod ;; ;; (define setenv set-environment-variable!) ;; (define unsetenv unset-environment-variable!) ;; (define getenv get-environment-variable) | > | 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | ;; config file utils ;; misc conversion, data manipulation functions ;; testsuite and area utilites ;; ;;====================================================================== (include "megatest-fossil-hash.scm") (include "db_records.scm") ;; these come from processmod ;; ;; (define setenv set-environment-variable!) ;; (define unsetenv unset-environment-variable!) ;; (define getenv get-environment-variable) |
| ︙ | ︙ |
Modified db_records.scm from [b1c479de82] to [fefce42cd2].
| ︙ | ︙ | |||
74 75 76 77 78 79 80 | ;; (dbr:dbstruct-path-set! v path) ;; (dbr:dbstruct-local-set! v local) ;; (dbr:dbstruct-locdbs-set! v (make-hash-table)) ;; v)) (define (make-db:test)(make-vector 20)) | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | 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 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 |
;; (dbr:dbstruct-path-set! v path)
;; (dbr:dbstruct-local-set! v local)
;; (dbr:dbstruct-locdbs-set! v (make-hash-table))
;; v))
(define (make-db:test)(make-vector 20))
(define (db:test-get-id vec) (vector-ref vec 0))
(define (db:test-get-run_id vec) (vector-ref vec 1))
(define (db:test-get-testname vec) (vector-ref vec 2))
(define (db:test-get-state vec) (vector-ref vec 3))
(define (db:test-get-status vec) (vector-ref vec 4))
(define (db:test-get-event_time vec) (vector-ref vec 5))
(define (db:test-get-host vec) (vector-ref vec 6))
(define (db:test-get-cpuload vec) (vector-ref vec 7))
(define (db:test-get-diskfree vec) (vector-ref vec 8))
(define (db:test-get-uname vec) (vector-ref vec 9))
;; (define (db:test-get-rundir vec) (sdb:qry 'getstr (vector-ref vec 10)))
(define (db:test-get-rundir vec) (vector-ref vec 10))
(define (db:test-get-item-path vec) (vector-ref vec 11))
(define (db:test-get-run_duration vec) (vector-ref vec 12))
(define (db:test-get-final_logf vec) (vector-ref vec 13))
(define (db:test-get-comment vec) (vector-ref vec 14))
(define (db:test-get-process_id vec) (vector-ref vec 16))
(define (db:test-get-archived vec) (vector-ref vec 17))
(define (db:test-get-last_update vec) (vector-ref vec 18))
;; (define (db:test-get-pass_count vec) (vector-ref vec 15))
;; (define (db:test-get-fail_count vec) (vector-ref vec 16))
(define (db:test-get-fullname vec)
(conc (db:test-get-testname vec) "/" (db:test-get-item-path vec)))
;; replace runs:make-full-test-name with this routine
(define (db:test-make-full-name testname itempath)
(if (equal? itempath "") testname (conc testname "/" itempath)))
(define (db:test-get-first_err vec) (conc #;printable (vector-ref vec 15)))
(define (db:test-get-first_warn vec) (conc #;printable (vector-ref vec 16))) ;; RADT => reference 16 is repeated
(define (db:test-set-cpuload! vec val)(vector-set! vec 7 val))
(define (db:test-set-diskfree! vec val)(vector-set! vec 8 val))
(define (db:test-set-testname! vec val)(vector-set! vec 2 val))
(define (db:test-set-state! vec val)(vector-set! vec 3 val))
(define (db:test-set-status! vec val)(vector-set! vec 4 val))
(define (db:test-set-run_duration! vec val)(vector-set! vec 12 val))
(define (db:test-set-final_logf! vec val)(vector-set! vec 13 val))
;; Test record utility functions
;; Is a test a toplevel?
;;
(define (db:test-get-is-toplevel vec)
(and (equal? (db:test-get-item-path vec) "") ;; test is not an item
(equal? (db:test-get-uname vec) "n/a"))) ;; test has never been run
;; make-vector-record "" db mintest id run_id testname state status event_time item_path
;; RADT => purpose of mintest??
;;
(define (make-db:mintest)(make-vector 7))
(define (db:mintest-get-id vec) (vector-ref vec 0))
(define (db:mintest-get-run_id vec) (vector-ref vec 1))
(define (db:mintest-get-testname vec) (vector-ref vec 2))
(define (db:mintest-get-state vec) (vector-ref vec 3))
(define (db:mintest-get-status vec) (vector-ref vec 4))
(define (db:mintest-get-event_time vec) (vector-ref vec 5))
(define (db:mintest-get-item_path vec) (vector-ref vec 6))
;; make-vector-record db testmeta id testname author owner description reviewed iterated avg_runtime avg_disk
(define (make-db:testmeta)(make-vector 10 ""))
(define (db:testmeta-get-id vec) (vector-ref vec 0))
(define (db:testmeta-get-testname vec) (vector-ref vec 1))
(define (db:testmeta-get-author vec) (vector-ref vec 2))
(define (db:testmeta-get-owner vec) (vector-ref vec 3))
(define (db:testmeta-get-description vec) (vector-ref vec 4))
(define (db:testmeta-get-reviewed vec) (vector-ref vec 5))
(define (db:testmeta-get-iterated vec) (vector-ref vec 6))
(define (db:testmeta-get-avg_runtime vec) (vector-ref vec 7))
(define (db:testmeta-get-avg_disk vec) (vector-ref vec 8))
(define (db:testmeta-get-tags vec) (vector-ref vec 9))
(define (db:testmeta-set-id! vec val)(vector-set! vec 0 val))
(define (db:testmeta-set-testname! vec val)(vector-set! vec 1 val))
(define (db:testmeta-set-author! vec val)(vector-set! vec 2 val))
(define (db:testmeta-set-owner! vec val)(vector-set! vec 3 val))
(define (db:testmeta-set-description! vec val)(vector-set! vec 4 val))
(define (db:testmeta-set-reviewed! vec val)(vector-set! vec 5 val))
(define (db:testmeta-set-iterated! vec val)(vector-set! vec 6 val))
(define (db:testmeta-set-avg_runtime! vec val)(vector-set! vec 7 val))
(define (db:testmeta-set-avg_disk! vec val)(vector-set! vec 8 val))
;;======================================================================
;; S I M P L E R U N
;;======================================================================
;; (defstruct id "runname" "state" "status" "owner" "event_time"
;;======================================================================
;; T E S T D A T A
;;======================================================================
(define (make-db:test-data)(make-vector 10))
(define (db:test-data-get-id vec) (vector-ref vec 0))
(define (db:test-data-get-test_id vec) (vector-ref vec 1))
(define (db:test-data-get-category vec) (vector-ref vec 2))
(define (db:test-data-get-variable vec) (vector-ref vec 3))
(define (db:test-data-get-value vec) (vector-ref vec 4))
(define (db:test-data-get-expected vec) (vector-ref vec 5))
(define (db:test-data-get-tol vec) (vector-ref vec 6))
(define (db:test-data-get-units vec) (vector-ref vec 7))
(define (db:test-data-get-comment vec) (vector-ref vec 8))
(define (db:test-data-get-status vec) (vector-ref vec 9))
(define (db:test-data-get-type vec) (vector-ref vec 10))
(define (db:test-data-get-last_update vec) (vector-ref vec 11))
(define (db:test-data-set-id! vec val)(vector-set! vec 0 val))
(define (db:test-data-set-test_id! vec val)(vector-set! vec 1 val))
(define (db:test-data-set-category! vec val)(vector-set! vec 2 val))
(define (db:test-data-set-variable! vec val)(vector-set! vec 3 val))
(define (db:test-data-set-value! vec val)(vector-set! vec 4 val))
(define (db:test-data-set-expected! vec val)(vector-set! vec 5 val))
(define (db:test-data-set-tol! vec val)(vector-set! vec 6 val))
(define (db:test-data-set-units! vec val)(vector-set! vec 7 val))
(define (db:test-data-set-comment! vec val)(vector-set! vec 8 val))
(define (db:test-data-set-status! vec val)(vector-set! vec 9 val))
(define (db:test-data-set-type! vec val)(vector-set! vec 10 val))
;;======================================================================
;; S T E P S
;;======================================================================
;; Run steps
;; make-vector-record "Run steps" db step id test_id stepname step_complete step_pass event_time
(define (make-db:step)(make-vector 9))
(define (tdb:step-get-id vec) (vector-ref vec 0))
(define (tdb:step-get-test_id vec) (vector-ref vec 1))
(define (tdb:step-get-stepname vec) (vector-ref vec 2))
(define (tdb:step-get-state vec) (vector-ref vec 3))
(define (tdb:step-get-status vec) (vector-ref vec 4))
(define (tdb:step-get-event_time vec) (vector-ref vec 5))
(define (tdb:step-get-logfile vec) (vector-ref vec 6))
(define (tdb:step-get-comment vec) (vector-ref vec 7))
(define (tdb:step-get-last_update vec) (vector-ref vec 8))
(define (tdb:step-set-id! vec val)(vector-set! vec 0 val))
(define (tdb:step-set-test_id! vec val)(vector-set! vec 1 val))
(define (tdb:step-set-stepname! vec val)(vector-set! vec 2 val))
(define (tdb:step-set-state! vec val)(vector-set! vec 3 val))
(define (tdb:step-set-status! vec val)(vector-set! vec 4 val))
(define (tdb:step-set-event_time! vec val)(vector-set! vec 5 val))
(define (tdb:step-set-logfile! vec val)(vector-set! vec 6 val))
(define (tdb:step-set-comment! vec val)(vector-set! vec 7 val))
;; The steps table
(define (make-db:steps-table)(make-vector 5))
(define (tdb:steps-table-get-stepname vec) (vector-ref vec 0))
(define (tdb:steps-table-get-start vec) (vector-ref vec 1))
(define (tdb:steps-table-get-end vec) (vector-ref vec 2))
(define (tdb:steps-table-get-status vec) (vector-ref vec 3))
(define (tdb:steps-table-get-runtime vec) (vector-ref vec 4))
(define (tdb:steps-table-get-log-file vec) (vector-ref vec 5))
(define (tdb:step-stable-set-stepname! vec val)(vector-set! vec 0 val))
(define (tdb:step-stable-set-start! vec val)(vector-set! vec 1 val))
(define (tdb:step-stable-set-end! vec val)(vector-set! vec 2 val))
(define (tdb:step-stable-set-status! vec val)(vector-set! vec 3 val))
(define (tdb:step-stable-set-runtime! vec val)(vector-set! vec 4 val))
;; The data structure for handing off requests via wire
(define (make-cdb:packet)(make-vector 6))
(define (cdb:packet-get-client-sig vec) (vector-ref vec 0))
(define (cdb:packet-get-qtype vec) (vector-ref vec 1))
(define (cdb:packet-get-immediate vec) (vector-ref vec 2))
(define (cdb:packet-get-query-sig vec) (vector-ref vec 3))
(define (cdb:packet-get-params vec) (vector-ref vec 4))
(define (cdb:packet-get-qtime vec) (vector-ref vec 5))
(define (cdb:packet-set-client-sig! vec val)(vector-set! vec 0 val))
(define (cdb:packet-set-qtype! vec val)(vector-set! vec 1 val))
(define (cdb:packet-set-immediate! vec val)(vector-set! vec 2 val))
(define (cdb:packet-set-query-sig! vec val)(vector-set! vec 3 val))
(define (cdb:packet-set-params! vec val)(vector-set! vec 4 val))
(define (cdb:packet-set-qtime! vec val)(vector-set! vec 5 val))
|
Modified dbmod.scm from [dc7e97c759] to [8a7fea8aaf].
| ︙ | ︙ | |||
90 91 92 93 94 95 96 | ;; (declare (uses keys)) ;; (declare (uses ods)) ;; (declare (uses client)) ;; (declare (uses mt)) ;; ;; (include "common_records.scm") | | | 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 | ;; (declare (uses keys)) ;; (declare (uses ods)) ;; (declare (uses client)) ;; (declare (uses mt)) ;; ;; (include "common_records.scm") ;; (include "db_records.scm") (include "key_records.scm") ;; (include "run_records.scm") (define *number-of-writes* 0) (define *number-non-write-queries* 0) ;;====================================================================== |
| ︙ | ︙ |
Modified ezstepsmod.scm from [c2dd1003d3] to [d9ce0e65b9].
| ︙ | ︙ | |||
93 94 95 96 97 98 99 | ;; (declare (uses items)) ;; (declare (uses runconfig)) ;; ;; (declare (uses sdb)) ;; ;; (declare (uses filedb)) ;; ;; (include "common_records.scm") ;; (include "key_records.scm") | | | 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 | ;; (declare (uses items)) ;; (declare (uses runconfig)) ;; ;; (declare (uses sdb)) ;; ;; (declare (uses filedb)) ;; ;; (include "common_records.scm") ;; (include "key_records.scm") ;; (include "db_records.scm") ;; (include "run_records.scm") ;; ;; ;;(rmt:get-test-info-by-id run-id test-id) -> testdat (define message-window #f) |
| ︙ | ︙ |
Modified http-transportmod.scm from [194fbe34ee] to [68352bdfd6].
| ︙ | ︙ | |||
104 105 106 107 108 109 110 | ;; (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running. ;; (declare (uses server)) ;; ;; (declare (uses daemon)) ;; (declare (uses portlogger)) ;; (declare (uses rmt)) ;; ;; (include "common_records.scm") | | | 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 |
;; (declare (uses tasks)) ;; tasks are where stuff is maintained about what is running.
;; (declare (uses server))
;; ;; (declare (uses daemon))
;; (declare (uses portlogger))
;; (declare (uses rmt))
;;
;; (include "common_records.scm")
;; (include "db_records.scm")
;; (include "js-path.scm")
;; (require-library stml)
(define (http-transport:make-server-url hostport)
(if (not hostport)
#f
(conc "http://" (car hostport) ":" (cadr hostport))))
|
| ︙ | ︙ |
Modified launchmod.scm from [1c5a69d4fb] to [90e4e1ba80].
| ︙ | ︙ | |||
92 93 94 95 96 97 98 | processmod rmtmod servermod subrunmod testsmod ) | | | 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 | processmod rmtmod servermod subrunmod testsmod ) ;; (include "db_records.scm") (include "key_records.scm") ;;====================================================================== ;; ezsteps ;;====================================================================== ;; ezsteps were going to be coded as |
| ︙ | ︙ |
Modified megatest.scm from [97792d486c] to [9175824e00].
| ︙ | ︙ | |||
141 142 143 144 145 146 147 | ;; tasksmod testsmod ) ;; fake out readline usage of toplevel-command (define (toplevel-command . a) #f) | < < | | | 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 | ;; tasksmod testsmod ) ;; fake out readline usage of toplevel-command (define (toplevel-command . a) #f) (define *db* #f) ;; this is only for the repl, do not use in general!!!! ;; (include "common_records.scm") ;; (include "key_records.scm") ;; (include "db_records.scm") (include "run_records.scm") ;; (include "test_records.scm") (include "common.scm") (include "db.scm") (include "server.scm") (include "tests.scm") |
| ︙ | ︙ |
Modified mtmod.scm from [0faea80728] to [961c38c9fc].
| ︙ | ︙ | |||
80 81 82 83 84 85 86 | ;; (declare (uses server)) ;; (declare (uses runs)) ;; (declare (uses rmt)) ;; ;; (declare (uses filedb)) ;; ;; (include "common_records.scm") ;; (include "key_records.scm") | | | 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | ;; (declare (uses server)) ;; (declare (uses runs)) ;; (declare (uses rmt)) ;; ;; (declare (uses filedb)) ;; ;; (include "common_records.scm") ;; (include "key_records.scm") ;; (include "db_records.scm") ;; (include "run_records.scm") ;; (include "test_records.scm") ;; This is the Megatest API. All generally "useful" routines will be wrapped or extended ;; here. (define (mt:discard-blocked-tests run-id failed-test tests test-records) |
| ︙ | ︙ |
Modified rmtmod.scm from [625e964a73] to [ce483e1308].
| ︙ | ︙ | |||
68 69 70 71 72 73 74 | ) (defstruct alldat (areapath #f) (ulexdat #f) ) | | | 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 | ) (defstruct alldat (areapath #f) (ulexdat #f) ) ;; (include "db_records.scm") ;;====================================================================== ;; return the handle struct for sending queries to a specific database ;; - initializes the connection object if this is the first access ;; - finds the "captain" and asks who to talk to for the given dbfname ;; - establishes the connection to the current dbowner ;; |
| ︙ | ︙ |
Modified runsmod.scm from [2690188456] to [af3c8fc3d0].
| ︙ | ︙ | |||
95 96 97 98 99 100 101 | launchmod subrunmod servermod itemsmod ) | | | 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 | launchmod subrunmod servermod itemsmod ) ;; (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") (include "key_records.scm") ;; use this struct to facilitate refactoring ;; |
| ︙ | ︙ |
Modified tasksmod.scm from [a2cb242f3c] to [04ec90a3d8].
| ︙ | ︙ | |||
89 90 91 92 93 94 95 | ;; (declare (uses rmt)) ;; (declare (uses common)) ;; (declare (uses pgdb)) ;; (import pgdb) ;; pgdb is a module (include "task_records.scm") | | | 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 | ;; (declare (uses rmt)) ;; (declare (uses common)) ;; (declare (uses pgdb)) ;; (import pgdb) ;; pgdb is a module (include "task_records.scm") ;; (include "db_records.scm") ;;====================================================================== ;; Tasks db ;;====================================================================== ;; wait up to aprox n seconds for a journal to go away ;; |
| ︙ | ︙ |
Modified testsmod.scm from [f755d84d12] to [4c8938f16a].
| ︙ | ︙ | |||
104 105 106 107 108 109 110 | ;; ;; (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils) ;; (import (prefix sqlite3 sqlite3:)) ;; (require-library stml) ;; ;; (include "common_records.scm") ;; (include "key_records.scm") | | | 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 | ;; ;; (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils) ;; (import (prefix sqlite3 sqlite3:)) ;; (require-library stml) ;; ;; (include "common_records.scm") ;; (include "key_records.scm") ;; (include "db_records.scm") (include "run_records.scm") (include "test_records.scm") (include "js-path.scm") (define (init-java-script-lib) (set! *java-script-lib* (conc (common:get-install-area) "/share/js/jquery-3.1.0.slim.min.js")) ) |
| ︙ | ︙ |