Working on legacy code Part 2

Now that most of the low-hanging fuit has been picked from sb-cover, it is time to try to tackle some logic. The logic is at the start of the function ‘report’.

What it does extract sb-c::*code-coverage-info*. This is a hash table that uses pathnames to files as keys. The values stored is unknown at this time.

The logic that I want to tackle is the ‘maphash’ function. The function takes a function with two inputs (a key and value):

(maphash (lambda (k v)
               (declare (ignore v))
               (let* ((n (format nil "~(~{~2,'0X~}~)"
                                 (coerce (sb-md5:md5sum-string
                                          (sb-ext:native-namestring k))
                                         'list)))
                      (path (make-pathname :name n :type "html")))
                 (when (probe-file k)
                   (with-open-file (stream path
                                           :direction :output
                                           :if-exists :overwrite
                                           :if-does-not-exist :create)
                     (push (list* k n (report-file k stream external-format))
                           paths)))))
             *code-coverage-info*)

The first thing is I want to do is extract it into its own function. This is very dangerous, there are no unit tests.

(defun make-coverage-list (code-coverage-info external-format)
  (let ((paths))
    (maphash (lambda (key value)
               (declare (ignore value))
               (let ((n (create-unique-name key))
                     (path (create-unique-html-path key)))
                 (when (probe-file key)
                   (with-open-file (stream path
                                           :direction :output
                                           :if-exists :overwrite
                                           :if-does-not-exist :create)
                     (setf paths (push (list* key n (report-file key stream external-format)) paths))))))
             code-coverage-info)
    paths)

I’ve been doing Lisp for almost a year now and always forgetting things; Lisp passes-by-value. That is why I return paths.

This still is not where I want to be. I can’t get at the logic in this because I’m opening a file. When writing unit tests you try to remove as much external dependencies as possible. ‘with-open-file’ is a dependency on the file system. Need to extract method again:

(defun make-coverage-list (code-coverage-info external-format)
  (let ((coverage-data))
    (maphash (lambda (key value)
               (declare (ignore value))
               (let ((unique-name (create-unique-name key))
                     (path (create-unique-html-path key)))
                 (when (probe-file key)
                   (setf coverage-data (write-source-html path unique-name key external-format)))))
             code-coverage-info)
    coverage-data))

(defun write-source-html (path name source-path-name external-format)
  (let ((paths))
    (with-open-file (stream path
                            :direction :output
                            :if-exists :overwrite
                            :if-does-not-exist :create)
      (setf paths (push
                   (list* source-path-name name (report-file source-path-name stream external-format)) paths)))
    paths))

Still need some more changes:

(defun make-coverage-list (code-coverage-info external-format fn-truename-exist? fn-source-write)
  (let ((coverage-data))
    (maphash (lambda (key value)
               (declare (ignore value))
               (let ((unique-name (create-unique-name key))
                     (path (create-unique-html-path key)))
                 (when (funcall fn-truename-exist? key)
                   (setf coverage-data (push (funcall fn-source-write path unique-name key external-format) coverage-data)))))
             code-coverage-info)
    coverage-data))

(defun write-source-html (path name source-path-name external-format)
  (let ((paths))
    (with-open-file (stream path :direction :output :if-exists :overwrite :if-does-not-exist :create)
      (setf paths (push
                   (list* source-path-name name (report-file source-path-name stream external-format)) paths)))
    paths))

(defun create-unique-html-path (name-string)
  (make-pathname :name (create-unique-name name-string):type "html"))

(defun create-unique-name (name-string)
  (format nil "~(~{~2,'0X~}~)"
          (coerce (sb-md5:md5sum-string
                   (sb-ext:native-namestring name-string))
                  'list)))

Here is the unit test for testing ‘make-coverage-list’:

;;; Mocking functions
(let ((is-exist))
  (defun truename-exist? (key)
    (declare (ignore key))
    is-exist)
  (defun exist ()
    (setf is-exist t))
  (defun not-exist ()
    (setf is-exist nil))
  (defun source-writer (path name source-path-name external-format)
    (declare (ignore path external-format))
    (list* source-path-name name "source-code")))

(test-fixture make-coverage-list
    (:setup ((coverage-list '(("whatever-directory\\huh.lisp" "821ea77acb15d31a2ee610daddaa0c8e" . "source-code")))
             (source-file (first (first coverage-list)))))
  (:tests
    (should-make-coverage-list-exist
     (let ((cover-data (make-hash-table)))
       (setf (gethash source-file cover-data) (list "cover-data"))
       (exist)
       (assert-equal coverage-list (make-coverage-list cover-data :default #'truename-exist? #'source-writer))))

    (should-make-coverage-list-no-exist
     (declare (ignore coverage-list))
     (let ((cover-data (make-hash-table)))
       (setf (gethash source-file cover-data) (list "cover-data"))
       (not-exist)
       (assert-equal nil (make-coverage-list cover-data :default #'truename-exist? #'source-writer))
       ))
    ))

And the final client for using ‘make-coverage-list:

(defun report (directory &key ((:form-mode *source-path-mode*) :whole)
                         (external-format :default))
  (let ((paths)
        (*default-pathname-defaults* (pathname-as-directory directory)))
    (ensure-directories-exist *default-pathname-defaults*)
    (setf paths (make-coverage-list *code-coverage-info* external-format #'probe-file #'write-source-html))
    (let ((report-file-pathname (make-pathname :name "cover-index" :type "html")))
      (with-open-file (stream report-file-pathname
                              :direction :output :if-exists :overwrite
                              :if-does-not-exist :create)
        (write-styles stream)
        (unless paths
          (write-no-coverage-data stream)
          (close stream)
          (return-from report))
        (write-header stream)
        (setf paths (sort paths #'string< :key #'car))
        (loop for prev = nil then source-file
              for (source-file report-file-pathname expression branch) in paths
              for is-even? = nil then (not is-even?)
              do (when (or (null prev)
                           (not (equal (pathname-directory (pathname source-file))
                                       (pathname-directory (pathname prev)))))
                   (write-source-file-pathname stream source-file))
              do (write-coverage-data stream source-file is-even? report-file-pathname expression branch))
        (write-end-table stream))
      report-file-pathname)))

You’ll notice that I injected two functions into ‘make-coverage-list’. In the unit tests you can see that I’ve created stubs to emulate the functions.

Here is todays numbers:

	Expression			Branch
Source file	Covered	Total	%	Covered	Total	%
\_Holder\WorkSpace\gWeb\sb-cover-dev\src\
cover.lisp	308	1085	28.4	10	82	12.2
\_Holder\WorkSpace\gWeb\sb-cover-dev\unit-tests\
sb-cover-dev-tests.lisp	12	12	100.0	0	0	-

Yesterdays numbers:

	Expression			Branch
Source file	Covered	Total	%	Covered	Total	%
\_Holder\WorkSpace\gWeb\sb-cover-dev\src\
cover.lisp	201	1047	19.2	2	84	2.4

The numbers can be a bit misleading due to grabbing some low hanging fruit today.

Working on legacy code Part 1

The project I’m working on right now is sb-cover. I want to integrate it with lisp-unit-with-fixture.

For me, to understand code, it is best if I create coverage tests to ensure that when I change code, I don’t change the codes behavior.

Looking at the design of the application I noticed that the coverage data model and the view (HTML) is intermingled:

        (format stream "<table class='summary'>")
        (format stream "<tr class='head-row'><td></td><td class='main-head' colspan='3'>Expression</td><td class='main-head' colspan='3'>Branch</td></tr>")
        (format stream "<tr class='head-row'>~{<td width='80px'>~A</td>~}</tr>"
                (list "Source file"
                      "Covered" "Total" "%"
                      "Covered" "Total" "%")

So to start you grab the low-lying fruit and encapsulate it:

(defun write-header (stream)
  (format stream "<table class='summary'>")
  (format stream "<tr class='head-row'><td></td><td class='main-head' colspan='3'>Expression</td><td class='main-head' colspan='3'>Branch</td></tr>")
  (format stream "<tr class='head-row'>~{<td width='80px'>~A</td>~}</tr>"
          (list "Source file"
                "Covered" "Total" "%"
                "Covered" "Total" "%"))

The function ‘write-header’ outputs a string. Let’s pin this down with an unit test:

(test-fixture html-stream-writing
    (:setup
      ((header "<table class='summary'> ;....
  (:tests
    (should-write-html
     (assert-equal header (with-output-to-string (out)
                            (write-header out)))))

And that is how you start to get your code under control.

	Expression			Branch
Source file	Covered	Total	%	Covered	Total	%
\_Holder\WorkSpace\gWeb\sb-cover-dev\src\
cover.lisp	201	1047	19.2	2	84	2.4

Update to test-fixture

An update to test-fixtures was required to handle setup code. Specifically, LET* and variable loading from LET*:

(create-tests :setup-let-and-variable-load
 (:setup  ((true t) (not-false nil))
   (setf not-false true))

 (:tests
   (test-bind-form2 (assert-true not-false))
   (test-bind-form3 (assert-true not-false))))

(create-tests :setup-let-and-use-variables
 (:setup ((lister (make-list 0))
          (lister-with-push (push 'hello lister)))