Fix bug in #:defined-table implementation, add test for #:defined-table

pkgs/racket-test/tests/generic/defined-table.rkt

@@ -0,0 +1,63 @@
+#lang racket/base
+
+(require racket/generic)
+
+(define-generics cost
+  (money-cost cost)
+  (time-cost cost)
+  (happiness-cost cost)
+  #:defined-table cost-types)
+
+(struct food (name price calories)
+  #:methods gen:cost
+  [(define (money-cost x)
+     (food-price x))
+   (define (happiness-cost x)
+     ;; Guilt from eating too many calories
+     (/ (- (max (food-calories x) 1000) 1000) 200))])
+
+(struct laundry (num-loads)
+  #:methods gen:cost
+  [(define (money-cost x)
+     (* (laundry-num-loads x) 3))
+   (define (time-cost x)
+     ;; It's really annoying to start laundry, but subsequent loads are okay
+     (+ 5 (laundry-num-loads x)))])
+
+(define methods
+  (hash 'money-cost money-cost
+        'time-cost time-cost
+        'happiness-cost happiness-cost))
+
+(define (total-cost stuff)
+  (for/sum ([thing stuff])
+    (define supported-costs (cost-types thing))
+    (for/sum ([cost-type (hash-keys methods)])
+      (if (hash-ref supported-costs cost-type)
+          ((hash-ref methods cost-type) thing)
+          0))))
+
+(module+ test
+  (require rackunit rackunit/text-ui racket/port)
+
+  (define (check-basics table)
+    (check-true (hash? table))
+    (for ([method (hash-keys table)])
+      (check-true (symbol? method))
+      (check-true (boolean? (hash-ref table method)))))
+
+  (define pizza (food 'pizza 8 1200))
+  (define stuff (list pizza (laundry 1)))
+  (parameterize {[current-output-port (open-output-nowhere)]}
+    (run-tests
+     (test-suite
+      "defined-table"
+      (check-basics (cost-types pizza))
+      (check-true (hash-ref (cost-types pizza) 'money-cost))
+      (check-false (hash-ref (cost-types pizza) 'time-cost))
+      (check-true (hash-ref (cost-types pizza) 'happiness-cost))
+
+      (check-basics (cost-types (car stuff)))
+      (check-basics (cost-types (cadr stuff)))
+      (check-equal? (total-cost stuff) 18)))
+    (void)))

pkgs/racket-test/tests/generic/tests.rkt

@@ -3,6 +3,7 @@
 (require (submod "custom-hash.rkt" test)
          (submod "alist.rkt" test)
          (submod "from-docs.rkt" test)
+         (submod "defined-table.rkt" test)
          (submod "stream.rkt" test)
          (submod "iterator.rkt" test)
          (submod "struct-form.rkt" test)

racket/collects/racket/generic.rkt

@@ -152,7 +152,7 @@
          (if table
              (with-syntax ([table-name table])
                #'(define (table-name name)
-                   (for/hasheq ([sym (in-list '(method ...))])
+                   (for/hasheq ([sym (in-list '(method-name ...))])
                      (values sym (support-name name sym)))))
              #'(begin)))
        #'(begin