X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fcoverage.scm;h=3c210555ae102bc2f67621e87610d8fa27441818;hb=b7a28319d55b8264de7fe0f2655377c5881fb5fb;hp=aefef132f99cdf43fe8cba742d2b28c1d113c5c1;hpb=3cc66e28a7194cf2bed29c9c85f9b6bd5dbc0fa4;p=lilypond.git

diff --git a/scm/coverage.scm b/scm/coverage.scm
index aefef132f9..3c210555ae 100644
--- a/scm/coverage.scm
+++ b/scm/coverage.scm
@@ -1,30 +1,31 @@
+;;;; coverage.scm
+
 (define-module (scm coverage))
 
 (use-modules (lily)
 	     (ice-9 rdelim)
 	     (ice-9 regex)
-	     (ice-9 format))
+	     (ice-9 format) ;; needed for ~8@ 
+	     )
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define-public (coverage:show-all filter?)
-  
+  (let*
+      ((keys
+	(filter filter?
+		(sort (map car (hash-table->alist coverage-table)) string<? ))))
+    
   (newline)
-  (hash-fold
-   (lambda (key val acc)
-     (if (filter? key)
-	 (begin
-	   (format #t
-		 "
-Coverage for file: ~a
-"
-		 key)
-	 (display-coverage key val
-			   (format #f "~a.cov" (basename key))
-			   )))
-     #t)
-   #t
-   coverage-table))
+  (for-each
+   (lambda (k)
+
+     (format #t "Coverage for file: ~a\n" k)
+     (display-coverage
+      k (hash-ref coverage-table k)
+      (format #f "~a.cov" (basename k))))
+   keys)))
+
 
 (define-public (coverage:enable)
   (trap-set! memoize-symbol-handler record-coverage)
@@ -74,7 +75,7 @@ Coverage for file: ~a
   (let*
       ((name (source-property exp 'filename))
        (line (source-property exp 'line))
-       (vec (and name (hashv-ref coverage-table name #f)))
+       (vec (and name (hash-ref coverage-table name #f)))
        (veclen (and vec (vector-length vec)))
        (veccopy (lambda (src dst)
 		  (vector-move-left! src 0 (vector-length src)
@@ -84,7 +85,7 @@ Coverage for file: ~a
 	(begin
 	  (if (or (not vec) (>= line (vector-length vec)))
 	      (set! vec
-		    (hashv-set! coverage-table name
+		    (hash-set! coverage-table name
 				(if vec
 				    (veccopy vec (make-vector (1+ line) #f))
 				    (make-vector (1+ line) #f)))))