Fork me on GitHub

source: git/external/tcl/tclGet.c@ ededa33

ImprovedOutputFile Timing
Last change on this file since ededa33 was d7d2da3, checked in by pavel <pavel@…>, 12 years ago

move branches/ModularDelphes to trunk
  • Property mode set to 100644
File size: 8.6 KB
RevLine 
[d7d2da3]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-1995 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.1 2008-06-04 13:58:06 demin Exp $
15 */
16
17#include "tclInt.h"
18#include "tclPort.h"
19
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 interp->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 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, *p;
49 long i;
50
51 /*
52 * Note: use strtoul instead of strtol for integer conversions
53 * to allow full-size unsigned numbers, but don't depend on strtoul
54 * to handle sign characters; it won't in some implementations.
55 */
56
57 errno = 0;
58 for (p = string; isspace(UCHAR(*p)); p++) {
59 /* Empty loop body. */
60 }
61 if (*p == '-') {
62 p++;
63 i = -((long)strtoul(p, &end, 0));
64 } else if (*p == '+') {
65 p++;
66 i = strtoul(p, &end, 0);
67 } else {
68 i = strtoul(p, &end, 0);
69 }
70 if (end == p) {
71 badInteger:
72 if (interp != (Tcl_Interp *) NULL) {
73 Tcl_AppendResult(interp, "expected integer but got \"", string,
74 "\"", (char *) NULL);
75 }
76 return TCL_ERROR;
77 }
78
79 /*
80 * The second test below is needed on platforms where "long" is
81 * larger than "int" to detect values that fit in a long but not in
82 * an int.
83 */
84
85 if ((errno == ERANGE) || (((long)(int) i) != i)) {
86 if (interp != (Tcl_Interp *) NULL) {
87 Tcl_SetResult(interp, "integer value too large to represent",
88 TCL_STATIC);
89 Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
90 interp->result, (char *) NULL);
91 }
92 return TCL_ERROR;
93 }
94 while ((*end != '\0') && isspace(UCHAR(*end))) {
95 end++;
96 }
97 if (*end != 0) {
98 goto badInteger;
99 }
100 *intPtr = (int) i;
101 return TCL_OK;
102}
103
104
105/*
106 *----------------------------------------------------------------------
107 *
108 * TclGetLong --
109 *
110 * Given a string, produce the corresponding long integer value.
111 * This routine is a version of Tcl_GetInt but returns a "long"
112 * instead of an "int".
113 *
114 * Results:
115 * The return value is normally TCL_OK; in this case *longPtr
116 * will be set to the long integer value equivalent to string. If
117 * string is improperly formed then TCL_ERROR is returned and
118 * an error message will be left in interp->result.
119 *
120 * Side effects:
121 * None.
122 *
123 *----------------------------------------------------------------------
124 */
125
126int
127TclGetLong(interp, string, longPtr)
128 Tcl_Interp *interp; /* Interpreter used for error reporting. */
129 char *string; /* String containing a (possibly signed)
130 * long integer in a form acceptable to
131 * strtoul. */
132 long *longPtr; /* Place to store converted long result. */
133{
134 char *end, *p;
135 long i;
136
137 /*
138 * Note: don't depend on strtoul to handle sign characters; it won't
139 * in some implementations.
140 */
141
142 errno = 0;
143 for (p = string; isspace(UCHAR(*p)); p++) {
144 /* Empty loop body. */
145 }
146 if (*p == '-') {
147 p++;
148 i = -(int)strtoul(p, &end, 0);
149 } else if (*p == '+') {
150 p++;
151 i = strtoul(p, &end, 0);
152 } else {
153 i = strtoul(p, &end, 0);
154 }
155 if (end == p) {
156 badInteger:
157 if (interp != (Tcl_Interp *) NULL) {
158 Tcl_AppendResult(interp, "expected integer but got \"", string,
159 "\"", (char *) NULL);
160 }
161 return TCL_ERROR;
162 }
163 if (errno == ERANGE) {
164 if (interp != (Tcl_Interp *) NULL) {
165 Tcl_SetResult(interp, "integer value too large to represent",
166 TCL_STATIC);
167 Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
168 interp->result, (char *) NULL);
169 }
170 return TCL_ERROR;
171 }
172 while ((*end != '\0') && isspace(UCHAR(*end))) {
173 end++;
174 }
175 if (*end != 0) {
176 goto badInteger;
177 }
178 *longPtr = i;
179 return TCL_OK;
180}
181
182
183/*
184 *----------------------------------------------------------------------
185 *
186 * Tcl_GetDouble --
187 *
188 * Given a string, produce the corresponding double-precision
189 * floating-point value.
190 *
191 * Results:
192 * The return value is normally TCL_OK; in this case *doublePtr
193 * will be set to the double-precision value equivalent to string.
194 * If string is improperly formed then TCL_ERROR is returned and
195 * an error message will be left in interp->result.
196 *
197 * Side effects:
198 * None.
199 *
200 *----------------------------------------------------------------------
201 */
202
203int
204Tcl_GetDouble(interp, string, doublePtr)
205 Tcl_Interp *interp; /* Interpreter used for error reporting. */
206 char *string; /* String containing a floating-point number
207 * in a form acceptable to strtod. */
208 double *doublePtr; /* Place to store converted result. */
209{
210 char *end;
211 double d;
212
213 errno = 0;
214 d = strtod(string, &end);
215 if (end == string) {
216 badDouble:
217 if (interp != (Tcl_Interp *) NULL) {
218 Tcl_AppendResult(interp,
219 "expected floating-point number but got \"",
220 string, "\"", (char *) NULL);
221 }
222 return TCL_ERROR;
223 }
224 if (errno != 0) {
225 if (interp != (Tcl_Interp *) NULL) {
226 TclExprFloatError(interp, d); /* sets interp->objResult */
227
228 /*
229 * Move the interpreter's object result to the string result,
230 * then reset the object result.
231 * FAILS IF OBJECT RESULT'S STRING REPRESENTATION HAS NULLS.
232 */
233
234 Tcl_SetResult(interp,
235 TclGetStringFromObj(Tcl_GetObjResult(interp),
236 (int *) NULL),
237 TCL_VOLATILE);
238 }
239 return TCL_ERROR;
240 }
241 while ((*end != 0) && isspace(UCHAR(*end))) {
242 end++;
243 }
244 if (*end != 0) {
245 goto badDouble;
246 }
247 *doublePtr = d;
248 return TCL_OK;
249}
250
251
252/*
253 *----------------------------------------------------------------------
254 *
255 * Tcl_GetBoolean --
256 *
257 * Given a string, return a 0/1 boolean value corresponding
258 * to the string.
259 *
260 * Results:
261 * The return value is normally TCL_OK; in this case *boolPtr
262 * will be set to the 0/1 value equivalent to string. If
263 * string is improperly formed then TCL_ERROR is returned and
264 * an error message will be left in interp->result.
265 *
266 * Side effects:
267 * None.
268 *
269 *----------------------------------------------------------------------
270 */
271
272int
273Tcl_GetBoolean(interp, string, boolPtr)
274 Tcl_Interp *interp; /* Interpreter used for error reporting. */
275 char *string; /* String containing a boolean number
276 * specified either as 1/0 or true/false or
277 * yes/no. */
278 int *boolPtr; /* Place to store converted result, which
279 * will be 0 or 1. */
280{
281 int i;
282 char lowerCase[10], c;
283 size_t length;
284
285 /*
286 * Convert the input string to all lower-case.
287 */
288
289 for (i = 0; i < 9; i++) {
290 c = string[i];
291 if (c == 0) {
292 break;
293 }
294 if ((c >= 'A') && (c <= 'Z')) {
295 c += (char) ('a' - 'A');
296 }
297 lowerCase[i] = c;
298 }
299 lowerCase[i] = 0;
300
301 length = strlen(lowerCase);
302 c = lowerCase[0];
303 if ((c == '0') && (lowerCase[1] == '\0')) {
304 *boolPtr = 0;
305 } else if ((c == '1') && (lowerCase[1] == '\0')) {
306 *boolPtr = 1;
307 } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
308 *boolPtr = 1;
309 } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
310 *boolPtr = 0;
311 } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
312 *boolPtr = 1;
313 } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
314 *boolPtr = 0;
315 } else if ((c == 'o') && (length >= 2)) {
316 if (strncmp(lowerCase, "on", length) == 0) {
317 *boolPtr = 1;
318 } else if (strncmp(lowerCase, "off", length) == 0) {
319 *boolPtr = 0;
320 } else {
321 goto badBoolean;
322 }
323 } else {
324 badBoolean:
325 if (interp != (Tcl_Interp *) NULL) {
326 Tcl_AppendResult(interp, "expected boolean value but got \"",
327 string, "\"", (char *) NULL);
328 }
329 return TCL_ERROR;
330 }
331 return TCL_OK;
332}
Note: See TracBrowser for help on using the repository browser.