From d78535d18769c35cee87ee71688fed128b7912e0 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Thu, 29 Aug 2013 11:22:39 -0400 Subject: [PATCH] Add subtyping tests for classes/objects original commit: 8331d8c8a2e994a2c961e18977d9563a3f92ba8d --- .../typed-racket/unit-tests/subtype-tests.rkt | 21 +++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/subtype-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/subtype-tests.rkt index 18a2428c..27375dc9 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/subtype-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/subtype-tests.rkt @@ -291,4 +291,25 @@ [FAIL (->key -String #:x -Symbol #f #:y -Symbol #f Univ) (->optkey -String [-Void] #:x -Symbol #t Univ)] + + ;; classes and objects + [(make-Class #f null null `((m ,(-> -Nat))) `((m ,(-> -Nat)))) + (make-Class #f null null `((m ,(-> -Nat))) `((m ,(-> -Nat))))] + [(make-Instance (make-Class #f null null `((m ,(-> -Nat))) `((m ,(-> -Nat))))) + (make-Instance (make-Class #f null null `((m ,(-> -Nat))) `((m ,(-> -Nat)))))] + [(make-Instance (make-Class #f null null `((m ,(-> -Nat)) (n ,(-> -Nat))) null)) + (make-Instance (make-Class #f null null `((m ,(-> -Nat))) null))] + [(make-Instance (make-Class #f null `((f ,-Nat)) `((m ,(-> -Nat)) (n ,(-> -Nat))) null)) + (make-Instance (make-Class #f null null `((m ,(-> -Nat))) null))] + [(make-Instance (make-Class #f `((a ,-Nat)) null `((m ,(-> -Nat)) (n ,(-> -Nat))) null)) + (make-Instance (make-Class #f null null `((m ,(-> -Nat))) null))] + [FAIL + (make-Instance (make-Class #f null null `((m ,(-> -Nat)) (n ,(-> -Nat))) null)) + (make-Instance (make-Class #f null null `((l ,(-> -Nat)) (m ,(-> -Nat))) null))] + [FAIL + (make-Class #f null null `((m ,(-> -Nat))) null) + (make-Class #f null null `((m ,(-> -Nat))) `((m ,(-> -Nat))))] + [FAIL + (make-Class #f null null `((m ,(-> -Nat))) `((m ,(-> -Nat)))) + (make-Class #f null null `((m ,(-> -Nat))) null)] ))