Latest version of SRFI-64 testing.scm?

Latest version of SRFI-64 testing.scm?

[Mark H Weaver]

Hi Per,

I'd like to include a fully-featured SRFI-64 in the upcoming Guile
2.0.10 release, and to do so in such a way that most of the changes can
be folded back into your upstream version.

I'm aware of the earlier work by Sunjoong Lee in 2012, but it seems that
he made extensive stylistic changes to your code, and I'd prefer to stay
closer to your upstream version.

Where can I find your latest versions of testing.scm and
srfi-64-test.scm?

    Regards,
      Mark

Re: Latest version of SRFI-64 testing.scm?

[Per Bothner]

On 01/24/2014 11:22 AM, Mark H Weaver wrote:

> I'd like to include a fully-featured SRFI-64 in the upcoming Guile
> 2.0.10 release, and to do so in such a way that most of the changes can
> be folded back into your upstream version.

Great!

> Where can I find your latest versions of testing.scm and
> srfi-64-test.scm?

The latest versions are in the Kawa SVN tree - see
http://www.gnu.org/software/kawa/Getting-Kawa.html
Specifically:
http://sourceware.org/viewvc/kawa/trunk/gnu/kawa/slib/testing.scm
- and .../trunk/testsuite/srfi-64-test.scm

I think there are few differences between the SVN version and the
one at the SRFI site - mainly to support r7rs-tests.scm.
After the Guile port is stable, we should upload an updated version
to the SRFI site.d
-- 
	--Per Bothner
per@bothner.com   http://per.bothner.com/

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

[Mark H Weaver]

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

Hi Per,

I've modified testing.scm to fully support Guile 2.  It passes all tests
of srfi-64-test.scm, except for the two expected failures.  (What's the
story with those expected failures, btw?  Do they pass on any system?)

A few notes:

* Guile 2's syntax-case macro system does not tolerate bare symbols in
  the output of macro transformers, but the syntax-case macros in
  testing.scm generate bare symbols.  I fixed this by changing several
  instances of 'quote to (syntax quote), and also by using
  'datum->syntax' in Guile-2's implementation of '%test-source-line2'.

* I noticed that three of the implementations of '%test-error' were
  incorrect in the following respect: they should return #f if no error
  occurs, but instead they would return the result of evaluating the
  test expression.  To fix this, I added '#f' after 'expr' in several
  places.

* In 'test-read-eval-string', you call 'eval' with only one argument,
  but R5RS, R6RS, and R7RS all specify that 'eval' takes two arguments.
  Guile's 'eval' requires two arguments.

Anyway, I've attached a patch with my changes to testing.scm.

    Regards,
      Mark



[-- Attachment #2: Changes to SRFI-64 testing.scm to support Guile 2, etc. --]
[-- Type: text/x-patch, Size: 6266 bytes --]

--- testing.scm-ORIG	2014-01-28 23:23:45.443513698 -0500
+++ testing.scm	2014-01-29 03:33:40.647991235 -0500
@@ -2,6 +2,7 @@
 ;; Added "full" support for Chicken, Gauche, Guile and SISC.
 ;;   Alex Shinn, Copyright (c) 2005.
 ;; Modified for Scheme Spheres by Álvaro Castro-Castilla, Copyright (c) 2012.
+;; Support for Guile 2 by Mark H Weaver <mhw@netris.org>, Copyright (c) 2014.
 ;;
 ;; Permission is hereby granted, free of charge, to any person
 ;; obtaining a copy of this software and associated documentation
@@ -26,6 +27,12 @@
 (cond-expand
  (chicken
   (require-extension syntax-case))
+ (guile-2
+  (use-modules (srfi srfi-9)
+               ;; In 2.0.9, srfi-34 and srfi-35 are not well integrated
+               ;; with either Guile's native exceptions or R6RS exceptions.
+               ;;(srfi srfi-34) (srfi srfi-35)
+               (srfi srfi-39)))
  (guile
   (use-modules (ice-9 syncase) (srfi srfi-9)
 	       ;;(srfi srfi-34) (srfi srfi-35) - not in Guile 1.6.7
@@ -236,7 +243,7 @@
 	 (else #t)))
     r))
 
-(define (%test-specificier-matches spec runner)
+(define (%test-specifier-matches spec runner)
   (spec runner))
 
 (define (test-runner-create)
@@ -247,7 +254,7 @@
     (let loop ((l list))
       (cond ((null? l) result)
 	    (else
-	     (if (%test-specificier-matches (car l) runner)
+	     (if (%test-specifier-matches (car l) runner)
 		 (set! result #t))
 	     (loop (cdr l)))))))
 
@@ -609,6 +616,21 @@
 	   (line-pair (if line (list (cons 'source-line line)) '())))
       (cons (cons 'source-form (syntax-object->datum form))
 	    (if file (cons (cons 'source-file file) line-pair) line-pair)))))
+ (guile-2
+  (define (%test-source-line2 form)
+    (let* ((src-props (syntax-source form))
+           (file (and src-props (assq-ref src-props 'filename)))
+           (line (and src-props (assq-ref src-props 'line)))
+           (file-alist (if file
+                           `((source-file . ,file))
+                           '()))
+           (line-alist (if line
+                           `((source-line . ,(+ line 1)))
+                           '())))
+      (datum->syntax (syntax here)
+                     `((source-form . ,(syntax->datum form))
+                       ,@file-alist
+                       ,@line-alist)))))
  (else
   (define (%test-source-line2 form)
     '())))
@@ -662,12 +684,12 @@
        (%test-report-result)))))
 
 (cond-expand
- ((or kawa mzscheme)
+ ((or kawa mzscheme guile-2)
   ;; Should be made to work for any Scheme with syntax-case
   ;; However, I haven't gotten the quoting working.  FIXME.
   (define-syntax test-end
     (lambda (x)
-      (syntax-case (list x (list 'quote (%test-source-line2 x))) ()
+      (syntax-case (list x (list (syntax quote) (%test-source-line2 x))) ()
 	(((mac suite-name) line)
 	 (syntax
 	  (%test-end suite-name line)))
@@ -676,7 +698,7 @@
 	  (%test-end #f line))))))
   (define-syntax test-assert
     (lambda (x)
-      (syntax-case (list x (list 'quote (%test-source-line2 x))) ()
+      (syntax-case (list x (list (syntax quote) (%test-source-line2 x))) ()
 	(((mac tname expr) line)
 	 (syntax
 	  (let* ((r (test-runner-get))
@@ -689,7 +711,7 @@
 	    (test-result-alist! r line)
 	    (%test-comp1body r expr)))))))
   (define (%test-comp2 comp x)
-    (syntax-case (list x (list 'quote (%test-source-line2 x)) comp) ()
+    (syntax-case (list x (list (syntax quote) (%test-source-line2 x)) comp) ()
       (((mac tname expected expr) line comp)
        (syntax
 	(let* ((r (test-runner-get))
@@ -709,7 +731,7 @@
     (lambda (x) (%test-comp2 (syntax equal?) x)))
   (define-syntax test-approximate ;; FIXME - needed for non-Kawa
     (lambda (x)
-      (syntax-case (list x (list 'quote (%test-source-line2 x))) ()
+      (syntax-case (list x (list (syntax quote) (%test-source-line2 x))) ()
       (((mac tname expected expr error) line)
        (syntax
 	(let* ((r (test-runner-get))
@@ -774,7 +796,21 @@
   (define-syntax %test-error
     (syntax-rules ()
       ((%test-error r etype expr)
-       (%test-comp1body r (catch #t (lambda () expr) (lambda (key . args) #t)))))))
+       (cond ((%test-on-test-begin r)
+              (let ((et etype))
+                (test-result-set! r 'expected-error et)
+                (%test-on-test-end r
+                                   (catch #t
+                                     (lambda ()
+                                       (test-result-set! r 'actual-value expr)
+                                       #f)
+                                     (lambda (key . args)
+                                       ;; TODO: decide how to specify expected
+                                       ;; error types for Guile.
+                                       (test-result-set! r 'actual-error
+                                                         (cons key args))
+                                       #t)))
+                (%test-report-result))))))))
  (mzscheme
   (define-syntax %test-error
     (syntax-rules ()
@@ -830,12 +866,12 @@
 		  ((equal? etype #t)
 		   #t)
 		  (else #t))
-	      expr))))))
+	      expr #f))))))
  (srfi-34
   (define-syntax %test-error
     (syntax-rules ()
       ((%test-error r etype expr)
-       (%test-comp1body r (guard (ex (else #t)) expr))))))
+       (%test-comp1body r (guard (ex (else #t)) expr #f))))))
  (else
   (define-syntax %test-error
     (syntax-rules ()
@@ -846,11 +882,11 @@
 	 (%test-report-result)))))))
 
 (cond-expand
- ((or kawa mzscheme)
+ ((or kawa mzscheme guile-2)
 
   (define-syntax test-error
     (lambda (x)
-      (syntax-case (list x (list 'quote (%test-source-line2 x))) ()
+      (syntax-case (list x (list (syntax quote) (%test-source-line2 x))) ()
 	(((mac tname etype expr) line)
 	 (syntax
 	  (let* ((r (test-runner-get))
@@ -987,7 +1023,9 @@
   (let* ((port (open-input-string string))
 	 (form (read port)))
     (if (eof-object? (read-char port))
-	(eval form)
+	(cond-expand
+	 (guile (eval form (current-module)))
+	 (else (eval form)))
 	(cond-expand
 	 (srfi-23 (error "(not at eof)"))
 	 (else "error")))))

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

[Per Bothner]

On 01/29/2014 12:57 AM, Mark H Weaver wrote:
> Hi Per,
>
> I've modified testing.scm to fully support Guile 2.  It passes all tests
> of srfi-64-test.scm,

Thanks - I checked your changes into the Kawa repository.

> except for the two expected failures.  (What's the
> story with those expected failures, btw?  Do they pass on any system?)

Not as far as I know.  The first test-expect-fail in line 564 makes sense,
as I don't see any code in test-group to increment the skip count
or otherwise report a "result" for the group.  It's kind of mushy what
the result of a group *should* be - should we call the on-rst-end handler?
I haven't looked into the test-expect-fail in line 747.

-- 
	--Per Bothner
per@bothner.com   http://per.bothner.com/

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

[Mark H Weaver]

[-- 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)

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

[Per Bothner]

On 01/30/2014 07:18 AM, Mark H Weaver wrote:
> 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.

Thanks - I've checked these into the master source at Kawa.
-- 
	--Per Bothner
per@bothner.com   http://per.bothner.com/