Megatest

Check-in [733a3a4bd6]
Login
Overview
Comment:fixed case in trackback.scm where cycle prevented seeing call path
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | v1.64
Files: files | file ages | folders
SHA1: 733a3a4bd604b30406171fcd47801c8f795ed10b
User & Date: bjbarcla on 2017-08-16 11:49:56
Other Links: branch diff | manifest | tags
Context
2017-08-16
15:23
factored out common code in show-uncalled-procedures.scm and trackback.scm check-in: 536b980f6a user: bjbarcla tags: v1.64
11:49
fixed case in trackback.scm where cycle prevented seeing call path check-in: 733a3a4bd6 user: bjbarcla tags: v1.64
11:11
fixed bug in show-uncalled-procedures.scm check-in: b4d839d5b8 user: bjbarcla tags: v1.64
Changes

Modified trackback.scm from [353b1160ce] to [b62dd10178].

143
144
145
146
147
148
149
150

151
152
153





154
155
156
157
158
159
160
143
144
145
146
147
148
149

150



151
152
153
154
155
156
157
158
159
160
161
162







-
+
-
-
-
+
+
+
+
+







  (letrec* ((all-scm-files (glob "*.scm"))
            (xref (get-xref all-scm-files))
            (have (alist-ref (string->symbol in-procname) xref eq? #f))
            (lookup (lambda (path procname depth)
                      (let* ((upcone-temp (filter (lambda (x)
                                                    (eq? procname (car x)))
                                                  xref))
                             (upcone (begin
                             (upcone-temp2 (cond
                                       (cond
                                        ((null? upcone-temp) '())
                                        (else (cdar upcone-temp)))))
                                            ((null? upcone-temp) '())
                                            (else (cdar upcone-temp))))
                             (upcone (filter
                                      (lambda (x) (not (eq? x procname)))
                                      upcone-temp2))
                             (uppath (cons procname path))
                             (updepth (add1 depth)))
                        (if (null? upcone)
                            (print  uppath)
                            (for-each (lambda (x)
                                        (if (not (member procname path))
                                            (lookup uppath x updepth) ))