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