From b97811d4dbb1548c66f64ac31d94d3b51c21d665 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 12 Oct 2018 20:36:53 -0400
Subject: [PATCH] improve error checking in the `struct` form of `contract-out`

closes #2303
---
 .../tests/racket/contract/contract-out.rkt    | 16 ++++++++++++
 .../racket/contract/private/helpers.rkt       | 26 ++++++++++++-------
 .../racket/contract/private/provide.rkt       |  2 ++
 3 files changed, 34 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 6fd55553cc..2a57383134 100644
--- a/pkgs/racket-test/tests/racket/contract/contract-out.rkt
+++ b/pkgs/racket-test/tests/racket/contract/contract-out.rkt
@@ -1230,6 +1230,22 @@
       (eval '(dynamic-require ''provide/contract66-m2 #f)))
    "provide/contract66-m1")
 
+  (contract-error-test
+   'provide/contract-struct-out
+   #'(begin
+       (eval '(module pos racket/base
+                (require racket/contract)
+                (provide
+                 (contract-out
+                  [struct (b not-a) ()])
+
+                 (struct a ())
+                 (struct b a ())))))
+   (λ (x)
+     (and (exn:fail:syntax? x)
+          (regexp-match #rx"^contract-out: expected a struct name"
+                        (exn-message x)))))
+
   (contract-error-test
    'contract-error-test8
    #'(begin
diff --git a/racket/collects/racket/contract/private/helpers.rkt b/racket/collects/racket/contract/private/helpers.rkt
index ce12964d00..0504bdd667 100644
--- a/racket/collects/racket/contract/private/helpers.rkt
+++ b/racket/collects/racket/contract/private/helpers.rkt
@@ -23,16 +23,22 @@
 
 ;; lookup-struct-info : syntax -> (union #f (list syntax syntax (listof syntax) ...))
 (define (lookup-struct-info stx provide-stx)
-  (let ([id (syntax-case stx ()
-              [(a b) (syntax a)]
-              [_ stx])])
-    (let ([v (syntax-local-value id (λ () #f))])
-      (if (struct-info? v)
-          (extract-struct-info v)
-          (raise-syntax-error 'provide/contract
-                              "expected a struct name" 
-                              provide-stx
-                              id)))))
+  (define id (syntax-case stx ()
+               [(a b) (syntax a)]
+               [_ stx]))
+  (define v (syntax-local-value id (λ () #f)))
+  (define error-name
+    (syntax-case provide-stx ()
+      [(x . y)
+       (identifier? #'x)
+       (syntax-e #'x)]
+      [_ 'provide/contract]))
+  (if (struct-info? v)
+      (extract-struct-info v)
+      (raise-syntax-error error-name
+                          "expected a struct name"
+                          provide-stx
+                          id)))
 
 
 (define (add-name-prop name stx)
diff --git a/racket/collects/racket/contract/private/provide.rkt b/racket/collects/racket/contract/private/provide.rkt
index 742161fc26..9d48166fc5 100644
--- a/racket/collects/racket/contract/private/provide.rkt
+++ b/racket/collects/racket/contract/private/provide.rkt
@@ -684,6 +684,8 @@
 
                 [all-parent-struct-count/names 
                  (get-field-counts/struct-names struct-name provide-stx)]
+                [_ (and (syntax? super-id)
+                        (a:lookup-struct-info super-id provide-stx))] ;; for the error check
                 [parent-struct-count (if (null? all-parent-struct-count/names)
                                          #f
                                          (let ([pp (cdr all-parent-struct-count/names)])