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

Remove now-redundant instrumentation of vector contracts.

Browse Source 
Now covered by instrumentation at contract entry points.
This commit is contained in:
Vincent St-Amour 2016-01-11 16:29:36 -06:00
parent 1277f0347a
commit 143267f1e9
2 changed files with 27 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
pkgs/racket-test/tests/racket/contract/prof.rkt
View File

@ -370,4 +370,26 @@
(set-field! x o 2)
(send o f)))
(test/spec-passed
'contract-marks41
'(contract (vectorof pos-blame? #:flat? #t) #(1 2 3) 'pos 'neg))
(test/spec-passed
'contract-marks42
'((vector-ref (contract (vectorof (-> pos-blame? neg-blame?)) (vector values)
'pos 'neg)
0)
1))
(test/spec-passed
'contract-marks43
'(contract (vector/c pos-blame? #:flat? #t) #(1) 'pos 'neg))
(test/spec-passed
'contract-marks42
'((vector-ref (contract (vector/c (-> pos-blame? neg-blame?)) (vector values)
'pos 'neg)
0)
1))
)

13
racket/collects/racket/contract/private/vector.rkt
View File

@ -365,14 +365,11 @@
(for/list ([c (in-list (base-vector/c-elems ctc))])
((get/build-late-neg-projection c) blame+ctxt)))
(λ (val neg-party)
(with-contract-continuation-mark
(cons blame neg-party)
(begin
(check-vector/c ctc val blame neg-party)
(for ([e (in-vector val)]
[p (in-list val+np-acceptors)])
(p e neg-party))
val)))))))
(check-vector/c ctc val blame neg-party)
(for ([e (in-vector val)]
[p (in-list val+np-acceptors)])
(p e neg-party))
val)))))
(define (vector/c-ho-late-neg-projection vector-wrapper)
(λ (ctc)