Megatest

Check-in [198baf1267]
Login
Overview
Comment:Add filter to plot-uses
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.80-mbi
Files: files | file ages | folders
SHA1: 198baf1267f1429d940a8440f34a64539673fb53
User & Date: mrwellan on 2023-03-31 17:56:44
Other Links: branch diff | manifest | tags
Context
2023-03-31
21:32
More cleanup check-in: 57d442213a user: matt tags: v1.80-mbi
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
Changes

Modified Makefile from [84f0ec3c1e] to [aeac845805].

493
494
495
496
497
498
499
500
501


502
503
504
505
506
507
508
493
494
495
496
497
498
499


500
501
502
503
504
505
506
507
508







-
-
+
+







	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.dot : *scm ./utils/plot-uses Makefile
	./utils/plot-uses todot commonmod.import,mtargs.import,mtargs,debugprint *.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

Modified utils/plot-uses.scm from [74e9dea5a4] to [a8d79f928b].

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
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







-
+












-
+
+
+








-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
+
+







(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)
(define (process-file ignores 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")))
			    (if (not (or (member modname '("DUMMYMOD"))
					 (member modname ignores)
					 (member unitname ignores)))
				(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 "}"))
    (("todot" ignoreunits . files)
     (let* ((ignores (string-split ignoreunits ",")))
       (print-err "Making graph for files: " (string-intersperse files ", "))
       (print "digraph uses_unit {")
       (for-each
	(lambda (fname)
	  (print "// Filename: "fname)
	  (process-file ignores fname))
	files)
       (print "}")))
    (else
     (print-err "Usage: plot-uses file1.scm ..."))))
     (print-err "Usage: plot-uses u1,u2... file1.scm ...")
     (print-err "    where u1,u2... are units to ignore and file1.scm... are the files to process."))))

(main)

)
;; 
;; ;; Gather the usages
;; (print "digraph G {")