From 6ae082fccde11fdefe7b4a896f447240abb5a8a3 Mon Sep 17 00:00:00 2001
From: Alexis King <lexi.lambda@gmail.com>
Date: Thu, 4 Apr 2019 00:14:03 -0500
Subject: [PATCH] class/c: Swap after, not before, adding #:important blame
 context
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Swapping the blame before adding #:important context associates the
important party with the negative party for the purposes of picking
“contract violation” versus “broke its own contract” messages in error
reporting. Therefore, only swap after adding the context.

fixes #2531
---
 .../tests/racket/contract/class.rkt           | 27 +++++++++++++++++++
 .../collects/racket/private/class-c-old.rkt   |  4 +--
 2 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/pkgs/racket-test/tests/racket/contract/class.rkt b/pkgs/racket-test/tests/racket/contract/class.rkt
index b3a249ba9a..198097661d 100644
--- a/pkgs/racket-test/tests/racket/contract/class.rkt
+++ b/pkgs/racket-test/tests/racket/contract/class.rkt
@@ -2748,4 +2748,31 @@
                         'pos 'neg)])
       (new c% [a (lambda () 1)]
               [b (lambda () #f)])))
+
+  (test/neg-blame
+   'override-important
+   #:header-of-message "contract violation"
+   '(let* ([a% (contract (class/c (override [b (->m string?)]))
+                         (class object%
+                           (super-new)
+                           (abstract b)
+                           (define/public (a) (b)))
+                         'pos 'neg)]
+           [b% (class a%
+                 (super-new)
+                 (define/override (b) #f))])
+      (send (new b%) a)))
+
+  (test/neg-blame
+   'inner-important
+   #:header-of-message "contract violation"
+   '(let* ([a% (contract (class/c (inner [a (->m string?)]))
+                         (class object%
+                           (super-new)
+                           (define/pubment (a) (inner "" a)))
+                         'pos 'neg)]
+           [b% (class a%
+                 (super-new)
+                 (define/augment (a) #f))])
+      (send (new b%) a)))
   )
diff --git a/racket/collects/racket/private/class-c-old.rkt b/racket/collects/racket/private/class-c-old.rkt
index c03edb84c4..d2c26bd642 100644
--- a/racket/collects/racket/private/class-c-old.rkt
+++ b/racket/collects/racket/private/class-c-old.rkt
@@ -459,7 +459,7 @@
       (for/list ([name (in-list (internal-class/c-inners internal-ctc))]
                  [c (in-list (internal-class/c-inner-contracts internal-ctc))])
         (and c
-             ((contract-late-neg-projection c) (blame-add-method-context bswap name)))))
+             ((contract-late-neg-projection c) (blame-swap (blame-add-method-context blame name))))))
     
     (define internal-field-projections
       (for/list ([f (in-list (internal-class/c-inherit-fields internal-ctc))]
@@ -515,7 +515,7 @@
       (for/list ([m (in-list (internal-class/c-overrides internal-ctc))]
                  [c (in-list (internal-class/c-override-contracts internal-ctc))])
         (and c
-             ((contract-late-neg-projection c) (blame-add-method-context bswap m)))))
+             ((contract-late-neg-projection c) (blame-swap (blame-add-method-context blame m))))))
     
     (define augment/augride-projections
       (for/list ([m (in-list (append (internal-class/c-augments internal-ctc)