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

repair impersonator-porperty predicate and accessor

Browse Source 
Repair for b923269569, helpfully reported again by Scott
This commit is contained in:
Matthew Flatt 2015-03-09 15:33:41 -06:00
parent 5749d4080c
commit 332b380ca2
2 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
pkgs/racket-test-core/tests/racket/chaperone.rktl
View File

@ -1730,6 +1730,9 @@
(test #t blue? (make-a (chaperone-struct a1 struct:a prop:blue 'color) 2)) (test #t blue? (make-a (chaperone-struct a1 struct:a prop:blue 'color) 2))
(test 'color blue-ref (make-a (chaperone-struct a1 struct:a prop:blue 'color) 2)) (test 'color blue-ref (make-a (chaperone-struct a1 struct:a prop:blue 'color) 2))
(test #f blue? a1)
(err/rt-test (blue-ref a1))
(void))) (void)))
;; ---------------------------------------- ;; ----------------------------------------

8
racket/src/racket/src/struct.c
View File

@ -1022,9 +1022,11 @@ static Scheme_Object *prop_pred(int argc, Scheme_Object **args, Scheme_Object *p
be via `prop:impersonator-of`: */ be via `prop:impersonator-of`: */
Scheme_Object *procs; Scheme_Object *procs;
procs = scheme_struct_type_property_ref(scheme_impersonator_of_property, v); procs = scheme_struct_type_property_ref(scheme_impersonator_of_property, v);
if (procs) if (procs) {
v = scheme_apply_impersonator_of(0, procs, v); v = scheme_apply_impersonator_of(0, procs, v);
else if (!v)
return scheme_false;
} else
return scheme_false; return scheme_false;
} else } else
break; break;
@ -1179,6 +1181,8 @@ static Scheme_Object *do_chaperone_prop_accessor(const char *who, Scheme_Object
procs = scheme_struct_type_property_ref(scheme_impersonator_of_property, arg); procs = scheme_struct_type_property_ref(scheme_impersonator_of_property, arg);
if (procs) { if (procs) {
arg = scheme_apply_impersonator_of(0, procs, arg); arg = scheme_apply_impersonator_of(0, procs, arg);
if (!arg)
return NULL;
/* loop to try again */ /* loop to try again */
} else { } else {
/* an impersonator property lives at the impersonator/chaperone level, only: */ /* an impersonator property lives at the impersonator/chaperone level, only: */