Fix bug when profiling with no samples.

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
+  (with-output-to-report-file boundary-graph-dot-file
-    #:exists 'replace
+                              (render all-boundaries contracts->keys))
-    (lambda () (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
+  (with-output-to-report-file contract-key-file
-    #:exists 'replace
-    (lambda ()
                               (for ([contract+key (in-list contracts->keys)])
                                 (printf "[~a] = ~a\n"
                                         (cdr contract+key)
-                (car contract+key))))))
+                                        (car contract+key)))))
 
 
 ;; given a profile node, return all the boundaries centered there

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))))

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
+  (with-output-to-report-file cost-breakdown-file
-    #:exists 'replace
+                              (print-breakdown correlated))
-    (lambda () (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,9 +170,8 @@
       (values n typed?)))
 
   ;; graphviz output
-  (with-output-to-file module-graph-dot-file
+  (with-output-to-report-file
-    #:exists 'replace
+   module-graph-dot-file
-    (lambda ()
    (printf "digraph {\n")
    (define nodes->names (for/hash ([n nodes]) (values n (gensym))))
    (for ([n nodes])
@@ -187,7 +185,7 @@
              (hash-ref nodes->names neg)
              (hash-ref nodes->names pos)
              (samples-time v)))
-      (printf "}\n")))
+   (printf "}\n"))
   ;; render, if graphviz is installed
   (render-dot module-graph-dot-file))
 

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)))))
+  )

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 ...))))