www

commit 92f18c3978111863419f9e624823940f6b0ad93b
parent e572113b0ca8f3c46e2107d9b22a53884b86d8c7
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Tue,  9 May 2017 20:08:58 +0200

Fixed tests

Diffstat:
M
main.rkt
 | 
26
++++++++++++++------------
M
test/test-2-require.rkt
 | 
12
++++++++----
M
test/test-require.rkt
 | 
13
++++++-------

3 files changed, 28 insertions(+), 23 deletions(-)
diff --git a/main.rkt b/main.rkt
@@ -63,13 +63,15 @@
          ...]
         ...)
      #:with ((old-generated-id ...) ...)
-     (map (λ (id meanings) (map (λ (meaning) (gen-id id meaning)) meanings))
+     (map (λ (id meanings) (map (λ (meaning) (gen-id id (syntax-e meaning)))
+                                (syntax->list meanings)))
           (syntax->list #'(old-id ...))
-          (map syntax-e (syntax->list #'((meaning ...) ...))))
-     #:with (new-generated-id ...)
-     (map (λ (id meanings) (map (λ (meaning) (gen-id id meaning)) meanings))
+          (syntax->list #'((meaning ...) ...)))
+     #:with ((new-generated-id ...) ...)
+     (map (λ (id meanings) (map (λ (meaning) (gen-id id (syntax-e meaning)))
+                                (syntax->list meanings)))
           (syntax->list #'(new-id ...))
-          (map syntax-e (syntax->list #'((meaning ...) ...))))
+          (syntax->list #'((meaning ...) ...)))
      #:with (new-id-no-duplicates ...)
      (remove-duplicates (syntax->list #'(new-id ...))
                         free-identifier=?)
@@ -124,12 +126,12 @@
                        (map (λ (one-id) (gen-id one-id '| safeguard |))
                             (syntax->list #'(new-id ...)))])
           (register-meanings (syntax->datum #'(meaning ... ...)))
-          (expand-export #'(combine-out new-id ...
-                                        safeguard ...
-                                        (rename-out [old-generated-id
-                                                     new-generated-id]
-                                                    ... ...))
-                         modes))]))))
+          (pre-expand-export #'(combine-out new-id ...
+                                            safeguard ...
+                                            (rename-out [old-generated-id
+                                                         new-generated-id]
+                                                        ... ...))
+                             modes))]))))
 
 ;; Definition of polysemic identifiers and parts of these
 ;; _____________________________________________________________________________
@@ -267,7 +269,7 @@
     (for ([expanded (in-list expanded*)])
       (when (free-id-set-member? covered-ids expanded)
         (raise-syntax-error 'polysemy
-                            "Overlap between function cases"
+                            "some available function cases overlap"
                             stx
                             #f
                             pred-ids))
diff --git a/test/test-2-require.rkt b/test/test-2-require.rkt
@@ -2,12 +2,16 @@
 
 (require polysemy
          rackunit
+         syntax/macro-testing
          (poly-rename-in "test-2-provide.rkt"
-                         [foo |(poly-case string?)| bar]
-                         [bar |(poly-case string?)| foo]))
+                         [[foo bar] |(poly-case string?)|]
+                         [[bar foo] |(poly-case string?)|]))
 
 (check-equal? (foo 1) 11)
 (check-equal? (foo "abc") "bar-abc")
 (check-equal? (bar 1) 21)
 (check-equal? (bar "abc") 3)
-(baz "abc")
-\ No newline at end of file
+(check-exn #px"overlap"
+           (λ ()
+             (convert-compile-time-error
+              (baz "abc"))))
+\ No newline at end of file
diff --git a/test/test-require.rkt b/test/test-require.rkt
@@ -1,15 +1,15 @@
 #lang racket
 
-(provide (poly-out [baz identifier-macro match-expander]))
-
 (require polysemy
          rackunit)
 
+(provide (poly-out [baz identifier-macro match-expander]))
+
 (require (poly-rename-in "test-provide.rkt"
-                         [foo identifier-macro baz])
+                         [(foo baz) identifier-macro])
          (poly-rename-in "test-provide-b.rkt"
-                         [bar identifier-macro foo]
-                         [bar match-expander baz]
+                         [(bar foo) identifier-macro]
+                         [(bar baz) match-expander]
                          [foo match-expander]))
 
 (define-poly bar identifier-macro (λ (stx) #'"overridden bar"))
@@ -36,4 +36,4 @@
               '((a aa aaa) (b bb bbb)))
 
 (check-equal? (my-macro2 a aa aaa foo b bb bbb)
-              '((a aa aaa) 42 (b bb bbb)))
-\ No newline at end of file
+              '((a aa aaa) 42 (b bb bbb)))