Inline SRFI-9 constructors too.

* module/srfi/srfi-9.scm (define-record-type)[constructor]: Use
  `define-inlinable' instead of `define'.

* test-suite/lib.scm (exception:syntax-pattern-unmatched): New variable.

* test-suite/tests/srfi-9.test ("constructor")["foo 0 args (inline)",
  "foo 2 args (inline)"]: New tests.
  ["foo 0 args", "foo 2 args"]: Adjust to constructor inlining.

* testsuite/t-records.scm: Remove wrong-arg-count case.

diff --git a/module/srfi/srfi-9.scm b/module/srfi/srfi-9.scm
index ce80293..39f4e34 100644 (file)
--- 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 1e78c71..d67b957 100644 (file)
--- 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 f8cb0b4..a645ddc 100644 (file)
--- 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 0cb320d..9aa4daa 100644 (file)
--- a/testsuite/t-records.scm
+++ b/testsuite/t-records.scm
@@ -11,5 +11,4 @@
 \f
 (and (stuff? (%make-stuff 12))
      (= 7 (stuff:chbouib (%make-stuff 7)))
-     (not (stuff? 12))
-     (not (false-if-exception (%make-stuff))))
+     (not (stuff? 12)))