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