From 6755a11d368fad491dd3bc8c7968e21b2e580ed0 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Wed, 20 Feb 2013 17:21:13 -0500 Subject: [PATCH] Fix subtyping for Negative-Single-Flonum. original commit: 12aaa229a3fb84018a44f0aff175982a1841b764 --- collects/tests/typed-racket/unit-tests/subtype-tests.rkt | 1 + collects/tests/typed-racket/unit-tests/typecheck-tests.rkt | 2 ++ collects/typed-racket/types/numeric-tower.rkt | 2 +- 3 files changed, 4 insertions(+), 1 deletion(-) diff --git a/collects/tests/typed-racket/unit-tests/subtype-tests.rkt b/collects/tests/typed-racket/unit-tests/subtype-tests.rkt index ea91f04a..0d60c57c 100644 --- a/collects/tests/typed-racket/unit-tests/subtype-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/subtype-tests.rkt @@ -94,6 +94,7 @@ [(Un (-val 'foo) (-val 6)) (Un (-val 'foo) (-val 6))] [(-poly (a) (make-Listof (-v a))) (make-Listof (-mu x (Un (make-Listof x) -Number)))] [FAIL (make-Listof (-mu x (Un (make-Listof x) -Number))) (-poly (a) (make-Listof a))] + [(-val -34.2f0) -NegSingleFlonum] ;; case-lambda [(cl-> [(-Number) -Number] [(-Boolean) -Boolean]) (-Number . -> . -Number)] ;; special case for unused variables diff --git a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt index 536223c6..1cd017e3 100644 --- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -177,6 +177,8 @@ (tc-e (- -23524623547234734568) -PosInt) (tc-e (- 241.3) -NegFlonum) (tc-e (- -24.3) -PosFlonum) + (tc-e/t 34.2f0 -PosSingleFlonum) + (tc-e/t -34.2f0 -NegSingleFlonum) (tc-e (- (ann 1000 Index) 1) -Fixnum) (tc-e (- (ann 1000 Positive-Index) 1) -Index) diff --git a/collects/typed-racket/types/numeric-tower.rkt b/collects/typed-racket/types/numeric-tower.rkt index 5505f109..8173777b 100644 --- a/collects/typed-racket/types/numeric-tower.rkt +++ b/collects/typed-racket/types/numeric-tower.rkt @@ -201,7 +201,7 @@ (define -NegSingleFlonumNoNan (make-Base 'Negative-Single-Flonum-No-Nan #'(and/c single-flonum? negative?) - (lambda (x) (and (single-flonum? x) (positive? x))) + (lambda (x) (and (single-flonum? x) (negative? x))) #'-NegSingleFlonumNoNan)) (define -NegSingleFlonum (*Un -NegSingleFlonumNoNan -SingleFlonumNan)) (define -NegInexactReal (*Un -NegSingleFlonum -NegFlonum))