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

make chaperone-of?' accept prop:equal+hash'

Browse Source 
There appears to be no reason to block equality based on
`prop:equal+hash' when using `chaperone-of?'.
This commit is contained in:
Matthew Flatt 2012-10-16 12:10:49 -04:00
parent b8f5776797
commit 755cd47cc5
2 changed files with 23 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/tests/racket/chaperone.rktl
View File

@ -1072,11 +1072,14 @@
(define (a-impersonator-of v) (a-x v))
(define a-equal+hash (list
(lambda (v1 v2 equal?)
(equal? (a-y v1) (a-y v2)))
(equal? (aa-y v1) (aa-y v2)))
(lambda (v1 hash)
(hash (a-y v1)))
(hash (aa-y v1)))
(lambda (v2 hash)
(hash (a-y v2)))))
(hash (aa-y v2)))))
(define (aa-y v) (if (a? v) (a-y v) (pre-a-y v)))
(define-struct pre-a (x y)
#:property prop:equal+hash a-equal+hash)
(define-struct a (x y)
#:property prop:impersonator-of a-impersonator-of
#:property prop:equal+hash a-equal+hash)
@ -1087,12 +1090,19 @@
#:property prop:equal+hash a-equal+hash)
(let ([a1 (make-a #f 2)])
(test #t equal? (make-pre-a 17 1) (make-pre-a 18 1))
(test #t chaperone-of? (make-pre-a 17 1) (make-pre-a 18 1))
(test #t chaperone-of? (chaperone-struct (make-pre-a 17 1) pre-a-y (lambda (a v) v)) (make-pre-a 18 1))
(test #f chaperone-of? (make-pre-a 18 1) (chaperone-struct (make-pre-a 17 1) pre-a-y (lambda (a v) v)))
(test #t impersonator-of? (make-pre-a 17 1) (make-pre-a 18 1))
(test #f chaperone-of? (make-pre-a 17 1) (make-pre-a 17 2))
(test #t equal? (make-a #f 2) a1)
(test #t equal? (make-a-more #f 2 7) a1)
(test #t equal? (make-a-new-impersonator #f 2) a1)
(test #f equal? (make-a-new-equal #f 2) a1)
(test #f equal? (make-a #f 3) a1)
(test #f impersonator-of? (make-a #f 2) a1)
(test #t impersonator-of? (make-a #f 2) a1)
(test #t chaperone-of? (make-a #f 2) a1)
(test #t impersonator-of? (make-a a1 3) a1)
(test #t impersonator-of? (make-a-more a1 3 8) a1)
(test #f chaperone-of? (make-a a1 3) a1)

22
src/racket/src/bool.c
View File

@ -401,9 +401,9 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
return cmp;
if (eql->for_chaperone
&& SCHEME_CHAPERONEP(obj1)
&& (!(SCHEME_CHAPERONE_FLAGS((Scheme_Chaperone *)obj1) & SCHEME_CHAPERONE_IS_IMPERSONATOR)
|| (eql->for_chaperone > 1))) {
&& SCHEME_CHAPERONEP(obj1)
&& (!(SCHEME_CHAPERONE_FLAGS((Scheme_Chaperone *)obj1) & SCHEME_CHAPERONE_IS_IMPERSONATOR)
|| (eql->for_chaperone > 1))) {
obj1 = ((Scheme_Chaperone *)obj1)->prev;
goto top;
}
@ -527,16 +527,12 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
if (procs2) obj2 = procs2;
goto top;
} else {
if (eql->for_chaperone) {
procs1 = NULL;
} else {
procs1 = scheme_struct_type_property_ref(scheme_equal_property, (Scheme_Object *)st1);
if (procs1 && (st1 != st2)) {
procs2 = scheme_struct_type_property_ref(scheme_equal_property, (Scheme_Object *)st2);
if (!procs2
|| !SAME_OBJ(SCHEME_VEC_ELS(procs1)[0], SCHEME_VEC_ELS(procs2)[0]))
procs1 = NULL;
}
procs1 = scheme_struct_type_property_ref(scheme_equal_property, (Scheme_Object *)st1);
if (procs1 && (st1 != st2)) {
procs2 = scheme_struct_type_property_ref(scheme_equal_property, (Scheme_Object *)st2);
if (!procs2
|| !SAME_OBJ(SCHEME_VEC_ELS(procs1)[0], SCHEME_VEC_ELS(procs2)[0]))
procs1 = NULL;
}
if (procs1) {