[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH] experimental lookupcar based coverage testing.
From: |
Han-Wen Nienhuys |
Subject: |
Re: [PATCH] experimental lookupcar based coverage testing. |
Date: |
Fri, 19 Jan 2007 21:14:17 +0100 |
User-agent: |
Thunderbird 1.5.0.9 (X11/20061219) |
Ludovic Courtès escreveu:
>> Of course, the patch that I posted is ad-hoc, because it hardcodes the
>> coverage analysis in eval.c. If it were to be included, I propose
>> something like
>>
>> (trap-set! 'memoize-symbol
>> record-coverage)
>> (trap-enable 'memoize-symbol)
>>
>> which would be possible with a generic, and quite minimal extension to
>> eval.
>
> Indeed, this looks less specific and more flexible. I'd personally
> prefer this approach.
This is now in CVS, along with a couple of other changes.
The following code demonstrates the use of this interface.
***
(define coverage-table (make-hash-table 57))
(use-modules (ice-9 rdelim)
(ice-9 format))
(define (read-lines port)
(string-split (read-delimited "" port) #\newline))
(define (display-coverage file vec)
(let*
((lines (read-lines (open-file file "r"))))
(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))))))
(define (show-coverage)
(newline)
(hash-fold
(lambda (key val acc)
(display-coverage key val)
#t)
#t
coverage-table))
(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)))
(veclen (and vec (vector-length vec)))
(veccopy (lambda (src dst)
(vector-move-left! src 0 (vector-length src)
dst 0)
dst)))
(if (and line name)
(begin
(if (or (not vec) (>= line (vector-length vec)))
(set! vec
(hashv-set! coverage-table name
(if vec
(veccopy vec (make-vector (1+ line) #f))
(make-vector (1+ line) #f)))))
(display (vector-length vec))
(vector-set! vec line #t))
)))
(trap-set! memoize-symbol-handler record-coverage)
(trap-enable 'memoize-symbol)
***
--
Han-Wen Nienhuys - address@hidden - http://www.xs4all.nl/~hanwen