os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclGet.c
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclGet.c Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,340 @@
1.4 +/*
1.5 + * tclGet.c --
1.6 + *
1.7 + * This file contains procedures to convert strings into
1.8 + * other forms, like integers or floating-point numbers or
1.9 + * booleans, doing syntax checking along the way.
1.10 + *
1.11 + * Copyright (c) 1990-1993 The Regents of the University of California.
1.12 + * Copyright (c) 1994-1997 Sun Microsystems, Inc.
1.13 + * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.
1.14 + *
1.15 + * See the file "license.terms" for information on usage and redistribution
1.16 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.17 + *
1.18 + * RCS: @(#) $Id: tclGet.c,v 1.8.2.1 2005/04/20 16:06:17 dgp Exp $
1.19 + */
1.20 +
1.21 +#include "tclInt.h"
1.22 +#include "tclPort.h"
1.23 +#include "tclMath.h"
1.24 +
1.25 +
1.26 +/*
1.27 + *----------------------------------------------------------------------
1.28 + *
1.29 + * Tcl_GetInt --
1.30 + *
1.31 + * Given a string, produce the corresponding integer value.
1.32 + *
1.33 + * Results:
1.34 + * The return value is normally TCL_OK; in this case *intPtr
1.35 + * will be set to the integer value equivalent to string. If
1.36 + * string is improperly formed then TCL_ERROR is returned and
1.37 + * an error message will be left in the interp's result.
1.38 + *
1.39 + * Side effects:
1.40 + * None.
1.41 + *
1.42 + *----------------------------------------------------------------------
1.43 + */
1.44 +
1.45 +EXPORT_C int
1.46 +Tcl_GetInt(interp, string, intPtr)
1.47 + Tcl_Interp *interp; /* Interpreter to use for error reporting. */
1.48 + CONST char *string; /* String containing a (possibly signed)
1.49 + * integer in a form acceptable to strtol. */
1.50 + int *intPtr; /* Place to store converted result. */
1.51 +{
1.52 + char *end;
1.53 + CONST char *p = string;
1.54 + long i;
1.55 +
1.56 + /*
1.57 + * Note: use strtoul instead of strtol for integer conversions
1.58 + * to allow full-size unsigned numbers, but don't depend on strtoul
1.59 + * to handle sign characters; it won't in some implementations.
1.60 + */
1.61 +
1.62 + errno = 0;
1.63 +#ifdef TCL_STRTOUL_SIGN_CHECK
1.64 + /*
1.65 + * This special sign check actually causes bad numbers to be allowed
1.66 + * when strtoul. I can't find a strtoul that doesn't validly handle
1.67 + * signed characters, and the C standard implies that this is all
1.68 + * unnecessary. [Bug #634856]
1.69 + */
1.70 + for ( ; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */
1.71 + /* Empty loop body. */
1.72 + }
1.73 + if (*p == '-') {
1.74 + p++;
1.75 + i = -((long)strtoul(p, &end, 0)); /* INTL: Tcl source. */
1.76 + } else if (*p == '+') {
1.77 + p++;
1.78 + i = strtoul(p, &end, 0); /* INTL: Tcl source. */
1.79 + } else
1.80 +#else
1.81 + i = strtoul(p, &end, 0); /* INTL: Tcl source. */
1.82 +#endif
1.83 + if (end == p) {
1.84 + badInteger:
1.85 + if (interp != (Tcl_Interp *) NULL) {
1.86 + Tcl_AppendResult(interp, "expected integer but got \"", string,
1.87 + "\"", (char *) NULL);
1.88 + TclCheckBadOctal(interp, string);
1.89 + }
1.90 + return TCL_ERROR;
1.91 + }
1.92 +
1.93 + /*
1.94 + * The second test below is needed on platforms where "long" is
1.95 + * larger than "int" to detect values that fit in a long but not in
1.96 + * an int.
1.97 + */
1.98 +
1.99 + if ((errno == ERANGE)
1.100 +#if (LONG_MAX > INT_MAX)
1.101 + || (i > UINT_MAX) || (i < -(long)UINT_MAX)
1.102 +#endif
1.103 + ) {
1.104 + if (interp != (Tcl_Interp *) NULL) {
1.105 + Tcl_SetResult(interp, "integer value too large to represent",
1.106 + TCL_STATIC);
1.107 + Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
1.108 + Tcl_GetStringResult(interp), (char *) NULL);
1.109 + }
1.110 + return TCL_ERROR;
1.111 + }
1.112 + while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
1.113 + end++;
1.114 + }
1.115 + if (*end != 0) {
1.116 + goto badInteger;
1.117 + }
1.118 + *intPtr = (int) i;
1.119 + return TCL_OK;
1.120 +}
1.121 +
1.122 +/*
1.123 + *----------------------------------------------------------------------
1.124 + *
1.125 + * TclGetLong --
1.126 + *
1.127 + * Given a string, produce the corresponding long integer value.
1.128 + * This routine is a version of Tcl_GetInt but returns a "long"
1.129 + * instead of an "int".
1.130 + *
1.131 + * Results:
1.132 + * The return value is normally TCL_OK; in this case *longPtr
1.133 + * will be set to the long integer value equivalent to string. If
1.134 + * string is improperly formed then TCL_ERROR is returned and
1.135 + * an error message will be left in the interp's result if interp
1.136 + * is non-NULL.
1.137 + *
1.138 + * Side effects:
1.139 + * None.
1.140 + *
1.141 + *----------------------------------------------------------------------
1.142 + */
1.143 +
1.144 +int
1.145 +TclGetLong(interp, string, longPtr)
1.146 + Tcl_Interp *interp; /* Interpreter used for error reporting
1.147 + * if not NULL. */
1.148 + CONST char *string; /* String containing a (possibly signed)
1.149 + * long integer in a form acceptable to
1.150 + * strtoul. */
1.151 + long *longPtr; /* Place to store converted long result. */
1.152 +{
1.153 + char *end;
1.154 + CONST char *p = string;
1.155 + long i;
1.156 +
1.157 + /*
1.158 + * Note: don't depend on strtoul to handle sign characters; it won't
1.159 + * in some implementations.
1.160 + */
1.161 +
1.162 + errno = 0;
1.163 +#ifdef TCL_STRTOUL_SIGN_CHECK
1.164 + for ( ; isspace(UCHAR(*p)); p++) { /* INTL: ISO space. */
1.165 + /* Empty loop body. */
1.166 + }
1.167 + if (*p == '-') {
1.168 + p++;
1.169 + i = -(int)strtoul(p, &end, 0); /* INTL: Tcl source. */
1.170 + } else if (*p == '+') {
1.171 + p++;
1.172 + i = strtoul(p, &end, 0); /* INTL: Tcl source. */
1.173 + } else
1.174 +#else
1.175 + i = strtoul(p, &end, 0); /* INTL: Tcl source. */
1.176 +#endif
1.177 + if (end == p) {
1.178 + badInteger:
1.179 + if (interp != (Tcl_Interp *) NULL) {
1.180 + Tcl_AppendResult(interp, "expected integer but got \"", string,
1.181 + "\"", (char *) NULL);
1.182 + TclCheckBadOctal(interp, string);
1.183 + }
1.184 + return TCL_ERROR;
1.185 + }
1.186 + if (errno == ERANGE) {
1.187 + if (interp != (Tcl_Interp *) NULL) {
1.188 + Tcl_SetResult(interp, "integer value too large to represent",
1.189 + TCL_STATIC);
1.190 + Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
1.191 + Tcl_GetStringResult(interp), (char *) NULL);
1.192 + }
1.193 + return TCL_ERROR;
1.194 + }
1.195 + while ((*end != '\0') && isspace(UCHAR(*end))) { /* INTL: ISO space. */
1.196 + end++;
1.197 + }
1.198 + if (*end != 0) {
1.199 + goto badInteger;
1.200 + }
1.201 + *longPtr = i;
1.202 + return TCL_OK;
1.203 +}
1.204 +
1.205 +/*
1.206 + *----------------------------------------------------------------------
1.207 + *
1.208 + * Tcl_GetDouble --
1.209 + *
1.210 + * Given a string, produce the corresponding double-precision
1.211 + * floating-point value.
1.212 + *
1.213 + * Results:
1.214 + * The return value is normally TCL_OK; in this case *doublePtr
1.215 + * will be set to the double-precision value equivalent to string.
1.216 + * If string is improperly formed then TCL_ERROR is returned and
1.217 + * an error message will be left in the interp's result.
1.218 + *
1.219 + * Side effects:
1.220 + * None.
1.221 + *
1.222 + *----------------------------------------------------------------------
1.223 + */
1.224 +
1.225 +EXPORT_C int
1.226 +Tcl_GetDouble(interp, string, doublePtr)
1.227 + Tcl_Interp *interp; /* Interpreter used for error reporting. */
1.228 + CONST char *string; /* String containing a floating-point number
1.229 + * in a form acceptable to strtod. */
1.230 + double *doublePtr; /* Place to store converted result. */
1.231 +{
1.232 + char *end;
1.233 + double d;
1.234 +
1.235 + errno = 0;
1.236 + d = strtod(string, &end); /* INTL: Tcl source. */
1.237 + if (end == string) {
1.238 + badDouble:
1.239 + if (interp != (Tcl_Interp *) NULL) {
1.240 + Tcl_AppendResult(interp,
1.241 + "expected floating-point number but got \"",
1.242 + string, "\"", (char *) NULL);
1.243 + }
1.244 + return TCL_ERROR;
1.245 + }
1.246 + if (errno != 0 && (d == HUGE_VAL || d == -HUGE_VAL || d == 0)) {
1.247 + if (interp != (Tcl_Interp *) NULL) {
1.248 + TclExprFloatError(interp, d);
1.249 + }
1.250 + return TCL_ERROR;
1.251 + }
1.252 + while ((*end != 0) && isspace(UCHAR(*end))) { /* INTL: ISO space. */
1.253 + end++;
1.254 + }
1.255 + if (*end != 0) {
1.256 + goto badDouble;
1.257 + }
1.258 + *doublePtr = d;
1.259 + return TCL_OK;
1.260 +}
1.261 +
1.262 +/*
1.263 + *----------------------------------------------------------------------
1.264 + *
1.265 + * Tcl_GetBoolean --
1.266 + *
1.267 + * Given a string, return a 0/1 boolean value corresponding
1.268 + * to the string.
1.269 + *
1.270 + * Results:
1.271 + * The return value is normally TCL_OK; in this case *boolPtr
1.272 + * will be set to the 0/1 value equivalent to string. If
1.273 + * string is improperly formed then TCL_ERROR is returned and
1.274 + * an error message will be left in the interp's result.
1.275 + *
1.276 + * Side effects:
1.277 + * None.
1.278 + *
1.279 + *----------------------------------------------------------------------
1.280 + */
1.281 +
1.282 +EXPORT_C int
1.283 +Tcl_GetBoolean(interp, string, boolPtr)
1.284 + Tcl_Interp *interp; /* Interpreter used for error reporting. */
1.285 + CONST char *string; /* String containing a boolean number
1.286 + * specified either as 1/0 or true/false or
1.287 + * yes/no. */
1.288 + int *boolPtr; /* Place to store converted result, which
1.289 + * will be 0 or 1. */
1.290 +{
1.291 + int i;
1.292 + char lowerCase[10], c;
1.293 + size_t length;
1.294 +
1.295 + /*
1.296 + * Convert the input string to all lower-case.
1.297 + * INTL: This code will work on UTF strings.
1.298 + */
1.299 +
1.300 + for (i = 0; i < 9; i++) {
1.301 + c = string[i];
1.302 + if (c == 0) {
1.303 + break;
1.304 + }
1.305 + if ((c >= 'A') && (c <= 'Z')) {
1.306 + c += (char) ('a' - 'A');
1.307 + }
1.308 + lowerCase[i] = c;
1.309 + }
1.310 + lowerCase[i] = 0;
1.311 +
1.312 + length = strlen(lowerCase);
1.313 + c = lowerCase[0];
1.314 + if ((c == '0') && (lowerCase[1] == '\0')) {
1.315 + *boolPtr = 0;
1.316 + } else if ((c == '1') && (lowerCase[1] == '\0')) {
1.317 + *boolPtr = 1;
1.318 + } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
1.319 + *boolPtr = 1;
1.320 + } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
1.321 + *boolPtr = 0;
1.322 + } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
1.323 + *boolPtr = 1;
1.324 + } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
1.325 + *boolPtr = 0;
1.326 + } else if ((c == 'o') && (length >= 2)) {
1.327 + if (strncmp(lowerCase, "on", length) == 0) {
1.328 + *boolPtr = 1;
1.329 + } else if (strncmp(lowerCase, "off", length) == 0) {
1.330 + *boolPtr = 0;
1.331 + } else {
1.332 + goto badBoolean;
1.333 + }
1.334 + } else {
1.335 + badBoolean:
1.336 + if (interp != (Tcl_Interp *) NULL) {
1.337 + Tcl_AppendResult(interp, "expected boolean value but got \"",
1.338 + string, "\"", (char *) NULL);
1.339 + }
1.340 + return TCL_ERROR;
1.341 + }
1.342 + return TCL_OK;
1.343 +}