A little utility for testing the trace of a function

test-trace.rkt

#lang racket/base

(require 
  rackunit
  racket/match
  (for-syntax 
    racket/base
    syntax/parse))

(define-syntax (check-trace stx)
  (syntax-parse stx
    [(_ (f:id args ...) trace-checker)
     #`(test-begin
         (let ([f- f]
               [input-filter (car trace-checker)]
               [trace-pred (cdr trace-checker)])
           (let-values ([(trace traced-f) (make-traced f- input-filter)])
             (set! f traced-f)
             (traced-f args ...)
             (check-pred trace-pred (unbox trace))
             (set! f f-))))]))

(define (make-traced f pred)
  (define depth -1)
  (define trace (box '()))
  (values
    trace
    (lambda args
      (if (apply pred args)
          (begin
            (set! depth (add1 depth))
            (let ([r (apply f args)])
              (set-box! trace (cons (list depth args r) (unbox trace)))
              (set! depth (sub1 depth))
              r))
          (apply f args)))))

(define (make-finite-prefix-trace-check ls)
  (define-values (foo bar)
    (let loop ([ls ls])
      (match ls
        ['() (values 
               (lambda _ #f)
               ;; Assumes an empty trace is a valid trace; doesn't test existance properties
               (lambda (t) #t))]
        [`((,input . ,output) . ,ls)
          (define-values (input-filter trace-pred)
            (loop ls))
          (values
            (lambda x
              (or (equal? x input)
                  (apply input-filter x)))
            (lambda (t)
              (match t
                [`((,_ ,tinput ,toutput) . ,trest)
                  #:when (equal? tinput input)
                  (and (equal? toutput output)
                       (trace-pred trest))]
                [_ #f])))])))
  (cons foo bar))

(module+ test
  (define (fact n)
    (if (zero? n)
        1
        (* n (fact (sub1 n)))))

  (check-trace 
    (fact 5)
    (make-finite-prefix-trace-check
      `(((5) . 120)
        ((4) . 24)
        ((3) . 6)
        ((2) . 2)
        ((1) . 1)
        #;((0) . 1)))))