Ignore:
Timestamp:
May 6, 2010, 7:56:41 PM (9 years ago)
Author:
gz
Message:

Store checksum with code coverage info, signal error if try to color a different file than stored; Also while in there, add a restart to coverage coloring to let you skip a file if there are any errors.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/qres/ccl/lib/nfcomp.lisp

    r13565 r13685  
    498498        (fcomp-compile-toplevel-forms env)
    499499        (let* ((fns (fcomp-code-covered-functions))
    500                (v (nreverse (coerce fns 'vector))))
     500               (v (nreverse (coerce fns 'vector)))
     501               (id (fcomp-file-checksum stream)))
    501502          (map nil #'fcomp-digest-code-notes v)
    502           (fcomp-random-toplevel-form `(register-code-covered-functions ',v) env)))
     503          (fcomp-random-toplevel-form `(register-code-covered-functions ',v
     504                                                                        ',*fcomp-external-format*
     505                                                                        ,id)
     506                                      env)))
    503507      (while (setq form *fasl-eof-forms*)
    504508        (setq *fasl-eof-forms* nil)
     
    507511        (fcomp-output-form $fasl-src env (namestring *compile-file-pathname*)))
    508512      (fcomp-compile-toplevel-forms env))))
     513
     514(defvar *crc32-table* (let ((crc-table (make-array 256 :element-type '(unsigned-byte 32))))
     515                        (loop for i from 0 below 255 as crc = i
     516                              do (loop for j from 0 below 8
     517                                       do (setq crc (ash crc -1))
     518                                       do (when (oddp crc)
     519                                            (setq crc (logxor crc  #xEDB88320))))
     520                              do (setf (aref crc-table i) crc))
     521                        crc-table))
     522(declaim (type (simple-array (unsigned-byte 32) (256)) *crc32-table*))
     523
     524(defun fcomp-stream-checksum (stream)
     525  ;; Could consider crc16 for 32-bit targets, but this is only used with code
     526  ;; coverage so don't worry about efficiency anyway.
     527  (file-position stream 0)
     528  (let ((crc 0))
     529    (declare (type (unsigned-byte 32) crc))
     530    (loop for char base-char = (read-char stream nil) while char
     531          do (setq crc (logxor
     532                         (%ilogand (ash crc -8) #x00FFFFFF)
     533                         (aref *crc32-table* (logand (logxor crc (char-code char)) #xFF)))))
     534    (logior (ash (file-position stream) 32) crc)))
     535
     536(defun fcomp-file-checksum (filename &key (external-format *fcomp-external-format*))
     537  (when (setq filename (probe-file filename))
     538    (with-open-file (stream filename
     539                            :element-type 'base-char
     540                            :external-format external-format)
     541      (fcomp-stream-checksum stream))))
    509542
    510543(defun fcomp-code-covered-functions ()
Note: See TracChangeset for help on using the changeset viewer.