3e2d020a19
An opaque object contract is stronger than another (opaque) object contract if: - it has stronger field/method contracts on fields/methods common to both - and it has no more field/method contracts than the other, if the other is opaque
53 lines
1.9 KiB
Racket
53 lines
1.9 KiB
Racket
#lang racket
|
|
(require typed-racket/utils/opaque-object rackunit
|
|
(for-syntax (only-in syntax/srcloc build-source-location-list)))
|
|
|
|
;; --------------------------------------------------------------------------------------------------
|
|
|
|
;; object/c-opaque names should be lists:
|
|
;; - with 'object/c-opaque as the first element
|
|
;; - and 1 element for each member of the contract (field spec, method, ...)
|
|
(define-syntax (test-object/c-opaque-name-shape stx)
|
|
(syntax-case stx ()
|
|
[(_ . ctc-spec*)
|
|
#`(begin
|
|
#,@(for/list ([ctc-spec (in-list (syntax-e #'ctc-spec*))])
|
|
#`(let ([nm (contract-name (object/c-opaque #,@ctc-spec))])
|
|
(with-check-info* (list (make-check-location '#,(build-source-location-list ctc-spec)))
|
|
(lambda ()
|
|
(check-equal? (car nm) 'object/c-opaque)
|
|
(check-equal? (length nm) (+ 1 #,(length (syntax-e ctc-spec)))))))))]))
|
|
|
|
(test-object/c-opaque-name-shape
|
|
[]
|
|
[(field [i integer?] [j string?])]
|
|
[(field [k (<=/c 0)])
|
|
(m (->m (-> integer? integer?) zero?))]
|
|
[(m1 (->m (-> integer? integer?) zero?))
|
|
(m2 (->m boolean?))
|
|
(m3 (->m natural-number/c any/c))]
|
|
[(field [a real?] [b (-> string?)])
|
|
(m1 (->m (-> integer? integer?) zero?))
|
|
(m2 (->m boolean?))
|
|
(m3 (->m natural-number/c any/c))]
|
|
)
|
|
|
|
;; --------------------------------------------------------------------------------------------------
|
|
|
|
(define-syntax (test-object/c-vs-opaque-name stx)
|
|
(syntax-case stx ()
|
|
[(_ . ctc-spec*)
|
|
#`(begin
|
|
#,@(for/list ([ctc-spec (in-list (syntax-e #'ctc-spec*))])
|
|
#`(check-not-equal?
|
|
(contract-name (object/c #,@ctc-spec))
|
|
(contract-name (object/c-opaque #,@ctc-spec)))))]))
|
|
|
|
(test-object/c-vs-opaque-name
|
|
[]
|
|
[(field [i integer?])
|
|
(f (->m string? boolean?))]
|
|
[(hd (->m any/c))
|
|
(tl (->m object?))]
|
|
)
|