Re: [PATCH] experimental lookupcar based coverage testing.

[Han-Wen Nienhuys]

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