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