TclOO Package

Check-in [7779ee5d61]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:tcl:9dd1bd7a74 Ensure that [self] returns a sensible value in a destructor even when construction didn't complete.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7779ee5d6183c3f63121d9ec44ebd02000c37ab1
User & Date: dkf 2015-05-15 14:01:33
Original Comment: [9dd1bd7a74] Ensure that [self] returns a sensible value in a destructor even when construction didn't complete.
Context
2015-05-17
12:05
tcl:ad6696285c Demonstrate that filters are not called for destructors. check-in: 7c1b9675fd user: dkf tags: trunk
2015-05-15
14:01
tcl:9dd1bd7a74 Ensure that [self] returns a sensible value in a destructor even when construction didn't complete. check-in: 7779ee5d61 user: dkf tags: trunk
2014-09-09
17:56
Updates for 1.0.2 release. check-in: a5f531d6ac user: dkf tags: trunk, release, release-1.0.2, corresponds-to-Tcl8.6.2, corresponds-to-Tcl8.6.3
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclOO.c.

1618
1619
1620
1621
1622
1623
1624







1625
1626
1627
1628
1629
1630
1631
		Tcl_SetResult(interp, "object deleted in constructor",
			TCL_STATIC);
		Tcl_SetErrorCode(interp, "TCLOO", "STILLBORN", NULL);
		result = TCL_ERROR;
	    }
	    TclOODeleteContext(contextPtr);
	    if (result != TCL_OK && !Deleted(oPtr)) {







		/*
		 * Take care to not delete a deleted object; that would be
		 * bad. [Bug 2903011]
		 */

		Tcl_DeleteCommandFromToken(interp, oPtr->command);
	    }






>
>
>
>
>
>
>







1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
		Tcl_SetResult(interp, "object deleted in constructor",
			TCL_STATIC);
		Tcl_SetErrorCode(interp, "TCLOO", "STILLBORN", NULL);
		result = TCL_ERROR;
	    }
	    TclOODeleteContext(contextPtr);
	    if (result != TCL_OK && !Deleted(oPtr)) {
		/*
		 * Take care to make sure that we have the name of the command
		 * before we delete it. [Bug 9dd1bd7a74]
		 */

		(void) TclOOObjectName(interp, oPtr);

		/*
		 * Take care to not delete a deleted object; that would be
		 * bad. [Bug 2903011]
		 */

		Tcl_DeleteCommandFromToken(interp, oPtr->command);
	    }

Changes to tests/oo.test.

412
413
414
415
416
417
418

























419
420
421
422
423
424
425
	namespace export t next
	namespace ensemble create
    }
    k t create X
} -returnCodes error -cleanup {
    namespace delete k
} -result {wrong # args: should be "k next j"}


























test oo-3.1 {basic test of OO functionality: destructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as
    # we're modifying the root object class's constructor
    interp create subinterp
    initInterpreter subinterp
    subinterp eval {






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
	namespace export t next
	namespace ensemble create
    }
    k t create X
} -returnCodes error -cleanup {
    namespace delete k
} -result {wrong # args: should be "k next j"}
test oo-2.9 {construction failures and self creation} -setup {
    set ::result {}
    oo::class create Root
} -body {
    oo::class create A {
	superclass Root
	constructor {} {
	    lappend ::result "in A"
	    error "failure in A"
	}
	destructor {lappend ::result [self]}
    }
    oo::class create B {
	superclass Root
	constructor {} {
	    lappend ::result "in B [self]"
	    error "failure in B"
	}
	destructor {lappend ::result [self]}
    }
    lappend ::result [catch {A create a} msg] $msg
    lappend ::result [catch {B create b} msg] $msg
} -cleanup {
    Root destroy
} -result {{in A} ::a 1 {failure in A} {in B ::b} ::b 1 {failure in B}}

test oo-3.1 {basic test of OO functionality: destructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as
    # we're modifying the root object class's constructor
    interp create subinterp
    initInterpreter subinterp
    subinterp eval {