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

print value of the super class in error messages

Browse Source 
svn: r16482
This commit is contained in:
Jon Rafkind 2009-10-30 17:50:15 +00:00
parent 9aa2075961
commit f99c5f276c
1 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/scheme/private/class-internal.ss
View File

@ -1831,7 +1831,7 @@
;; -- Check superclass -- ;; -- Check superclass --
(unless (class? super) (unless (class? super)
(obj-error 'class* "superclass expression returned a non-class: ~a~a" (obj-error 'class* "superclass expression ~e returned a non-class: ~a"
super super
(for-class name))) (for-class name)))
@ -1919,7 +1919,8 @@
(let loop ([ids public-names][p (class-method-width super)]) (let loop ([ids public-names][p (class-method-width super)])
(unless (null? ids) (unless (null? ids)
(when (hash-ref method-ht (car ids) #f) (when (hash-ref method-ht (car ids) #f)
(obj-error 'class* "superclass already contains method: ~a~a" (obj-error 'class* "superclass ~e already contains method: ~a~a"
super
(car ids) (car ids)
(for-class name))) (for-class name)))
(hash-set! method-ht (car ids) p) (hash-set! method-ht (car ids) p)
@ -1928,7 +1929,8 @@
(let loop ([ids public-field-names][p (class-field-width super)]) (let loop ([ids public-field-names][p (class-field-width super)])
(unless (null? ids) (unless (null? ids)
(when (hash-ref field-ht (car ids) #f) (when (hash-ref field-ht (car ids) #f)
(obj-error 'class* "superclass already contains field: ~a~a" (obj-error 'class* "superclass ~e already contains field: ~a~a"
super
(car ids) (car ids)
(for-class name))) (for-class name)))
(hash-set! field-ht (car ids) p) (hash-set! field-ht (car ids) p)
@ -1937,7 +1939,8 @@
;; Check that superclass has expected fields ;; Check that superclass has expected fields
(for-each (lambda (id) (for-each (lambda (id)
(unless (hash-ref field-ht id #f) (unless (hash-ref field-ht id #f)
(obj-error 'class* "superclass does not provide field: ~a~a" (obj-error 'class* "superclass ~e does not provide field: ~a~a"
super
id id
(for-class name)))) (for-class name))))
inherit-field-names) inherit-field-names)
@ -2120,8 +2123,9 @@
(or (vector-ref vec (sub1 (vector-length vec))) (or (vector-ref vec (sub1 (vector-length vec)))
(obj-error 'class* (obj-error 'class*
(string-append (string-append
"superclass method for override, overment, inherit/super, " "superclass ~e method for override, overment, inherit/super, "
"or rename-super is not overrideable: ~a~a") "or rename-super is not overrideable: ~a~a")
super
mname mname
(for-class name))) (for-class name)))
(vector-ref (class-methods super) index)))) (vector-ref (class-methods super) index))))
@ -2152,8 +2156,9 @@
(unless aug-ok? (unless aug-ok?
(obj-error 'class* (obj-error 'class*
(string-append (string-append
"superclass method for augride, augment, inherit/inner, " "superclass ~e method for augride, augment, inherit/inner, "
"or rename-inner method is not augmentable: ~a~a") "or rename-inner method is not augmentable: ~a~a")
super
mname mname
(for-class name))))))]) (for-class name))))))])
(for-each (check-aug #f) (for-each (check-aug #f)