/*
|
/*
|
* tclGet.c --
|
* tclGet.c --
|
*
|
*
|
* This file contains procedures to convert strings into
|
* This file contains procedures to convert strings into
|
* other forms, like integers or floating-point numbers or
|
* other forms, like integers or floating-point numbers or
|
* booleans, doing syntax checking along the way.
|
* booleans, doing syntax checking along the way.
|
*
|
*
|
* Copyright (c) 1990-1993 The Regents of the University of California.
|
* Copyright (c) 1990-1993 The Regents of the University of California.
|
* Copyright (c) 1994-1995 Sun Microsystems, Inc.
|
* Copyright (c) 1994-1995 Sun Microsystems, Inc.
|
*
|
*
|
* See the file "license.terms" for information on usage and redistribution
|
* See the file "license.terms" for information on usage and redistribution
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
*
|
*
|
* RCS: @(#) $Id: tclGet.c,v 1.1.1.1 2002-01-16 10:25:27 markom Exp $
|
* RCS: @(#) $Id: tclGet.c,v 1.1.1.1 2002-01-16 10:25:27 markom Exp $
|
*/
|
*/
|
|
|
#include "tclInt.h"
|
#include "tclInt.h"
|
#include "tclPort.h"
|
#include "tclPort.h"
|
|
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_GetInt --
|
* Tcl_GetInt --
|
*
|
*
|
* Given a string, produce the corresponding integer value.
|
* Given a string, produce the corresponding integer value.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is normally TCL_OK; in this case *intPtr
|
* The return value is normally TCL_OK; in this case *intPtr
|
* will be set to the integer value equivalent to string. If
|
* will be set to the integer value equivalent to string. If
|
* string is improperly formed then TCL_ERROR is returned and
|
* string is improperly formed then TCL_ERROR is returned and
|
* an error message will be left in interp->result.
|
* an error message will be left in interp->result.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
Tcl_GetInt(interp, string, intPtr)
|
Tcl_GetInt(interp, string, intPtr)
|
Tcl_Interp *interp; /* Interpreter to use for error reporting. */
|
Tcl_Interp *interp; /* Interpreter to use for error reporting. */
|
char *string; /* String containing a (possibly signed)
|
char *string; /* String containing a (possibly signed)
|
* integer in a form acceptable to strtol. */
|
* integer in a form acceptable to strtol. */
|
int *intPtr; /* Place to store converted result. */
|
int *intPtr; /* Place to store converted result. */
|
{
|
{
|
char *end, *p;
|
char *end, *p;
|
long i;
|
long i;
|
|
|
/*
|
/*
|
* Note: use strtoul instead of strtol for integer conversions
|
* Note: use strtoul instead of strtol for integer conversions
|
* to allow full-size unsigned numbers, but don't depend on strtoul
|
* to allow full-size unsigned numbers, but don't depend on strtoul
|
* to handle sign characters; it won't in some implementations.
|
* to handle sign characters; it won't in some implementations.
|
*/
|
*/
|
|
|
errno = 0;
|
errno = 0;
|
for (p = string; isspace(UCHAR(*p)); p++) {
|
for (p = string; isspace(UCHAR(*p)); p++) {
|
/* Empty loop body. */
|
/* Empty loop body. */
|
}
|
}
|
if (*p == '-') {
|
if (*p == '-') {
|
p++;
|
p++;
|
i = -((long)strtoul(p, &end, 0));
|
i = -((long)strtoul(p, &end, 0));
|
} else if (*p == '+') {
|
} else if (*p == '+') {
|
p++;
|
p++;
|
i = strtoul(p, &end, 0);
|
i = strtoul(p, &end, 0);
|
} else {
|
} else {
|
i = strtoul(p, &end, 0);
|
i = strtoul(p, &end, 0);
|
}
|
}
|
if (end == p) {
|
if (end == p) {
|
badInteger:
|
badInteger:
|
if (interp != (Tcl_Interp *) NULL) {
|
if (interp != (Tcl_Interp *) NULL) {
|
Tcl_AppendResult(interp, "expected integer but got \"", string,
|
Tcl_AppendResult(interp, "expected integer but got \"", string,
|
"\"", (char *) NULL);
|
"\"", (char *) NULL);
|
}
|
}
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
|
|
/*
|
/*
|
* The second test below is needed on platforms where "long" is
|
* 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
|
* larger than "int" to detect values that fit in a long but not in
|
* an int.
|
* an int.
|
*/
|
*/
|
|
|
if ((errno == ERANGE) || (((long)(int) i) != i)) {
|
if ((errno == ERANGE) || (((long)(int) i) != i)) {
|
if (interp != (Tcl_Interp *) NULL) {
|
if (interp != (Tcl_Interp *) NULL) {
|
Tcl_SetResult(interp, "integer value too large to represent",
|
Tcl_SetResult(interp, "integer value too large to represent",
|
TCL_STATIC);
|
TCL_STATIC);
|
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
|
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
|
interp->result, (char *) NULL);
|
interp->result, (char *) NULL);
|
}
|
}
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
end++;
|
end++;
|
}
|
}
|
if (*end != 0) {
|
if (*end != 0) {
|
goto badInteger;
|
goto badInteger;
|
}
|
}
|
*intPtr = (int) i;
|
*intPtr = (int) i;
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* TclGetLong --
|
* TclGetLong --
|
*
|
*
|
* Given a string, produce the corresponding long integer value.
|
* Given a string, produce the corresponding long integer value.
|
* This routine is a version of Tcl_GetInt but returns a "long"
|
* This routine is a version of Tcl_GetInt but returns a "long"
|
* instead of an "int".
|
* instead of an "int".
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is normally TCL_OK; in this case *longPtr
|
* The return value is normally TCL_OK; in this case *longPtr
|
* will be set to the long integer value equivalent to string. If
|
* will be set to the long integer value equivalent to string. If
|
* string is improperly formed then TCL_ERROR is returned and
|
* string is improperly formed then TCL_ERROR is returned and
|
* an error message will be left in interp->result.
|
* an error message will be left in interp->result.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
TclGetLong(interp, string, longPtr)
|
TclGetLong(interp, string, longPtr)
|
Tcl_Interp *interp; /* Interpreter used for error reporting. */
|
Tcl_Interp *interp; /* Interpreter used for error reporting. */
|
char *string; /* String containing a (possibly signed)
|
char *string; /* String containing a (possibly signed)
|
* long integer in a form acceptable to
|
* long integer in a form acceptable to
|
* strtoul. */
|
* strtoul. */
|
long *longPtr; /* Place to store converted long result. */
|
long *longPtr; /* Place to store converted long result. */
|
{
|
{
|
char *end, *p;
|
char *end, *p;
|
long i;
|
long i;
|
|
|
/*
|
/*
|
* Note: don't depend on strtoul to handle sign characters; it won't
|
* Note: don't depend on strtoul to handle sign characters; it won't
|
* in some implementations.
|
* in some implementations.
|
*/
|
*/
|
|
|
errno = 0;
|
errno = 0;
|
for (p = string; isspace(UCHAR(*p)); p++) {
|
for (p = string; isspace(UCHAR(*p)); p++) {
|
/* Empty loop body. */
|
/* Empty loop body. */
|
}
|
}
|
if (*p == '-') {
|
if (*p == '-') {
|
p++;
|
p++;
|
i = -(int)strtoul(p, &end, 0);
|
i = -(int)strtoul(p, &end, 0);
|
} else if (*p == '+') {
|
} else if (*p == '+') {
|
p++;
|
p++;
|
i = strtoul(p, &end, 0);
|
i = strtoul(p, &end, 0);
|
} else {
|
} else {
|
i = strtoul(p, &end, 0);
|
i = strtoul(p, &end, 0);
|
}
|
}
|
if (end == p) {
|
if (end == p) {
|
badInteger:
|
badInteger:
|
if (interp != (Tcl_Interp *) NULL) {
|
if (interp != (Tcl_Interp *) NULL) {
|
Tcl_AppendResult(interp, "expected integer but got \"", string,
|
Tcl_AppendResult(interp, "expected integer but got \"", string,
|
"\"", (char *) NULL);
|
"\"", (char *) NULL);
|
}
|
}
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
if (errno == ERANGE) {
|
if (errno == ERANGE) {
|
if (interp != (Tcl_Interp *) NULL) {
|
if (interp != (Tcl_Interp *) NULL) {
|
Tcl_SetResult(interp, "integer value too large to represent",
|
Tcl_SetResult(interp, "integer value too large to represent",
|
TCL_STATIC);
|
TCL_STATIC);
|
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
|
Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
|
interp->result, (char *) NULL);
|
interp->result, (char *) NULL);
|
}
|
}
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
while ((*end != '\0') && isspace(UCHAR(*end))) {
|
end++;
|
end++;
|
}
|
}
|
if (*end != 0) {
|
if (*end != 0) {
|
goto badInteger;
|
goto badInteger;
|
}
|
}
|
*longPtr = i;
|
*longPtr = i;
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_GetDouble --
|
* Tcl_GetDouble --
|
*
|
*
|
* Given a string, produce the corresponding double-precision
|
* Given a string, produce the corresponding double-precision
|
* floating-point value.
|
* floating-point value.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is normally TCL_OK; in this case *doublePtr
|
* The return value is normally TCL_OK; in this case *doublePtr
|
* will be set to the double-precision value equivalent to string.
|
* will be set to the double-precision value equivalent to string.
|
* If string is improperly formed then TCL_ERROR is returned and
|
* If string is improperly formed then TCL_ERROR is returned and
|
* an error message will be left in interp->result.
|
* an error message will be left in interp->result.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
Tcl_GetDouble(interp, string, doublePtr)
|
Tcl_GetDouble(interp, string, doublePtr)
|
Tcl_Interp *interp; /* Interpreter used for error reporting. */
|
Tcl_Interp *interp; /* Interpreter used for error reporting. */
|
char *string; /* String containing a floating-point number
|
char *string; /* String containing a floating-point number
|
* in a form acceptable to strtod. */
|
* in a form acceptable to strtod. */
|
double *doublePtr; /* Place to store converted result. */
|
double *doublePtr; /* Place to store converted result. */
|
{
|
{
|
char *end;
|
char *end;
|
double d;
|
double d;
|
|
|
errno = 0;
|
errno = 0;
|
d = strtod(string, &end);
|
d = strtod(string, &end);
|
if (end == string) {
|
if (end == string) {
|
badDouble:
|
badDouble:
|
if (interp != (Tcl_Interp *) NULL) {
|
if (interp != (Tcl_Interp *) NULL) {
|
Tcl_AppendResult(interp,
|
Tcl_AppendResult(interp,
|
"expected floating-point number but got \"",
|
"expected floating-point number but got \"",
|
string, "\"", (char *) NULL);
|
string, "\"", (char *) NULL);
|
}
|
}
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
if (errno != 0) {
|
if (errno != 0) {
|
if (interp != (Tcl_Interp *) NULL) {
|
if (interp != (Tcl_Interp *) NULL) {
|
TclExprFloatError(interp, d); /* sets interp->objResult */
|
TclExprFloatError(interp, d); /* sets interp->objResult */
|
|
|
/*
|
/*
|
* Move the interpreter's object result to the string result,
|
* Move the interpreter's object result to the string result,
|
* then reset the object result.
|
* then reset the object result.
|
* FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
|
* FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
|
*/
|
*/
|
|
|
Tcl_SetResult(interp,
|
Tcl_SetResult(interp,
|
TclGetStringFromObj(Tcl_GetObjResult(interp),
|
TclGetStringFromObj(Tcl_GetObjResult(interp),
|
(int *) NULL),
|
(int *) NULL),
|
TCL_VOLATILE);
|
TCL_VOLATILE);
|
}
|
}
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
while ((*end != 0) && isspace(UCHAR(*end))) {
|
while ((*end != 0) && isspace(UCHAR(*end))) {
|
end++;
|
end++;
|
}
|
}
|
if (*end != 0) {
|
if (*end != 0) {
|
goto badDouble;
|
goto badDouble;
|
}
|
}
|
*doublePtr = d;
|
*doublePtr = d;
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
/*
|
/*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*
|
*
|
* Tcl_GetBoolean --
|
* Tcl_GetBoolean --
|
*
|
*
|
* Given a string, return a 0/1 boolean value corresponding
|
* Given a string, return a 0/1 boolean value corresponding
|
* to the string.
|
* to the string.
|
*
|
*
|
* Results:
|
* Results:
|
* The return value is normally TCL_OK; in this case *boolPtr
|
* The return value is normally TCL_OK; in this case *boolPtr
|
* will be set to the 0/1 value equivalent to string. If
|
* will be set to the 0/1 value equivalent to string. If
|
* string is improperly formed then TCL_ERROR is returned and
|
* string is improperly formed then TCL_ERROR is returned and
|
* an error message will be left in interp->result.
|
* an error message will be left in interp->result.
|
*
|
*
|
* Side effects:
|
* Side effects:
|
* None.
|
* None.
|
*
|
*
|
*----------------------------------------------------------------------
|
*----------------------------------------------------------------------
|
*/
|
*/
|
|
|
int
|
int
|
Tcl_GetBoolean(interp, string, boolPtr)
|
Tcl_GetBoolean(interp, string, boolPtr)
|
Tcl_Interp *interp; /* Interpreter used for error reporting. */
|
Tcl_Interp *interp; /* Interpreter used for error reporting. */
|
char *string; /* String containing a boolean number
|
char *string; /* String containing a boolean number
|
* specified either as 1/0 or true/false or
|
* specified either as 1/0 or true/false or
|
* yes/no. */
|
* yes/no. */
|
int *boolPtr; /* Place to store converted result, which
|
int *boolPtr; /* Place to store converted result, which
|
* will be 0 or 1. */
|
* will be 0 or 1. */
|
{
|
{
|
int i;
|
int i;
|
char lowerCase[10], c;
|
char lowerCase[10], c;
|
size_t length;
|
size_t length;
|
|
|
/*
|
/*
|
* Convert the input string to all lower-case.
|
* Convert the input string to all lower-case.
|
*/
|
*/
|
|
|
for (i = 0; i < 9; i++) {
|
for (i = 0; i < 9; i++) {
|
c = string[i];
|
c = string[i];
|
if (c == 0) {
|
if (c == 0) {
|
break;
|
break;
|
}
|
}
|
if ((c >= 'A') && (c <= 'Z')) {
|
if ((c >= 'A') && (c <= 'Z')) {
|
c += (char) ('a' - 'A');
|
c += (char) ('a' - 'A');
|
}
|
}
|
lowerCase[i] = c;
|
lowerCase[i] = c;
|
}
|
}
|
lowerCase[i] = 0;
|
lowerCase[i] = 0;
|
|
|
length = strlen(lowerCase);
|
length = strlen(lowerCase);
|
c = lowerCase[0];
|
c = lowerCase[0];
|
if ((c == '0') && (lowerCase[1] == '\0')) {
|
if ((c == '0') && (lowerCase[1] == '\0')) {
|
*boolPtr = 0;
|
*boolPtr = 0;
|
} else if ((c == '1') && (lowerCase[1] == '\0')) {
|
} else if ((c == '1') && (lowerCase[1] == '\0')) {
|
*boolPtr = 1;
|
*boolPtr = 1;
|
} else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
|
} else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
|
*boolPtr = 1;
|
*boolPtr = 1;
|
} else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
|
} else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
|
*boolPtr = 0;
|
*boolPtr = 0;
|
} else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
|
} else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
|
*boolPtr = 1;
|
*boolPtr = 1;
|
} else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
|
} else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
|
*boolPtr = 0;
|
*boolPtr = 0;
|
} else if ((c == 'o') && (length >= 2)) {
|
} else if ((c == 'o') && (length >= 2)) {
|
if (strncmp(lowerCase, "on", length) == 0) {
|
if (strncmp(lowerCase, "on", length) == 0) {
|
*boolPtr = 1;
|
*boolPtr = 1;
|
} else if (strncmp(lowerCase, "off", length) == 0) {
|
} else if (strncmp(lowerCase, "off", length) == 0) {
|
*boolPtr = 0;
|
*boolPtr = 0;
|
} else {
|
} else {
|
goto badBoolean;
|
goto badBoolean;
|
}
|
}
|
} else {
|
} else {
|
badBoolean:
|
badBoolean:
|
if (interp != (Tcl_Interp *) NULL) {
|
if (interp != (Tcl_Interp *) NULL) {
|
Tcl_AppendResult(interp, "expected boolean value but got \"",
|
Tcl_AppendResult(interp, "expected boolean value but got \"",
|
string, "\"", (char *) NULL);
|
string, "\"", (char *) NULL);
|
}
|
}
|
return TCL_ERROR;
|
return TCL_ERROR;
|
}
|
}
|
return TCL_OK;
|
return TCL_OK;
|
}
|
}
|
|
|
