From 6777fc31a3a0cda49dc8e346c230cb61ecc2c072 Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Fri, 19 Feb 2010 04:59:05 +0000
Subject: [PATCH] Rewrite this a little to make it clear that we're now only
 checking the super class's beta-methods vector to make sure this is even an
 overrideable method.

svn: r18181
---
 collects/scheme/private/class-internal.ss | 29 +++++++++++------------
 1 file changed, 14 insertions(+), 15 deletions(-)

diff --git a/collects/scheme/private/class-internal.ss b/collects/scheme/private/class-internal.ss
index 4c32a2e4b7..3d7fab704e 100644
--- a/collects/scheme/private/class-internal.ss
+++ b/collects/scheme/private/class-internal.ss
@@ -2142,22 +2142,21 @@
                 
                 ;; -- Extract superclass methods and make rename-inners ---
                 (let ([rename-supers (map (lambda (index mname)
+                                              ;; While the last part of the vector is indeed the right
+                                              ;; method, if there have been super contracts placed since,
+                                              ;; they won't be reflected there, only in the super-methods
+                                              ;; vector of the superclass.
                                             (let ([vec (vector-ref (class-beta-methods super) index)])
-                                              (if (positive? (vector-length vec))
-                                                  ;; While the last part of the vector is indeed the right
-                                                  ;; method, if there have been super contracts placed since,
-                                                  ;; they won't be reflected there, only in the super-methods
-                                                  ;; vector of the superclass.
-                                                  (if (vector-ref vec (sub1 (vector-length vec)))
-                                                      (vector-ref (class-super-methods super) index)
-                                                      (obj-error 'class* 
-                                                                 (string-append
-                                                                  "superclass ~e method for override, overment, inherit/super, "
-                                                                  "or rename-super is not overrideable: ~a~a")
-                                                                 super
-                                                                 mname
-                                                                 (for-class name)))
-                                                  (vector-ref (class-super-methods super) index))))
+                                              (when (and (positive? (vector-length vec))
+                                                         (not (vector-ref vec (sub1 (vector-length vec)))))
+                                                (obj-error 'class* 
+                                                           (string-append
+                                                            "superclass ~e method for override, overment, inherit/super, "
+                                                            "or rename-super is not overrideable: ~a~a")
+                                                           super
+                                                           mname
+                                                           (for-class name))))
+                                            (vector-ref (class-super-methods super) index))
                                           rename-super-indices
                                           rename-super-names)]
                       [rename-inners (let ([new-augonly (make-vector method-width #f)])