From 27132ee0614955e25c5f1b80ed7f491ffca2de36 Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Tue, 18 Nov 2014 13:54:39 -0500
Subject: [PATCH] Relax parsing of `All` types and type annotations

Closes PR 14839
---
 .../typed-racket/base-env/colon.rkt           |  2 --
 .../typed-racket/private/parse-classes.rkt    |  2 +-
 .../typed-racket/unit-tests/all-tests.rkt     |  3 +-
 .../unit-tests/parse-type-tests.rkt           |  4 +++
 .../typed-racket/unit-tests/prims-tests.rkt   | 29 +++++++++++++++++++
 5 files changed, 36 insertions(+), 4 deletions(-)
 create mode 100644 pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/prims-tests.rkt

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/colon.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/colon.rkt
index 76ae0de387..aacd2d3607 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/colon.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/colon.rkt
@@ -32,8 +32,6 @@
     [(: id (~and kw :) . more:omit-parens)
      (add-disappeared-use #'kw)
      (wrap stx #`(:-helper #,stx #,top-level? id more.type))]
-    [(: id : . more)
-     (wrap stx #`(:-helper #,stx #,top-level? id . more))]
     [(: e ...)
      (wrap stx #`(:-helper #,stx #,top-level? e ...))]))
 
diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-classes.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-classes.rkt
index 06ac9c5631..79a58759a3 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-classes.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-classes.rkt
@@ -38,5 +38,5 @@
   ;;        or with #:fail-when. -- AT
   (pattern (~and (:->^ x y ~! z ...) (~fail))
            #:with type 'dummy)
-  (pattern (~and type ((~or (~once :->^) (~not :->^)) ...)))
+  (pattern (~and type ((~or (~between :->^ 1 +inf.0) (~not :->^)) ...)))
   (pattern (type)))
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt
index c28d87d77a..61e6f16296 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt
@@ -41,4 +41,5 @@
   "filter-tests.rkt"
   "metafunction-tests.rkt"
   "generalize-tests.rkt"
-  "rep-tests.rkt")
+  "rep-tests.rkt"
+  "prims-tests.rkt")
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt
index 44eb2b264a..e16ca15e0b 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/parse-type-tests.rkt
@@ -99,7 +99,11 @@
    [(-> (values Number Boolean Number)) (t:-> (-values (list N B N)))]
    [(Number -> Number) (t:-> N N)]
    [(All (A) Number -> Number) (-poly (a) (t:-> N N))]
+   [(All (A) Number -> Number -> Number) (-poly (a) (t:-> N (t:-> N N)))]
+   [(All (A) Number -> Number -> Number -> Number)
+    (-poly (a) (t:-> N (t:-> N (t:-> N N))))]
    [FAIL (All (A) -> Number Number)]
+   [FAIL (All (A) Listof Any)]
    [(All (A) (Number -> Number)) (-poly (a) (t:-> N N))]
    [(All (A) (-> Number Number)) (-poly (a) (t:-> N N))]
    [(All (A) A -> A) (-poly (a) (t:-> a a))]
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/prims-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/prims-tests.rkt
new file mode 100644
index 0000000000..500761fa42
--- /dev/null
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/prims-tests.rkt
@@ -0,0 +1,29 @@
+#lang racket/base
+
+;; Tests for Typed Racket primitive macros
+
+(require "test-utils.rkt"
+         (base-env base-types-extra)
+         (base-env prims)
+         rackunit
+         unstable/macro-testing)
+
+(provide tests)
+(gen-test-main)
+
+(define-syntax-rule (check-ok exp)
+  (check-not-exn (λ () (convert-compile-time-error exp))))
+(define-syntax-rule (check-bad exp regex)
+  (check-exn regex (λ () (convert-compile-time-error exp))))
+
+;; These tests don't run the type-checker, they just correct expansion
+;; and error checking in primitive macros
+(define tests
+  (test-suite "Prims tests"
+    (check-bad (let () (: x : Listof Any) 'dummy)
+               #rx"multiple types")
+    (check-bad (let () (: x : -> String String) 'dummy)
+               #rx"multiple types")
+    (check-ok (let () (: x : String -> String -> String)
+                      (define x 0)
+                      'dummy))))