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