summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclInt.h3
-rw-r--r--generic/tclNamesp.c89
2 files changed, 49 insertions, 43 deletions
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4da08f9..008980a 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -433,10 +433,13 @@ struct NamespacePathEntry {
* TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns.
* TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces.
* TCL_FIND_ONLY_NS - The name sought is a namespace name.
+ * TCL_FIND_IF_NOT_SIMPLE - Retrieve last namespace even if the rest of
+ * name is not simple name (contains ::).
*/
#define TCL_CREATE_NS_IF_UNKNOWN 0x800
#define TCL_FIND_ONLY_NS 0x1000
+#define TCL_FIND_IF_NOT_SIMPLE 0x2000
/*
* The client data for an ensemble command. This consists of the table of
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 7a32fd9..dab51c3 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -718,9 +718,9 @@ Tcl_CreateNamespace(
if (*name == '\0') {
Tcl_SetObjResult(interp, Tcl_NewStringObj("can't create namespace"
- " \"\": only global namespace can have empty name", -1));
+ " \"\": only global namespace can have empty name", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
- "CREATEGLOBAL", (void *)NULL);
+ "CREATEGLOBAL", (char *)NULL);
Tcl_DStringFree(&tmpBuffer);
return NULL;
}
@@ -759,7 +759,7 @@ Tcl_CreateNamespace(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create namespace \"%s\": already exists", name));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "NAMESPACE",
- "CREATEEXISTING", (void *)NULL);
+ "CREATEEXISTING", (char *)NULL);
Tcl_DStringFree(&tmpBuffer);
return NULL;
}
@@ -1438,8 +1438,8 @@ Tcl_Export(
if ((exportNsPtr != nsPtr) || (strcmp(pattern, simplePattern) != 0)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("invalid export pattern"
- " \"%s\": pattern can't specify a namespace", pattern));
- Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", (void *)NULL);
+ " \"%s\": pattern can't specify a namespace", pattern));
+ Tcl_SetErrorCode(interp, "TCL", "EXPORT", "INVALID", (char *)NULL);
return TCL_ERROR;
}
@@ -1645,7 +1645,7 @@ Tcl_Import(
if (strlen(pattern) == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("empty import pattern",-1));
- Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "IMPORT", "EMPTY", (char *)NULL);
return TCL_ERROR;
}
TclGetNamespaceForQualName(interp, pattern, nsPtr, TCL_NAMESPACE_ONLY,
@@ -1653,21 +1653,21 @@ Tcl_Import(
if (importNsPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unknown namespace in import pattern \"%s\"", pattern));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, (void *)NULL);
+ "unknown namespace in import pattern \"%s\"", pattern));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, (char *)NULL);
return TCL_ERROR;
}
if (importNsPtr == nsPtr) {
if (pattern == simplePattern) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"no namespace specified in import pattern \"%s\"",
- pattern));
- Tcl_SetErrorCode(interp, "TCL", "IMPORT", "ORIGIN", (void *)NULL);
+ pattern));
+ Tcl_SetErrorCode(interp, "TCL", "IMPORT", "ORIGIN", (char *)NULL);
} else {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "import pattern \"%s\" tries to import from namespace"
- " \"%s\" into itself", pattern, importNsPtr->name));
- Tcl_SetErrorCode(interp, "TCL", "IMPORT", "SELF", (void *)NULL);
+ "import pattern \"%s\" tries to import from namespace"
+ " \"%s\" into itself", pattern, importNsPtr->name));
+ Tcl_SetErrorCode(interp, "TCL", "IMPORT", "SELF", (char *)NULL);
}
return TCL_ERROR;
}
@@ -1786,11 +1786,11 @@ DoImport(
linkCmd = dataPtr->realCmdPtr;
if (overwrite == linkCmd) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "import pattern \"%s\" would create a loop"
- " containing command \"%s\"",
- pattern, Tcl_DStringValue(&ds)));
+ "import pattern \"%s\" would create a loop"
+ " containing command \"%s\"",
+ pattern, Tcl_DStringValue(&ds)));
Tcl_DStringFree(&ds);
- Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "IMPORT", "LOOP", (char *)NULL);
return TCL_ERROR;
}
}
@@ -1831,8 +1831,8 @@ DoImport(
}
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't import command \"%s\": already exists", cmdName));
- Tcl_SetErrorCode(interp, "TCL", "IMPORT", "OVERWRITE", (void *)NULL);
+ "can't import command \"%s\": already exists", cmdName));
+ Tcl_SetErrorCode(interp, "TCL", "IMPORT", "OVERWRITE", (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -1902,7 +1902,7 @@ Tcl_ForgetImport(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown namespace in namespace forget pattern \"%s\"",
pattern));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", pattern, (char *)NULL);
return TCL_ERROR;
}
@@ -2329,11 +2329,8 @@ TclGetNamespaceForQualName(
if (flags & TCL_FIND_ONLY_NS) {
nsName = start;
} else {
- *nsPtrPtr = nsPtr;
- *altNsPtrPtr = altNsPtr;
*simpleNamePtr = start;
- Tcl_DStringFree(&buffer);
- return TCL_OK;
+ goto done;
}
} else {
/*
@@ -2383,6 +2380,15 @@ TclGetNamespaceForQualName(
}
} else { /* Namespace not found and was not
* created. */
+ if (flags & TCL_FIND_IF_NOT_SIMPLE) {
+ /*
+ * return last found NS and not simple name relative it,
+ * e. g. ::A::B::C::D -> ::A::B and C::D, if
+ * namespace C cannot be found in ::A::B
+ */
+ *simpleNamePtr = start;
+ goto done;
+ }
nsPtr = NULL;
}
}
@@ -2413,11 +2419,8 @@ TclGetNamespaceForQualName(
*/
if ((nsPtr == NULL) && (altNsPtr == NULL)) {
- *nsPtrPtr = NULL;
- *altNsPtrPtr = NULL;
*simpleNamePtr = NULL;
- Tcl_DStringFree(&buffer);
- return TCL_OK;
+ goto done;
}
start = end;
@@ -2447,6 +2450,7 @@ TclGetNamespaceForQualName(
nsPtr = NULL;
}
+done:
*nsPtrPtr = nsPtr;
*altNsPtrPtr = altNsPtr;
Tcl_DStringFree(&buffer);
@@ -2536,8 +2540,8 @@ Tcl_FindNamespace(
if (flags & TCL_LEAVE_ERR_MSG) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unknown namespace \"%s\"", name));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, (void *)NULL);
+ "unknown namespace \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, (char *)NULL);
}
return NULL;
}
@@ -2726,8 +2730,8 @@ Tcl_FindCommand(
if (flags & TCL_LEAVE_ERR_MSG) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unknown command \"%s\"", name));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, (void *)NULL);
+ "unknown command \"%s\"", name));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", name, (char *)NULL);
}
return NULL;
}
@@ -2921,7 +2925,7 @@ TclGetNamespaceFromObj(
"namespace \"%s\" not found in \"%s\"", name,
Tcl_GetStringResult(interp)));
}
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", name, (char *)NULL);
return TCL_ERROR;
}
return TCL_OK;
@@ -2949,8 +2953,8 @@ GetNamespaceFromObj(
refNsPtr = resNamePtr->refNsPtr;
if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp)
&& (!refNsPtr || (refNsPtr ==
- (Namespace *) TclGetCurrentNamespace(interp)))) {
- *nsPtrPtr = (Tcl_Namespace *) nsPtr;
+ (Namespace *)TclGetCurrentNamespace(interp)))) {
+ *nsPtrPtr = (Tcl_Namespace *)nsPtr;
return TCL_OK;
}
Tcl_StoreInternalRep(objPtr, &nsNameType, NULL);
@@ -3310,10 +3314,10 @@ NamespaceDeleteCmd(
if ((namespacePtr == NULL)
|| (((Namespace *) namespacePtr)->flags & NS_TEARDOWN)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "unknown namespace \"%s\" in namespace delete command",
+ "unknown namespace \"%s\" in namespace delete command",
TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE",
- TclGetString(objv[i]), (void *)NULL);
+ TclGetString(objv[i]), (char *)NULL);
return TCL_ERROR;
}
}
@@ -3945,9 +3949,9 @@ NamespaceOriginCmd(
Tcl_DecrRefCount(resultPtr);
namespaceOriginError:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "invalid command name \"%s\"", TclGetString(objv[1])));
+ "invalid command name \"%s\"", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND",
- TclGetString(objv[1]), (void *)NULL);
+ TclGetString(objv[1]), (char *)NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, resultPtr);
@@ -4839,7 +4843,7 @@ SetNsNameFromAny(
if ((name[0] == ':') && (name[1] == ':')) {
resNamePtr->refNsPtr = NULL;
} else {
- resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
+ resNamePtr->refNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
}
resNamePtr->refCount = 0;
NsNameSetInternalRep(objPtr, resNamePtr);
@@ -4931,8 +4935,7 @@ TclLogCommandInfo(
const char *command, /* First character in command that generated
* the error. */
Tcl_Size length, /* Number of bytes in command (< 0 means use
- * all bytes up to first null byte).
- */
+ * all bytes up to first null byte). */
const unsigned char *pc, /* Current pc of bytecode execution context */
Tcl_Obj **tosPtr) /* Current stack of bytecode execution
* context */
@@ -4983,7 +4986,7 @@ TclLogCommandInfo(
return;
} else {
Tcl_HashEntry *hPtr
- = Tcl_FindHashEntry(&iPtr->varTraces, (char *) varPtr);
+ = Tcl_FindHashEntry(&iPtr->varTraces, (char *)varPtr);
VarTrace *tracePtr = (VarTrace *)Tcl_GetHashValue(hPtr);
if (tracePtr->traceProc != EstablishErrorInfoTraces) {
generated by cgit v0.12 at 2024-11-16 09:23:38 (GMT)