Tcl Source Code

2011-03-31  Donal K. Fellows  <[email protected]>

	* generic/tclGetDate.y, generic/tclDate.c (TclClockOldscanObjCmd):
	More generation of errorCode information.

2011-03-28  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c, generic/tclConfig.c, generic/tclUtil.c: More
	generation of errorCode information, notably when lists are
	mis-parsed.

	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd, Tcl_RegsubObjCmd): Use the
	error messages generated by the variable management code rather than
	creating our own.

2011-03-27  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclNREvalObjEx): fix performance issue,
	notably apparent in tclbench's "LIST lset foreach". Many thanks to
	twylite for patiently researching the issue and explaining it to
	me: a missing Tcl_ResetObjResult that causes unwanted sharing of
	the current result Tcl_Obj.

2011-03-26  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (Tcl_Export, Tcl_Import, DoImport): More
	generation of errorCode information.

	* generic/tclCompExpr.c, generic/tclCompile.c, generic/tclExecute.c:

		if (Tcl_ListObjAppendElement(interp, resultPtr, newPtr)
			!= TCL_OK) {
		    Tcl_DecrRefCount(newPtr);
		    Tcl_DecrRefCount(resultPtr);
		    return TCL_ERROR;
		}
	    } else {


		if (Tcl_ObjSetVar2(interp, objv[i], NULL, newPtr,
			TCL_LEAVE_ERR_MSG) == NULL) {


		    return TCL_ERROR;
		}
	    }
	}

	if (all == 0) {
	    break;

	resultPtr = objv[1];
	Tcl_IncrRefCount(resultPtr);
    } else if (offset < wlen) {
	Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, wlen - offset);
    }
    if (objc == 4) {
	if (Tcl_ObjSetVar2(interp, objv[3], NULL, resultPtr,

		TCL_LEAVE_ERR_MSG) == NULL) {
	    result = TCL_ERROR;
	} else {
	    /*
	     * Set the interpreter's object result to an integer object
	     * holding the number of matches.
	     */

	if ((length2 > 1) &&
		strncmp(string, "-nocase", (size_t) length2) == 0) {
	    nocase = 1;
	} else {
	    Tcl_AppendResult(interp, "bad option \"", string,
		    "\": must be -nocase", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * This test is tricky, but has to be that way or you get other strange
     * inconsistencies (see test string-10.20 for illustration why!)

	} else if (mapElemc & 1) {
	    /*
	     * The charMap must be an even number of key/value items.
	     */

	    Tcl_SetObjResult(interp,
		    Tcl_NewStringObj("char map list unbalanced", -1));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "MAP",
		    "UNBALANCED", NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * Take a copy of the source string object if it is the same as the map
     * string to cut out nasty sharing crashes. [Bug 1018562]

	if ((length > 1) &&
	    strncmp(string, "-nocase", (size_t) length) == 0) {
	    nocase = TCL_MATCH_NOCASE;
	} else {
	    Tcl_AppendResult(interp, "bad option \"", string,
		    "\": must be -nocase", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string, NULL);
	    return TCL_ERROR;
	}
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(
		TclStringMatchObj(objv[objc-1], objv[objc-2], nocase)));
    return TCL_OK;
}

     * We need to keep 2 <= length2 <= INT_MAX.
     */

    if (count > INT_MAX/length1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"result exceeds max size for a Tcl value (%d bytes)",
		INT_MAX));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }
    length2 = length1 * count;

    /*
     * Include space for the NUL.
     */

    string2 = attemptckalloc((unsigned) length2 + 1);
    if (string2 == NULL) {
	/*
	 * Alloc failed. Note that in this case we try to do an error message
	 * since this is a case that's most likely when the alloc is large and
	 * that's easy to do with this API. Note that if we fail allocating a
	 * short string, this will likely keel over too (and fatally).
	 */

	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"string size overflow, out of memory allocating %u bytes",
		length2 + 1));
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    }
    for (index = 0; index < count; index++) {
	memcpy(string2 + (length1 * index), string1, (size_t) length1);
    }
    string2[length2] = '\0';

	    i++;
	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_AppendResult(interp, "bad option \"", string2,
		    "\": must be -nocase or -length", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string2, NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * From now on, we only access the two objects at the end of the argument
     * array.

	    i++;
	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
		return TCL_ERROR;
	    }
	} else {
	    Tcl_AppendResult(interp, "bad option \"", string2,
		    "\": must be -nocase or -length", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "INDEX", "option",
		    string2, NULL);
	    return TCL_ERROR;
	}
    }

    /*
     * From now on, we only access the two objects at the end of the argument
     * array.

		/*
		 * Mode already set via -exact, -glob, or -regexp.
		 */

		Tcl_AppendResult(interp, "bad option \"",
			TclGetString(objv[i]), "\": ", options[mode],
			" option already found", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"DOUBLEOPT", NULL);
		return TCL_ERROR;
	    }
	    foundmode = 1;
	    mode = index;
	    break;

	    /*
	     * Check for TIP#75 options specifying the variables to write
	     * regexp information into.
	     */

	case OPT_INDEXV:
	    i++;
	    if (i >= objc-2) {
		Tcl_AppendResult(interp, "missing variable name argument to ",
			"-indexvar", " option", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"NOVAR", NULL);
		return TCL_ERROR;
	    }
	    indexVarObj = objv[i];
	    numMatchesSaved = -1;
	    break;
	case OPT_MATCHV:
	    i++;
	    if (i >= objc-2) {
		Tcl_AppendResult(interp, "missing variable name argument to ",
			"-matchvar", " option", NULL);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			"NOVAR", NULL);
		return TCL_ERROR;
	    }
	    matchVarObj = objv[i];
	    numMatchesSaved = -1;
	    break;
	}
    }

  finishedOptions:
    if (objc - i < 2) {
	Tcl_WrongNumArgs(interp, 1, objv,
		"?-switch ...? string ?pattern body ...? ?default body?");
	return TCL_ERROR;
    }
    if (indexVarObj != NULL && mode != OPT_REGEXP) {
	Tcl_AppendResult(interp,
		"-indexvar option requires -regexp option", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", NULL);
	return TCL_ERROR;
    }
    if (matchVarObj != NULL && mode != OPT_REGEXP) {
	Tcl_AppendResult(interp,
		"-matchvar option requires -regexp option", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
		"MODERESTRICTION", NULL);
	return TCL_ERROR;
    }

    stringObj = objv[i];
    objc -= i + 1;
    objv += i + 1;
    bidx = i + 1;		/* First after the match string. */

     * Complain if there is an odd number of words in the list of patterns and
     * bodies.
     */

    if (objc % 2) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "extra switch pattern with no body", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
		NULL);

	/*
	 * Check if this can be due to a badly placed comment in the switch
	 * block.
	 *
	 * The following is an heuristic to detect the infamous "comment in
	 * switch" error: just check if a pattern begins with '#'.
	 */

	if (splitObjs) {
	    for (i=0 ; i<objc ; i+=2) {
		if (TclGetString(objv[i])[0] == '#') {
		    Tcl_AppendResult(interp, ", this may be due to a "
			    "comment incorrectly placed outside of a "
			    "switch body - see the \"switch\" "
			    "documentation", NULL);
		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH",
			    "BADARM", "COMMENT?", NULL);
		    break;
		}
	    }
	}

	return TCL_ERROR;
    }

    /*
     * Complain if the last body is a continuation. Note that this check
     * assumes that the list is non-empty!
     */

    if (strcmp(TclGetString(objv[objc-1]), "-") == 0) {
	Tcl_ResetResult(interp);
	Tcl_AppendResult(interp, "no body specified for pattern \"",
		TclGetString(objv[objc-2]), "\"", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "SWITCH", "BADARM",
		"FALLTHROUGH", NULL);
	return TCL_ERROR;
    }

    for (i = 0; i < objc; i += 2) {
	/*
	 * See if the pattern matches the string.
	 */

     * The type must be a list of at least length 1.
     */

    if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) {
	return TCL_ERROR;
    } else if (len < 1) {
	Tcl_AppendResult(interp, "type must be non-empty list", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "THROW", "BADEXCEPTION",
		NULL);
	return TCL_ERROR;
    }

    /*
     * Now prepare the result options dictionary. We use the list API as it is
     * slightly more convenient.
     */

	    return TCL_ERROR;
	}
	switch ((enum Handlers) type) {
	case TryFinally:	/* finally script */
	    if (i < objc-2) {
		Tcl_AppendResult(interp, "finally clause must be last", NULL);
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
			"NONTERMINAL", NULL);
		return TCL_ERROR;
	    } else if (i == objc-1) {
		Tcl_AppendResult(interp, "wrong # args to finally clause: ",
			"must be \"", TclGetString(objv[0]),
			" ... finally script\"", NULL);
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "FINALLY",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    finallyObj = objv[++i];
	    break;

	case TryOn:		/* on code variableList script */
	    if (i > objc-4) {
		Tcl_AppendResult(interp, "wrong # args to on clause: ",
			"must be \"", TclGetString(objv[0]),
			" ... on code variableList script\"", NULL);
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "ON",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    if (TCL_ERROR == TclGetCompletionCodeFromObj(interp, objv[i+1], &code)) {
		Tcl_DecrRefCount(handlersObj);
		return TCL_ERROR;
	    }
	    info[2] = NULL;
	    goto commonHandler;

	case TryTrap:		/* trap pattern variableList script */
	    if (i > objc-4) {
		Tcl_AppendResult(interp, "wrong # args to trap clause: ",
			"must be \"... trap pattern variableList script\"",
			NULL);
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
			"ARGUMENT", NULL);
		return TCL_ERROR;
	    }
	    code = 1;
	    if (Tcl_ListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"bad prefix '%s': must be a list",
			Tcl_GetString(objv[i+1])));
		Tcl_DecrRefCount(handlersObj);
		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "TRAP",
			"EXNFORMAT", NULL);
		return TCL_ERROR;
	    }
	    info[2] = objv[i+1];

	commonHandler:
	    if (Tcl_ListObjLength(interp, objv[i+2], &dummy) != TCL_OK) {
		Tcl_DecrRefCount(handlersObj);

	}
    }
    if (bodyShared) {
	Tcl_AppendResult(interp,
		"last non-finally clause must not have a body of \"-\"",
		NULL);
	Tcl_DecrRefCount(handlersObj);
	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "TRY", "BADFALLTHROUGH",
		NULL);
	return TCL_ERROR;
    }
    if (!haveHandlers) {
	Tcl_DecrRefCount(handlersObj);
	handlersObj = NULL;
    }

	    || pkgDict == NULL) {
	/*
	 * Maybe a Tcl_Panic is better, because the package data has to be
	 * present.
	 */

	Tcl_SetResult(interp, "package not known", TCL_STATIC);
	Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
		Tcl_GetString(pkgName), NULL);
	return TCL_ERROR;
    }

    switch ((enum subcmds) index) {
    case CFG_GET:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "key");
	    return TCL_ERROR;
	}

	if (Tcl_DictObjGet(interp, pkgDict, objv[2], &val) != TCL_OK
		|| val == NULL) {
	    Tcl_SetResult(interp, "key not known", TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
		    Tcl_GetString(objv[2]), NULL);
	    return TCL_ERROR;
	}

	Tcl_SetObjResult(interp, val);
	return TCL_OK;

    case CFG_LIST:
	if (objc != 2) {
	    Tcl_WrongNumArgs(interp, 2, objv, NULL);
	    return TCL_ERROR;
	}

	Tcl_DictObjSize(interp, pkgDict, &n);
	listPtr = Tcl_NewListObj(n, NULL);

	if (!listPtr) {
	    Tcl_SetResult(interp, "insufficient memory to create list",
		    TCL_STATIC);
	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	    return TCL_ERROR;
	}

	if (n) {
	    List *listRepPtr = (List *)
		    listPtr->internalRep.twoPtrValue.ptr1;
	    Tcl_DictSearch s;

    dateInfo.separatrix = "";
    Tcl_IncrRefCount(dateInfo.messages);

    status = yyparse(&dateInfo);
    if (status == 1) {
	Tcl_SetObjResult(interp, dateInfo.messages);
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
	return TCL_ERROR;
    } else if (status == 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    } else if (status != 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned "
						  "from date parser. Please "
						  "report this error as a "
						  "bug in Tcl.", -1));
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(dateInfo.messages);

    if (yyHaveDate > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one date in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveTime > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one time of day in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveZone > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one time zone in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveDay > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one weekday in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveOrdinalMonth > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one ordinal month in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }

    result = Tcl_NewObj();
    resultElement = Tcl_NewObj();
    if (yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,

    dateInfo.separatrix = "";
    Tcl_IncrRefCount(dateInfo.messages);

    status = yyparse(&dateInfo);
    if (status == 1) {
	Tcl_SetObjResult(interp, dateInfo.messages);
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "PARSE", NULL);
	return TCL_ERROR;
    } else if (status == 2) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("memory exhausted", -1));
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
	return TCL_ERROR;
    } else if (status != 0) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("Unknown status returned "
						  "from date parser. Please "
						  "report this error as a "
						  "bug in Tcl.", -1));
	Tcl_DecrRefCount(dateInfo.messages);
	Tcl_SetErrorCode(interp, "TCL", "BUG", NULL);
	return TCL_ERROR;
    }
    Tcl_DecrRefCount(dateInfo.messages);

    if (yyHaveDate > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one date in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveTime > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one time of day in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveZone > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one time zone in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveDay > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one weekday in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }
    if (yyHaveOrdinalMonth > 1) {
	Tcl_SetObjResult(interp,
		Tcl_NewStringObj("more than one ordinal month in string", -1));
	Tcl_SetErrorCode(interp, "TCL", "VALUE", "DATE", "MULTIPLE", NULL);
	return TCL_ERROR;
    }

    result = Tcl_NewObj();
    resultElement = Tcl_NewObj();
    if (yyHaveDate) {
	Tcl_ListObjAppendElement(interp, resultElement,

			    && (!isspace(UCHAR(*p2)))	/* INTL: ISO space. */
			    && (p2 < p+20)) {
			p2++;
		    }
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "list element in braces followed by \"%.*s\" "
			    "instead of space", (int) (p2-p), p));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
			    NULL);
		}
		return TCL_ERROR;
	    }
	    break;

	    /*
	     * Backslash: skip over everything up to the end of the backslash

			    && (!isspace(UCHAR(*p2)))	/* INTL: ISO space */
			    && (p2 < p+20)) {
			p2++;
		    }
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "list element in quotes followed by \"%.*s\" "
			    "instead of space", (int) (p2-p), p));
		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "JUNK",
			    NULL);
		}
		return TCL_ERROR;
	    }
	    break;
	}
	p++;
    }

    /*
     * End of list: terminate element.
     */

    if (p == limit) {
	if (openBraces != 0) {
	    if (interp != NULL) {
		Tcl_SetResult(interp, "unmatched open brace in list",
			TCL_STATIC);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "BRACE",
			NULL);
	    }
	    return TCL_ERROR;
	} else if (inQuotes) {
	    if (interp != NULL) {
		Tcl_SetResult(interp, "unmatched open quote in list",
			TCL_STATIC);
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", "QUOTE",
			NULL);
	    }
	    return TCL_ERROR;
	}
	size = (p - elemStart);
    }

  done:

	    *list != 0;  i++) {
	const char *prevList = list;

	result = TclFindElement(interp, list, length, &element, &list,
		&elSize, &brace);
	length -= (list - prevList);
	if (result != TCL_OK) {



	    ckfree(argv);
	    return result;
	}
	if (*element == 0) {
	    break;
	}
	if (i >= size) {

    double value,		/* Value to print as string. */
    char *dst)			/* Where to store converted value; must have
				 * at least TCL_DOUBLE_SPACE characters. */
{
    char *p, c;
    int exponent;
    int signum;
    char *digits;
    char *end;

    int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int));

    /*
     * Handle NaN.
     */
    
    if (TclIsNaN(value)) {
	TclFormatNaN(value, dst);

    /*
     * Ordinary (normal and denormal) values.
     */
    
    if (*precisionPtr == 0) {
	digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST,
		&exponent, &signum, &end);
    } else {
	/*
	 * There are at least two possible interpretations for tcl_precision.
	 *
	 * The first is, "choose the decimal representation having
	 * $tcl_precision digits of significance that is nearest to the given
	 * number, breaking ties by rounding to even, and then trimming
	 * trailing zeros." This gives the greatest possible precision in the
	 * decimal string, but offers the anomaly that [expr 0.1] will be
	 * "0.10000000000000001".
	 *
	 * The second is "choose the decimal representation having at most
	 * $tcl_precision digits of significance that is nearest to the given
	 * number. If no such representation converts exactly to the given
	 * number, choose the one that is closest, breaking ties by rounding
	 * to even. If more than one such representation converts exactly to
	 * the given number, choose the shortest, breaking ties in favour of
	 * the nearest, breaking remaining ties in favour of the one ending in
	 * an even digit."
	 *
	 * Tcl 8.4 implements the first of these, which gives rise to
	 * anomalies in formatting:
	 *
	 * % expr 0.1
	 * 0.10000000000000001
	 * % expr 0.01
	 * 0.01
	 * % expr 1e-7
	 * 9.9999999999999995e-08
	 *
	 * For human readability, it appears better to choose the second rule,
	 * and let [expr 0.1] return 0.1. But for 8.4 compatibility, we prefer
	 * the first (the recommended zero value for tcl_precision avoids the
	 * problem entirely).
	 *
	 * Uncomment TCL_DD_SHORTEN_FLAG in the next call to prefer the method
	 * that allows floating point values to be shortened if it can be done
	 * without loss of precision.
	 */

	digits = TclDoubleDigits(value, *precisionPtr,
				 TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */, 
				 &exponent, &signum, &end);
    }
    if (signum) {

	if (c != '\0') {
	    *dst++ = '.';
	    while (c != '\0') {
		*dst++ = c;
		c = *++p;
	    }
	}

	/*
	 * Tcl 8.4 appears to format with at least a two-digit exponent;
	 * preserve that behaviour when tcl_precision != 0
	 */

	if (*precisionPtr == 0) {
	    sprintf(dst, "e%+d", exponent);
	} else {
	    sprintf(dst, "e%+03d", exponent);
	}
    } else {
	/*

	 * Performance tweak. All ASCII spaces are <= 0x20. So get a quick
	 * answer for most characters before comparing against all spaces in
	 * the switch below.
	 *
	 * NOTE: Remove this if other Unicode spaces ever get accepted as
	 * list-element separators.
	 */

	return 1;
    }
    switch (*end) {
    case ' ':
    case '\t':
    case '\n':
    case '\r':

 *----------------------------------------------------------------------
 *
 * TclFormatInt --
 *
 *	This procedure formats an integer into a sequence of decimal digit
 *	characters in a buffer. If the integer is negative, a minus sign is
 *	inserted at the start of the buffer. A null character is inserted at
 *	the end of the formatted characters. It is the caller's responsibility
 *	to ensure that enough storage is available. This procedure has the
 *	effect of sprintf(buffer, "%ld", n) but is faster as proven in
 *	benchmarks.  This is key to UpdateStringOfInt, which is a common path
 *	for a lot of code (e.g. int-indexed arrays).
 *
 * Results:
 *	An integer representing the number of characters formatted, not
 *	including the terminating \0.
 *
 * Side effects:
 *	The formatted characters are written into the storage pointer to by
 *	the "buffer" argument.
 *
 *----------------------------------------------------------------------
 */

int
TclFormatInt(buffer, n)
    char *buffer;		/* Points to the storage into which the

    } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
	/*
	 * This is our limited string expression evaluator. Pass everything
	 * after "end-" to Tcl_GetInt, then reverse for offset.
	 */

	if (isspace(UCHAR(bytes[4]))) {
	    goto badIndexFormat;
	}
	if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (bytes[3] == '-') {
	    offset = -offset;
	}
    } else {
	/*
	 * Conversion failed. Report the error.
	 */

    badIndexFormat:
	if (interp != NULL) {
	    Tcl_ResetResult(interp);
	    Tcl_AppendResult(interp, "bad index \"", bytes,
		    "\": must be end?[+-]integer?", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
	}
	return TCL_ERROR;

    Tcl_HashTable *tablePtr)
{
    Tcl_HashSearch search;
    Tcl_HashEntry *hPtr;

    for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL;
	    hPtr = Tcl_NextHashEntry(&search)) {
	Tcl_Obj *objPtr = Tcl_GetHashValue(hPtr);

	Tcl_DecrRefCount(objPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
}

/*
 *----------------------------------------------------------------------

 *----------------------------------------------------------------------
 */

static void
FreeThreadHash(
    ClientData clientData)
{
    Tcl_HashTable *tablePtr = clientData;

    ClearHash(tablePtr);
    Tcl_DeleteHashTable(tablePtr);
    ckfree(tablePtr);
}

/*

     * loss of the intrep. Increment newValue refCount early to handle case
     * where we set a PGV to itself.
     */

    Tcl_IncrRefCount(newValue);
    cacheMap = GetThreadHash(&pgvPtr->key);
    ClearHash(cacheMap);
    hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy);

    Tcl_SetHashValue(hPtr, newValue);
    Tcl_MutexUnlock(&pgvPtr->mutex);
}

/*
 *----------------------------------------------------------------------
 *

    /*
     * "***=xxx" == "*xxx*", watch for glob-sensitive chars.
     */

    if ((reStrLen >= 4) && (memcmp("***=", reStr, 4) == 0)) {
	/*
	 * At most, the glob pattern has length 2*reStrLen + 2 to backslash
	 * escape every character and have * at each end.
	 */

	Tcl_DStringSetLength(dsPtr, reStrLen + 2);
	dsStr = dsStrStart = Tcl_DStringValue(dsPtr);
	*dsStr++ = '*';
	for (p = reStr + 4; p < strEnd; p++) {
	    switch (*p) {
	    case '\\': case '*': case '[': case ']': case '?':
		/* Only add \ where necessary for glob */

	if (exactPtr) {
	    *exactPtr = 0;
	}
	return TCL_OK;
    }

    /*
     * At most, the glob pattern has length reStrLen + 2 to account for
     * possible * at each end.
     */

    Tcl_DStringSetLength(dsPtr, reStrLen + 2);
    dsStr = dsStrStart = Tcl_DStringValue(dsPtr);

    /*
     * Check for anchored REs (ie ^foo$), so we can use string equal if
     * possible. Do not alter the start of str so we can free it correctly.
     *
     * Keep track of the last char being an unescaped star to prevent multiple
     * instances.  Simpler than checking that the last star may be escaped.

     */

    msg = NULL;
    p = reStr;
    anchorRight = 0;
    lastIsStar = 0;
    numStars = 0;

	lastIsStar = 0;
    }
    if (numStars > 1) {
	/*
	 * Heuristic: if >1 non-anchoring *, the risk is large that glob
	 * matching is slower than the RE engine, so report invalid.
	 */

	msg = "excessive recursive glob backtrack potential";
	goto invalidGlob;
    }

    if (!anchorRight && !lastIsStar) {
	*dsStr++ = '*';
    }

    VarHashDeleteTable(varPtr->value.tablePtr);
    ckfree(varPtr->value.tablePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * TclObjVarErrMsg --
 *
 *	Generate a reasonable error message describing why a variable
 *	operation failed.
 *
 * Results:
 *	None.
 *

# Commands covered:  regexp, regsub
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

unset -nocomplain foo

testConstraint exec [llength [info commands exec]]

test regexp-1.1 {basic regexp operation} {
    regexp ab*c abbbc
} 1
test regexp-1.2 {basic regexp operation} {

    regexp -nocase FOo abcFOo
} 1
set x abcdefghijklmnopqrstuvwxyz1234567890
set x $x$x$x$x$x$x$x$x$x$x$x$x
test regexp-4.4 {case conversion in regexp} {
    list [regexp -nocase $x $x foo] $foo
} "1 $x"
unset -nocomplain x

test regexp-5.1 {exercise cache of compiled expressions} {
    regexp .*a b
    regexp .*b c
    regexp .*c d
    regexp .*d e
    regexp .*e f

} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexp-6.6 {regexp errors} {
    list [catch {regexp a a f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1 f1} msg] $msg
} {0 1}
test regexp-6.7 {regexp errors} {
    list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
} {0 0}
test regexp-6.8 {regexp errors} -setup {
    unset -nocomplain f1
} -body {
    set f1 44
    regexp abc abc f1(f2)
} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
test regexp-6.9 {regexp errors, -start bad int check} {
    list [catch {regexp -start bogus {^$} {}} msg] $msg
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
test regexp-6.10 {regexp errors} {
    list [catch {regexp {a[} b} msg] $msg
} {1 {couldn't compile regular expression pattern: brackets [] not balanced}}

} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
test regexp-11.5 {regsub errors} {
    list [catch {regsub -gorp a b c} msg] $msg
} {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
test regexp-11.6 {regsub errors} {
    list [catch {regsub -nocase a( b c d} msg] $msg
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexp-11.7 {regsub errors} -setup {
    unset -nocomplain f1
} -body {
    set f1 44
    regsub -nocase aaa aaa xxx f1(f2)
} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
test regexp-11.8 {regsub errors, -start bad int check} {
    list [catch {regsub -start bogus pattern string rep var} msg] $msg
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
test regexp-11.9 {regsub without final variable name returns value} {
    regsub b abaca X
} {aXaca}
test regexp-11.10 {regsub without final variable name returns value} {

} -body {
    exec [interpreter] $junk
} -cleanup {
    removeFile junk.tcl
} -result 1

test regexp-15.1 {regexp -start} {
    unset -nocomplain x
    list [regexp -start -10 {\d} 1abc2de3 x] $x
} {1 1}
test regexp-15.2 {regexp -start} {
    unset -nocomplain x
    list [regexp -start 2 {\d} 1abc2de3 x] $x
} {1 2}
test regexp-15.3 {regexp -start} {
    unset -nocomplain x
    list [regexp -start 4 {\d} 1abc2de3 x] $x
} {1 2}
test regexp-15.4 {regexp -start} {
    unset -nocomplain x
    list [regexp -start 5 {\d} 1abc2de3 x] $x
} {1 3}
test regexp-15.5 {regexp -start, over end of string} {
    unset -nocomplain x
    list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
} {0 0}
test regexp-15.6 {regexp -start, loss of ^$ behavior} {
    list [regexp -start 2 {^$} {}]
} {0}
test regexp-15.7 {regexp -start, double option} {
    regexp -start 2 -start 0 a abc
} 1
test regexp-15.8 {regexp -start, double option} {
    regexp -start 0 -start 2 a abc
} 0
test regexp-15.9 {regexp -start, end relative index} {
    unset -nocomplain x
    list [regexp -start end {\d} 1abc2de3 x] [info exists x]
} {0 0}
test regexp-15.10 {regexp -start, end relative index} {
    unset -nocomplain x
    list [regexp -start end-1 {\d} 1abc2de3 x] [info exists x] $x
} {1 1 3}
test regexp-15.11 {regexp -start, over end of string} {
    set x NA
    list [regexp -start 2 {.*} ab x] $x
} {1 {}}

test regexp-16.1 {regsub -start} {
    unset -nocomplain x
    list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
} {4 a1b/2c/3d/4e/5}
test regexp-16.2 {regsub -start} {
    unset -nocomplain x
    list [regsub -all -start -25 {z} hello {/&} x] $x
} {0 hello}
test regexp-16.3 {regsub -start} {
    unset -nocomplain x
    list [regsub -all -start 3 {z} hello {/&} x] $x
} {0 hello}
test regexp-16.4 {regsub -start, \A behavior} {
    set out {}
    lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
    lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
} {5 /a/b/c/d/e 3 ab/c/d/e}

    regexp -all -inline -- {a*} "b\n"
} {{} {}}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

	testProc 
    } result]
    rename testProc {}
    return $result
    #return [list $status $result]
}

unset -nocomplain foo

test regexpComp-1.1 {basic regexp operation} {
    evalInProc {
	regexp ab*c abbbc
    }
} 1
test regexpComp-1.2 {basic regexp operation} {
    evalInProc {

set ::x abcdefghijklmnopqrstuvwxyz1234567890
set ::x $x$x$x$x$x$x$x$x$x$x$x$x
test regexpComp-4.4 {case conversion in regexp} {
    evalInProc {
	list [regexp -nocase $::x $::x foo] $foo
    }
} "1 $x"
unset -nocomplain ::x

test regexpComp-5.1 {exercise cache of compiled expressions} {
    evalInProc {
	regexp .*a b
	regexp .*b c
	regexp .*c d
	regexp .*d e

test regexpComp-6.7 {regexp errors} {
    evalInProc {
	list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
    }
} {0 0}
test regexpComp-6.8 {regexp errors} {
    evalInProc {
	unset -nocomplain f1
	set f1 44
	list [catch {regexp abc abc f1(f2)} msg] $msg
    }
} {1 {can't set "f1(f2)": variable isn't array}}
test regexpComp-6.9 {regexp errors, -start bad int check} {
    evalInProc {
	list [catch {regexp -start bogus {^$} {}} msg] $msg
    }
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}

test regexpComp-7.1 {basic regsub operation} {

test regexpComp-11.6 {regsub errors} {
    evalInProc {
	list [catch {regsub -nocase a( b c d} msg] $msg
    }
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
test regexpComp-11.7 {regsub errors} {
    evalInProc {
	unset -nocomplain f1
	set f1 44
	list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
    }
} {1 {can't set "f1(f2)": variable isn't array}}
test regexpComp-11.8 {regsub errors, -start bad int check} {
    evalInProc {
	list [catch {regsub -start bogus pattern string rep var} msg] $msg
    }
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}

# This test crashes on the Mac unless you increase the Stack Space to about 1

} -body {
    exec [interpreter] $junk
} -cleanup {
    removeFile junk.tcl
} -result 1

test regexpComp-15.1 {regexp -start} {
    unset -nocomplain x
    list [regexp -start -10 {\d} 1abc2de3 x] $x
} {1 1}
test regexpComp-15.2 {regexp -start} {
    unset -nocomplain x
    list [regexp -start 2 {\d} 1abc2de3 x] $x
} {1 2}
test regexpComp-15.3 {regexp -start} {
    unset -nocomplain x
    list [regexp -start 4 {\d} 1abc2de3 x] $x
} {1 2}
test regexpComp-15.4 {regexp -start} {
    unset -nocomplain x
    list [regexp -start 5 {\d} 1abc2de3 x] $x
} {1 3}
test regexpComp-15.5 {regexp -start, over end of string} {
    unset -nocomplain x
    list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
} {0 0}
test regexpComp-15.6 {regexp -start, loss of ^$ behavior} {
    list [regexp -start 2 {^$} {}]
} {0}

test regexpComp-16.1 {regsub -start} {
    unset -nocomplain x
    list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
} {4 a1b/2c/3d/4e/5}
test regexpComp-16.2 {regsub -start} {
    unset -nocomplain x
    list [regsub -all -start -25 {z} hello {/&} x] $x
} {0 hello}
test regexpComp-16.3 {regsub -start} {
    unset -nocomplain x
    list [regsub -all -start 3 {z} hello {/&} x] $x
} {0 hello}
test regexpComp-16.4 {regsub -start, \A behavior} {
    set out {}
    lappend out [regsub -start 0 -all {\A(\w)} {abcde} {/\1} x] $x
    lappend out [regsub -start 2 -all {\A(\w)} {abcde} {/\1} x] $x
} {5 /a/b/c/d/e 3 ab/c/d/e}

    # Bug 1902436 - last * escaped
    evalInProc {
	set text {this is *bold* !}
	set re {\*bold\*.*!}
	regexp -- $re $text
    }
} 1

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

fi
{ echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5
echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6; }
    if test $tcl_cv_cc_visibility_hidden = yes; then

	CFLAGS="$CFLAGS -fvisibility=hidden"

cat >>confdefs.h <<\_ACEOF
#define MODULE_SCOPE extern
_ACEOF


else


cat >>confdefs.h <<\_ACEOF
#define NO_VIZ
_ACEOF

	    if test "$tcl_cv_cc_visibility_hidden" != yes; then


cat >>confdefs.h <<\_ACEOF
#define MODULE_SCOPE __private_extern__
_ACEOF

		tcl_cv_cc_visibility_hidden=yes

fi

	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH"

	    CYGWIN_*) ;;
	    IRIX*) ;;
	    NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac
fi


    if test "$tcl_cv_cc_visibility_hidden" != yes; then


cat >>confdefs.h <<\_ACEOF
#define MODULE_SCOPE extern
_ACEOF


cat >>confdefs.h <<\_ACEOF
#define NO_VIZ
_ACEOF


fi


    if test "$SHARED_LIB_SUFFIX" = ""; then

	SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'
fi

		CFLAGS=$hold_cflags
	    ], [
		tcl_cv_cc_visibility_hidden=no
	    ])
    ])
    AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [
	CFLAGS="$CFLAGS -fvisibility=hidden"
	AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])
    ], [

	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
	AC_TRY_LINK([
	    extern __attribute__((__visibility__("hidden"))) void f(void);
	    void f(void) {}], [f();], tcl_cv_cc_visibility_hidden=yes,
	    tcl_cv_cc_visibility_hidden=no)
	CFLAGS=$hold_cflags
	AS_IF([test $tcl_cv_cc_visibility_hidden = yes], [

		LDFLAGS=$hold_ldflags])
	    AS_IF([test $tcl_cv_ld_search_paths_first = yes], [
		LDFLAGS="$LDFLAGS -Wl,-search_paths_first"
	    ])
	    AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [
		AC_DEFINE(MODULE_SCOPE, [__private_extern__],
		    [Compiler support for module scope symbols])
		tcl_cv_cc_visibility_hidden=yes
	    ])
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH"
	    AC_DEFINE(MAC_OSX_TCL, 1, [Is this a Mac I see before me?])
	    PLAT_OBJS='${MAC_OSX_OBJS}'
	    PLAT_SRCS='${MAC_OSX_SRCS}'

	    CYGWIN_*) ;;
	    IRIX*) ;;
	    NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac])

    AS_IF([test "$tcl_cv_cc_visibility_hidden" != yes], [
	AC_DEFINE(MODULE_SCOPE, [extern],
	    [No Compiler support for module scope symbols])
	AC_DEFINE(NO_VIZ, [], [No visibility attribute])
    ])

    AS_IF([test "$SHARED_LIB_SUFFIX" = ""], [
	SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'])
    AS_IF([test "$UNSHARED_LIB_SUFFIX" = ""], [
	UNSHARED_LIB_SUFFIX='${VERSION}.a'])
	DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)"

  CELIB_DIR=NO_CELIB
fi;
    echo "$as_me:$LINENO: result: $CELIB_DIR" >&5
echo "${ECHO_T}$CELIB_DIR" >&6

    # Set some defaults (may get changed below)
    EXTRA_CFLAGS=""

cat >>confdefs.h <<\_ACEOF
#define MODULE_SCOPE extern
_ACEOF


    # Extract the first word of "cygpath", so it can be a program name with args.
set dummy cygpath; ac_word=$2
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_prog_CYGPATH+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6

    AC_MSG_CHECKING([for Windows/CE celib directory])
    AC_ARG_WITH(celib,[  --with-celib=DIR        use Windows/CE support library from DIR],
	    CELIB_DIR=$withval, CELIB_DIR=NO_CELIB)
    AC_MSG_RESULT([$CELIB_DIR])

    # Set some defaults (may get changed below)
    EXTRA_CFLAGS=""
	AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])

    AC_CHECK_PROG(CYGPATH, cygpath, cygpath -w, echo)

    SHLIB_SUFFIX=".dll"

    # MACHINE is IX86 for LINK, but this is used by the manifest,
    # which requires x86|amd64|ia64.