andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

mes: Print backtrace upon exception. 

* mes/module/mes/catch.mes (display-backtrace,
frame-function): New function.
(%eh): Use them.
This commit is contained in:
Jan Nieuwenhuizen 2018-10-20 18:24:37 +02:00
parent a233287c07
commit 00dc02757b
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
2 changed files with 27 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
mes/module/mes/catch.mes
View File

@ -31,6 +31,8 @@
(core:display-error ":")
(core:write-error args)
(core:display-error "\n")))
(core:display-error "Backtrace:\n")
(display-backtrace (make-stack) (current-error-port))
(exit 1))))
(define (catch key thunk handler)
@ -54,3 +56,16 @@
(apply handler (cons key args))))
(define with-throw-handler catch) ; FIXME: hack for Nyacc 0.75
(define (frame-procedure frame)
(struct-ref frame 3))
(define (display-backtrace stack port . rest)
(let* ((frames (map (lambda (i) (stack-ref stack i)) (iota (stack-length stack))))
(call-frames (filter frame-procedure frames))
(display-frames (drop-right call-frames 2)))
(for-each (lambda (f)
(core:display-error " ")
(core:display-error f)
(core:display-error "\n"))
display-frames)))

25
tests/catch.test
View File

@ -54,18 +54,17 @@ exec ${MES-src/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
(lambda (key . args)
789)))
(if mes?
(pass-if-equal "catch feel"
1
(let ((save-exit exit))
(set! exit (lambda (x)
(set! exit save-exit)
1))
(catch 'boo
(lambda ()
(throw-22)
11)
(lambda (key . args)
22)))))
(pass-if-equal "catch feel"
1
(catch 'twenty-two
(lambda _
(catch 'boo
(lambda ()
(throw-22)
11)
(lambda (key . args)
(exit 1))))
(lambda (key . args)
1)))
(result 'report)