bug#74385: [PATCH 0/4] Patches for SRFI-64

bug#74385: [PATCH 0/4] Patches for SRFI-64

[Tomas Volf]

Few patches resolving either problems I have noticed or that were
reported on the mailing list.

Tomas Volf (4):
  srfi-64: Fix maybe-print-prop.
  srfi-64: Use ~s when printing some properties.
  srfi-64: Export define-equality-test.
  srfi-64: Report failed tests in (standards)Errors format.

 module/srfi/srfi-64.scm | 65 +++++++++++++++++++++++++----------------
 1 file changed, 40 insertions(+), 25 deletions(-)

--
2.46.0

bug#74385: [PATCH 1/4] srfi-64: Fix maybe-print-prop.

[Tomas Volf]

Previously it always printed the property, regardless of whether it was set or
not.

* module/srfi/srfi-64.scm (test-on-test-end-simple)[maybe-print-prop]:
Print only set properties.
---
 module/srfi/srfi-64.scm | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/module/srfi/srfi-64.scm b/module/srfi/srfi-64.scm
index 98fcef645..13ae26d48 100644
--- a/module/srfi/srfi-64.scm
+++ b/module/srfi/srfi-64.scm
@@ -418,15 +418,16 @@ instead."
 (define (test-on-test-end-simple runner)
   "Log that test is done."
   (define (maybe-print-prop prop pretty?)
-    (let* ((val (test-result-ref runner prop))
-           (val (string-trim-both
-                 (with-output-to-string
-                   (λ ()
-                     (if pretty?
-                         (pretty-print val #:per-line-prefix "             ")
-                         (display val)))))))
-      (when val
-        (format #t "~a: ~a~%" prop val))))
+    (let* ((default (list))
+           (val (test-result-ref runner prop default)))
+      (unless (eq? val default)
+        (let ((val (string-trim-both
+                    (with-output-to-string
+                      (λ ()
+                        (if pretty?
+                            (pretty-print val #:per-line-prefix "             ")
+                            (display val)))))))
+          (format #t "~a: ~a~%" prop val)))))
 
   (let ((result-kind (test-result-kind runner)))
     ;; Skip tests not executed due to run list.
-- 
2.46.0

bug#74385: [PATCH 2/4] srfi-64: Use ~s when printing some properties.

[Tomas Volf]

This will help to properly debug failing tests like:

    (test-equal "some failing test" "a b " "a b")

Before there was no way to tell that one "a b" as extra trailing space, now
there is.

* module/srfi/srfi-64.scm (test-on-test-end-simple)['expected-value]
['expected-error, 'actual-value, 'actual-error]: Print using ~s.
[maybe-print-prop]: Take the code for format as a parameter.
---
 module/srfi/srfi-64.scm | 25 +++++++++----------------
 1 file changed, 9 insertions(+), 16 deletions(-)

diff --git a/module/srfi/srfi-64.scm b/module/srfi/srfi-64.scm
index 13ae26d48..7b3341bf0 100644
--- a/module/srfi/srfi-64.scm
+++ b/module/srfi/srfi-64.scm
@@ -27,7 +27,6 @@
   #:use-module (ice-9 exceptions)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 pretty-print)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
@@ -417,17 +416,11 @@ instead."
 
 (define (test-on-test-end-simple runner)
   "Log that test is done."
-  (define (maybe-print-prop prop pretty?)
+  (define (maybe-print-prop prop pretty? code)
     (let* ((default (list))
            (val (test-result-ref runner prop default)))
       (unless (eq? val default)
-        (let ((val (string-trim-both
-                    (with-output-to-string
-                      (λ ()
-                        (if pretty?
-                            (pretty-print val #:per-line-prefix "             ")
-                            (display val)))))))
-          (format #t "~a: ~a~%" prop val)))))
+        (format #t "~a: ~@?~&" prop code val))))
 
   (let ((result-kind (test-result-kind runner)))
     ;; Skip tests not executed due to run list.
@@ -436,13 +429,13 @@ instead."
               result-kind
               (test-runner-test-name runner))
       (unless (member result-kind '(pass xfail))
-        (maybe-print-prop 'source-file    #f)
-        (maybe-print-prop 'source-line    #f)
-        (maybe-print-prop 'source-form    #t)
-        (maybe-print-prop 'expected-value #f)
-        (maybe-print-prop 'expected-error #t)
-        (maybe-print-prop 'actual-value   #f)
-        (maybe-print-prop 'actual-error   #t)))))
+        (maybe-print-prop 'source-file    #f "~a")
+        (maybe-print-prop 'source-line    #f "~a")
+        (maybe-print-prop 'source-form    #t "~y")
+        (maybe-print-prop 'expected-value #f "~s")
+        (maybe-print-prop 'expected-error #t "~s")
+        (maybe-print-prop 'actual-value   #f "~s")
+        (maybe-print-prop 'actual-error   #t "~s")))))
 
 (define (test-runner-simple)
   "Creates a new simple test-runner, that prints errors and a summary on the
-- 
2.46.0

bug#74385: [PATCH 3/4] srfi-64: Export define-equality-test.

[Tomas Volf]

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 <janneke@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

bug#74385: [PATCH 4/4] srfi-64: Report failed tests in (standards)Errors format.

[Tomas Volf]

There is a page in the GNU Standards document regarding the format of error
messages.  Both GNU Emacs and Vim are able to parse it and support jumping to
next/previous error.  My version did not produce a line in this format for
failed tests and this commit rectifies that.

* module/srfi/srfi-64.scm (test-on-test-end-simple)[non-passed]: Write
out (standards)Errors compatible line.

Reported-by: Janneke Nieuwenhuizen <janneke@gnu.org>
---
 module/srfi/srfi-64.scm | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/module/srfi/srfi-64.scm b/module/srfi/srfi-64.scm
index 203db49ea..98f6c8114 100644
--- a/module/srfi/srfi-64.scm
+++ b/module/srfi/srfi-64.scm
@@ -28,6 +28,7 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-71)
@@ -431,6 +432,10 @@ instead."
               result-kind
               (test-runner-test-name runner))
       (unless (member result-kind '(pass xfail))
+        (and-let* ((file (test-result-ref runner 'source-file))
+                   (line (test-result-ref runner 'source-line)))
+          ;; Satisfy (standards)Errors
+          (format #t "~a:~a: unexpected result~%" file line))
         (maybe-print-prop 'source-file    #f "~a")
         (maybe-print-prop 'source-line    #f "~a")
         (maybe-print-prop 'source-form    #t "~y")
-- 
2.46.0