Ignore:
Timestamp:
Aug 11, 2010, 6:01:21 PM (9 years ago)
Author:
gz
Message:

Last acode coverage bug (knock wood): defuns inside flet

File:
1 edited

Legend:

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

    r14165 r14172  
    740740  (assert *nx-current-code-note*)
    741741  (let ((form->note (make-hash-table :test #'eq)))
    742     (labels ((hook (acode form &aux (note (acode-note acode)))
     742    (labels ((decomp-hook (acode form &aux (note (acode-note acode)))
    743743               ;; For expressions within without-compiling-code-coverage, there is a source
    744744               ;; note and not a code note, so need to check for code note explicitly.
     
    747747                 (dbg-assert (null (code-note-acode-range note)))
    748748                 (setf (gethash form form->note) note)))
     749             (print-hook (form open-p pos)
     750               (let* ((note (gethash form form->note))
     751                      (range (and note (code-note-acode-range note))))
     752                 (when note
     753                   (cond (open-p
     754                          (dbg-assert (null range))
     755                          (setf (code-note-acode-range note)
     756                                (encode-file-range pos pos)))
     757                         (t
     758                          (dbg-assert (not (null range)))
     759                          (multiple-value-bind (start end)
     760                              (decode-file-range range)
     761                            (declare (ignorable end))
     762                            (dbg-assert (eq start end))
     763                            (setf (code-note-acode-range note)
     764                                  (encode-file-range start pos))))))))
    749765             (stringify (acode)
    750                (let* ((*nx-acode-inner-refs* nil)
    751                       (*nx-acode-refs-counter* 0)
    752                       (form (decomp-acode acode :prettify t :hook #'hook))
     766               (let* ((*nx-acode-refs-counter* 0)
     767                      (form (decomp-acode acode :prettify t :hook #'decomp-hook))
    753768                      (package *package*))
    754769                 (with-standard-io-syntax
     
    758773                              (*print-case* :downcase)
    759774                              (*print-readably* nil))
    760                          (pprint-recording-positions
    761                           form *nx-pprint-stream*
    762                           (lambda (form open-p pos)
    763                             (let* ((note (gethash form form->note))
    764                                    (range (and note (code-note-acode-range note))))
    765                               (when note
    766                                 (cond (open-p
    767                                        (dbg-assert (null range))
    768                                        (setf (code-note-acode-range note)
    769                                              (encode-file-range pos pos)))
    770                                       (t
    771                                        (dbg-assert (not (null range)))
    772                                        (multiple-value-bind (start end)
    773                                            (decode-file-range range)
    774                                          (declare (ignorable end))
    775                                          (dbg-assert (eq start end))
    776                                          (setf (code-note-acode-range note)
    777                                                (encode-file-range start pos))))))))))))))
    778              (record (afunc &aux (string (stringify (afunc-acode afunc))))
    779                (iterate store ((afunc afunc))
     775                         (pprint-recording-positions form *nx-pprint-stream* #'print-hook))))))
     776             (record (afunc)
     777               (let* ((*nx-acode-inner-refs* nil);; filled in by stringify.
     778                      (string (stringify (afunc-acode afunc))))
    780779                 (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)))))
     780                 (loop for ref in *nx-acode-inner-refs* as fn = (acode-afunc-ref-afunc ref)
     781                       do (dbg-assert (null (getf (afunc-lfun-info fn) '%function-acode-string)))
     782                       do (setf (getf (afunc-lfun-info fn) '%function-acode-string) string)))))
    784783      (if (getf (afunc-lfun-info afunc) '%function-source-note)
    785784        (record afunc)
Note: See TracChangeset for help on using the changeset viewer.