diff --git a/collects/racket/private/generic.rkt b/collects/racket/private/generic.rkt index 9bde0182e0..e8e153811c 100644 --- a/collects/racket/private/generic.rkt +++ b/collects/racket/private/generic.rkt @@ -127,7 +127,8 @@ (generate-temporary 'get-generics))] ;; for each generic method, builds a cond clause to do the ;; predicate dispatch found in method-impl-list - [((cond-impl ...) ...) marked-generics]) + [((cond-impl ...) ...) marked-generics] + [(-name?) (generate-temporaries #'(name?))]) #`(begin (define-syntax name (list #'prop:name #'generic ...)) ; XXX optimize no kws or opts @@ -197,15 +198,16 @@ (lambda given-args (define this (list-ref given-args generic-this-idx)) (cond - ;; default cases - [(pred? this) (apply cond-impl given-args)] - ... - ;; Fallthrough - [(name? this) + [#,(if prop-defined-already? + #'(name? this) + #'(-name? this)) (let ([m (vector-ref (get-generics this) generic-idx)]) (if m (apply m given-args) (error 'generic "not implemented for ~e" this)))] + ;; default cases + [(pred? this) (apply cond-impl given-args)] + ... [else (raise-argument-error 'generic name-str this)]))))) ...)))])) diff --git a/collects/scribblings/reference/generic.scrbl b/collects/scribblings/reference/generic.scrbl index a3aa87d2eb..0dd3b6dba3 100644 --- a/collects/scribblings/reference/generic.scrbl +++ b/collects/scribblings/reference/generic.scrbl @@ -69,7 +69,7 @@ availability. When @racket[maybe-defaults] is provided, each generic function uses @racket[pred?]s to dispatch to the given default implementations, -@racket[method-impl]s, before dispatching to the generic method table. +@racket[method-impl]s, if dispatching to the generic method table fails. The syntax of the @racket[method-impl]s is the same as the methods provided for the @racket[#:methods] keyword for @racket[struct].} diff --git a/collects/tests/generic/defaults.rkt b/collects/tests/generic/defaults.rkt index 3826a3751f..ce8252accc 100644 --- a/collects/tests/generic/defaults.rkt +++ b/collects/tests/generic/defaults.rkt @@ -41,3 +41,24 @@ (check-false (stream-empty? l4)) (check-equal? (stream-first l4) 1) (check-equal? (stream-first (stream-rest l4)) 2)) + +(struct a ()) + +(define-generics bool-able + (to-bool bool-able) + #:defaults + ([a? (define (to-bool a) #t)])) + +(struct b a () + #:methods gen:bool-able + [(define (to-bool b) #f)]) + +(module+ test + (define my-a (a)) + (define my-b (b)) + + (check-true (bool-able? my-a)) + (check-true (bool-able? my-b)) + + (check-true (to-bool my-a)) + (check-false (to-bool my-b)))