suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Replaced make-proj-contract with simple-contract in tests.

Browse Source 
svn: r17737
This commit is contained in:
Carl Eastlund 2010-01-19 05:31:18 +00:00
parent e94bef6938
commit 888045dcf9
1 changed files with 19 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
collects/tests/mzscheme/contract-test.ss
View File

@ -2291,49 +2291,46 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; make-proj-contract
;; simple-contract
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(contract-eval
'(define proj:add1->sub1
(make-proj-contract
'proj:add1->sub1
(lambda (pos neg src name blame)
(simple-contract
#:name 'proj:add1->sub1
#:projection
(lambda (blame)
(lambda (f)
(unless (and (procedure? f) (procedure-arity-includes? f 1))
(raise-contract-error f src pos name
"expected a unary function, got: ~e"
f))
(raise-blame-error blame f "expected a unary function, got: ~e" f))
(lambda (x)
(unless (and (integer? x) (exact? x))
(raise-contract-error x src neg name
"expected an integer, got: ~e"
x))
(raise-blame-error (blame-swap blame) x
"expected an integer, got: ~e" x))
(let* ([y (f (add1 x))])
(unless (and (integer? y) (exact? y))
(raise-contract-error y src pos name
"expected an integer, got: ~e"
y))
(raise-blame-error blame y "expected an integer, got: ~e" y))
(sub1 y)))))
#:first-order
(lambda (f)
(and (procedure? f) (procedure-arity-includes? f 1))))))
(test/spec-passed/result
'make-proj-contract-1
'simple-contract-1
'((contract proj:add1->sub1 sqrt 'pos 'neg) 15)
3)
(test/pos-blame
'make-proj-contract-2
'simple-contract-2
'(contract proj:add1->sub1 'dummy 'pos 'neg))
(test/pos-blame
'make-proj-contract-3
'simple-contract-3
'((contract proj:add1->sub1 (lambda (x) 'dummy) 'pos 'neg) 2))
(test/neg-blame
'make-proj-contract-4
'simple-contract-4
'((contract proj:add1->sub1 sqrt 'pos 'neg) 'dummy))
;
@ -5263,12 +5260,12 @@
'(begin
(define proj:blame/c
(make-proj-contract
'proj:blame/c
(lambda (pos neg src name blame)
(simple-contract
#:name 'proj:blame/c
#:projection
(lambda (blame)
(lambda (x)
(if blame 'positive 'negative)))
(lambda (x) #t)))
(if blame 'positive 'negative)))))
(define call*0 'dummy)
(define (call*1 x0) x0)