/usr/share/racket/pkgs/contract-profile/tests.rkt is in racket-common 6.7-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 | #lang racket/base
(require racket/port
contract-profile
(only-in contract-profile/utils make-shortener))
(module+ test
(require rackunit)
;; reported by Greg Hendershott
(define res
(with-output-to-string
(lambda ()
(check-true (contract-profile #:module-graph-file #f
#:boundary-view-file #f
#:boundary-view-key-file #f
#t)))))
(check-regexp-match #rx"^Running time is 0% contracts" res)
;; test options for `contract-profile-thunk`
(let ([res
(with-output-to-string
(lambda ()
(check-false
(contract-profile-thunk
#:module-graph-file #f
#:boundary-view-file #f
#:boundary-view-key-file #f
(lambda () (string? 4))))))])
(check-regexp-match #rx"0% contracts" res))
(require math)
(let ()
(define dim 200)
(define big1 (build-matrix dim dim (lambda (i j) (random))))
(define big2 (build-matrix dim dim (lambda (i j) (random))))
(define (main) (matrix* big1 big2))
(check-true (parameterize ([current-output-port (open-output-nowhere)])
(matrix? (contract-profile (main))))))
;; test path shortening
(define paths '("a/b/c.rkt" "a/b/d.rkt" ("a/b/e.rkt" f) (something else)))
(define shortener (make-shortener paths))
(check-equal? (map shortener paths)
(list (build-path "c.rkt")
(build-path "d.rkt")
(list (build-path "e.rkt") 'f)
'(something else)))
;; test that instrumentation for TR contract combinators works
;; (tests for instrumentation of other contracts is in the contract tests)
(let ([res
(with-output-to-string
(lambda ()
(parameterize ([current-namespace (make-base-namespace)])
(eval '(module server1 typed/racket
(provide v)
(: v Any)
(define v (vector 0))))
(eval '(require 'server1))
(eval '(require contract-profile))
(eval '(contract-profile
(for ([i (in-range 10000000)])
(vector-ref v 0))))
)))])
(check-regexp-match #rx"Any" res))
;; Note: The next two tests originally featured single-argument methods.
;; However, TR's contract generation improved (main by using simple-result->
;; more often) which made the costs of the contracts not be directly
;; observable anymore. Because of this, these tests now use methods that take
;; more arguments.
;; Note to the note: That's not to say that TR's optimization eliminated the
;; cost of contracts altogether. The direct costs seem to be basically gone,
;; but most of the opportunity costs seem to remain.
(let ([res
(with-output-to-string
(lambda ()
(parameterize ([current-namespace (make-base-namespace)])
(eval '(module u racket
(define (mixin cls)
(class cls
(super-new)
(define/public (n x a b c d) (add1 x))))
(provide mixin)))
(eval '(module t typed/racket
;; expects a mixin that adds n
(require/typed
'u
[mixin
(All (r #:row)
(-> (Class #:row-var r)
(Class #:row-var r
[n (-> Integer Integer Integer Integer Integer Integer)])))])
(define c%
(mixin (class object%
(super-new)
(define/public (m x) x))))
(require/typed
contract-profile
[contract-profile-thunk ((-> Any) -> Any)])
(define x (new c%))
(contract-profile-thunk
(lambda ()
(for ([i (in-range 1000000)]) (send x n 1 2 3 4 5))))))
(eval '(require 't))
)))])
(check-regexp-match #rx"mixin" res))
(let ([res
(with-output-to-string
(lambda ()
(parameterize ([current-namespace (make-base-namespace)])
(eval '(module a racket
(provide c%)
(define c%
(class object%
(super-new)
(define/public (m x a b c d) (void))))))
(eval '(module b typed/racket
(require/typed 'a
[c% (Class [m (-> Integer Integer Integer Integer Integer Void)])])
(provide o)
(: o (Object))
(define o (new (class c%
(super-new)
(define/public (n) (void)))))))
(eval '(require 'b contract-profile racket/class))
(eval '(contract-profile
(for ([i (in-range 3000000)])
(send o m 1 2 3 4 5))))
)))])
(check-regexp-match #rx"c%" res))
)
|