sl@0: /* 
sl@0:  * tclGet.c --
sl@0:  *
sl@0:  *	This file contains procedures to convert strings into
sl@0:  *	other forms, like integers or floating-point numbers or
sl@0:  *	booleans, doing syntax checking along the way.
sl@0:  *
sl@0:  * Copyright (c) 1990-1993 The Regents of the University of California.
sl@0:  * Copyright (c) 1994-1997 Sun Microsystems, Inc.
sl@0:  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclGet.c,v 1.8.2.1 2005/04/20 16:06:17 dgp Exp $
sl@0:  */
sl@0: 
sl@0: #include "tclInt.h"
sl@0: #include "tclPort.h"
sl@0: #include "tclMath.h"
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_GetInt --
sl@0:  *
sl@0:  *	Given a string, produce the corresponding integer value.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is normally TCL_OK;  in this case *intPtr
sl@0:  *	will be set to the integer value equivalent to string.  If
sl@0:  *	string is improperly formed then TCL_ERROR is returned and
sl@0:  *	an error message will be left in the interp's result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C int
sl@0: Tcl_GetInt(interp, string, intPtr)
sl@0:     Tcl_Interp *interp;		/* Interpreter to use for error reporting. */
sl@0:     CONST char *string;		/* String containing a (possibly signed)
sl@0: 				 * integer in a form acceptable to strtol. */
sl@0:     int *intPtr;		/* Place to store converted result. */
sl@0: {
sl@0:     char *end;
sl@0:     CONST char *p = string;
sl@0:     long i;
sl@0: 
sl@0:     /*
sl@0:      * Note: use strtoul instead of strtol for integer conversions
sl@0:      * to allow full-size unsigned numbers, but don't depend on strtoul
sl@0:      * to handle sign characters;  it won't in some implementations.
sl@0:      */
sl@0: 
sl@0:     errno = 0;
sl@0: #ifdef TCL_STRTOUL_SIGN_CHECK
sl@0:     /*
sl@0:      * This special sign check actually causes bad numbers to be allowed
sl@0:      * when strtoul.  I can't find a strtoul that doesn't validly handle
sl@0:      * signed characters, and the C standard implies that this is all
sl@0:      * unnecessary. [Bug #634856]
sl@0:      */
sl@0:     for ( ; isspace(UCHAR(*p)); p++) {	/* INTL: ISO space. */
sl@0: 	/* Empty loop body. */
sl@0:     }
sl@0:     if (*p == '-') {
sl@0: 	p++;
sl@0: 	i = -((long)strtoul(p, &end, 0)); /* INTL: Tcl source. */
sl@0:     } else if (*p == '+') {
sl@0: 	p++;
sl@0: 	i = strtoul(p, &end, 0); /* INTL: Tcl source. */
sl@0:     } else
sl@0: #else
sl@0: 	i = strtoul(p, &end, 0); /* INTL: Tcl source. */
sl@0: #endif
sl@0:     if (end == p) {
sl@0: 	badInteger:
sl@0:         if (interp != (Tcl_Interp *) NULL) {
sl@0: 	    Tcl_AppendResult(interp, "expected integer but got \"", string,
sl@0: 		    "\"", (char *) NULL);
sl@0: 	    TclCheckBadOctal(interp, string);
sl@0:         }
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * The second test below is needed on platforms where "long" is
sl@0:      * larger than "int" to detect values that fit in a long but not in
sl@0:      * an int.
sl@0:      */
sl@0: 
sl@0:     if ((errno == ERANGE) 
sl@0: #if (LONG_MAX > INT_MAX)
sl@0: 	    || (i > UINT_MAX) || (i < -(long)UINT_MAX)
sl@0: #endif
sl@0:     ) {
sl@0:         if (interp != (Tcl_Interp *) NULL) {
sl@0: 	    Tcl_SetResult(interp, "integer value too large to represent",
sl@0: 		    TCL_STATIC);
sl@0:             Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
sl@0: 		    Tcl_GetStringResult(interp), (char *) NULL);
sl@0:         }
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
sl@0: 	end++;
sl@0:     }
sl@0:     if (*end != 0) {
sl@0: 	goto badInteger;
sl@0:     }
sl@0:     *intPtr = (int) i;
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclGetLong --
sl@0:  *
sl@0:  *	Given a string, produce the corresponding long integer value.
sl@0:  *	This routine is a version of Tcl_GetInt but returns a "long"
sl@0:  *	instead of an "int".
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is normally TCL_OK; in this case *longPtr
sl@0:  *	will be set to the long integer value equivalent to string. If
sl@0:  *	string is improperly formed then TCL_ERROR is returned and
sl@0:  *	an error message will be left in the interp's result if interp
sl@0:  *	is non-NULL. 
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: TclGetLong(interp, string, longPtr)
sl@0:     Tcl_Interp *interp;		/* Interpreter used for error reporting
sl@0: 				 * if not NULL. */
sl@0:     CONST char *string;		/* String containing a (possibly signed)
sl@0: 				 * long integer in a form acceptable to
sl@0: 				 * strtoul. */
sl@0:     long *longPtr;		/* Place to store converted long result. */
sl@0: {
sl@0:     char *end;
sl@0:     CONST char *p = string;
sl@0:     long i;
sl@0: 
sl@0:     /*
sl@0:      * Note: don't depend on strtoul to handle sign characters; it won't
sl@0:      * in some implementations.
sl@0:      */
sl@0: 
sl@0:     errno = 0;
sl@0: #ifdef TCL_STRTOUL_SIGN_CHECK
sl@0:     for ( ; isspace(UCHAR(*p)); p++) {	/* INTL: ISO space. */
sl@0: 	/* Empty loop body. */
sl@0:     }
sl@0:     if (*p == '-') {
sl@0: 	p++;
sl@0: 	i = -(int)strtoul(p, &end, 0); /* INTL: Tcl source. */
sl@0:     } else if (*p == '+') {
sl@0: 	p++;
sl@0: 	i = strtoul(p, &end, 0); /* INTL: Tcl source. */
sl@0:     } else
sl@0: #else
sl@0: 	i = strtoul(p, &end, 0); /* INTL: Tcl source. */
sl@0: #endif
sl@0:     if (end == p) {
sl@0: 	badInteger:
sl@0:         if (interp != (Tcl_Interp *) NULL) {
sl@0: 	    Tcl_AppendResult(interp, "expected integer but got \"", string,
sl@0: 		    "\"", (char *) NULL);
sl@0: 	    TclCheckBadOctal(interp, string);
sl@0:         }
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     if (errno == ERANGE) {
sl@0:         if (interp != (Tcl_Interp *) NULL) {
sl@0: 	    Tcl_SetResult(interp, "integer value too large to represent",
sl@0: 		    TCL_STATIC);
sl@0:             Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
sl@0:                     Tcl_GetStringResult(interp), (char *) NULL);
sl@0:         }
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
sl@0: 	end++;
sl@0:     }
sl@0:     if (*end != 0) {
sl@0: 	goto badInteger;
sl@0:     }
sl@0:     *longPtr = i;
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_GetDouble --
sl@0:  *
sl@0:  *	Given a string, produce the corresponding double-precision
sl@0:  *	floating-point value.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is normally TCL_OK; in this case *doublePtr
sl@0:  *	will be set to the double-precision value equivalent to string.
sl@0:  *	If string is improperly formed then TCL_ERROR is returned and
sl@0:  *	an error message will be left in the interp's result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C int
sl@0: Tcl_GetDouble(interp, string, doublePtr)
sl@0:     Tcl_Interp *interp;		/* Interpreter used for error reporting. */
sl@0:     CONST char *string;		/* String containing a floating-point number
sl@0: 				 * in a form acceptable to strtod. */
sl@0:     double *doublePtr;		/* Place to store converted result. */
sl@0: {
sl@0:     char *end;
sl@0:     double d;
sl@0: 
sl@0:     errno = 0;
sl@0:     d = strtod(string, &end); /* INTL: Tcl source. */
sl@0:     if (end == string) {
sl@0: 	badDouble:
sl@0:         if (interp != (Tcl_Interp *) NULL) {
sl@0:             Tcl_AppendResult(interp,
sl@0:                     "expected floating-point number but got \"",
sl@0:                     string, "\"", (char *) NULL);
sl@0:         }
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     if (errno != 0 && (d == HUGE_VAL || d == -HUGE_VAL || d == 0)) {
sl@0:         if (interp != (Tcl_Interp *) NULL) {
sl@0:             TclExprFloatError(interp, d); 
sl@0:         }
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     while ((*end != 0) && isspace(UCHAR(*end))) { /* INTL: ISO space. */
sl@0: 	end++;
sl@0:     }
sl@0:     if (*end != 0) {
sl@0: 	goto badDouble;
sl@0:     }
sl@0:     *doublePtr = d;
sl@0:     return TCL_OK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_GetBoolean --
sl@0:  *
sl@0:  *	Given a string, return a 0/1 boolean value corresponding
sl@0:  *	to the string.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is normally TCL_OK;  in this case *boolPtr
sl@0:  *	will be set to the 0/1 value equivalent to string.  If
sl@0:  *	string is improperly formed then TCL_ERROR is returned and
sl@0:  *	an error message will be left in the interp's result.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C int
sl@0: Tcl_GetBoolean(interp, string, boolPtr)
sl@0:     Tcl_Interp *interp;		/* Interpreter used for error reporting. */
sl@0:     CONST char *string;		/* String containing a boolean number
sl@0: 				 * specified either as 1/0 or true/false or
sl@0: 				 * yes/no. */
sl@0:     int *boolPtr;		/* Place to store converted result, which
sl@0: 				 * will be 0 or 1. */
sl@0: {
sl@0:     int i;
sl@0:     char lowerCase[10], c;
sl@0:     size_t length;
sl@0: 
sl@0:     /*
sl@0:      * Convert the input string to all lower-case. 
sl@0:      * INTL: This code will work on UTF strings.
sl@0:      */
sl@0: 
sl@0:     for (i = 0; i < 9; i++) {
sl@0: 	c = string[i];
sl@0: 	if (c == 0) {
sl@0: 	    break;
sl@0: 	}
sl@0: 	if ((c >= 'A') && (c <= 'Z')) {
sl@0: 	    c += (char) ('a' - 'A');
sl@0: 	}
sl@0: 	lowerCase[i] = c;
sl@0:     }
sl@0:     lowerCase[i] = 0;
sl@0: 
sl@0:     length = strlen(lowerCase);
sl@0:     c = lowerCase[0];
sl@0:     if ((c == '0') && (lowerCase[1] == '\0')) {
sl@0: 	*boolPtr = 0;
sl@0:     } else if ((c == '1') && (lowerCase[1] == '\0')) {
sl@0: 	*boolPtr = 1;
sl@0:     } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
sl@0: 	*boolPtr = 1;
sl@0:     } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
sl@0: 	*boolPtr = 0;
sl@0:     } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
sl@0: 	*boolPtr = 1;
sl@0:     } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
sl@0: 	*boolPtr = 0;
sl@0:     } else if ((c == 'o') && (length >= 2)) {
sl@0: 	if (strncmp(lowerCase, "on", length) == 0) {
sl@0: 	    *boolPtr = 1;
sl@0: 	} else if (strncmp(lowerCase, "off", length) == 0) {
sl@0: 	    *boolPtr = 0;
sl@0: 	} else {
sl@0: 	    goto badBoolean;
sl@0: 	}
sl@0:     } else {
sl@0: 	badBoolean:
sl@0:         if (interp != (Tcl_Interp *) NULL) {
sl@0:             Tcl_AppendResult(interp, "expected boolean value but got \"",
sl@0:                     string, "\"", (char *) NULL);
sl@0:         }
sl@0: 	return TCL_ERROR;
sl@0:     }
sl@0:     return TCL_OK;
sl@0: }