Changeset 8661


Ignore:
Timestamp:
Mar 5, 2008, 3:49:32 AM (12 years ago)
Author:
gz
Message:

Guard against CL-PPCRE's tricks with load-time-values of closures

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/library/cover.lisp

    r8658 r8661  
    100100        do (destructuring-bind (file . toplevel-functions) data
    101101             (push (list* file
    102                           (loop for fn across toplevel-functions
    103                                 nconc (get-function-coverage fn nil))
     102                          ;; Duplicates are possible if you have multiple instances of
     103                          ;; (load-time-value (foo)) where (foo) returns an lfun.
     104                          ;; CL-PPCRE does that.
     105                          (delete-duplicates
     106                           (loop for fn across toplevel-functions
     107                                nconc (get-function-coverage fn nil)))
    104108                          toplevel-functions)
    105109                   *file-coverage*))))
     
    110114  (labels ((show (note indent label)
    111115             (dotimes (i indent) (write-char #\space))
    112              (format t "~a ~a~%" label note)
     116             (format t "~a ~a" label note)
    113117             (unless (emitted-code-note-p note)
    114118               (format t " [Not Emitted]"))
    115119             (when (entry-code-note-p note)
    116120               (format t " (Entry to ~s)" (entry-code-note-p note)))
     121             (format t "~%")
    117122             (when (code-note-p note)
    118123               (loop with subindent = (+ indent 3)
     
    395400  (update-text-styles note styles))
    396401
    397 
     402(defun function-source-form-note (fn)
     403  (loop for n = (function-entry-code-note fn) then (code-note-parent-note n)
     404        do (when (null n) (return nil))
     405        do (when (source-note-p n)
     406             (loop for s = (code-note-source n) while (source-note-p s)
     407                   do (setq n s))
     408             (return n))))
     409
     410 
    398411(defun colorize-function (fn styles &optional refs)
    399   ;; Colorize the body of the function
    400   (let ((note (function-entry-code-note fn)))
     412  (let* ((note (function-entry-code-note fn))
     413         (source (function-source-form-note fn))
     414         (refs (cons fn refs)))
     415    (declare (dynamic-extent refs))
     416    ;; Colorize the body of the function
    401417    (when note
    402       (colorize-source-note note styles)))
    403   ;; And now any subfunction references
    404   (let ((refs (cons fn refs)))
    405     (declare (dynamic-extent refs))
     418      (colorize-source-note note styles))
     419    ;; And now any subfunction references
    406420    (lfunloop for imm in fn
    407               when (and (functionp imm) (not (memq imm refs)))
     421              when (and (functionp imm)
     422                        (not (memq imm refs))
     423                        ;; Make sure this fn is in the source we're currently looking at.
     424                        ;; It might not be, if it is referenced via (load-time-value (foo))
     425                        ;; where (foo) returns an lfun from some different source entirely.
     426                        ;; CL-PPCRE does that.
     427                        (or (null source)
     428                            (eq source (function-source-form-note imm))
     429                            #+debug (progn
     430                                      (warn "Ignoring ref to ~s from ~s" imm fn)
     431                                      nil)))
    408432              do (colorize-function imm styles refs))))
    409433
Note: See TracChangeset for help on using the changeset viewer.