{"size": 3374, "ext": "rktl", "max_stars_repo_path": "pkgs/racket-test-core/tests/racket/trace.rktl", "max_stars_repo_name": "lkh01/racket", "max_stars_repo_stars_event_min_datetime": "2018-07-05T21:18:24.000Z", "max_stars_repo_stars_event_max_datetime": "2021-06-04T14:48:37.000Z", "max_issues_repo_path": "pkgs/racket-test-core/tests/racket/trace.rktl", "max_issues_repo_name": "lkh01/racket", "max_issues_repo_issues_event_min_datetime": "2017-05-10T07:33:20.000Z", "max_issues_repo_issues_event_max_datetime": "2018-07-19T15:49:46.000Z", "max_forks_repo_path": "pkgs/racket-test-core/tests/racket/trace.rktl", "max_forks_repo_name": "lkh01/racket", "max_forks_repo_forks_event_min_datetime": "2016-04-25T11:47:57.000Z", "max_forks_repo_forks_event_max_datetime": "2017-05-09T14:52:48.000Z"}
{"max_stars_count": 4, "max_issues_count": 9, "max_forks_count": 3, "avg_line_length": 25.5606060606, "max_line_length": 83, "alphanum_fraction": 0.4386484884}
(load-relative "loadtest.rktl")

(Section 'trace)

(require racket/trace)

(define-syntax-rule (trace-output expr ...)
  (let ([out '()])
    (parameterize ([current-trace-notify
                    (lambda (e) (set! out (cons e out)))])
      expr ...
      (reverse out))))

(let ([n1 (let ([out '()])
            (parameterize ([current-trace-notify
                            (lambda (e) (set! out (cons e out)))])
              (define (foo x) x)
              (trace foo)
              (foo 2)
              out))])
  (test (reverse n1) 'test-it (list ">(foo 2)" "<2")))

(test (trace-output
        (define (foo x) x)
        (trace foo)
        (foo 2))
      'simple-trace
      (list ">(foo 2)"
            "<2"))

(test (trace-output
        (define (foo x) (add1 x))
        (trace foo)
        (foo 2))
      'simple-trace
      (list ">(foo 2)"
            "<3"))

(test (trace-output
        (define (a x) x)
        (define (b x) (a x))
        (define (c x) (+ (b x) (b x)))
        (trace a b c)
        (c 1))
      'trace2
      (list ">(c 1)"
            "> (b 1)"
            "> (a 1)"
            "< 1"
            "> (b 1)"
            "> (a 1)"
            "< 1"
            "<2"))

(test (trace-output
       (define (f x #:q w) (list x 1))
       (trace f)
       (f #:q (box 18) '(1 2 3)))
      'trace-quotes
      (list ">(f '(1 2 3) #:q '#&18)"
            "<'((1 2 3) 1)"))

(parameterize ([print-as-expression #f])
  (test (trace-output
         (define (f x #:q w) (list x 1))
         (trace f)
         (f #:q (box 18) '(1 2 3)))
        'trace-quotes
        (list ">(f (1 2 3) #:q #&18)"
              "<((1 2 3) 1)")))

(test
  (list ">(verbose-fact 2)"
        "> (verbose-fact 1)"
        "> >(verbose-fact 0)"
        "< <1"
        "> >(verbose-fact 0)"
        "< <1"
        "< 1"
        "> (verbose-fact 1)"
        "> >(verbose-fact 0)"
        "< <1"
        "> >(verbose-fact 0)"
        "< <1"
        "< 1"
        "<2")
  'trace-define
  (trace-output
    (trace-define (verbose-fact x)
      (if (zero? x)
        (begin (displayln 1) 1)
        (begin (displayln (* x (verbose-fact (sub1 x))))
               (* x (verbose-fact (sub1 x))))))
    (parameterize ([current-output-port (open-output-nowhere)]) (verbose-fact 2))))

(test
  (list ">(fact 120)"
        "<120")
  'trace-lambda-named
  (trace-output
    ((trace-lambda #:name fact (x) x) 120)))

(let ([tout (trace-output ((trace-lambda (x) x) 120))])
  (local-require racket/match)
  (test #t
        'trace-lambda-anonymous
        (match tout
          [(list (pregexp #px">\\(.+\\.rktl?:\\d+:\\d+[|]? 120\\)") "<120") #t]
          [_ #f])))

(let* ([file-name (lambda (x)
                   (last (string-split
                         (car (string-split x ":"))
                         "/")))]
      [proc-file-name (compose file-name symbol->string object-name)])
  (local-require syntax/location)
  (let ([current-file-name (file-name (quote-source-file))]
         [f1 (trace-lambda (x) x)])
    (trace-define f2 (lambda (x) x))
    (test current-file-name
          'trace-lambda-source
          (proc-file-name f1))
    (test current-file-name
          'trace-lambda-source
          (proc-file-name f2))
    (trace-let f3 ([x 1])
      (test current-file-name
            'trace-lambda-source
            (proc-file-name f3)))))

(report-errs)
