Tk Source Code

Check-in [5b0cea38]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Make sure that in test-cases, Tk_DeleteOptionTable() is never called more times than the corresponding Tk_CreateOptionTable(). Although it doesn't crash now, this behavior cannot be depended on.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 5b0cea38b5a8b0965326c7b3aac4e37d5ff3fc2a
User & Date: jan.nijtmans 2013-08-01 08:47:37
Context
2013-08-11
14:51
Sync with Tcl version of tcl.m4 check-in: f2303527 user: jan.nijtmans tags: trunk
2013-08-01
08:51
rebase check-in: 218ef501 user: jan.nijtmans tags: bug-069c9e43c4
08:47
Make sure that in test-cases, Tk_DeleteOptionTable() is never called more times than the corresponding Tk_CreateOptionTable(). Although it doesn't crash now, this behavior cannot be depended on. check-in: 5b0cea38 user: jan.nijtmans tags: trunk
2013-07-26
14:23
Don't hardcode "tclWinError.o" for Cygwin. check-in: ef0cac7c user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tkTest.c.

︙︙
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511

TestobjconfigObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const options[] = {
	"alltypes", "chain1", "chain2", "configerror", "delete", "info",
	"internal", "new", "notenoughparams", "twowindows", NULL
    };
    enum {
	ALL_TYPES, CHAIN1, CHAIN2, CONFIG_ERROR,
	DEL,			/* Can't use DELETE: VC++ compiler barfs. */
	INFO, INTERNAL, NEW, NOT_ENOUGH_PARAMS, TWO_WINDOWS
    };
    static Tk_OptionTable tables[11];
				/* Holds pointers to option tables created by
				 * commands below; indexed with same values as
				 * "options" array. */








|



|








493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511

TestobjconfigObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    static const char *const options[] = {
	"alltypes", "chain1", "chain2", "chain3", "configerror", "delete", "info",
	"internal", "new", "notenoughparams", "twowindows", NULL
    };
    enum {
	ALL_TYPES, CHAIN1, CHAIN2, CHAIN3, CONFIG_ERROR,
	DEL,			/* Can't use DELETE: VC++ compiler barfs. */
	INFO, INTERNAL, NEW, NOT_ENOUGH_PARAMS, TWO_WINDOWS
    };
    static Tk_OptionTable tables[11];
				/* Holds pointers to option tables created by
				 * commands below; indexed with same values as
				 * "options" array. */
︙︙
716
717
718
719
720
721
722

723
724
725
726
727
728
729
730

	    Tk_CreateEventHandler(tkwin, StructureNotifyMask,
		    TrivialEventProc, (ClientData) recordPtr);
	    Tcl_SetObjResult(interp, objv[2]);
	}
	break;
    }


    case CHAIN2: {
	ExtensionWidgetRecord *recordPtr;
	static const Tk_OptionSpec extensionSpecs[] = {
	    {TK_OPTION_STRING, "-three", "three", "Three", "three",
		Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr), -1, 0, NULL, 0},
	    {TK_OPTION_STRING, "-four", "four", "Four", "four",
		Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr), -1, 0, NULL, 0},
	    {TK_OPTION_STRING, "-two", "two", "Two", "two and a half",








>
|








716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731

	    Tk_CreateEventHandler(tkwin, StructureNotifyMask,
		    TrivialEventProc, (ClientData) recordPtr);
	    Tcl_SetObjResult(interp, objv[2]);
	}
	break;
    }

    case CHAIN2:
    case CHAIN3: {
	ExtensionWidgetRecord *recordPtr;
	static const Tk_OptionSpec extensionSpecs[] = {
	    {TK_OPTION_STRING, "-three", "three", "Three", "three",
		Tk_Offset(ExtensionWidgetRecord, extension3ObjPtr), -1, 0, NULL, 0},
	    {TK_OPTION_STRING, "-four", "four", "Four", "four",
		Tk_Offset(ExtensionWidgetRecord, extension4ObjPtr), -1, 0, NULL, 0},
	    {TK_OPTION_STRING, "-two", "two", "Two", "two and a half",
︙︙
799
800
801
802
803
804
805



806
807
808
809
810
811
812

	}
	if (Tcl_GetIndexFromObjStruct(interp, objv[2], options,
		sizeof(char *), "table", 0, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (tables[index] != NULL) {
	    Tk_DeleteOptionTable(tables[index]);



	}
	break;

    case INFO:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "tableName");
	    return TCL_ERROR;








>
>
>








800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816

	}
	if (Tcl_GetIndexFromObjStruct(interp, objv[2], options,
		sizeof(char *), "table", 0, &index) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (tables[index] != NULL) {
	    Tk_DeleteOptionTable(tables[index]);
	    /* Make sure that Tk_DeleteOptionTable() is never done
	     * twice for the same table. */
	    tables[index] = NULL;
	}
	break;

    case INFO:
	if (objc != 3) {
	    Tcl_WrongNumArgs(interp, 2, objv, "tableName");
	    return TCL_ERROR;
︙︙

Changes to tests/config.test.

︙︙
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

tcltest::loadTestedCommands

proc killTables {} {
    # Note: it's important to delete chain2 before chain1, because
    # chain2 depends on chain1.  If chain1 is deleted first, the
    # delete of chain2 will crash.
    deleteWindows
    foreach t {alltypes chain2 chain1 configerror internal new notenoughparams
	    twowindows} {
	    while {[testobjconfig info $t] != ""} {
	        testobjconfig delete $t
	    }
    }
}










|
|








12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27

tcltest::loadTestedCommands

proc killTables {} {
    # Note: it's important to delete chain2 before chain1, because
    # chain2 depends on chain1.  If chain1 is deleted first, the
    # delete of chain2 will crash.
    deleteWindows
    foreach t {alltypes chain3 chain2 chain1 configerror internal
	    new notenoughparams twowindows} {
	    while {[testobjconfig info $t] != ""} {
	        testobjconfig delete $t
	    }
    }
}
︙︙
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138


test config-2.1 {Tk_DeleteOptionTable - reference counts} -constraints {
    testobjconfig
} -body {
    set x {}
    testobjconfig chain1 .a
    testobjconfig chain2 .b
    testobjconfig chain2 .c
    deleteWindows
    testobjconfig delete chain2
    lappend x [testobjconfig info chain2] [testobjconfig info chain1]
    testobjconfig delete chain2
    lappend x [testobjconfig info chain2] [testobjconfig info chain1]
} -cleanup {
    killTables
} -result {{1 4 -three 2 2 -one} {2 2 -one} {} {1 2 -one}}









|

|








122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138


test config-2.1 {Tk_DeleteOptionTable - reference counts} -constraints {
    testobjconfig
} -body {
    set x {}
    testobjconfig chain1 .a
    testobjconfig chain2 .b
    testobjconfig chain3 .c
    deleteWindows
    testobjconfig delete chain3
    lappend x [testobjconfig info chain2] [testobjconfig info chain1]
    testobjconfig delete chain2
    lappend x [testobjconfig info chain2] [testobjconfig info chain1]
} -cleanup {
    killTables
} -result {{1 4 -three 2 2 -one} {2 2 -one} {} {1 2 -one}}
︙︙

This page was generated in about 0.018s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19