summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--module/srfi/srfi-9.scm4
-rw-r--r--test-suite/lib.scm3
-rw-r--r--test-suite/tests/srfi-9.test18
-rw-r--r--testsuite/t-records.scm3
4 files changed, 21 insertions, 7 deletions
diff --git a/module/srfi/srfi-9.scm b/module/srfi/srfi-9.scm
index ce8029395..39f4e34e5 100644
--- a/module/srfi/srfi-9.scm
+++ b/module/srfi/srfi-9.scm
@@ -1,6 +1,6 @@
;;; srfi-9.scm --- define-record-type
-;; Copyright (C) 2001, 2002, 2006, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2006, 2009, 2010 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -119,7 +119,7 @@
(ctor-args (map (lambda (field)
(cons (syntax->datum field) field))
#'(field ...))))
- #`(define #,constructor-spec
+ #`(define-inlinable #,constructor-spec
(make-struct #,type-name 0
#,@(unfold
(lambda (field-num)
diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index 1e78c71cf..d67b957df 100644
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -22,6 +22,7 @@
:export (
;; Exceptions which are commonly being tested for.
+ exception:syntax-pattern-unmatched
exception:bad-variable
exception:missing-expression
exception:out-of-range exception:unbound-var
@@ -248,6 +249,8 @@ with-locale with-locale*
;;;;
;;; Define some exceptions which are commonly being tested for.
+(define exception:syntax-pattern-unmatched
+ (cons 'syntax-error "source expression failed to match any pattern"))
(define exception:bad-variable
(cons 'syntax-error "Bad variable"))
(define exception:missing-expression
diff --git a/test-suite/tests/srfi-9.test b/test-suite/tests/srfi-9.test
index f8cb0b491..a645ddc09 100644
--- a/test-suite/tests/srfi-9.test
+++ b/test-suite/tests/srfi-9.test
@@ -1,7 +1,7 @@
;;;; srfi-9.test --- Test suite for Guile's SRFI-9 functions. -*- scheme -*-
;;;; Martin Grabmueller, 2001-05-10
;;;;
-;;;; Copyright (C) 2001, 2006, 2007 Free Software Foundation, Inc.
+;;;; Copyright (C) 2001, 2006, 2007, 2010 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -19,6 +19,7 @@
(define-module (test-suite test-numbers)
#:use-module (test-suite lib)
+ #:use-module ((system base compile) #:select (compile))
#:use-module (srfi srfi-9))
@@ -35,10 +36,21 @@
(with-test-prefix "constructor"
+ ;; Constructors are defined using `define-integrable', meaning that direct
+ ;; calls as in `(make-foo)' lead to a compile-time psyntax error, hence the
+ ;; distinction below.
+
+ (pass-if-exception "foo 0 args (inline)" exception:syntax-pattern-unmatched
+ (compile '(make-foo) #:env (current-module)))
+ (pass-if-exception "foo 2 args (inline)" exception:syntax-pattern-unmatched
+ (compile '(make-foo 1 2) #:env (current-module)))
+
(pass-if-exception "foo 0 args" exception:wrong-num-args
- (make-foo))
+ (let ((make-foo make-foo))
+ (make-foo)))
(pass-if-exception "foo 2 args" exception:wrong-num-args
- (make-foo 1 2)))
+ (let ((make-foo make-foo))
+ (make-foo 1 2))))
(with-test-prefix "predicate"
diff --git a/testsuite/t-records.scm b/testsuite/t-records.scm
index 0cb320da3..9aa4daac6 100644
--- a/testsuite/t-records.scm
+++ b/testsuite/t-records.scm
@@ -11,5 +11,4 @@
(and (stuff? (%make-stuff 12))
(= 7 (stuff:chbouib (%make-stuff 7)))
- (not (stuff? 12))
- (not (false-if-exception (%make-stuff))))
+ (not (stuff? 12)))