remove use of exported set!'d identifier from contract examples
(replacing it with an accessor function) Also add some for-label requires and remove a guaranteed-to-fail test case (the bug is documented in the contract gotchas section)
This commit is contained in:
parent
a9f64f4615
commit
09e28b272c
|
@ -10,7 +10,7 @@
|
||||||
(test-suite
|
(test-suite
|
||||||
"manager"
|
"manager"
|
||||||
(test-equal? "id lookup" "matthias" (name 'mf))
|
(test-equal? "id lookup" "matthias" (name 'mf))
|
||||||
(test-equal? "count" 4 count)
|
(test-equal? "count" 4 (get-count))
|
||||||
(test-true "active?" (active? 'mf))
|
(test-true "active?" (active? 'mf))
|
||||||
(test-false "active? 2" (active? 'kk))
|
(test-false "active? 2" (active? 'kk))
|
||||||
(test-true "set name" (void? (set-name 'mf "matt")))))
|
(test-true "set name" (void? (set-name 'mf "matt")))))
|
||||||
|
|
|
@ -18,6 +18,7 @@
|
||||||
(define not-active? (compose not active? basic-customer-id))
|
(define not-active? (compose not active? basic-customer-id))
|
||||||
|
|
||||||
(define count 0)
|
(define count 0)
|
||||||
|
(define (get-count) count)
|
||||||
|
|
||||||
(define (add c)
|
(define (add c)
|
||||||
(set! all (cons (list c 'secret) all))
|
(set! all (cons (list c 'secret) all))
|
||||||
|
@ -37,23 +38,20 @@
|
||||||
(provide
|
(provide
|
||||||
(contract-out
|
(contract-out
|
||||||
;; how many customers are in the db?
|
;; how many customers are in the db?
|
||||||
[count natural-number/c]
|
[get-count (-> natural-number/c)]
|
||||||
;; is the customer with this id active?
|
;; is the customer with this id active?
|
||||||
[active? (-> id? boolean?)]
|
[active? (-> id? boolean?)]
|
||||||
;; what is the name of the customer with this id?
|
;; what is the name of the customer with this id?
|
||||||
[name (-> (and/c id? active?) string?)]
|
[name (-> (and/c id? active?) string?)]
|
||||||
;; change the name of the customer with this id
|
;; change the name of the customer with this id
|
||||||
[set-name (->d ([id id?] [nn string?])
|
[set-name (->i ([id id?] [nn string?])
|
||||||
()
|
|
||||||
[result any/c] ;; result contract
|
[result any/c] ;; result contract
|
||||||
#:post-cond
|
#:post (id nn) (string=? (name id) nn))]
|
||||||
(string=? (name id) nn))]
|
|
||||||
|
|
||||||
[add (->d ([bc (and/c basic-customer? not-active?)])
|
[add (->i ([bc (and/c basic-customer? not-active?)])
|
||||||
()
|
|
||||||
;; A pre-post condition contract must use
|
;; A pre-post condition contract must use
|
||||||
;; a side-effect to express this contract
|
;; a side-effect to express this contract
|
||||||
;; via post-conditions
|
;; via post-conditions
|
||||||
#:pre-cond (set! c0 count)
|
#:pre () (set! c0 count)
|
||||||
[result any/c] ;; result contract
|
[result any/c] ;; result contract
|
||||||
#:post-cond (> count c0))]))
|
#:post () (> count c0))]))
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
|
|
||||||
(require scribble/basic
|
(require scribble/basic
|
||||||
(for-syntax racket/port)
|
(for-syntax racket/port)
|
||||||
|
(for-label racket rackunit rackunit/text-ui)
|
||||||
racket/include
|
racket/include
|
||||||
scribble/eval
|
scribble/eval
|
||||||
(except-in scribble/manual link))
|
(except-in scribble/manual link))
|
||||||
|
@ -31,22 +32,6 @@
|
||||||
(define (solution)
|
(define (solution)
|
||||||
(bold (format "Solution to exercise ~a" exercise-number)))
|
(bold (format "Solution to exercise ~a" exercise-number)))
|
||||||
|
|
||||||
#;
|
|
||||||
(define-syntax (external-file stx)
|
|
||||||
(syntax-case stx ()
|
|
||||||
[(_ filename)
|
|
||||||
(call-with-input-file (build-path "contracts-examples" (format "~a.rkt" (syntax-e #'filename)))
|
|
||||||
(λ (port)
|
|
||||||
(define prefix "#reader scribble/comment-reader\n[racketmod\nracket\n")
|
|
||||||
(define suffix "]")
|
|
||||||
(with-syntax ([s (parameterize ([read-accept-reader #t])
|
|
||||||
(read-syntax 'contract-examples
|
|
||||||
(input-port-append #f
|
|
||||||
(open-input-string prefix)
|
|
||||||
port
|
|
||||||
(open-input-string suffix))))])
|
|
||||||
#'s)))]))
|
|
||||||
|
|
||||||
(require (for-syntax (only-in scribble/comment-reader [read-syntax comment-reader])))
|
(require (for-syntax (only-in scribble/comment-reader [read-syntax comment-reader])))
|
||||||
(define-for-syntax (comment-racketmod-reader path port)
|
(define-for-syntax (comment-racketmod-reader path port)
|
||||||
(let ([pb (peek-byte port)])
|
(let ([pb (peek-byte port)])
|
||||||
|
|
|
@ -938,26 +938,6 @@
|
||||||
(eval '(require 'provide/contract48-m1)))
|
(eval '(require 'provide/contract48-m1)))
|
||||||
"provide/contract48-m1")
|
"provide/contract48-m1")
|
||||||
|
|
||||||
(test/spec-passed/result
|
|
||||||
'provide/contract49
|
|
||||||
'(let ()
|
|
||||||
(eval '(module provide/contract49-m1 racket/base
|
|
||||||
(require racket/contract/base)
|
|
||||||
(define count 0)
|
|
||||||
(define (add) (set! count (+ count 1)))
|
|
||||||
(provide
|
|
||||||
add
|
|
||||||
(contract-out
|
|
||||||
[count natural-number/c]))))
|
|
||||||
(eval '(module provide/contract49-m2 racket/base
|
|
||||||
(require 'provide/contract49-m1)
|
|
||||||
(add)
|
|
||||||
(define (provide/contract49-x) count)
|
|
||||||
(provide provide/contract49-x)))
|
|
||||||
(eval '(require 'provide/contract49-m2))
|
|
||||||
(eval '(provide/contract49-x)))
|
|
||||||
1)
|
|
||||||
|
|
||||||
(contract-error-test
|
(contract-error-test
|
||||||
'contract-error-test8
|
'contract-error-test8
|
||||||
#'(begin
|
#'(begin
|
||||||
|
|
Loading…
Reference in New Issue
Block a user