inner default expr shouldn't evaluate when a target is available

svn: r3094

collects/mzlib/private/class-internal.ss

@@ -1877,12 +1877,10 @@
 						   augment-names)
 					 (map (lambda (mname index)
 						(let ([depth (get-depth index)])
-						  (lambda (obj default)
-						    (let* ([rename-inner (vector-ref (vector-ref (class-beta-methods (object-ref obj)) 
-												 index)
-										     depth)])
-						      (or rename-inner
-							  (lambda args default))))))
+						  (lambda (obj)
+						    (vector-ref (vector-ref (class-beta-methods (object-ref obj)) 
+									    index)
+								depth))))
 					      rename-inner-names
 					      rename-inner-indices))])
 		    ;; -- Create method accessors --

collects/mzlib/private/classidmap.ss

@@ -1,6 +1,5 @@
 
 (module classidmap mzscheme
-
   (require (lib "stx.ss" "syntax"))
 
   (define-values (struct:s!t make-s!t s!t? s!t-ref s!t-set!)
@@ -207,8 +206,10 @@
      (let ([target (find the-finder the-obj stx)])
        (datum->syntax-object 
 	the-finder
-	(make-method-apply (list (find the-finder rename-temp stx) target default-expr)
-			   target args)
+	`(let ([i (,(find the-finder rename-temp stx) ,target)])
+	   (if i
+	       ,(make-method-apply 'i target args)
+	       ,default-expr))
 	stx))
      stx))
 

collects/tests/mzscheme/object.ss

@@ -500,6 +500,23 @@
 (test '(9 (13 (15 (6 (3 24))))) 'bjt (send (new bjjbjfoo-jbjjbgoo%) goo 24))
 (test '(14 (12 (8 (10 (20 (7 25)))))) 'bjt (send (new bjjbjfoo-jbjjbgoo%) hoo 25))
 
+;; ----------------------------------------
+;; Make sure inner default isn't called when augment is available:
+
+(let ([x 0])
+  (define c% (class object%
+	       (define/pubment (m v)
+		 (inner (set! x (+ x v)) m v))
+	       (super-new)))
+  (define d% (class c%
+	       (define/augment (m v)
+		 (list v))
+	       (super-new)))
+  (test (void) 'no-inner (send (new c%) m 5))
+  (test 5 values x)
+  (test '(6) 'inner (send (new d%) m 6))
+  (test 5 values x))
+
 ;; ----------------------------------------
 
 (define rest-arg-fish%