From 8c5c8da1a7e8c63460125d5cde3cdc5e1240a09c Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sun, 5 Feb 2017 14:31:59 -0600
Subject: [PATCH] fix fast path to not ignore pre/post conditions and bail out
 appropriately

---
 .../tests/racket/contract/contract-out.rkt     | 18 ++++++++++++++++--
 .../contract/private/arrow-val-first.rkt       | 13 ++++++++-----
 .../racket/contract/private/provide.rkt        | 11 ++++++++---
 3 files changed, 32 insertions(+), 10 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/contract/contract-out.rkt b/pkgs/racket-test/tests/racket/contract/contract-out.rkt
index c13dd6e1b6..679a377922 100644
--- a/pkgs/racket-test/tests/racket/contract/contract-out.rkt
+++ b/pkgs/racket-test/tests/racket/contract/contract-out.rkt
@@ -1196,8 +1196,22 @@
                (f)))
       (eval '(dynamic-require ''provide/contract64-m2 #f)))
    "provide/contract64-m1")
-   
-  
+
+  (test/spec-failed
+   'provide/contract65
+   '(let ()
+      (eval '(module provide/contract65-m1 racket/base
+               (require racket/contract/base)
+               (provide
+                (contract-out
+                 [f (->* () () #:pre/desc "get-apples not allowed" any)]))
+               (define (f) (values #t #t))))
+      (eval '(module provide/contract65-m2 racket/base
+               (require 'provide/contract65-m1)
+               (f)))
+      (eval '(dynamic-require ''provide/contract65-m2 #f)))
+   "provide/contract65-m2")
+
   (contract-error-test
    'contract-error-test8
    #'(begin
diff --git a/racket/collects/racket/contract/private/arrow-val-first.rkt b/racket/collects/racket/contract/private/arrow-val-first.rkt
index 58de3e034b..d36604a0ec 100644
--- a/racket/collects/racket/contract/private/arrow-val-first.rkt
+++ b/racket/collects/racket/contract/private/arrow-val-first.rkt
@@ -830,11 +830,14 @@
     (parse->* stx this->*))
   (with-syntax ([((mandatory-dom-kwd mandatory-dom-kwd-ctc) ...) man-dom-kwds]
                 [((optional-dom-kwd optional-dom-kwd-ctc) ...) opt-dom-kwds])
-    (valid-app-shapes-from-man/opts (length (syntax->list man-dom))
-                                    (length (syntax->list opt-dom))
-                                    rest-ctc
-                                    (syntax->datum #'(mandatory-dom-kwd ...))
-                                    (syntax->datum #'(optional-dom-kwd ...)))))
+    (cond
+      [(or pre pre/desc post post/desc) #f]
+      [else
+       (valid-app-shapes-from-man/opts (length (syntax->list man-dom))
+                                       (length (syntax->list opt-dom))
+                                       rest-ctc
+                                       (syntax->datum #'(mandatory-dom-kwd ...))
+                                       (syntax->datum #'(optional-dom-kwd ...)))])))
 
 (define-syntax (->* stx)
   (syntax-case stx ()
diff --git a/racket/collects/racket/contract/private/provide.rkt b/racket/collects/racket/contract/private/provide.rkt
index c301b37bce..4e6c2559ee 100644
--- a/racket/collects/racket/contract/private/provide.rkt
+++ b/racket/collects/racket/contract/private/provide.rkt
@@ -283,9 +283,14 @@
       [(-> . _) 
        (not (->-arity-check-only->? ctrct))
        (values #t (->-valid-app-shapes ctrct))]
-      [(->* . _) 
-       (values (not (->*-arity-check-only->? ctrct))
-               (->*-valid-app-shapes ctrct))]
+      [(->* . _)
+       (cond
+         [(->*-arity-check-only->? ctrct) (values #f #f)]
+         [else
+          (define shapes (->*-valid-app-shapes ctrct))
+          (if shapes
+              (values #t shapes)
+              (values #f #f))])]
       [(->i . _) (values #t (->i-valid-app-shapes ctrct))]
       [_ (values #f #f)]))
   (with-syntax ([id id]