suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Check that we have an object before trying to unwrap it in class-field-*.

Browse Source 
svn: r18443
This commit is contained in:
Stevie Strickland 2010-03-03 14:39:44 +00:00
parent ce23d92a95
commit 3fb2e1d9ae
1 changed files with 6 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/scheme/private/class-internal.ss
View File

@ -3695,11 +3695,15 @@
(values (λ (class name) (values (λ (class name)
(let* ([p (check-and-get-index 'class-field-accessor class name)] (let* ([p (check-and-get-index 'class-field-accessor class name)]
[ref (vector-ref (class-ext-field-refs class) p)]) [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) (λ (class name)
(let* ([p (check-and-get-index 'class-field-mutator class name)] (let* ([p (check-and-get-index 'class-field-mutator class name)]
[set (vector-ref (class-ext-field-sets class) p)]) [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)) (define-struct generic (name applicable))