(mat compile-profile
  (error? ; invalid argument
    (compile-profile 'src))
  (eqv?
    (parameterize ([compile-profile #t])
      (compile-profile))
    'source)
  (eqv?
    (parameterize ([compile-profile 'source])
      (compile-profile))
    'source)
  (eqv?
    (parameterize ([compile-profile 'block])
      (compile-profile))
    'block)
  (error? ; incorrect argument count
    (profile-dump '()))
  (error? ; incorrect argument count
    (profile-clear '()))
  (error? ; incorrect argument count
    (profile-dump-list #t '() 3))
  (error? ; invalid dump
    (profile-dump-list #f 17))
  (error? ; invalid dump
    (profile-dump-list #f '(17)))
  (error? ; invalid dump
    (profile-dump-list #f '((a . 17))))
  (error? ; invalid dump
    (profile-dump-list #f `((,(make-source-object (source-file-descriptor "abc" 34) 0 3) . q))))
  (error? ; incorrect argument count
    (profile-dump-html "" '() 3))
  (error? ; not a string
    (profile-dump-html '(prefix)))
  (error? ; invalid dump
    (profile-dump-html "profile" 17))
  (error? ; invalid dump
    (profile-dump-html "profile" '(17)))
  (error? ; invalid dump
    (profile-dump-html "profile" '((a . 17))))
  (error? ; invalid dump
    (profile-dump-html "profile" `((,(make-source-object (source-file-descriptor "abc" 34) 0 3) . q))))
  (error? ; incorrect argument count
    (profile-dump-data))
  (error? ; incorrect argument count
    (profile-dump-data "profile.data" '() 'q))
  (error? ; not a string
    (profile-dump-data #t))
  (error? ; invalid dump
    (profile-dump-data "profile.data" 17))
  (error? ; invalid dump
    (profile-dump-data "profile.data" '(17)))
  (error? ; invalid dump
    (profile-dump-data "profile.data" '((a . 17))))
  (error? ; invalid dump
    (profile-dump-data "profile.data" `((,(make-source-object (source-file-descriptor "abc" 34) 0 3) . q))))
  (error? ; not a string
    (profile-load-data 'what?))
  (eqv? (parameterize ([compile-profile #t])
          (compile
            '(let ()
               (define (f x) (if (= x 0) 1 (* x (f (- x 1)))))
               (f 3))))
        6)
  (eqv? (parameterize ([compile-profile #t])
          (compile
            '(let ()
               (define fat+
                 (lambda (x y)
                   (if (zero? y)
                       x
                       (fat+ (1+ x) (1- y)))))
               (define fatfib
                 (lambda (x)
                   (if (< x 2)
                       1
                       (fat+ (fatfib (1- x)) (fatfib (1- (1- x)))))))
               (fatfib 20))))
         10946)
  (equal?
    (parameterize ([compile-profile #t])
      (compile
        '(let ()
           (define $values (lambda (n) (lambda () (apply values (make-list n)))))
           (define foo
             (lambda (n)
               (call/cc
                 (lambda (k)
                   (with-exception-handler
                     (lambda (c) (collect) (k 'okay))
                     (lambda ()
                       (define f (case-lambda))
                       (let ([x (random 10)])
                         (call-with-values ($values n) f))))))))
           (list (foo 0) (foo 1) (foo 3) (foo 10) (foo 100) (foo 1000)))))
    '(okay okay okay okay okay okay))
  ; no longer recording (useless) profiling information when source file & position aren't available
  #;(let ([ls (profile-dump)])
    (and (list? ls)
      (not (null? ls))))
  (eqv? (profile-clear) (void))
  (or (eq? (compile-profile) 'source) (andmap zero? (map cdr (remp preexisting-profile-dump-entry? (profile-dump)))))
  (begin (set! cp-fatfib (void)) #t) ; release fatfib

  (begin (define $old-cp (compile-profile)) #t)
  ; this collect is here to make it more likely that we won't get a generation 1
  ; collection cementing in place the code that defines cp-fact
  (begin (collect 1) #t)
  (mat/cf (testfile "testfile")
    (eval-when (compile) (compile-profile 'source))
    (define (cp-fact x) (if (= x 0) 1 (* x (cp-fact (- x 1))))))
  (eq? (compile-profile) $old-cp)
  ; drop code that defines cp-fact so it won't show up in profile-dump-list in
  ; hopes of resolving potential issue with comparison to pdl further down
  (begin (collect (collect-maximum-generation)) #t)
  (= (cp-fact 10) 3628800)
  (begin
    (define (prefix=? prefix s)
      (let ([n (string-length prefix)])
        (and (>= (string-length s) n) (string=? (substring s 0 n) prefix))))
    (define (sdir? x) (or (prefix=? "../s" (cadr x)) (prefix=? "../unicode" (cadr x))))
    (define-values (pdl pdl2)
      (with-interrupts-disabled
        (parameterize ([source-directories (cons* "../s" "../unicode" (source-directories))])
          (values
            (remp sdir? (profile-dump-list #t (profile-dump)))
            (remp sdir? (profile-dump-list))))))
    #t)
  (equal? pdl pdl2)
  (not (null? pdl))
  (begin
    (rm-rf "testdir")
    (mkdir "testdir")
    (parameterize ([gensym-prefix 0]) (profile-dump-html "testdir/" (profile-dump)))
    #t)
  (file-exists? "testdir/profile.html")
  (file-exists? "testdir/testfile.ss.html")

  (begin (define $old-cp (compile-profile)) #t)
  (mat/cf (testfile "testfile-block")
    (eval-when (compile) (compile-profile 'block))
    (define (cp-fact-block x) (if (= x 0) 1 (* x (cp-fact-block (- x 1))))))
  (eq? (compile-profile) $old-cp)
  (= (cp-fact-block 10) 3628800)
  (or (equal? (compile-profile) 'source)
      (equal?
        (parameterize ([source-directories (cons* "../s" "../unicode" (source-directories))])
          (remp sdir? (profile-dump-list)))
        pdl))
  (begin
    (parameterize ([source-directories (cons* "../s" "../unicode" (source-directories))])
      (profile-dump-html))
    #t)
  (file-exists? "profile.html")
  (file-exists? "testfile.ss.html")
  (not (file-exists? "testfile2.ss.html"))

  (eqv? (profile-clear) (void))

  (mat/cf (testfile "testfile")
    (eval-when (compile) (compile-profile #t))
    (define (cp-fact x) (if (= x 0) 1 (* x (cp-fact (- x 1))))))
  (= (cp-fact 10) 3628800)
  (eqv? (profile-dump-data "testfile1.pd" (remp preexisting-profile-dump-entry? (profile-dump))) (void))
  (file-exists? "testfile1.pd")
  (eqv? (profile-load-data) (void))
  (eqv? (profile-load-data "testfile1.pd") (void))
  (begin
    (define $cp-ip (open-file-input-port "testfile.ss"))
    (define $cp-sfd (make-source-file-descriptor "testfile.ss" $cp-ip))
    (define $qw (lambda (bfp efp) (profile-query-weight (make-source-object $cp-sfd bfp efp))))
    #t)

  (eqv? (close-port $cp-ip) (void))

  (eqv? ($qw 0 0) 0.0) ; bfp, efp combination not in database
  (eqv? ; file not in database
    (let* ([fn (format "~a/Mf-base" *mats-dir*)]
           [ip (open-file-input-port fn)]
           [sfd (make-source-file-descriptor fn ip)])
      (close-port ip)
      (profile-query-weight (make-source-object sfd 0 0)))
    #f)
  ((lambda (x) (and (memv x (list 0.0 (/ 1.0 11.0))) #t)) ($qw 0 42))
  ((lambda (x) (and (memv x (list 0.0 (/ 1.0 11.0))) #t)) ($qw 43 102))
  (eqv? ($qw 63 101) 1.0)
  (eqv? ($qw 75 76) (fl/ 1.0 11.0))
  (eqv? ($qw 77 100) (fl/ 10.0 11.0))
  ((lambda (x) (and (memv x (list 0.0 (/ 1.0 11.0))) #t)) ($qw 103 127))
  (eqv? ($qw 119 126) 0.0)
  (eqv? ($qw 120 125) 0.0)
  (eqv? (profile-clear) (void))
  (= (cp-fact 5) 120)
  (eqv? (profile-dump-data "testfile2.pd" (remp preexisting-profile-dump-entry? (profile-dump))) (void))
  (eqv? (profile-load-data "testfile2.pd") (void))
  ((lambda (x) (and (memv x (list 0.0 (/ 1.0 11.0) (fl/ (/ 1.0 11.0) 2.0))) #t)) ($qw 0 42))
  (eqv? ($qw 21 40) 0.0)
  ((lambda (x) (and (memv x (list 0.0 (/ 1.0 11.0) (fl/ (/ 1.0 11.0) 2.0))) #t)) ($qw 43 102))
  (eqv? ($qw 63 101) 1.0)
  (eqv? ($qw 75 76) (fl/ (fl+ (/ 1.0 11.0) (fl/ 1.0 6.0)) 2.0))
  (eqv? ($qw 77 100) (fl/ (fl+ (fl/ 10.0 11.0) (fl/ 5.0 6.0)) 2.0))
  ((lambda (x) (and (memv x (list 0.0 (/ 1.0 11.0) (fl/ (/ 1.0 11.0) 2.0))) #t)) ($qw 103 127))
  (eqv? ($qw 119 126) 0.0)
  (eqv? ($qw 120 125) 0.0)
  (eqv? (profile-clear) (void))

  ; make sure all is well when compiled with source profile info
  (mat/cf (testfile "testfile")
    (eval-when (compile) (compile-profile 'block))
    (define (cp-fact x) (if (= x 0) 1 (* x (cp-fact (- x 1))))))
  (eqv? (profile-dump-data "testfile3.pd" (remp preexisting-profile-dump-entry? (profile-dump))) (void))
  (file-exists? "testfile3.pd")
  (eqv? (profile-load-data "testfile3.pd") (void))
  ; and again with block profile info
  (mat/cf (testfile "testfile")
    (eval-when (compile) (compile-profile #f))
    (define (cp-fact x) (if (= x 0) 1 (* x (cp-fact (- x 1))))))
  (= (cp-fact 5) 120)

  (eqv? (profile-clear-database) (void))
  (eqv? ($qw 0 42) #f)
  (eqv? ($qw 77 100) #f)

  ; make sure record-ref, record-type, and record-cd are properly handled by
  ; find-source in pdhtml
  (mat/cf
    (eval-when (compile) (compile-profile #t))
    (library (A) (export make-foo foo? foo-x) (import (chezscheme)) (define-record-type foo (fields x)))
    (let ()
      (import (A))
      (define add-foo-xs
        (lambda ls
          (let f ([ls ls] [sum 0])
            (if (null? ls) sum (f (cdr ls) (+ (foo-x (car ls)) sum))))))
      ; make sure this is still around when we call profile-dump-list
      (set! $add-foo-xs add-foo-xs)
      (pretty-print (add-foo-xs (make-foo 1) (make-foo 2) (make-foo 3)))))
  (not (null? (profile-dump-list)))
  (eqv? (profile-clear) (void))
  (begin (set! $add-foo-xs #f) #t)

  (vector? (profile-palette))
  (vector?
    (parameterize ([profile-palette (vector-map
                                      (lambda (p) (cons "white" (car p)))
                                      (profile-palette))])
      (profile-palette)))
  (parameterize ([profile-palette
                  '#(("black" . "white")
                     ("red" . "white")
                     ("blue" . "black"))])
    (= (vector-length (profile-palette)) 3))
  (error? (profile-palette '#()))
  (error? (profile-palette '#(("black" . "white"))))
  (error? (profile-palette '#(("black" . "white") ("red" . "white"))))
  (error?
    (profile-palette
      '#(("black" . "white")
         #("red" "white")
         ("blue" . "black"))))
  (error?
    (profile-palette
      '#(("black" . "white")
         ("red" . "white")
         ("blue" . black))))
  (error?
    (profile-palette
      '#(("black" . "white")
         ("red" . "white")
         (#x0000ff . "black"))))
  ; test for proper counts in the presence of control operators
  (begin
    (define $return)
    (define $retry)
    (with-output-to-file "testfile-cp1.ss"
      (lambda ()
        (display-string "\
(define $frumble
  (lambda (ls)
    (if (null? ls)
        1
        (let ([n (car ls)])
          (if (eqv? n 0)
              (call/cc (lambda (k) (set! $retry k) ($return 0)))
              (let ([q ($frumble (cdr ls))])
                (add1 (* q n))))))))
"))
      'replace)
    (profile-clear)
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2] [compile-profile #t])
      (load "testfile-cp1.ss" compile))
    #t)
  (eqv?
    ($frumble (make-list 100 5))
    9860761315262647567646607066034827870915080438862787559628486633300781)
  (equal?
    (filter (lambda (x) (equal? (cadr x) "testfile-cp1.ss")) (profile-dump-list))
    '((101 "testfile-cp1.ss" 36 258 3 5)
      (101 "testfile-cp1.ss" 40 50 3 9)
      (101 "testfile-cp1.ss" 41 46 3 10)
      (101 "testfile-cp1.ss" 47 49 3 16)
      (100 "testfile-cp1.ss" 69 257 5 9)
      (100 "testfile-cp1.ss" 78 86 5 18)
      (100 "testfile-cp1.ss" 79 82 5 19)
      (100 "testfile-cp1.ss" 83 85 5 23)
      (100 "testfile-cp1.ss" 99 256 6 11)
      (100 "testfile-cp1.ss" 103 113 6 15)
      (100 "testfile-cp1.ss" 104 108 6 16)
      (100 "testfile-cp1.ss" 109 110 6 21)
      (100 "testfile-cp1.ss" 111 112 6 23)
      (100 "testfile-cp1.ss" 193 255 8 15)
      (100 "testfile-cp1.ss" 202 221 8 24)
      (100 "testfile-cp1.ss" 203 211 8 25)
      (100 "testfile-cp1.ss" 212 220 8 34)
      (100 "testfile-cp1.ss" 213 216 8 35)
      (100 "testfile-cp1.ss" 217 219 8 39)
      (100 "testfile-cp1.ss" 240 254 9 17)
      (100 "testfile-cp1.ss" 241 245 9 18)
      (100 "testfile-cp1.ss" 246 253 9 23)
      (100 "testfile-cp1.ss" 247 248 9 24)
      (100 "testfile-cp1.ss" 249 250 9 26)
      (100 "testfile-cp1.ss" 251 252 9 28)
      (1 "testfile-cp1.ss" 0 260 1 1)
      (1 "testfile-cp1.ss" 19 259 2 3)
      (1 "testfile-cp1.ss" 59 60 4 9)
      (0 "testfile-cp1.ss" 128 178 7 15)
      (0 "testfile-cp1.ss" 129 136 7 16)
      (0 "testfile-cp1.ss" 137 177 7 24)
      (0 "testfile-cp1.ss" 149 164 7 36)
      (0 "testfile-cp1.ss" 162 163 7 49)
      (0 "testfile-cp1.ss" 165 176 7 52)
      (0 "testfile-cp1.ss" 166 173 7 53)
      (0 "testfile-cp1.ss" 174 175 7 61)))
  (eqv? 
    (call/cc
      (lambda (k)
        (set! $return k)
        (let ([ans ($frumble (append (make-list 50 5) (list 0) (make-list 50 7)))])
          ($return ans))))
    0)
  (equal?
    (filter (lambda (x) (equal? (cadr x) "testfile-cp1.ss")) (profile-dump-list))
    '((152 "testfile-cp1.ss" 36 258 3 5)
      (152 "testfile-cp1.ss" 40 50 3 9)
      (152 "testfile-cp1.ss" 41 46 3 10)
      (152 "testfile-cp1.ss" 47 49 3 16)
      (151 "testfile-cp1.ss" 69 257 5 9)
      (151 "testfile-cp1.ss" 78 86 5 18)
      (151 "testfile-cp1.ss" 79 82 5 19)
      (151 "testfile-cp1.ss" 83 85 5 23)
      (151 "testfile-cp1.ss" 99 256 6 11)
      (151 "testfile-cp1.ss" 103 113 6 15)
      (151 "testfile-cp1.ss" 104 108 6 16)
      (151 "testfile-cp1.ss" 109 110 6 21)
      (151 "testfile-cp1.ss" 111 112 6 23)
      (150 "testfile-cp1.ss" 193 255 8 15)
      (150 "testfile-cp1.ss" 202 221 8 24)
      (150 "testfile-cp1.ss" 203 211 8 25)
      (150 "testfile-cp1.ss" 212 220 8 34)
      (150 "testfile-cp1.ss" 213 216 8 35)
      (150 "testfile-cp1.ss" 217 219 8 39)
      (100 "testfile-cp1.ss" 240 254 9 17)
      (100 "testfile-cp1.ss" 241 245 9 18)
      (100 "testfile-cp1.ss" 246 253 9 23)
      (100 "testfile-cp1.ss" 247 248 9 24)
      (100 "testfile-cp1.ss" 249 250 9 26)
      (100 "testfile-cp1.ss" 251 252 9 28)
      (1 "testfile-cp1.ss" 0 260 1 1)
      (1 "testfile-cp1.ss" 19 259 2 3)
      (1 "testfile-cp1.ss" 59 60 4 9)
      (1 "testfile-cp1.ss" 128 178 7 15)
      (1 "testfile-cp1.ss" 129 136 7 16)
      (1 "testfile-cp1.ss" 137 177 7 24)
      (1 "testfile-cp1.ss" 149 164 7 36)
      (1 "testfile-cp1.ss" 162 163 7 49)
      (1 "testfile-cp1.ss" 165 176 7 52)
      (1 "testfile-cp1.ss" 166 173 7 53)
      (1 "testfile-cp1.ss" 174 175 7 61)))
  (eqv?
    (call/cc
      (lambda (k)
        (set! $return k)
        ($retry 1)))
    111022302462515654042363166809082031)
  (equal?
    (filter (lambda (x) (equal? (cadr x) "testfile-cp1.ss")) (profile-dump-list))
    '((152 "testfile-cp1.ss" 36 258 3 5)
      (152 "testfile-cp1.ss" 40 50 3 9)
      (152 "testfile-cp1.ss" 41 46 3 10)
      (152 "testfile-cp1.ss" 47 49 3 16)
      (151 "testfile-cp1.ss" 69 257 5 9)
      (151 "testfile-cp1.ss" 78 86 5 18)
      (151 "testfile-cp1.ss" 79 82 5 19)
      (151 "testfile-cp1.ss" 83 85 5 23)
      (151 "testfile-cp1.ss" 99 256 6 11)
      (151 "testfile-cp1.ss" 103 113 6 15)
      (151 "testfile-cp1.ss" 104 108 6 16)
      (151 "testfile-cp1.ss" 109 110 6 21)
      (151 "testfile-cp1.ss" 111 112 6 23)
      (150 "testfile-cp1.ss" 193 255 8 15)
      (150 "testfile-cp1.ss" 202 221 8 24)
      (150 "testfile-cp1.ss" 203 211 8 25)
      (150 "testfile-cp1.ss" 212 220 8 34)
      (150 "testfile-cp1.ss" 213 216 8 35)
      (150 "testfile-cp1.ss" 217 219 8 39)
      (150 "testfile-cp1.ss" 240 254 9 17)
      (150 "testfile-cp1.ss" 241 245 9 18)
      (150 "testfile-cp1.ss" 246 253 9 23)
      (150 "testfile-cp1.ss" 247 248 9 24)
      (150 "testfile-cp1.ss" 249 250 9 26)
      (150 "testfile-cp1.ss" 251 252 9 28)
      (1 "testfile-cp1.ss" 0 260 1 1)
      (1 "testfile-cp1.ss" 19 259 2 3)
      (1 "testfile-cp1.ss" 59 60 4 9)
      (1 "testfile-cp1.ss" 128 178 7 15)
      (1 "testfile-cp1.ss" 129 136 7 16)
      (1 "testfile-cp1.ss" 137 177 7 24)
      (1 "testfile-cp1.ss" 149 164 7 36)
      (1 "testfile-cp1.ss" 162 163 7 49)
      (1 "testfile-cp1.ss" 165 176 7 52)
      (1 "testfile-cp1.ss" 166 173 7 53)
      (1 "testfile-cp1.ss" 174 175 7 61)))
  (begin
    (collect (collect-maximum-generation)) ; drop code object for the define and lambda
    (profile-release-counters) ; drop proile information for the dropped code object
    #t)
  (equal?
    (filter (lambda (x) (equal? (cadr x) "testfile-cp1.ss")) (profile-dump-list))
    '((152 "testfile-cp1.ss" 36 258 3 5)
      (152 "testfile-cp1.ss" 40 50 3 9)
      (152 "testfile-cp1.ss" 41 46 3 10)
      (152 "testfile-cp1.ss" 47 49 3 16)
      (151 "testfile-cp1.ss" 69 257 5 9)
      (151 "testfile-cp1.ss" 78 86 5 18)
      (151 "testfile-cp1.ss" 79 82 5 19)
      (151 "testfile-cp1.ss" 83 85 5 23)
      (151 "testfile-cp1.ss" 99 256 6 11)
      (151 "testfile-cp1.ss" 103 113 6 15)
      (151 "testfile-cp1.ss" 104 108 6 16)
      (151 "testfile-cp1.ss" 109 110 6 21)
      (151 "testfile-cp1.ss" 111 112 6 23)
      (150 "testfile-cp1.ss" 193 255 8 15)
      (150 "testfile-cp1.ss" 202 221 8 24)
      (150 "testfile-cp1.ss" 203 211 8 25)
      (150 "testfile-cp1.ss" 212 220 8 34)
      (150 "testfile-cp1.ss" 213 216 8 35)
      (150 "testfile-cp1.ss" 217 219 8 39)
      (150 "testfile-cp1.ss" 240 254 9 17)
      (150 "testfile-cp1.ss" 241 245 9 18)
      (150 "testfile-cp1.ss" 246 253 9 23)
      (150 "testfile-cp1.ss" 247 248 9 24)
      (150 "testfile-cp1.ss" 249 250 9 26)
      (150 "testfile-cp1.ss" 251 252 9 28)
      (1 "testfile-cp1.ss" 59 60 4 9)
      (1 "testfile-cp1.ss" 128 178 7 15)
      (1 "testfile-cp1.ss" 129 136 7 16)
      (1 "testfile-cp1.ss" 137 177 7 24)
      (1 "testfile-cp1.ss" 149 164 7 36)
      (1 "testfile-cp1.ss" 162 163 7 49)
      (1 "testfile-cp1.ss" 165 176 7 52)
      (1 "testfile-cp1.ss" 166 173 7 53)
      (1 "testfile-cp1.ss" 174 175 7 61)))
  ; test profiling with compiled files
  (begin
    (with-output-to-file "testfile-cp2.ss"
      (lambda ()
        (display-string "\
(define cp2-fib
  (rec fib
    (lambda (n)
      (cond
        [(fx= n 0) 1]
        [(fx= n 1) 1]
        [else (+ (fib (- n 1)) (fib (- n 2)))]))))
"))
      'replace)
    (parameterize ([enable-cp0 #t] [#%$suppress-primitive-inlining #f] [optimize-level 2] [compile-profile #t])
      (compile-file "testfile-cp2"))
    (profile-clear)
    (load "testfile-cp2.so")
    #t)
  (eqv? (cp2-fib 10) 89)
  (equal?
    (filter (lambda (x) (equal? (cadr x) "testfile-cp2.ss")) (profile-dump-list))
    '((177 "testfile-cp2.ss" 49 146 4 7)
      (177 "testfile-cp2.ss" 64 73 5 10)
      (177 "testfile-cp2.ss" 65 68 5 11)
      (177 "testfile-cp2.ss" 69 70 5 15)
      (177 "testfile-cp2.ss" 71 72 5 17)
      (143 "testfile-cp2.ss" 86 95 6 10)
      (143 "testfile-cp2.ss" 87 90 6 11)
      (143 "testfile-cp2.ss" 91 92 6 15)
      (143 "testfile-cp2.ss" 93 94 6 17)
      (88 "testfile-cp2.ss" 113 144 7 15)
      (88 "testfile-cp2.ss" 114 115 7 16)
      (88 "testfile-cp2.ss" 116 129 7 18)
      (88 "testfile-cp2.ss" 117 120 7 19)
      (88 "testfile-cp2.ss" 121 128 7 23)
      (88 "testfile-cp2.ss" 122 123 7 24)
      (88 "testfile-cp2.ss" 124 125 7 26)
      (88 "testfile-cp2.ss" 126 127 7 28)
      (88 "testfile-cp2.ss" 130 143 7 32)
      (88 "testfile-cp2.ss" 131 134 7 33)
      (88 "testfile-cp2.ss" 135 142 7 37)
      (88 "testfile-cp2.ss" 136 137 7 38)
      (88 "testfile-cp2.ss" 138 139 7 40)
      (88 "testfile-cp2.ss" 140 141 7 42)
      (55 "testfile-cp2.ss" 96 97 6 20)
      (34 "testfile-cp2.ss" 74 75 5 20)
      (1 "testfile-cp2.ss" 0 149 1 1)
      (1 "testfile-cp2.ss" 18 148 2 3)
      (1 "testfile-cp2.ss" 23 26 2 8)
      (1 "testfile-cp2.ss" 31 147 3 5)))
  (begin
    (collect (collect-maximum-generation)) ; drop code object for the define and lambda
    (profile-release-counters) ; drop proile information for the dropped code object
    #t)
  (equal?
    (filter (lambda (x) (equal? (cadr x) "testfile-cp2.ss")) (profile-dump-list))
    '((177 "testfile-cp2.ss" 49 146 4 7)
      (177 "testfile-cp2.ss" 64 73 5 10)
      (177 "testfile-cp2.ss" 65 68 5 11)
      (177 "testfile-cp2.ss" 69 70 5 15)
      (177 "testfile-cp2.ss" 71 72 5 17)
      (143 "testfile-cp2.ss" 86 95 6 10)
      (143 "testfile-cp2.ss" 87 90 6 11)
      (143 "testfile-cp2.ss" 91 92 6 15)
      (143 "testfile-cp2.ss" 93 94 6 17)
      (88 "testfile-cp2.ss" 113 144 7 15)
      (88 "testfile-cp2.ss" 114 115 7 16)
      (88 "testfile-cp2.ss" 116 129 7 18)
      (88 "testfile-cp2.ss" 117 120 7 19)
      (88 "testfile-cp2.ss" 121 128 7 23)
      (88 "testfile-cp2.ss" 122 123 7 24)
      (88 "testfile-cp2.ss" 124 125 7 26)
      (88 "testfile-cp2.ss" 126 127 7 28)
      (88 "testfile-cp2.ss" 130 143 7 32)
      (88 "testfile-cp2.ss" 131 134 7 33)
      (88 "testfile-cp2.ss" 135 142 7 37)
      (88 "testfile-cp2.ss" 136 137 7 38)
      (88 "testfile-cp2.ss" 138 139 7 40)
      (88 "testfile-cp2.ss" 140 141 7 42)
      (55 "testfile-cp2.ss" 96 97 6 20)
      (34 "testfile-cp2.ss" 74 75 5 20)))
  (eqv? (profile-clear) (void))
  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (pretty-print
          '(define f (lambda () 0))))
      'replace)
    (parameterize ([compile-profile #t]) (load "testfile.ss" compile))
    #t)
  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (pretty-print
          '(define f (lambda () 1))))
      'replace)
    #t)
  (eqv? (f) 0)
  (warning? ; unmodified source file not found
    (parameterize ([source-directories (cons* "../s" "../unicode" (source-directories))])
      (profile-dump-list)))
  (warning? ; unmodified source file not found
    (parameterize ([source-directories (cons* "../s" "../unicode" (source-directories))])
      (profile-dump-list #t)))
  (warning? ; unmodified source file not found
    (parameterize ([source-directories (cons* "../s" "../unicode" (source-directories))])
      (profile-dump-list #t (profile-dump))))
  (warning? ; unmodified source file not found
    (parameterize ([source-directories (cons* "../s" "../unicode" (source-directories))])
      (profile-dump-list #t (profile-dump))))
  (guard (c [else #f])
    (profile-dump-list #f)
    #t)
  (guard (c [else #f])
    (profile-dump-list #f (profile-dump))
    #t)
  (eqv? (profile-clear) (void))

  ; verify that annotations are preserved within syntax objects when
  ; profiling is enabled even when generation of inspector information
  ; is disabled.
  (begin
    (mkfile "testfile-ca3.ss"
      '(library (testfile-ca3) (export a) (import (chezscheme))
         (define-syntax a (lambda (x) #'(cons 0 1)))))
    (mkfile "testfile-cp3.ss"
      '(import (chezscheme) (testfile-ca3))
      '(do ([i 123 (fx- i 1)] [q #f a]) ((fx= i 0) (pretty-print q)))
      '(profile-dump-html))
    (separate-compile
      '(lambda (x)
         (parameterize ([generate-inspector-information #f]
                        [compile-profile #t])
           (compile-library x)))
      'ca3)
    (separate-compile
      '(lambda (x)
         (parameterize ([compile-profile #t])
           (compile-program x)))
      'cp3)
    #t)
  (equal?
    (separate-eval
      '(load-program "testfile-cp3.so")
      '(cdr (find (lambda (x) (equal? (source-file-descriptor-path (source-object-sfd (car x))) "testfile-ca3.ss")) (profile-dump))))
    "(0 . 1)\n123\n")

  ; verify that we get profiling information for local macro transformers
  (begin
    (call-with-port (open-output-file "testfile-cp4.ss" 'replace)
      (lambda (op)
        (put-string op "\
(let ()
  (define-syntax a
    (lambda (q)
      (define square
        (lambda (n)
          (* n n)))
      (syntax-case q ()
        [(_ x (d ...) e)
         #`(let ([x (quote #,(map square (datum (d ...))))])
             e)])))
  (pretty-print (list (a b (8 6 7) b) (a b (5 3 0 9) (list b)))))")))
    (delete-file "testfile-cp4.so")
    (parameterize ([print-gensym #f] [current-eval compile] [compile-profile #t])
      (compile-file "testfile-cp4"))
    #t)
  (equal?
    (sort (lambda (x y) (< (list-ref x 2) (list-ref y 2)))
      (filter (lambda (x) (equal? (list-ref x 1) "testfile-cp4.ss"))
        (profile-dump-list)))
    '((1 "testfile-cp4.ss" 31 232 3 5)     ; first transformer count ...
      (2 "testfile-cp4.ss" 72 102 5 9)
      (7 "testfile-cp4.ss" 94 101 6 11)
      (7 "testfile-cp4.ss" 95 96 6 12)
      (7 "testfile-cp4.ss" 97 98 6 14)
      (7 "testfile-cp4.ss" 99 100 6 16)
      (2 "testfile-cp4.ss" 110 231 7 7)
      (2 "testfile-cp4.ss" 123 124 7 20)
      (2 "testfile-cp4.ss" 162 229 9 10)
      (2 "testfile-cp4.ss" 182 210 9 30)
      (2 "testfile-cp4.ss" 183 186 9 31)
      (2 "testfile-cp4.ss" 187 193 9 35)
      (2 "testfile-cp4.ss" 194 209 9 42)   ; ... last transformer count
      ))
  (begin
    (collect (collect-maximum-generation))
    (profile-release-counters)
    #t)
  (equal?
    (with-output-to-string
      (lambda ()
        (revisit "testfile-cp4.so")))
    "((64 36 49) ((25 9 0 81)))\n")
  (equal?
    (sort (lambda (x y) (< (list-ref x 2) (list-ref y 2)))
      (filter (lambda (x) (equal? (list-ref x 1) "testfile-cp4.ss"))
        (profile-dump-list)))
    '((1 "testfile-cp4.ss" 0 299 1 1)      ; top-level let
      (1 "testfile-cp4.ss" 236 298 11 3)   ; pretty-print call ...
      (1 "testfile-cp4.ss" 237 249 11 4)   ; ... and subforms
      (1 "testfile-cp4.ss" 250 297 11 17)
      (1 "testfile-cp4.ss" 251 255 11 18)
      (1 "testfile-cp4.ss" 256 271 11 23)
      (1 "testfile-cp4.ss" 269 270 11 36)
      (1 "testfile-cp4.ss" 272 296 11 39)
      (1 "testfile-cp4.ss" 287 295 11 54)
      (1 "testfile-cp4.ss" 288 292 11 55)
      (1 "testfile-cp4.ss" 293 294 11 60)
      ))
)

(mat profile-form
  (error? ; invalid syntax
    (profile))
  (error? ; invalid syntax
    (profile 1 2 3))
  (error? ; not a source object
    (profile 3))
  (begin
    (define str "(ugh (if \x3b2;))")
    (define bv (string->utf8 str))
    (define ip (open-bytevector-input-port bv))
    (define sfd (make-source-file-descriptor "foo" ip #t))
    #t)
  (eq? (eval `(profile ,(make-source-object sfd 2 3))) (void))
  (begin
    (define compile-triv-file
      (lambda (ifn ofn)
        (define insert-profile-forms
          (lambda (x)
            (unless (annotation? x) (errorf 'compile-triv-file "expected an annotation, got ~s" x))
            (let ([src (annotation-source x)] [exp (annotation-expression x)])
              `(begin (profile ,src)
                 ,(syntax-case exp ()
                    [(?do-times n e)
                      (eq? (annotation-expression #'?do-times) 'do-times)
                      (let ([n (annotation-expression #'n)])
                        `(do ([i ,n (fx- i 1)]) ((fx= i 0)) ,(insert-profile-forms #'e)))]
                    [(?print string)
                      (eq? (annotation-expression #'?print) 'print)
                      `(printf "~a\n" ,(annotation-expression #'string))]
                    [else (syntax-error exp)])))))
        (define parse
          (lambda (ifn)
            (let ([ip (open-file-input-port ifn)])
              (let ([sfd (make-source-file-descriptor ifn ip #t)])
                (let ([ip (transcoded-port ip (native-transcoder))])
                  (let f ([bfp 0])
                    (let-values ([(x bfp) (get-datum/annotations ip sfd bfp)])
                      (if (eof-object? x)
                          (begin (close-port ip) '())
                          (cons x (f bfp))))))))))
        (parameterize ([compile-profile 'source] [generate-profile-forms #f])
          (compile-to-file (list `(define (triv) ,@(map insert-profile-forms (parse ifn)))) ofn))))
    #t)
  (begin
    (with-output-to-file "testfile-triv.ss"
      (lambda ()
        (pretty-print '(do-times 10 (print "hello")))
        (pretty-print '(do-times 5 (print "goodbye"))))
      'replace)
    (compile-triv-file "testfile-triv.ss" "testfile-triv.so")
    (load "testfile-triv.so")
    #t)
  (equal?
    (with-output-to-string triv)
    "hello\nhello\nhello\nhello\nhello\nhello\nhello\nhello\nhello\nhello\ngoodbye\ngoodbye\ngoodbye\ngoodbye\ngoodbye\n")
  (equal?
    (sort
      ; sort by bfp
      (lambda (x y) (< (list-ref x 2) (list-ref y 2)))
      (filter (lambda (x) (equal? (list-ref x 1) "testfile-triv.ss")) (profile-dump-list)))
    '((1 "testfile-triv.ss" 0 29 1 1)
      (10 "testfile-triv.ss" 13 28 1 14)
      (1 "testfile-triv.ss" 30 60 2 1)
      (5 "testfile-triv.ss" 42 59 2 13)))
  (eqv? (profile-clear) (void))
)

(mat coverage
  (begin
    (mkfile "testfile.ss" '(printf "hello\n"))
    (define $ct0 (make-source-table))
    (define $ct0-src1
      (make-source-object
        (call-with-port (open-file-input-port "testfile.ss")
          (lambda (ip)
            (make-source-file-descriptor "testfile.ss" ip #t)))
        3 7))
    (define $ct0-src2
      (make-source-object
        (call-with-port (open-file-input-port "testfile.ss")
          (lambda (ip)
            (make-source-file-descriptor "testfile.ss" ip #t)))
        5 11))
    (define $ct0-src3
      (make-source-object
        (call-with-port (open-file-input-port "testfile.ss")
          (lambda (ip)
            (make-source-file-descriptor "not-testfile.ss" ip #t)))
        17 19))
    #t)
  (source-table? $ct0)
  (= (source-table-size $ct0) 0)
  (not (source-table-contains? $ct0 $ct0-src1))
  (eq? (source-table-ref $ct0 $ct0-src2 'q) 'q)
  (begin
    (source-table-set! $ct0 $ct0-src1 17)
    #t)
  (= (source-table-size $ct0) 1)
  (source-table-contains? $ct0 $ct0-src1)
  (not (source-table-contains? $ct0 $ct0-src2))
  (eq? (source-table-ref $ct0 $ct0-src3 'q) 'q)
  (begin
    (source-table-set! $ct0 $ct0-src2 37)
    (source-table-set! $ct0 $ct0-src3 43)
    #t)
  (= (source-table-size $ct0) 3)
  (source-table-contains? $ct0 $ct0-src1)
  (source-table-contains? $ct0 $ct0-src2)
  (source-table-contains? $ct0 $ct0-src3)
  (eqv? (source-table-ref $ct0 $ct0-src1 'q) 17)
  (eqv? (source-table-ref $ct0 $ct0-src2 'q) 37)
  (eqv? (source-table-ref $ct0 $ct0-src3 'q) 43)
  (let ([a (source-table-cell $ct0 $ct0-src1 #f)])
    (and (eqv? (cdr a) 17)
         (begin
           (set-cdr! a 23)
           #t)))
  (= (source-table-size $ct0) 3)
  (source-table-contains? $ct0 $ct0-src1)
  (source-table-contains? $ct0 $ct0-src2)
  (source-table-contains? $ct0 $ct0-src3)
  (eqv? (source-table-ref $ct0 $ct0-src1 'q) 23)
  (eqv? (source-table-ref $ct0 $ct0-src2 'q) 37)
  (eqv? (source-table-ref $ct0 $ct0-src3 'q) 43)
  (eqv? (source-table-delete! $ct0 $ct0-src1) (void))
  (= (source-table-size $ct0) 2)
  (not (source-table-contains? $ct0 $ct0-src1))
  (source-table-contains? $ct0 $ct0-src2)
  (source-table-contains? $ct0 $ct0-src3)
  (eqv? (source-table-delete! $ct0 $ct0-src3) (void))
  (= (source-table-size $ct0) 1)
  (not (source-table-contains? $ct0 $ct0-src1))
  (source-table-contains? $ct0 $ct0-src2)
  (not (source-table-contains? $ct0 $ct0-src3))
  (eqv? (source-table-delete! $ct0 $ct0-src2) (void))
  (= (source-table-size $ct0) 0)
  (not (source-table-contains? $ct0 $ct0-src1))
  (not (source-table-contains? $ct0 $ct0-src2))
  (not (source-table-contains? $ct0 $ct0-src3))
  (begin
    (define $source-table-filter
      (lambda (universe-ct ct)
        (let ([new-ct (make-source-table)])
          (for-each
            (lambda (p)
              (let ([src (car p)] [count (cdr p)])
                (when (source-table-contains? universe-ct src)
                  (source-table-set! new-ct src count))))
            (source-table-dump ct))
          new-ct)))
    (begin
      (mkfile "testfile-coverage1a.ss"
        '(library (testfile-coverage1a) (export a f) (import (chezscheme))
           (define-syntax a (lambda (x) #'(cons 0 1)))
           (define f (lambda (x) (if (= x 0) 1 (* x (f (- x 1))))))))
      (parameterize ([generate-covin-files #t] [compile-profile #t])
        (compile-library "testfile-coverage1a")))
    (begin
      (mkfile "testfile-coverage1b.ss"
        `(top-level-program
           (import (chezscheme) (testfile-coverage1a))
           (do ([i 3 (fx- i 1)])
               ((fx= i 0) (printf "~s\n" (f 3)))
             (printf "a = ~s\n" a))))
      (call-with-port (open-file-input-port "testfile-coverage1b.ss")
        (lambda (ip)
          (let ([sfd (make-source-file-descriptor "testfile-coverage1b.ss" ip #t)])
            (call-with-port (transcoded-port ip (native-transcoder))
              (lambda (ip)
                (call-with-port (open-file-output-port "testfile-coverage1b.so" (file-options replace))
                  (lambda (op)
                    (call-with-port (open-output-file "testfile-coverage1b.covin" 'replace)
                      (lambda (covop)
                        (parameterize ([compile-profile #t])
                          (compile-port ip op sfd #f covop))))))))))))
    (begin
      (mkfile "testfile-coverage1c.ss"
        '(top-level-program
           (import (chezscheme) (testfile-coverage1a))
           (do ([i 4 (fx- i 1)])
               ((fx= i 0) (printf "~s\n" (f 4)))
             (printf "a = ~s\n" a))))
      (call-with-port (open-file-input-port "testfile-coverage1c.ss")
        (lambda (ip)
          (let ([sfd (make-source-file-descriptor "testfile-coverage1c.ss" ip #t)])
            (call-with-port (transcoded-port ip (native-transcoder))
              (lambda (ip)
                (call-with-port (open-file-output-port "testfile-coverage1c.so" (file-options replace))
                  (lambda (op)
                    (call-with-port (open-output-file "testfile-coverage1c.covin" 'replace)
                      (lambda (covop)
                        (parameterize ([compile-profile #t])
                          (let-values ([(x fp) (get-datum/annotations ip sfd 0)])
                            (compile-to-port (list x) op sfd #f covop)))))))))))))
    (begin
      (mkfile "testfile-coverage1d.ss"
        '(import (chezscheme) (testfile-coverage1a))
        '(do ([i 3 (fx- i 1)])
             ((fx= i 0) (printf "~s\n" (f 5)))
           (printf "a = ~s\n" a)))
      (parameterize ([generate-covin-files #t] [compile-profile #t])
        (compile-program "testfile-coverage1d")))
    (define $ct0
      (let ()
        (define (with-source-input-port path p)
          (call-with-port
            (open-file-input-port path
              (file-options compressed)
              (buffer-mode block)
              (current-transcoder))
            p))
        (let ([ct (make-source-table)])
          (with-source-input-port "testfile-coverage1b.covin" (lambda (ip) (get-source-table! ip ct)))
          (with-source-input-port "testfile-coverage1c.covin" (lambda (ip) (get-source-table! ip ct (lambda (x y) (assert (= x y 0)) x))))
          ct)))
    #t)
  (source-table? $ct0)
  (andmap zero? (map cdr (source-table-dump $ct0)))
  (call-with-values
    (lambda ()
      (with-profile-tracker
        (lambda ()
          (call/cc
            (lambda (k)
              (values k
                (with-output-to-string
                  (lambda ()
                    (load-program "testfile-coverage1b.so")
                    (load-program "testfile-coverage1c.so")
                    (load-program "testfile-coverage1d.so")))))))))
    (lambda (ct k s)
      (let* ([ct ($source-table-filter $ct0 ct)])
        (if k
            (and (string=? s "a = (0 . 1)\na = (0 . 1)\na = (0 . 1)\n6\na = (0 . 1)\na = (0 . 1)\na = (0 . 1)\na = (0 . 1)\n24\na = (0 . 1)\na = (0 . 1)\na = (0 . 1)\n120\n")
                 (procedure? k)
                 (begin
                   (set! $ct1 ct)
                   (k #f "yup.")))
            (and (string=? s "yup.")
                 (begin
                   (set! $ct2 ct)
                   #t))))))
  (source-table? $ct1)
  (source-table? $ct2)
  (and
    (andmap
      (lambda (dumpit)
        (and (source-table-contains? $ct2 (car dumpit))
             (>= (source-table-ref $ct2 (car dumpit) #f) (cdr dumpit))))
      (source-table-dump $ct1))
    (andmap
      (lambda (dumpit)
        (and (source-table-contains? $ct1 (car dumpit))
             (<= (source-table-ref $ct1 (car dumpit) #f) (cdr dumpit))))
      (source-table-dump $ct2)))
  (not (ormap zero? (map cdr (source-table-dump $ct1))))
  (let ([dump (source-table-dump $ct1)])
    (define (file-found? path)
      (ormap
        (lambda (dumpit)
          (string=? (source-file-descriptor-path (source-object-sfd (car dumpit))) path))
        dump))
    (and (file-found? "testfile-coverage1a.ss")
         (file-found? "testfile-coverage1b.ss")
         (file-found? "testfile-coverage1c.ss")
         (not (file-found? "testfile-coverage1d.ss"))))
    (string=?
      (with-output-to-string
        (lambda ()
          ; shouldn't matter whether this is before or after the with-profile-tracker call
          (load-program "testfile-coverage1b.so")
          (let-values ([(ct . ignore) (with-profile-tracker #t
                                        (lambda ()
                                          (load-program "testfile-coverage1c.so")
                                          (load-program "testfile-coverage1d.so")))])
            (let ([ct ($source-table-filter $ct0 ct)])
              (set! $ct3 ct)))))
      "a = (0 . 1)\na = (0 . 1)\na = (0 . 1)\n6\na = (0 . 1)\na = (0 . 1)\na = (0 . 1)\na = (0 . 1)\n24\na = (0 . 1)\na = (0 . 1)\na = (0 . 1)\n120\n")
  (source-table? $ct3)
  (let ([dump (source-table-dump $ct3)])
    (define (file-found? path)
      (ormap
        (lambda (dumpit)
          (string=? (source-file-descriptor-path (source-object-sfd (car dumpit))) path))
        dump))
    (and (file-found? "testfile-coverage1a.ss")
         (file-found? "testfile-coverage1b.ss")
         (file-found? "testfile-coverage1c.ss")
         (not (file-found? "testfile-coverage1d.ss"))))
  ; the coverage table retrieved should include counts for both sets of load-program calls
  (and
    (andmap
      (lambda (dumpit)
        (>= (source-table-ref $ct3 (car dumpit) #f) (* 2 (cdr dumpit))))
      (source-table-dump $ct1))
    (andmap
      (lambda (dumpit)
        (<= (* 2 (source-table-ref $ct1 (car dumpit) #f)) (cdr dumpit)))
      (source-table-dump $ct3)))
  (begin
    (call-with-output-file "testfile.covout"
      (lambda (op)
        (put-source-table op $ct3))
      'replace)
    (define $ct5
      (let ([ct (make-source-table)])
        (call-with-input-file "testfile.covout" (lambda (ip) (get-source-table! ip ct)))
        ct))
    #t)
  (andmap
    (lambda (dumpit)
      (= (source-table-ref $ct5 (car dumpit) #f) (cdr dumpit)))
    (source-table-dump $ct3))
  (andmap
    (lambda (dumpit)
      (= (source-table-ref $ct3 (car dumpit) #f) (cdr dumpit)))
    (source-table-dump $ct5))
  (begin
    (call-with-input-file "testfile.covout" (lambda (ip) (get-source-table! ip $ct5 (lambda (x y) (- (* x y))))))
    #t)
  (andmap
    (lambda (dumpit)
      (= (source-table-ref $ct5 (car dumpit) #f) (- (expt (cdr dumpit) 2))))
    (source-table-dump $ct3))
)