From 3fb2e1d9ae95ccb271da40e512ba3f6f8efb5865 Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Wed, 3 Mar 2010 14:39:44 +0000 Subject: [PATCH] Check that we have an object before trying to unwrap it in class-field-*. svn: r18443 --- collects/scheme/private/class-internal.ss | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/collects/scheme/private/class-internal.ss b/collects/scheme/private/class-internal.ss index d64eebcdeb..f0513acdbf 100644 --- a/collects/scheme/private/class-internal.ss +++ b/collects/scheme/private/class-internal.ss @@ -3695,11 +3695,15 @@ (values (λ (class name) (let* ([p (check-and-get-index 'class-field-accessor class name)] [ref (vector-ref (class-ext-field-refs class) p)]) - (λ (o) (ref ((object-unwrapper o) o))))) + (λ (o) (if (object? o) + (ref ((object-unwrapper o) o)) + (raise-type-error 'class-field-accessor "object" o))))) (λ (class name) (let* ([p (check-and-get-index 'class-field-mutator class name)] [set (vector-ref (class-ext-field-sets class) p)]) - (λ (o v) (set ((object-unwrapper o) o) v))))))) + (λ (o v) (if (object? o) + (set ((object-unwrapper o) o) v) + (raise-type-error 'class-field-mutator "object" o)))))))) (define-struct generic (name applicable))