From 06fe71fe1e634b95c3c38096db646781de102be1 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Wed, 2 Apr 2014 21:25:09 -0700 Subject: [PATCH] Add a bunch of new check below tests. original commit: 87cfce97f9912179bad9c6e8be8339819293f896 --- .../unit-tests/check-below-tests.rkt | 41 +++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/check-below-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/check-below-tests.rkt index 3275de8f..89333150 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/check-below-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/check-below-tests.rkt @@ -73,6 +73,28 @@ (test-suite "Check Below" (test-below -Bottom Univ) (test-below #:fail -Symbol -String) + + (test-below + (ret -Bottom) + (ret (list Univ Univ) (list -true-filter -no-filter) (list -no-obj -empty-obj)) + #:result (ret (list Univ Univ) (list -true-filter -top-filter) (list -empty-obj -empty-obj))) + + (test-below + (ret -Bottom) + (ret (list Univ) (list -no-filter) (list -no-obj) Univ 'B) + #:result (ret (list Univ) (list -top-filter) (list -empty-obj) Univ 'B)) + + ;; Bottom is not below everything if the number of values doesn't match up. + (test-below #:fail + (ret (list -Bottom -Bottom)) + (ret (list Univ) (list -true-filter) (list -no-obj)) + #:result (ret (list Univ) (list -true-filter) (list -empty-obj))) + + (test-below #:fail + (ret (list)) + (ret (list Univ) (list -true-filter) (list -no-obj)) + #:result (ret (list Univ) (list -true-filter) (list -empty-obj))) + (test-below (ret (list -Symbol) (list -top-filter) (list -empty-obj)) (ret (list Univ) (list -no-filter) (list -no-obj)) @@ -98,6 +120,25 @@ (test-below (ret -Bottom) tc-any-results #:result (ret -Bottom)) (test-below (ret Univ) tc-any-results #:result (ret Univ)) + (test-below (ret -Symbol -true-filter -empty-obj) tc-any-results + #:result (ret -Symbol -true-filter -empty-obj)) + (test-below (ret (list -Symbol -String)) tc-any-results + #:result (ret (list -Symbol -String))) + (test-below + (ret (list -Symbol -String) (list -true-filter -false-filter) (list -empty-obj -empty-obj)) + tc-any-results + #:result (ret (list -Symbol -String) (list -true-filter -false-filter) (list -empty-obj -empty-obj))) + + + (test-below #:fail + (ret -Symbol) + (ret (list -Symbol -Symbol) (list -top-filter -no-filter) (list -no-obj -empty-obj)) + #:result (ret (list -Symbol -Symbol) (list -top-filter -top-filter) (list -empty-obj -empty-obj))) + + (test-below #:fail + tc-any-results + (ret -Symbol)) + ;; Enable these once check-below is fixed ;; Currently does not fail #;