diff options
author | Andrew Whatson <whatson@gmail.com> | 2023-01-11 14:04:32 +1000 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2023-01-11 23:09:07 +0100 |
commit | fe2a0c54ac7863a705da8f64fd548e4817b3fb72 (patch) | |
tree | 9778f3b29b7666cba92f9202e7b24161d4130c72 | |
parent | f3ea8f7fa1d84a559c7bf834fe5b675abe0ae7b8 (diff) | |
download | guile-fe2a0c54ac7863a705da8f64fd548e4817b3fb72.tar.gz |
Test for 'frame-local-ref' errors when printing backtrace.
This test reproduces the error from <https://bugs.gnu.org/56493>, and
passes with the workaround which was merged in commit
c7fa78fc751eb336bcfafbb5ac59c460ee2c5d7a.
* test-suite/tests/eval.test ("avoid frame-local-ref out of range"): New
test.
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
-rw-r--r-- | test-suite/tests/eval.test | 23 |
1 files changed, 22 insertions, 1 deletions
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test index 9d20812f2..316153385 100644 --- a/test-suite/tests/eval.test +++ b/test-suite/tests/eval.test @@ -22,6 +22,7 @@ :use-module ((system vm vm) :select (call-with-stack-overflow-handler)) :use-module ((system vm frame) :select (frame-call-representation)) :use-module (ice-9 documentation) + :use-module (ice-9 exceptions) :use-module (ice-9 local-eval)) @@ -387,7 +388,27 @@ (and (eq? (car (frame-call-representation (car frames))) 'make-stack) (eq? (car (frame-call-representation (car (last-pair frames)))) - 'with-exception-handler))))) + 'with-exception-handler)))) + + (pass-if "avoid frame-local-ref out of range" + (with-exception-handler + (lambda (ex) + ;; If frame-call-representation fails, we'll catch that + ;; instead of the expected "Wrong type to apply" error. + (string-prefix? "Wrong type to apply" (exception-message ex))) + (lambda () + (with-exception-handler + (lambda (ex) + (let* ((stack (make-stack #t)) + (frames (stack->frames stack))) + (for-each frame-call-representation frames)) + (raise-exception ex)) + (lambda () + ;; This throws a "Wrong type to apply" error, creating a + ;; frame with an incorrect number of local slots as + ;; described in bug <https://bugs.gnu.org/56493>. + (primitive-eval '(define foo (#t)))))) + #:unwind? #t))) ;;; ;;; letrec init evaluation |