From 167c6c45858fa637a872a57cdcdb758cd9e6c77a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Martin=20Povi=C5=A1er?= <povik@cutebit.org>
Date: Fri, 6 Mar 2026 11:52:17 +0100
Subject: [PATCH] Replace deprecated Tcl API to fix use-after-free

Under Tcl 9.0 the Tcl_SetResult utility is a macro:

	#define Tcl_SetResult(interp, result, freeProc) \
		do { \
		    const char *__result = result; \
		    Tcl_FreeProc *__freeProc = freeProc; \
		    Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \
		    if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
			if (__freeProc == TCL_DYNAMIC) { \
			    Tcl_Free((char *)__result); \
			} else { \
			    (*__freeProc)((char *)__result); \
			} \
		    } \
		} while(0)

Temporaries constructed as part of the 'result' expression will be
dropped before the 'result' pointer is used. What was safe when
Tcl_SetResult was a function isn't safe with the macro definition.
Transition away from deprecated SetResult to calling
SetObjResult/MewStringObj directly.
---
 kernel/tclapi.cc | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/kernel/tclapi.cc b/kernel/tclapi.cc
index ec0483a4a..9866f5c98 100644
--- a/kernel/tclapi.cc
+++ b/kernel/tclapi.cc
@@ -279,7 +279,7 @@ static int tcl_get_attr(ClientData, Tcl_Interp *interp, int argc, const char *ar
 		ERROR("object not found")
 
 	if (string_flag) {
-		Tcl_SetResult(interp, (char *) obj->get_string_attribute(attr_id).c_str(), TCL_VOLATILE);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(obj->get_string_attribute(attr_id).c_str(), -1));
 	} else if (int_flag || uint_flag || sint_flag) {
 		if (!obj->has_attribute(attr_id))
 			ERROR("attribute missing (required for -int)");
@@ -295,7 +295,7 @@ static int tcl_get_attr(ClientData, Tcl_Interp *interp, int argc, const char *ar
 		if (!obj->has_attribute(attr_id))
 			ERROR("attribute missing (required unless -bool or -string)")
 
-		Tcl_SetResult(interp, (char *) obj->attributes.at(attr_id).as_string().c_str(), TCL_VOLATILE);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(obj->attributes.at(attr_id).as_string().c_str(), -1));
 	}
 
 	return TCL_OK;
@@ -341,7 +341,7 @@ static int tcl_has_attr(ClientData, Tcl_Interp *interp, int argc, const char *ar
 	if (!obj)
 		ERROR("object not found")
 
-	Tcl_SetResult(interp, (char *) std::to_string(obj->has_attribute(attr_id)).c_str(), TCL_VOLATILE);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(std::to_string(obj->has_attribute(attr_id)).c_str(), -1));
 	return TCL_OK;
 }
 
@@ -465,14 +465,14 @@ static int tcl_get_param(ClientData, Tcl_Interp *interp, int argc, const char *a
 	const RTLIL::Const &value = cell->getParam(param_id);
 
 	if (string_flag) {
-		Tcl_SetResult(interp, (char *) value.decode_string().c_str(), TCL_VOLATILE);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(value.decode_string().c_str(), -1));
 	} else if (int_flag || uint_flag || sint_flag) {
 		mp_int value_mp;
 		if (!const_to_mp_int(value, &value_mp, sint_flag, uint_flag))
 			ERROR("bignum manipulation failed");
 		Tcl_SetObjResult(interp, Tcl_NewBignumObj(&value_mp));
 	} else {
-		Tcl_SetResult(interp, (char *) value.as_string().c_str(), TCL_VOLATILE);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(value.as_string().c_str(), -1));
 	}
 	return TCL_OK;
 }