Ignore:
Timestamp:
Aug 10, 2010, 8:16:19 PM (9 years ago)
Author:
gz
Message:

arrange so don't output coverage acode for compiler-generated toplevel forms

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/qres/ccl/compiler/nx-basic.lisp

    r14085 r14164  
    739739(defun nx-record-code-coverage-acode (afunc)
    740740  (assert *nx-current-code-note*)
    741   (let* ((form->note (make-hash-table :test #'eq))
    742          (*nx-acode-inner-refs* nil)
    743          (*nx-acode-refs-counter* 0)
    744          (form (decomp-acode (afunc-acode afunc)
    745                              :prettify t
    746                              :hook (lambda (acode form &aux (note (acode-note acode)))
    747                                      ;; For expressions within without-compiling-code-coverage, there is a source
    748                                      ;; note and not a code note, so need to check for code note explicitly.
    749                                      (when (code-note-p note)
    750                                        (dbg-assert (null (gethash form form->note)))
    751                                        (dbg-assert (null (code-note-acode-range note)))
    752                                        (setf (gethash form form->note) note)))))
    753          (package *package*)
    754          (string (with-standard-io-syntax
     741  (let ((form->note (make-hash-table :test #'eq)))
     742    (labels ((hook (acode form &aux (note (acode-note acode)))
     743               ;; For expressions within without-compiling-code-coverage, there is a source
     744               ;; note and not a code note, so need to check for code note explicitly.
     745               (when (code-note-p note)
     746                 (dbg-assert (null (gethash form form->note)))
     747                 (dbg-assert (null (code-note-acode-range note)))
     748                 (setf (gethash form form->note) note)))
     749             (stringify (acode)
     750               (let* ((*nx-acode-inner-refs* nil)
     751                      (*nx-acode-refs-counter* 0)
     752                      (form (decomp-acode acode :prettify t :hook #'hook))
     753                      (package *package*))
     754                 (with-standard-io-syntax
    755755                     (with-output-to-string (*nx-pprint-stream*)
    756756                       (let* ((*package* package)
     
    769769                                             (encode-file-range pos pos)))
    770770                                      (t
    771                                        (dbg-assert (not (null range)))
     771                                       (dbg-assert (not (null range)))
    772772                                       (multiple-value-bind (start end)
    773                                                             (decode-file-range range)
     773                                           (decode-file-range range)
    774774                                         (declare (ignorable end))
    775775                                         (dbg-assert (eq start end))
    776776                                         (setf (code-note-acode-range note)
    777777                                               (encode-file-range start pos))))))))))))))
    778     (iterate store ((afunc afunc))
    779       (setf (getf (afunc-lfun-info afunc) '%function-acode-string) string)
    780       (loop for inner in (afunc-inner-functions afunc)
    781         unless (getf (afunc-lfun-info inner) '%function-acode-string)
    782         do (store inner)))
    783     afunc))
     778             (record (afunc &aux (string (stringify (afunc-acode afunc))))
     779               (iterate store ((afunc afunc))
     780                 (setf (getf (afunc-lfun-info afunc) '%function-acode-string) string)
     781                 (loop for inner in (afunc-inner-functions afunc)
     782                       unless (getf (afunc-lfun-info inner) '%function-acode-string)
     783                         do (store inner)))))
     784      (if (getf (afunc-lfun-info afunc) '%function-source-note)
     785        (record afunc)
     786        ;; If don't have a function source note while recording code coverage, it's
     787        ;; probably a toplevel function consed up by the file compiler.  Don't store it,
     788        ;; as it just confuses things
     789        (loop for inner in (afunc-inner-functions afunc) do (record inner)))))
     790  afunc)
    784791
    785792(defmethod print-object ((ref acode-afunc-ref) stream)
Note: See TracChangeset for help on using the changeset viewer.