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

Actually turn on old object-info hack mentioned in 4e451a1.

Browse Source
This commit is contained in:
Stevie Strickland 2010-12-02 13:02:59 -05:00
parent 60d986b6df
commit 778f0c9fc4
3 changed files with 3 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/racket/private/class-internal.rkt
View File

@ -4157,7 +4157,7 @@
(trace-begin (trace-begin
(trace (inspect-event o)) (trace (inspect-event o))
(let ([o* (if (has-original-object? o) (original-object o) o)]) (let ([o* (if (has-original-object? o) (original-object o) o)])
(let loop ([c (object-ref o)] (let loop ([c (object-ref o*)]
[skipped? #f]) [skipped? #f])
(if (struct? ((class-insp-mk c))) (if (struct? ((class-insp-mk c)))
;; current objec can inspect this object ;; current objec can inspect this object

5
collects/tests/racket/contract-mzlib-test.rktl
View File

@ -2760,10 +2760,6 @@ of the contract library does not change over time.
(test #t (contract-eval 'is-a?) (contract-eval `(contract (object-contract) ,o 'pos 'neg)) i<%>) (test #t (contract-eval 'is-a?) (contract-eval `(contract (object-contract) ,o 'pos 'neg)) i<%>)
(test #t (contract-eval 'is-a?) (contract-eval `(contract (object-contract) ,o 'pos 'neg)) c%)) (test #t (contract-eval 'is-a?) (contract-eval `(contract (object-contract) ,o 'pos 'neg)) c%))
;; Currently the new object contracts using impersonators don't even attempt to ensure that
;; these reflective operations still work, and I'm not even sure they should. For now, I'll
;; just comment them out so that we can revive them if we decide that they should work.
#|
(let ([c% (parameterize ([current-inspector (make-inspector)]) (let ([c% (parameterize ([current-inspector (make-inspector)])
(contract-eval '(class object% (super-new))))]) (contract-eval '(class object% (super-new))))])
(test (list c% #f) (test (list c% #f)
@ -2785,7 +2781,6 @@ of the contract library does not change over time.
,obj ,obj
'pos 'pos
'neg)))) 'neg))))
|#
; ;
; ;

6
collects/tests/racket/contract-test.rktl
View File

@ -6045,8 +6045,8 @@
(test #t (contract-eval 'is-a?) (contract-eval `(contract (object-contract) ,o 'pos 'neg)) c%)) (test #t (contract-eval 'is-a?) (contract-eval `(contract (object-contract) ,o 'pos 'neg)) c%))
;; Currently the new object contracts using impersonators don't even attempt to ensure that ;; Currently the new object contracts using impersonators don't even attempt to ensure that
;; these reflective operations still work, and I'm not even sure they should. For now, I'll ;; these reflective operations still work, and I'm not even sure they should. For now, I
;; just comment them out so that we can revive them if we decide that they should work. ;; just get the class info from the original object, which means that all contracts are evaded.
;; ;;
;; Just as a note, if we move the class-insp-mk values forward in class/c-proj and make-wrapper-class, ;; Just as a note, if we move the class-insp-mk values forward in class/c-proj and make-wrapper-class,
;; we get a failure in object->vector for the second testcase because the field-ref/field-set! in the ;; we get a failure in object->vector for the second testcase because the field-ref/field-set! in the
@ -6054,7 +6054,6 @@
;; know how to get the fields out of the object struct. We can always force it with unsafe-struct-ref, ;; know how to get the fields out of the object struct. We can always force it with unsafe-struct-ref,
;; but if we had impersonate-struct-type, with the same ability to replace the prop:object as ;; but if we had impersonate-struct-type, with the same ability to replace the prop:object as
;; impersonate-struct has, then we might be able to handle this better. ;; impersonate-struct has, then we might be able to handle this better.
#|
(let ([c% (parameterize ([current-inspector (make-inspector)]) (let ([c% (parameterize ([current-inspector (make-inspector)])
(contract-eval '(class object% (super-new))))]) (contract-eval '(class object% (super-new))))])
(test (list c% #f) (test (list c% #f)
@ -6076,7 +6075,6 @@
,obj ,obj
'pos 'pos
'neg)))) 'neg))))
|#
; ;