From 44783b9f8e08392d0f1fc3f9fd6dce50f497132d Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Tue, 22 May 2012 18:32:43 -0400
Subject: [PATCH] Add tests from unstable/generics.

---
 collects/tests/generics/from-unstable.rkt | 140 +++++++++++++++++++++
 collects/tests/generics/tests.rkt         |   3 +-
 collects/tests/unstable/generics.rkt      | 146 ----------------------
 3 files changed, 142 insertions(+), 147 deletions(-)
 create mode 100644 collects/tests/generics/from-unstable.rkt
 delete mode 100644 collects/tests/unstable/generics.rkt

diff --git a/collects/tests/generics/from-unstable.rkt b/collects/tests/generics/from-unstable.rkt
new file mode 100644
index 0000000000..ff705dc2ba
--- /dev/null
+++ b/collects/tests/generics/from-unstable.rkt
@@ -0,0 +1,140 @@
+#lang racket
+(require racket/generics
+         tests/eli-tester)
+
+(define (massq idx l)
+  (match l
+    [(mcons (and v (mcons (? (curry equal? idx)) _)) _)
+     v]
+    [(mcons _ rst)
+     (massq idx rst)]
+    [null
+     #f]))
+
+(test
+ (local
+   [(define-generics (lots)
+      (f #:foo foo lots zog [def]))
+    
+    (define-struct ex ()
+      #:methods gen:lots
+      [(define (f #:foo foo lots zog [def #t])
+         1)])]
+   (test
+    (f #:foo 3 (make-ex) 2) => 1
+    (f (make-ex) #:foo 3 2) => 1
+    (f (make-ex) 2 #:foo 3) => 1))
+ 
+ (local
+   [(define-generics (lots)
+      (f #:foo foo lots zog #:def [def]))
+    
+    (define-struct ex ()
+      #:methods gen:lots
+      [(define (f #:foo foo lots zog #:def [def #t])
+         1)])]
+   (test
+    (f #:foo 3 (make-ex) 2) => 1
+    (f (make-ex) 4 #:foo 3 #:def 2) => 1
+    (f (make-ex) 3 #:foo 1) => 1))
+ 
+ (local
+   [(define-generics (lots)
+      (f lots idx val))
+    
+    (define-struct ex ()
+      #:methods gen:lots
+      [(define/generic gen:f f)
+       (define (f lots idx val)
+         (if (zero? idx)
+             val
+             (gen:f lots (sub1 idx) (* 2 val))))])]
+   (test
+    (f (make-ex) 4 1) => (expt 2 4)))
+ 
+ (local 
+   [(define-generics (table)
+      (get table idx [default])
+      (weird-get idx table)
+      (put! table idx new))
+    
+    (define-struct alist ([l #:mutable])
+      #:methods gen:table
+      ((define (get table idx [default #f])
+         (cond [(massq idx (alist-l table)) => mcdr]
+               [else default]))
+       (define (weird-get idx table)
+         (get table idx))
+       (define (put! table idx new)
+         (let* ([l (alist-l table)]
+                [prev (massq idx l)])
+           (if prev
+               (set-mcar! prev new)
+               (set-alist-l! table (mcons (mcons idx new) (alist-l table))))))))]
+   
+   (test
+    (make-alist empty)
+    
+    (get (make-alist empty) 'foo) => #f
+    
+    (local [(define t (make-alist empty))]
+      (put! t 'foo 1)
+      (get t 'foo))
+    =>
+    1
+    
+    (weird-get 'foo (make-alist empty)) => #f
+    
+    (local [(define t (make-alist empty))]
+      (put! t 'foo 1)
+      (weird-get 'foo t))
+    =>
+    1))
+ 
+ (test
+  (define-generics (table)
+    (get idx [default]))
+  =error>
+  "No required by-position generic argument"
+  
+  (define-generics (table)
+    (get idx [table] [default]))
+  =error>
+  "No required by-position generic argument")
+ 
+ 
+ (local [(define-generics (printable)
+           (gen-print printable [port])
+           (gen-port-print port printable)
+           (gen-print* printable [port] #:width width #:height [height]))
+         
+         (define-struct num (v)
+           #:methods gen:printable
+           ((define/generic super-print gen-print)
+            (define (gen-print n [port (current-output-port)])
+              (fprintf port "Num: ~a" (num-v n)))
+            (define (gen-port-print port n)
+              (super-print n port))
+            (define (gen-print* n [port (current-output-port)] #:width w #:height [h 0])
+              (fprintf port "Num (~ax~a): ~a" w h (num-v n)))))
+         
+         (define-struct bool (v)
+           #:methods gen:printable
+           ((define/generic super-print gen-print)
+            (define (gen-print b [port (current-output-port)])
+              (fprintf port "Bool ~a" (if (bool-v b) "Yes" "No")))
+            (define (gen-port-print port b)
+              (super-print b port))
+            (define (gen-print* b [port (current-output-port)] #:width w #:height [h 0])
+              (fprintf port "Bool (~ax~a): ~a" w h (if (bool-v b) "Yes" "No")))))
+         
+         (define x (make-num 10))
+         (define y (make-bool #t))]
+   (test
+    (gen-print x)
+    (gen-port-print (current-output-port) x)
+    (gen-print* x #:width 100 #:height 90)
+    
+    (gen-print y)
+    (gen-port-print (current-output-port) y)
+    (gen-print* y #:width 100 #:height 90))))
diff --git a/collects/tests/generics/tests.rkt b/collects/tests/generics/tests.rkt
index d71849001e..c9c71cb071 100644
--- a/collects/tests/generics/tests.rkt
+++ b/collects/tests/generics/tests.rkt
@@ -6,4 +6,5 @@
          (submod "coercion.rkt" test)
          (submod "stream.rkt" test)
          (submod "iterator.rkt" test)
-         (submod "struct-form.rkt" test))
+         (submod "struct-form.rkt" test)
+         "from-unstable.rkt")
diff --git a/collects/tests/unstable/generics.rkt b/collects/tests/unstable/generics.rkt
deleted file mode 100644
index 9344ded5cb..0000000000
--- a/collects/tests/unstable/generics.rkt
+++ /dev/null
@@ -1,146 +0,0 @@
-#lang racket
-(require unstable/generics
-         tests/eli-tester)
-
-(define (massq idx l)
-  (match l
-    [(mcons (and v (mcons (? (curry equal? idx)) _)) _)
-     v]
-    [(mcons _ rst)
-     (massq idx rst)]
-    [null
-     #f]))
-
-(test
- (local
-   [(define-generics (lots prop:lots lots?)
-      (f #:foo foo lots zog [def]))
-    
-    (define-struct ex ()
-      #:property prop:lots
-      (methods lots
-        (define (f #:foo foo lots zog [def #t])
-          1)))]
-   (test
-    (f #:foo 3 (make-ex) 2) => 1
-    (f (make-ex) #:foo 3 2) => 1
-    (f (make-ex) 2 #:foo 3) => 1))
- 
- (local
-   [(define-generics (lots prop:lots lots?)
-      (f #:foo foo lots zog #:def [def]))
-    
-    (define-struct ex ()
-      #:property prop:lots
-      (methods lots
-        (define (f #:foo foo lots zog #:def [def #t])
-          1)))]
-   (test
-    (f #:foo 3 (make-ex) 2) => 1
-    (f (make-ex) 4 #:foo 3 #:def 2) => 1
-    (f (make-ex) 3 #:foo 1) => 1))
- 
- (local
-   [(define-generics (lots prop:lots lots?)
-      (f lots idx val))
-    
-    (define-struct ex ()
-      #:property prop:lots
-      (methods lots
-        (define/generic gen:f f)
-        (define (f lots idx val)
-          (if (zero? idx)
-              val
-              (gen:f lots (sub1 idx) (* 2 val))))))]
-   (test
-    (f (make-ex) 4 1) => (expt 2 4)))
- 
- (local 
-   [(generics table
-              (get table idx [default])
-              (weird-get idx table)
-              (put! table idx new))
-    
-    (define-struct alist ([l #:mutable])
-      #:property prop:table
-      (methods table
-        (define (get table idx [default #f])
-          (cond [(massq idx (alist-l table)) => mcdr]
-                [else default]))
-        (define (weird-get idx table)
-          (get table idx))
-        (define (put! table idx new)
-          (let* ([l (alist-l table)]
-                 [prev (massq idx l)])
-            (if prev
-                (set-mcar! prev new)
-                (set-alist-l! table (mcons (mcons idx new) (alist-l table))))))))]
-   
-   (test
-    (make-alist empty)
-    
-    (get (make-alist empty) 'foo) => #f
-    
-    (local [(define t (make-alist empty))]
-      (put! t 'foo 1)
-      (get t 'foo))
-    =>
-    1
-    
-    (weird-get 'foo (make-alist empty)) => #f
-    
-    (local [(define t (make-alist empty))]
-      (put! t 'foo 1)
-      (weird-get 'foo t))
-    =>
-    1))
- 
- (test
-  (generics table
-            (get idx [default]))
-  =error>
-  "No required by-position generic argument"
-  
-  (generics table
-            (get idx [table] [default]))
-  =error>
-  "No required by-position generic argument")
- 
- 
- (local [(define-generics (printable prop:printable printable?)
-           (gen-print printable [port])
-           (gen-port-print port printable)
-           (gen-print* printable [port] #:width width #:height [height]))
-         
-         (define-struct num (v)
-           #:property prop:printable
-           (methods printable
-             (define/generic super-print gen-print)
-             (define (gen-print n [port (current-output-port)])
-               (fprintf port "Num: ~a" (num-v n)))
-             (define (gen-port-print port n)
-               (super-print n port))
-             (define (gen-print* n [port (current-output-port)] #:width w #:height [h 0])
-               (fprintf port "Num (~ax~a): ~a" w h (num-v n)))))
-         
-         (define-struct bool (v)
-           #:property prop:printable
-           (methods printable
-             (define/generic super-print gen-print)
-             (define (gen-print b [port (current-output-port)])
-               (fprintf port "Bool ~a" (if (bool-v b) "Yes" "No")))
-             (define (gen-port-print port b)
-               (super-print b port))
-             (define (gen-print* b [port (current-output-port)] #:width w #:height [h 0])
-               (fprintf port "Bool (~ax~a): ~a" w h (if (bool-v b) "Yes" "No")))))
-         
-         (define x (make-num 10))
-         (define y (make-bool #t))]
-   (test
-    (gen-print x)
-    (gen-port-print (current-output-port) x)
-    (gen-print* x #:width 100 #:height 90)
-    
-    (gen-print y)
-    (gen-port-print (current-output-port) y)
-    (gen-print* y #:width 100 #:height 90))))