[Guile-commits] branch main updated: Test for 'frame-local-ref' errors when printing backtrace.

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script.

civodul pushed a commit to branch main
in repository guile.

The following commit(s) were added to refs/heads/main by this push:
     new fe2a0c54a Test for 'frame-local-ref' errors when printing backtrace.
fe2a0c54a is described below

commit fe2a0c54ac7863a705da8f64fd548e4817b3fb72
Author: Andrew Whatson <whatson@gmail.com>
AuthorDate: Wed Jan 11 14:04:32 2023 +1000

    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>
---
 test-suite/tests/eval.test | 23 ++++++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

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