(Arne Babenhauserheide)
2017-10-10: use properties for doctests use properties for doctests
diff --git a/examples/doctests.w b/examples/doctests.w
--- a/examples/doctests.w
+++ b/examples/doctests.w
@@ -10,6 +10,7 @@ define-module : examples doctests
import : ice-9 optargs
ice-9 rdelim
ice-9 match
+ ice-9 pretty-print
oop goops
texinfo reflection
@@ -37,19 +38,7 @@ define : string-index s fragment
loop (string-drop s 1) (+ i 1)
define : doctests-extract-from-string s
- . "Extract all test calls from a given string.
-
- This procedure provides an example test:"
- . #((tests
- (test 'mytest
- (define v (make-vector 5 99))
- (test-assert (vector? v))
- (test-eqv 99 (vector-ref v 2))
- (vector-set! v 2 7)
- (test-eqv 7 (vector-ref v 2)))
- (test 'mytest2
- (test-assert #t))))
- ;; thanks to Vítor De Araújo: https://lists.gnu.org/archive/html/guile-user/2017-08/msg00003.html
+ . "Extract all test calls from a given string."
let lp
: str s
tests : list
@@ -67,8 +56,25 @@ define : doctests-extract-from-string s
λ () : read
. tests
+define : subtract a b
+ . "Subtract B from A"
+ . #((tests ('positive (test-eqv 3 (subtract 5 2)))))
+ - a b
+
define : doctests-testmod mod
- . "Execute all doctests in the current module"
+ . "Execute all doctests in the current module
+
+ This procedure provides an example test:"
+ . #((tests
+ ('mytest
+ (define v (make-vector 5 99))
+ (test-assert (vector? v))
+ (test-eqv 99 (vector-ref v 2))
+ (vector-set! v 2 7)
+ (test-eqv 7 (vector-ref v 2)))
+ ('mytest2
+ (test-assert #t))))
+ ;; thanks to Vítor De Araújo: https://lists.gnu.org/archive/html/guile-user/2017-08/msg00003.html
let*
: names : module-map (λ (sym var) sym) mod
filename
@@ -84,21 +90,24 @@ define : doctests-testmod mod
: names names
docstrings docstrings
doctests doctests
+ ;; pretty-print doctests
+ ;; newline
when : not : null? docstrings
when doctests
let*
: name : car names
docstring : car docstrings
- doctest : car doctests
let loop-tests
- : doctests doctest
- when : and (list? doctests) : not : null? doctests
+ : doctest : car doctests
+ when : and (pair? doctest) (car doctest) : pair? : car doctest
+ ;; pretty-print : car doctest
+ ;; newline
let*
- : doctest : car doctests
+ :
testid
- if : not : list? doctest
+ if : not : pair? doctest
. #f
- string-join : list filename (symbol->string name) : symbol->string : primitive-eval : car : cdr doctest
+ string-join : list filename (symbol->string name) : symbol->string : primitive-eval : car : car doctest
. "--"
cleaned
if : not : list? doctest
@@ -108,13 +117,15 @@ define : doctests-testmod mod
cons '(import (srfi srfi-64))
cons
list 'test-begin testid
- cdr : cdr doctest
+ cdr : car doctest
list : list 'test-end testid
+ ;; pretty-print cleaned
+ ;; newline
when cleaned
let :
eval cleaned mod
newline
- loop-tests : cdr doctests
+ loop-tests : cdr doctest
loop (cdr names) (cdr docstrings) (cdr doctests)
define %this-module : current-module