Megatest

Check-in [4f82003dc0]
Login
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: 4f82003dc0af1a95e10a23cc60a91b9b5ce9b461
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
1945

1946
1947
1948
1949
1950
1951
1952
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)
#;(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
3269

3270
3271
3272
3273
3274
3275
3276
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)
#;(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
291

292
293
294
295
296
297
298
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.
#;(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
380

381
382
383
384
385
386
387
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
#;(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
174






175
176
177
178
179
180
181
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)(< (car a)(car b)))))))
	      (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)