Index: .github/workflows/linux-with-tcl8-build.yml ================================================================== --- .github/workflows/linux-with-tcl8-build.yml +++ .github/workflows/linux-with-tcl8-build.yml @@ -28,11 +28,11 @@ path: tk - name: Checkout Tcl uses: actions/checkout@v2 with: repository: tcltk/tcl - ref: core-8-branch + ref: tip-613 path: tcl - name: Setup Environment (compiler=${{ matrix.compiler }}) run: | sudo apt-get install libxss-dev mkdir "$HOME/install dir" @@ -131,11 +131,11 @@ path: tk - name: Checkout Tcl uses: actions/checkout@v2 with: repository: tcltk/tcl - ref: core-8-branch + ref: tip-613 path: tcl - name: Setup Environment (compiler=${{ matrix.compiler }}) run: | sudo apt-get install libxss-dev xvfb mkdir "$HOME/install dir" DELETED .github/workflows/linux-with-tcl9-build.yml Index: .github/workflows/linux-with-tcl9-build.yml ================================================================== --- .github/workflows/linux-with-tcl9-build.yml +++ /dev/null @@ -1,172 +0,0 @@ -name: Linux (with Tcl 9.0) -on: [push] -defaults: - run: - shell: bash - working-directory: tk/unix -env: - ERROR_ON_FAILURES: 1 -jobs: - build: - runs-on: ubuntu-20.04 - strategy: - matrix: - compiler: - - "gcc" - - "clang" - cfgopt: - - "" - - "CFLAGS=-DTK_NO_DEPRECATED=1" - - "--disable-shared" - - "--disable-xft" - - "--disable-xss" - - "--enable-symbols" - steps: - - name: Checkout - uses: actions/checkout@v2 - with: - path: tk - - name: Checkout Tcl - uses: actions/checkout@v2 - with: - repository: tcltk/tcl - ref: main - path: tcl - - name: Setup Environment (compiler=${{ matrix.compiler }}) - run: | - sudo apt-get install libxss-dev - mkdir "$HOME/install dir" - touch tk/doc/man.macros tk/generic/tkStubInit.c - echo "CFGOPT=$CFGOPT" >> $GITHUB_ENV - echo "CC=$COMPILER" >> $GITHUB_ENV - echo "TOOL_DIR=$(cd tcl/tools;pwd)" >> $GITHUB_ENV - echo "BUILD_CONFIG_ID=$OPTS" >> $GITHUB_ENV - working-directory: "." - env: - CFGOPT: ${{ matrix.cfgopt }} - COMPILER: ${{ matrix.compiler }} - OPTS: ${{ matrix.compiler }}${{ matrix.cfgopt }} - - name: Configure and Build Tcl - run: | - ./configure ${CFGOPT} "--prefix=$HOME/install dir" || { - cat config.log - echo "::warning::Failure during Tcl Configure" - exit 1 - } - make all install || { - echo "::warning::Failure during Tcl Build" - exit 1 - } - echo "TCL_CONFIG_PATH=`pwd`" >> $GITHUB_ENV - working-directory: tcl/unix - - name: Configure (opts=${{ matrix.cfgopt }}) - run: | - ./configure $CFGOPT --with-tcl=$TCL_CONFIG_PATH "--prefix=$HOME/install dir" || { - cat config.log - echo "::error::Failure during Configure" - exit 1 - } - - name: Build - run: | - make binaries libraries || { - echo "::error::Failure during Build" - exit 1 - } - - name: Build Test Harness - run: | - make tktest || { - echo "::error::Failure during Build" - exit 1 - } - - name: Test-Drive Installation - run: | - make install || { - echo "::error::Failure during Install" - exit 1 - } - - name: Create Distribution Package - run: | - make dist || { - echo "::error::Failure during Distribute" - exit 1 - } - - name: Convert Documentation to HTML - run: | - make html-tk TOOL_DIR=$TOOL_DIR || { - echo "::error::Failure during Distribute" - exit 1 - } - - name: Discover Version ID - if: ${{ env.BUILD_CONFIG_ID == 'gcc' }} - run: | - cd /tmp/dist - echo "VERSION=`ls -d tk* | sed 's/tk//'`" >> $GITHUB_ENV - test: - runs-on: ubuntu-20.04 - strategy: - matrix: - compiler: - - "gcc" - cfgopt: - - "" - - "--enable-symbols" - steps: - - name: Checkout - uses: actions/checkout@v2 - with: - path: tk - - name: Checkout Tcl - uses: actions/checkout@v2 - with: - repository: tcltk/tcl - ref: main - path: tcl - - name: Setup Environment (compiler=${{ matrix.compiler }}) - run: | - sudo apt-get install libxss-dev xvfb - mkdir "$HOME/install dir" - touch tk/doc/man.macros tk/generic/tkStubInit.c - echo "CFGOPT=$CFGOPT" >> $GITHUB_ENV - echo "CC=$COMPILER" >> $GITHUB_ENV - working-directory: "." - env: - CFGOPT: ${{ matrix.cfgopt }} - COMPILER: ${{ matrix.compiler }} - - name: Configure and Build Tcl - run: | - ./configure ${CFGOPT} "--prefix=$HOME/install dir" || { - cat config.log - echo "::warning::Failure during Tcl Configure" - exit 1 - } - make all install || { - echo "::warning::Failure during Tcl Build" - exit 1 - } - echo "TCL_CONFIG_PATH=`pwd`" >> $GITHUB_ENV - working-directory: tcl/unix - - name: Configure ${{ matrix.cfgopt }} - run: | - ./configure $CFGOPT --with-tcl=$TCL_CONFIG_PATH "--prefix=$HOME/install dir" || { - cat config.log - echo "::error::Failure during Configure" - exit 1 - } - - name: Build - run: | - make binaries libraries tktest || { - echo "::error::Failure during Build" - exit 1 - } - - name: Run Tests - run: | - xvfb-run --auto-servernum make test-classic | tee out-classic.txt - xvfb-run --auto-servernum make test-ttk | tee out-ttk.txt - grep -q "Failed 0" out-classic.txt || { - echo "::error::Failure during Test" - exit 1 - } - grep -q "Failed 0" out-ttk.txt || { - echo "::error::Failure during Test" - exit 1 - } Index: .github/workflows/onefiledist.yml ================================================================== --- .github/workflows/onefiledist.yml +++ .github/workflows/onefiledist.yml @@ -17,11 +17,11 @@ path: tk - name: Checkout Tcl 8.7 uses: actions/checkout@v2 with: repository: tcltk/tcl - ref: core-8-branch + ref: tip-613 path: tcl - name: Setup Environment run: | sudo apt-get install libxss-dev touch tcl/generic/tclStubInit.c tcl/generic/tclOOStubInit.c @@ -81,11 +81,11 @@ path: tk - name: Checkout Tcl 8.7 uses: actions/checkout@v2 with: repository: tcltk/tcl - ref: core-8-branch + ref: tip-613 path: tcl - name: Checkout create-dmg uses: actions/checkout@v2 with: repository: create-dmg/create-dmg @@ -169,11 +169,11 @@ path: tk - name: Checkout Tcl 8.7 uses: actions/checkout@v2 with: repository: tcltk/tcl - ref: core-8-branch + ref: tip-613 path: tcl - name: Setup Environment run: | mkdir -p install/combined touch tcl/generic/tclStubInit.c tcl/generic/tclOOStubInit.c Index: .github/workflows/win-build.yml ================================================================== --- .github/workflows/win-build.yml +++ .github/workflows/win-build.yml @@ -17,11 +17,11 @@ path: tk - name: Checkout uses: actions/checkout@v2 with: repository: tcltk/tcl - ref: core-8-branch + ref: tip-613 path: tcl - name: Init MSVC uses: ilammy/msvc-dev-cmd@v1 - name: Make Install Location working-directory: tcl Index: doc/SetOptions.3 ================================================================== --- doc/SetOptions.3 +++ doc/SetOptions.3 @@ -331,21 +331,27 @@ nor \fIclientData\fR. .TP \fBTK_OPTION_ANCHOR\fR The value must be a standard anchor position such as \fBne\fR or \fBcenter\fR. The internal form is a Tk_Anchor value like the ones -returned by \fBTk_GetAnchorFromObj\fR. +returned by \fBTk_GetAnchorFromObj\fR. This option type supports the \fBTK_OPTION_NULL_OK\fR +flag; if the empty string is specified as the value for the option, +the integer relief value is set to \fBTK_ANCHOR_NULL\fR. .TP \fBTK_OPTION_BITMAP\fR The value must be a standard Tk bitmap name. The internal form is a Pixmap token like the ones returned by \fBTk_AllocBitmapFromObj\fR. This option type requires \fItkwin\fR to be supplied to procedures such as \fBTk_SetOptions\fR, and it supports the \fBTK_OPTION_NULL_OK\fR flag. .TP \fBTK_OPTION_BOOLEAN\fR The value must be a standard boolean value such as \fBtrue\fR or -\fBno\fR. The internal form is an integer with value 0 or 1. +\fBno\fR. The internal form is an integer with value 0 or 1. Note: if the +\fIobjOffset\fR field is not used then information about the original value +of this option will be lost. This option type supports the +\fBTK_OPTION_NULL_OK\fR flag; if a NULL value is set, the internal +representation is set to -1. .TP \fBTK_OPTION_BORDER\fR The value must be a standard color name such as \fBred\fR or \fB#ff8080\fR. The internal form is a Tk_3DBorder token like the ones returned by \fBTk_Alloc3DBorderFromObj\fR. @@ -375,11 +381,11 @@ .TP \fBTK_OPTION_DOUBLE\fR The string value must be a floating-point number in the format accepted by \fBstrtol\fR. The internal form is a C \fBdouble\fR value. This option type supports the \fBTK_OPTION_NULL_OK\fR -flag; if a NULL value is set, the internal representation is set to zero. +flag; if a NULL value is set, the internal representation is set to NaN. .TP \fBTK_OPTION_END\fR Marks the end of the template. There must be a Tk_OptionSpec structure with \fItype\fR \fBTK_OPTION_END\fR at the end of each template. If the \fIclientData\fR field of this structure is not NULL, then it points to @@ -397,26 +403,29 @@ .TP \fBTK_OPTION_INT\fR The string value must be an integer in the format accepted by \fBstrtol\fR (e.g. \fB0\fR and \fB0x\fR prefixes may be used to specify octal or hexadecimal numbers, respectively). The internal -form is a C \fBint\fR value. +form is a C \fBint\fR value. This option type supports the \fBTK_OPTION_NULL_OK\fR +flag; if a NULL value is set, the internal representation is set to INT_MIN. .TP \fBTK_OPTION_JUSTIFY\fR The value must be a standard justification value such as \fBleft\fR. The internal form is a Tk_Justify like the values returned by -\fBTk_GetJustifyFromObj\fR. +\fBTk_GetJustifyFromObj\fR. This option type supports the \fBTK_OPTION_NULL_OK\fR +flag; if the empty string is specified as the value for the option, +the integer relief value is set to \fBTK_JUSTIFY_NULL\fR. .TP \fBTK_OPTION_PIXELS\fR The value must specify a screen distance such as \fB2i\fR or \fB6.4\fR. The internal form is an integer value giving a distance in pixels, like the values returned by \fBTk_GetPixelsFromObj\fR. Note: if the \fIobjOffset\fR field is not used then information about the original value of this option will be lost. See \fBOBJOFFSET VS. INTERNALOFFSET\fR below for details. This option type supports the \fBTK_OPTION_NULL_OK\fR flag; if a NULL value is set, the -internal representation is set to zero. +internal representation is set to INT_MIN. .TP \fBTK_OPTION_RELIEF\fR The value must be standard relief such as \fBraised\fR. The internal form is an integer relief value such as \fBTK_RELIEF_RAISED\fR. This option type supports the \fBTK_OPTION_NULL_OK\fR Index: generic/tk.h ================================================================== --- generic/tk.h +++ generic/tk.h @@ -545,10 +545,11 @@ /* * Enumerated type for describing a point by which to anchor something: */ typedef enum { + TK_ANCHOR_NULL = -1, TK_ANCHOR_N, TK_ANCHOR_NE, TK_ANCHOR_E, TK_ANCHOR_SE, TK_ANCHOR_S, TK_ANCHOR_SW, TK_ANCHOR_W, TK_ANCHOR_NW, TK_ANCHOR_CENTER } Tk_Anchor; @@ -555,10 +556,11 @@ /* * Enumerated type for describing a style of justification: */ typedef enum { + TK_JUSTIFY_NULL = -1, TK_JUSTIFY_LEFT, TK_JUSTIFY_RIGHT, TK_JUSTIFY_CENTER } Tk_Justify; /* * The following structure is used by Tk_GetFontMetrics() to return Index: generic/tkConfig.c ================================================================== --- generic/tkConfig.c +++ generic/tkConfig.c @@ -612,11 +612,18 @@ nullOK = (optionPtr->specPtr->flags & TK_OPTION_NULL_OK); switch (optionPtr->specPtr->type) { case TK_OPTION_BOOLEAN: { int newBool; - if (Tcl_GetBooleanFromObj(interp, valuePtr, &newBool) != TCL_OK) { + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + newBool = -1; + } else if (Tcl_GetBooleanFromObj(nullOK ? NULL : interp, valuePtr, &newBool) != TCL_OK) { + if (nullOK && interp) { + Tcl_AppendResult(interp, "expected boolean value or \"\" but got \"", + Tcl_GetString(valuePtr), "\"", NULL); + } return TCL_ERROR; } if (internalPtr != NULL) { *((int *) oldInternalPtr) = *((int *) internalPtr); *((int *) internalPtr) = newBool; @@ -624,11 +631,22 @@ break; } case TK_OPTION_INT: { int newInt; - if (Tcl_GetIntFromObj(interp, valuePtr, &newInt) != TCL_OK) { + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + newInt = INT_MIN; + } else if (Tcl_GetIntFromObj(nullOK ? NULL : interp, valuePtr, &newInt) != TCL_OK) { + if (nullOK && interp) { + Tcl_Obj *msg = Tcl_NewStringObj("expected integer or \"\" but got \"", -1); + + Tcl_AppendLimitedToObj(msg, Tcl_GetString(valuePtr), -1, 50, ""); + Tcl_AppendToObj(msg, "\"", -1); + Tcl_SetObjResult(interp, msg); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); + } return TCL_ERROR; } if (internalPtr != NULL) { *((int *) oldInternalPtr) = *((int *) internalPtr); *((int *) internalPtr) = newInt; @@ -659,11 +677,16 @@ case TK_OPTION_DOUBLE: { double newDbl; if (nullOK && ObjectIsEmpty(valuePtr)) { valuePtr = NULL; - newDbl = 0; +#if defined(NAN) + if (optionPtr->specPtr->flags & TK_OPTION_NULL_OK) { + newDbl = NAN; + } else +#endif + newDbl = 0.0; } else { if (Tcl_GetDoubleFromObj(nullOK ? NULL : interp, valuePtr, &newDbl) != TCL_OK) { if (nullOK && interp) { Tcl_Obj *msg = Tcl_NewStringObj("expected floating-point number or \"\" but got \"", -1); @@ -710,11 +733,11 @@ valuePtr = NULL; newValue = -1; } else { if (Tcl_GetIndexFromObjStruct(interp, valuePtr, optionPtr->specPtr->clientData, sizeof(char *), - optionPtr->specPtr->optionName+1, 0, &newValue) != TCL_OK) { + optionPtr->specPtr->optionName+1, (nullOK ? TCL_INDEX_NULL_OK : 0), &newValue) != TCL_OK) { return TCL_ERROR; } } if (internalPtr != NULL) { *((int *) oldInternalPtr) = *((int *) internalPtr); @@ -817,11 +840,11 @@ if (nullOK && ObjectIsEmpty(valuePtr)) { valuePtr = NULL; newRelief = TK_RELIEF_NULL; } else if (Tcl_GetIndexFromObj(interp, valuePtr, tkReliefStrings, - "relief", 0, &newRelief) != TCL_OK) { + "relief", (nullOK ? TCL_INDEX_NULL_OK : 0), &newRelief) != TCL_OK) { return TCL_ERROR; } if (internalPtr != NULL) { *((int *) oldInternalPtr) = *((int *) internalPtr); *((int *) internalPtr) = newRelief; @@ -848,12 +871,15 @@ break; } case TK_OPTION_JUSTIFY: { int newJustify; - if (Tcl_GetIndexFromObj(interp, valuePtr, tkJustifyStrings, - "justification", 0, &newJustify) != TCL_OK) { + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + newJustify = -1; + } else if (Tcl_GetIndexFromObj(interp, valuePtr, tkJustifyStrings, + "justification", (nullOK ? TCL_INDEX_NULL_OK : 0), &newJustify) != TCL_OK) { return TCL_ERROR; } if (internalPtr != NULL) { *((Tk_Justify *) oldInternalPtr) = *((Tk_Justify *) internalPtr); *((Tk_Justify *) internalPtr) = (Tk_Justify)newJustify; @@ -861,12 +887,15 @@ break; } case TK_OPTION_ANCHOR: { int newAnchor; - if (Tcl_GetIndexFromObj(interp, valuePtr, tkAnchorStrings, - "anchor", 0, &newAnchor) != TCL_OK) { + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + newAnchor = -1; + } else if (Tcl_GetIndexFromObj(interp, valuePtr, tkAnchorStrings, + "anchor", (nullOK ? TCL_INDEX_NULL_OK : 0), &newAnchor) != TCL_OK) { return TCL_ERROR; } if (internalPtr != NULL) { *((Tk_Anchor *) oldInternalPtr) = *((Tk_Anchor *) internalPtr); *((Tk_Anchor *) internalPtr) = (Tk_Anchor)newAnchor; @@ -876,11 +905,11 @@ case TK_OPTION_PIXELS: { int newPixels; if (nullOK && ObjectIsEmpty(valuePtr)) { valuePtr = NULL; - newPixels = 0; + newPixels = INT_MIN; } else if (Tk_GetPixelsFromObj(interp, tkwin, valuePtr, &newPixels) != TCL_OK) { return TCL_ERROR; } if (internalPtr != NULL) { @@ -1901,12 +1930,18 @@ objPtr = NULL; if (optionPtr->specPtr->internalOffset != TCL_INDEX_NONE) { internalPtr = (char *)recordPtr + optionPtr->specPtr->internalOffset; switch (optionPtr->specPtr->type) { case TK_OPTION_BOOLEAN: + if (*((int *) internalPtr) != -1) { + objPtr = Tcl_NewBooleanObj(*((int *)internalPtr)); + } + break; case TK_OPTION_INT: - objPtr = Tcl_NewWideIntObj(*((int *)internalPtr)); + if (!(optionPtr->specPtr->flags & TK_OPTION_NULL_OK) || *((int *) internalPtr) != INT_MIN) { + objPtr = Tcl_NewWideIntObj(*((int *)internalPtr)); + } break; case TK_OPTION_INDEX: if (*((int *) internalPtr) == INT_MIN) { objPtr = TkNewIndexObj(TCL_INDEX_NONE); } else if (*((int *) internalPtr) == INT_MAX) { @@ -1920,18 +1955,22 @@ } else { objPtr = Tcl_NewWideIntObj(*((int *) internalPtr)); } break; case TK_OPTION_DOUBLE: - objPtr = Tcl_NewDoubleObj(*((double *) internalPtr)); + if (!(optionPtr->specPtr->flags & TK_OPTION_NULL_OK) || !TkIsNaN(*((double *) internalPtr))) { + objPtr = Tcl_NewDoubleObj(*((double *) internalPtr)); + } break; case TK_OPTION_STRING: objPtr = Tcl_NewStringObj(*((char **)internalPtr), -1); break; case TK_OPTION_STRING_TABLE: - objPtr = Tcl_NewStringObj(((char **) optionPtr->specPtr->clientData)[ - *((int *) internalPtr)], -1); + if (*((int *) internalPtr) >= 0) { + objPtr = Tcl_NewStringObj(((char **) optionPtr->specPtr->clientData)[ + *((int *) internalPtr)], -1); + } break; case TK_OPTION_COLOR: { XColor *colorPtr = *((XColor **)internalPtr); if (colorPtr != NULL) { @@ -1991,11 +2030,13 @@ case TK_OPTION_ANCHOR: objPtr = Tcl_NewStringObj(Tk_NameOfAnchor( *((Tk_Anchor *)internalPtr)), -1); break; case TK_OPTION_PIXELS: - objPtr = Tcl_NewWideIntObj(*((int *)internalPtr)); + if (!(optionPtr->specPtr->flags & TK_OPTION_NULL_OK) || *((int *) internalPtr) != INT_MIN) { + objPtr = Tcl_NewWideIntObj(*((int *)internalPtr)); + } break; case TK_OPTION_WINDOW: { tkwin = *((Tk_Window *) internalPtr); if (tkwin != NULL) { Index: generic/tkGet.c ================================================================== --- generic/tkGet.c +++ generic/tkGet.c @@ -188,10 +188,11 @@ case TK_ANCHOR_S: return "s"; case TK_ANCHOR_SW: return "sw"; case TK_ANCHOR_W: return "w"; case TK_ANCHOR_NW: return "nw"; case TK_ANCHOR_CENTER: return "center"; + case TK_ANCHOR_NULL: return ""; } return "unknown anchor position"; } /* @@ -469,11 +470,11 @@ { switch (justify) { case TK_JUSTIFY_LEFT: return "left"; case TK_JUSTIFY_RIGHT: return "right"; case TK_JUSTIFY_CENTER: return "center"; - default: break; + case TK_JUSTIFY_NULL: return ""; } return "unknown justification style"; } /* Index: generic/tkInt.h ================================================================== --- generic/tkInt.h +++ generic/tkInt.h @@ -78,10 +78,20 @@ # define TkSizeT size_t # else # define TkSizeT int # endif #endif + +#ifdef _MSC_VER +# define TkIsNaN(d) (_isnan((d))) +#else +# ifdef NO_ISNAN +# define TkIsNaN(d) ((d) != (d)) +# else +# define TkIsNaN(d) (isnan(d)) +# endif +#endif #if (TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION < 7) # define Tcl_WCharToUtfDString ((char * (*)(const WCHAR *, int len, Tcl_DString *))Tcl_UniCharToUtfDString) # define Tcl_UtfToWCharDString ((WCHAR * (*)(const char *, int len, Tcl_DString *))Tcl_UtfToUniCharDString) # define Tcl_Char16ToUtfDString Tcl_UniCharToUtfDString @@ -123,15 +133,18 @@ # endif #endif /* * Fallback in case Tk is linked against a Tcl version not having TIP #585 - * (TCL_INDEX_TEMP_TABLE). + * (TCL_INDEX_TEMP_TABLE) or not having TIP #613 (TCL_INDEX_NULL_OK). */ #if !defined(TCL_INDEX_TEMP_TABLE) # define TCL_INDEX_TEMP_TABLE 2 +#endif +#if !defined(TCL_INDEX_NULL_OK) +# define TCL_INDEX_NULL_OK 4 #endif #ifndef TCL_Z_MODIFIER # if defined(_WIN64) # define TCL_Z_MODIFIER "I" Index: generic/tkTest.c ================================================================== --- generic/tkTest.c +++ generic/tkTest.c @@ -593,12 +593,12 @@ }; static const char *const stringTable2[] = { "one", "two", NULL }; static const Tk_OptionSpec typesSpecs[] = { - {TK_OPTION_BOOLEAN, "-boolean", "boolean", "Boolean", "1", - offsetof(TypesRecord, booleanPtr), TCL_INDEX_NONE, 0, 0, 0x1}, + {TK_OPTION_BOOLEAN, "-boolean", "boolean", "Boolean", NULL, + offsetof(TypesRecord, booleanPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, 0, 0x1}, {TK_OPTION_INT, "-integer", "integer", "Integer", "7", offsetof(TypesRecord, integerPtr), TCL_INDEX_NONE, 0, 0, 0x2}, {TK_OPTION_DOUBLE, "-double", "double", "Double", "3.14159", offsetof(TypesRecord, doublePtr), TCL_INDEX_NONE, 0, 0, 0x4}, {TK_OPTION_STRING, "-string", "string", "String", @@ -605,15 +605,15 @@ "foo", offsetof(TypesRecord, stringPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, 0, 0x8}, {TK_OPTION_STRING_TABLE, "-stringtable", "StringTable", "stringTable", "one", offsetof(TypesRecord, stringTablePtr), TCL_INDEX_NONE, - 0, stringTable, 0x10}, + TK_CONFIG_NULL_OK, stringTable, 0x10}, {TK_OPTION_STRING_TABLE, "-stringtable2", "StringTable2", "stringTable2", "two", offsetof(TypesRecord, stringTablePtr2), TCL_INDEX_NONE, - 0, stringTable2, 0x10}, + TK_CONFIG_NULL_OK, stringTable2, 0x10}, {TK_OPTION_COLOR, "-color", "color", "Color", "red", offsetof(TypesRecord, colorPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, "black", 0x20}, {TK_OPTION_FONT, "-font", "font", "Font", "Helvetica 12", offsetof(TypesRecord, fontPtr), TCL_INDEX_NONE, @@ -633,11 +633,11 @@ {TK_OPTION_JUSTIFY, "-justify", NULL, NULL, "left", offsetof(TypesRecord, justifyPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, 0, 0x800}, {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", "center", offsetof(TypesRecord, anchorPtr), TCL_INDEX_NONE, - 0, 0, 0x1000}, + TK_CONFIG_NULL_OK, 0, 0x1000}, {TK_OPTION_PIXELS, "-pixel", "pixel", "Pixel", "1", offsetof(TypesRecord, pixelPtr), TCL_INDEX_NONE, TK_CONFIG_NULL_OK, 0, 0x2000}, {TK_OPTION_CUSTOM, "-custom", NULL, NULL, "", offsetof(TypesRecord, customPtr), TCL_INDEX_NONE, @@ -797,11 +797,11 @@ Tcl_Obj *intPtr; } ErrorWidgetRecord; ErrorWidgetRecord widgetRecord; static const Tk_OptionSpec errorSpecs[] = { {TK_OPTION_INT, "-int", "integer", "Integer", "bogus", - offsetof(ErrorWidgetRecord, intPtr), 0, 0, NULL, 0}, + offsetof(ErrorWidgetRecord, intPtr), 0, TK_OPTION_NULL_OK, NULL, 0}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, NULL, 0} }; Tk_OptionTable optionTable; widgetRecord.intPtr = NULL; @@ -871,11 +871,11 @@ static const char *const internalStringTable[] = { "one", "two", "three", "four", NULL }; static const Tk_OptionSpec internalSpecs[] = { {TK_OPTION_BOOLEAN, "-boolean", "boolean", "Boolean", "1", - TCL_INDEX_NONE, offsetof(InternalRecord, boolean), 0, 0, 0x1}, + TCL_INDEX_NONE, offsetof(InternalRecord, boolean), TK_CONFIG_NULL_OK, 0, 0x1}, {TK_OPTION_INT, "-integer", "integer", "Integer", "148962237", TCL_INDEX_NONE, offsetof(InternalRecord, integer), 0, 0, 0x2}, {TK_OPTION_DOUBLE, "-double", "double", "Double", "3.14159", TCL_INDEX_NONE, offsetof(InternalRecord, doubleValue), 0, 0, 0x4}, {TK_OPTION_STRING, "-string", "string", "String", "foo", @@ -906,11 +906,11 @@ {TK_OPTION_JUSTIFY, "-justify", NULL, NULL, "left", TCL_INDEX_NONE, offsetof(InternalRecord, justify), TK_CONFIG_NULL_OK, 0, 0x800}, {TK_OPTION_ANCHOR, "-anchor", "anchor", "Anchor", "center", TCL_INDEX_NONE, offsetof(InternalRecord, anchor), - 0, 0, 0x1000}, + TK_CONFIG_NULL_OK, 0, 0x1000}, {TK_OPTION_PIXELS, "-pixel", "pixel", "Pixel", "1", TCL_INDEX_NONE, offsetof(InternalRecord, pixels), TK_CONFIG_NULL_OK, 0, 0x2000}, {TK_OPTION_WINDOW, "-window", "window", "Window", NULL, TCL_INDEX_NONE, offsetof(InternalRecord, tkwin), Index: generic/tkText.c ================================================================== --- generic/tkText.c +++ generic/tkText.c @@ -56,21 +56,21 @@ * The 'TkWrapMode' enum in tkText.h is used to define a type for the -wrap * option of the Text widget. These values are used as indices into the string * table below. */ -static const char *const wrapStrings[] = { +const char *const tkTextWrapStrings[] = { "char", "none", "word", NULL }; /* * The 'TkTextTabStyle' enum in tkText.h is used to define a type for the * -tabstyle option of the Text widget. These values are used as indices into * the string table below. */ -static const char *const tabStyleStrings[] = { +const char *const tkTextTabStyleStrings[] = { "tabular", "wordprocessor", NULL }; /* * The 'TkTextInsertUnfocussed' enum in tkText.h is used to define a type for @@ -234,11 +234,11 @@ {TK_OPTION_STRING, "-tabs", "tabs", "Tabs", DEF_TEXT_TABS, offsetof(TkText, tabOptionPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, TK_TEXT_LINE_GEOMETRY}, {TK_OPTION_STRING_TABLE, "-tabstyle", "tabStyle", "TabStyle", DEF_TEXT_TABSTYLE, TCL_INDEX_NONE, offsetof(TkText, tabStyle), - 0, tabStyleStrings, TK_TEXT_LINE_GEOMETRY}, + 0, tkTextTabStyleStrings, TK_TEXT_LINE_GEOMETRY}, {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", DEF_TEXT_TAKE_FOCUS, TCL_INDEX_NONE, offsetof(TkText, takeFocus), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_BOOLEAN, "-undo", "undo", "Undo", DEF_TEXT_UNDO, TCL_INDEX_NONE, offsetof(TkText, undo), @@ -246,11 +246,11 @@ {TK_OPTION_INT, "-width", "width", "Width", DEF_TEXT_WIDTH, TCL_INDEX_NONE, offsetof(TkText, width), 0, 0, TK_TEXT_LINE_GEOMETRY}, {TK_OPTION_STRING_TABLE, "-wrap", "wrap", "Wrap", DEF_TEXT_WRAP, TCL_INDEX_NONE, offsetof(TkText, wrapMode), - 0, wrapStrings, TK_TEXT_LINE_GEOMETRY}, + 0, tkTextWrapStrings, TK_TEXT_LINE_GEOMETRY}, {TK_OPTION_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand", DEF_TEXT_XSCROLL_COMMAND, TCL_INDEX_NONE, offsetof(TkText, xScrollCmd), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand", DEF_TEXT_YSCROLL_COMMAND, TCL_INDEX_NONE, offsetof(TkText, yScrollCmd), Index: generic/tkText.h ================================================================== --- generic/tkText.h +++ generic/tkText.h @@ -280,13 +280,15 @@ * widget. These structures are kept in sharedTextPtr->tagTable and referred * to in other structures. */ typedef enum { - TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_NONE, TEXT_WRAPMODE_WORD, - TEXT_WRAPMODE_NULL + TEXT_WRAPMODE_NULL = -1, + TEXT_WRAPMODE_CHAR, TEXT_WRAPMODE_NONE, TEXT_WRAPMODE_WORD } TkWrapMode; + +MODULE_SCOPE const char *const tkTextWrapStrings[]; typedef struct TkTextTag { const char *name; /* Name of this tag. This field is actually a * pointer to the key from the entry in * sharedTextPtr->tagTable, so it needn't be @@ -333,11 +335,11 @@ * foreground stuff. None means no value * specified here.*/ char *justifyString; /* -justify option string (malloc-ed). NULL * means option not specified. */ Tk_Justify justify; /* How to justify text: TK_JUSTIFY_LEFT, - * TK_JUSTIFY_RIGHT, or TK_JUSTIFY_CENTER. + * TK_JUSTIFY_RIGHT, TK_JUSTIFY_CENTER, or TK_JUSTIFY_NULL. * Only valid if justifyString is non-NULL. */ char *lMargin1String; /* -lmargin1 option string (malloc-ed). NULL * means option not specified. */ int lMargin1; /* Left margin for first display line of each * text line, in pixels. Only valid if @@ -391,12 +393,12 @@ Tcl_Obj *tabStringPtr; /* -tabs option string. NULL means option not * specified. */ struct TkTextTabArray *tabArrayPtr; /* Info about tabs for tag (malloc-ed) or * NULL. Corresponds to tabString. */ - int tabStyle; /* One of TABULAR or WORDPROCESSOR or NONE (if - * not specified). */ + int tabStyle; /* One of TK_TEXT_TABSTYLE_TABULAR or TK_TEXT_TABSTYLE_WORDPROCESSOR + * or TK_TEXT_TABSTYLE_NULL (if not specified). */ char *underlineString; /* -underline option string (malloc-ed). NULL * means option not specified. */ int underline; /* Non-zero means draw underline underneath * text. Only valid if underlineString is * non-NULL. */ @@ -464,18 +466,20 @@ typedef enum {LEFT, RIGHT, CENTER, NUMERIC} TkTextTabAlign; /* * The following are the supported styles of tabbing, used for the -tabstyle - * option of the text widget. The last element is only used for tag options. + * option of the text widget. The first element is only used for tag options. */ typedef enum { + TK_TEXT_TABSTYLE_NULL = -1, TK_TEXT_TABSTYLE_TABULAR, - TK_TEXT_TABSTYLE_WORDPROCESSOR, - TK_TEXT_TABSTYLE_NONE + TK_TEXT_TABSTYLE_WORDPROCESSOR } TkTextTabStyle; + +MODULE_SCOPE const char *const tkTextTabStyleStrings[]; typedef struct TkTextTab { int location; /* Offset in pixels of this tab stop from the * left margin (lmargin2) of the text. */ TkTextTabAlign alignment; /* Where the tab stop appears relative to the @@ -693,11 +697,11 @@ Tcl_Obj *tabOptionPtr; /* Value of -tabs option string. */ TkTextTabArray *tabArrayPtr; /* Information about tab stops (malloc'ed). * NULL means perform default tabbing * behavior. */ - int tabStyle; /* One of TABULAR or WORDPROCESSOR. */ + int tabStyle; /* One of TK_TEXT_TABSTYLE_TABULAR or TK_TEXT_TABSTYLE_WORDPROCESSOR. */ /* * Additional information used for displaying: */ Index: generic/tkTextTag.c ================================================================== --- generic/tkTextTag.c +++ generic/tkTextTag.c @@ -14,32 +14,10 @@ #include "tkInt.h" #include "tkText.h" #include "default.h" -/* - * The 'TkWrapMode' enum in tkText.h is used to define a type for the -wrap - * option of tags in a Text widget. These values are used as indices into the - * string table below. Tags are allowed an empty wrap value, but the widget as - * a whole is not. - */ - -static const char *const wrapStrings[] = { - "char", "none", "word", "", NULL -}; - -/* - * The 'TkTextTabStyle' enum in tkText.h is used to define a type for the - * -tabstyle option of the Text widget. These values are used as indices into - * the string table below. Tags are allowed an empty tabstyle value, but the - * widget as a whole is not. - */ - -static const char *const tabStyleStrings[] = { - "tabular", "wordprocessor", "", NULL -}; - static const Tk_OptionSpec tagOptionSpecs[] = { {TK_OPTION_BORDER, "-background", NULL, NULL, NULL, TCL_INDEX_NONE, offsetof(TkTextTag, border), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_BITMAP, "-bgstipple", NULL, NULL, NULL, TCL_INDEX_NONE, offsetof(TkTextTag, bgStipple), TK_OPTION_NULL_OK, 0, 0}, @@ -89,20 +67,20 @@ NULL, TCL_INDEX_NONE, offsetof(TkTextTag, spacing3String), TK_OPTION_NULL_OK,0,0}, {TK_OPTION_STRING, "-tabs", NULL, NULL, NULL, offsetof(TkTextTag, tabStringPtr), TCL_INDEX_NONE, TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-tabstyle", NULL, NULL, NULL, TCL_INDEX_NONE, offsetof(TkTextTag, tabStyle), - TK_OPTION_NULL_OK, tabStyleStrings, 0}, + TK_OPTION_NULL_OK, tkTextTabStyleStrings, 0}, {TK_OPTION_STRING, "-underline", NULL, NULL, NULL, TCL_INDEX_NONE, offsetof(TkTextTag, underlineString), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_COLOR, "-underlinefg", NULL, NULL, NULL, TCL_INDEX_NONE, offsetof(TkTextTag, underlineColor), TK_OPTION_NULL_OK, 0, 0}, {TK_OPTION_STRING_TABLE, "-wrap", NULL, NULL, NULL, TCL_INDEX_NONE, offsetof(TkTextTag, wrapMode), - TK_OPTION_NULL_OK, wrapStrings, 0}, + TK_OPTION_NULL_OK, tkTextWrapStrings, 0}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0} }; /* * Forward declarations for functions defined later in this file: @@ -1036,11 +1014,11 @@ tagPtr->bgStipple = None; tagPtr->fgColor = NULL; tagPtr->tkfont = NULL; tagPtr->fgStipple = None; tagPtr->justifyString = NULL; - tagPtr->justify = TK_JUSTIFY_LEFT; + tagPtr->justify = TK_JUSTIFY_NULL; tagPtr->lMargin1String = NULL; tagPtr->lMargin1 = 0; tagPtr->lMargin2String = NULL; tagPtr->lMargin2 = 0; tagPtr->lMarginColor = NULL; @@ -1060,11 +1038,11 @@ tagPtr->spacing2 = 0; tagPtr->spacing3String = NULL; tagPtr->spacing3 = 0; tagPtr->tabStringPtr = NULL; tagPtr->tabArrayPtr = NULL; - tagPtr->tabStyle = TK_TEXT_TABSTYLE_NONE; + tagPtr->tabStyle = TK_TEXT_TABSTYLE_NULL; tagPtr->underlineString = NULL; tagPtr->underline = 0; tagPtr->underlineColor = NULL; tagPtr->elideString = NULL; tagPtr->elide = 0; Index: tests/bind.test ================================================================== --- tests/bind.test +++ tests/bind.test @@ -11,11 +11,10 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands tk useinputmethods 0 -testConstraint needsTcl87 [package vsatisfies [package provide Tcl] 8.7-] testConstraint failsOnWindows [expr {![info exists ::env(CI)] || [tk windowingsystem] ne "win32"}] toplevel .t -width 100 -height 50 wm geom .t +0+0 Index: tests/button.test ================================================================== --- tests/button.test +++ tests/button.test @@ -1742,19 +1742,19 @@ .b configure -overrelief "" .b cget -overrelief } -cleanup { destroy .b } -result {} -test button-1.178 {configuration option: "overrelief" for button} -setup { +test button-1.178 {configuration option: "overrelief" for button} -constraints needsTcl87 -setup { button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .b update } -body { .b configure -overrelief 1.5 } -cleanup { destroy .b -} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, sunken, or ""} test button-1.179 {configuration option: "overrelief" for checkbutton} -setup { checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .c update } -body { @@ -1761,19 +1761,19 @@ .c configure -overrelief "" .c cget -overrelief } -cleanup { destroy .c } -result {} -test button-1.180 {configuration option: "overrelief" for checkbutton} -setup { +test button-1.180 {configuration option: "overrelief" for checkbutton} -constraints needsTcl87 -setup { checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .c update } -body { .c configure -overrelief 1.5 } -cleanup { destroy .c -} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, sunken, or ""} test button-1.181 {configuration option: "overrelief" for radiobutton} -setup { radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .r update } -body { @@ -1780,19 +1780,19 @@ .r configure -overrelief "" .r cget -overrelief } -cleanup { destroy .r } -result {} -test button-1.182 {configuration option: "overrelief" for radiobutton} -setup { +test button-1.182 {configuration option: "overrelief" for radiobutton} -constraints needsTcl87 -setup { radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .r update } -body { .r configure -overrelief 1.5 } -cleanup { destroy .r -} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +} -returnCodes {error} -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, sunken, or ""} test button-1.183 {configuration option: "padx" for label} -setup { label .l -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .l update Index: tests/config.test ================================================================== --- tests/config.test +++ tests/config.test @@ -208,17 +208,17 @@ test config-3.8 {Tk_InitOptions - bad initial value} -constraints { testobjconfig } -body { testobjconfig configerror -} -returnCodes error -result {expected integer but got "bogus"} +} -returnCodes error -result {expected integer or "" but got "bogus"} test config-3.9 {Tk_InitOptions - bad initial value} -constraints { testobjconfig } -body { catch {testobjconfig configerror} return $errorInfo -} -result {expected integer but got "bogus" +} -result {expected integer or "" but got "bogus" (default value for "-int") invoked from within "testobjconfig configerror"} test config-4.1 {DoObjConfig - boolean} -constraints testobjconfig -setup { @@ -272,14 +272,14 @@ test config-4.7 {DoObjConfig - invalid boolean} -constraints { testobjconfig } -setup { catch {rename .foo {}} } -body { - testobjconfig alltypes .foo -boolean {} + testobjconfig alltypes .foo -boolean foo } -cleanup { killTables -} -returnCodes error -result {expected boolean value but got ""} +} -returnCodes error -result {expected boolean value or "" but got "foo"} test config-4.8 {DoObjConfig - boolean internal value} -constraints { testobjconfig } -setup { catch {rename .foo {}} } -body { @@ -456,23 +456,24 @@ rename .foo {} } -cleanup { killTables } -returnCodes ok test config-4.29 {DoObjConfig - invalid string table} -constraints { - testobjconfig + testobjconfig needsTcl87 } -body { testobjconfig alltypes .foo -stringtable foo } -cleanup { killTables -} -returnCodes error -result {bad stringtable "foo": must be one, two, three, or four} +} -returnCodes error -result {bad stringtable "foo": must be one, two, three, four, or ""} test config-4.29a {DoObjConfig - invalid string table} -constraints { - testobjconfig + testobjconfig needsTcl87 } -body { testobjconfig alltypes .foo -stringtable2 foo } -cleanup { killTables -} -returnCodes error -result {bad stringtable2 "foo": must be one or two} +} -returnCodes error -result {bad stringtable2 "foo": must be one, two, or ""} + test config-4.30 {DoObjConfig - new string table} -constraints { testobjconfig } -body { testobjconfig alltypes .foo -stringtable two .foo configure -stringtable three @@ -778,16 +779,16 @@ .foo cget -relief } -cleanup { killTables } -returnCodes ok -result flat test config-4.71 {DoObjConfig - invalid relief} -constraints { - testobjconfig + testobjconfig needsTcl87 } -body { testobjconfig alltypes .foo -relief foo } -cleanup { killTables -} -returnCodes error -result {bad relief "foo": must be flat, groove, raised, ridge, solid, or sunken} +} -returnCodes error -result {bad relief "foo": must be flat, groove, raised, ridge, solid, sunken, or ""} test config-4.72 {DoObjConfig - relief internal value} -constraints testobjconfig -setup { catch {rename .foo {}} } -body { testobjconfig internal .foo -relief ridge .foo cget -relief @@ -872,15 +873,15 @@ testobjconfig alltypes .foo -justify center .foo cget -justify } -cleanup { killTables } -returnCodes ok -result center -test config-4.85 {DoObjConfig - invalid justify} -constraints testobjconfig -body { +test config-4.85 {DoObjConfig - invalid justify} -constraints {testobjconfig needsTcl87} -body { testobjconfig alltypes .foo -justify foo } -cleanup { killTables -} -returnCodes error -result {bad justification "foo": must be left, right, or center} +} -returnCodes error -result {bad justification "foo": must be left, right, center, or ""} test config-4.86 {DoObjConfig - new justify} -constraints testobjconfig -body { testobjconfig alltypes .foo -justify left .foo configure -justify right } -cleanup { killTables @@ -914,13 +915,13 @@ } -cleanup { killTables } -returnCodes ok -result center test config-4.91 {DoObjConfig - invalid anchor} -constraints testobjconfig -body { testobjconfig alltypes .foo -anchor foo -} -cleanup { +} -constraints needsTcl87 -cleanup { killTables -} -returnCodes error -result {bad anchor "foo": must be n, ne, e, se, s, sw, w, nw, or center} +} -returnCodes error -result {bad anchor "foo": must be n, ne, e, se, s, sw, w, nw, center, or ""} test config-4.92 {DoObjConfig - new anchor} -constraints testobjconfig -body { testobjconfig alltypes .foo -anchor e .foo configure -anchor n } -cleanup { killTables @@ -1585,11 +1586,11 @@ } -body { testobjconfig alltypes .foo -font {Helvetica 18} -integer 13563 .foo configure } -cleanup { destroy .foo -} -result {{-boolean boolean Boolean 1 1} {-integer integer Integer 7 13563} {-double double Double 3.14159 3.14159} {-string string String foo foo} {-stringtable StringTable stringTable one one} {-stringtable2 StringTable2 stringTable2 two two} {-color color Color red red} {-font font Font {Helvetica 12} {Helvetica 18}} {-bitmap bitmap Bitmap gray50 gray50} {-border border Border blue blue} {-relief relief Relief {} {}} {-cursor cursor Cursor xterm xterm} {-justify {} {} left left} {-anchor anchor Anchor center center} {-pixel pixel Pixel 1 1} {-custom {} {} {} {}} {-synonym -color}} +} -result {{-boolean boolean Boolean {} {}} {-integer integer Integer 7 13563} {-double double Double 3.14159 3.14159} {-string string String foo foo} {-stringtable StringTable stringTable one one} {-stringtable2 StringTable2 stringTable2 two two} {-color color Color red red} {-font font Font {Helvetica 12} {Helvetica 18}} {-bitmap bitmap Bitmap gray50 gray50} {-border border Border blue blue} {-relief relief Relief {} {}} {-cursor cursor Cursor xterm xterm} {-justify {} {} left left} {-anchor anchor Anchor center center} {-pixel pixel Pixel 1 1} {-custom {} {} {} {}} {-synonym -color}} test config-10.4 {Tk_GetOptionInfo - chaining through tables} -constraints testobjconfig -body { testobjconfig chain2 .foo -one asdf -three xyzzy .foo configure } -cleanup { destroy .foo Index: tests/constraints.tcl ================================================================== --- tests/constraints.tcl +++ tests/constraints.tcl @@ -255,10 +255,11 @@ testConstraint altDisplay [info exists env(TK_ALT_DISPLAY)] testConstraint noExceed [expr { ![testConstraint unix] || [catch {font actual "\{xyz"}] }] testConstraint deprecated [expr {![package vsatisfies [package provide Tcl] 8.7-] || ![::tk::build-info no-deprecate]}] +testConstraint needsTcl87 [package vsatisfies [package provide Tcl] 8.7-] # constraints for testing facilities defined in the tktest executable... testConstraint testImageType [expr {"test" in [image types]}] testConstraint testOldImageType [expr {"oldtest" in [image types]}] testConstraint testbitmap [llength [info commands testbitmap]] Index: tests/panedwindow.test ================================================================== --- tests/panedwindow.test +++ tests/panedwindow.test @@ -120,13 +120,13 @@ .p configure -proxyrelief groove list [lindex [.p configure -proxyrelief] 4] [.p cget -proxyrelief] } -cleanup { .p configure -proxyrelief [lindex [.p configure -proxyrelief] 3] } -result {groove groove} -test panedwindow-1.24 {configuration options: -proxyrelief (bad)} -body { +test panedwindow-1.24 {configuration options: -proxyrelief (bad)} -constraints needsTcl87 -body { .p configure -proxyrelief 1.5 -} -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, or sunken} +} -returnCodes error -result {bad relief "1.5": must be flat, groove, raised, ridge, solid, sunken, or ""} test panedwindow-1.25 {configuration options: -relief (good)} -body { .p configure -relief groove list [lindex [.p configure -relief] 4] [.p cget -relief] } -cleanup { .p configure -relief [lindex [.p configure -relief] 3]