From 8489697faa6eceeb5a0af24fe8228189d6b6418c Mon Sep 17 00:00:00 2001 From: Oscar Waddell Date: Tue, 19 Dec 2023 16:59:20 -0500 Subject: [PATCH] profile: fix destination for annotated files If a source file does (include "../../aux/file.ss"), then swish-test could end up trying to write an annotated file.ss.html outside the target directory containing the specified coverage summary report. To fix this we determine a common prefix based on the real paths of the profiled source files and use the distinct suffix as the path within the target directory. The appearance of the coverage report changes slightly since we: - sort entries based on the real path of the file, - use natural-stringlist - (vector-sort (lambda (a b) (string\n") (fprintf op "\n") (html->string op @@ -376,14 +401,15 @@ (let ([root (path-parent (get-real-path output-fn))]) (for-each (lambda (entry) - ;; entry = (sfd . skiplist | #f) + ;; entry = (source-path . skiplist | #f) (match entry - [(,name . ,sl) + [(,source-path . ,sl) (match (and sl (sl)) [,data (guard (pair? data)) ;; non-blocking i/o OK: profile:dump-html runs from dedicated OS process, not interested in concurrency - (let* ([ip (open-input-file name)] + (let* ([ip (open-input-file source-path)] + [name (strip-prefix source-path)] [file-op (open-file-to-replace (make-directory-path (path-combine root (string-append name ".html"))))]) (on-exit (close-port file-op) (annotate (pregexp-replace* "\\\\" name "/") ip data op file-op)))] diff --git a/src/swish/swish-test.ms b/src/swish/swish-test.ms index 8ddad485..097c72ee 100644 --- a/src/swish/swish-test.ms +++ b/src/swish/swish-test.ms @@ -1418,8 +1418,9 @@ e0 e1 ...))])) (isolate-mat profile () + (define src-file "profile-code.ss") (define source-file - (write-test-file "profile-code.ss" + (write-test-file src-file (lambda () (display "#!chezscheme\n") (display "(define (fac n)\n") @@ -1472,8 +1473,8 @@ ([#t (file-regular? coverage-file)] [,cov (utf8->string (read-file coverage-file))] [(,_) (pregexp-match "Overall 74% coverage with 17 of 23 sites covered" cov)] - [(,_) (pregexp-match (summary-row source-file-rel 17 23 74 12) cov)] - [,ss.html (path-combine (path-parent coverage-file) (string-append source-file-rel ".html"))] + [(,_) (pregexp-match (summary-row src-file 17 23 74 12) cov)] + [,ss.html (path-combine (path-parent coverage-file) (string-append src-file ".html"))] [#t (file-regular? ss.html)] [,ss (utf8->string (read-file ss.html))] [(,_) (check-count 2 "1" ss)] ;; base case @@ -1491,8 +1492,8 @@ ([#t (file-regular? coverage1-file)] [,cov1 (utf8->string (read-file coverage1-file))] [(,_) (pregexp-match "Overall 45% coverage with 18 of 40 sites covered" cov1)] - [(,_) (pregexp-match (summary-row source-file-rel 18 40 45 1) cov1)] - [,ss.html (path-combine (path-parent coverage1-file) (string-append source-file-rel ".html"))] + [(,_) (pregexp-match (summary-row src-file 18 40 45 1) cov1)] + [,ss.html (path-combine (path-parent coverage1-file) (string-append src-file ".html"))] [#t (file-regular? ss.html)] [,ss (utf8->string (read-file ss.html))] [(,_) (check-count 1 "1" ss)] ;; base case @@ -1519,8 +1520,8 @@ ([#t (file-regular? coverage1-file)] [,cov1 (utf8->string (read-file coverage1-file))] [(,_) (pregexp-match "Overall 70% coverage with 28 of 40 sites covered" cov1)] - [(,_) (pregexp-match (summary-row source-file-rel 28 40 70 6) cov1)] - [,ss.html (path-combine (path-parent coverage1-file) (string-append source-file-rel ".html"))] + [(,_) (pregexp-match (summary-row src-file 28 40 70 6) cov1)] + [,ss.html (path-combine (path-parent coverage1-file) (string-append src-file ".html"))] [#t (file-regular? ss.html)] [,ss (utf8->string (read-file ss.html))] [(,_) (check-count 1 "1" ss)] ;; base case @@ -1540,8 +1541,8 @@ ([#t (file-regular? coverage1-file)] [,cov1 (utf8->string (read-file coverage1-file))] [(,_) (pregexp-match "Overall 85% coverage with 34 of 40 sites covered" cov1)] - [(,_) (pregexp-match (summary-row source-file-rel 34 40 85 7) cov1)] - [,ss.html (path-combine (path-parent coverage1-file) (string-append source-file-rel ".html"))] + [(,_) (pregexp-match (summary-row src-file 34 40 85 7) cov1)] + [,ss.html (path-combine (path-parent coverage1-file) (string-append src-file ".html"))] [#t (file-regular? ss.html)] [,ss (utf8->string (read-file ss.html))] [(,_) (check-count 2 "1" ss)] ;; base case @@ -1575,8 +1576,8 @@ ([#t (file-regular? coverage-file)] [,cov (utf8->string (read-file coverage-file))] [(,_) (pregexp-match "Overall 85% coverage with 34 of 40 sites covered" cov)] - [(,_) (pregexp-match (summary-row source-file-rel 34 40 85 31) cov)] - [,ss.html (path-combine (path-parent coverage-file) (string-append source-file-rel ".html"))] + [(,_) (pregexp-match (summary-row src-file 34 40 85 31) cov)] + [,ss.html (path-combine (path-parent coverage-file) (string-append src-file ".html"))] [#t (file-regular? ss.html)] [,ss (utf8->string (read-file ss.html))] [(,_) (check-count (+ (* 2 2) 2) "1" ss)] ;; base case @@ -1597,8 +1598,8 @@ ([#t (file-regular? coverage-file)] [,cov (utf8->string (read-file coverage-file))] [(,_) (pregexp-match "Overall 85% coverage with 34 of 40 sites covered" cov)] - [(,_) (pregexp-match (summary-row source-file-rel 34 40 85 (+ 31 7)) cov)] - [,ss.html (path-combine (path-parent coverage-file) (string-append source-file-rel ".html"))] + [(,_) (pregexp-match (summary-row src-file 34 40 85 (+ 31 7)) cov)] + [,ss.html (path-combine (path-parent coverage-file) (string-append src-file ".html"))] [#t (file-regular? ss.html)] [,ss (utf8->string (read-file ss.html))] [(,_) (check-count (+ (* 2 2) (* 2 2)) "1" ss)] ;; base case