From e7ec0b5d055203ca45f4513fb50b9351613b1408 Mon Sep 17 00:00:00 2001 From: Vincent St-Amour Date: Thu, 18 Jul 2013 10:20:40 -0400 Subject: [PATCH] Fix bug when profiling with no samples. --- pkgs/contract-profile/boundary-view.rkt | 17 +++++------ pkgs/contract-profile/dot.rkt | 4 +-- pkgs/contract-profile/main.rkt | 40 ++++++++++++------------- pkgs/contract-profile/tests.rkt | 20 +++++++++++++ pkgs/contract-profile/utils.rkt | 10 +++++++ 5 files changed, 58 insertions(+), 33 deletions(-) create mode 100644 pkgs/contract-profile/tests.rkt diff --git a/pkgs/contract-profile/boundary-view.rkt b/pkgs/contract-profile/boundary-view.rkt index 5e3af33cb5..52769a235b 100644 --- a/pkgs/contract-profile/boundary-view.rkt +++ b/pkgs/contract-profile/boundary-view.rkt @@ -119,22 +119,19 @@ s))) (boundary contracted-function boundary-edges b time-spent))) - (with-output-to-file boundary-graph-dot-file - #:exists 'replace - (lambda () (render all-boundaries contracts->keys))) + (with-output-to-report-file boundary-graph-dot-file + (render all-boundaries contracts->keys)) (render-dot boundary-graph-dot-file) ;; print contract key ;; TODO find a way to add to pdf ;; TODO also to add to pdf: show proportion of time spent in contracts ;; otherwise we have no idea if we're looking at a case where contracts are ;; bottlenecks or not - (with-output-to-file contract-key-file - #:exists 'replace - (lambda () - (for ([contract+key (in-list contracts->keys)]) - (printf "[~a] = ~a\n" - (cdr contract+key) - (car contract+key)))))) + (with-output-to-report-file contract-key-file + (for ([contract+key (in-list contracts->keys)]) + (printf "[~a] = ~a\n" + (cdr contract+key) + (car contract+key))))) ;; given a profile node, return all the boundaries centered there diff --git a/pkgs/contract-profile/dot.rkt b/pkgs/contract-profile/dot.rkt index 2a1dcab06f..9c6a24fa3c 100644 --- a/pkgs/contract-profile/dot.rkt +++ b/pkgs/contract-profile/dot.rkt @@ -3,7 +3,7 @@ ;; Graphviz support ;; inspired by redex/private/dot.rkt (can't use directly because it uses GUI) -(require racket/system) +(require racket/system "utils.rkt") (provide render-dot) @@ -25,5 +25,5 @@ dot-paths))) (define (render-dot input-file) - (when dot + (when (and dot (not (dry-run?))) (system (format "~a -Tpdf -O ~a" (path->string dot) input-file)))) diff --git a/pkgs/contract-profile/main.rkt b/pkgs/contract-profile/main.rkt index b2cbd4b6dc..5d7a4297e2 100644 --- a/pkgs/contract-profile/main.rkt +++ b/pkgs/contract-profile/main.rkt @@ -33,9 +33,8 @@ (define (analyze-contract-samples contract-samples samples*) (define correlated (correlate-contract-samples contract-samples samples*)) - (with-output-to-file cost-breakdown-file - #:exists 'replace - (lambda () (print-breakdown correlated))) + (with-output-to-report-file cost-breakdown-file + (print-breakdown correlated)) (module-graph-view correlated) (boundary-view correlated)) @@ -53,7 +52,7 @@ live-contract-samples all-blames regular-profile) correlated) - (define contract-ratio (/ n-contract-samples n-samples 1.0)) + (define contract-ratio (/ n-contract-samples (max n-samples 1) 1.0)) (printf "Running time is ~a% contracts\n" (~r (* 100 contract-ratio) #:precision 2)) (printf "~a/~a samples\n" n-contract-samples n-samples) @@ -171,23 +170,22 @@ (values n typed?))) ;; graphviz output - (with-output-to-file module-graph-dot-file - #:exists 'replace - (lambda () - (printf "digraph {\n") - (define nodes->names (for/hash ([n nodes]) (values n (gensym)))) - (for ([n nodes]) - (printf "~a[label=\"~a\"][color=\"~a\"]\n" - (hash-ref nodes->names n) - n - (if (hash-ref nodes->typed? n) "green" "red"))) - (for ([(k v) (in-hash edge-samples)]) - (match-define (cons pos neg) k) - (printf "~a -> ~a[label=\"~ams\"]\n" - (hash-ref nodes->names neg) - (hash-ref nodes->names pos) - (samples-time v))) - (printf "}\n"))) + (with-output-to-report-file + module-graph-dot-file + (printf "digraph {\n") + (define nodes->names (for/hash ([n nodes]) (values n (gensym)))) + (for ([n nodes]) + (printf "~a[label=\"~a\"][color=\"~a\"]\n" + (hash-ref nodes->names n) + n + (if (hash-ref nodes->typed? n) "green" "red"))) + (for ([(k v) (in-hash edge-samples)]) + (match-define (cons pos neg) k) + (printf "~a -> ~a[label=\"~ams\"]\n" + (hash-ref nodes->names neg) + (hash-ref nodes->names pos) + (samples-time v))) + (printf "}\n")) ;; render, if graphviz is installed (render-dot module-graph-dot-file)) diff --git a/pkgs/contract-profile/tests.rkt b/pkgs/contract-profile/tests.rkt new file mode 100644 index 0000000000..90618add3e --- /dev/null +++ b/pkgs/contract-profile/tests.rkt @@ -0,0 +1,20 @@ +#lang racket/base + +(require contract-profile (only-in contract-profile/utils dry-run?)) + +(module+ test + (require rackunit) + + (dry-run? #t) ; don't output to files + + ;; reported by Greg Hendershott + (check-true (contract-profile #t)) + + (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 (matrix? (contract-profile (main))))) + ) diff --git a/pkgs/contract-profile/utils.rkt b/pkgs/contract-profile/utils.rkt index dd878badd6..3ec0457261 100644 --- a/pkgs/contract-profile/utils.rkt +++ b/pkgs/contract-profile/utils.rkt @@ -19,3 +19,13 @@ (cadr s))) (define output-file-prefix "tmp-contract-profile-") + + +;; for testing. don't generate output files +(define dry-run? (make-parameter #f)) + +(define-syntax-rule (with-output-to-report-file file body ...) + (unless (dry-run?) + (with-output-to-file file + #:exists 'replace + (lambda () body ...))))