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
187 lines
4.5 KiB
Racket
187 lines
4.5 KiB
Racket
#lang racket
|
|
(require typed-racket/utils/opaque-object)
|
|
|
|
;; --------------------------------------------------------------------------------------------------
|
|
;; test helpers
|
|
|
|
(define (test-stronger? ctc-stronger ctc-weaker)
|
|
(unless (contract-stronger? ctc-stronger ctc-weaker)
|
|
(error 'pr267
|
|
"contract ~a is unexpectedly weaker than ~a"
|
|
(contract-name ctc-stronger)
|
|
(contract-name ctc-weaker))))
|
|
|
|
(define (test-not-stronger? ctc-stronger ctc-weaker)
|
|
(when (contract-stronger? ctc-stronger ctc-weaker)
|
|
(error 'pr267
|
|
"contract ~a is unexpectedly stronger than ~a"
|
|
(contract-name ctc-stronger)
|
|
(contract-name ctc-weaker))))
|
|
|
|
;; --------------------------------------------------------------------------------------------------
|
|
;; stronger? tests
|
|
|
|
(let () ;; object/c-opaque with the same members
|
|
(test-stronger?
|
|
(object/c-opaque)
|
|
(object/c-opaque))
|
|
|
|
(test-stronger?
|
|
(object/c-opaque
|
|
(field (f1 integer?))
|
|
(m1 (->m object? object?)))
|
|
(object/c-opaque
|
|
(field (f1 integer?))
|
|
(m1 (->m object? object?))))
|
|
|
|
(test-stronger?
|
|
(object/c-opaque
|
|
(m1 (->m any/c object? (-> integer? integer?))))
|
|
(object/c-opaque
|
|
(m1 (->m any/c object? (-> integer? integer?)))))
|
|
)
|
|
|
|
(let () ;; object/c-opaque with fewer members (unspecified = opaque)
|
|
(test-stronger?
|
|
(object/c-opaque)
|
|
(object/c-opaque
|
|
(field (x symbol?))))
|
|
|
|
(test-stronger?
|
|
(object/c-opaque
|
|
(field (x symbol?)))
|
|
(object/c-opaque
|
|
(field (x symbol?))
|
|
(y (->m none/c none/c))))
|
|
|
|
(test-stronger?
|
|
(object/c-opaque
|
|
(f (->m void? any/c)))
|
|
(object/c-opaque
|
|
(f (->m void? any/c))
|
|
(g (->m integer? integer? integer?))))
|
|
|
|
(test-stronger?
|
|
(object/c-opaque
|
|
(field (a integer?))
|
|
(c (-> real? real?)))
|
|
(object/c-opaque
|
|
(field (a integer?)
|
|
(b integer?))
|
|
(c (-> real? real?))
|
|
(d (-> real? real?))))
|
|
|
|
)
|
|
|
|
(let () ;; object/c-opaque with stronger members
|
|
|
|
(test-stronger?
|
|
(object/c-opaque
|
|
(m1 (->m any/c integer?)))
|
|
(object/c-opaque
|
|
(m1 (->m any/c any/c))))
|
|
|
|
(test-stronger?
|
|
(object/c-opaque
|
|
(m1 (->m any/c any/c)))
|
|
(object/c-opaque
|
|
(m1 (->m integer? any/c))))
|
|
|
|
(test-stronger?
|
|
(object/c-opaque
|
|
(m1 (->m any/c integer?))
|
|
(m2 (->m any/c (listof boolean?))))
|
|
(object/c-opaque
|
|
(m1 (->m any/c integer?))
|
|
(m2 (->m any/c (listof any/c)))))
|
|
|
|
(test-stronger?
|
|
(object/c-opaque
|
|
(a (->m symbol?))
|
|
(b (->m (between/c 2 3)))
|
|
(c (->m any/c (listof (char-in #\A #\B)))))
|
|
(object/c-opaque
|
|
(a (->m symbol?))
|
|
(b (->m (between/c 0 5)))
|
|
(c (->m any/c (listof (char-in #\A #\Z))))))
|
|
)
|
|
|
|
(let () ;; vs. object/c
|
|
(test-stronger?
|
|
(object/c-opaque)
|
|
(object/c
|
|
(field (a boolean?))
|
|
(b (->m string? any/c))))
|
|
|
|
(test-stronger?
|
|
(object/c-opaque
|
|
(field (x any/c))
|
|
(h (->m (-> boolean? boolean? boolean?) integer?)))
|
|
(object/c))
|
|
|
|
(test-stronger?
|
|
(object/c-opaque
|
|
(field (x integer?))
|
|
(m1 (->m any/c any/c any/c)))
|
|
(object/c
|
|
(field (x integer?))
|
|
(m1 (->m any/c any/c any/c))))
|
|
|
|
(test-stronger?
|
|
(object/c-opaque
|
|
(m1 (->m any/c (</c 2))))
|
|
(object/c
|
|
(field (a real?) (b boolean?))
|
|
(m1 (->m any/c (</c 10)))))
|
|
)
|
|
|
|
;; --------------------------------------------------------------------------------------------------
|
|
;; not-stronger? tests
|
|
|
|
(let () ;; fields must be the same for stronger?
|
|
(test-not-stronger?
|
|
(object/c-opaque
|
|
(field (number (</c 999))))
|
|
(object/c-opaque
|
|
(field (number (</c 1)))))
|
|
|
|
(test-not-stronger?
|
|
(object/c-opaque
|
|
(field (number (</c 1))))
|
|
(object/c-opaque
|
|
(field (number (</c 999)))))
|
|
|
|
(test-not-stronger?
|
|
(object/c-opaque
|
|
(field (a symbol?)
|
|
(b integer?)
|
|
(c (-> any/c (listof zero?)))))
|
|
(object/c-opaque
|
|
(field (a symbol?)
|
|
(b real?)
|
|
(c (-> any/c (listof exact-nonnegative-integer?))))))
|
|
)
|
|
|
|
(let () ;; an object/c is never stronger than an object/c-opaque
|
|
(test-not-stronger?
|
|
(object/c-opaque
|
|
(f (->m integer? integer?)))
|
|
(object/c
|
|
(f (->m any/c none/c))))
|
|
|
|
(test-not-stronger?
|
|
(object/c
|
|
(f (->m any/c none/c)))
|
|
(object/c-opaque
|
|
(f (->m integer? integer?))))
|
|
|
|
(test-not-stronger?
|
|
(object/c
|
|
(field (x integer?))
|
|
(m1 (->m any/c any/c any/c)))
|
|
(object/c-opaque
|
|
(field (x real?))
|
|
(m1 (->m any/c any/c any/c))))
|
|
|
|
)
|