mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-06 07:30:28 +02:00
Merge remote-tracking branch 'origin/stable-2.0'
This commit is contained in:
Mark H Weaver
commit
ad84cc8b84
3 changed files with 288 additions and 134 deletions
|
|
@ -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)
|
||||
'(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 unknown second getter"
|
||||
(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)
|
||||
(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"
|
||||
(set-fields s
|
||||
((bar-i foo-x) 1)
|
||||
((bar-i foo-z) 2)
|
||||
((bar-i foo-x) 3))
|
||||
(bar-i foo-x))))))
|
||||
(list key whom what form subform))))
|
||||
|
||||
(pass-if "set-fields with one path as a prefix of another"
|
||||
(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) 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,110 +489,232 @@
|
|||
(equal? p (make-person 30 "foo@example.com"
|
||||
(make-address "Foo" "Paris" "France")))))))
|
||||
|
||||
(pass-if "set-fields with unknown first getter"
|
||||
(let ()
|
||||
(define-immutable-record-type foo (make-foo x) foo?
|
||||
(x foo-x)
|
||||
(y foo-y set-foo-y)
|
||||
(z foo-z set-foo-z))
|
||||
(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 ()
|
||||
(define-immutable-record-type foo
|
||||
(make-foo x)
|
||||
foo?
|
||||
(x foo-x)
|
||||
(y foo-y set-foo-y)
|
||||
(z foo-z set-foo-z))
|
||||
|
||||
(define-immutable-record-type :bar (make-bar i j) bar?
|
||||
(i bar-i)
|
||||
(j bar-j set-bar-j))
|
||||
(define-immutable-record-type :bar
|
||||
(make-bar i j)
|
||||
bar?
|
||||
(i bar-i)
|
||||
(j bar-j set-bar-j))
|
||||
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(compile '(let ((s (make-bar (make-foo 5) 2)))
|
||||
(set-fields s ((bar-i foo-x) 1) ((blah) 3)))
|
||||
#: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))))))
|
||||
(let ((s (make-bar (make-foo 5) 2)))
|
||||
(set-fields s ((bar-i foo-x) 1) ((blah) 3))))
|
||||
#:env (current-module))
|
||||
#f)
|
||||
(lambda (key whom what src form subform)
|
||||
(list key whom what form subform))))
|
||||
|
||||
(pass-if "set-fields with unknown second getter"
|
||||
(let ()
|
||||
(define-immutable-record-type foo (make-foo x) foo?
|
||||
(x foo-x)
|
||||
(y foo-y set-foo-y)
|
||||
(z foo-z set-foo-z))
|
||||
(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)
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(compile '(let ()
|
||||
(define-immutable-record-type foo
|
||||
(make-foo x)
|
||||
foo?
|
||||
(x foo-x)
|
||||
(y foo-y set-foo-y)
|
||||
(z foo-z set-foo-z))
|
||||
|
||||
(define-immutable-record-type :bar (make-bar i j) bar?
|
||||
(i bar-i)
|
||||
(j bar-j set-bar-j))
|
||||
(define-immutable-record-type :bar
|
||||
(make-bar i j)
|
||||
bar?
|
||||
(i bar-i)
|
||||
(j bar-j set-bar-j))
|
||||
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(compile '(let ((s (make-bar (make-foo 5) 2)))
|
||||
(set-fields s ((bar-i foo-x) 1) ((blah) 3)))
|
||||
#: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))))))
|
||||
(let ((s (make-bar (make-foo 5) 2)))
|
||||
(set-fields s ((bar-i foo-x) 1) ((blah) 3))))
|
||||
#:env (current-module))
|
||||
#f)
|
||||
(lambda (key whom what src form subform)
|
||||
(list key whom what form subform))))
|
||||
|
||||
(pass-if "set-fields with duplicate field path"
|
||||
(let ()
|
||||
(define-immutable-record-type foo (make-foo x) foo?
|
||||
(x foo-x)
|
||||
(y foo-y set-foo-y)
|
||||
(z foo-z set-foo-z))
|
||||
|
||||
(define-immutable-record-type :bar (make-bar i j) bar?
|
||||
(i bar-i)
|
||||
(j bar-j set-bar-j))
|
||||
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(compile '(let ((s (make-bar (make-foo 5) 2)))
|
||||
(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)))
|
||||
#: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"
|
||||
(set-fields s
|
||||
((bar-i foo-x) 1)
|
||||
((bar-i foo-z) 2)
|
||||
((bar-i foo-x) 3))
|
||||
(bar-i foo-x)))))))
|
||||
((bar-i foo-x) 3))
|
||||
(bar-i foo-x))
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(compile '(let ()
|
||||
(define-immutable-record-type foo
|
||||
(make-foo x)
|
||||
foo?
|
||||
(x foo-x)
|
||||
(y foo-y set-foo-y)
|
||||
(z foo-z set-foo-z))
|
||||
|
||||
(pass-if "set-fields with one path as a prefix of another"
|
||||
(let ()
|
||||
(define-immutable-record-type foo (make-foo x) foo?
|
||||
(x foo-x)
|
||||
(y foo-y set-foo-y)
|
||||
(z foo-z set-foo-z))
|
||||
(define-immutable-record-type :bar
|
||||
(make-bar i j)
|
||||
bar?
|
||||
(i bar-i)
|
||||
(j bar-j set-bar-j))
|
||||
|
||||
(define-immutable-record-type :bar (make-bar i j) bar?
|
||||
(i bar-i)
|
||||
(j bar-j set-bar-j))
|
||||
(let ((s (make-bar (make-foo 5) 2)))
|
||||
(set-fields s
|
||||
((bar-i foo-x) 1)
|
||||
((bar-i foo-z) 2)
|
||||
((bar-i foo-x) 3))))
|
||||
#:env (current-module))
|
||||
#f)
|
||||
(lambda (key whom what src form subform)
|
||||
(list key whom what form subform))))
|
||||
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(compile '(let ((s (make-bar (make-foo 5) 2)))
|
||||
(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) 3)))
|
||||
#: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)))))))))
|
||||
((bar-i) 3))
|
||||
(bar-i))
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(compile '(let ()
|
||||
(define-immutable-record-type foo
|
||||
(make-foo x)
|
||||
foo?
|
||||
(x foo-x)
|
||||
(y foo-y set-foo-y)
|
||||
(z foo-z set-foo-z))
|
||||
|
||||
(define-immutable-record-type :bar
|
||||
(make-bar i j)
|
||||
bar?
|
||||
(i bar-i)
|
||||
(j bar-j set-bar-j))
|
||||
|
||||
(let ((s (make-bar (make-foo 5) 2)))
|
||||
(set-fields s
|
||||
((bar-i foo-x) 1)
|
||||
((bar-i foo-z) 2)
|
||||
((bar-i) 3))))
|
||||
#:env (current-module))
|
||||
#f)
|
||||
(lambda (key whom what src form subform)
|
||||
(list key whom what form subform))))))
|
||||
|
||||
|
||||
(with-test-prefix "record type definition error reporting"
|
||||
|
||||
(pass-if-equal "invalid type name"
|
||||
'(syntax-error define-immutable-record-type
|
||||
"expected type name"
|
||||
(define-immutable-record-type
|
||||
(foobar x y)
|
||||
foobar?
|
||||
(x foobar-x)
|
||||
(y foobar-y))
|
||||
(foobar x y))
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(compile '(define-immutable-record-type
|
||||
(foobar x y)
|
||||
foobar?
|
||||
(x foobar-x)
|
||||
(y foobar-y))
|
||||
#:env (current-module))
|
||||
#f)
|
||||
(lambda (key whom what src form subform)
|
||||
(list key whom what form subform))))
|
||||
|
||||
(pass-if-equal "invalid constructor spec"
|
||||
'(syntax-error define-immutable-record-type
|
||||
"invalid constructor spec"
|
||||
(define-immutable-record-type :foobar
|
||||
(make-foobar x y 3)
|
||||
foobar?
|
||||
(x foobar-x)
|
||||
(y foobar-y))
|
||||
(make-foobar x y 3))
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(compile '(define-immutable-record-type :foobar
|
||||
(make-foobar x y 3)
|
||||
foobar?
|
||||
(x foobar-x)
|
||||
(y foobar-y))
|
||||
#:env (current-module))
|
||||
#f)
|
||||
(lambda (key whom what src form subform)
|
||||
(list key whom what form subform))))
|
||||
|
||||
(pass-if-equal "invalid predicate name"
|
||||
'(syntax-error define-immutable-record-type
|
||||
"expected predicate name"
|
||||
(define-immutable-record-type :foobar
|
||||
(foobar x y)
|
||||
(x foobar-x)
|
||||
(y foobar-y))
|
||||
(x foobar-x))
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(compile '(define-immutable-record-type :foobar
|
||||
(foobar x y)
|
||||
(x foobar-x)
|
||||
(y foobar-y))
|
||||
#:env (current-module))
|
||||
#f)
|
||||
(lambda (key whom what src form subform)
|
||||
(list key whom what form subform))))
|
||||
|
||||
(pass-if-equal "invalid field spec"
|
||||
'(syntax-error define-record-type
|
||||
"invalid field spec"
|
||||
(define-record-type :foobar
|
||||
(make-foobar x y)
|
||||
foobar?
|
||||
(x)
|
||||
(y foobar-y))
|
||||
(x))
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(compile '(define-record-type :foobar
|
||||
(make-foobar x y)
|
||||
foobar?
|
||||
(x)
|
||||
(y foobar-y))
|
||||
#:env (current-module))
|
||||
#f)
|
||||
(lambda (key whom what src form subform)
|
||||
(list key whom what form subform))))
|
||||
|
||||
(pass-if-equal "unknown field in constructor spec"
|
||||
'(syntax-error define-record-type
|
||||
"unknown field in constructor spec"
|
||||
(define-record-type :foobar
|
||||
(make-foobar x z)
|
||||
foobar?
|
||||
(x foobar-x)
|
||||
(y foobar-y))
|
||||
z)
|
||||
(catch 'syntax-error
|
||||
(lambda ()
|
||||
(compile '(define-record-type :foobar
|
||||
(make-foobar x z)
|
||||
foobar?
|
||||
(x foobar-x)
|
||||
(y foobar-y))
|
||||
#:env (current-module))
|
||||
#f)
|
||||
(lambda (key whom what src form subform)
|
||||
(list key whom what form subform)))))
|
||||
|
||||
(with-test-prefix "record compatibility"
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue