[Guile-commits] 05/08: Add R7RS XFAILs due to https://bugs.gnu.org/38236 (datum labels)

[Andy Wingo]

wingo pushed a commit to branch wip-r7rs
in repository guile.

commit fcbf0d15b203ef63b0686968a7917836775b2fd4
Author: Andy Wingo <address@hidden>
Date:   Sat Nov 16 22:06:06 2019 +0100

    Add R7RS XFAILs due to https://bugs.gnu.org/38236 (datum labels)
    
    * test-suite/tests/r7rs.test (failing-test-with-exception): New form.
      ("https://bugs.gnu.org/38236";): Mark a couple more xfails.
---
 test-suite/tests/r7rs.test | 29 ++++++++++++++++++-----------
 1 file changed, 18 insertions(+), 11 deletions(-)

diff --git a/test-suite/tests/r7rs.test b/test-suite/tests/r7rs.test
index 85fdcc2..6c5cc7d 100644
--- a/test-suite/tests/r7rs.test
+++ b/test-suite/tests/r7rs.test
@@ -87,6 +87,9 @@
 ;; This form is used for those R7RS tests that do not yet pass in Guile.
 (define-syntax-rule (failing-test url expected expr)
   (expect-fail url (%test-equal? expr expected)))
+(define-syntax-rule (failing-test-with-exception url expected expr)
+  (expect-fail url (guard (exn (else #f))
+                     (%test-equal? expr expected))))
 
 (define-syntax-rule (test-values expected expr)
   (pass-if-equal (call-with-values (lambda () expected) list)
@@ -2162,15 +2165,15 @@
     (get-output-bytevector out)))
 
 (test #t
-    (and (member
-          (let ((out (open-output-string))
-                (x (list 1)))
-            (set-cdr! x x)
-            (write x out)
-            (get-output-string out))
-          ;; labels not guaranteed to be 0 indexed, spacing may differ
-          '("#0=(1 . #0#)" "#1=(1 . #1#)"))
-         #t))
+ (and (member
+       (let ((out (open-output-string))
+             (x (list 1)))
+         (set-cdr! x x)
+         (write x out)
+         (get-output-string out))
+       ;; labels not guaranteed to be 0 indexed, spacing may differ
+       '("#0=(1 . #0#)" "#1=(1 . #1#)"))
+      #t))
 
 (test "((1 2 3) (1 2 3))"
     (let ((out (open-output-string))
@@ -2213,8 +2216,12 @@
 (test '(1 . 2) (read (open-input-string "(1 . 2)")))
 (test '(1 2) (read (open-input-string "(1 . (2))")))
 (test '(1 2 3 4 5) (read (open-input-string "(1 . (2 3 4 . (5)))")))
-(test '1 (cadr (read (open-input-string "#0=(1 . #0#)"))))
-(test '(1 2 3) (cadr (read (open-input-string "(#0=(1 2 3) #0#)"))))
+(failing-test-with-exception
+ "https://bugs.gnu.org/38236";
+ '1 (cadr (read (open-input-string "#0=(1 . #0#)"))))
+(failing-test-with-exception
+ "https://bugs.gnu.org/38236";
+ '(1 2 3) (cadr (read (open-input-string "(#0=(1 2 3) #0#)"))))
 
 (test '(quote (1 2)) (read (open-input-string "'(1 2)")))
 (test '(quote (1 (unquote 2))) (read (open-input-string "'(1 ,2)")))