diff --git a/src/swish/profile.ss b/src/swish/profile.ss index f5198d24..bcbee5ae 100644 --- a/src/swish/profile.ss +++ b/src/swish/profile.ss @@ -345,15 +345,40 @@ inputs)) (let-values ([(keys vals) (hashtable-entries table)]) (vector->list - (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