;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (coverage:show-all filter?)
(let*
((keys
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (coverage:show-all filter?)
(let*
((keys
- (format #t "Coverage for file: ~a\n" k)
- (display-coverage
- k (hash-ref coverage-table k)
- (format #f "~a.cov" (basename k))))
- keys)))
+ (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:disable)
(trap-set! memoize-symbol-handler #f)
(trap-disable 'memoize-symbol))
(define-public (coverage:disable)
(trap-set! memoize-symbol-handler #f)
(trap-disable 'memoize-symbol))
((lines (read-lines (open-file file "r")))
(format-str "~8@a: ~5@a:~a\n")
(out (if out-file (open-output-file out-file)
((lines (read-lines (open-file file "r")))
(format-str "~8@a: ~5@a:~a\n")
(out (if out-file (open-output-file out-file)
- (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)))))
+ (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)))))
(vec (and name (hash-ref coverage-table name #f)))
(veclen (and vec (vector-length vec)))
(veccopy (lambda (src dst)
(vec (and name (hash-ref coverage-table name #f)))
(veclen (and vec (vector-length vec)))
(veccopy (lambda (src dst)
- (begin
- (if (or (not vec) (>= line (vector-length vec)))
- (set! vec
- (hash-set! coverage-table name
- (if vec
- (veccopy vec (make-vector (1+ line) #f))
- (make-vector (1+ line) #f)))))
-
- (vector-set! vec line #t))
- )))
-
-
-
-
-
+ (begin
+ (if (or (not vec) (>= line (vector-length vec)))
+ (set! vec
+ (hash-set! coverage-table name
+ (if vec
+ (veccopy vec (make-vector (1+ line) #f))
+ (make-vector (1+ line) #f)))))
+
+ (vector-set! vec line #t))
+ )))