shared_source/c_tcl_base_7_5_w_mods/tclget.c

/* $Header$ */
/* 
 * 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.
 *
 * 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.
 *
 * RCS: @(#) $Id: tclget.c,v 1.1.1.1 2001/06/13 04:39:21 dtashley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"
#include "tclMath.h"


/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetInt --
 *
 *      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.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetInt(interp, string, intPtr)
    Tcl_Interp *interp;         /* Interpreter to use for error reporting. */
    char *string;               /* String containing a (possibly signed)
                                 * integer in a form acceptable to strtol. */
    int *intPtr;                /* Place to store converted result. */
{
    char *end, *p;
    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;
    for (p = string; 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 {
        i = strtoul(p, &end, 0); /* INTL: Tcl source. */
    }
    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;
    }

    /*
     * 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.
     */

    if ((errno == ERANGE) || (((long)(int) i) != i)) {
        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;
    }
    *intPtr = (int) i;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * 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".
 *
 * 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. 
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
TclGetLong(interp, string, longPtr)
    Tcl_Interp *interp;         /* Interpreter used for error reporting
                                 * if not NULL. */
    char *string;               /* String containing a (possibly signed)
                                 * long integer in a form acceptable to
                                 * strtoul. */
    long *longPtr;              /* Place to store converted long result. */
{
    char *end, *p;
    long i;

    /*
     * Note: don't depend on strtoul to handle sign characters; it won't
     * in some implementations.
     */

    errno = 0;
    for (p = string; 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 {
        i = strtoul(p, &end, 0); /* INTL: Tcl source. */
    }
    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;
    }
    while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
        end++;
    }
    if (*end != 0) {
        goto badInteger;
    }
    *longPtr = i;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetDouble --
 *
 *      Given a string, produce the corresponding double-precision
 *      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.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetDouble(interp, string, doublePtr)
    Tcl_Interp *interp;         /* Interpreter used for error reporting. */
    char *string;               /* String containing a floating-point number
                                 * in a form acceptable to strtod. */
    double *doublePtr;          /* Place to store converted result. */
{
    char *end;
    double d;

    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;
    }
    *doublePtr = d;
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetBoolean --
 *
 *      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.
 *
 * Side effects:
 *      None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_GetBoolean(interp, string, boolPtr)
    Tcl_Interp *interp;         /* Interpreter used for error reporting. */
    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. */
{
    int i;
    char lowerCase[10], c;
    size_t length;

    /*
     * Convert the input string to all lower-case. 
     * INTL: This code will work on UTF strings.
     */

    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;
    }
    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;
    }
    return TCL_OK;
}

/* End of tclget.c */
1	dashley	64	/* $Header$ */
2	dashley	25	/*
3			* tclGet.c --
4			*
5			* This file contains procedures to convert strings into
6			* other forms, like integers or floating-point numbers or
7			* booleans, doing syntax checking along the way.
8			*
9			* Copyright (c) 1990-1993 The Regents of the University of California.
10			* Copyright (c) 1994-1997 Sun Microsystems, Inc.
11			*
12			* See the file "license.terms" for information on usage and redistribution
13			* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14			*
15			* RCS: @(#) $Id: tclget.c,v 1.1.1.1 2001/06/13 04:39:21 dtashley Exp $
16			*/
17
18			#include "tclInt.h"
19			#include "tclPort.h"
20			#include "tclMath.h"
21
22
23			/*
24			*----------------------------------------------------------------------
25			*
26			* Tcl_GetInt --
27			*
28			* Given a string, produce the corresponding integer value.
29			*
30			* Results:
31			* The return value is normally TCL_OK; in this case *intPtr
32			* will be set to the integer value equivalent to string. If
33			* string is improperly formed then TCL_ERROR is returned and
34			* an error message will be left in the interp's result.
35			*
36			* Side effects:
37			* None.
38			*
39			*----------------------------------------------------------------------
40			*/
41
42			int
43			Tcl_GetInt(interp, string, intPtr)
44			Tcl_Interp interp; / Interpreter to use for error reporting. */
45			char string; / String containing a (possibly signed)
46			* integer in a form acceptable to strtol. */
47			int intPtr; / Place to store converted result. */
48			{
49			char end, p;
50			long i;
51
52			/*
53			* Note: use strtoul instead of strtol for integer conversions
54			* to allow full-size unsigned numbers, but don't depend on strtoul
55			* to handle sign characters; it won't in some implementations.
56			*/
57
58			errno = 0;
59			for (p = string; isspace(UCHAR(p)); p++) { / INTL: ISO space. */
60			/* Empty loop body. */
61			}
62			if (*p == '-') {
63			p++;
64			i = -((long)strtoul(p, &end, 0)); /* INTL: Tcl source. */
65			} else if (*p == '+') {
66			p++;
67			i = strtoul(p, &end, 0); /* INTL: Tcl source. */
68			} else {
69			i = strtoul(p, &end, 0); /* INTL: Tcl source. */
70			}
71			if (end == p) {
72			badInteger:
73			if (interp != (Tcl_Interp *) NULL) {
74			Tcl_AppendResult(interp, "expected integer but got \"", string,
75			"\"", (char *) NULL);
76			TclCheckBadOctal(interp, string);
77			}
78			return TCL_ERROR;
79			}
80
81			/*
82			* The second test below is needed on platforms where "long" is
83			* larger than "int" to detect values that fit in a long but not in
84			* an int.
85			*/
86
87			if ((errno == ERANGE) \|\| (((long)(int) i) != i)) {
88			if (interp != (Tcl_Interp *) NULL) {
89			Tcl_SetResult(interp, "integer value too large to represent",
90			TCL_STATIC);
91			Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
92			Tcl_GetStringResult(interp), (char *) NULL);
93			}
94			return TCL_ERROR;
95			}
96			while ((end != '\0') && isspace(UCHAR(end))) { /* INTL: ISO space. */
97			end++;
98			}
99			if (*end != 0) {
100			goto badInteger;
101			}
102			*intPtr = (int) i;
103			return TCL_OK;
104			}
105
106			/*
107			*----------------------------------------------------------------------
108			*
109			* TclGetLong --
110			*
111			* Given a string, produce the corresponding long integer value.
112			* This routine is a version of Tcl_GetInt but returns a "long"
113			* instead of an "int".
114			*
115			* Results:
116			* The return value is normally TCL_OK; in this case *longPtr
117			* will be set to the long integer value equivalent to string. If
118			* string is improperly formed then TCL_ERROR is returned and
119			* an error message will be left in the interp's result if interp
120			* is non-NULL.
121			*
122			* Side effects:
123			* None.
124			*
125			*----------------------------------------------------------------------
126			*/
127
128			int
129			TclGetLong(interp, string, longPtr)
130			Tcl_Interp interp; / Interpreter used for error reporting
131			* if not NULL. */
132			char string; / String containing a (possibly signed)
133			* long integer in a form acceptable to
134			* strtoul. */
135			long longPtr; / Place to store converted long result. */
136			{
137			char end, p;
138			long i;
139
140			/*
141			* Note: don't depend on strtoul to handle sign characters; it won't
142			* in some implementations.
143			*/
144
145			errno = 0;
146			for (p = string; isspace(UCHAR(p)); p++) { / INTL: ISO space. */
147			/* Empty loop body. */
148			}
149			if (*p == '-') {
150			p++;
151			i = -(int)strtoul(p, &end, 0); /* INTL: Tcl source. */
152			} else if (*p == '+') {
153			p++;
154			i = strtoul(p, &end, 0); /* INTL: Tcl source. */
155			} else {
156			i = strtoul(p, &end, 0); /* INTL: Tcl source. */
157			}
158			if (end == p) {
159			badInteger:
160			if (interp != (Tcl_Interp *) NULL) {
161			Tcl_AppendResult(interp, "expected integer but got \"", string,
162			"\"", (char *) NULL);
163			TclCheckBadOctal(interp, string);
164			}
165			return TCL_ERROR;
166			}
167			if (errno == ERANGE) {
168			if (interp != (Tcl_Interp *) NULL) {
169			Tcl_SetResult(interp, "integer value too large to represent",
170			TCL_STATIC);
171			Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
172			Tcl_GetStringResult(interp), (char *) NULL);
173			}
174			return TCL_ERROR;
175			}
176			while ((end != '\0') && isspace(UCHAR(end))) { /* INTL: ISO space. */
177			end++;
178			}
179			if (*end != 0) {
180			goto badInteger;
181			}
182			*longPtr = i;
183			return TCL_OK;
184			}
185
186			/*
187			*----------------------------------------------------------------------
188			*
189			* Tcl_GetDouble --
190			*
191			* Given a string, produce the corresponding double-precision
192			* floating-point value.
193			*
194			* Results:
195			* The return value is normally TCL_OK; in this case *doublePtr
196			* will be set to the double-precision value equivalent to string.
197			* If string is improperly formed then TCL_ERROR is returned and
198			* an error message will be left in the interp's result.
199			*
200			* Side effects:
201			* None.
202			*
203			*----------------------------------------------------------------------
204			*/
205
206			int
207			Tcl_GetDouble(interp, string, doublePtr)
208			Tcl_Interp interp; / Interpreter used for error reporting. */
209			char string; / String containing a floating-point number
210			* in a form acceptable to strtod. */
211			double doublePtr; / Place to store converted result. */
212			{
213			char *end;
214			double d;
215
216			errno = 0;
217			d = strtod(string, &end); /* INTL: Tcl source. */
218			if (end == string) {
219			badDouble:
220			if (interp != (Tcl_Interp *) NULL) {
221			Tcl_AppendResult(interp,
222			"expected floating-point number but got \"",
223			string, "\"", (char *) NULL);
224			}
225			return TCL_ERROR;
226			}
227			if (errno != 0 && (d == HUGE_VAL \|\| d == -HUGE_VAL \|\| d == 0)) {
228			if (interp != (Tcl_Interp *) NULL) {
229			TclExprFloatError(interp, d);
230			}
231			return TCL_ERROR;
232			}
233			while ((end != 0) && isspace(UCHAR(end))) { /* INTL: ISO space. */
234			end++;
235			}
236			if (*end != 0) {
237			goto badDouble;
238			}
239			*doublePtr = d;
240			return TCL_OK;
241			}
242
243			/*
244			*----------------------------------------------------------------------
245			*
246			* Tcl_GetBoolean --
247			*
248			* Given a string, return a 0/1 boolean value corresponding
249			* to the string.
250			*
251			* Results:
252			* The return value is normally TCL_OK; in this case *boolPtr
253			* will be set to the 0/1 value equivalent to string. If
254			* string is improperly formed then TCL_ERROR is returned and
255			* an error message will be left in the interp's result.
256			*
257			* Side effects:
258			* None.
259			*
260			*----------------------------------------------------------------------
261			*/
262
263			int
264			Tcl_GetBoolean(interp, string, boolPtr)
265			Tcl_Interp interp; / Interpreter used for error reporting. */
266			char string; / String containing a boolean number
267			* specified either as 1/0 or true/false or
268			* yes/no. */
269			int boolPtr; / Place to store converted result, which
270			* will be 0 or 1. */
271			{
272			int i;
273			char lowerCase[10], c;
274			size_t length;
275
276			/*
277			* Convert the input string to all lower-case.
278			* INTL: This code will work on UTF strings.
279			*/
280
281			for (i = 0; i < 9; i++) {
282			c = string[i];
283			if (c == 0) {
284			break;
285			}
286			if ((c >= 'A') && (c <= 'Z')) {
287			c += (char) ('a' - 'A');
288			}
289			lowerCase[i] = c;
290			}
291			lowerCase[i] = 0;
292
293			length = strlen(lowerCase);
294			c = lowerCase[0];
295			if ((c == '0') && (lowerCase[1] == '\0')) {
296			*boolPtr = 0;
297			} else if ((c == '1') && (lowerCase[1] == '\0')) {
298			*boolPtr = 1;
299			} else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
300			*boolPtr = 1;
301			} else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
302			*boolPtr = 0;
303			} else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
304			*boolPtr = 1;
305			} else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
306			*boolPtr = 0;
307			} else if ((c == 'o') && (length >= 2)) {
308			if (strncmp(lowerCase, "on", length) == 0) {
309			*boolPtr = 1;
310			} else if (strncmp(lowerCase, "off", length) == 0) {
311			*boolPtr = 0;
312			} else {
313			goto badBoolean;
314			}
315			} else {
316			badBoolean:
317			if (interp != (Tcl_Interp *) NULL) {
318			Tcl_AppendResult(interp, "expected boolean value but got \"",
319			string, "\"", (char *) NULL);
320			}
321			return TCL_ERROR;
322			}
323			return TCL_OK;
324			}
325
326	dashley	64	/* End of tclget.c */