mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-03 05:20:16 +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

29
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)
@ -2162,15 +2165,15 @@
(get-output-bytevector out))) (get-output-bytevector out)))
(test #t (test #t
(and (member (and (member
(let ((out (open-output-string)) (let ((out (open-output-string))
(x (list 1))) (x (list 1)))
(set-cdr! x x) (set-cdr! x x)
(write x out) (write x out)
(get-output-string out)) (get-output-string out))
;; labels not guaranteed to be 0 indexed, spacing may differ ;; labels not guaranteed to be 0 indexed, spacing may differ
'("#0=(1 . #0#)" "#1=(1 . #1#)")) '("#0=(1 . #0#)" "#1=(1 . #1#)"))
#t)) #t))
(test "((1 2 3) (1 2 3))" (test "((1 2 3) (1 2 3))"
(let ((out (open-output-string)) (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) (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)")))