1 |
dashley |
71 |
/* $Header$ */ |
2 |
|
|
/* |
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 |
|
|
/* End of tclget.c */ |