From 7615825fcb937ee6963442176c882ad52a52e7ff Mon Sep 17 00:00:00 2001
From: Steve Bennett <steveb@workware.net.au>
Date: Mon, 10 Jul 2023 08:27:58 +1000
Subject: info script: return real current source file

And allow current source file to be set

Fixes: #268

Signed-off-by: Steve Bennett <steveb@workware.net.au>
---
 jim.c          | 39 ++++++++++++++++++++++++++++++++++++---
 jim.h          |  2 +-
 tests/jim.test | 10 ++++++++++
 3 files changed, 47 insertions(+), 4 deletions(-)

diff --git a/jim.c b/jim.c
index 5d91099..30fc067 100644
--- a/jim.c
+++ b/jim.c
@@ -172,6 +172,23 @@ static int utf8_tounicode_case(const char *s, int *uc, int upper)
     return l;
 }
 
+/* A common pattern is to save an object from interp and set a new
+ * value, and then restore the original. Use this pattern:
+ *
+ * Jim_Obj *saveObj = JimPushInterpObj(interp->obj, newobj);
+ * JimPopInterpObj(interp, interp->obj, saveObj);
+ */
+static Jim_Obj *JimPushInterpObjImpl(Jim_Obj **iop, Jim_Obj *no)
+{
+    Jim_Obj *io = *iop;
+    Jim_IncrRefCount(no);
+    *iop = no;
+    return io;
+}
+
+#define JimPushInterpObj(IO, NO) JimPushInterpObjImpl(&(IO), NO)
+#define JimPopInterpObj(I, IO, SO) do { Jim_DecrRefCount(I, IO); IO = SO; } while (0)
+
 /* These can be used in addition to JIM_CASESENS/JIM_NOCASE */
 #define JIM_CHARSET_SCAN 2
 #define JIM_CHARSET_GLOB 0
@@ -5741,6 +5758,7 @@ Jim_Interp *Jim_CreateInterp(void)
     i->errorProc = i->emptyObj;
     i->nullScriptObj = Jim_NewEmptyStringObj(i);
     i->evalFrame = &i->topEvalFrame;
+    i->currentFilenameObj = Jim_NewEmptyStringObj(i);
     Jim_IncrRefCount(i->emptyObj);
     Jim_IncrRefCount(i->result);
     Jim_IncrRefCount(i->stackTrace);
@@ -5750,6 +5768,7 @@ Jim_Interp *Jim_CreateInterp(void)
     Jim_IncrRefCount(i->errorProc);
     Jim_IncrRefCount(i->trueObj);
     Jim_IncrRefCount(i->falseObj);
+    Jim_IncrRefCount(i->currentFilenameObj);
 
     /* Initialize key variables every interpreter should contain */
     Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY);
@@ -5794,6 +5813,7 @@ void Jim_FreeInterp(Jim_Interp *i)
     Jim_DecrRefCount(i, i->unknown);
     Jim_DecrRefCount(i, i->defer);
     Jim_DecrRefCount(i, i->nullScriptObj);
+    Jim_DecrRefCount(i, i->currentFilenameObj);
 
     /* This will disard any cached commands */
     Jim_InterpIncrProcEpoch(i);
@@ -11641,6 +11661,8 @@ static Jim_Obj *JimReadTextFile(Jim_Interp *interp, const char *filename)
 
 int Jim_EvalFile(Jim_Interp *interp, const char *filename)
 {
+    Jim_Obj *filenameObj;
+    Jim_Obj *oldFilenameObj;
     Jim_Obj *scriptObjPtr;
     int retcode;
 
@@ -11648,10 +11670,16 @@ int Jim_EvalFile(Jim_Interp *interp, const char *filename)
     if (!scriptObjPtr) {
         return JIM_ERR;
     }
-    JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1);
+
+    filenameObj = Jim_NewStringObj(interp, filename, -1);
+    JimSetSourceInfo(interp, scriptObjPtr, filenameObj, 1);
+
+    oldFilenameObj = JimPushInterpObj(interp->currentFilenameObj, filenameObj);
 
     retcode = Jim_EvalObj(interp, scriptObjPtr);
 
+    JimPopInterpObj(interp, interp->currentFilenameObj, oldFilenameObj);
+
     /* Handle the JIM_RETURN return code */
     if (retcode == JIM_RETURN) {
         if (--interp->returnLevel <= 0) {
@@ -15565,7 +15593,7 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
         JIM_DEF_SUBCMD("procs", "?pattern?", 0, 1),
         JIM_DEF_SUBCMD("references", NULL, 0, 0),
         JIM_DEF_SUBCMD("returncodes", "?code?", 0, 1),
-        JIM_DEF_SUBCMD("script", NULL, 0, 0),
+        JIM_DEF_SUBCMD("script", "?filename?", 0, 1),
         JIM_DEF_SUBCMD("source", "source ?filename line?", 1, 3),
         JIM_DEF_SUBCMD("stacktrace", NULL, 0, 0),
         JIM_DEF_SUBCMD("statics", "procname", 1, 1),
@@ -15655,7 +15683,12 @@ static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *arg
             return JIM_OK;
 
         case INFO_SCRIPT:
-            Jim_SetResult(interp, JimGetScript(interp, interp->evalFrame->scriptObj)->fileNameObj);
+            if (argc == 3) {
+                Jim_IncrRefCount(argv[2]);
+                Jim_DecrRefCount(interp, interp->currentFilenameObj);
+                interp->currentFilenameObj = argv[2];
+            }
+            Jim_SetResult(interp, interp->currentFilenameObj);
             return JIM_OK;
 
         case INFO_SOURCE:{
diff --git a/jim.h b/jim.h
index 19c94bb..46ea66f 100644
--- a/jim.h
+++ b/jim.h
@@ -541,7 +541,7 @@ typedef struct Jim_PrngState {
 typedef struct Jim_Interp {
     Jim_Obj *result; /* object returned by the last command called. */
     int unused_errorLine; /* Error line where an error occurred. */
-    Jim_Obj *unused_errorFileNameObj; /* Error file where an error occurred. */
+    Jim_Obj *currentFilenameObj; /* filename of current Jim_EvalFile() */
     int unused_addStackTrace;
     int maxCallFrameDepth; /* Used for infinite loop detection. */
     int maxEvalDepth; /* Used for infinite loop detection. */
diff --git a/tests/jim.test b/tests/jim.test
index 8151712..16e56fa 100644
--- a/tests/jim.test
+++ b/tests/jim.test
@@ -3339,6 +3339,16 @@ test info-7.5 {info vars with temporary variables} {
     }
     t1
 } {a}
+test info-8.1 {info script} {
+    file tail [info script]
+} {jim.test}
+test info-8.2 {info script - set} {
+    set save [info script]
+    list [info script abc] [info script] [file tail [info script $save]]
+} {abc abc jim.test}
+test info-8.3 {info script - usage} -body {
+    info script too many args
+} -returnCodes error -result {wrong # args: should be "info script ?filename?"}
 
 ################################################################################
 # RANGE
-- 
cgit v1.1