From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 30 Jan 2010 21:54:20 +0000 (+0100)
Subject: Inline SRFI-9 constructors too.
X-Git-Url: http://git.hcoop.net/bpt/guile.git/commitdiff_plain/30a700c8c12aeaefe3cd5fb85ea3c1b7059705bf

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 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)))