diff options
| -rw-r--r-- | doc/GetAnchor.3 | 2 | ||||
| -rw-r--r-- | generic/tk.h | 1 | ||||
| -rw-r--r-- | generic/tkConfig.c | 34 | ||||
| -rw-r--r-- | generic/tkEntry.c | 4 | ||||
| -rw-r--r-- | generic/tkGet.c | 5 | ||||
| -rw-r--r-- | generic/tkImgPhoto.c | 8 | ||||
| -rw-r--r-- | generic/tkInt.h | 1 | ||||
| -rw-r--r-- | generic/tkTest.c | 6 | ||||
| -rw-r--r-- | generic/ttk/ttkEntry.c | 12 | ||||
| -rw-r--r-- | tests/button.test | 22 | ||||
| -rw-r--r-- | tests/config.test | 190 | ||||
| -rw-r--r-- | tests/menu.test | 8 | ||||
| -rw-r--r-- | tests/menubut.test | 2 | ||||
| -rw-r--r-- | tests/panedwindow.test | 6 | ||||
| -rw-r--r-- | tests/ttk/combobox.test | 7 | ||||
| -rw-r--r-- | unix/tkUnixSysTray.c | 22 | ||||
| -rw-r--r-- | win/tkWinSysTray.c | 2 |
17 files changed, 181 insertions, 151 deletions
diff --git a/doc/GetAnchor.3 b/doc/GetAnchor.3 index 5d41ad6..1d01989 100644 --- a/doc/GetAnchor.3 +++ b/doc/GetAnchor.3 @@ -58,7 +58,7 @@ Anchor position, e.g. \fBTCL_ANCHOR_CENTER\fR. corresponding to \fIobjPtr\fR's value. The result will be one of \fBTK_ANCHOR_N\fR, \fBTK_ANCHOR_NE\fR, \fBTK_ANCHOR_E\fR, \fBTK_ANCHOR_SE\fR, \fBTK_ANCHOR_S\fR, \fBTK_ANCHOR_SW\fR, \fBTK_ANCHOR_W\fR, \fBTK_ANCHOR_NW\fR, -or \fBTK_ANCHOR_CENTER\fR. +\fBTK_ANCHOR_CENTER\fR, or \fBTK_ANCHOR_NULL\fR. Anchor positions are typically used for indicating a point on an object that will be used to position the object, e.g. \fBTK_ANCHOR_N\fR means position the top center point of the object at a particular place. diff --git a/generic/tk.h b/generic/tk.h index ae870c7..43af6b7 100644 --- a/generic/tk.h +++ b/generic/tk.h @@ -547,6 +547,7 @@ typedef enum { */ 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 diff --git a/generic/tkConfig.c b/generic/tkConfig.c index 4356eea..891ba4e 100644 --- a/generic/tkConfig.c +++ b/generic/tkConfig.c @@ -614,7 +614,10 @@ DoObjConfig( 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(interp, valuePtr, &newBool) != TCL_OK) { return TCL_ERROR; } if (internalPtr != NULL) { @@ -641,7 +644,7 @@ DoObjConfig( if (TkGetIntForIndex(valuePtr, TCL_INDEX_END, 0, &newIndex) != TCL_OK) { if (interp) { Tcl_AppendResult(interp, "bad index \"", Tcl_GetString(valuePtr), - "\": must be integer?[+-]integer? or end?[+-]integer?", NULL); + "\": must be integer?[+-]integer?, end?[+-]integer?, or \"\"", NULL); } return TCL_ERROR; } @@ -810,10 +813,9 @@ DoObjConfig( if (nullOK && ObjectIsEmpty(valuePtr)) { valuePtr = NULL; newRelief = TK_RELIEF_NULL; - } else { - if (Tk_GetReliefFromObj(interp, valuePtr, &newRelief) != TCL_OK) { - return TCL_ERROR; - } + } else if (Tcl_GetIndexFromObj(interp, valuePtr, tkReliefStrings, + "relief", (nullOK ? TCL_INDEX_NULL_OK : 0), &newRelief) != TCL_OK) { + return TCL_ERROR; } if (internalPtr != NULL) { *((int *) oldInternalPtr) = *((int *) internalPtr); @@ -842,9 +844,17 @@ DoObjConfig( } case TK_OPTION_JUSTIFY: { Tk_Justify newJustify; + int index; - if (Tk_GetJustifyFromObj(interp, valuePtr, &newJustify) != TCL_OK) { + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + newJustify = TK_JUSTIFY_NULL; + } else { + if (Tcl_GetIndexFromObj(interp, valuePtr, tkJustifyStrings, + "justification", (nullOK ? TCL_INDEX_NULL_OK : 0), &index) != TCL_OK) { return TCL_ERROR; + } + newJustify = (Tk_Justify) index; } if (internalPtr != NULL) { *((Tk_Justify *) oldInternalPtr) = *((Tk_Justify *) internalPtr); @@ -854,9 +864,17 @@ DoObjConfig( } case TK_OPTION_ANCHOR: { Tk_Anchor newAnchor; + int index; - if (Tk_GetAnchorFromObj(interp, valuePtr, &newAnchor) != TCL_OK) { + if (nullOK && ObjectIsEmpty(valuePtr)) { + valuePtr = NULL; + newAnchor = TK_ANCHOR_NULL; + } else { + if (Tcl_GetIndexFromObj(interp, valuePtr, tkAnchorStrings, + "anchor", (nullOK ? TCL_INDEX_NULL_OK : 0), &index) != TCL_OK) { return TCL_ERROR; + } + newAnchor = (Tk_Anchor) index; } if (internalPtr != NULL) { *((Tk_Anchor *) oldInternalPtr) = *((Tk_Anchor *) internalPtr); diff --git a/generic/tkEntry.c b/generic/tkEntry.c index 0e7f87c..20173c6 100644 --- a/generic/tkEntry.c +++ b/generic/tkEntry.c @@ -711,7 +711,7 @@ EntryWidgetObjCmd( Tcl_WrongNumArgs(interp, 2, objv, NULL); goto error; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->string, TCL_INDEX_NONE)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(entryPtr->string, -1)); break; case COMMAND_ICURSOR: @@ -1263,7 +1263,7 @@ ConfigureEntry( Tcl_Obj *newObjPtr; int nelems; - newObjPtr = Tcl_NewStringObj(sbPtr->valueStr, TCL_INDEX_NONE); + newObjPtr = Tcl_NewStringObj(sbPtr->valueStr, -1); if (Tcl_ListObjLength(interp, newObjPtr, &nelems) != TCL_OK) { valuesChanged = -1; diff --git a/generic/tkGet.c b/generic/tkGet.c index 8d77786..68d8c75 100644 --- a/generic/tkGet.c +++ b/generic/tkGet.c @@ -35,7 +35,7 @@ static void FreeUidThreadExitProc(ClientData clientData); * used by Tk_GetAnchorFromObj and Tk_GetJustifyFromObj. */ -static const char *const anchorStrings[] = { +const char *const tkAnchorStrings[] = { "n", "ne", "e", "se", "s", "sw", "w", "nw", "center", NULL }; const char *const tkJustifyStrings[] = { @@ -71,7 +71,7 @@ Tk_GetAnchorFromObj( { int index, code; - code = Tcl_GetIndexFromObj(interp, objPtr, anchorStrings, "anchor", 0, + code = Tcl_GetIndexFromObj(interp, objPtr, tkAnchorStrings, "anchor", 0, &index); if (code == TCL_OK) { *anchorPtr = (Tk_Anchor) index; @@ -190,6 +190,7 @@ Tk_NameOfAnchor( 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"; } diff --git a/generic/tkImgPhoto.c b/generic/tkImgPhoto.c index 647eb17..0330ade 100644 --- a/generic/tkImgPhoto.c +++ b/generic/tkImgPhoto.c @@ -3263,8 +3263,8 @@ Tk_PhotoPutBlock( */ sourceBlock = *blockPtr; memToFree = NULL; - if (sourceBlock.pixelPtr >= modelPtr->pix32 - && sourceBlock.pixelPtr <= modelPtr->pix32 + modelPtr->width + if (modelPtr->pix32 && (sourceBlock.pixelPtr >= modelPtr->pix32) + && (sourceBlock.pixelPtr < modelPtr->pix32 + modelPtr->width) * modelPtr->height * 4) { /* * Fix 5c51be6411: avoid reading @@ -3709,8 +3709,8 @@ Tk_PhotoPutZoomedBlock( */ sourceBlock = *blockPtr; memToFree = NULL; - if (sourceBlock.pixelPtr >= modelPtr->pix32 - && sourceBlock.pixelPtr <= modelPtr->pix32 + modelPtr->width + if (modelPtr->pix32 && (sourceBlock.pixelPtr >= modelPtr->pix32) + && (sourceBlock.pixelPtr < modelPtr->pix32 + modelPtr->width) * modelPtr->height * 4) { /* * Fix 5c51be6411: avoid reading diff --git a/generic/tkInt.h b/generic/tkInt.h index 45348bd..5608ad7 100644 --- a/generic/tkInt.h +++ b/generic/tkInt.h @@ -916,6 +916,7 @@ typedef struct TkWindow { * String tables: */ +MODULE_SCOPE const char *const tkAnchorStrings[]; MODULE_SCOPE const char *const tkReliefStrings[]; MODULE_SCOPE const char *const tkJustifyStrings[]; diff --git a/generic/tkTest.c b/generic/tkTest.c index 4642d55..75a0be0 100644 --- a/generic/tkTest.c +++ b/generic/tkTest.c @@ -595,8 +595,8 @@ TestobjconfigObjCmd( "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", @@ -873,7 +873,7 @@ TestobjconfigObjCmd( }; 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", diff --git a/generic/ttk/ttkEntry.c b/generic/ttk/ttkEntry.c index 36e613e..b0502a4 100644 --- a/generic/ttk/ttkEntry.c +++ b/generic/ttk/ttkEntry.c @@ -1396,10 +1396,10 @@ EntryIndex( if (idx == TCL_INDEX_NONE) { idx = 0; } else if (idx > entryPtr->entry.numChars) { - idx = entryPtr->entry.numChars; - } - *indexPtr = idx; - return TCL_OK; + idx = entryPtr->entry.numChars; + } + *indexPtr = idx; + return TCL_OK; } string = Tcl_GetStringFromObj(indexObj, &length); @@ -1876,7 +1876,7 @@ static int ComboboxCurrentCommand( TkSizeT idx; if (TCL_OK == TkGetIntForIndex(objv[2], nValues - 1, 0, &idx)) { - if (idx == TCL_INDEX_NONE || idx > (TkSizeT)nValues) { + if (idx == TCL_INDEX_NONE || idx >= (TkSizeT)nValues) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "index \"%s\" out of range", Tcl_GetString(objv[2]))); Tcl_SetErrorCode(interp, "TTK", "COMBOBOX", "IDX_RANGE", NULL); @@ -1885,7 +1885,7 @@ static int ComboboxCurrentCommand( currentIndex = idx; } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "Incorrect index %s", Tcl_GetString(objv[2]))); + "bad index \"%s\"", Tcl_GetString(objv[2]))); Tcl_SetErrorCode(interp, "TTK", "COMBOBOX", "IDX_VALUE", NULL); return TCL_ERROR; } diff --git a/tests/button.test b/tests/button.test index 1a53a74..15fe487 100644 --- a/tests/button.test +++ b/tests/button.test @@ -13,6 +13,8 @@ eval tcltest::configure $argv tcltest::loadTestedCommands imageInit +testConstraint needsTcl87 [package vsatisfies [package provide Tcl] 8.7-] + proc bogusTrace args { error "trace aborted" } @@ -1744,7 +1746,7 @@ test button-1.177 {configuration option: "overrelief" for button} -setup { } -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 @@ -1752,7 +1754,7 @@ test button-1.178 {configuration option: "overrelief" for button} -setup { .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 @@ -1763,7 +1765,7 @@ test button-1.179 {configuration option: "overrelief" for checkbutton} -setup { } -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 @@ -1771,7 +1773,7 @@ test button-1.180 {configuration option: "overrelief" for checkbutton} -setup { .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 @@ -1782,7 +1784,7 @@ test button-1.181 {configuration option: "overrelief" for radiobutton} -setup { } -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 @@ -1790,7 +1792,7 @@ test button-1.182 {configuration option: "overrelief" for radiobutton} -setup { .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} @@ -2414,7 +2416,7 @@ test button-1.244 {configuration option: "underline" for label} -setup { .l configure -underline 3p } -cleanup { destroy .l -} -returnCodes {error} -result {bad index "3p": must be integer?[+-]integer? or end?[+-]integer?} +} -returnCodes {error} -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer?, or ""} test button-1.245 {configuration option: "underline" for button} -setup { button .b -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .b @@ -2433,7 +2435,7 @@ test button-1.246 {configuration option: "underline" for button} -setup { .b configure -underline 3p } -cleanup { destroy .b -} -returnCodes {error} -result {bad index "3p": must be integer?[+-]integer? or end?[+-]integer?} +} -returnCodes {error} -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer?, or ""} test button-1.247 {configuration option: "underline" for checkbutton} -setup { checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .c @@ -2452,7 +2454,7 @@ test button-1.248 {configuration option: "underline" for checkbutton} -setup { .c configure -underline 3p } -cleanup { destroy .c -} -returnCodes {error} -result {bad index "3p": must be integer?[+-]integer? or end?[+-]integer?} +} -returnCodes {error} -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer?, or ""} test button-1.249 {configuration option: "underline" for radiobutton} -setup { radiobutton .r -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} pack .r @@ -2471,7 +2473,7 @@ test button-1.250 {configuration option: "underline" for radiobutton} -setup { .r configure -underline 3p } -cleanup { destroy .r -} -returnCodes {error} -result {bad index "3p": must be integer?[+-]integer? or end?[+-]integer?} +} -returnCodes {error} -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer?, or ""} test button-1.251 {configuration option: "tristatevalue" for checkbutton} -setup { checkbutton .c -borderwidth 2 -highlightthickness 2 -font {Helvetica -12 bold} diff --git a/tests/config.test b/tests/config.test index 1c6f488..1cfc7a9 100644 --- a/tests/config.test +++ b/tests/config.test @@ -53,7 +53,7 @@ test config-1.2 {Tk_CreateOptionTable - synonym initialization} -constraints { .a cget -color } -cleanup { killTables -} -result {green} +} -result green test config-1.3 {Tk_CreateOptionTable - option database initialization} -constraints { testobjconfig } -body { @@ -83,7 +83,7 @@ test config-1.5 {Tk_CreateOptionTable - default initialization} -constraints { .a cget -relief } -cleanup { killTables -} -result {raised} +} -result raised test config-1.6 {Tk_CreateOptionTable - chained tables} -constraints { testobjconfig } -body { @@ -159,7 +159,7 @@ test config-3.2 {Tk_InitOptions - initialize from database} -constraints { } -cleanup { killTables option clear -} -result {blue} +} -result blue test config-3.3 {Tk_InitOptions - initialize from database} -constraints { testobjconfig } -body { @@ -169,7 +169,7 @@ test config-3.3 {Tk_InitOptions - initialize from database} -constraints { } -cleanup { killTables option clear -} -result {left} +} -result left test config-3.4 {Tk_InitOptions - initialize from widget class} -constraints { testobjconfig } -body { @@ -177,7 +177,7 @@ test config-3.4 {Tk_InitOptions - initialize from widget class} -constraints { list [.a cget -color] } -cleanup { killTables -} -result {red} +} -result red test config-3.5 {Tk_InitOptions - no initial value} -constraints { testobjconfig } -body { @@ -230,7 +230,7 @@ test config-4.1 {DoObjConfig - boolean} -constraints testobjconfig -setup { testobjconfig alltypes .foo -boolean 0 } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.2 {DoObjConfig - boolean} -constraints testobjconfig -setup { catch {rename .foo {}} } -body { @@ -254,7 +254,7 @@ test config-4.4 {DoObjConfig - boolean} -constraints testobjconfig -setup { testobjconfig alltypes .foo -boolean 1 } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.5 {DoObjConfig - boolean} -constraints testobjconfig -setup { catch {rename .foo {}} } -body { @@ -277,10 +277,10 @@ test config-4.7 {DoObjConfig - invalid boolean} -constraints { } -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 but got "foo"} test config-4.8 {DoObjConfig - boolean internal value} -constraints { testobjconfig } -setup { @@ -298,7 +298,7 @@ test config-4.9 {DoObjConfig - integer} -constraints testobjconfig -setup { testobjconfig alltypes .foo -integer 3 } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.10 {DoObjConfig - integer} -constraints testobjconfig -setup { catch {rename .foo {}} } -body { @@ -344,7 +344,7 @@ test config-4.14 {DoObjConfig - double} -constraints testobjconfig -setup { testobjconfig alltypes .foo -double 3.14 } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.15 {DoObjConfig - double} -constraints testobjconfig -setup { catch {rename .foo {}} } -body { @@ -352,7 +352,7 @@ test config-4.15 {DoObjConfig - double} -constraints testobjconfig -setup { .foo cget -double } -cleanup { killTables -} -returnCodes ok -result {3.14} +} -returnCodes ok -result 3.14 test config-4.16 {DoObjConfig - double} -constraints testobjconfig -setup { catch {rename .foo {}} } -body { @@ -380,7 +380,7 @@ test config-4.18 {DoObjConfig - double internal value} -constraints { .foo cget -double } -cleanup { killTables -} -result {62.75} +} -result 62.75 test config-4.19 {DoObjConfig - string} -constraints testobjconfig -setup { catch {rename .foo {}} @@ -388,7 +388,7 @@ test config-4.19 {DoObjConfig - string} -constraints testobjconfig -setup { testobjconfig alltypes .foo -string test } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.20 {DoObjConfig - string} -constraints testobjconfig -setup { catch {rename .foo {}} } -body { @@ -396,7 +396,7 @@ test config-4.20 {DoObjConfig - string} -constraints testobjconfig -setup { .foo cget -string } -cleanup { killTables -} -returnCodes ok -result {test} +} -returnCodes ok -result test test config-4.21 {DoObjConfig - string} -constraints testobjconfig -setup { catch {rename .foo {}} } -body { @@ -412,7 +412,7 @@ test config-4.22 {DoObjConfig - null string} -constraints testobjconfig -setup { testobjconfig alltypes .foo -string {} } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.23 {DoObjConfig - null string} -constraints testobjconfig -setup { catch {rename .foo {}} } -body { @@ -446,13 +446,13 @@ test config-4.26 {DoObjConfig - string table} -constraints testobjconfig -body { testobjconfig alltypes .foo -stringtable two } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.27 {DoObjConfig - string table} -constraints testobjconfig -body { testobjconfig alltypes .foo -stringtable two .foo cget -stringtable } -cleanup { killTables -} -returnCodes ok -result {two} +} -returnCodes ok -result two test config-4.28 {DoObjConfig - string table} -constraints testobjconfig -body { testobjconfig alltypes .foo -stringtable two .foo cget -stringtable @@ -491,7 +491,7 @@ test config-4.31 {DoObjConfig - new string table} -constraints { .foo cget -stringtable } -cleanup { killTables -} -returnCodes ok -result {three} +} -returnCodes ok -result three test config-4.32 {DoObjConfig - new string table} -constraints { testobjconfig } -body { @@ -511,19 +511,19 @@ test config-4.33 {DoObjConfig - stringtable internal value} -constraints { .foo cget -stringtable } -cleanup { killTables -} -result {four} +} -result four test config-4.34 {DoObjConfig - color} -constraints testobjconfig -body { testobjconfig alltypes .foo -color blue } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.35 {DoObjConfig - color} -constraints testobjconfig -body { testobjconfig alltypes .foo -color blue .foo cget -color } -cleanup { killTables -} -returnCodes ok -result {blue} +} -returnCodes ok -result blue test config-4.36 {DoObjConfig - color} -constraints testobjconfig -body { testobjconfig alltypes .foo -color blue .foo cget -color @@ -547,13 +547,13 @@ test config-4.38 {DoObjConfig - color internal value} -constraints { .foo cget -color } -cleanup { killTables -} -result {purple} +} -result purple test config-4.39 {DoObjConfig - null color} -constraints testobjconfig -body { testobjconfig alltypes .foo -color {} } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.40 {DoObjConfig - null color} -constraints testobjconfig -body { testobjconfig alltypes .foo -color {} .foo cget -color @@ -601,7 +601,7 @@ test config-4.45 {DoObjConfig - font} -constraints testobjconfig -setup { testobjconfig alltypes .foo -font {Helvetica 72} } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.46 {DoObjConfig - font} -constraints testobjconfig -setup { catch {rename .foo {}} } -body { @@ -642,7 +642,7 @@ test config-4.50 {DoObjConfig - null font} -constraints testobjconfig -setup { testobjconfig alltypes .foo -font {} } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.51 {DoObjConfig - null font} -constraints testobjconfig -setup { catch {rename .foo {}} } -body { @@ -666,13 +666,13 @@ test config-4.53 {DoObjConfig - bitmap} -constraints testobjconfig -body { testobjconfig alltypes .foo -bitmap gray75 } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.54 {DoObjConfig - bitmap} -constraints testobjconfig -body { testobjconfig alltypes .foo -bitmap gray75 .foo cget -bitmap } -cleanup { killTables -} -returnCodes ok -result {gray75} +} -returnCodes ok -result gray75 test config-4.55 {DoObjConfig - new bitmap} -constraints testobjconfig -body { testobjconfig alltypes .foo -bitmap gray75 .foo configure -bitmap gray50 @@ -685,7 +685,7 @@ test config-4.56 {DoObjConfig - new bitmap} -constraints testobjconfig -body { .foo cget -bitmap } -cleanup { killTables -} -returnCodes ok -result {gray50} +} -returnCodes ok -result gray50 test config-4.57 {DoObjConfig - invalid bitmap} -constraints { testobjconfig } -body { @@ -697,7 +697,7 @@ test config-4.58 {DoObjConfig - null bitmap} -constraints testobjconfig -body { testobjconfig alltypes .foo -bitmap {} } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.59 {DoObjConfig - null bitmap} -constraints testobjconfig -body { testobjconfig alltypes .foo -bitmap {} .foo cget -bitmap @@ -713,19 +713,19 @@ test config-4.60 {DoObjConfig - bitmap internal value} -constraints { .foo cget -bitmap } -cleanup { killTables -} -result {gray25} +} -result gray25 test config-4.61 {DoObjConfig - border} -constraints testobjconfig -body { testobjconfig alltypes .foo -border green } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.62 {DoObjConfig - border} -constraints testobjconfig -body { testobjconfig alltypes .foo -border green .foo cget -border } -cleanup { killTables -} -returnCodes ok -result {green} +} -returnCodes ok -result green test config-4.63 {DoObjConfig - invalid border} -constraints { testobjconfig } -body { @@ -737,7 +737,7 @@ test config-4.64 {DoObjConfig - null border} -constraints testobjconfig -body { testobjconfig alltypes .foo -border {} } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.65 {DoObjConfig - null border} -constraints testobjconfig -body { testobjconfig alltypes .foo -border {} .foo cget -border @@ -776,20 +776,20 @@ test config-4.69 {DoObjConfig - relief} -constraints testobjconfig -body { testobjconfig alltypes .foo -relief flat } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.70 {DoObjConfig - relief} -constraints testobjconfig -body { testobjconfig alltypes .foo -relief flat .foo cget -relief } -cleanup { killTables -} -returnCodes ok -result {flat} +} -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 { @@ -797,7 +797,7 @@ test config-4.72 {DoObjConfig - relief internal value} -constraints testobjconfi .foo cget -relief } -cleanup { killTables -} -result {ridge} +} -result ridge test config-4.73 {DoObjConfig - new relief} -constraints testobjconfig -body { testobjconfig alltypes .foo -relief raised .foo configure -relief flat @@ -810,19 +810,19 @@ test config-4.74 {DoObjConfig - new relief} -constraints testobjconfig -body { .foo cget -relief } -cleanup { killTables -} -returnCodes ok -result {flat} +} -returnCodes ok -result flat test config-4.75 {DoObjConfig - cursor} -constraints testobjconfig -body { testobjconfig alltypes .foo -cursor arrow } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.76 {DoObjConfig - cursor} -constraints testobjconfig -body { testobjconfig alltypes .foo -cursor arrow .foo cget -cursor } -cleanup { killTables -} -returnCodes ok -result {arrow} +} -returnCodes ok -result arrow test config-4.77 {DoObjConfig - invalid cursor} -constraints testobjconfig -body { testobjconfig alltypes .foo -cursor foo } -cleanup { @@ -834,7 +834,7 @@ test config-4.78 {DoObjConfig - null cursor} -constraints testobjconfig -setup { testobjconfig alltypes .foo -cursor {} } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.79 {DoObjConfig - null cursor} -constraints testobjconfig -setup { catch {rename .foo {}} } -body { @@ -855,7 +855,7 @@ test config-4.81 {DoObjConfig - new cursor} -constraints testobjconfig -body { .foo cget -cursor } -cleanup { killTables -} -returnCodes ok -result {arrow} +} -returnCodes ok -result arrow test config-4.82 {DoObjConfig - cursor internal value} -constraints { testobjconfig } -setup { @@ -865,24 +865,24 @@ test config-4.82 {DoObjConfig - cursor internal value} -constraints { .foo cget -cursor } -cleanup { killTables -} -result {watch} +} -result watch test config-4.83 {DoObjConfig - justify} -constraints testobjconfig -body { testobjconfig alltypes .foo -justify center } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.84 {DoObjConfig - justify} -constraints testobjconfig -body { testobjconfig alltypes .foo -justify center .foo cget -justify } -cleanup { killTables -} -returnCodes ok -result {center} -test config-4.85 {DoObjConfig - invalid justify} -constraints testobjconfig -body { +} -returnCodes ok -result center +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 @@ -895,7 +895,7 @@ test config-4.87 {DoObjConfig - new justify} -constraints testobjconfig -body { .foo cget -justify } -cleanup { killTables -} -returnCodes ok -result {right} +} -returnCodes ok -result right test config-4.88 {DoObjConfig - justify internal value} -constraints { testobjconfig } -setup { @@ -905,24 +905,24 @@ test config-4.88 {DoObjConfig - justify internal value} -constraints { .foo cget -justify } -cleanup { killTables -} -result {center} +} -result center test config-4.89 {DoObjConfig - anchor} -constraints testobjconfig -body { testobjconfig alltypes .foo -anchor center } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.90 {DoObjConfig - anchor} -constraints testobjconfig -body { testobjconfig alltypes .foo -anchor center .foo cget -anchor } -cleanup { killTables -} -returnCodes ok -result {center} +} -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 @@ -935,7 +935,7 @@ test config-4.93 {DoObjConfig - new anchor} -constraints testobjconfig -body { .foo cget -anchor } -cleanup { killTables -} -returnCodes ok -result {n} +} -returnCodes ok -result n test config-4.94 {DoObjConfig - anchor internal value} -constraints { testobjconfig } -setup { @@ -945,12 +945,12 @@ test config-4.94 {DoObjConfig - anchor internal value} -constraints { .foo cget -anchor } -cleanup { killTables -} -result {sw} +} -result sw test config-4.95 {DoObjConfig - pixel} -constraints testobjconfig -body { testobjconfig alltypes .foo -pixel 42 } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.96 {DoObjConfig - pixel} -constraints testobjconfig -body { testobjconfig alltypes .foo -pixel 42 .foo cget -pixel @@ -974,7 +974,7 @@ test config-4.99 {DoObjConfig - new pixel} -constraints testobjconfig -body { .foo cget -pixel } -cleanup { killTables -} -returnCodes ok -result {3c} +} -returnCodes ok -result 3c test config-4.100 {DoObjConfig - pixel internal value} -constraints { testobjconfig } -setup { @@ -993,14 +993,14 @@ test config-4.101 {DoObjConfig - window} -constraints testobjconfig -body { testobjconfig twowindows .foo -window .bar } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.102 {DoObjConfig - window} -constraints testobjconfig -body { toplevel .bar testobjconfig twowindows .foo -window .bar .foo cget -window } -cleanup { killTables -} -returnCodes ok -result {.bar} +} -returnCodes ok -result .bar test config-4.103 {DoObjConfig - invalid window} -constraints testobjconfig -body { toplevel .bar testobjconfig twowindows .foo -window foo @@ -1012,7 +1012,7 @@ test config-4.104 {DoObjConfig - null window} -constraints testobjconfig -body { testobjconfig twowindows .foo -window {} } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.105 {DoObjConfig - null window} -constraints testobjconfig -body { toplevel .bar testobjconfig twowindows .foo -window {} @@ -1036,7 +1036,7 @@ test config-4.107 {DoObjConfig - new window} -constraints testobjconfig -body { .foo cget -window } -cleanup { killTables -} -returnCodes ok -result {.blamph} +} -returnCodes ok -result .blamph test config-4.108 {DoObjConfig - window internal value} -constraints { testobjconfig } -setup { @@ -1046,7 +1046,7 @@ test config-4.108 {DoObjConfig - window internal value} -constraints { .foo cget -window } -cleanup { killTables -} -result {.} +} -result . test config-4.109 {DoObjConfig - releasing old values} -constraints { testobjconfig @@ -1091,18 +1091,18 @@ test config-4.111 {DoObjConfig - custom} -constraints testobjconfig -body { testobjconfig alltypes .foo -custom test } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.112 {DoObjConfig - custom} -constraints testobjconfig -body { testobjconfig alltypes .foo -custom test .foo cget -custom } -cleanup { killTables -} -returnCodes ok -result {TEST} +} -returnCodes ok -result TEST test config-4.113 {DoObjConfig - null custom} -constraints testobjconfig -body { testobjconfig alltypes .foo -custom {} } -cleanup { killTables -} -returnCodes ok -result {.foo} +} -returnCodes ok -result .foo test config-4.114 {DoObjConfig - null custom} -constraints testobjconfig -body { testobjconfig alltypes .foo -custom {} .foo cget -custom @@ -1161,7 +1161,7 @@ test config-6.2 {GetOptionFromObj - exact match} -constraints { .a cget -one } -cleanup { killTables -} -result {one} +} -result one test config-6.3 {GetOptionFromObj - abbreviation} -constraints { testobjconfig } -body { @@ -1169,7 +1169,7 @@ test config-6.3 {GetOptionFromObj - abbreviation} -constraints { .a cget -fo } -cleanup { killTables -} -result {four} +} -result four test config-6.4 {GetOptionFromObj - ambiguous abbreviation} -constraints { testobjconfig } -body { @@ -1193,7 +1193,7 @@ test config-6.6 {GetOptionFromObj - synonym} -constraints testobjconfig -body { .b cget -synonym } -cleanup { killTables -} -result {red} +} -result red if {[testConstraint testobjconfig]} { @@ -1211,7 +1211,7 @@ test config-7.2 {Tk_SetOptions - bogus option name} -constraints { test config-7.3 {Tk_SetOptions - synonym} -constraints testobjconfig -body { .a configure -synonym blue .a cget -color -} -result {blue} +} -result blue test config-7.4 {Tk_SetOptions - missing value} -constraints { testobjconfig } -body { @@ -1222,7 +1222,7 @@ test config-7.5 {Tk_SetOptions - missing value} -constraints { } -body { catch {.a configure -color green -relief} .a cget -color -} -result {green} +} -result green test config-7.6 {Tk_SetOptions - saving old values} -constraints { testobjconfig } -body { @@ -1306,7 +1306,7 @@ test config-8.2 {Tk_RestoreSavedOptions - restore in proper order} -constraints .a cget -color } -cleanup { killTables -} -result {red} +} -result red test config-8.3 {Tk_RestoreSavedOptions - freeing object memory} -constraints { testobjconfig } -body { @@ -1357,7 +1357,7 @@ test config-8.8 {Tk_RestoreSavedOptions - double internal form} -constraints { .a cget -double } -cleanup { killTables -} -result {3.14159} +} -result 3.14159 test config-8.9 {Tk_RestoreSavedOptions - string internal form} -constraints { testobjconfig } -body { @@ -1366,7 +1366,7 @@ test config-8.9 {Tk_RestoreSavedOptions - string internal form} -constraints { .a cget -string } -cleanup { killTables -} -result {foo} +} -result foo test config-8.10 {Tk_RestoreSavedOptions - string table internal form} -constraints { testobjconfig } -body { @@ -1375,7 +1375,7 @@ test config-8.10 {Tk_RestoreSavedOptions - string table internal form} -constrai .a cget -stringtable } -cleanup { killTables -} -result {one} +} -result one test config-8.11 {Tk_RestoreSavedOptions - color internal form} -constraints { testobjconfig } -body { @@ -1384,7 +1384,7 @@ test config-8.11 {Tk_RestoreSavedOptions - color internal form} -constraints { .a cget -color } -cleanup { killTables -} -result {red} +} -result red test config-8.12 {Tk_RestoreSavedOptions - font internal form} -constraints { testobjconfig nonPortable } -body { @@ -1402,7 +1402,7 @@ test config-8.13 {Tk_RestoreSavedOptions - bitmap internal form} -constraints { .a cget -bitmap } -cleanup { killTables -} -result {gray50} +} -result gray50 test config-8.14 {Tk_RestoreSavedOptions - border internal form} -constraints { testobjconfig } -body { @@ -1411,7 +1411,7 @@ test config-8.14 {Tk_RestoreSavedOptions - border internal form} -constraints { .a cget -border } -cleanup { killTables -} -result {blue} +} -result blue test config-8.15 {Tk_RestoreSavedOptions - relief internal form} -constraints { testobjconfig } -body { @@ -1420,7 +1420,7 @@ test config-8.15 {Tk_RestoreSavedOptions - relief internal form} -constraints { .a cget -relief } -cleanup { killTables -} -result {raised} +} -result raised test config-8.16 {Tk_RestoreSavedOptions - cursor internal form} -constraints { testobjconfig } -body { @@ -1429,7 +1429,7 @@ test config-8.16 {Tk_RestoreSavedOptions - cursor internal form} -constraints { .a cget -cursor } -cleanup { killTables -} -result {xterm} +} -result xterm test config-8.17 {Tk_RestoreSavedOptions - justify internal form} -constraints { testobjconfig } -body { @@ -1438,7 +1438,7 @@ test config-8.17 {Tk_RestoreSavedOptions - justify internal form} -constraints { .a cget -justify } -cleanup { killTables -} -result {left} +} -result left test config-8.18 {Tk_RestoreSavedOptions - anchor internal form} -constraints { testobjconfig } -body { @@ -1447,7 +1447,7 @@ test config-8.18 {Tk_RestoreSavedOptions - anchor internal form} -constraints { .a cget -anchor } -cleanup { killTables -} -result {center} +} -result center test config-8.19 {Tk_RestoreSavedOptions - window internal form} -constraints { testobjconfig } -body { @@ -1456,7 +1456,7 @@ test config-8.19 {Tk_RestoreSavedOptions - window internal form} -constraints { .a cget -window } -cleanup { killTables -} -result {.a} +} -result .a test config-8.20 {Tk_RestoreSavedOptions - custom internal form} -constraints { testobjconfig } -body { @@ -1465,7 +1465,7 @@ test config-8.20 {Tk_RestoreSavedOptions - custom internal form} -constraints { .a cget -custom } -cleanup { killTables -} -result {FOOBAR} +} -result FOOBAR # Most of the tests below will cause memory leakage if there is a # problem. This may not be evident unless the tests are run in @@ -1591,7 +1591,7 @@ test config-10.3 {Tk_GetOptionInfo - all items} -constraints { .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 raised raised} {-cursor cursor Cursor xterm xterm} {-justify {} {} left left} {-anchor anchor Anchor {} {}} {-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 raised raised} {-cursor cursor Cursor xterm xterm} {-justify {} {} left left} {-anchor anchor Anchor {} {}} {-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 @@ -1648,11 +1648,11 @@ test config-12.5 {GetObjectForOption - stringTable} -constraints { } -body { .a configure -stringtable "two" .a cget -stringtable -} -result {two} +} -result two test config-12.6 {GetObjectForOption - color} -constraints testobjconfig -body { .a configure -color "green" .a cget -color -} -result {green} +} -result green test config-12.7 {GetObjectForOption - font} -constraints testobjconfig -body { .a configure -font {Times 36} .a cget -font @@ -1660,7 +1660,7 @@ test config-12.7 {GetObjectForOption - font} -constraints testobjconfig -body { test config-12.8 {GetObjectForOption - bitmap} -constraints testobjconfig -body { .a configure -bitmap "questhead" .a cget -bitmap -} -result {questhead} +} -result questhead test config-12.9 {GetObjectForOption - border} -constraints testobjconfig -body { .a configure -border #33217c .a cget -border @@ -1670,23 +1670,23 @@ test config-12.10 {GetObjectForOption - relief} -constraints { } -body { .a configure -relief groove .a cget -relief -} -result {groove} +} -result groove test config-12.11 {GetObjectForOption - cursor} -constraints { testobjconfig } -body { .a configure -cursor watch .a cget -cursor -} -result {watch} +} -result watch test config-12.12 {GetObjectForOption - justify} -constraints { testobjconfig } -body { .a configure -justify right .a cget -justify -} -result {right} +} -result right test config-12.13 {GetObjectForOption - anchor} -constraints testobjconfig -body { .a configure -anchor e .a cget -anchor -} -result {e} +} -result e test config-12.14 {GetObjectForOption - pixels} -constraints testobjconfig -body { .a configure -pixel 193.2 .a cget -pixel @@ -1694,11 +1694,11 @@ test config-12.14 {GetObjectForOption - pixels} -constraints testobjconfig -body test config-12.15 {GetObjectForOption - window} -constraints testobjconfig -body { .a configure -window .a .a cget -window -} -result {.a} +} -result .a test config-12.16 {GetObjectForOption -custom} -constraints testobjconfig -body { .a configure -custom foobar .a cget -custom -} -result {FOOBAR} +} -result FOOBAR test config-12.17 {GetObjectForOption - null values} -constraints { testobjconfig } -body { diff --git a/tests/menu.test b/tests/menu.test index b98b2ad..4993761 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -1199,11 +1199,11 @@ test menu-2.223 {entry configuration options 0 -underline 3p tearoff} -body { test menu-2.224 {entry configuration options 1 -underline 3p command} -body { .m1 entryconfigure 1 -underline 3p -} -returnCodes error -result {bad index "3p": must be integer?[+-]integer? or end?[+-]integer?} +} -returnCodes error -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer?, or ""} test menu-2.225 {entry configuration options 2 -underline 3p cascade} -body { .m1 entryconfigure 2 -underline 3p -} -returnCodes error -result {bad index "3p": must be integer?[+-]integer? or end?[+-]integer?} +} -returnCodes error -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer?, or ""} test menu-2.226 {entry configuration options 3 -underline 3p separator} -body { .m1 entryconfigure 3 -underline 3p @@ -1211,11 +1211,11 @@ test menu-2.226 {entry configuration options 3 -underline 3p separator} -body { test menu-2.227 {entry configuration options 4 -underline 3p checkbutton} -body { .m1 entryconfigure 4 -underline 3p -} -returnCodes error -result {bad index "3p": must be integer?[+-]integer? or end?[+-]integer?} +} -returnCodes error -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer?, or ""} test menu-2.228 {entry configuration options 5 -underline 3p radiobutton} -body { .m1 entryconfigure 5 -underline 3p -} -returnCodes error -result {bad index "3p": must be integer?[+-]integer? or end?[+-]integer?} +} -returnCodes error -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer?, or ""} deleteWindows if {[testConstraint hasEarthPhoto]} { diff --git a/tests/menubut.test b/tests/menubut.test index c2fa2a2..ac479ab 100644 --- a/tests/menubut.test +++ b/tests/menubut.test @@ -294,7 +294,7 @@ test menubutton-1.54 {configuration options} -body { } -result 5 test menubutton-1.55 {configuration options} -body { .mb configure -underline 3p -} -returnCodes error -result {bad index "3p": must be integer?[+-]integer? or end?[+-]integer?} +} -returnCodes error -result {bad index "3p": must be integer?[+-]integer?, end?[+-]integer?, or ""} test menubutton-1.56 {configuration options} -body { .mb configure -width 402 .mb cget -width diff --git a/tests/panedwindow.test b/tests/panedwindow.test index f8fb3ae..4a1f161 100644 --- a/tests/panedwindow.test +++ b/tests/panedwindow.test @@ -11,6 +11,8 @@ eval tcltest::configure $argv tcltest::loadTestedCommands namespace import -force tcltest::test +testConstraint needsTcl87 [package vsatisfies [package provide Tcl] 8.7-] + deleteWindows # Panedwindow for tests 1.* panedwindow .p @@ -122,9 +124,9 @@ test panedwindow-1.23 {configuration options: -proxyrelief (good)} -body { } -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] diff --git a/tests/ttk/combobox.test b/tests/ttk/combobox.test index 7287fb0..3308d20 100644 --- a/tests/ttk/combobox.test +++ b/tests/ttk/combobox.test @@ -53,7 +53,12 @@ test combobox-2.5 "current -- set to end index" -body { test combobox-2.6 "current -- set to unknown index" -body { .cb configure -values [list a b c d e] .cb current notanindex -} -returnCodes error -result {Incorrect index notanindex} +} -returnCodes error -result {bad index "notanindex"} + +test combobox-2.7 {current -- set to 0 index when empty [bug 924835c36d]} -body { + .cb configure -values {} + .cb current 0 +} -returnCodes error -result {index "0" out of range} test combobox-2.end "Cleanup" -body { destroy .cb } diff --git a/unix/tkUnixSysTray.c b/unix/tkUnixSysTray.c index 03414e7..26cd825 100644 --- a/unix/tkUnixSysTray.c +++ b/unix/tkUnixSysTray.c @@ -671,21 +671,21 @@ DockToManager( static const Tk_OptionSpec IconOptionSpec[] = { {TK_OPTION_STRING,"-image","image","Image", - (char *) NULL, -1, offsetof(DockIcon, imageString), - TK_OPTION_NULL_OK, NULL, - ICON_CONF_IMAGE | ICON_CONF_REDISPLAY}, + NULL, TCL_INDEX_NONE, offsetof(DockIcon, imageString), + TK_OPTION_NULL_OK, NULL, + ICON_CONF_IMAGE | ICON_CONF_REDISPLAY}, {TK_OPTION_STRING,"-class","class","Class", - "TrayIcon", -1, offsetof(DockIcon, classString), - 0, NULL, ICON_CONF_CLASS}, + "TrayIcon", TCL_INDEX_NONE, offsetof(DockIcon, classString), + 0, NULL, ICON_CONF_CLASS}, {TK_OPTION_BOOLEAN,"-docked","docked","Docked", - "1", -1, offsetof(DockIcon, docked), 0, NULL, - ICON_CONF_XEMBED | ICON_CONF_REDISPLAY}, + "1", TCL_INDEX_NONE, offsetof(DockIcon, docked), 0, NULL, + ICON_CONF_XEMBED | ICON_CONF_REDISPLAY}, {TK_OPTION_BOOLEAN,"-shape","shape","Shape", - "0", -1, offsetof(DockIcon, useShapeExt), 0, NULL, - ICON_CONF_IMAGE | ICON_CONF_REDISPLAY}, + "0", TCL_INDEX_NONE, offsetof(DockIcon, useShapeExt), 0, NULL, + ICON_CONF_IMAGE | ICON_CONF_REDISPLAY}, {TK_OPTION_BOOLEAN,"-visible","visible","Visible", - "1", -1, offsetof(DockIcon, visible), 0, NULL, - ICON_CONF_XEMBED | ICON_CONF_REDISPLAY}, + "1", TCL_INDEX_NONE, offsetof(DockIcon, visible), 0, NULL, + ICON_CONF_XEMBED | ICON_CONF_REDISPLAY}, {TK_OPTION_END, NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0} }; diff --git a/win/tkWinSysTray.c b/win/tkWinSysTray.c index aca9eb9..73d5d37 100644 --- a/win/tkWinSysTray.c +++ b/win/tkWinSysTray.c @@ -391,7 +391,7 @@ GetIcoPtr( notfound: Tcl_AppendResult(interp, "icon \"", string, - "\" doesn't exist", (char *) NULL); + "\" doesn't exist", NULL); return NULL; } |