Changeset 33687 in project


Ignore:
Timestamp:
09/30/16 22:29:21 (5 years ago)
Author:
felix winkelmann
Message:

trace 0.9: added feature to show call-sites and limit output length (thanks to sjamaan + Matt Welland)

Location:
release/4/trace
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/trace/tags/0.9/tests/run.scm

    r17167 r33687  
    1111
    1212(trace foo)
    13 (assert (= 10 (foo 10 0)))
     13(parameterize ((trace-call-sites #t)
     14               (trace-call-site-length-limit 20))
     15  (assert (= 10 (foo 10 0))))
    1416
    1517(define (bar x k)
     
    2022(trace bar)
    2123
    22 (call/cc (lambda (return) (bar 1 return)))
     24(parameterize ((trace-length-limit 20))
     25  (call/cc (lambda (return) (bar 1 return))))
    2326
    2427(break foo)
  • release/4/trace/tags/0.9/trace.scm

    r29165 r33687  
    55               trace untrace
    66               break unbreak
     7               trace-call-sites
     8               trace-call-site-length-limit
     9               trace-length-limit
    710               trace-output-port
    8                continue c 
     11               continue c
    912               traced?
    1013               trace-module untrace-module
     
    2629(define trace-output-port (make-parameter (current-output-port)))
    2730(define trace-verbose (make-parameter #t))
     31(define trace-length-limit (make-parameter #f))
     32(define trace-call-sites (make-parameter #f))
     33(define trace-call-site-length-limit (make-parameter 100))
    2834
    2935(define (break-entry name args)
     
    6167    (trace-indent)
    6268    (set! *trace-indent-level* (fx+ 1 *trace-indent-level*))
    63     (write (cons name args) port)
     69    (##sys#with-print-length-limit
     70     (trace-length-limit)
     71     (lambda ()
     72       (write (cons name args) port)))
     73    (when (trace-call-sites)
     74      (display "     called from " port)
     75      (let* ((cooked-data (car (get-call-chain)))
     76             (mode (vector-ref cooked-data 0))
     77             (expr/form (vector-ref cooked-data 1))
     78             (cntr/frameinfo (vector-ref cooked-data 2))
     79             (fi (##sys#structure? cntr/frameinfo 'frameinfo)))
     80        (display mode port)
     81        (when (and cntr/frameinfo (if fi (##sys#slot cntr/frameinfo 1) #t))
     82          (display " [" port)
     83          (display (if fi
     84                       (##sys#slot cntr/frameinfo 1) ; cntr
     85                       cntr/frameinfo) port)
     86          (display "]" port))
     87        (when expr/form
     88          (##sys#with-print-length-limit
     89           (trace-call-site-length-limit)
     90           (lambda ()
     91             (display #\space port)
     92             (write expr/form port) ) ) )))
    6493    (write-char #\newline port)
    6594    (flush-output port) ) )
  • release/4/trace/trunk/tests/run.scm

    r17167 r33687  
    1111
    1212(trace foo)
    13 (assert (= 10 (foo 10 0)))
     13(parameterize ((trace-call-sites #t)
     14               (trace-call-site-length-limit 20))
     15  (assert (= 10 (foo 10 0))))
    1416
    1517(define (bar x k)
     
    2022(trace bar)
    2123
    22 (call/cc (lambda (return) (bar 1 return)))
     24(parameterize ((trace-length-limit 20))
     25  (call/cc (lambda (return) (bar 1 return))))
    2326
    2427(break foo)
  • release/4/trace/trunk/trace.scm

    r29165 r33687  
    55               trace untrace
    66               break unbreak
     7               trace-call-sites
     8               trace-call-site-length-limit
     9               trace-length-limit
    710               trace-output-port
    8                continue c 
     11               continue c
    912               traced?
    1013               trace-module untrace-module
     
    2629(define trace-output-port (make-parameter (current-output-port)))
    2730(define trace-verbose (make-parameter #t))
     31(define trace-length-limit (make-parameter #f))
     32(define trace-call-sites (make-parameter #f))
     33(define trace-call-site-length-limit (make-parameter 100))
    2834
    2935(define (break-entry name args)
     
    6167    (trace-indent)
    6268    (set! *trace-indent-level* (fx+ 1 *trace-indent-level*))
    63     (write (cons name args) port)
     69    (##sys#with-print-length-limit
     70     (trace-length-limit)
     71     (lambda ()
     72       (write (cons name args) port)))
     73    (when (trace-call-sites)
     74      (display "     called from " port)
     75      (let* ((cooked-data (car (get-call-chain)))
     76             (mode (vector-ref cooked-data 0))
     77             (expr/form (vector-ref cooked-data 1))
     78             (cntr/frameinfo (vector-ref cooked-data 2))
     79             (fi (##sys#structure? cntr/frameinfo 'frameinfo)))
     80        (display mode port)
     81        (when (and cntr/frameinfo (if fi (##sys#slot cntr/frameinfo 1) #t))
     82          (display " [" port)
     83          (display (if fi
     84                       (##sys#slot cntr/frameinfo 1) ; cntr
     85                       cntr/frameinfo) port)
     86          (display "]" port))
     87        (when expr/form
     88          (##sys#with-print-length-limit
     89           (trace-call-site-length-limit)
     90           (lambda ()
     91             (display #\space port)
     92             (write expr/form port) ) ) )))
    6493    (write-char #\newline port)
    6594    (flush-output port) ) )
Note: See TracChangeset for help on using the changeset viewer.