/[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 42 - (show annotations) (download)
Fri Oct 14 01:50:00 2016 UTC (7 years, 4 months ago) by dashley
Original Path: projs/trunk/shared_source/tcl_base/tclget.c
File MIME type: text/plain
File size: 9678 byte(s)
Move shared source code to commonize.
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 */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25