Tcl Source Code

            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT=--host=i686-w64-mingw32
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: i686-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-i686
            - gcc-mingw-w64-i686
            - gcc-mingw-w64
            - gcc-multilib
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=i686-w64-mingw32 CFLAGS=-DTCL_UTF_MAX=6"
        - NO_DIRECT_TEST=1
# Test with mingw-w64 (64 bit)
    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit"
        - NO_DIRECT_TEST=1
    - os: linux
      dist: xenial
      compiler: x86_64-w64-mingw32-gcc
      addons:
        apt:
          packages:
            - gcc-mingw-w64-base
            - binutils-mingw-w64-x86-64
            - gcc-mingw-w64-x86-64
            - gcc-mingw-w64
            - wine
      env:
        - BUILD_DIR=win
        - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit CFLAGS=-DTCL_UTF_MAX=6"
        - NO_DIRECT_TEST=1

before_install:
  - export ERROR_ON_FAILURES=1
  - cd ${BUILD_DIR}
install:
  - test -n "$NO_DIRECT_CONFIGURE" || ./configure ${CFGOPT}
script:
  - make
  # The styles=develop avoids some weird problems on OSX
  - test -n "$NO_DIRECT_TEST" || make test styles=develop

    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    const char *dstEnd, *dstStart;
    int result, numChars, charLimit = INT_MAX;

    unsigned short ch;



    if (flags & TCL_ENCODING_CHAR_LIMIT) {
	charLimit = *dstCharsPtr;
    }
    result = TCL_OK;
    if ((srcLen % sizeof(unsigned short)) != 0) {
	result = TCL_CONVERT_MULTIBYTE;
	srcLen /= sizeof(unsigned short);
	srcLen *= sizeof(unsigned short);
    }

    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - TCL_UTF_MAX;

    for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}

	/*
	 * Special case for 1-byte utf chars for speed. Make sure we work with
	 * unsigned short-size data.
	 */

	ch = *(unsigned short *)src;
	if (ch && ch < 0x80) {
	    *dst++ = (ch & 0xFF);
	} else {
	    dst += Tcl_UniCharToUtf(ch, dst);
	}
	src += sizeof(unsigned short);
    }

    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = numChars;
    return result;
}

	/*
	 * Need to handle this in a way that won't cause misalignment by
	 * casting dst to a Tcl_UniChar. [Bug 1122671]
	 */

#ifdef WORDS_BIGENDIAN
#if TCL_UTF_MAX > 4
	if (*chPtr <= 0xFFFF) {
	    *dst++ = (*chPtr >> 8);
	    *dst++ = (*chPtr & 0xFF);
	} else {
	    *dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
	    *dst++ = (*chPtr & 0xFF);
	    *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
	    *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
	}
#else
	*dst++ = (*chPtr >> 8);
	*dst++ = (*chPtr & 0xFF);
#endif
#else
#if TCL_UTF_MAX > 4
	if (*chPtr <= 0xFFFF) {
	    *dst++ = (*chPtr & 0xFF);
	    *dst++ = (*chPtr >> 8);
	} else {
	    *dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
	    *dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
	    *dst++ = (*chPtr & 0xFF);
	    *dst++ = ((*chPtr & 0x3) >> 8) | 0xDC;
	}
#else
	*dst++ = (*chPtr & 0xFF);
	*dst++ = (*chPtr >> 8);
#endif
#endif
    }
    *srcReadPtr = src - srcStart;

/*
 * Further on, in UNICODE mode we just use Tcl_NewUnicodeObj, otherwise
 * NewNativeObj is needed (which provides proper conversion from native
 * encoding to UTF-8).
 */

#if defined(UNICODE) && (TCL_UTF_MAX <= 4)
#   define NewNativeObj Tcl_NewUnicodeObj
#else /* !UNICODE || (TCL_UTF_MAX > 4) */
static inline Tcl_Obj *
NewNativeObj(
    TCHAR *string,
    int length)
{
    Tcl_DString ds;

#ifdef UNICODE
    if (length > 0) {
	length *= sizeof(WCHAR);
    }
    Tcl_WinTCharToUtf(string, length, &ds);
#else
    Tcl_ExternalToUtfDString(NULL, (char *) string, length, &ds);
#endif
    return TclDStringToObj(&ds);
}
#endif /* !UNICODE || (TCL_UTF_MAX > 4) */

/*
 * Declarations for various library functions and variables (don't want to
 * include tclPort.h here, because people might copy this file out of the Tcl
 * source directory to make their own modified versions).
 */

	 * characters separated by "-").
	 */

	if (p == '[') {
	    Tcl_UniChar startChar, endChar;

	    uniPattern++;
	    ch1 = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*uniStr) : *uniStr);
	    uniStr++;
	    while (1) {
		if ((*uniPattern == ']') || (*uniPattern == 0)) {
		    return 0;
		}
		startChar = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*uniPattern)
			: *uniPattern);
		uniPattern++;
		if (*uniPattern == '-') {
		    uniPattern++;
		    if (*uniPattern == 0) {
			return 0;
		    }
		    endChar = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*uniPattern)
			    : *uniPattern);
		    uniPattern++;
		    if (((startChar <= ch1) && (ch1 <= endChar))
			    || ((endChar <= ch1) && (ch1 <= startChar))) {
			/*
			 * Matches ranges of form [a-z] or [z-a].
			 */

	 * characters separated by "-").
	 */

	if (p == '[') {
	    Tcl_UniChar ch1, startChar, endChar;

	    pattern++;
	    ch1 = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*string) : *string);
	    string++;
	    while (1) {
		if ((*pattern == ']') || (pattern == patternEnd)) {
		    return 0;
		}
		startChar = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*pattern) : *pattern);
		pattern++;
		if (*pattern == '-') {
		    pattern++;
		    if (pattern == patternEnd) {
			return 0;
		    }
		    endChar = (nocase ? (Tcl_UniChar)Tcl_UniCharToLower(*pattern)
			    : *pattern);
		    pattern++;
		    if (((startChar <= ch1) && (ch1 <= endChar))
			    || ((endChar <= ch1) && (ch1 <= startChar))) {
			/*
			 * Matches ranges of form [a-z] or [z-a].
			 */

		 * character
		 */

		if ((p != '[') && (p != '?') && (p != '\\')) {
		    if (nocase) {
			while (*str) {
			    charLen = TclUtfToUniChar(str, &ch1);
			    if (ch2==ch1 || ch2==(Tcl_UniChar)Tcl_UniCharToLower(ch1)) {
				break;
			    }
			    str += charLen;
			}
		    } else {
			/*
			 * There's no point in trying to make this code

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

int
TclZipfs_AppHook(
    int *argcPtr,		/* Pointer to argc */
#ifdef _WIN32
    WCHAR
#else /* !_WIN32 */
    char
#endif /* _WIN32 */
    ***argvPtr)			/* Pointer to argv */
{
    char *archive;

proc runtests {} {
    variable x

# Some tests require the testencoding command
testConstraint testencoding [llength [info commands testencoding]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint teststringbytes [llength [info commands teststringbytes]]

testConstraint exec [llength [info commands exec]]
testConstraint testgetencpath [llength [info commands testgetencpath]]

# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested

test encoding-1.1 {Tcl_GetEncoding: system encoding} -setup {

} 00
test encoding-15.3 {UtfToUtfProc null character input} teststringbytes {
    set y [encoding convertfrom utf-8 [encoding convertto utf-8 \u0000]]
    binary scan [teststringbytes $y] H* z
    set z
} c080

test encoding-16.1 {UnicodeToUtfProc} -body {
    set val [encoding convertfrom unicode NN]
    list $val [format %x [scan $val %c]]
} -result "\u4e4e 4e4e"
test encoding-16.2 {UnicodeToUtfProc} -body {
    set val [encoding convertfrom unicode "\xd8\xd8\xdc\xdc"]
    list $val [format %x [scan $val %c]]
} -result "\U460dc 460dc"

test encoding-17.1 {UtfToUnicodeProc} -body {
    encoding convertto unicode "\U460dc"
} -result "\xd8\xd8\xdc\xdc"

test encoding-18.1 {TableToUtfProc} {
} {}

test encoding-19.1 {TableFromUtfProc} {

	Tcl_Obj *norm = Tcl_FSGetNormalizedPath(NULL, pathPtr);

	if (norm != NULL) {
	    /*
	     * Match a single file directly.
	     */

	    int len;
	    DWORD attr;
	    WIN32_FILE_ATTRIBUTE_DATA data;
	    const char *str = TclGetStringFromObj(norm, &len);

	    native = Tcl_FSGetNativePath(pathPtr);

	    if (GetFileAttributesEx(native,
		    GetFileExInfoStandard, &data) != TRUE) {
		return TCL_OK;
	    }
	    attr = data.dwFileAttributes;

	    if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) {
		Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
	    }
	}
	return TCL_OK;
    } else {
	DWORD attr;
	HANDLE handle;
	WIN32_FIND_DATA data;
	const char *dirName;	/* UTF-8 dir name, later with pattern
				 * appended. */
	int dirLength;
	int matchSpecialDots;
	Tcl_DString ds;		/* Native encoding of dir, also used
				 * temporarily for other things. */
	Tcl_DString dsOrig;	/* UTF-8 encoding of dir. */
	Tcl_Obj *fileNamePtr;
	char lastChar;

	/*
	 * Build up the directory name for searching, including a trailing
	 * directory separator.
	 */

	Tcl_DStringInit(&dsOrig);
	dirName = TclGetStringFromObj(fileNamePtr, &dirLength);

	Tcl_DStringAppend(&dsOrig, dirName, dirLength);

	lastChar = dirName[dirLength -1];
	if ((lastChar != '\\') && (lastChar != '/') && (lastChar != ':')) {
	    TclDStringAppendLiteral(&dsOrig, "/");
	    dirLength++;
	}

		Tcl_JoinPath(1, &ptr, bufferPtr);
		rc = 1;
		result = Tcl_DStringValue(bufferPtr);
	    }
	}
	Tcl_DStringFree(&ds);
    } else {

	wName = Tcl_WinUtfToTChar(domain + 1, -1, &ds);
	rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain);
	Tcl_DStringFree(&ds);
	nameLen = domain - name;
    }
    if (rc == 0) {

	wName = Tcl_WinUtfToTChar(name, nameLen, &ds);
	while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) {
	    /*
	     * user does not exists - if domain was not specified,
	     * try again using current domain.
	     */
	    rc = 1;
	    if (domain != NULL) break;
	    /* get current domain */
	    rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain);
	    if (rc != 0) break;
	    domain = INT2PTR(-1); /* repeat once */
	}
	if (rc == 0) {
	    DWORD i, size = MAX_PATH;
	    wHomeDir = uiPtr->usri1_home_dir;
	    if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
		size = lstrlenW(wHomeDir);
		Tcl_WinTCharToUtf((TCHAR *) wHomeDir, size * sizeof(WCHAR), bufferPtr);
	    } else {
		/*
		 * User exists but has no home dir. Return
		 * "{GetProfilesDirectory}/<user>".
		 */
		GetProfilesDirectoryW(buf, &size);
		Tcl_WinTCharToUtf(buf, (size-1) * sizeof(WCHAR), bufferPtr);
		Tcl_DStringAppend(bufferPtr, "/", 1);
		Tcl_DStringAppend(bufferPtr, name, nameLen);
	    }
	    result = Tcl_DStringValue(bufferPtr);
	    /* be sure we return normalized path */
	    for (i = 0; i < size; ++i){
		if (result[i] == '\\') result[i] = '/';
	    }
	    NetApiBufferFree((void *) uiPtr);
	}
	Tcl_DStringFree(&ds);
    }

		Tcl_DStringLength(&dsNorm), &ds);
	nextCheckpoint = Tcl_DStringLength(&ds);
	if (*lastValidPathEnd != 0) {
	    /*
	     * Not the end of the string.
	     */

	    int len;
	    char *path;
	    Tcl_Obj *tmpPathPtr;

	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
		    nextCheckpoint);
	    Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
	    path = TclGetStringFromObj(tmpPathPtr, &len);
	    Tcl_SetStringObj(pathPtr, path, len);
	    Tcl_DecrRefCount(tmpPathPtr);
	} else {
	    /*
	     * End of string was reached above.
	     */

	    Tcl_SetStringObj(pathPtr, Tcl_DStringValue(&ds), nextCheckpoint);

	 */
    } else {
	/*
	 * Path of form C:foo/bar, but this only makes sense if the cwd is
	 * also on drive C.
	 */

	int cwdLen;
	const char *drive =
		TclGetStringFromObj(useThisCwd, &cwdLen);
	char drive_cur = path[0];

	if (drive_cur >= 'a') {
	    drive_cur -= ('a' - 'A');
	}
	if (drive[0] == drive_cur) {
	    absolutePath = Tcl_DuplicateObj(useThisCwd);