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