From cfd1f46fa2f2233b3e94c4bc90d979b8d7fe1648 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 13 May 2014 20:15:48 -0500
Subject: [PATCH] fix bug in flat struct/dc predicate implementation

---
 .../tests/racket/contract/struct-dc.rkt       | 24 +++++++++++++++++++
 .../racket/contract/private/struct-dc.rkt     | 11 ++++++---
 2 files changed, 32 insertions(+), 3 deletions(-)

diff --git a/pkgs/racket-pkgs/racket-test/tests/racket/contract/struct-dc.rkt b/pkgs/racket-pkgs/racket-test/tests/racket/contract/struct-dc.rkt
index b5feb5278a..9c62bae8ab 100644
--- a/pkgs/racket-pkgs/racket-test/tests/racket/contract/struct-dc.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/racket/contract/struct-dc.rkt
@@ -1088,6 +1088,30 @@
       ((struct/dc s [f any/c] #:inv (f) (equal? f 11)) (s 11)))
    #t)
   
+  (test/spec-passed/result
+   'struct/dc-inv8
+   '(let ()
+      (struct node (v l r))
+      ((struct/dc node
+                  [v any/c]
+                  [l any/c]
+                  [r any/c]
+                  #:inv (l r) #f)
+       (node #f #f #f)))
+   #f)
+  
+  (test/spec-passed/result
+   'struct/dc-inv9
+   '(let ()
+      (struct node (v l r))
+      ((struct/dc node
+                  [v any/c]
+                  [l any/c]
+                  [r any/c]
+                  #:inv (l r) #t)
+       (node #f #f #f)))
+   #t)
+  
   (contract-error-test
    'struct/dc-imp-nondep-runtime-error
    '(let ()
diff --git a/racket/collects/racket/contract/private/struct-dc.rkt b/racket/collects/racket/contract/private/struct-dc.rkt
index 9a78c8aabe..9cbe90192f 100644
--- a/racket/collects/racket/contract/private/struct-dc.rkt
+++ b/racket/collects/racket/contract/private/struct-dc.rkt
@@ -179,16 +179,21 @@
               (define subc (car subcs))
               (cond
                 [(invariant? subc)
-                 (apply (invariant-dep-proc subc) args)]
+                 (and (apply (invariant-dep-proc subc) args)
+                      (loop (cdr subcs) args))]
                 [else
                  (define val ((subcontract-ref subc) v))
+                 (define next-args 
+                   (if (subcontract-depended-on? subc)
+                       (cons val args)
+                       args))
                  (cond
                    [(indep? subc)
                     (and ((flat-contract-predicate (indep-ctc subc)) val)
-                         (loop (cdr subcs) (cons val args)))]
+                         (loop (cdr subcs) next-args))]
                    [else
                     (and ((flat-contract-predicate (apply (dep-dep-proc subc) args)) val)
-                         (loop (cdr subcs) (cons val args)))])])])))))
+                         (loop (cdr subcs) next-args))])])])))))
 
 (define (struct/dc-first-order ctc)
   (base-struct/dc-pred ctc))