home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / tkisrc04.zip / tcl / os2 / tclGet.c < prev    next >
C/C++ Source or Header  |  1998-08-07  |  6KB  |  233 lines

  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.  * SCCS: @(#) tclGet.c 1.24 96/02/15 11:42:47
  15.  */
  16.  
  17. #include "tclInt.h"
  18. #include "tclPort.h"
  19.  
  20.  
  21. /*
  22.  *----------------------------------------------------------------------
  23.  *
  24.  * Tcl_GetInt --
  25.  *
  26.  *    Given a string, produce the corresponding integer value.
  27.  *
  28.  * Results:
  29.  *    The return value is normally TCL_OK;  in this case *intPtr
  30.  *    will be set to the integer value equivalent to string.  If
  31.  *    string is improperly formed then TCL_ERROR is returned and
  32.  *    an error message will be left in interp->result.
  33.  *
  34.  * Side effects:
  35.  *    None.
  36.  *
  37.  *----------------------------------------------------------------------
  38.  */
  39.  
  40. int
  41. Tcl_GetInt(interp, string, intPtr)
  42.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  43.     char *string;        /* String containing a (possibly signed)
  44.                  * integer in a form acceptable to strtol. */
  45.     int *intPtr;        /* Place to store converted result. */
  46. {
  47.     char *end, *p;
  48.     int i;
  49.  
  50.     /*
  51.      * Note: use strtoul instead of strtol for integer conversions
  52.      * to allow full-size unsigned numbers, but don't depend on strtoul
  53.      * to handle sign characters;  it won't in some implementations.
  54.      */
  55.  
  56.     errno = 0;
  57.     for (p = string; isspace(UCHAR(*p)); p++) {
  58.     /* Empty loop body. */
  59.     }
  60.     if (*p == '-') {
  61.     p++;
  62.     i = -(int)strtoul(p, &end, 0);
  63.     } else if (*p == '+') {
  64.     p++;
  65.     i = strtoul(p, &end, 0);
  66.     } else {
  67.     i = strtoul(p, &end, 0);
  68.     }
  69.     if (end == p) {
  70.     badInteger:
  71.         if (interp != (Tcl_Interp *) NULL) {
  72.             Tcl_AppendResult(interp, "expected integer but got \"", string,
  73.                     "\"", (char *) NULL);
  74.         }
  75.     return TCL_ERROR;
  76.     }
  77.     if (errno == ERANGE) {
  78.         if (interp != (Tcl_Interp *) NULL) {
  79.             interp->result = "integer value too large to represent";
  80.             Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW",
  81.                     interp->result, (char *) NULL);
  82.         }
  83.     return TCL_ERROR;
  84.     }
  85.     while ((*end != '\0') && isspace(UCHAR(*end))) {
  86.     end++;
  87.     }
  88.     if (*end != 0) {
  89.     goto badInteger;
  90.     }
  91.     *intPtr = i;
  92.     return TCL_OK;
  93. }
  94.  
  95. /*
  96.  *----------------------------------------------------------------------
  97.  *
  98.  * Tcl_GetDouble --
  99.  *
  100.  *    Given a string, produce the corresponding double-precision
  101.  *    floating-point value.
  102.  *
  103.  * Results:
  104.  *    The return value is normally TCL_OK;  in this case *doublePtr
  105.  *    will be set to the double-precision value equivalent to string.
  106.  *    If string is improperly formed then TCL_ERROR is returned and
  107.  *    an error message will be left in interp->result.
  108.  *
  109.  * Side effects:
  110.  *    None.
  111.  *
  112.  *----------------------------------------------------------------------
  113.  */
  114.  
  115. int
  116. Tcl_GetDouble(interp, string, doublePtr)
  117.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  118.     char *string;        /* String containing a floating-point number
  119.                  * in a form acceptable to strtod. */
  120.     double *doublePtr;        /* Place to store converted result. */
  121. {
  122.     char *end;
  123.     double d;
  124.  
  125.     errno = 0;
  126.     d = strtod(string, &end);
  127.     if (end == string) {
  128.     badDouble:
  129.         if (interp != (Tcl_Interp *) NULL) {
  130.             Tcl_AppendResult(interp,
  131.                     "expected floating-point number but got \"",
  132.                     string, "\"", (char *) NULL);
  133.         }
  134.     return TCL_ERROR;
  135.     }
  136.     if (errno != 0) {
  137.         if (interp != (Tcl_Interp *) NULL) {
  138.             TclExprFloatError(interp, d);
  139.         }
  140.     return TCL_ERROR;
  141.     }
  142.     while ((*end != 0) && isspace(UCHAR(*end))) {
  143.     end++;
  144.     }
  145.     if (*end != 0) {
  146.     goto badDouble;
  147.     }
  148.     *doublePtr = d;
  149.     return TCL_OK;
  150. }
  151.  
  152. /*
  153.  *----------------------------------------------------------------------
  154.  *
  155.  * Tcl_GetBoolean --
  156.  *
  157.  *    Given a string, return a 0/1 boolean value corresponding
  158.  *    to the string.
  159.  *
  160.  * Results:
  161.  *    The return value is normally TCL_OK;  in this case *boolPtr
  162.  *    will be set to the 0/1 value equivalent to string.  If
  163.  *    string is improperly formed then TCL_ERROR is returned and
  164.  *    an error message will be left in interp->result.
  165.  *
  166.  * Side effects:
  167.  *    None.
  168.  *
  169.  *----------------------------------------------------------------------
  170.  */
  171.  
  172. int
  173. Tcl_GetBoolean(interp, string, boolPtr)
  174.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  175.     char *string;        /* String containing a boolean number
  176.                  * specified either as 1/0 or true/false or
  177.                  * yes/no. */
  178.     int *boolPtr;        /* Place to store converted result, which
  179.                  * will be 0 or 1. */
  180. {
  181.     int i;
  182.     char lowerCase[10], c;
  183.     size_t length;
  184.  
  185.     /*
  186.      * Convert the input string to all lower-case.
  187.      */
  188.  
  189.     for (i = 0; i < 9; i++) {
  190.     c = string[i];
  191.     if (c == 0) {
  192.         break;
  193.     }
  194.     if ((c >= 'A') && (c <= 'Z')) {
  195.         c += (char) ('a' - 'A');
  196.     }
  197.     lowerCase[i] = c;
  198.     }
  199.     lowerCase[i] = 0;
  200.  
  201.     length = strlen(lowerCase);
  202.     c = lowerCase[0];
  203.     if ((c == '0') && (lowerCase[1] == '\0')) {
  204.     *boolPtr = 0;
  205.     } else if ((c == '1') && (lowerCase[1] == '\0')) {
  206.     *boolPtr = 1;
  207.     } else if ((c == 'y') && (strncmp(lowerCase, "yes", length) == 0)) {
  208.     *boolPtr = 1;
  209.     } else if ((c == 'n') && (strncmp(lowerCase, "no", length) == 0)) {
  210.     *boolPtr = 0;
  211.     } else if ((c == 't') && (strncmp(lowerCase, "true", length) == 0)) {
  212.     *boolPtr = 1;
  213.     } else if ((c == 'f') && (strncmp(lowerCase, "false", length) == 0)) {
  214.     *boolPtr = 0;
  215.     } else if ((c == 'o') && (length >= 2)) {
  216.     if (strncmp(lowerCase, "on", length) == 0) {
  217.         *boolPtr = 1;
  218.     } else if (strncmp(lowerCase, "off", length) == 0) {
  219.         *boolPtr = 0;
  220.     } else {
  221.         goto badBoolean;
  222.     }
  223.     } else {
  224.     badBoolean:
  225.         if (interp != (Tcl_Interp *) NULL) {
  226.             Tcl_AppendResult(interp, "expected boolean value but got \"",
  227.                     string, "\"", (char *) NULL);
  228.         }
  229.     return TCL_ERROR;
  230.     }
  231.     return TCL_OK;
  232. }
  233.