From c5c22e117cb32de2cf81ea216f17dca218c3d52a Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Sat, 20 Feb 2010 10:46:54 +0000
Subject: [PATCH] Tests to make sure the first-order parts of method contracts
 are attributed to the correct source upon failure.

svn: r18219
---
 collects/tests/mzscheme/contract-test.ss | 38 ++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index 035cc09d96..dbb8ae2ff7 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -4123,6 +4123,13 @@
               'pos
               'neg))
   
+  (test/pos-blame
+   'class/c-first-order-method-4
+   '(contract (class/c [m (-> any/c number? number?)])
+              (class object% (super-new) (define/public (m) 3))
+              'pos
+              'neg))
+  
   (test/pos-blame
    'class/c-first-order-field-1
    '(contract (class/c (field [n number?]))
@@ -4237,6 +4244,13 @@
               'pos
               'neg))
   
+  (test/pos-blame
+   'class/c-first-order-super-9
+   '(contract (class/c (super [m (-> any/c number? number?)]))
+              (class object% (super-new) (define/public (m) 3))
+              'pos
+              'neg))
+
   (test/pos-blame
    'class/c-first-order-inner-1
    '(contract (class/c (inner [m (-> any/c number? number?)]))
@@ -4298,6 +4312,14 @@
                          'neg)])
       (class c% (super-new) (define/augment (m) 5))))
   
+  (test/neg-blame
+   'class/c-first-order-inner-9
+   '(let* ([c% (contract (class/c (inner [m (-> any/c number? number?)]))
+                         (class object% (super-new) (define/pubment (m x) (inner x m x)))
+                         'pos
+                         'neg)])
+      (class c% (super-new) (define/augment (m) 5))))
+  
   (test/pos-blame
    'class/c-first-order-override-1
    '(contract (class/c (override [m (-> any/c number? number?)]))
@@ -4358,6 +4380,14 @@
                         'pos
                         'neg)])
       (class c% (super-new) (define/override (m) 5))))
+  
+  (test/neg-blame
+   'class/c-first-order-override-9
+   '(let ([c% (contract (class/c (override [m (-> any/c number? number?)]))
+                        (class object% (super-new) (define/public (m x) 3))
+                        'pos
+                        'neg)])
+      (class c% (super-new) (define/override (m) 5))))
 
   (test/pos-blame
    'class/c-first-order-augment-1
@@ -4420,6 +4450,14 @@
                         'neg)])
       (class c% (super-new) (inherit m))))
 
+  (test/pos-blame
+   'class/c-first-order-augment-9
+   '(let ([c% (contract (class/c (augment [m (-> any/c number? number?)]))
+                        (class object% (super-new) (define/pubment (m) 3))
+                        'pos
+                        'neg)])
+      (class c% (super-new) (inherit m))))
+
   (test/spec-passed
    'class/c-higher-order-method-1
    '(let ([c% (contract (class/c [m (-> any/c number? number?)])