fix a bug in recent and/c improvements and add proper printing for integer-in

This commit is contained in:
Robby Findler 2017-03-07 20:40:26 -06:00
parent fe9288d0d5
commit f5c5db3b3d
2 changed files with 3 additions and 1 deletions

View File

@ -58,6 +58,7 @@
(test-flat-contract '(and/c exact-integer? (between/c -10 10)) -1 -11) (test-flat-contract '(and/c exact-integer? (between/c -10 10)) -1 -11)
(test-flat-contract '(and/c exact-integer? (between/c -10.5 10.5)) -10 -11) (test-flat-contract '(and/c exact-integer? (between/c -10.5 10.5)) -10 -11)
(test-flat-contract '(and/c exact-integer? (between/c -10.5 10.5)) 10 11) (test-flat-contract '(and/c exact-integer? (between/c -10.5 10.5)) 10 11)
(test-flat-contract '(and/c exact-integer? (<=/c 0)) -1 -3/2)
(test-flat-contract '(char-in #\a #\z) #\a #\Z) (test-flat-contract '(char-in #\a #\z) #\a #\Z)
(test-flat-contract '(char-in #\a #\z) #\z #\A) (test-flat-contract '(char-in #\a #\z) #\z #\A)
(test-flat-contract '(char-in #\a #\z) #\b "b") (test-flat-contract '(char-in #\a #\z) #\b "b")

View File

@ -234,7 +234,7 @@
[(between/c-s? other) [(between/c-s? other)
(define other-low (between/c-s-low other)) (define other-low (between/c-s-low other))
(define other-high (between/c-s-high other)) (define other-high (between/c-s-high other))
(integer-in (exact-ceiling (if (= other-low -inf.0) #f other-low)) (integer-in (if (= other-low -inf.0) #f (exact-ceiling other-low))
(if (= other-high +inf.0) #f (exact-floor other-high)))] (if (= other-high +inf.0) #f (exact-floor other-high)))]
[else (make-first-order-and/c contracts preds)])] [else (make-first-order-and/c contracts preds)])]
[else [else
@ -249,6 +249,7 @@
(define (exact-ceiling x) (ceiling (inexact->exact x))) (define (exact-ceiling x) (ceiling (inexact->exact x)))
(struct integer-in-ctc (start end) (struct integer-in-ctc (start end)
#:property prop:custom-write custom-write-property-proc
#:property prop:flat-contract #:property prop:flat-contract
(build-flat-contract-property (build-flat-contract-property
#:name (λ (ctc) #:name (λ (ctc)