1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-21 20:20:24 +02:00

Use 'pass-if-equal' to check syntax-error exceptions in srfi-9.test.

* test-suite/tests/srfi-9.test: Convert detailed syntax-error exception
  tests to use 'pass-if-equal'.
This commit is contained in:
Mark H Weaver 2012-11-09 22:23:46 -05:00
parent fe040dd138
commit ce6508531c

View file

@ -118,7 +118,10 @@
(pass-if-exception "set-field on number" exception:wrong-type-arg
(set-field (foo-x bar-j) 4 3))
(pass-if "set-field with unknown first getter"
(pass-if-equal "set-field with unknown first getter"
'(syntax-error set-fields "unknown getter"
(set-field (blah) s 3)
blah)
(catch 'syntax-error
(lambda ()
(compile '(let ((s (make-bar (make-foo 5) 2)))
@ -126,12 +129,12 @@
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(equal? (list key whom what form subform)
'(syntax-error set-fields "unknown getter"
(set-field (blah) s 3)
blah)))))
(list key whom what form subform))))
(pass-if "set-field with unknown second getter"
(pass-if-equal "set-field with unknown second getter"
'(syntax-error set-fields "unknown getter"
(set-field (bar-j blah) s 3)
blah)
(catch 'syntax-error
(lambda ()
(compile '(let ((s (make-bar (make-foo 5) 2)))
@ -139,10 +142,7 @@
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(equal? (list key whom what form subform)
'(syntax-error set-fields "unknown getter"
(set-field (bar-j blah) s 3)
blah)))))
(list key whom what form subform))))
(pass-if "set-fields"
(let ((s (make-foo (make-bar 1 2))))
@ -167,7 +167,10 @@
((foo-x bar-j) 3)
((foo-z) 'bar)))
(pass-if "set-fields with unknown first getter"
(pass-if-equal "set-fields with unknown first getter"
'(syntax-error set-fields "unknown getter"
(set-fields s ((bar-i foo-x) 1) ((blah) 3))
blah)
(catch 'syntax-error
(lambda ()
(compile '(let ((s (make-bar (make-foo 5) 2)))
@ -175,12 +178,12 @@
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(equal? (list key whom what form subform)
(list key whom what form subform))))
(pass-if-equal "set-fields with unknown second getter"
'(syntax-error set-fields "unknown getter"
(set-fields s ((bar-i foo-x) 1) ((blah) 3))
blah)))))
(pass-if "set-fields with unknown second getter"
blah)
(catch 'syntax-error
(lambda ()
(compile '(let ((s (make-bar (make-foo 5) 2)))
@ -188,12 +191,15 @@
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(equal? (list key whom what form subform)
'(syntax-error set-fields "unknown getter"
(set-fields s ((bar-i foo-x) 1) ((blah) 3))
blah)))))
(list key whom what form subform))))
(pass-if "set-fields with duplicate field path"
(pass-if-equal "set-fields with duplicate field path"
'(syntax-error set-fields "duplicate field path"
(set-fields s
((bar-i foo-x) 1)
((bar-i foo-z) 2)
((bar-i foo-x) 3))
(bar-i foo-x))
(catch 'syntax-error
(lambda ()
(compile '(let ((s (make-bar (make-foo 5) 2)))
@ -204,15 +210,16 @@
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(equal? (list key whom what form subform)
'(syntax-error set-fields "duplicate field path"
(list key whom what form subform))))
(pass-if-equal "set-fields with one path as a prefix of another"
'(syntax-error set-fields
"one field path is a prefix of another"
(set-fields s
((bar-i foo-x) 1)
((bar-i foo-z) 2)
((bar-i foo-x) 3))
(bar-i foo-x))))))
(pass-if "set-fields with one path as a prefix of another"
((bar-i) 3))
(bar-i))
(catch 'syntax-error
(lambda ()
(compile '(let ((s (make-bar (make-foo 5) 2)))
@ -223,14 +230,7 @@
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(equal? (list key whom what form subform)
'(syntax-error set-fields
"one field path is a prefix of another"
(set-fields s
((bar-i foo-x) 1)
((bar-i foo-z) 2)
((bar-i) 3))
(bar-i)))))))
(list key whom what form subform)))))
(with-test-prefix "side-effecting arguments"
@ -489,7 +489,10 @@
(equal? p (make-person 30 "foo@example.com"
(make-address "Foo" "Paris" "France")))))))
(pass-if "set-fields with unknown first getter"
(pass-if-equal "set-fields with unknown first getter"
'(syntax-error set-fields "unknown getter"
(set-fields s ((bar-i foo-x) 1) ((blah) 3))
blah)
(let ()
(define-immutable-record-type foo (make-foo x) foo?
(x foo-x)
@ -507,12 +510,12 @@
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(equal? (list key whom what form subform)
(list key whom what form subform)))))
(pass-if-equal "set-fields with unknown second getter"
'(syntax-error set-fields "unknown getter"
(set-fields s ((bar-i foo-x) 1) ((blah) 3))
blah))))))
(pass-if "set-fields with unknown second getter"
blah)
(let ()
(define-immutable-record-type foo (make-foo x) foo?
(x foo-x)
@ -530,12 +533,15 @@
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(equal? (list key whom what form subform)
'(syntax-error set-fields "unknown getter"
(set-fields s ((bar-i foo-x) 1) ((blah) 3))
blah))))))
(list key whom what form subform)))))
(pass-if "set-fields with duplicate field path"
(pass-if-equal "set-fields with duplicate field path"
'(syntax-error set-fields "duplicate field path"
(set-fields s
((bar-i foo-x) 1)
((bar-i foo-z) 2)
((bar-i foo-x) 3))
(bar-i foo-x))
(let ()
(define-immutable-record-type foo (make-foo x) foo?
(x foo-x)
@ -556,15 +562,16 @@
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(equal? (list key whom what form subform)
'(syntax-error set-fields "duplicate field path"
(list key whom what form subform)))))
(pass-if-equal "set-fields with one path as a prefix of another"
'(syntax-error set-fields
"one field path is a prefix of another"
(set-fields s
((bar-i foo-x) 1)
((bar-i foo-z) 2)
((bar-i foo-x) 3))
(bar-i foo-x)))))))
(pass-if "set-fields with one path as a prefix of another"
((bar-i) 3))
(bar-i))
(let ()
(define-immutable-record-type foo (make-foo x) foo?
(x foo-x)
@ -585,14 +592,7 @@
#:env (current-module))
#f)
(lambda (key whom what src form subform)
(equal? (list key whom what form subform)
'(syntax-error set-fields
"one field path is a prefix of another"
(set-fields s
((bar-i foo-x) 1)
((bar-i foo-z) 2)
((bar-i) 3))
(bar-i)))))))))
(list key whom what form subform)))))))
(with-test-prefix "record compatibility"