summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorhobbs <hobbs>2000-03-27 22:18:55 (GMT)
committerhobbs <hobbs>2000-03-27 22:18:55 (GMT)
commit421933f19aa8d89536eea0669c57360ab504db1b (patch)
treeed74dafa9255effac95c093bbd776c37a65c5f1d /generic
parente5c183a2a4ea443f89becd0e62024e6e242ea990 (diff)
downloadtcl-421933f19aa8d89536eea0669c57360ab504db1b.zip
tcl-421933f19aa8d89536eea0669c57360ab504db1b.tar.gz
tcl-421933f19aa8d89536eea0669c57360ab504db1b.tar.bz2
* tests/namespace.test:
* generic/tclNamesp.c (Tcl_Export): added a uniq'ing test to the export list so only one instance of each export pattern would exist in the list. * generic/tclExecute.c (TclExecuteByteCode): optimized case for the empty string in ==/!= comparisons
Diffstat (limited to 'generic')
-rw-r--r--generic/tclExecute.c53
-rw-r--r--generic/tclNamesp.c16
2 files changed, 46 insertions, 23 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 1affb53..bc026b3 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.9 1999/12/12 02:26:42 hobbs Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.10 2000/03/27 22:18:55 hobbs Exp $
*/
#include "tclInt.h"
@@ -1779,30 +1779,39 @@ TclExecuteByteCode(interp, codePtr)
valuePtr = POP_OBJECT();
t1Ptr = valuePtr->typePtr;
t2Ptr = value2Ptr->typePtr;
-
- if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
- s1 = Tcl_GetStringFromObj(valuePtr, &length);
- if (TclLooksLikeInt(s1, length)) {
- (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- valuePtr, &i);
- } else {
- (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- valuePtr, &d1);
+
+ /*
+ * We only want to coerce numeric validation if
+ * neither type is NULL. A NULL type means the arg is
+ * essentially an empty object ("", {} or [list]).
+ */
+ if (!((((t1Ptr == NULL) && (valuePtr->bytes == NULL))
+ || (valuePtr->bytes && (valuePtr->length == 0)))
+ || (((t2Ptr == NULL) && (value2Ptr->bytes == NULL))
+ || (value2Ptr->bytes && (value2Ptr->length == 0))))) {
+ if ((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType)) {
+ s1 = Tcl_GetStringFromObj(valuePtr, &length);
+ if (TclLooksLikeInt(s1, length)) {
+ (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+ valuePtr, &i);
+ } else {
+ (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+ valuePtr, &d1);
+ }
+ t1Ptr = valuePtr->typePtr;
}
- t1Ptr = valuePtr->typePtr;
- }
- if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) {
- s2 = Tcl_GetStringFromObj(value2Ptr, &length);
- if (TclLooksLikeInt(s2, length)) {
- (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
- value2Ptr, &i2);
- } else {
- (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
- value2Ptr, &d2);
+ if ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType)) {
+ s2 = Tcl_GetStringFromObj(value2Ptr, &length);
+ if (TclLooksLikeInt(s2, length)) {
+ (void) Tcl_GetLongFromObj((Tcl_Interp *) NULL,
+ value2Ptr, &i2);
+ } else {
+ (void) Tcl_GetDoubleFromObj((Tcl_Interp *) NULL,
+ value2Ptr, &d2);
+ }
+ t2Ptr = value2Ptr->typePtr;
}
- t2Ptr = value2Ptr->typePtr;
}
-
if (((t1Ptr != &tclIntType) && (t1Ptr != &tclDoubleType))
|| ((t2Ptr != &tclIntType) && (t2Ptr != &tclDoubleType))) {
/*
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index b64b6cc..43b074c 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -19,7 +19,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.16 2000/01/26 21:36:35 ericm Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.17 2000/03/27 22:18:56 hobbs Exp $
*/
#include "tclInt.h"
@@ -956,6 +956,20 @@ Tcl_Export(interp, namespacePtr, pattern, resetListFirst)
}
/*
+ * Make sure that we don't already have the pattern in the array
+ */
+ if (nsPtr->exportArrayPtr != NULL) {
+ for (i = 0; i < nsPtr->numExportPatterns; i++) {
+ if (strcmp(pattern, nsPtr->exportArrayPtr[i]) == 0) {
+ /*
+ * The pattern already exists in the list
+ */
+ return TCL_OK;
+ }
+ }
+ }
+
+ /*
* Make sure there is room in the namespace's pattern array for the
* new pattern.
*/