From 888d681ecba2ad8d9f9ea42a26247e0d13089ca3 Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Thu, 23 Jan 2014 11:36:44 -0500
Subject: [PATCH] Allow other kinds of for clauses in for/hash:

Closes PR 14306

original commit: 120ce62bbb27e10d3f55c9c99cbd14d7cba9fd22
---
 .../typed-racket/base-env/prims.rkt             |  8 ++++----
 .../typed-racket/unit-tests/typecheck-tests.rkt | 17 +++++++++++++++++
 2 files changed, 21 insertions(+), 4 deletions(-)

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
index 75f7f1fa..37b35fc2 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt
@@ -1057,12 +1057,12 @@ This file defines two sorts of primitives. All of them are provided into any mod
     (syntax-parse stx
       #:literals (:)
       ((_ (~seq : return-annotation:expr)
-          (bind:optionally-annotated-binding ...)
+          clause:for-clauses
           body ...) ; body is not always an expression, can be a break-clause
        (quasisyntax/loc stx
          (for/fold: : return-annotation
            ((return-hash : return-annotation (ann (#,hash-maker null) return-annotation)))
-           (bind ...)
+           (clause.expand ... ...)
            (let-values (((key val) (let () body ...)))
              (hash-set return-hash key val))))))))
 
@@ -1075,12 +1075,12 @@ This file defines two sorts of primitives. All of them are provided into any mod
     (syntax-parse stx
       #:literals (:)
       ((_ (~seq : return-annotation:expr)
-          (bind:optionally-annotated-binding ...)
+          clause:for-clauses
           body ...) ; body is not always an expression, can be a break-clause
        (quasisyntax/loc stx
          (for*/fold: : return-annotation
            ((return-hash : return-annotation (ann (#,hash-maker null) return-annotation)))
-           (bind ...)
+           (clause.expand* ... ...)
            (let-values (((key val) (let () body ...)))
              (hash-set return-hash key val))))))))
 
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
index 331b7331..d021e1cb 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
@@ -1918,6 +1918,23 @@
          (call-with-values (lambda () (eval #'(+ 1 2))) (inst list Any))
          (-lst Univ)]
 
+       ;; for/hash, for*/hash - PR 14306
+       [tc-e (for/hash: : (HashTable Symbol String)
+               ([x (in-list '(x y z))]
+                [y (in-list '("a" "b" "c"))]
+                #:when (eq? x 'x))
+               (values x y))
+             #:ret (ret (-HT -Symbol -String)
+                        (-FS -top -top)
+                        (make-NoObject))]
+       [tc-e (for*/hash: : (HashTable Symbol String)
+               ([k (in-list '(x y z))]
+                [v (in-list '("a" "b"))]
+                #:when (eq? k 'x))
+               (values k v))
+             #:ret (ret (-HT -Symbol -String)
+                        (-FS -top -top)
+                        (make-NoObject))]
         )
   (test-suite
    "tc-literal tests"