mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 21:10:27 +02:00
Code Activity

Add R7RS XFAILs due to https://bugs.gnu.org/38236 (datum labels)

Browse source 
* test-suite/tests/r7rs.test (failing-test-with-exception): New form.
  ("https://bugs.gnu.org/38236"): Mark a couple more xfails.
This commit is contained in:
Andy Wingo 2019-11-16 22:06:06 +01:00
parent ddc03c070e
commit fcbf0d15b2
1 changed files with 18 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

11
test-suite/tests/r7rs.test
View file

@ -87,6 +87,9 @@
;; This form is used for those R7RS tests that do not yet pass in Guile. ;; This form is used for those R7RS tests that do not yet pass in Guile.
(define-syntax-rule (failing-test url expected expr) (define-syntax-rule (failing-test url expected expr)
(expect-fail url (%test-equal? expr expected))) (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) (define-syntax-rule (test-values expected expr)
(pass-if-equal (call-with-values (lambda () expected) list) (pass-if-equal (call-with-values (lambda () expected) list)
@ -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) (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 2 3 4 5) (read (open-input-string "(1 . (2 3 4 . (5)))")))
(test '1 (cadr (read (open-input-string "#0=(1 . #0#)")))) (failing-test-with-exception
(test '(1 2 3) (cadr (read (open-input-string "(#0=(1 2 3) #0#)")))) "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 2)) (read (open-input-string "'(1 2)")))
(test '(quote (1 (unquote 2))) (read (open-input-string "'(1 ,2)"))) (test '(quote (1 (unquote 2))) (read (open-input-string "'(1 ,2)")))