/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclget.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclget.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 64 - (show annotations) (download)
Sun Oct 30 04:21:11 2016 UTC (8 years, 1 month ago) by dashley
File MIME type: text/plain
File size: 9355 byte(s)
Adjust line endings to Windows style.
Set properties to expand the "Header" keyword.
Change header and footer.
1 /* $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 */

Properties

Name Value
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25