Tcl Source Code

    Namespace *globalNsPtr = iPtr->globalNsPtr;
    const char *simpleName;
    Tcl_HashEntry *entryPtr;
    Tcl_DString buffer1, buffer2;
    Tcl_DString *namePtr, *buffPtr;
    int newEntry, nameLen;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    const char *nameStr;
    Tcl_DString tmpBuffer;

    Tcl_DStringInit(&tmpBuffer);

    /*
     * If there is no active namespace, the interpreter is being initialized.
     */

    if ((globalNsPtr == NULL) && (iPtr->varFramePtr == NULL)) {
	/*
	 * Treat this namespace as the global namespace, and avoid looking for
	 * a parent.
	 */

	parentPtr = NULL;
	simpleName = "";
	goto doCreate;
    }

    /*
     * Ensure that there are no trailing colons as that causes chaos when a
     * deleteProc is specified. [Bug d614d63989]
     */

    if (deleteProc != NULL) {
	nameStr = name + strlen(name) - 2;
	if (nameStr >= name && nameStr[1] == ':' && nameStr[0] == ':') {
	    Tcl_DStringAppend(&tmpBuffer, name, -1);
	    while ((nameLen = Tcl_DStringLength(&tmpBuffer)) > 0
		    && Tcl_DStringValue(&tmpBuffer)[nameLen-1] == ':') {
		Tcl_DStringSetLength(&tmpBuffer, nameLen-1);
	    }
	    name = Tcl_DStringValue(&tmpBuffer);
	}
    }

    /*
     * If we've ended up with an empty string now, we're attempting to create
     * the global namespace despite the global namespace existing. That's
     * naughty!
     */

    if (*name == '\0') {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "can't create namespace \"\": "
		"only global namespace can have empty name", NULL);
	Tcl_DStringFree(&tmpBuffer);
	return NULL;
    }

    /*
     * Find the parent for the new namespace.
     */

    TclGetNamespaceForQualName(interp, name, NULL, TCL_CREATE_NS_IF_UNKNOWN,
	    &parentPtr, &dummy1Ptr, &dummy2Ptr, &simpleName);

    /*
     * If the unqualified name at the end is empty, there were trailing "::"s
     * after the namespace's name which we ignore. The new namespace was
     * already (recursively) created and is pointed to by parentPtr.
     */

    if (*simpleName == '\0') {
	Tcl_DStringFree(&tmpBuffer);
	return (Tcl_Namespace *) parentPtr;
    }

    /*
     * Check for a bad namespace name and make sure that the name does not
     * already exist in the parent namespace.
     */

    if (Tcl_FindHashEntry(&parentPtr->childTable, simpleName) != NULL) {
	Tcl_AppendResult(interp, "can't create namespace \"", name,
		"\": already exists", NULL);
	Tcl_DStringFree(&tmpBuffer);
	return NULL;

    }

    /*
     * Create the new namespace and root it in its parent. Increment the count
     * of namespaces created.
     */

  doCreate:
    nsPtr = (Namespace *) ckalloc(sizeof(Namespace));
    nsPtr->name = ckalloc((unsigned) (strlen(simpleName)+1));
    strcpy(nsPtr->name, simpleName);
    nsPtr->fullName = NULL;		/* Set below. */
    nsPtr->clientData = clientData;
    nsPtr->deleteProc = deleteProc;
    nsPtr->parentPtr = parentPtr;

    name = Tcl_DStringValue(namePtr);
    nameLen = Tcl_DStringLength(namePtr);
    nsPtr->fullName = ckalloc((unsigned) (nameLen+1));
    memcpy(nsPtr->fullName, name, (unsigned) nameLen + 1);

    Tcl_DStringFree(&buffer1);
    Tcl_DStringFree(&buffer2);
    Tcl_DStringFree(&tmpBuffer);

    /*
     * Return a pointer to the new namespace.
     */

    return (Tcl_Namespace *) nsPtr;
}