(Arne Babenhauserheide)
2017-10-08: doctests: use procedure properties instead of stringly tests doctests: use procedure properties instead of stringly tests
diff --git a/examples/doctests.w b/examples/doctests.w --- a/examples/doctests.w +++ b/examples/doctests.w @@ -39,17 +39,17 @@ define : string-index s fragment define : doctests-extract-from-string s . "Extract all test calls from a given string. - This is an example test: - - (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)) -" + 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 let lp : str s tests : list @@ -77,16 +77,21 @@ define : doctests-testmod mod docstrings map (λ (x) (if (procedure? x) (procedure-documentation x))) map (λ (x) (module-ref mod x)) names + doctests + map (λ (x) (if (procedure? x) (procedure-property x 'tests))) + map (λ (x) (module-ref mod x)) names let loop : names names docstrings docstrings + doctests doctests when : not : null? docstrings - when : string? : car docstrings + when doctests let* : name : car names docstring : car docstrings + doctest : car doctests let loop-tests - : doctests : doctests-extract-from-string : car docstrings + : doctests doctest when : and (list? doctests) : not : null? doctests let* : doctest : car doctests @@ -110,7 +115,7 @@ define : doctests-testmod mod eval cleaned mod newline loop-tests : cdr doctests - loop (cdr names) (cdr docstrings) + loop (cdr names) (cdr docstrings) (cdr doctests) define %this-module : current-module define : main args