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:
parent
61cbfff509
commit
30a700c8c1
4 changed files with 21 additions and 7 deletions
|
@ -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)
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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"
|
||||||
|
|
||||||
|
|
|
@ -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))))
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue