Overview
| Comment: | Sort danglers by name if same count. Few more orpaned functions commented out |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.6569-diet |
| Files: | files | file ages | folders |
| SHA1: |
4f82003dc0af1a95e10a23cc60a91b9b |
| User & Date: | matt on 2021-01-16 23:10:12 |
| Other Links: | branch diff | manifest | tags |
Context
|
2021-01-16
| ||
| 23:19 | Moved sauth and datashare files to appropriate subdirs, commented couple more unused functions. check-in: 155720494a user: matt tags: v1.6569-diet | |
| 23:10 | Sort danglers by name if same count. Few more orpaned functions commented out check-in: 4f82003dc0 user: matt tags: v1.6569-diet | |
| 22:59 | Moved sauth files to subdir. Improved show-uncalled-procedures output. Removed few unused procedures. check-in: c9e2628a91 user: matt tags: v1.6569-diet | |
Changes
Added danglers-to-ignore.txt version [b2a2845e76].
> > > > | 1 2 3 4 | spublish:lst->path megatest-param->mtutil-param add-target-mapper add-runname-mapper |
Modified db.scm from [a9d288c6b2] to [138ed10f64].
| ︙ | ︙ | |||
1938 1939 1940 1941 1942 1943 1944 | ;; 1. Look at test records either deleted or part of deleted run: ;; a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown' ;; b. If test dir gone, delete the test record ;; 2. Look at run records ;; a. If have tests that are not deleted, set state='unknown' ;; b. .... ;; | | | 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 | ;; 1. Look at test records either deleted or part of deleted run: ;; a. If test dir exists, set the the test to state='UNKNOWN', Set the run to 'unknown' ;; b. If test dir gone, delete the test record ;; 2. Look at run records ;; a. If have tests that are not deleted, set state='unknown' ;; b. .... ;; #;(define (db:clean-up-rundb dbdat) ;; (debug:print 0 *default-log-port* "WARNING: db clean up not fully ported to v1.60, cleanup action will be on megatest.db") (let* ((db (db:dbdat-get-db dbdat)) (count-stmt (sqlite3:prepare db "SELECT (SELECT count(id) FROM tests);")) (statements (map (lambda (stmt) (sqlite3:prepare db stmt)) (list |
| ︙ | ︙ | |||
3262 3263 3264 3265 3266 3267 3268 |
0))))
;; tags: '("tag%" "tag2" "%ag6")
;;
;; done with run when:
;; 0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
| | | 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 |
0))))
;; tags: '("tag%" "tag2" "%ag6")
;;
;; done with run when:
;; 0 tests in LAUNCHED, NOT_STARTED, REMOTEHOSTSTART, RUNNING
#;(define (db:estimated-tests-remaining dbstruct run-id)
(db:with-db
dbstruct
run-id
#f
(lambda (db)
(sqlite3:first-result
db
|
| ︙ | ︙ |
Modified server.scm from [8e9cdd2cea] to [c89e2532fc].
| ︙ | ︙ | |||
284 285 286 287 288 289 290 |
(define (server:record->url servr)
(match-let (((mod-time host port start-time pid)
servr))
(if (and host port)
(conc host ":" port)
#f)))
| | | 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 |
(define (server:record->url servr)
(match-let (((mod-time host port start-time pid)
servr))
(if (and host port)
(conc host ":" port)
#f)))
#;(define (server:get-client-signature) ;; BB> why is this proc named "get-"? it returns nothing -- set! has not return value.
(if *my-client-signature* *my-client-signature*
(let ((sig (server:mk-signature)))
(set! *my-client-signature* sig)
*my-client-signature*)))
;; wait for server=start-last to be three seconds old
;;
|
| ︙ | ︙ |
Modified tdb.scm from [6edff6262d] to [107bd93069].
| ︙ | ︙ | |||
373 374 375 376 377 378 379 |
(< (tdb:step-get-id a) (tdb:step-get-id b)))
(else #f)))))
res))
;;
;; Move to steps.scm
;;
| | | 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 |
(< (tdb:step-get-id a) (tdb:step-get-id b)))
(else #f)))))
res))
;;
;; Move to steps.scm
;;
#;(define (tdb:get-compressed-steps comprsteps) ;; from tdb:get-steps-table
(map (lambda (x)
;; take advantage of the \n on time->string
(vector
(vector-ref x 0)
(let ((s (vector-ref x 1)))
(if (number? s)(seconds->time-string s) s))
(let ((s (vector-ref x 2)))
|
| ︙ | ︙ |
Modified utils/show-uncalled-procedures.scm from [9e9d6c8594] to [7cf01ad99d].
| ︙ | ︙ | |||
167 168 169 170 171 172 173 |
;; (print "ignores: " (hash-table->alist ignores))
(for-each (lambda (dangler)
(let* ((fnname (conc (cadr dangler))))
;; (print "fnname="fnname" member: "(member fnname ignore-list))
(if (not (hash-table-exists? ignores fnname))
(apply print (intersperse dangler "\t"))
#;(print "skipping "fnname))))
| | > > > > > | 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 |
;; (print "ignores: " (hash-table->alist ignores))
(for-each (lambda (dangler)
(let* ((fnname (conc (cadr dangler))))
;; (print "fnname="fnname" member: "(member fnname ignore-list))
(if (not (hash-table-exists? ignores fnname))
(apply print (intersperse dangler "\t"))
#;(print "skipping "fnname))))
(sort danglers (lambda (a b)
(let ((ca (car a))
(cb (car b)))
(if (equal? ca cb)
(string<=? (conc (cadr a))(conc (cadr b)))
(< ca cb))))))))
;; (for-each print dangling-procs) ;; our product.
(define (get-stats fn)
(let* ((data (with-input-from-pipe (conc "grep '"fn"' *.scm") read-lines))
(files (delete-duplicates
(map (lambda (entry)
|
| ︙ | ︙ |