1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

Changes from arch/CVS synchronization

This commit is contained in:
Ludovic Courtès 2007-08-08 14:56:02 +00:00
parent 416fe978b0
commit 3ba9acb1b4
4 changed files with 27 additions and 13 deletions

View file

@ -1,3 +1,12 @@
2007-08-08 Ludovic Courtès <ludo@gnu.org>
* boot-9.scm (%record-type-check): Renamed to
`%record-type-error'.
(record-accessor): Directly use `struct-vtable' and
`struct-ref', thereby avoiding indirections and procedure-call
overhead.
(record-modifier): Likewise.
2007-05-05 Ludovic Courtès <ludo@chbouib.org>
Implemented lazy duplicate binding handling. Fixed the

View file

@ -429,7 +429,7 @@
(define (record-predicate rtd)
(lambda (obj) (and (struct? obj) (eq? rtd (struct-vtable obj)))))
(define (%record-type-check rtd obj) ;; private helper
(define (%record-type-error rtd obj) ;; private helper
(or (eq? rtd (record-type-descriptor obj))
(scm-error 'wrong-type-arg "%record-type-check"
"Wrong type record (want `~S'): ~S"
@ -441,8 +441,9 @@
(if (not pos)
(error 'no-such-field field-name))
(local-eval `(lambda (obj)
(%record-type-check ',rtd obj)
(struct-ref obj ,pos))
(if (eq? (struct-vtable obj) ,rtd)
(struct-ref obj ,pos)
(%record-type-error ,rtd obj)))
the-root-environment)))
(define (record-modifier rtd field-name)
@ -450,8 +451,9 @@
(if (not pos)
(error 'no-such-field field-name))
(local-eval `(lambda (obj val)
(%record-type-check ',rtd obj)
(struct-set! obj ,pos val))
(if (eq? (struct-vtable obj) ,rtd)
(struct-set! obj ,pos val)
(%record-type-error ,rtd obj)))
the-root-environment)))

View file

@ -1,3 +1,10 @@
2007-08-08 Ludovic Courtès <ludo@gnu.org>
* tests/srfi-9.test (exception:not-a-record): Removed.
(accessor)[get-x on number, get-y on number]: Expect
`exception:wrong-type-arg' instead of `exception:not-a-record'.
(modifier)[set-y! on number]: Likewise
2007-07-25 Ludovic Courtès <ludo@gnu.org>
* tests/srfi-17.test (%some-variable): New.

View file

@ -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 Free Software Foundation, Inc.
;;;; Copyright (C) 2001, 2006, 2007 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
@ -23,10 +23,6 @@
#:use-module (srfi srfi-9))
(define exception:not-a-record
(cons 'misc-error "^not-a-record"))
(define-record-type :foo (make-foo x) foo?
(x get-x) (y get-y set-y!))
@ -61,9 +57,9 @@
(pass-if "get-y"
(= 2 (get-y f)))
(pass-if-exception "get-x on number" exception:not-a-record
(pass-if-exception "get-x on number" exception:wrong-type-arg
(get-x 999))
(pass-if-exception "get-y on number" exception:not-a-record
(pass-if-exception "get-y on number" exception:wrong-type-arg
(get-y 999))
;; prior to guile 1.6.9 and 1.8.1 this wan't enforced
@ -78,7 +74,7 @@
(set-y! f #t)
(eq? #t (get-y f)))
(pass-if-exception "set-y! on number" exception:not-a-record
(pass-if-exception "set-y! on number" exception:wrong-type-arg
(set-y! 999 #t))
;; prior to guile 1.6.9 and 1.8.1 this wan't enforced