racket/class: add missing check for #<unsafe-undefined>

When a superclass method is called before the superclass
is initialized, then all field accesses need to be guarded.

Robby found this one.
This commit is contained in:
Matthew Flatt 2014-08-06 08:46:51 +01:00
parent 698c22ef9d
commit f4c1d7ec03
2 changed files with 33 additions and 19 deletions

View File

@ -1927,6 +1927,11 @@
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; check error reporting for variable use before assignment
(define (make-undefined-exn? name)
(lambda (exn)
(and (exn:fail:contract:variable? exn)
(eq? name (exn:fail:contract:variable-id exn)))))
(let ()
(define c%
(class object%
@ -1962,21 +1967,25 @@
(field [s 1])
(super-new)))
(err/rt-test (new d%) (lambda (exn)
(and (exn:fail:contract:variable? exn)
(eq? 'z (exn:fail:contract:variable-id exn)))))
(err/rt-test (new d!%) (lambda (exn)
(and (exn:fail:contract:variable? exn)
(eq? 'z (exn:fail:contract:variable-id exn)))))
(err/rt-test (new e%) (lambda (exn)
(and (exn:fail:contract:variable? exn)
(eq? 'z (exn:fail:contract:variable-id exn)))))
(err/rt-test (new d2%) (lambda (exn)
(and (exn:fail:contract:variable? exn)
(eq? 'f (exn:fail:contract:variable-id exn)))))
(err/rt-test (new e2%) (lambda (exn)
(and (exn:fail:contract:variable? exn)
(eq? 'f (exn:fail:contract:variable-id exn))))))
(err/rt-test (new d%) (make-undefined-exn? 'z))
(err/rt-test (new d!%) (make-undefined-exn? 'z))
(err/rt-test (new e%) (make-undefined-exn? 'z))
(err/rt-test (new d2%) (make-undefined-exn? 'f))
(err/rt-test (new e2%) (make-undefined-exn? 'f)))
(let ()
(define c%
(class object%
(field [s #f])
(define/public (set-s)
(set! s #f))
(super-new)))
(define d%
(class c%
(inherit set-s)
(set-s)
(super-new)))
(err/rt-test (new d%) (make-undefined-exn? 's)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; check optimization to omit use-before-definition chaperone:

View File

@ -124,10 +124,15 @@
(free-identifier=? #'decl #'declare-this-escapes))
;; Any method call or explicit use of `this` means a field
;; might be accessed outside of the `class` declaration,
;; so any initialization afterward is too late:
(begin
(when ready (set! init-too-late? #t))
(loop #'(begin . body)))]
;; so `super-new` had better be done, and any initialization
;; afterward is too late:
(or (and ready
(not super-new?)
(report #'body)
#t)
(begin
(when ready (set! init-too-late? #t))
(loop #'(begin . body))))]
[(begin '(decl) . body)
(and (identifier? #'decl)