Overview
Comment: | Minor clean up of units |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | v1.80-mbi |
Files: | files | file ages | folders |
SHA1: |
c10775f9d83a4e29f50f9ccdbfc9fd32 |
User & Date: | mrwellan on 2023-03-31 16:30:04 |
Other Links: | branch diff | manifest | tags |
Context
2023-03-31
| ||
17:56 | Add filter to plot-uses check-in: 198baf1267 user: mrwellan tags: v1.80-mbi | |
16:30 | Minor clean up of units check-in: c10775f9d8 user: mrwellan tags: v1.80-mbi | |
2023-03-30
| ||
09:28 | Added rmtmod where needed check-in: 5aedc5c5f0 user: matt tags: v1.80-mbi | |
Changes
Modified Makefile from [0724779afb] to [84f0ec3c1e].
︙ | ︙ | |||
21 22 23 24 25 26 27 | PREFIX=$(PWD) CSCOPTS= INSTALL=install SRCFILES = common.scm items.scm launch.scm ods.scm runconfig.scm \ server.scm configf.scm db.scm keys.scm margs.scm \ process.scm runs.scm tasks.scm tests.scm genexample.scm \ tdb.scm mt.scm \ | | | 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 | PREFIX=$(PWD) CSCOPTS= INSTALL=install SRCFILES = common.scm items.scm launch.scm ods.scm runconfig.scm \ server.scm configf.scm db.scm keys.scm margs.scm \ process.scm runs.scm tasks.scm tests.scm genexample.scm \ tdb.scm mt.scm \ ezsteps.scm rmt.scm api.scm \ subrun.scm portlogger.scm archive.scm env.scm \ diff-report.scm cgisetup/models/pgdb.scm # module source files MSRCFILES = dbfile.scm debugprint.scm mtargs.scm commonmod.scm dbmod.scm \ tcp-transportmod.scm rmtmod.scm |
︙ | ︙ | |||
121 122 123 124 125 126 127 | common.o \ configf.o \ db.o \ env.o \ items.o \ keys.o \ launch.o \ | < | 121 122 123 124 125 126 127 128 129 130 131 132 133 134 | common.o \ configf.o \ db.o \ env.o \ items.o \ keys.o \ launch.o \ margs.o \ mt.o \ ods.o \ portlogger.o \ process.o \ rmt.o \ runconfig.o \ |
︙ | ︙ | |||
491 492 493 494 495 496 497 | if csi -ne '(import mysql-client)'&> /dev/null;then \ echo "(import mysql-client)(hash-table-set! *available-db* 'mysql #t)" >> altdb.scm; \ fi if csi -ne '(import postgresql)'&> /dev/null;then \ echo "(import postgresql)(hash-table-set! *available-db* 'postgresql #t)" >> altdb.scm;\ fi | | | > > > > > > > > > < < < < < < < < | 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 | if csi -ne '(import mysql-client)'&> /dev/null;then \ echo "(import mysql-client)(hash-table-set! *available-db* 'mysql #t)" >> altdb.scm; \ fi if csi -ne '(import postgresql)'&> /dev/null;then \ echo "(import postgresql)(hash-table-set! *available-db* 'postgresql #t)" >> altdb.scm;\ fi # portlogger-example : portlogger-example.scm api.o archive.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o server.o synchash.o tasks.o tdb.o tests.o tree.o # csc $(CSCOPTS) portlogger-example.scm api.o archive.o common.o configf.o dashboard-tests.o dashboard-context-menu.o db.o dcommon.o ezsteps.o genexample.o gutils.o items.o keys.o launch.o lock-queue.o margs.o mt.o ods.o portlogger.o process.o rmt.o runconfig.o runs.o server.o sync-hash.o tasks.o tdb.o tests.o tree.o unitdeps.dot : *scm ./utils/plot-uses ./utils/plot-uses todot *.scm > unitdeps.dot unitdeps.pdf : unitdeps.dot dot unitdeps.dot -Tpdf -o unitdeps.pdf ./utils/plot-uses : utils/plot-uses.scm csc utils/plot-uses.scm # create a pdf dot graphviz diagram from notations in rmt.scm rmt.pdf : rmt.scm grep ';;DOT' rmt.scm | sed -e 's/.*;;DOT //' > rmt.dot;dot -Tpdf rmt.dot -o rmt.pdf buildmanual: cd docs/manual && make targets: @grep : Makefile | perl -ne '/^([A-Za-z0-9_-]+):/ && print "$$1\n"' unit : cd tests;make unit |
Modified api.scm from [9b08184ae6] to [8894c9cdb4].
︙ | ︙ | |||
15 16 17 18 19 20 21 | ;; ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;; ;;====================================================================== (declare (unit api)) | < < < | 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 | ;; ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;; ;;====================================================================== (declare (unit api)) (declare (uses db)) (declare (uses debugprint)) (declare (uses dbmod)) (declare (uses dbfile)) (declare (uses tasks)) (declare (uses tcp-transportmod)) (import dbmod) (import dbfile) (import debugprint) (import tcp-transportmod) (use srfi-69 posix matchable s11n) |
︙ | ︙ |
Modified apimod.scm from [a7cef484dc] to [eede50dabc].
︙ | ︙ | |||
16 17 18 19 20 21 22 | ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (declare (unit apimod)) (declare (uses commonmod)) | < < | 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 | ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;;====================================================================== (declare (unit apimod)) (declare (uses commonmod)) (module apimod * (import scheme chicken data-structures extras) (import (prefix sqlite3 sqlite3:) posix typed-records srfi-18) (import commonmod) ) |
Name change from index-tree.scm to attic/index-tree.scm.
︙ | ︙ |
Name change from lock-queue.scm to attic/lock-queue.scm.
︙ | ︙ |
Modified commonmod.scm from [bbd943f11f] to [19a34cf301].
︙ | ︙ | |||
91 92 93 94 95 96 97 98 99 100 101 102 103 104 | ;; testsuite and area utilites ;; ;;====================================================================== (include "megatest-version.scm") (include "megatest-fossil-hash.scm") (define (get-full-version) (conc megatest-version "-" megatest-fossil-hash)) (define (version-signature) (conc megatest-version "-" (substring megatest-fossil-hash 0 4))) (define *common:denoise* (make-hash-table)) ;; for low noise printing | > > > > > > | 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 | ;; testsuite and area utilites ;; ;;====================================================================== (include "megatest-version.scm") (include "megatest-fossil-hash.scm") ;; http - use the old http + in /tmp db ;; tcp - use tcp transport with inmem db ;; nfs - use direct to disk access (read-only) ;; (define rmt:transport-mode (make-parameter 'tcp)) (define (get-full-version) (conc megatest-version "-" megatest-fossil-hash)) (define (version-signature) (conc megatest-version "-" (substring megatest-fossil-hash 0 4))) (define *common:denoise* (make-hash-table)) ;; for low noise printing |
︙ | ︙ |
Modified rmt.scm from [7c73e45fa8] to [759d7a27d6].
︙ | ︙ | |||
36 37 38 39 40 41 42 | commonmod debugprint ;; dbmemmod dbfile dbmod tcp-transportmod) | < < < < < | 36 37 38 39 40 41 42 43 44 45 46 47 48 49 | commonmod debugprint ;; dbmemmod dbfile dbmod tcp-transportmod) ;; ;; THESE ARE ALL CALLED ON THE CLIENT SIDE!!! ;; ;; generate entries for ~/.megatestrc with the following ;; ;; grep define ../rmt.scm | grep rmt: |perl -pi -e 's/\(define\s+\((\S+)\W.*$/\1/'|sort -u |
︙ | ︙ |
Modified tests.scm from [45e41fe8dc] to [1a4573f7da].
︙ | ︙ | |||
19 20 21 22 23 24 25 | ;;====================================================================== ;;====================================================================== ;; Tests ;;====================================================================== (declare (unit tests)) | < < < < | 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | ;;====================================================================== ;;====================================================================== ;; Tests ;;====================================================================== (declare (unit tests)) (declare (uses db)) (declare (uses tdb)) (declare (uses debugprint)) (declare (uses common)) (declare (uses commonmod)) (declare (uses items)) (declare (uses runconfig)) (declare (uses server)) (declare (uses mtargs)) (declare (uses rmtmod)) (use sqlite3 srfi-1 posix regex regex-case srfi-69 dot-locking tcp directory-utils) (import (prefix sqlite3 sqlite3:)) (import commonmod (prefix mtargs args:) |
︙ | ︙ |
Deleted ulex.scm version [39353b5283].
|
| < < < < < < < < < < < < < < < < < < < < < < < < |
Added utils/plot-uses.scm version [74e9dea5a4].
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 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 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 | #!/mfs/pkgs/chicken/4.8.0.5/bin/csi -nbq ;; Copyright 2006-2017, Matthew Welland. ;; ;; This file is part of Megatest. ;; ;; Megatest is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; ;; Megatest is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with Megatest. If not, see <http://www.gnu.org/licenses/>. ;; ;; Coming soon (right?) Usage: plot-code file1.scm,file2.scm "fun1,fun2,x*" *.scm > plot.dot ;; Usage: plot-code file1.scm,file2.scm *.scm > plot.dot ;; dot -Tpdf plot.dot > plot.pdf ;; first param is comma separated list of files to include in the map, use - to do all ;; second param is list of regexs for functions to include in the map ;; third param is list of files to scan (module plot-uses * (import scheme chicken) (use regex srfi-69 srfi-13) (use matchable data-structures ports extras) (define unituses-rx (regexp "^\\(declare \\((unit|uses) ([^\\(\\)]+)\\).*")) (define (print-err . data) (with-output-to-port (current-error-port) (lambda () (apply print data)))) (define (process-file fname) (with-input-from-file fname (lambda () (let loop ((modname "DUMMYMOD")) (let* ((inl (read-line))) (if (eof-object? inl) #t (match (string-search unituses-rx inl) ((_ dtype unitname) (if (equal? dtype "unit") (loop unitname) (begin (if (equal? dtype "uses") (if (not (member modname '("DUMMYMOD"))) (print " \""unitname"\" -> \""modname"\";")) (print-err "ERROR: bad declare line \""inl"\"")) (loop modname)))) (else (loop modname))))))))) (define (main) (match (command-line-arguments) (("todot" . files) (print-err "Making graph for files: " (string-intersperse files ", ")) (print "digraph uses_unit {") (for-each (lambda (fname) (print "// Filename: "fname) (process-file fname)) files) (print "}")) (else (print-err "Usage: plot-uses file1.scm ...")))) (main) ) ;; ;; ;; Gather the usages ;; (print "digraph G {") ;; (define curr-cluster-num 0) ;; (define function-calls '()) ;; ;; (for-each ;; (lambda (fname) ;; (let ((last-func #f)) ;; (print-err "Processing file " fname) ;; (print "subgraph cluster_" curr-cluster-num " {") ;; (set! curr-cluster-num (+ curr-cluster-num 1)) ;; (with-input-from-file fname ;; (lambda () ;; (with-output-to-port (current-error-port) ;; (lambda () ;; (print "Analyzing file " fname))) ;; (print "label=\"" fname "\";") ;; (let loop ((inl (read-line)) ;; (fnname "toplevel") ;; (allcalls '())) ;; (if (eof-object? inl) ;; (begin ;; (set! function-calls (cons (list fnname allcalls) function-calls)) ;; (for-each ;; (lambda (call-name) ;; (hash-table-set! breadcrumbs call-name #t)) ;; allcalls) ;; (print-err "function: " fnname " allcalls: " allcalls)) ;; (let ((match (string-match defn-rx inl))) ;; (if match ;; (let ((func-name (cadr match))) ;; (if last-func ;; (print "\"" func-name "\" -> \"" last-func "\";") ;; (print "\"" func-name "\";")) ;; (set! last-func func-name) ;; (hash-table-set! breadcrumbs func-name #t) ;; (loop (read-line) ;; func-name ;; allcalls)) ;; (let ((calls (look-for-all-calls inl fnname))) ;; (loop (read-line) fnname (append allcalls calls))))))))) ;; (print "}"))) ;; targs) ;; ;; (print-err "breadcrumbs: " (hash-table-keys breadcrumbs)) ;; (print-err "function-calls: " function-calls) ;; ;; (for-each ;; (lambda (function-call) ;; (print-err "function-call: " function-call) ;; (let ((fnname (car function-call)) ;; (calls (cadr function-call))) ;; (for-each ;; (lambda (callname) ;; (print (if (hash-table-ref/default breadcrumbs callname #f) "" "// ") ;; "\"" fnname "\" -> \"" callname "\";")) ;; calls))) ;; function-calls) ;; ;; (print "}") ;; ;; (exit) ;; |