Attachment "refchan-core-8-branch.diff" to
ticket [4b4830eb54]
added by
chw
2021-03-15 09:45:46.
Index: doc/refchan.n
==================================================================
--- doc/refchan.n
+++ doc/refchan.n
@@ -320,10 +320,23 @@
If the subcommand throws an error the command which caused its
invocation (usually \fBfconfigure\fR or \fBchan configure\fR) will appear to
have thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR,
etc.) is treated as and converted to an error.
.RE
+.TP
+\fIcmdPrefix \fBtruncate\fR \fIchannelId length\fR
+.
+This \fIoptional\fR subcommand handles changing the length of the
+underlying data stream for the channel \fIchannelId\fR. Its length
+gets set to \fIlength\fR.
+.RS
+.PP
+If the subcommand throws an error the command which caused its
+invocation (usually \fBchan truncate\fR) will appear to have thrown
+this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR,
+etc.) is treated as and converted to an error.
+.RE
.SH NOTES
Some of the functions supported in channels defined in Tcl's C
interface are not available to channels reflected to the Tcl level.
.PP
The function \fBTcl_DriverGetHandleProc\fR is not supported;
Index: generic/tclIORChan.c
==================================================================
--- generic/tclIORChan.c
+++ generic/tclIORChan.c
@@ -54,16 +54,18 @@
Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
static int ReflectSetOption(ClientData clientData,
Tcl_Interp *interp, const char *optionName,
const char *newValue);
+static int ReflectTruncate(ClientData clientData,
+ long long length);
static void TimerRunRead(ClientData clientData);
static void TimerRunWrite(ClientData clientData);
/*
* The C layer channel type/driver definition used by the reflection. This is
- * a version 3 structure.
+ * a version 5 structure.
*/
static const Tcl_ChannelType tclRChannelType = {
"tclrchannel", /* Type name. */
TCL_CHANNEL_VERSION_5, /* v5 channel */
@@ -87,11 +89,11 @@
#if TCL_THREADS
ReflectThread, /* thread action, tracking owner */
#else
NULL, /* thread action */
#endif
- NULL /* truncate */
+ ReflectTruncate /* Truncate. NULL'able */
};
/*
* Instance data for a reflected channel. ===========================
*/
@@ -185,10 +187,11 @@
"configure", /* OPT */
"finalize", /* */
"initialize", /* */
"read", /* OPT */
"seek", /* OPT */
+ "truncate", /* OPT */
"watch", /* */
"write", /* OPT */
NULL
};
typedef enum {
@@ -198,20 +201,22 @@
METH_CONFIGURE,
METH_FINAL,
METH_INIT,
METH_READ,
METH_SEEK,
+ METH_TRUNCATE,
METH_WATCH,
METH_WRITE
} MethodName;
#define FLAG(m) (1 << (m))
#define REQUIRED_METHODS \
(FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH))
#define NULLABLE_METHODS \
(FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \
- FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | FLAG(METH_CGETALL))
+ FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | \
+ FLAG(METH_CGETALL) | FLAG(METH_TRUNCATE))
#define RANDW \
(TCL_READABLE | TCL_WRITABLE)
#define IMPLIES(a,b) ((!(a)) || (b))
@@ -237,11 +242,12 @@
ForwardedSeek,
ForwardedWatch,
ForwardedBlock,
ForwardedSetOpt,
ForwardedGetOpt,
- ForwardedGetOptAll
+ ForwardedGetOptAll,
+ ForwardedTruncate
} ForwardedOperation;
/*
* Event used to forward driver invocations to the thread actually managing
* the channel. We cannot construct the command to execute and forward that.
@@ -300,10 +306,14 @@
struct ForwardParamGetOpt {
ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
const char *name; /* Name of option to get, maybe NULL */
Tcl_DString *value; /* Result */
};
+struct ForwardParamTruncate {
+ ForwardParamBase base; /* "Supertype". MUST COME FIRST. */
+ Tcl_WideInt length; /* I: Length of file. */
+};
/*
* Now join all these together in a single union for convenience.
*/
@@ -314,10 +324,11 @@
struct ForwardParamSeek seek;
struct ForwardParamWatch watch;
struct ForwardParamBlock block;
struct ForwardParamSetOpt setOpt;
struct ForwardParamGetOpt getOpt;
+ struct ForwardParamTruncate truncate;
} ForwardParam;
/*
* Forward declaration.
*/
@@ -703,10 +714,13 @@
if (!(methods & FLAG(METH_SEEK))) {
#ifndef TCL_NO_DEPRECATED
clonePtr->seekProc = NULL;
#endif
clonePtr->wideSeekProc = NULL;
+ }
+ if (!(methods & FLAG(METH_TRUNCATE))) {
+ clonePtr->truncateProc = NULL;
}
chanPtr->typePtr = clonePtr;
}
@@ -2044,10 +2058,77 @@
return result;
error:
result = TCL_ERROR;
goto stop;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectTruncate --
+ *
+ * This function is invoked to truncate a channel's file size.
+ *
+ * Results:
+ * A standard Tcl result code.
+ *
+ * Side effects:
+ * Arbitrary, as it calls upon a Tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectTruncate(
+ ClientData clientData, /* Channel to query */
+ long long length) /* Length to truncate to. */
+{
+ ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
+ Tcl_Obj *lenObj;
+ int errorNum; /* EINVAL or EOK (success). */
+ Tcl_Obj *resObj; /* Result for 'truncate' */
+
+ /*
+ * Are we in the correct thread?
+ */
+
+#ifdef TCL_THREADS
+ if (rcPtr->thread != Tcl_GetCurrentThread()) {
+ ForwardParam p;
+
+ p.truncate.length = length;
+
+ ForwardOpToHandlerThread(rcPtr, ForwardedTruncate, &p);
+
+ if (p.base.code != TCL_OK) {
+ PassReceivedError(rcPtr->chan, &p);
+ return EINVAL;
+ }
+
+ return EOK;
+ }
+#endif
+
+ /* ASSERT: rcPtr->method & FLAG(METH_TRUNCATE) */
+
+ Tcl_Preserve(rcPtr);
+
+ lenObj = Tcl_NewIntObj(length);
+ Tcl_IncrRefCount(lenObj);
+
+ if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
+ Tcl_SetChannelError(rcPtr->chan, resObj);
+ errorNum = EINVAL;
+ } else {
+ errorNum = EOK;
+ }
+
+ Tcl_DecrRefCount(lenObj);
+ Tcl_DecrRefCount(resObj); /* Remove reference held from invoke */
+ Tcl_Release(rcPtr);
+ return errorNum;
+}
/*
* Helpers. =========================================================
*/
@@ -3275,10 +3356,23 @@
}
}
}
Tcl_Release(rcPtr);
break;
+
+ case ForwardedTruncate: {
+ Tcl_Obj *lenObj = Tcl_NewIntObj(paramPtr->truncate.length);
+
+ Tcl_IncrRefCount(lenObj);
+ Tcl_Preserve(rcPtr);
+ if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
+ ForwardSetObjError(paramPtr, resObj);
+ }
+ Tcl_Release(rcPtr);
+ Tcl_DecrRefCount(lenObj);
+ break;
+ }
default:
/*
* Bad operation code.
*/
