From 7f31302868d92415abd3d4589efec9d783c3f6b7 Mon Sep 17 00:00:00 2001
From: Kris Katterjohn <katterjohn@gmail.com>
Date: Fri, 5 Jul 2024 17:37:54 -0400
Subject: [PATCH] transl: do not assume a catch's mode based on the last body
 form

It's not uncommon for user code to throw a symbol on failure, when
the last body form of a catch has a very different mode.

Even in other cases with, e.g., only numbers involved, it's been
trivial to get a lisp error due to an incorrect mode assumption:

(%i1) foo () := throw (1/2)$

(%i2) bar () := 1 + catch (foo (), 2)$

(%i3) translate (foo, bar)$

(%i4) bar ();
<lisp error>

No problems with the test suite, share test suite or rtest_translator.
New tests have been added to rtest_translator.
---
 src/trans1.lisp            |  7 ++-----
 tests/rtest_translator.mac | 18 ++++++++++++++++++
 2 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/src/trans1.lisp b/src/trans1.lisp
index 9da3570e9..7e1249f0a 100644
--- a/src/trans1.lisp
+++ b/src/trans1.lisp
@@ -143,13 +143,10 @@
     (declare (ignore mode))
     (cons '$any `(cons '(mlist) (errcatch ,body)))))
 
-;;; The MODE of a CATCH could either be the MODE of the last of the PROGN
-;;; or the mode of the THROW. The THROW may be hard to find, so this goes
-;;; on the assumption that the mode of the PROGN is enough to tell.
-
 (def%tr $catch (form)
   (destructuring-bind (mode . body) (translate `((mprogn) . ,(cdr form)))
-    (cons mode `(mcatch ,body))))
+    (declare (ignore mode))
+    (cons '$any `(mcatch ,body))))
 
 (def%tr $throw (form)
   (destructuring-bind (mode . body) (translate (cadr form))
diff --git a/tests/rtest_translator.mac b/tests/rtest_translator.mac
index 3a34d7386..9276f70c4 100644
--- a/tests/rtest_translator.mac
+++ b/tests/rtest_translator.mac
@@ -1998,6 +1998,24 @@ block ([translate : false, l1, l2],
   [l2, is (l1 = l2)]);
 [[3, 13], true];
 
+block ([translate : false, l1, l2],
+  local (foo, bar),
+
+  foo (p) := throw (if p then 1/2 else 'other),
+  bar (p) := 1 + catch (foo (p), 2),
+
+  l1 : [bar (true), bar (false)],
+
+  translate_or_lose (foo, bar),
+
+  l2 : [bar (true), bar (false)],
+
+  [l2, is (l1 = l2)]);
+[[3/2, 1 + 'other], true];
+
+(kill (foo, bar), 0);
+0;
+
 /* Translating a define_variable form with translate (but not
  * translate_file or compfile) used to invoke undefined behavior.
  * This would cause a lisp error during translation under some
-- 
2.11.4.GIT