summaryrefslogtreecommitdiffstats
path: root/generic/tclGet.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclGet.c')
-rw-r--r--generic/tclGet.c344
1 files changed, 103 insertions, 241 deletions
diff --git a/generic/tclGet.c b/generic/tclGet.c
index b15f100..54b4370 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -1,21 +1,18 @@
-/*
+/*
* tclGet.c --
*
- * This file contains procedures to convert strings into
- * other forms, like integers or floating-point numbers or
- * booleans, doing syntax checking along the way.
+ * This file contains functions to convert strings into other forms, like
+ * integers or floating-point numbers or booleans, doing syntax checking
+ * along the way.
*
* Copyright (c) 1990-1993 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
*
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclInt.h"
-#include "tclPort.h"
-#include "tclMath.h"
-
/*
*----------------------------------------------------------------------
@@ -25,10 +22,10 @@
* Given a string, produce the corresponding integer value.
*
* Results:
- * The return value is normally TCL_OK; in this case *intPtr
- * will be set to the integer value equivalent to string. If
- * string is improperly formed then TCL_ERROR is returned and
- * an error message will be left in the interp's result.
+ * The return value is normally TCL_OK; in this case *intPtr will be set
+ * to the integer value equivalent to src. If src is improperly formed
+ * then TCL_ERROR is returned and an error message will be left in the
+ * interp's result.
*
* Side effects:
* None.
@@ -37,80 +34,26 @@
*/
int
-Tcl_GetInt(interp, string, intPtr)
- Tcl_Interp *interp; /* Interpreter to use for error reporting. */
- CONST char *string; /* String containing a (possibly signed)
- * integer in a form acceptable to strtol. */
- int *intPtr; /* Place to store converted result. */
+Tcl_GetInt(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
+ CONST char *src, /* String containing a (possibly signed)
+ * integer in a form acceptable to
+ * Tcl_GetIntFromObj(). */
+ int *intPtr) /* Place to store converted result. */
{
- char *end;
- CONST char *p = string;
- long i;
-
- /*
- * Note: use strtoul instead of strtol for integer conversions
- * to allow full-size unsigned numbers, but don't depend on strtoul
- * to handle sign characters; it won't in some implementations.
- */
-
- errno = 0;
-#ifdef TCL_STRTOUL_SIGN_CHECK
- /*
- * This special sign check actually causes bad numbers to be allowed
- * when strtoul. I can't find a strtoul that doesn't validly handle
- * signed characters, and the C standard implies that this is all
- * unnecessary. [Bug #634856]
- */
- for ( ; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */
- /* Empty loop body. */
- }
- if (*p == '-') {
- p++;
- i = -((long)strtoul(p, &end, 0)); /* INTL: Tcl source. */
- } else if (*p == '+') {
- p++;
- i = strtoul(p, &end, 0); /* INTL: Tcl source. */
- } else
-#else
- i = strtoul(p, &end, 0); /* INTL: Tcl source. */
-#endif
- if (end == p) {
- badInteger:
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "expected integer but got \"", string,
- "\"", (char *) NULL);
- TclCheckBadOctal(interp, string);
- }
- return TCL_ERROR;
- }
+ Tcl_Obj obj;
+ int code;
- /*
- * The second test below is needed on platforms where "long" is
- * larger than "int" to detect values that fit in a long but not in
- * an int.
- */
+ obj.refCount = 1;
+ obj.bytes = (char *) src;
+ obj.length = strlen(src);
+ obj.typePtr = NULL;
- if ((errno == ERANGE)
-#if (LONG_MAX > INT_MAX)
- || (i > UINT_MAX) || (i < -(long)UINT_MAX)
-#endif
- ) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_SetResult(interp, "integer value too large to represent",
- TCL_STATIC);
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- Tcl_GetStringResult(interp), (char *) NULL);
- }
- return TCL_ERROR;
- }
- while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
- end++;
- }
- if (*end != 0) {
- goto badInteger;
+ code = Tcl_GetIntFromObj(interp, &obj, intPtr);
+ if (obj.refCount > 1) {
+ Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
- *intPtr = (int) i;
- return TCL_OK;
+ return code;
}
/*
@@ -118,16 +61,15 @@ Tcl_GetInt(interp, string, intPtr)
*
* TclGetLong --
*
- * Given a string, produce the corresponding long integer value.
- * This routine is a version of Tcl_GetInt but returns a "long"
- * instead of an "int".
+ * Given a string, produce the corresponding long integer value. This
+ * routine is a version of Tcl_GetInt but returns a "long" instead of an
+ * "int" (a difference that matters on 64-bit architectures).
*
* Results:
- * The return value is normally TCL_OK; in this case *longPtr
- * will be set to the long integer value equivalent to string. If
- * string is improperly formed then TCL_ERROR is returned and
- * an error message will be left in the interp's result if interp
- * is non-NULL.
+ * The return value is normally TCL_OK; in this case *longPtr will be set
+ * to the long integer value equivalent to src. If src is improperly
+ * formed then TCL_ERROR is returned and an error message will be left in
+ * the interp's result if interp is non-NULL.
*
* Side effects:
* None.
@@ -136,64 +78,27 @@ Tcl_GetInt(interp, string, intPtr)
*/
int
-TclGetLong(interp, string, longPtr)
- Tcl_Interp *interp; /* Interpreter used for error reporting
- * if not NULL. */
- CONST char *string; /* String containing a (possibly signed)
- * long integer in a form acceptable to
- * strtoul. */
- long *longPtr; /* Place to store converted long result. */
+TclGetLong(
+ Tcl_Interp *interp, /* Interpreter used for error reporting if not
+ * NULL. */
+ CONST char *src, /* String containing a (possibly signed) long
+ * integer in a form acceptable to
+ * Tcl_GetLongFromObj(). */
+ long *longPtr) /* Place to store converted long result. */
{
- char *end;
- CONST char *p = string;
- long i;
+ Tcl_Obj obj;
+ int code;
- /*
- * Note: don't depend on strtoul to handle sign characters; it won't
- * in some implementations.
- */
+ obj.refCount = 1;
+ obj.bytes = (char *) src;
+ obj.length = strlen(src);
+ obj.typePtr = NULL;
- errno = 0;
-#ifdef TCL_STRTOUL_SIGN_CHECK
- for ( ; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */
- /* Empty loop body. */
- }
- if (*p == '-') {
- p++;
- i = -(int)strtoul(p, &end, 0); /* INTL: Tcl source. */
- } else if (*p == '+') {
- p++;
- i = strtoul(p, &end, 0); /* INTL: Tcl source. */
- } else
-#else
- i = strtoul(p, &end, 0); /* INTL: Tcl source. */
-#endif
- if (end == p) {
- badInteger:
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "expected integer but got \"", string,
- "\"", (char *) NULL);
- TclCheckBadOctal(interp, string);
- }
- return TCL_ERROR;
- }
- if (errno == ERANGE) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_SetResult(interp, "integer value too large to represent",
- TCL_STATIC);
- Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
- Tcl_GetStringResult(interp), (char *) NULL);
- }
- return TCL_ERROR;
+ code = Tcl_GetLongFromObj(interp, &obj, longPtr);
+ if (obj.refCount > 1) {
+ Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
- while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
- end++;
- }
- if (*end != 0) {
- goto badInteger;
- }
- *longPtr = i;
- return TCL_OK;
+ return code;
}
/*
@@ -205,10 +110,10 @@ TclGetLong(interp, string, longPtr)
* floating-point value.
*
* Results:
- * The return value is normally TCL_OK; in this case *doublePtr
- * will be set to the double-precision value equivalent to string.
- * If string is improperly formed then TCL_ERROR is returned and
- * an error message will be left in the interp's result.
+ * The return value is normally TCL_OK; in this case *doublePtr will be
+ * set to the double-precision value equivalent to src. If src is
+ * improperly formed then TCL_ERROR is returned and an error message will
+ * be left in the interp's result.
*
* Side effects:
* None.
@@ -217,40 +122,26 @@ TclGetLong(interp, string, longPtr)
*/
int
-Tcl_GetDouble(interp, string, doublePtr)
- Tcl_Interp *interp; /* Interpreter used for error reporting. */
- CONST char *string; /* String containing a floating-point number
- * in a form acceptable to strtod. */
- double *doublePtr; /* Place to store converted result. */
+Tcl_GetDouble(
+ Tcl_Interp *interp, /* Interpreter used for error reporting. */
+ CONST char *src, /* String containing a floating-point number
+ * in a form acceptable to
+ * Tcl_GetDoubleFromObj(). */
+ double *doublePtr) /* Place to store converted result. */
{
- char *end;
- double d;
+ Tcl_Obj obj;
+ int code;
- errno = 0;
- d = strtod(string, &end); /* INTL: Tcl source. */
- if (end == string) {
- badDouble:
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp,
- "expected floating-point number but got \"",
- string, "\"", (char *) NULL);
- }
- return TCL_ERROR;
- }
- if (errno != 0 && (d == HUGE_VAL || d == -HUGE_VAL || d == 0)) {
- if (interp != (Tcl_Interp *) NULL) {
- TclExprFloatError(interp, d);
- }
- return TCL_ERROR;
- }
- while ((*end != 0) && isspace(UCHAR(*end))) { /* INTL: ISO space. */
- end++;
- }
- if (*end != 0) {
- goto badDouble;
+ obj.refCount = 1;
+ obj.bytes = (char *) src;
+ obj.length = strlen(src);
+ obj.typePtr = NULL;
+
+ code = Tcl_GetDoubleFromObj(interp, &obj, doublePtr);
+ if (obj.refCount > 1) {
+ Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
- *doublePtr = d;
- return TCL_OK;
+ return code;
}
/*
@@ -258,14 +149,14 @@ Tcl_GetDouble(interp, string, doublePtr)
*
* Tcl_GetBoolean --
*
- * Given a string, return a 0/1 boolean value corresponding
- * to the string.
+ * Given a string, return a 0/1 boolean value corresponding to the
+ * string.
*
* Results:
- * The return value is normally TCL_OK; in this case *boolPtr
- * will be set to the 0/1 value equivalent to string. If
- * string is improperly formed then TCL_ERROR is returned and
- * an error message will be left in the interp's result.
+ * The return value is normally TCL_OK; in this case *boolPtr will be set
+ * to the 0/1 value equivalent to src. If src is improperly formed then
+ * TCL_ERROR is returned and an error message will be left in the
+ * interp's result.
*
* Side effects:
* None.
@@ -274,64 +165,35 @@ Tcl_GetDouble(interp, string, doublePtr)
*/
int
-Tcl_GetBoolean(interp, string, boolPtr)
- Tcl_Interp *interp; /* Interpreter used for error reporting. */
- CONST char *string; /* String containing a boolean number
- * specified either as 1/0 or true/false or
- * yes/no. */
- int *boolPtr; /* Place to store converted result, which
- * will be 0 or 1. */
+Tcl_GetBoolean(
+ Tcl_Interp *interp, /* Interpreter used for error reporting. */
+ CONST char *src, /* String containing one of the boolean values
+ * 1, 0, true, false, yes, no, on off. */
+ int *boolPtr) /* Place to store converted result, which will
+ * be 0 or 1. */
{
- int i;
- char lowerCase[10], c;
- size_t length;
+ Tcl_Obj obj;
+ int code;
- /*
- * Convert the input string to all lower-case.
- * INTL: This code will work on UTF strings.
- */
+ obj.refCount = 1;
+ obj.bytes = (char *) src;
+ obj.length = strlen(src);
+ obj.typePtr = NULL;
- for (i = 0; i < 9; i++) {
- c = string[i];
- if (c == 0) {
- break;
- }
- if ((c >= 'A') && (c <= 'Z')) {
- c += (char) ('a' - 'A');
- }
- lowerCase[i] = c;
+ code = Tcl_ConvertToType(interp, &obj, &tclBooleanType);
+ if (obj.refCount > 1) {
+ Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
- lowerCase[i] = 0;
-
- length = strlen(lowerCase);
- c = lowerCase[0];
- if ((c == '0') && (lowerCase[1] == '\0')) {
- *boolPtr = 0;
- } else if ((c == '1') && (lowerCase[1] == '\0')) {
- *boolPtr = 1;
- } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
- *boolPtr = 1;
- } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
- *boolPtr = 0;
- } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
- *boolPtr = 1;
- } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
- *boolPtr = 0;
- } else if ((c == 'o') && (length >= 2)) {
- if (strncmp(lowerCase, "on", length) == 0) {
- *boolPtr = 1;
- } else if (strncmp(lowerCase, "off", length) == 0) {
- *boolPtr = 0;
- } else {
- goto badBoolean;
- }
- } else {
- badBoolean:
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "expected boolean value but got \"",
- string, "\"", (char *) NULL);
- }
- return TCL_ERROR;
+ if (code == TCL_OK) {
+ *boolPtr = obj.internalRep.longValue;
}
- return TCL_OK;
+ return code;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */