aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteve Bennett <steveb@workware.net.au>2023-07-10 08:27:58 +1000
committerSteve Bennett <steveb@workware.net.au>2023-07-10 08:27:58 +1000
commit7615825fcb937ee6963442176c882ad52a52e7ff (patch)
tree10b1c6ea35b66ed125866e18fbdf892dbc1872ab
parentd765fc5bfd0643d4af928e538715beb32c2111db (diff)
downloadjimtcl-7615825fcb937ee6963442176c882ad52a52e7ff.zip
jimtcl-7615825fcb937ee6963442176c882ad52a52e7ff.tar.gz
jimtcl-7615825fcb937ee6963442176c882ad52a52e7ff.tar.bz2
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>
-rw-r--r--jim.c39
-rw-r--r--jim.h2
-rw-r--r--tests/jim.test10
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