From 48ac219d6fa56165fa7641eca8d74f30d609781c Mon Sep 17 00:00:00 2001
From: Eric Dobson <eric.n.dobson@gmail.com>
Date: Mon, 2 Jun 2014 22:30:55 -0700
Subject: [PATCH] Correctly combine or filters in combine-props.

Closes PR 14534.
---
 .../typecheck/tc-metafunctions.rkt            |  4 +-
 .../typed-racket/unit-tests/all-tests.rkt     |  1 +
 .../unit-tests/metafunction-tests.rkt         | 44 +++++++++++++++++++
 3 files changed, 47 insertions(+), 2 deletions(-)
 create mode 100644 pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/metafunction-tests.rkt

diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt
index 55bdf81fdc..49edcd36db 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt
@@ -218,10 +218,10 @@
                       (cond
                         [(null? ps) (apply -or result)]
                         [(for/or ([other-p (in-list (append derived-formulas derived-atoms))])
-                             (complementary? (car ps) other-p))
+                           (contradictory? (car ps) other-p))
                          (or-loop (cdr ps) result)]
                         [(for/or ([other-p (in-list derived-atoms)])
-                             (implied-atomic? (car ps) other-p))
+                           (implied-atomic? (car ps) other-p))
                          -top]
                         [else (or-loop (cdr ps) (cons (car ps) result))]))])
                (if (OrFilter? new-or)
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt
index d3409d85af..6135a5583f 100644
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/all-tests.rkt
@@ -39,4 +39,5 @@
   "check-below-tests.rkt"
   "init-env-tests.rkt"
   "filter-tests.rkt"
+  "metafunction-tests.rkt"
   "rep-tests.rkt")
diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/metafunction-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/metafunction-tests.rkt
new file mode 100644
index 0000000000..9394637819
--- /dev/null
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/metafunction-tests.rkt
@@ -0,0 +1,44 @@
+#lang racket/base
+
+(require "test-utils.rkt"
+         rackunit racket/format
+         (types abbrev union filter-ops)
+         (typecheck tc-metafunctions)
+         (for-syntax racket/base syntax/parse))
+
+(provide tests)
+(gen-test-main)
+
+(define-syntax (test-combine-props stx)
+  (syntax-parse stx
+    [(_ new:expr existing:expr expected:expr box-v:expr)
+     (quasisyntax/loc stx
+       (test-case (~a '(new + existing = expected))
+         (define b (box #t))
+         (define-values (res-formulas res-props) (combine-props new existing b))
+         #,(syntax/loc stx (check-equal? (append res-formulas res-props) expected))
+         #,(syntax/loc stx (check-equal? (unbox b) box-v))))]))
+
+
+(define tests
+  (test-suite "Metafunctions"
+
+    (test-suite "combine-props"
+
+      (test-combine-props
+        (list (-or (-not-filter -String #'x) (-not-filter -String #'y)))
+        (list (-filter (Un -String -Symbol) #'x) (-filter (Un -String -Symbol) #'y))
+        (list (-or (-not-filter -String #'y) (-not-filter -String #'x))
+              (-filter (Un -String -Symbol) #'y) (-filter (Un -String -Symbol) #'x))
+        #t)
+
+      (test-combine-props
+        (list (-or (-filter -String #'x) (-filter -String #'y)))
+        (list (-filter (Un -String -Symbol) #'x) (-filter (Un -String -Symbol) #'y))
+        (list (-or (-filter -String #'y) (-filter -String #'x))
+              (-filter (Un -String -Symbol) #'y) (-filter (Un -String -Symbol) #'x))
+        #t)
+
+    )
+
+  ))