1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00

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.
This commit is contained in:
Ludovic Courtès 2010-01-30 22:54:20 +01:00
parent 61cbfff509
commit 30a700c8c1
4 changed files with 21 additions and 7 deletions

View file

@ -1,6 +1,6 @@
;;; srfi-9.scm --- define-record-type ;;; 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 ;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public ;; modify it under the terms of the GNU Lesser General Public
@ -119,7 +119,7 @@
(ctor-args (map (lambda (field) (ctor-args (map (lambda (field)
(cons (syntax->datum field) field)) (cons (syntax->datum field) field))
#'(field ...)))) #'(field ...))))
#`(define #,constructor-spec #`(define-inlinable #,constructor-spec
(make-struct #,type-name 0 (make-struct #,type-name 0
#,@(unfold #,@(unfold
(lambda (field-num) (lambda (field-num)

View file

@ -22,6 +22,7 @@
:export ( :export (
;; Exceptions which are commonly being tested for. ;; Exceptions which are commonly being tested for.
exception:syntax-pattern-unmatched
exception:bad-variable exception:bad-variable
exception:missing-expression exception:missing-expression
exception:out-of-range exception:unbound-var 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 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 (define exception:bad-variable
(cons 'syntax-error "Bad variable")) (cons 'syntax-error "Bad variable"))
(define exception:missing-expression (define exception:missing-expression

View file

@ -1,7 +1,7 @@
;;;; srfi-9.test --- Test suite for Guile's SRFI-9 functions. -*- scheme -*- ;;;; srfi-9.test --- Test suite for Guile's SRFI-9 functions. -*- scheme -*-
;;;; Martin Grabmueller, 2001-05-10 ;;;; 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 ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -19,6 +19,7 @@
(define-module (test-suite test-numbers) (define-module (test-suite test-numbers)
#:use-module (test-suite lib) #:use-module (test-suite lib)
#:use-module ((system base compile) #:select (compile))
#:use-module (srfi srfi-9)) #:use-module (srfi srfi-9))
@ -35,10 +36,21 @@
(with-test-prefix "constructor" (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 (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 (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" (with-test-prefix "predicate"

View file

@ -11,5 +11,4 @@
(and (stuff? (%make-stuff 12)) (and (stuff? (%make-stuff 12))
(= 7 (stuff:chbouib (%make-stuff 7))) (= 7 (stuff:chbouib (%make-stuff 7)))
(not (stuff? 12)) (not (stuff? 12)))
(not (false-if-exception (%make-stuff))))