(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