From f15c0f545be3dd4b1da92824b1bf782e3571b4a6 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 16 Jan 2015 12:55:48 +0100 Subject: [PATCH] slot-ref, slot-set! et al bypass "using-class" variants * module/oop/goops.scm (slot-ref, slot-set!, slot-bound?, slot-exists?): Bypass slot-ref-using-class, slot-set-using-class!, and so on. Those interfaces are public and have to check that the class is indeed a class, they should check that the object is an instance of the class, and so on, whereas if we get the class via class-of we know that the invariant holds. --- module/oop/goops.scm | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/module/oop/goops.scm b/module/oop/goops.scm index 4464daa29..1babb09f8 100644 --- a/module/oop/goops.scm +++ b/module/oop/goops.scm @@ -897,19 +897,35 @@ followed by its associated value. If @var{l} does not hold a value for (define (slot-ref obj slot-name) "Return the value from @var{obj}'s slot with the nam var{slot_name}." - (slot-ref-using-class (class-of obj) obj slot-name)) + (unless (symbol? slot-name) + (scm-error 'wrong-type-arg #f "Not a symbol: ~S" + (list slot-name) #f)) + (let* ((class (class-of obj)) + (val (get-slot-value-using-name class obj slot-name))) + (if (unbound? val) + (slot-unbound class obj slot-name) + val))) (define (slot-set! obj slot-name value) "Set the slot named @var{slot_name} of @var{obj} to @var{value}." - (slot-set-using-class! (class-of obj) obj slot-name value)) + (unless (symbol? slot-name) + (scm-error 'wrong-type-arg #f "Not a symbol: ~S" + (list slot-name) #f)) + (set-slot-value-using-name! (class-of obj) obj slot-name value)) (define (slot-bound? obj slot-name) "Return the value from @var{obj}'s slot with the nam var{slot_name}." - (slot-bound-using-class? (class-of obj) obj slot-name)) + (unless (symbol? slot-name) + (scm-error 'wrong-type-arg #f "Not a symbol: ~S" + (list slot-name) #f)) + (not (unbound? (get-slot-value-using-name (class-of obj) obj slot-name)))) (define (slot-exists? obj slot-name) "Return @code{#t} if @var{obj} has a slot named @var{slot_name}." - (slot-exists-using-class? (class-of obj) obj slot-name)) + (unless (symbol? slot-name) + (scm-error 'wrong-type-arg #f "Not a symbol: ~S" + (list slot-name) #f)) + (test-slot-existence (class-of obj) obj slot-name)) -- 2.20.1