X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fcoverage.scm;h=e7392bb6837b8e5fe459d0001d3a29d2229299e3;hb=cb47f0d75cc88e34d5cb06fcfbf4104ce0780c90;hp=0b799599e160a78524475c2f37af8fd609368e36;hpb=dee82b1d0bcaf37a6a771417fe8f400a4b962131;p=lilypond.git

diff --git a/scm/coverage.scm b/scm/coverage.scm
index 0b799599e1..e7392bb683 100644
--- a/scm/coverage.scm
+++ b/scm/coverage.scm
@@ -2,31 +2,35 @@
 
 (use-modules (lily)
 	     (ice-9 rdelim)
-	     (ice-9 format))
+	     (ice-9 regex)
+	     (ice-9 format) ;; needed for ~8@ 
+	     )
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define-public (coverage:show-all)
+(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 (string-contains key "lilypond")
-	 (begin
-	   (format #t
-		 "
-Coverage for file: ~a
-"
-		 key)
-	 (display-coverage key val)))
-     #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)
   (trap-enable 'memoize-symbol)
   (trap-enable 'traps))
 
+     
 (define-public (coverage:disable)
   (trap-set! memoize-symbol-handler #f)
   (trap-disable 'memoize-symbol))
@@ -38,25 +42,38 @@ Coverage for file: ~a
 (define (read-lines port)
   (string-split (read-delimited "" port) #\newline))
 
-(define (display-coverage file vec)
+(define (display-coverage file vec out-file)
   (let*
-      ((lines (read-lines (open-file file "r"))))
+      ((lines (read-lines (open-file file "r")))
+       (format-str "~8@a: ~5@a:~a\n")
+       (out (if out-file (open-output-file out-file)
+		(current-output-port))))
 
+    (format out format-str "-" 0 (format #f "Source:~a" file))
     (do
 	((i 0 (1+ i))
 	 (l lines (cdr l)))
-	((or (null? l) (>= i (vector-length vec))))
-
-      (display (format #f "~8a: ~a\n"
-		       (if (vector-ref vec i)
-			   "#t"
-			   "") (car l))))))
+	((or (null? l) ))
+
+      (format out format-str
+		       (cond
+			((and (< i (vector-length vec)) (vector-ref vec i)) "1")
+			((and (string-contains file ".ly") (string-match "^[ \t]*%.*$" (car l)))
+			 "-")
+			((string-match  "^[ \t]*[()'`,]*$" (car l))
+			 "-")
+			((string-match  "^[ \t]*;.*$" (car l))
+
+			 "-")
+			(else "0"))
+		       (1+ i)
+		       (car l)))))
 
 (define (record-coverage key cont exp env)
   (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)
@@ -66,7 +83,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)))))