Fix get-custom-snapshots to conform to the docs.

2014-02-04 12:27:53 -05:00 · 2014-02-04 12:27:53 -05:00 · 7d45129fca
commit 7d45129fca
parent 01ca493389
2 changed files with 4 additions and 7 deletions
--- a/pkgs/contract-profile/main.rkt
+++ b/pkgs/contract-profile/main.rkt
@ -219,5 +219,5 @@
        (define samples (sampler 'get-snapshots))
        (define contract-samples
          (for/list ([s (in-list (sampler 'get-custom-snapshots))])
-            (and s (vector-ref s 0))))
+            (and (not (empty? s)) (vector-ref (car s) 0))))
        (analyze-contract-samples contract-samples samples)))))
--- a/pkgs/profile-pkgs/profile-lib/sampler.rkt
+++ b/pkgs/profile-pkgs/profile-lib/sampler.rkt
@ -124,12 +124,9 @@
               (unless (eq? t sampler-thread)
                 (when custom-keys
                   (set! custom-snapshots
-                         (cons (let ([cms (continuation-mark-set->list*
-                                           (continuation-marks t)
-                                           custom-keys)])
-                                 (if (null? cms)
-                                     #f
-                                     (car cms))) ; value
+                         (cons (continuation-mark-set->list*
+                                (continuation-marks t)
+                                custom-keys) ; frames
                               custom-snapshots)))
                 (set! snapshots
                       (cons (list* (thread-id t)