Unit test macro

Question

I have written a couple of macros (? and ??) for performing unit tests, but I'm having some difficulty with modifying it, so I was hoping to get some feedback on how to tidy up what I have written so far.

Yes, I know that unit test frameworks already exist, but I'm trying to learn by doing.

Here is an example of usage:

(??
  (? "Arithmetic tests"
    (? "Addition"
        (= (+ 1 2) 3)
        (= (+ 1 2 3) 6)
        (= (+ -1 -3) -4))))

And an example of output:

[Arithmetic tests]
  [Addition]
    (PASS) '(= (+ 1 2) 3)'
    (PASS) '(= (+ 1 2 3) 6)'
    (PASS) '(= (+ -1 -3) -4)'

Results: 3 tests passed, 0 tests failed

Now, the existing code works. Unfortunately, the (? ...) macro implementation is ugly, verbose, resistant to change - and I'm pretty sure also badly structured. For example, do I really have to use a list to store pieces of output code and then emit the contents at the end?

I'd like to modify the macro to permit description strings (or symbols) to optionally follow each test, whereupon it would replace the test literal in the output, thus:

(??
  (? "Arithmetic tests"
    (? "Addition"
        (= (+ 1 2) 3)    "Adding 1 and 2 results in 3"
        (= (+ 1 2 3) 6)
        (= (+ -1 -3) -4))))

Output:

[Arithmetic tests]
  [Addition]
    (PASS) Adding 1 and 2 results in 3
    (PASS) '(= (+ 1 2 3) 6)'
    (PASS) '(= (+ -1 -3) -4)'

But unfortunately I can't find a sensible place in the macro to insert this change. Depending on where I put it, I get errors like you're not inside a backquote expression, label is not defined or body-forms is not defined. I know what these errors mean, but I can't find a way to avoid them.

Also, I'll be wanting to handle exceptions thrown during the test, and treat that as a failure. Currently, there is no exception handling code - the test result is merely tested against nil. Again, it is not clear how I should add this functionality.

I'm thinking that maybe this macro is over-complex, due to my inexperience in writing macros; and perhaps if I simplify it, modification will be easier. I don't really want to separate it out into several smaller macros without good reason; but maybe there's a terser way to write it?

A complete code listing follows:

; Support functions and macros:
(defmacro with-gensyms ((&rest names) &body body)
    `(let ,(loop for n in names collect `(,n (gensym)))
         ,@body))

(defmacro while (condition &body body)
    `(loop while ,condition do (progn ,@body)))

(defun flatten (L)
  "Converts a list to single level."
  (if (null L)
    nil
    (if (atom (first L))
      (cons (first L) (flatten (rest L)))
      (append (flatten (first L)) (flatten (rest L))))))

(defun starts-with-p (str1 str2)
  "Determine whether `str1` starts with `str2`"
  (let ((p (search str2 str1)))
    (and p (= 0 p))))

(defmacro pop-first-char (string)
    `(with-gensyms (c)
        (if (> (length ,string) 0)
            (progn
                (setf c (schar ,string 0))
                (if (> (length ,string) 1)
                    (setf ,string (subseq ,string 1))
                    (setf ,string ""))))
    c))

(defmacro pop-chars (string count)
    `(with-gensyms (result)
        (setf result ())
        (dotimes (index ,count)
            (push (pop-first-char ,string) result))
        result))

(defun format-ansi-codes (text)
    (let ((result ()))
        (while (> (length text) 0)
            (cond
                ((starts-with-p text "\\e")
                    (push (code-char #o33) result)
                    (pop-chars text 2)
                )
                ((starts-with-p text "\\r")
                    (push (code-char 13) result)
                    (pop-chars text 2)
                )
                (t (push (pop-first-char text) result))
        ))
        (setf result (nreverse result))
        (coerce result 'string)))

(defun kv-lookup (values key)
    "Like getf, but works with 'keys as well as :keys, in both the list and the supplied key"
    (setf key (if (typep key 'cons) (nth 1 key) key))
    (while values
        (let ((k (pop values)) (v (pop values)))
            (setf k (if (typep k 'cons) (nth 1 k) k))
            (if (eql (symbol-name key) (symbol-name k))
                (return v)))))

(defun make-ansi-escape (ansi-name)
    (let ((ansi-codes '( :normal "\\e[00m" :white "\\e[1;37m" :light-grey "\\e[0;37m" :dark-grey "\\e[1;30m"
                                    :red "\\e[0;31m" :light-red "\\e[1;31m" :green "\\e[0;32m" :blue "\\e[1;34m" :dark-blue "\\e[1;34m"
                                    :cyan "\\e[1;36m" :magenta "\\e[1;35m" :yellow "\\e[0;33m"
                                    :bg-dark-grey "\\e[100m"
                                    :bold "\\e[1m" :underline "\\e[4m"
                                    :start-of-line "\\r" :clear-line "\\e[2K" :move-up "\\e[1A")))
    (format-ansi-codes (kv-lookup ansi-codes ansi-name))
    ))

(defun format-ansi-escaped-arg (out-stream arg)
    (cond
        ((typep arg 'symbol) (format out-stream "~a" (make-ansi-escape arg)))
        ((typep arg 'string) (format out-stream arg))
        (t (format out-stream "~a" arg))
    ))

(defun format-ansi-escaped (out-stream &rest args)
    (while args
        (let ((arg (pop args)))
            (if (typep arg 'list)
                (let ((first-arg (eval (first arg))))
                    (format out-stream first-arg (second arg))
                )
                (format-ansi-escaped-arg out-stream arg)
        ))
    ))

(defmacro while-pop ((var sequence &optional result-form) &rest forms)
    (with-gensyms (seq)
        `(let (,var)
            (progn
                (do () ((not ,sequence))
                    (setf ,var (pop ,sequence))
                    (progn ,@forms))
                ,result-form))))

(defun report-start (form)
    (format t "(    ) '~a'~%" form))

(defun report-result (result form)
        (format-ansi-escaped t "(" (if result :green :red) `("~:[FAIL~;PASS~]" ,result) :normal `(") '~a'~%" ,form))
        result)

; Macro relevant to the question
(defmacro ? (name &body body-forms)
    "Run any number of test forms, optionally nested within further (?) calls, and print the results of each test"
    (with-gensyms (result indent indent-string)
        (if (not body-forms)
            :empty
            (progn
                (setf result () indent 0 indent-string "  ")
                (cond
                    ((typep (first body-forms) 'integer)
                        (setf indent (pop body-forms))))
                `(progn
                    (format t "~v@{~A~:*~}" ,indent ,indent-string)
                    (format-ansi-escaped t "[" :white ,name :normal "]~%")
                    (with-gensyms (test-results)
                        (setf test-results ())
                        ,(while-pop (body-form body-forms `(progn ,@(nreverse result)))
                            (cond
                                ( (EQL (first body-form) '?)
                                    (push `(progn
                                        (setf test-results (append test-results (? ',(nth 1 body-form) ,(1+ indent) ,@(nthcdr 2 body-form))))
                                        (format t "~%")
                                        test-results
                                    ) result)
                                )
                                (t
                                    (push `(progn
                                        (format t "~v@{~A~:*~}" ,(1+ indent) ,indent-string)
                                        (report-start ',body-form)
                                        (with-gensyms (result label)
                                            (setf result ,body-form)
                                            (format-ansi-escaped t :move-up :start-of-line :clear-line)
                                            (format t "~v@{~A~:*~}" ,(1+ indent) ,indent-string)
                                            (push (report-result result ',body-form) test-results)
                                            test-results
                                    )) result))))))))))

(defun ?? (&rest results)
    "Run any number of tests, and print a summary afterward"
    (setf results (flatten results))
    (format-ansi-escaped t "~&" :white "Results: " :green `("~a test~:p passed" ,(count t results)) :normal ", "
        (if (find NIL results) :red :normal) `("~a test~:p failed" ,(count NIL results))
        :yellow `("~[~:;, ~:*~a test~:p not run~]" ,(count :skip results))
        :brown `("~[~:;, ~:*~a empty test group~:p skipped~]" ,(count :empty results))
        :normal "~%"))

How could I improve this so that I can make modifications easier?

Answer 1

I can't quite figure out which mode you're using for indentation, suffice to say that standard lisp-mode indents this a bit differently, but never mind that. The single-line parenthesis really shouldn't be there though, makes it look more ugly than necessary.

It's nice that the code is self-sufficient, though just in case that that's not clear: There are general-purpose helper libraries (for something like with-gensyms etc.) as well as for ANSI escape formatting available.

Btw. while the colour formatting might be nice, there should be a switch to turn it off and it would be even nicer if it could detect when it wasn't running in the shell, so that using e.g. SLIME i wouldn't have to see garbage on the screen.

In general, macro arguments shouldn't be evaluated multiple times! That is the case for all macros where you currently use one of the arguments more than once with , in the produced body. Reworking that to bind to a temporary variable first also ensures that passing in a literal will work. If you intent to modify a place, clearly indicate that in the documentation, the macro argument names and still only evaluate the initial value once. Otherwise you'll either end up having bugs or less then ideal performance due to repeated accessing of computation-heavy accessors and such.

Now I've also noticed that with-gensyms is used inside the produced body. That's almost certainly wrong. Consider the expansion of pop-first-char:

(let ((x "foo")) (pop-first-char x)))

=>

(LET ((X "foo"))
  (LET ((C (GENSYM)))
    (IF (> (LENGTH X) 0)
        (PROGN
         (SETQ C (SCHAR X 0))
         (IF (> (LENGTH X) 1)
             (SETQ X (SUBSEQ X 1))
             (SETQ X ""))))
    C))

gensym is called every time this form is evaluated, bound to c and then c is still assigned later and returned. It's not harmful in this case, because there's no forms passed into the macro that are spliced in below it. I'll explain below how this should be rewritten instead.

---

So, going definition by definition:

• starts-with-p is inefficient as you can just compare from the start and abort early if there's no match. The comparison can also be (eql 0 p) which will work in all circumstances.

• pop-first-char is, as explained, not quite so well written. with-gensyms isn't needed and it should fail if there's nothing in the string in the first place instead of returning a gensym symbol. Also, (if ... (progn)) is better written as (when ... ...) or using cond and schar should probably be char, aref or even elt as this pattern works for all sequences, not just strings. Consider this instead:

  (defmacro pop-first-char (place)
    (with-gensyms (s)
      `(let ((,s ,place))
         (prog1 (schar ,s 0)
           (setf ,place (subseq ,s 1))))))
  

  This will at least behave more consistently with respect to empty strings (error) and evaluates place only as often as necessary.

• pop-chars can also be written much more efficiently. The combination of pop-first-char, which will copy the rest of the string and the loop introduces unnecessary quadratic behaviour; it would be much better, say, to subseq the range you want, then coerce that to a list and assign the rest.
• format-ansi-codes looks okayish, but note that the operations aren't the most efficient (nreverse on the result, allocating in the right order is likely allocating less memory).
• kv-lookup uses eql on strings - that's not working, compare the spec. You want equal or string-equal on the strings. Then again, I'd consider this behaviour an unnecessary feature.
• format-ansi-escaped-arg could use typecase.
• In while-pop the seq isn't used (which SBCL tells you when loading the file. The progn isn't necessary and can be simplified away. IMO do is notoriously hard to understand, so I'd recommend not using it. The parameters are badly named as pop only works on lists. sequence (which should be list) should also be assigned to a temporary variable.

I'll stop here; you get the gist of it by following the first examples.

---

Now for your question, I dislike the optional docstring feature because it makes implementation more complicated since you'll always be checking if there's a literal string coming afterwards. Having a straightforward way to mark individual tests with a macro is completely obvious to the reader and the developer, so I'd rather go with that.

In case you really wanted to go ahead, either consider a pattern matching library, or don't do the whole while-pop thing and loop over the list with one token lookahead, i.e. (next-form possibly-a-string-here ...).

The other general recommendation is to decompose your functionality into functions. Then for one testing becomes a bit easier as you can just invoke the functions normally instead of having to macroexpand or whatever your editor does, but also it allows you to demarcate the different steps clearly by naming your functions (and documenting them of course).