Interest was expressed on the mailing list to have %test-2 as a part of the
public API. So rename it and export from the module.
* module/srfi/srfi-64.scm (define-equality-test): Rename from %test-2.
(%test-2): Rename from %%test-2.
(test-eq, test-eqv, test-equal): Adjust.
(define-module)<#:export>: Export it.
Reported-by: Janneke Nieuwenhuizen <jann...@gnu.org>
---
module/srfi/srfi-64.scm | 30 +++++++++++++++++++++++-------
1 file changed, 23 insertions(+), 7 deletions(-)
diff --git a/module/srfi/srfi-64.scm b/module/srfi/srfi-64.scm
index 7b3341bf0..203db49ea 100644
--- a/module/srfi/srfi-64.scm
+++ b/module/srfi/srfi-64.scm
@@ -118,6 +118,8 @@
test-procedure?
test-thunk
+ define-equality-test
+
&bad-end-name
bad-end-name?
bad-end-name-begin-name
@@ -728,7 +730,7 @@ to invoke @code{test-assert} if there is no current test
runner.
@end defspec")
-(define-syntax %%test-2
+(define-syntax %test-2
(λ (x)
(syntax-case x ()
((_ syn test-proc test-name expected test-expr)
@@ -742,20 +744,34 @@ to invoke @code{test-assert} if there is no current test
runner.
(test-result-set! r 'actual-value a)
(test-proc e a))))))))
-(define-syntax %test-2
+(define-syntax define-equality-test
(syntax-rules ()
((_ name test-proc)
(define-syntax name
(λ (x)
(syntax-case x ()
((_ test-name expected test-expr)
- #`(%%test-2 #,x test-proc test-name expected test-expr))
+ #`(%test-2 #,x test-proc test-name expected test-expr))
((_ expected test-expr)
- #`(%%test-2 #,x test-proc #f expected test-expr))))))))
+ #`(%test-2 #,x test-proc #f expected test-expr))))))))
+(set-documentation! 'define-equality-test
+ "@defspec define-equality-test identifier proc
+Define a new test form named @var{identifier} with same signature and usage as
+@code{test-eq} but using @var{proc} instead of @code{eq?}.
-(%test-2 test-eq eq?)
-(%test-2 test-eqv eqv?)
-(%test-2 test-equal equal?)
+For example, the provided equality checks are defined as:
+
+@lisp
+(define-equality-test test-eq eq?)
+(define-equality-test test-eqv eqv?)
+(define-equality-test test-equal equal?)
+@end lisp
+
+@end defspec")
+
+(define-equality-test test-eq eq?)
+(define-equality-test test-eqv eqv?)
+(define-equality-test test-equal equal?)
(set-documentation! 'test-eq
"@defspec test-eq test-name expected test-expr
--
2.46.0
