[PATCH] Add (ice-9 doctests)

"Dr. Arne Babenhauserheide" <[email protected]> Sun, 12 Jan 2025 12:30:10 +0100

Newsgroups	gmane.lisp.guile.devel
Message-ID	<[email protected]>

Hi,

The attached patch adds the module (ice-9 doctests) along with tests
(integrated into the test-suite) and texinfo documentation.

This provides doctests in the convenient style known from Python or
Haskell or jsdoc-tests or rustdoc tests - but without parsing strings,
so it does not inherit many of the problems in most other doctests.

A minimal looks like this:

    (define (tested-minimal)
      #((tests (test-equal #f (tested-with-doc))))
      #f)

This reduces the barrier to adopting test-driven-development, especially
for small procedures.

(ice-9 doctests) uses standard srfi-64 tests in the background, and it
does not aim to be a full replacement of all tests, but to reduce the
overhead for unit tests and to keep them close to the implementation.

Best wishes,
Arne



"Dr. Arne Babenhauserheide" <[email protected]> writes:

> Hi,
>
> I now went ahead and created a repository for guile-doctest. It uses
> (ice-9 doctests) in the hope that it can get merged into guile in the
> not too distant future:
>
> https://hg.sr.ht/~arnebab/guile-doctests/browse
>
> Currently it still needs proper texinfo docs. Aside from that it’s
> complete, as far as I can tell.
>
> Best wishes,
> Arne
>
> "Dr. Arne Babenhauserheide" <[email protected]> writes:
>
>> Hi,
>>
>> did this question drown in other messages? Should this go
>>
>> - to guile-lib
>> - to guile
>> - elsewhere?
>>
>> My preference would be guile, because then it would be available for
>> everyone learning Guile Scheme and I could more easily use it in
>> tutorials
>>
>> Best wishes,
>> Arne.
>>
>> "Dr. Arne Babenhauserheide" <[email protected]> writes:
>>
>>> Hi,
>>>
>>> I’ve been using my doctests implementation for years now, and it works
>>> beautifully for me, so I would like to contribute it — either to
>>> guile-lib as (tests doctest) or to guile (maybe (ice-9 doctest)?).
>>>
>>> Working code is here:
>>> https://hg.sr.ht/~arnebab/wisp/browse/examples/doctests.scm?rev=tip
>>>
>>>
>>> Example usage:
>>> ;; https://hg.sr.ht/~arnebab/wisp/browse/examples/doctests-test.scm?rev=tip
>>> (define-module (examples doctests-test))
>>>
>>> (import (examples doctests))
>>>
>>> (define (foo)
>>>     #((tests
>>>       ('foo
>>>         (test-equal "bar" (foo)))))
>>>     "bar")
>>>
>>> (define %this-module (current-module))
>>> (define (main args)
>>>        " Testing doctests"
>>>        #((tests ('mytest
>>>               (test-assert #t)
>>>               (test-assert #f))))
>>>        (doctests-testmod %this-module))
>>>
>>>
>>> How should I go forward to contribute it (and should I)?
>>>
>>>
>>> Best wishes,
>>> Arne

-- 
Unpolitisch sein
heißt politisch sein,
ohne es zu merken.
draketo.de

0001-Add-new-module-ice-9-doctests.patch (text/x-patch, 14.6 KB)

From 670c9df1ec1dd07d06c2041afb98c19d94915fe8 Mon Sep 17 00:00:00 2001
From: Arne Babenhauserheide <[email protected]>
Date: Sun, 12 Jan 2025 12:12:12 +0100
Subject: [PATCH] Add new module (ice-9 doctests)

* am/bootstrap.am (SOURCES): add ice-9/doctests.scm
* doc/ref/doctests.texi: added file
* doc/ref/guile.texi (Guile Modules): add Doctests after Curried Definitions
* module/ice-9/doctests.scm: added file
* test-suite/Makefile.am (SCM_TESTS): added tests/doctests.test
---
 am/bootstrap.am                |   1 +
 doc/ref/doctests.texi          | 173 +++++++++++++++++++++++++++++++++
 doc/ref/guile.texi             |   2 +
 module/ice-9/doctests.scm      | 119 +++++++++++++++++++++++
 test-suite/Makefile.am         |   1 +
 test-suite/tests/doctests.test |  35 +++++++
 6 files changed, 331 insertions(+)
 create mode 100644 doc/ref/doctests.texi
 create mode 100644 module/ice-9/doctests.scm
 create mode 100644 test-suite/tests/doctests.test

diff --git a/am/bootstrap.am b/am/bootstrap.am
index 96023d83d..6313487b4 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -137,6 +137,7 @@ SOURCES =					\
   ice-9/curried-definitions.scm			\
   ice-9/custom-ports.scm			\
   ice-9/deprecated.scm				\
+  ice-9/doctests.scm			\
   ice-9/documentation.scm			\
   ice-9/eval-string.scm				\
   ice-9/exceptions.scm				\
diff --git a/doc/ref/doctests.texi b/doc/ref/doctests.texi
new file mode 100644
index 000000000..e9452fb09
--- /dev/null
+++ b/doc/ref/doctests.texi
@@ -0,0 +1,173 @@
+@c -*-texinfo-*-
+@c This is part of the GNU Guile Reference Manual.
+@c Copyright (C) 2012 Free Software Foundation, Inc.
+@c See the file guile.texi for copying conditions.
+
+@node Doctests
+@chapter Doctests
+
+The module @code{(ice-9 doctests)} provides the infrastructure to add
+tests to the start of procedures, close to the implementation.  This
+minimizes the barrier to test-driven development.
+
+@itemize
+@item
+Download from https://hg.sr.ht/~arnebab/guile-doctests
+@item
+Install: @code{autoreconf -i && ./configure && make && make install}.
+@end itemize
+
+
+@node Using doctests
+@section Using doctests
+
+@cindex doctests
+
+The module is loaded by entering the following:
+
+@lisp
+(use-modules (ice-9 doctests))
+@end lisp
+
+This provides the procedure @code{doctests-testmod} used to execute
+doctests written as real code in literal vectors as first non-docstring
+element of procedures.  To work correctly, this requires the module of
+the respective file as input.  A minimal example of using doctests in a
+code file is the following:
+
+@lisp
+#!/usr/bin/env bash
+exec -a ``$0" guile -L ``$(dirname ``$0")" -e '(example)' -c ''
+(define-module (example)
+  #:use-module (ice-9 doctests)
+  #:export (main))
+
+(define (example)
+  ``Docstring of the example procedure."
+  #((tests 
+     (test-equal ``result" (example))
+     (test-equal 'result (string->symbol (example)))))
+  ;; result of (example)
+  ``result")
+
+;; store the current module
+(define %this-module (current-module))
+(define (main args)
+  ;; execute doctests, using %this-module
+  ;; to execute the current tests even
+  ;; when called from within another module.
+  (doctests-testmod %this-module))
+@end lisp
+
+Storing this code in the file @code{example.scm} and making it
+executable with @code{chmod +x example.scm} allows executing the tests
+with @code{./example.scm}.
+
+This provides output like the following:
+
+@example
+*** Entering test group: example.scm--example ***
+* PASS: 
+* PASS: 
+*** Leaving test group: example.scm--example ***
+*** Test suite finished. ***
+*** # of expected passes    : 2
+@end example
+
+The name of the test is derived from the filename and the procedure
+name. Tests for a given procedure can be grouped by wrapping the test
+with a list that starts with the group-name as symbol:
+
+@lisp
+  #((tests 
+     ('equality-tests
+      (test-equal ``result" (example))
+      (test-equal 'result (string->symbol (example))))
+     ('assert-that-true
+      (test-assert #t))))
+@end lisp
+
+This gives the output:
+
+@example
+*** Entering test group: doctest.scm--example--equality-tests ***
+* PASS: 
+* PASS: 
+*** Leaving test group: doctest.scm--example--equality-tests ***
+*** Test suite finished. ***
+*** # of expected passes    : 2
+
+*** Entering test group: doctest.scm--example--assert-that-true ***
+* PASS: 
+*** Leaving test group: doctest.scm--example--assert-that-true ***
+*** Test suite finished. ***
+*** # of expected passes    : 1
+@end example
+
+If a test fails, the output provides additional information. For example
+this test:
+
+@lisp
+  #((tests 
+     (test-equal #t #f)))
+@end lisp
+
+Provides test source-form, expected value, and actual value:
+
+@example
+*** Entering test group: example.scm--example ***
+* FAIL: 
+source-file: #f
+source-line: #f
+source-form: (test-equal #t #f)
+expected-value: #t
+expected-error: #f
+actual-value: #f
+actual-error: #f
+*** Leaving test group: example.scm--example ***
+*** Test suite finished. ***
+*** # of unexpected failures: 1
+@end example
+
+Error output is less complete than with full SRFI :64.  This is still a
+shortcoming of this module.
+
+
+@node Best Practices
+@section Best Practices
+
+To write tests before the implementation, start with the test and #f.
+
+@lisp
+(define (tested-minimal)
+  #((tests (test-equal #f (tested-minimal))))
+  #f)
+@end lisp
+
+
+The literal vector with the tests must either be the first element in
+the procedure or the second, when the first is a literal string.
+
+
+@lisp
+(define (tested-with-doc)
+  ``Docstring of the example procedure."
+  #((tests (test-equal #f (tested-with-doc))))
+  #f)
+@end lisp
+
+
+@deffn {Scheme Procedure} doctests-testmod mod
+Execute the doctests for procedures within the module @var{mod}.
+@end deffn
+
+
+@node Background
+@section Background
+
+Doctests wrap the standard test framework from @code{srfi :64} into a
+more lightweight structure inspired by tests in docstrings in other
+languages.  These doctests preserve homoiconicity by being written in a
+literal array that becomes part of the procedure properties.  They are
+not retrieved by parsing strings, but instead are just code, avoiding
+a few hard to trace sources of errors.
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index 988d30155..679b8b449 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -399,6 +399,7 @@ available through both Scheme and C interfaces.
 * sxml-match::                  Pattern matching of SXML.
 * The Scheme shell (scsh)::     Using scsh interfaces in Guile.
 * Curried Definitions::         Extended @code{define} syntax.
+* Doctests::                    Define tests to the start of procedures.
 * Statprof::                    An easy-to-use statistical profiler.
 * SXML::                        Parsing, transforming, and serializing XML.
 * Texinfo Processing::          Munging documents written in Texinfo.
@@ -421,6 +422,7 @@ available through both Scheme and C interfaces.
 
 @include scsh.texi
 @include curried.texi
+@include doctests.texi
 
 @include statprof.texi
 @include sxml.texi
diff --git a/module/ice-9/doctests.scm b/module/ice-9/doctests.scm
new file mode 100644
index 000000000..2da0198d4
--- /dev/null
+++ b/module/ice-9/doctests.scm
@@ -0,0 +1,119 @@
+;;; doctests.scm --- simple testing by adding procedure-properties with tests
+;;;;
+;;;; Copyright (C) 2024, 2025
+;;;;   2025 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (ice-9 doctests)
+  #:export (doctests-testmod))
+
+(import (ice-9 optargs)
+         (ice-9 rdelim)
+         (ice-9 match)
+         (ice-9 pretty-print)
+         (oop goops)
+         (texinfo reflection))
+
+(define (doctests-testmod mod)
+       "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
+                 (if (module-filename mod) (string-join (string-split (module-filename mod) #\/ ) "-")
+                     (string-join (cons "._" (map symbol->string (module-name mod))) "-")))
+             (doctests
+                 (map (λ (x) (if (procedure? x) (procedure-property x 'tests)))
+                     (map (λ (x) (module-ref mod x)) names))))
+           (let loop
+               ((names names)
+                (doctests doctests))
+               (when (pair? doctests)
+                   (let*
+                       ((name (car names))
+                        (doctest (car doctests)))
+                       (let loop-tests
+                          ((doctest doctest))
+                          (when (and (pair? doctest) (car doctest) (pair? (car doctest)))
+                             (let*
+                               ((testid
+                                    (match doctest
+                                      (((('quote id) tests ...) moretests ...)
+                                        (string-join
+                                            (list filename
+                                                (string-join (string-split (symbol->string name) (car (string->list "/"))) "--" );; escape / in paths
+                                                (symbol->string id))
+                                            "--"))
+                                      ((tests ...)
+                                        (string-join (list filename (string-join (string-split (symbol->string name) (car (string->list "/"))) "--" ));; escape / in paths
+                                                     "--"))))
+                                 (body
+                                     (match doctest
+                                      (((('quote id) test tests ...) moretests ...)
+                                        (cons test tests))
+                                      ((tests ...)
+                                        tests)))
+                                 (cleaned
+                                        (cons 'begin
+                                            (cons '(import (srfi srfi-64))
+                                                (cons
+                                                    (list 'test-begin (or testid ""))
+                                                    (append
+                                                        body
+                                                        (list (list 'test-end (or testid "")))))))))
+                               (when cleaned
+                                   (let ()
+                                       (eval cleaned mod))
+                                   (newline))
+                               (match doctest
+                                      (((('quote id) tests ...) moretests ...)
+                                        (loop-tests moretests))
+                                      ((tests ...)
+                                        #t))))))
+                   (loop (cdr names) (cdr doctests))))))
+
+;; Example tests
+(define (hello who)
+    "Say hello to WHO"
+    #((tests
+            (test-equal "Hello World!\n"
+                       (hello "World"))))
+    (format #f "Hello ~a!\n"
+                   who))
+
+(define (subtract a b)
+    "Subtract B from A."
+    #((tests (test-eqv 3 (subtract 5 2))))
+    (- a b))
+
+(define (tested-minimal)
+  #((tests (test-equal #f (tested-minimal))))
+  #f)
+
+(define %this-module (current-module))
+(define (test)
+         (doctests-testmod %this-module))
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index 6014b1f1f..60ff7d85c 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -42,6 +42,7 @@ SCM_TESTS = tests/00-initial-env.test		\
 	    tests/coverage.test			\
 	    tests/cross-compilation.test	\
 	    tests/curried-definitions.test	\
+	    tests/doctests.test			\
 	    tests/dwarf.test			\
 	    tests/ecmascript.test		\
 	    tests/elisp.test			\
diff --git a/test-suite/tests/doctests.test b/test-suite/tests/doctests.test
new file mode 100644
index 000000000..37f4f590c
--- /dev/null
+++ b/test-suite/tests/doctests.test
@@ -0,0 +1,35 @@
+;;;; vectors.test --- test suite for Guile's vector functions -*- scheme -*-
+;;;;
+;;;; Copyright (C) 2003, 2006, 2010, 2011 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+
+(define-module (test-suite doctests)
+  #:use-module (test-suite lib)
+  #:use-module (ice-9 doctests))
+
+(let ((previous-error-port (current-error-port)))
+  (with-exception-handler
+      (λ(e) (set-current-error-port previous-error-port))
+    (λ()
+      (set-current-error-port (current-output-port))
+      (let* ((res
+              (with-output-to-string
+                (λ () ((@@ (ice-9 doctests) test)))))
+             (succeeded (not (string-contains res "FAIL"))))
+        (pass-if "must not have doctest failures" succeeded)
+        (unless succeeded (display res previous-error-port))))
+    #:unwind? #t)
+  (set-current-error-port previous-error-port))
-- 
2.47.1

signature.asc (application/pgp-signature, 1.1 KB)