summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndrew Whatson <whatson@gmail.com>2023-01-11 14:04:32 +1000
committerLudovic Courtès <ludo@gnu.org>2023-01-11 23:09:07 +0100
commitfe2a0c54ac7863a705da8f64fd548e4817b3fb72 (patch)
tree9778f3b29b7666cba92f9202e7b24161d4130c72
parentf3ea8f7fa1d84a559c7bf834fe5b675abe0ae7b8 (diff)
downloadguile-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.test23
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