From 640895645f46f672fbcaca7d3eaa853c625f7648 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 10 Feb 2016 12:42:11 -0600 Subject: [PATCH] Fix contract-stronger? to work with late-neg projections. --- pkgs/racket-test/tests/racket/contract/opt-c.rkt | 8 ++++++++ racket/collects/racket/contract/private/prop.rkt | 9 +++++---- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/pkgs/racket-test/tests/racket/contract/opt-c.rkt b/pkgs/racket-test/tests/racket/contract/opt-c.rkt index b7cd9225b9..f3c739466d 100644 --- a/pkgs/racket-test/tests/racket/contract/opt-c.rkt +++ b/pkgs/racket-test/tests/racket/contract/opt-c.rkt @@ -26,6 +26,14 @@ (define (call*2 f1 x0) (f1 x0)) (define (call*3 f2 x1 x0) (f2 x1 x0)))) + ;; the two are incomparable, but we still want to check, to make sure + ;; contract-stronger works on contracts that use different kinds of + ;; projections (late-neg for any/c, regular for proj:blame/c) + (test/spec-passed/result + 'stronger-with-no-late-neg-projection + '(contract-stronger? proj:blame/c any/c) + #f) + (test/spec-passed/result 'opt/c-blame-0 '((contract diff --git a/racket/collects/racket/contract/private/prop.rkt b/racket/collects/racket/contract/private/prop.rkt index 4c51a8c21b..4ecf2b4dfa 100644 --- a/racket/collects/racket/contract/private/prop.rkt +++ b/racket/collects/racket/contract/private/prop.rkt @@ -497,9 +497,10 @@ v))))) (define (as-strong? a b) - (procedure-closure-contents-eq? - (contract-struct-projection a) - (contract-struct-projection b))) + (define late-neg-a (contract-struct-late-neg-projection a)) + (define late-neg-b (contract-struct-late-neg-projection b)) + (and late-neg-a late-neg-b + (procedure-closure-contents-eq? late-neg-a late-neg-b))) (define make-contract (procedure-rename @@ -549,4 +550,4 @@ ;; raises a blame error if val doesn't satisfy the first-order checks for the function ;; accepts-arglist : (-> (listof keyword?)[sorted by keyword