From f40c7f11a6a11c9e7afe1c02b2826ebd7626edbd Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Sat, 14 Jul 2012 20:40:30 -0400
Subject: [PATCH] Mutable data at typed boundaries can't have flat contracts.

Closes PR 12884.
---
 .../tests/typed-racket/fail/predicate-box.rkt   | 13 +++++++++++++
 collects/typed-racket/private/type-contract.rkt | 17 ++++++++---------
 2 files changed, 21 insertions(+), 9 deletions(-)
 create mode 100644 collects/tests/typed-racket/fail/predicate-box.rkt

diff --git a/collects/tests/typed-racket/fail/predicate-box.rkt b/collects/tests/typed-racket/fail/predicate-box.rkt
new file mode 100644
index 0000000000..483641774e
--- /dev/null
+++ b/collects/tests/typed-racket/fail/predicate-box.rkt
@@ -0,0 +1,13 @@
+#lang typed/racket
+
+(define: b : (Boxof Any) (box 4))
+
+(define-predicate boxof-integer? (Boxof Integer))
+
+(define (set-b-box! v) (set-box! b v))
+
+(: a-very-listy-integer (-> Integer))
+(define (a-very-listy-integer)
+  (cond [(boxof-integer? b)  (set-b-box! '(1 2 3))
+                             (unbox b)]
+        [else  (error 'a-very-listy-integer "can't happen")]))
diff --git a/collects/typed-racket/private/type-contract.rkt b/collects/typed-racket/private/type-contract.rkt
index a6b82e9a13..1475968885 100644
--- a/collects/typed-racket/private/type-contract.rkt
+++ b/collects/typed-racket/private/type-contract.rkt
@@ -188,13 +188,11 @@
 	[(Set: t) #`(set/c #,(t->c t))]
         [(Sequence: ts) #`(sequence/c #,@(map t->c ts))]
         [(Vector: t)
-         (if flat?
-             #`(vectorof #,(t->c t #:flat #t) #:flat? #t)
-             #`(vectorof #,(t->c t)))]
+         (when flat? (exit (fail)))
+         #`(vectorof #,(t->c t))]
         [(Box: t)
-         (if flat?
-             #`(box/c #,(t->c t #:flat #t) #:flat? #t)
-             #`(box/c #,(t->c t)))]
+         (when flat? (exit (fail)))
+         #`(box/c #,(t->c t))]
         [(Pair: t1 t2)
          #`(cons/c #,(t->c t1) #,(t->c t2))]
         [(Opaque: p? cert)
@@ -238,6 +236,8 @@
             =>
             cdr]
            [proc (exit (fail))]
+           [(and flat? (ormap values mut?))
+            (exit (fail))]
            [poly?
             (with-syntax* ([(rec blame val) (generate-temporaries '(rec blame val))]
                            [maker maker-id]
@@ -283,9 +283,8 @@
         [(Value: v) #`(flat-named-contract #,(format "~a" v) (lambda (x) (equal? x '#,v)))]
         [(Param: in out) #`(parameter/c #,(t->c out))]
 	[(Hashtable: k v)
-         (if flat?
-             #`(hash/c #,(t->c k #:flat #t) #,(t->c v #:flat #t) #:flat? #t #:immutable 'dont-care)
-             #`(hash/c #,(t->c k) #,(t->c v) #:immutable 'dont-care))]
+         (when flat? (exit (fail)))                  
+         #`(hash/c #,(t->c k) #,(t->c v) #:immutable 'dont-care)]
         [else
          (exit (fail))]))))