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

more unexpected strange things broke, so disable new class/c yet again

Browse Source 
No joy in mudville. See
http://drdr.racket-lang.org/28175/ for details

Also fix (just introduced) infinite loop in class/c contract-name
implementation and tweak naming stuff a little so tests pass
This commit is contained in:
Robby Findler 2014-02-12 10:17:37 -06:00
parent c07141408f
commit 0c73784c3c
3 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-pkgs/racket-test/tests/racket/contract/name.rkt
View File

@ -336,7 +336,7 @@
c%/c)) c%/c))
(test-name '(class/c (field [f integer?])) (class/c (field [f integer?]))) (test-name '(class/c (field [f integer?])) (class/c (field [f integer?])))
(test-name '(class/c (field [f integer?])) (class/c (field [f integer?]))) (test-name '(class/c (field [f integer?])) (class/c (field [f integer?])))
(test-name '(class/c (init-field [f integer?])) (class/c (init-field [f integer?]))) (test-name '(class/c (init [f integer?]) (field [f integer?])) (class/c (init-field [f integer?])))
(test-name '(class/c (inherit-field [f integer?])) (class/c (inherit-field [f integer?]))) (test-name '(class/c (inherit-field [f integer?])) (class/c (inherit-field [f integer?])))
(test-name '(class/c (absent a b c (field d e f))) (class/c (absent a b c (field d e f)))) (test-name '(class/c (absent a b c (field d e f))) (class/c (absent a b c (field d e f))))
(test-name '(class/c (absent a b c)) (class/c (absent a b c))) (test-name '(class/c (absent a b c)) (class/c (absent a b c)))

4
racket/collects/racket/class.rkt
View File

@ -6,8 +6,8 @@
;; All of the implementation is actually in private/class-internal.rkt, ;; All of the implementation is actually in private/class-internal.rkt,
;; which provides extra (private) functionality to contract.rkt. ;; which provides extra (private) functionality to contract.rkt.
(require "private/class-internal.rkt" (require "private/class-internal.rkt"
(except-in "private/class-c-old.rkt" class/c) "private/class-c-old.rkt"
(rename-in "private/class-c-new.rkt" [class/c2 class/c])) "private/class-c-new.rkt")
(provide-public-names) (provide-public-names)
(provide generic?) (provide generic?)

4
racket/collects/racket/private/class-c-old.rkt
View File

@ -755,7 +755,7 @@
[else (coerce-contract 'class/c obj)]))) [else (coerce-contract 'class/c obj)])))
(define (build-class/c-name ctc) (define (build-class/c-name ctc)
(or (build-class/c-name ctc) (or (class/c-name ctc)
(let* ([handled-methods (let* ([handled-methods
(for/list ([i (in-list (class/c-methods ctc))] (for/list ([i (in-list (class/c-methods ctc))]
[ctc (in-list (class/c-method-contracts ctc))]) [ctc (in-list (class/c-method-contracts ctc))])
@ -812,7 +812,7 @@
[(null? fields) [(null? fields)
(list (cons 'absent meths))] (list (cons 'absent meths))]
[else [else
(list (list* 'absent (cons 'field fields) meths))])) (list `(absent ,@meths (field ,@fields)))]))
(define-struct class/c (define-struct class/c
(methods method-contracts fields field-contracts inits init-contracts (methods method-contracts fields field-contracts inits init-contracts