From ae5bde175d17fbaaaa519592b9371b31ea768789 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Fri, 26 Apr 2013 09:28:46 -0500
Subject: [PATCH] fix is-a?/c opter

---
 collects/racket/contract/private/object.rkt |  2 +-
 collects/racket/contract/private/opters.rkt |  3 ++-
 collects/tests/racket/contract-test.rktl    | 19 +++++++++++++------
 3 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/collects/racket/contract/private/object.rkt b/collects/racket/contract/private/object.rkt
index fe19cd8823..176a5f7d9d 100644
--- a/collects/racket/contract/private/object.rkt
+++ b/collects/racket/contract/private/object.rkt
@@ -152,7 +152,7 @@
             #:lifts lifts2
             #:superlifts null
             #:partials null
-            #:flat #'(is-a? cls-x val)
+            #:flat #'(is-a? val cls-x)
             #:opt #f
             #:stronger-ribs '()
             #:chaperone #t
diff --git a/collects/racket/contract/private/opters.rkt b/collects/racket/contract/private/opters.rkt
index 0711687e04..b004964319 100644
--- a/collects/racket/contract/private/opters.rkt
+++ b/collects/racket/contract/private/opters.rkt
@@ -109,7 +109,8 @@
                  val
                  (raise-blame-error blame
                                     val
-                                    "none of the branches of the or/c matched"))))]
+                                    '("none of the branches of the or/c matched" given: "~e")
+                                    val))))]
          [(= (length hos) 1)
           (with-syntax ([ho-ctc ho-ctc]
                         [val (opt/info-val opt/info)])
diff --git a/collects/tests/racket/contract-test.rktl b/collects/tests/racket/contract-test.rktl
index 3c9decbe03..390bdd2846 100644
--- a/collects/tests/racket/contract-test.rktl
+++ b/collects/tests/racket/contract-test.rktl
@@ -12128,13 +12128,20 @@ so that propagation occurs.
                         (contract-eval `(class* object% (,i<%>) (super-new)))
                         #f))
 
-  (let ([i<%> (contract-eval '(interface ()))]
-        [c% (contract-eval '(class object% (super-new)))])
-    (test-flat-contract `(is-a?/c ,i<%>)
-                        (contract-eval `(new (class* object% (,i<%>) (super-new))))
+  (begin
+    (contract-eval '(define flat-is-a-test<%> (interface ())))
+    (contract-eval '(define flat-is-a-test% (class object% (super-new))))
+    (test-flat-contract `(is-a?/c flat-is-a-test<%>)
+                        (contract-eval `(new (class* object% (flat-is-a-test<%>) (super-new))))
                         (contract-eval '(new object%)))
-    (test-flat-contract `(is-a?/c ,c%)
-                        (contract-eval `(new ,c%))
+    (test-flat-contract `(is-a?/c flat-is-a-test%)
+                        (contract-eval `(new flat-is-a-test%))
+                        (contract-eval '(new object%)))
+    (test-flat-contract `(or/c #f (is-a?/c flat-is-a-test<%>))
+                        (contract-eval `(new (class* object% (flat-is-a-test<%>) (super-new))))
+                        (contract-eval '(new object%)))
+    (test-flat-contract `(or/c #f (is-a?/c flat-is-a-test%))
+                        (contract-eval `(new flat-is-a-test%))
                         (contract-eval '(new object%))))
 
   (test-flat-contract '(listof boolean?) (list #t #f) (list #f 3 #t))