parent
032b1871d1
commit
e4f0b69b72
|
@ -2495,6 +2495,38 @@
|
||||||
'neg)])
|
'neg)])
|
||||||
(f 6)))))
|
(f 6)))))
|
||||||
|
|
||||||
|
;; ----------------------------------------
|
||||||
|
;; Check that property-only impersonator does not
|
||||||
|
;; interfere with `chaperone-of?`
|
||||||
|
;; (Test provided by Vincent)
|
||||||
|
|
||||||
|
(let ()
|
||||||
|
(define-values (prop has-prop? get-prop)
|
||||||
|
(make-impersonator-property 'prop))
|
||||||
|
|
||||||
|
(define add1* (impersonate-procedure add1 #f
|
||||||
|
prop #f))
|
||||||
|
|
||||||
|
(test #t chaperone-of? (chaperone-procedure add1* #f)
|
||||||
|
add1*)
|
||||||
|
(test #t chaperone-of? (chaperone-procedure add1* (lambda (x) x))
|
||||||
|
add1*)
|
||||||
|
|
||||||
|
(test #f chaperone-of? (chaperone-procedure add1* #f)
|
||||||
|
add1)
|
||||||
|
(test #f chaperone-of? (chaperone-procedure add1* (lambda (x) x))
|
||||||
|
add1)
|
||||||
|
|
||||||
|
(test #t impersonator-of? (chaperone-procedure add1* #f)
|
||||||
|
add1*)
|
||||||
|
(test #t impersonator-of? (chaperone-procedure add1* (lambda (x) x))
|
||||||
|
add1*)
|
||||||
|
|
||||||
|
(test #t impersonator-of? (chaperone-procedure add1* #f)
|
||||||
|
add1)
|
||||||
|
(test #t impersonator-of? (chaperone-procedure add1* (lambda (x) x))
|
||||||
|
add1))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(report-errs)
|
(report-errs)
|
||||||
|
|
|
@ -575,6 +575,8 @@ int is_equal (Scheme_Object *obj1, Scheme_Object *obj2, Equal_Info *eql)
|
||||||
|
|
||||||
if (eql->for_chaperone
|
if (eql->for_chaperone
|
||||||
&& SCHEME_CHAPERONEP(obj2)
|
&& SCHEME_CHAPERONEP(obj2)
|
||||||
|
&& (!(SCHEME_CHAPERONE_FLAGS((Scheme_Chaperone *)obj2) & SCHEME_CHAPERONE_IS_IMPERSONATOR)
|
||||||
|
|| (eql->for_chaperone > 1))
|
||||||
&& scheme_is_noninterposing_chaperone(obj2)) {
|
&& scheme_is_noninterposing_chaperone(obj2)) {
|
||||||
obj2 = ((Scheme_Chaperone *)obj2)->prev;
|
obj2 = ((Scheme_Chaperone *)obj2)->prev;
|
||||||
goto top_after_next;
|
goto top_after_next;
|
||||||
|
|
Loading…
Reference in New Issue
Block a user