From d34cd06b900e9aea74cbddec7fae7b050e6f1576 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Fri, 8 Jan 2016 14:39:47 -0600 Subject: [PATCH] Tests for instrumentation of contract entry points. --- .../tests/racket/contract/prof.rkt | 33 +++++++++++++++++++ 1 file changed, 33 insertions(+) diff --git a/pkgs/racket-test/tests/racket/contract/prof.rkt b/pkgs/racket-test/tests/racket/contract/prof.rkt index 3b0c91f9fa..270bf2e99d 100644 --- a/pkgs/racket-test/tests/racket/contract/prof.rkt +++ b/pkgs/racket-test/tests/racket/contract/prof.rkt @@ -242,5 +242,38 @@ (eval 'x)) 3) + (test/spec-passed/result + 'contract-marks27 + '(with-contract test27 #:result (λ _ (named-blame? '(region test27))) 3) + 3) + + (test/spec-passed/result + 'contract-marks28 + '(let () + (eval '(define-struct/contract foo ([bar (λ _ (named-blame? 'top-level))]))) + (eval '(foo-bar (foo 3)))) + 3) + + (test/spec-passed/result + 'contract-marks29 + '(let () + (eval '(define f (invariant-assertion (-> (λ _ (named-blame? 'top-level)) + (λ _ (named-blame? 'top-level))) + (λ (x) 3)))) + (eval '(f 2))) + 3) + + (test/spec-passed/result + 'contract-marks30 + '(let () + (eval '(module test30 racket/base + (require racket/contract/base 'prof-fun) + (define (f x) 3) + (define-module-boundary-contract g f (-> (λ _ (named-blame? 'top-level)) + (λ _ (named-blame? 'top-level)))) + (provide g))) + (eval '(require 'test30)) + (eval '(f 2))) + 3) )