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