76 lines
2.7 KiB
Racket
76 lines
2.7 KiB
Racket
#lang racket/base
|
|
(require "test-utils.rkt"
|
|
(for-syntax racket/base)
|
|
(r:infer infer)
|
|
(types abbrev numeric-tower subtype union remove-intersect)
|
|
rackunit)
|
|
(provide tests)
|
|
(gen-test-main)
|
|
|
|
(define-syntax (over-tests stx)
|
|
(syntax-case stx ()
|
|
[(_ [t1 t2 res] ...)
|
|
#'(test-suite "Tests for overlap"
|
|
(test-check (format "~a ~a" 't1 't2) (lambda (a b) (eq? (not (not a)) b)) (overlap t1 t2) res) ...)]))
|
|
|
|
(define overlap-tests
|
|
(over-tests
|
|
[-Number -Integer #t]))
|
|
|
|
(define-syntax (restr-tests stx)
|
|
(syntax-case stx ()
|
|
[(_ [t1 t2 res] ...)
|
|
#'(test-suite "Tests for restrict"
|
|
(test-check (format "~a ~a" 't1 't2) type-compare? (restrict t1 t2) res) ...)]))
|
|
|
|
|
|
(define restrict-tests
|
|
(restr-tests
|
|
[-Number (Un -Number -Symbol) -Number]
|
|
[-Number -Number -Number]
|
|
[(Un (-val 'foo) (-val 6)) (Un -Number -Symbol) (Un (-val 'foo) (-val 6))]
|
|
[-Number (-mu a (Un -Number -Symbol (make-Listof a))) -Number]
|
|
[(Un -Number -Boolean) (-mu a (Un -Number -Symbol (make-Listof a))) -Number]
|
|
[(-mu x (Un -Number (make-Listof x))) (Un -Symbol -Number -Boolean) -Number]
|
|
[(Un -Number -String -Symbol -Boolean) -Number -Number]
|
|
|
|
[(-lst -Number) (-pair Univ Univ) (-pair -Number (-lst -Number))]
|
|
[(-lst -Number) (-poly (a) (-lst a)) (-lst -Number)]
|
|
;; FIXME
|
|
#;
|
|
[-Listof -Sexp (-lst (Un B N -String Sym))]
|
|
#;
|
|
[-Sexp -Listof (-lst -Sexp)]
|
|
[(-val "one") -Fixnum (Un)]
|
|
[(Un (-val "one") (-val "two")) (Un (-val "one") (-val 1)) (-val "one")]
|
|
))
|
|
|
|
(define-syntax (remo-tests stx)
|
|
(syntax-case stx ()
|
|
[(_ [t1 t2 res] ...)
|
|
(syntax/loc stx
|
|
(test-suite "Tests for remove"
|
|
(test-check (format "~a ~a" 't1 't2) type-compare? (remove t1 t2) res) ...))]))
|
|
|
|
(define remove-tests
|
|
(remo-tests
|
|
[(Un -Number -Symbol) -Number -Symbol]
|
|
[-Number -Number (Un)]
|
|
[(-mu x (Un -Number -Symbol (make-Listof x))) -Number (Un -Symbol (make-Listof (-mu x (Un -Number -Symbol (make-Listof x)))))]
|
|
[(-mu x (Un -Number -Symbol -Boolean (make-Listof x))) -Number (Un -Symbol -Boolean (make-Listof (-mu x (Un -Number -Symbol -Boolean (make-Listof x)))))]
|
|
[(Un (-val #f) (-mu x (Un -Number -Symbol (make-Listof (-v x)))))
|
|
(Un -Boolean -Number)
|
|
(Un -Symbol (make-Listof (-mu x (Un -Number -Symbol (make-Listof x)))))]
|
|
[(Un (-val 'foo) (-val 6)) (Un -Number -Symbol) (Un)]
|
|
[(-> (Un -Symbol -Number) -Number) (-> -Number -Number) (Un)]
|
|
[(Un (-poly (a) (make-Listof a)) (-> -Number -Number)) (-> -Number -Number) (-poly (a) (make-Listof a))]
|
|
[(Un -Symbol -Number) (-poly (a) -Number) -Symbol]
|
|
[(-pair -Number (-v a)) (-pair Univ Univ) (Un)]
|
|
))
|
|
|
|
(define tests
|
|
(test-suite "Remove Intersect"
|
|
remove-tests
|
|
restrict-tests
|
|
overlap-tests))
|