* generic/tclConfig.c (Tcl_RegisterConfig): Modified to not extend

	  the config database if the encoding provided by the user is not
	  found (venc == NULL). Scripts expecting the data will error out,
	  however we neither crash nor provide bogus information. See [SF
	  Tcl Bug 983509] for more discussion.

1 files changed, 39 insertions, 36 deletions

diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index e7d9bf3..43c25af 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -9,7 +9,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclConfig.c,v 1.15 2007/11/05 19:58:48 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclConfig.c,v 1.16 2007/11/05 21:26:41 andreas_kupries Exp $
  */
 
 #include "tclInt.h"
@@ -71,17 +71,11 @@ Tcl_RegisterConfig(
     Tcl_Config *cfg;
     Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding);
 
-    if (venc == NULL) {
-	/* Fall back to a builtin encoding if the user supplied one is bogus. */
-	venc = Tcl_GetEncoding(NULL, "iso8859-1");
-    }
-
-    pDB = GetConfigDict(interp);
     pkg = Tcl_NewStringObj(pkgName, -1);
 
     /*
      * Phase I: Adding the provided information to the internal database of
-     * package meta data.
+     * package meta data. Only if we have an ok encoding.
      *
      * Phase II: Create a command for querying this database, specific to the
      * package registerting its configuration. This is the approved interface
@@ -95,46 +89,55 @@ Tcl_RegisterConfig(
     Tcl_IncrRefCount(pkg);
 
     /*
-     * Retrieve package specific configuration...
+     * For venc == NULL aka bogus encoding we skip the step setting up the
+     * dictionaries visible at Tcl level. I.e. they are not filled
      */
 
-    if (Tcl_DictObjGet(interp, pDB, pkg, &pkgDict) != TCL_OK
-	    || (pkgDict == NULL)) {
-        pkgDict = Tcl_NewDictObj();
-    } else if (Tcl_IsShared(pkgDict)) {
-        pkgDict = Tcl_DuplicateObj(pkgDict);
-    }
+    if (venc != NULL) {
+	/*
+	 * Retrieve package specific configuration...
+	 */
 
-    /*
-     * Extend the package configuration...
-     */
+	pDB = GetConfigDict(interp);
 
-    for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) {
-        Tcl_DString conv;
-	CONST char *convValue =
-		Tcl_ExternalToUtfDString(venc, cfg->value, -1, &conv);
+	if (Tcl_DictObjGet(interp, pDB, pkg, &pkgDict) != TCL_OK
+	    || (pkgDict == NULL)) {
+	    pkgDict = Tcl_NewDictObj();
+	} else if (Tcl_IsShared(pkgDict)) {
+	    pkgDict = Tcl_DuplicateObj(pkgDict);
+	}
 
 	/*
-	 * We know that the keys are in ASCII/UTF-8, so for them is no
-	 * conversion required.
+	 * Extend the package configuration...
 	 */
 
-	Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1),
-		Tcl_NewStringObj(convValue, -1));
-	Tcl_DStringFree(&conv);
-    }
+	for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) {
+	    Tcl_DString conv;
+	    CONST char *convValue =
+		Tcl_ExternalToUtfDString(venc, cfg->value, -1, &conv);
 
-    /*
-     * We're now done with the encoding, so drop it.
-     */
+	    /*
+	     * We know that the keys are in ASCII/UTF-8, so for them is no
+	     * conversion required.
+	     */
 
-    Tcl_FreeEncoding(venc);
+	    Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1),
+			   Tcl_NewStringObj(convValue, -1));
+	    Tcl_DStringFree(&conv);
+	}
 
-    /*
-     * Write the changes back into the overall database.
-     */
+	/*
+	 * We're now done with the encoding, so drop it.
+	 */
+
+	Tcl_FreeEncoding(venc);
+
+	/*
+	 * Write the changes back into the overall database.
+	 */
 
-    Tcl_DictObjPut(interp, pDB, pkg, pkgDict);
+	Tcl_DictObjPut(interp, pDB, pkg, pkgDict);
+    }
 
     /*
      * Now create the interface command for retrieval of the package