Re: [PATCH] Changes to SRFI-64 testing.scm to support Guile 2, etc.

[Mark H Weaver <mhw@netris.org>]

[-- Attachment #1: Type: text/plain, Size: 594 bytes --]

Hi Per,

I've attached some more fixes for SRFI-64 testing.scm:

* Improved Guile's implementation of '%test-evaluate-with-catch'
  to record 'actual-error' if there's an error.

* Fix typo '%test-approximimate=' -> '%test-approximate='.

* In the default implementation of 'test-error', '%test-report-result'
  was being called twice: once by '%test-error', and once by
  'test-assert'.  This caused the test suite to fail on Guile 1.8.

Now, Guile 1.8 passes srfi-64-test.scm (after removing the R6RS block
comment at the end, which Guile 1.8 is unable to read).

     Regards,
       Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: More fixes for SRFI-64 testing.scm --]
[-- Type: text/x-patch, Size: 2706 bytes --]

--- testing.scm-ORIG2	2014-01-30 09:45:05.114667941 -0500
+++ testing.scm	2014-01-30 10:10:14.303999879 -0500
@@ -573,7 +573,12 @@
   (define-syntax %test-evaluate-with-catch
     (syntax-rules ()
       ((%test-evaluate-with-catch test-expression)
-       (catch #t (lambda () test-expression) (lambda (key . args) #f))))))
+       (catch #t
+         (lambda () test-expression)
+         (lambda (key . args)
+           (test-result-set! (test-runner-current) 'actual-error
+                             (cons key args))
+           #f))))))
  (kawa
   (define-syntax %test-evaluate-with-catch
     (syntax-rules ()
@@ -661,7 +666,7 @@
 			   (%test-on-test-end r (comp exp res)))))
 		   (%test-report-result)))))
 
-(define (%test-approximimate= error)
+(define (%test-approximate= error)
   (lambda (value expected)
     (let ((rval (real-part value))
           (ival (imag-part value))
@@ -737,12 +742,12 @@
 	(let* ((r (test-runner-get))
 	       (name tname))
 	  (test-result-alist! r (cons (cons 'test-name tname) line))
-	  (%test-comp2body r (%test-approximimate= error) expected expr))))
+	  (%test-comp2body r (%test-approximate= error) expected expr))))
       (((mac expected expr error) line)
        (syntax
 	(let* ((r (test-runner-get)))
 	  (test-result-alist! r line)
-	  (%test-comp2body r (%test-approximimate= error) expected expr))))))))
+	  (%test-comp2body r (%test-approximate= error) expected expr))))))))
  (else
   (define-syntax test-end
     (syntax-rules ()
@@ -787,9 +792,9 @@
   (define-syntax test-approximate
     (syntax-rules ()
       ((test-approximate tname expected expr error)
-       (%test-comp2 (%test-approximimate= error) tname expected expr))
+       (%test-comp2 (%test-approximate= error) tname expected expr))
       ((test-approximate expected expr error)
-       (%test-comp2 (%test-approximimate= error) expected expr))))))
+       (%test-comp2 (%test-approximate= error) expected expr))))))
 
 (cond-expand
  (guile
@@ -908,13 +913,16 @@
     (syntax-rules ()
       ((test-error name etype expr)
        (let ((r (test-runner-get)))
-         (test-assert name (%test-error r etype expr))))
+         (test-result-alist! r `((test-name . ,name)))
+         (%test-error r etype expr)))
       ((test-error etype expr)
        (let ((r (test-runner-get)))
-         (test-assert (%test-error r etype expr))))
+         (test-result-alist! r '())
+         (%test-error r etype expr)))
       ((test-error expr)
        (let ((r (test-runner-get)))
-         (test-assert (%test-error r #t expr))))))))
+         (test-result-alist! r '())
+         (%test-error r #t expr)))))))
 
 (define (test-apply first . rest)
   (if (test-runner? first)