fix typo and add test suite for invariant-assertion
This commit is contained in:
parent
51812cdd9b
commit
e4bf7ef55b
|
@ -1516,7 +1516,7 @@ The @racket[define-struct/contract] form only allows a subset of the
|
|||
@racket[invariant-assertion] does not establish a boundary
|
||||
between two parties. Instead, it simply attaches a logical assertion
|
||||
to the value. Because the form uses contract machinery to check the
|
||||
assertion, the surround module is treated as the party to be blamed
|
||||
assertion, the surrounding module is treated as the party to be blamed
|
||||
for any violations of the assertion.
|
||||
|
||||
This means, for example, that the assertion is checked on
|
||||
|
|
|
@ -0,0 +1,41 @@
|
|||
#lang racket/base
|
||||
(require "test-util.rkt")
|
||||
(parameterize ([current-contract-namespace (make-basic-contract-namespace
|
||||
'racket/contract)])
|
||||
(define exn:fail:contract:blame-object
|
||||
(contract-eval 'exn:fail:contract:blame-object))
|
||||
(define exn:fail:contract:blame?
|
||||
(contract-eval 'exn:fail:contract:blame?))
|
||||
|
||||
(contract-error-test
|
||||
'assertion1
|
||||
#'(begin
|
||||
(eval '(module contract-test-suite1 racket/base
|
||||
(require racket/contract)
|
||||
(invariant-assertion integer? #f)))
|
||||
(eval '(require 'contract-test-suite1)))
|
||||
(λ (x)
|
||||
(and (exn:fail:contract:blame? x)
|
||||
(regexp-match #rx"contract from: contract-test-suite1" (exn-message x)))))
|
||||
|
||||
(contract-error-test
|
||||
'assertion2
|
||||
#'(begin
|
||||
(eval '(module contract-test-suite2 racket/base
|
||||
(require racket/contract)
|
||||
(invariant-assertion integer? #f)))
|
||||
(eval '(require 'contract-test-suite2)))
|
||||
(λ (x)
|
||||
(and (exn:fail:contract:blame? x)
|
||||
(regexp-match #rx"blaming: contract-test-suite2" (exn-message x)))))
|
||||
|
||||
(contract-error-test
|
||||
'assertion3
|
||||
#'(begin
|
||||
(eval '(module contract-test-suite3 racket/base
|
||||
(require racket/contract)
|
||||
((invariant-assertion (-> integer? integer?) values) #f)))
|
||||
(eval '(require 'contract-test-suite3)))
|
||||
(λ (x)
|
||||
(and (exn:fail:contract:blame? x)
|
||||
(regexp-match #rx"blaming: contract-test-suite3" (exn-message x))))))
|
Loading…
Reference in New Issue
Block a user