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

Fix method accessors for inherits and abstracts

Browse Source 
Closes PR 13798
This commit is contained in:
Asumu Takikawa 2013-05-29 13:06:24 -04:00
parent 6b2a4ff54d
commit 6988b2e138
2 changed files with 18 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1302,11 +1302,8 @@
(append local-public-dynamic-names (append local-public-dynamic-names
(map car all-inherits)))] (map car all-inherits)))]
[(method-accessor ...) (generate-temporaries [(method-accessor ...) (generate-temporaries
(map car (append local-public-dynamic-names
(append publics overrides augrides (map car all-inherits)))]
overments augments
override-finals augment-finals
all-inherits abstracts)))]
[(inherit-field-accessor ...) (generate-temporaries [(inherit-field-accessor ...) (generate-temporaries
(map (lambda (id) (map (lambda (id)
(format "get-~a" (format "get-~a"
@ -2432,7 +2429,7 @@
(append new-normal-indices replace-normal-indices refine-normal-indices (append new-normal-indices replace-normal-indices refine-normal-indices
replace-augonly-indices refine-augonly-indices replace-augonly-indices refine-augonly-indices
replace-final-indices refine-final-indices replace-final-indices refine-final-indices
inherit-indices new-abstract-indices))]) new-abstract-indices inherit-indices))])
;; -- Get new methods and initializers -- ;; -- Get new methods and initializers --
(let-values ([(new-methods override-methods augride-methods init) (let-values ([(new-methods override-methods augride-methods init)

15
collects/tests/racket/object.rktl
View File

@ -849,6 +849,21 @@
(define/pubment (sum) number)) (define/pubment (sum) number))
exn:fail:object?) exn:fail:object?)
;; example from PR 13798
(let ()
(define test%
(class object% (super-new)
(define/public (name) "test")))
(define sub-abstract%
(class test% (super-new) (inherit name)
(abstract broken)
(define/public (full-name) (string-append (name) "subabs"))))
(define sub-concrete%
(class sub-abstract% (super-new)
(define/override (broken) "broken")))
(test "testsubabs" 'pr13798 (send (new sub-concrete%) full-name)))
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
;; Test send/apply dotted send and method-call forms: ;; Test send/apply dotted send and method-call forms: