mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-31 17:30:24 +02:00
Code Activity

Fix non-toplevel srfi-9 compile-time error tests to actually be non-toplevel.

Browse source 
* test-suite/tests/srfi-9.test: Move non-toplevel record definitions to be
  within the expression passed to 'compile'.
This commit is contained in:
Mark H Weaver 2012-11-09 23:02:44 -05:00
parent ce6508531c
commit dfba1025e5
1 changed files with 80 additions and 64 deletions
Download patch file Download diff file Expand all files Collapse all files

144
test-suite/tests/srfi-9.test
View file

@ -493,47 +493,55 @@
'(syntax-error set-fields "unknown getter" '(syntax-error set-fields "unknown getter"
(set-fields s ((bar-i foo-x) 1) ((blah) 3)) (set-fields s ((bar-i foo-x) 1) ((blah) 3))
blah) blah)
(let () (catch 'syntax-error
(define-immutable-record-type foo (make-foo x) foo? (lambda ()
(x foo-x) (compile '(let ()
(y foo-y set-foo-y) (define-immutable-record-type foo
(z foo-z set-foo-z)) (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? (define-immutable-record-type :bar
(i bar-i) (make-bar i j)
(j bar-j set-bar-j)) bar?
(i bar-i)
(j bar-j set-bar-j))
(catch 'syntax-error (let ((s (make-bar (make-foo 5) 2)))
(lambda () (set-fields s ((bar-i foo-x) 1) ((blah) 3))))
(compile '(let ((s (make-bar (make-foo 5) 2))) #:env (current-module))
(set-fields s ((bar-i foo-x) 1) ((blah) 3))) #f)
#:env (current-module)) (lambda (key whom what src form subform)
#f) (list key whom what form subform))))
(lambda (key whom what src form subform)
(list key whom what form subform)))))
(pass-if-equal "set-fields with unknown second getter" (pass-if-equal "set-fields with unknown second getter"
'(syntax-error set-fields "unknown getter" '(syntax-error set-fields "unknown getter"
(set-fields s ((bar-i foo-x) 1) ((blah) 3)) (set-fields s ((bar-i foo-x) 1) ((blah) 3))
blah) blah)
(let () (catch 'syntax-error
(define-immutable-record-type foo (make-foo x) foo? (lambda ()
(x foo-x) (compile '(let ()
(y foo-y set-foo-y) (define-immutable-record-type foo
(z foo-z set-foo-z)) (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? (define-immutable-record-type :bar
(i bar-i) (make-bar i j)
(j bar-j set-bar-j)) bar?
(i bar-i)
(j bar-j set-bar-j))
(catch 'syntax-error (let ((s (make-bar (make-foo 5) 2)))
(lambda () (set-fields s ((bar-i foo-x) 1) ((blah) 3))))
(compile '(let ((s (make-bar (make-foo 5) 2))) #:env (current-module))
(set-fields s ((bar-i foo-x) 1) ((blah) 3))) #f)
#:env (current-module)) (lambda (key whom what src form subform)
#f) (list key whom what form subform))))
(lambda (key whom what src form subform)
(list key whom what form subform)))))
(pass-if-equal "set-fields with duplicate field path" (pass-if-equal "set-fields with duplicate field path"
'(syntax-error set-fields "duplicate field path" '(syntax-error set-fields "duplicate field path"
@ -542,27 +550,31 @@
((bar-i foo-z) 2) ((bar-i foo-z) 2)
((bar-i foo-x) 3)) ((bar-i foo-x) 3))
(bar-i foo-x)) (bar-i foo-x))
(let () (catch 'syntax-error
(define-immutable-record-type foo (make-foo x) foo? (lambda ()
(x foo-x) (compile '(let ()
(y foo-y set-foo-y) (define-immutable-record-type foo
(z foo-z set-foo-z)) (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? (define-immutable-record-type :bar
(i bar-i) (make-bar i j)
(j bar-j set-bar-j)) bar?
(i bar-i)
(j bar-j set-bar-j))
(catch 'syntax-error (let ((s (make-bar (make-foo 5) 2)))
(lambda ()
(compile '(let ((s (make-bar (make-foo 5) 2)))
(set-fields s (set-fields s
((bar-i foo-x) 1) ((bar-i foo-x) 1)
((bar-i foo-z) 2) ((bar-i foo-z) 2)
((bar-i foo-x) 3))) ((bar-i foo-x) 3))))
#:env (current-module)) #:env (current-module))
#f) #f)
(lambda (key whom what src form subform) (lambda (key whom what src form subform)
(list key whom what form subform))))) (list key whom what form subform))))
(pass-if-equal "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 '(syntax-error set-fields
@ -572,27 +584,31 @@
((bar-i foo-z) 2) ((bar-i foo-z) 2)
((bar-i) 3)) ((bar-i) 3))
(bar-i)) (bar-i))
(let () (catch 'syntax-error
(define-immutable-record-type foo (make-foo x) foo? (lambda ()
(x foo-x) (compile '(let ()
(y foo-y set-foo-y) (define-immutable-record-type foo
(z foo-z set-foo-z)) (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? (define-immutable-record-type :bar
(i bar-i) (make-bar i j)
(j bar-j set-bar-j)) bar?
(i bar-i)
(j bar-j set-bar-j))
(catch 'syntax-error (let ((s (make-bar (make-foo 5) 2)))
(lambda ()
(compile '(let ((s (make-bar (make-foo 5) 2)))
(set-fields s (set-fields s
((bar-i foo-x) 1) ((bar-i foo-x) 1)
((bar-i foo-z) 2) ((bar-i foo-z) 2)
((bar-i) 3))) ((bar-i) 3))))
#:env (current-module)) #:env (current-module))
#f) #f)
(lambda (key whom what src form subform) (lambda (key whom what src form subform)
(list key whom what form subform))))))) (list key whom what form subform))))))
(with-test-prefix "record compatibility" (with-test-prefix "record compatibility"