47 lines
1.8 KiB
Racket
47 lines
1.8 KiB
Racket
#lang racket/base
|
|
|
|
(require "test-utils.rkt" (for-syntax racket/base)
|
|
(rep type-rep)
|
|
(types abbrev numeric-tower union)
|
|
rackunit)
|
|
|
|
(provide tests)
|
|
(gen-test-main)
|
|
|
|
(define (-base x) (make-Base x #'dummy values #f))
|
|
|
|
|
|
(define-syntax (te-tests stx)
|
|
(define (single-test stx)
|
|
(syntax-case stx (FAIL)
|
|
[(FAIL t s) (syntax/loc stx (test-check (format "FAIL ~a" '(t s))
|
|
(lambda (a b) (not (type-equal? a b))) t s))]
|
|
[(t s) (syntax/loc stx (test-check (format "~a" '(t s)) type-equal? t s))]))
|
|
(syntax-case stx ()
|
|
[(_ cl ...)
|
|
#`(test-suite "Tests for type equality"
|
|
#,@(map single-test (syntax->list #'(cl ...))))]))
|
|
|
|
(define (fld* t) (make-fld t (datum->syntax #'here 'values) #f))
|
|
|
|
(define tests
|
|
(te-tests
|
|
[-Number -Number]
|
|
[(Un -Number) -Number]
|
|
[(Un -Number -Symbol -Boolean) (Un -Number -Boolean -Symbol)]
|
|
[(Un -Number -Symbol -Boolean) (Un -Symbol -Boolean -Number)]
|
|
[(Un -Number -Symbol -Boolean) (Un -Symbol -Number -Boolean)]
|
|
[(Un -Number -Symbol -Boolean) (Un -Boolean (Un -Symbol -Number))]
|
|
[(Un -Number -Symbol) (Un -Symbol -Number)]
|
|
[(-poly (x) (-> (Un -Symbol -Number) x)) (-poly (xyz) (-> (Un -Number -Symbol) xyz))]
|
|
[(-mu x (Un -Number -Symbol x)) (-mu y (Un -Number -Symbol y))]
|
|
;; found bug
|
|
[FAIL (Un (-mu heap-node
|
|
(-struct #'heap-node #f
|
|
(map fld* (list (-base 'comparator) -Number (-v a) (Un heap-node (-base 'heap-empty))))))
|
|
(-base 'heap-empty))
|
|
(Un (-mu heap-node
|
|
(-struct #'heap-node #f
|
|
(map fld* (list (-base 'comparator) -Number (-pair -Number -Number) (Un heap-node (-base 'heap-empty))))))
|
|
(-base 'heap-empty))]))
|