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

Diff of /projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclget.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

projs/trunk/shared_source/tcl_base/tclget.c revision 42 by dashley, Fri Oct 14 01:50:00 2016 UTC projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclget.c revision 220 by dashley, Sun Jul 22 15:58:07 2018 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclget.c,v 1.1.1.1 2001/06/13 04:39:21 dtashley Exp $ */  
   
 /*  
  * tclGet.c --  
  *  
  *      This file contains procedures to convert strings into  
  *      other forms, like integers or floating-point numbers or  
  *      booleans, doing syntax checking along the way.  
  *  
  * Copyright (c) 1990-1993 The Regents of the University of California.  
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tclget.c,v 1.1.1.1 2001/06/13 04:39:21 dtashley Exp $  
  */  
   
 #include "tclInt.h"  
 #include "tclPort.h"  
 #include "tclMath.h"  
   
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetInt --  
  *  
  *      Given a string, produce the corresponding integer value.  
  *  
  * Results:  
  *      The return value is normally TCL_OK;  in this case *intPtr  
  *      will be set to the integer value equivalent to string.  If  
  *      string is improperly formed then TCL_ERROR is returned and  
  *      an error message will be left in the interp's result.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_GetInt(interp, string, intPtr)  
     Tcl_Interp *interp;         /* Interpreter to use for error reporting. */  
     char *string;               /* String containing a (possibly signed)  
                                  * integer in a form acceptable to strtol. */  
     int *intPtr;                /* Place to store converted result. */  
 {  
     char *end, *p;  
     long i;  
   
     /*  
      * Note: use strtoul instead of strtol for integer conversions  
      * to allow full-size unsigned numbers, but don't depend on strtoul  
      * to handle sign characters;  it won't in some implementations.  
      */  
   
     errno = 0;  
     for (p = string; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */  
         /* Empty loop body. */  
     }  
     if (*p == '-') {  
         p++;  
         i = -((long)strtoul(p, &end, 0)); /* INTL: Tcl source. */  
     } else if (*p == '+') {  
         p++;  
         i = strtoul(p, &end, 0); /* INTL: Tcl source. */  
     } else {  
         i = strtoul(p, &end, 0); /* INTL: Tcl source. */  
     }  
     if (end == p) {  
         badInteger:  
         if (interp != (Tcl_Interp *) NULL) {  
             Tcl_AppendResult(interp, "expected integer but got \"", string,  
                     "\"", (char *) NULL);  
             TclCheckBadOctal(interp, string);  
         }  
         return TCL_ERROR;  
     }  
   
     /*  
      * The second test below is needed on platforms where "long" is  
      * larger than "int" to detect values that fit in a long but not in  
      * an int.  
      */  
   
     if ((errno == ERANGE) || (((long)(int) i) != i)) {  
         if (interp != (Tcl_Interp *) NULL) {  
             Tcl_SetResult(interp, "integer value too large to represent",  
                     TCL_STATIC);  
             Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",  
                     Tcl_GetStringResult(interp), (char *) NULL);  
         }  
         return TCL_ERROR;  
     }  
     while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */  
         end++;  
     }  
     if (*end != 0) {  
         goto badInteger;  
     }  
     *intPtr = (int) i;  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TclGetLong --  
  *  
  *      Given a string, produce the corresponding long integer value.  
  *      This routine is a version of Tcl_GetInt but returns a "long"  
  *      instead of an "int".  
  *  
  * Results:  
  *      The return value is normally TCL_OK; in this case *longPtr  
  *      will be set to the long integer value equivalent to string. If  
  *      string is improperly formed then TCL_ERROR is returned and  
  *      an error message will be left in the interp's result if interp  
  *      is non-NULL.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TclGetLong(interp, string, longPtr)  
     Tcl_Interp *interp;         /* Interpreter used for error reporting  
                                  * if not NULL. */  
     char *string;               /* String containing a (possibly signed)  
                                  * long integer in a form acceptable to  
                                  * strtoul. */  
     long *longPtr;              /* Place to store converted long result. */  
 {  
     char *end, *p;  
     long i;  
   
     /*  
      * Note: don't depend on strtoul to handle sign characters; it won't  
      * in some implementations.  
      */  
   
     errno = 0;  
     for (p = string; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */  
         /* Empty loop body. */  
     }  
     if (*p == '-') {  
         p++;  
         i = -(int)strtoul(p, &end, 0); /* INTL: Tcl source. */  
     } else if (*p == '+') {  
         p++;  
         i = strtoul(p, &end, 0); /* INTL: Tcl source. */  
     } else {  
         i = strtoul(p, &end, 0); /* INTL: Tcl source. */  
     }  
     if (end == p) {  
         badInteger:  
         if (interp != (Tcl_Interp *) NULL) {  
             Tcl_AppendResult(interp, "expected integer but got \"", string,  
                     "\"", (char *) NULL);  
             TclCheckBadOctal(interp, string);  
         }  
         return TCL_ERROR;  
     }  
     if (errno == ERANGE) {  
         if (interp != (Tcl_Interp *) NULL) {  
             Tcl_SetResult(interp, "integer value too large to represent",  
                     TCL_STATIC);  
             Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",  
                     Tcl_GetStringResult(interp), (char *) NULL);  
         }  
         return TCL_ERROR;  
     }  
     while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */  
         end++;  
     }  
     if (*end != 0) {  
         goto badInteger;  
     }  
     *longPtr = i;  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetDouble --  
  *  
  *      Given a string, produce the corresponding double-precision  
  *      floating-point value.  
  *  
  * Results:  
  *      The return value is normally TCL_OK; in this case *doublePtr  
  *      will be set to the double-precision value equivalent to string.  
  *      If string is improperly formed then TCL_ERROR is returned and  
  *      an error message will be left in the interp's result.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_GetDouble(interp, string, doublePtr)  
     Tcl_Interp *interp;         /* Interpreter used for error reporting. */  
     char *string;               /* String containing a floating-point number  
                                  * in a form acceptable to strtod. */  
     double *doublePtr;          /* Place to store converted result. */  
 {  
     char *end;  
     double d;  
   
     errno = 0;  
     d = strtod(string, &end); /* INTL: Tcl source. */  
     if (end == string) {  
         badDouble:  
         if (interp != (Tcl_Interp *) NULL) {  
             Tcl_AppendResult(interp,  
                     "expected floating-point number but got \"",  
                     string, "\"", (char *) NULL);  
         }  
         return TCL_ERROR;  
     }  
     if (errno != 0 && (d == HUGE_VAL || d == -HUGE_VAL || d == 0)) {  
         if (interp != (Tcl_Interp *) NULL) {  
             TclExprFloatError(interp, d);  
         }  
         return TCL_ERROR;  
     }  
     while ((*end != 0) && isspace(UCHAR(*end))) { /* INTL: ISO space. */  
         end++;  
     }  
     if (*end != 0) {  
         goto badDouble;  
     }  
     *doublePtr = d;  
     return TCL_OK;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_GetBoolean --  
  *  
  *      Given a string, return a 0/1 boolean value corresponding  
  *      to the string.  
  *  
  * Results:  
  *      The return value is normally TCL_OK;  in this case *boolPtr  
  *      will be set to the 0/1 value equivalent to string.  If  
  *      string is improperly formed then TCL_ERROR is returned and  
  *      an error message will be left in the interp's result.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 Tcl_GetBoolean(interp, string, boolPtr)  
     Tcl_Interp *interp;         /* Interpreter used for error reporting. */  
     char *string;               /* String containing a boolean number  
                                  * specified either as 1/0 or true/false or  
                                  * yes/no. */  
     int *boolPtr;               /* Place to store converted result, which  
                                  * will be 0 or 1. */  
 {  
     int i;  
     char lowerCase[10], c;  
     size_t length;  
   
     /*  
      * Convert the input string to all lower-case.  
      * INTL: This code will work on UTF strings.  
      */  
   
     for (i = 0; i < 9; i++) {  
         c = string[i];  
         if (c == 0) {  
             break;  
         }  
         if ((c >= 'A') && (c <= 'Z')) {  
             c += (char) ('a' - 'A');  
         }  
         lowerCase[i] = c;  
     }  
     lowerCase[i] = 0;  
   
     length = strlen(lowerCase);  
     c = lowerCase[0];  
     if ((c == '0') && (lowerCase[1] == '\0')) {  
         *boolPtr = 0;  
     } else if ((c == '1') && (lowerCase[1] == '\0')) {  
         *boolPtr = 1;  
     } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {  
         *boolPtr = 1;  
     } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {  
         *boolPtr = 0;  
     } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {  
         *boolPtr = 1;  
     } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {  
         *boolPtr = 0;  
     } else if ((c == 'o') && (length >= 2)) {  
         if (strncmp(lowerCase, "on", length) == 0) {  
             *boolPtr = 1;  
         } else if (strncmp(lowerCase, "off", length) == 0) {  
             *boolPtr = 0;  
         } else {  
             goto badBoolean;  
         }  
     } else {  
         badBoolean:  
         if (interp != (Tcl_Interp *) NULL) {  
             Tcl_AppendResult(interp, "expected boolean value but got \"",  
                     string, "\"", (char *) NULL);  
         }  
         return TCL_ERROR;  
     }  
     return TCL_OK;  
 }  
   
   
 /* $History: tclget.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 1:30a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLGET.C */  
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 */
Legend:
Removed from v.42  
changed lines
  Added in v.220
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25