(Arne Babenhauserheide)
2017-07-27: working doctests working doctests
diff --git a/examples/doctests.w b/examples/doctests.w --- a/examples/doctests.w +++ b/examples/doctests.w @@ -9,6 +9,7 @@ define-module : examples doctests import : ice-9 optargs ice-9 rdelim + ice-9 match oop goops texinfo reflection @@ -40,38 +41,75 @@ define : doctests-extract-from-string s This is an example test: - (test #:name mytest + (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)) " - let : : idx : string-index s "(test" - when idx - let : : sub : substring s idx - with-input-from-string sub - λ () : read + let lp + : str s + tests : list + if : string-null? str + reverse tests + let : : idx : string-index str "(test" + if : not idx + reverse tests + let : : sub : substring str idx + lp ; recurse with the rest of the string + with-input-from-string sub + λ () (read) (read-string) + cons + with-input-from-string sub + λ () : read + . tests define : doctests-testmod mod . "Execute all doctests in the current module" let* : names : module-map (λ (sym var) sym) mod + filename + if (module-filename mod) (module-filename mod) + string-join (cons "-" (map symbol->string (module-name mod))) "-" docstrings map (λ (x) (if (procedure? x) (procedure-documentation x))) map (λ (x) (module-ref mod x)) names - let loop : (names names) (docstrings docstrings) + let loop + : names names + docstrings docstrings when : not : null? docstrings when : string? : car docstrings let* : name : car names docstring : car docstrings - doctest : doctests-extract-from-string : car docstrings - write : list name doctest - newline - let : - primitive-eval doctest - newline + let loop-tests + : doctests : doctests-extract-from-string : car docstrings + when : and (list? doctests) : not : null? doctests + let* + : doctest : car doctests + testid + if : not : list? doctest + . #f + string-join : list filename (symbol->string name) : car : cdr doctest + . "--" + cleaned + if : not : list? doctest + . '#f + append + cons 'begin + cons '(import (srfi srfi-64)) + cons + list 'test-begin testid + cdr : cdr doctest + list : list 'test-end testid + when cleaned + let : + eval cleaned mod + newline + loop-tests : cdr doctests loop (cdr names) (cdr docstrings) define %this-module : current-module