我是lisp的新手，并且一直试图通过潜入并编写一些代码来学习Common Lisp。我已经阅读了很多关于这个主题的文档，但它需要一段时间才能真正沉入其中。
我已经编写了几个用于执行单元测试的宏（?和??），但我遇到了一些困难。代码在帖子的末尾，以避免混淆实际问题。
以下是一个使用示例：
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3)
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
输出的一个例子：
[Arithmetic tests]
[Addition]
(PASS) '(= (+ 1 2) 3)'
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
Results: 3 tests passed, 0 tests failed
现在，现有代码可以运行。不幸的是，(? ...)宏是丑陋的，冗长的，无法改变的 - 我很确定结构也很糟糕。例如，我是否真的必须使用列表来存储输出代码片段，然后在最后发出内容？
我想修改宏以允许描述字符串（或符号）可选地跟随每个测试，因此它将替换输出中的测试文字，因此：
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) -4))))
输出：
[Arithmetic tests]
[Addition]
(PASS) Adding 1 and 2 results in 3
(PASS) '(= (+ 1 2 3) 6)'
(PASS) '(= (+ -1 -3) -4)'
但遗憾的是，我无法在宏中找到合理的位置来插入此更改。根据我放置的位置，我会收到you're not inside a backquote expression，label is not defined或body-forms is not defined等错误。我知道这些错误意味着什么，但我找不到避免它们的方法。
另外，我想要在测试中处理异常，并将其视为失败。目前，没有异常处理代码 - 测试结果仅针对nil进行测试。同样，我不清楚应该如何添加此功能。
我在想，由于我在编写宏方面经验不足，这个宏可能过于复杂;也许如果我简化它，修改会更容易。我真的不想把它分成几个较小的宏而没有充分的理由;但也许有一种更简洁的方式来写它？
有人可以帮助我吗？
完整的代码清单如下：
(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)
(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 "~%"))
答案 0 :(得分：1)
就我而言，?宏是技术性的，很难遵循格式化功能背后的逻辑。因此，我不想跟踪错误，而是建议我自己尝试，也许它会有用。
我认为实际上你的??不想评估任何事情，而是将其身体视为单独的测试或部分。如果正文包含以?开头的列表，则此列表代表一个部分;其他元素是测试形式，可选地后跟描述。因此，在我的实现中，??将是一个宏，?将只是一个符号。
我从一厢情愿的想法开始。我想我可以使用函数make-test-item创建单独的测试，并使用函数make-test-section测试部分（它们的实现现在不重要），我可以使用辅助函数display-test来显示它们。使用函数results计算结果，该函数返回两个值：测试总数和传递的数量。然后我想要代码
(??
(? "Arithmetic tests"
(? "Addition"
(= (+ 1 2) 3) "Adding 1 and 2 results in 3"
(= (+ 1 2 3) 6)
(= (+ -1 -3) 4))
(? "Subtraction"
(= (- 1 2) 1)))
(= (sin 0) 0) "Sine of 0 equals 0")
扩展为类似
的内容(let ((tests (list (make-test-section :header "Arithmetic tests"
:items (list (make-test-section :header "Addition"
:items (list (make-test-item :form '(= (+ 1 2) 3)
:description "Adding 1 and 2 results in 3"
:passp (= (+ 1 2) 3))
(make-test-item :form '(= (+ 1 2 3) 6)
:passp (= (+ 1 2 3) 6))
(make-test-item :form '(= (+ -1 -3) 4)
:passp (= (+ -1 -3) 4))))
(make-test-section :header "Subtraction"
:items (list (make-test-item :form '(= (- 1 2) 1)
:passp (= (- 1 2) 1))))))
(make-test-item :form '(= (sin 0) 0)
:passp (= (sin 0) 0)
:description "Sine of 0 equals 0"))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t)))
这里创建了一个测试列表;然后我们遍历它打印每个测试（0表示缩进的零级，t与format中一样）并跟踪结果，最后显示总结果。我不认为这里需要明确的eval。
它可能不是有史以来最精美的代码，但似乎可以管理。我在下面提供了缺少的定义，它们相当简单（并且可以改进）并且与宏无关。
现在我们转到宏。将两段代码视为数据，然后我们需要一个列表处理函数，它将第一个转换为第二个。一些辅助功能会派上用场。
主要任务是解析??的正文并生成测试列表以进入let。
(defun test-item-form (form description)
`(make-test-item :form ',form :description ,description :passp ,form))
(defun test-section-form (header items)
`(make-test-section :header ,header :items (list ,@items)))
(defun parse-test (forms)
(let (new-forms)
(loop
(when (null forms)
(return (nreverse new-forms)))
(let ((f (pop forms)))
(cond ((and (listp f) (eq (first f) '?))
(push (test-section-form (second f) (parse-test (nthcdr 2 f))) new-forms))
((stringp (first forms))
(push (test-item-form f (pop forms)) new-forms))
(t (push (test-item-form f nil) new-forms)))))))
这里parse-test基本上吸收了??的语法。每次迭代都会使用一个或两个表单并收集相应的make-...表单。这些函数可以在REPL中轻松测试（当然，我在编写时测试过它们）。
现在宏变得非常简单：
(defmacro ?? (&body body)
`(let ((tests (list ,@(parse-test body))))
(loop for test in tests
with total = 0
with passed = 0
do (display-test test 0 t)
do (multiple-value-bind (ttl p) (results test)
(incf total ttl)
(incf passed p))
finally (display-result total passed t))))
它在变量名称空间和函数1中捕获一些符号（扩展可能包含make-test-item和make-test-section）。使用gensyms的干净解决方案很麻烦，因此我建议只将所有定义移到单独的包中，并仅导出??和?。
为了完整性，这里是测试API的实现。实际上，这是我开始编码并继续进行，直到我确定大let - 形式有效;然后我转到了宏观部分。这种实施相当草率;特别是，它不支持终端颜色，display-test甚至无法将一个部分输出到字符串中。
(defstruct test-item form description passp)
(defstruct test-section header items)
(defun results (test)
(etypecase test
(test-item (if (test-item-passp test)
(values 1 1)
(values 1 0)))
(test-section (let ((items-count 0)
(passed-count 0))
(dolist (i (test-section-items test) (values items-count passed-count))
(multiple-value-bind (i p) (results i)
(incf items-count i)
(incf passed-count p)))))))
(defparameter *test-indent* 2)
(defun display-test-item (i level stream)
(format stream "~V,0T~:[(FAIL)~;(PASS)~] ~:['~S'~;~:*~A~]~%"
(* level *test-indent*)
(test-item-passp i)
(test-item-description i)
(test-item-form i)))
(defun display-test-section-header (s level stream)
(format stream "~V,0T[~A]~%"
(* level *test-indent*)
(test-section-header s)))
(defun display-test (test level stream)
(etypecase test
(test-item (display-test-item test level stream))
(test-section
(display-test-section-header test level stream)
(dolist (i (test-section-items test))
(display-test i (1+ level) stream)))))
(defun display-result (total passed stream)
(format stream "Results: ~D test~:P passed, ~D test~:P failed.~%" passed (- total passed)))
所有代码均在WTFPL下获得许可。