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

Annotation of /projs/trunk/shared_source/tcl_base/tclget.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 29 - (hide annotations) (download)
Sat Oct 8 07:08:47 2016 UTC (7 years, 4 months ago) by dashley
Original Path: to_be_filed/sf_code/esrgpcpj/shared/tcl_base/tclget.c
File MIME type: text/plain
File size: 9678 byte(s)
Directories relocated.
1 dashley 25 /* $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