shared_source/c_tcl_base_7_5_w_mods/tclget.c

/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclget.c,v 1.1.1.1 2001/06/13 04:39:21 dtashley Exp $ */

/* 
 * 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;
}


/* $History: tclget.c $
 * 
 * *****************  Version 1  *****************
 * User: Dtashley     Date: 1/02/01    Time: 1:30a
 * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
 * Initial check-in.
 */ 

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