[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.6-74-gf31a07
|
From: |
Mark H Weaver |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.6-74-gf31a076 |
|
Date: |
Sat, 10 Nov 2012 04:09:18 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=f31a0762328b9cffa328ce1540ceaa6f1497e083
The branch, stable-2.0 has been updated
via f31a0762328b9cffa328ce1540ceaa6f1497e083 (commit)
via dfba1025e56245f55bdda85639e5b59682e7ad47 (commit)
via ce6508531c2fb0a7fb61b3594bc347219ff093cc (commit)
from fe040dd138500520ddfe572a238a6cf28da842c2 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit f31a0762328b9cffa328ce1540ceaa6f1497e083
Author: Mark H Weaver <address@hidden>
Date: Fri Nov 9 03:22:40 2012 -0500
Improve error messages for invalid record definitions.
* module/srfi/srfi-9.scm (%define-record-type): Accept additional 'form'
parameter which contains the original form of 'define-record-type' or
'define-immutable-record-type'. Add elaborate pattern guard which
raises descriptive syntax errors for specific errors, and a fallback
pattern to catch anything else.
(define-record-type): Pass 'form' parameter to %define-record-type.
* module/srfi/srfi-9/gnu.scm (define-immutable-record-type): Pass 'form'
parameter to %define-record-type.
* test-suite/tests/srfi-9.test: Add tests.
commit dfba1025e56245f55bdda85639e5b59682e7ad47
Author: Mark H Weaver <address@hidden>
Date: Fri Nov 9 23:02:44 2012 -0500
Fix non-toplevel srfi-9 compile-time error tests to actually be
non-toplevel.
* test-suite/tests/srfi-9.test: Move non-toplevel record definitions to be
within the expression passed to 'compile'.
commit ce6508531c2fb0a7fb61b3594bc347219ff093cc
Author: Mark H Weaver <address@hidden>
Date: Fri Nov 9 22:23:46 2012 -0500
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'.
-----------------------------------------------------------------------
Summary of changes:
module/srfi/srfi-9.scm | 44 ++++-
module/srfi/srfi-9/gnu.scm | 4 +-
test-suite/tests/srfi-9.test | 396 +++++++++++++++++++++++++++---------------
3 files changed, 299 insertions(+), 145 deletions(-)
diff --git a/module/srfi/srfi-9.scm b/module/srfi/srfi-9.scm
index 1dd132a..de49459 100644
--- a/module/srfi/srfi-9.scm
+++ b/module/srfi/srfi-9.scm
@@ -205,8 +205,10 @@
(let ((name (syntax->datum field)))
(or (memq name field-names)
(syntax-violation
- 'define-record-type
- "unknown field in constructor-spec"
+ (syntax-case form ()
+ ((macro . args)
+ (syntax->datum #'macro)))
+ "unknown field in constructor spec"
form field))
(cons name field)))
#'(field ...))))
@@ -262,9 +264,30 @@
(string-concatenate (make-list count desc))))
(syntax-case x ()
- ((_ immutable? type-name constructor-spec predicate-name
+ ((_ immutable? form type-name constructor-spec predicate-name
field-spec ...)
- (boolean? (syntax->datum #'immutable?))
+ (let ()
+ (define (syntax-error message subform)
+ (syntax-violation (syntax-case #'form ()
+ ((macro . args) (syntax->datum #'macro)))
+ message #'form subform))
+ (and (boolean? (syntax->datum #'immutable?))
+ (or (identifier? #'type-name)
+ (syntax-error "expected type name" #'type-name))
+ (syntax-case #'constructor-spec ()
+ ((ctor args ...)
+ (every identifier? #'(ctor args ...))
+ #t)
+ (_ (syntax-error "invalid constructor spec"
+ #'constructor-spec)))
+ (or (identifier? #'predicate-name)
+ (syntax-error "expected predicate name" #'predicate-name))
+ (every (lambda (spec)
+ (syntax-case spec ()
+ ((field getter) #t)
+ ((field getter setter) #t)
+ (_ (syntax-error "invalid field spec" spec))))
+ #'(field-spec ...))))
(let* ((field-ids (field-identifiers #'(field-spec ...)))
(getter-ids (getter-identifiers #'(field-spec ...)))
(field-count (length field-ids))
@@ -275,7 +298,7 @@
((ctor args ...) #'ctor)))
(copier-id (make-copier-id #'type-name)))
#`(begin
- #,(constructor x #'type-name #'constructor-spec field-names)
+ #,(constructor #'form #'type-name #'constructor-spec field-names)
(define type-name
(let ((rtd (make-struct/no-tail
@@ -296,9 +319,16 @@
#,(copier #'type-name getter-ids copier-id)
#,@(if immutable?
(functional-setters copier-id #'(field-spec ...))
- (setters #'type-name #'(field-spec ...)))))))))
+ (setters #'type-name #'(field-spec ...))))))
+ ((_ immutable? form . rest)
+ (syntax-violation
+ (syntax-case #'form ()
+ ((macro . args) (syntax->datum #'macro)))
+ "invalid record definition syntax"
+ #'form)))))
(define-syntax-rule (define-record-type name ctor pred fields ...)
- (%define-record-type #f name ctor pred fields ...))
+ (%define-record-type #f (define-record-type name ctor pred fields ...)
+ name ctor pred fields ...))
;;; srfi-9.scm ends here
diff --git a/module/srfi/srfi-9/gnu.scm b/module/srfi/srfi-9/gnu.scm
index fa091fe..4f3a663 100644
--- a/module/srfi/srfi-9/gnu.scm
+++ b/module/srfi/srfi-9/gnu.scm
@@ -34,7 +34,9 @@
(struct-set! type vtable-index-printer thunk))
(define-syntax-rule (define-immutable-record-type name ctor pred fields ...)
- ((@@ (srfi srfi-9) %define-record-type) #t name ctor pred fields ...))
+ ((@@ (srfi srfi-9) %define-record-type)
+ #t (define-immutable-record-type name ctor pred fields ...)
+ name ctor pred fields ...))
(define-syntax-rule (set-field (getter ...) s expr)
(%set-fields #t (set-field (getter ...) s expr) ()
diff --git a/test-suite/tests/srfi-9.test b/test-suite/tests/srfi-9.test
index a5179e2..4935148 100644
--- a/test-suite/tests/srfi-9.test
+++ b/test-suite/tests/srfi-9.test
@@ -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)))))
-
- (pass-if "set-fields with duplicate field path"
+ (list key whom what form subform))))
+
+ (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))))))
-
- (pass-if "set-fields with one path as a prefix of another"
+ (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) 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 "address@hidden"
(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))
-
- (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))))))
-
- (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))
-
- (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))))))
-
- (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 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))
+
+ (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-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))
+
+ (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-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)))))))
-
- (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))
-
- (catch 'syntax-error
- (lambda ()
- (compile '(let ((s (make-bar (make-foo 5) 2)))
+ ((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))
+
+ (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))))
+
+ (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"
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.6-74-gf31a076,
Mark H Weaver <=