TclOO Package

Check-in [b4a2a87bc3]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | development-slots
Files: files | file ages | folders
SHA1: b4a2a87bc3aab0fbf0132f9d0c032619378cdadf
User & Date: dkf 2012-02-21 21:01:31
Context
2012-03-22
09:19
Add documentation. Work towards better code organization. check-in: ea8879da76 user: dkf tags: development-slots
2012-02-21
21:01
merge trunk check-in: b4a2a87bc3 user: dkf tags: development-slots
20:53
Don't use ranlib during installation process. It's already been done during build. check-in: 45f68ce75a user: dkf tags: trunk
2011-08-09
10:09
Merge mainline check-in: 685f760a21 user: dkf tags: development-slots
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.













1
2
3
4
5
6
7











2011-08-07  Donal K. Fellows  <[email protected]>

	* generic/tclOOInfo.c (InfoClassCallCmd): [Bug 3387082]: Plug memory
	leak in call chain introspection.

2011-07-14  Donal K. Fellows  <[email protected]>

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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
2012-02-21  Donal K. Fellows  <[email protected]>

	* Makefile.in (install-package, install-libraries): [Bug 3490157]:
	Don't use ranlib during installation process. It's already been done
	during build.

2012-01-25  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: When
	copying an object, make sure that the configuration of the variable
	resolver is also duplicated.

2011-08-07  Donal K. Fellows  <[email protected]>

	* generic/tclOOInfo.c (InfoClassCallCmd): [Bug 3387082]: Plug memory
	leak in call chain introspection.

2011-07-14  Donal K. Fellows  <[email protected]>

Changes to Makefile.in.

132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
...
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
#========================================================================
# Basic installation rules
#========================================================================

install-package: package
	@mkdir -p $(DESTDIR)$(pkglibdir)
	$(INSTALL_PROGRAM) $(PKG_LIB_FILE) $(DESTDIR)$(pkglibdir)/$(PKG_LIB_FILE)
	$(RANLIB) $(DESTDIR)$(pkglibdir)/$(PKG_LIB_FILE)
	$(INSTALL_DATA) pkgIndex.tcl $(DESTDIR)$(pkglibdir)/pkgIndex.tcl
	$(INSTALL_DATA) tclooConfig.sh $(DESTDIR)$(pkglibdir)/tclooConfig.sh
#	for p in $(SRC_DIR)/library/*.tcl ; do \
#	    destp=`basename $$p`; \
#	    echo " Install $$destp $(DESTDIR)$(pkglibdir)/$$destp"; \
#	    $(INSTALL_DATA) $$p $(DESTDIR)$(pkglibdir)/$$destp; \
#	done
................................................................................
	    echo "Installing $(SRC_DIR)/$$p" ; \
	    destp=`basename $$p`; \
	    $(INSTALL_DATA) $(SRC_DIR)/$$p $(DESTDIR)$(includedir)/$$destp ; \
	done;
install-libraries: libraries
	@echo "Installing $(PKG_STUB_LIB_FILE) in $(DESTDIR)$(pkglibdir)"
	@mkdir -p $(DESTDIR)$(pkglibdir)
	$(INSTALL_PROGRAM) $(PKG_STUB_LIB_FILE) $(DESTDIR)$(pkglibdir)
	$(RANLIB_STUB) $(DESTDIR)$(pkglibdir)/$(PKG_STUB_LIB_FILE)

#========================================================================
# Install documentation. Unix manpages should go in the $(mandir) directory.
#========================================================================

install-doc: doc
	@echo "Installing documentation in $(DESTDIR)$(mandir)"






<







 







|
<







132
133
134
135
136
137
138

139
140
141
142
143
144
145
...
158
159
160
161
162
163
164
165

166
167
168
169
170
171
172
#========================================================================
# Basic installation rules
#========================================================================

install-package: package
	@mkdir -p $(DESTDIR)$(pkglibdir)
	$(INSTALL_PROGRAM) $(PKG_LIB_FILE) $(DESTDIR)$(pkglibdir)/$(PKG_LIB_FILE)

	$(INSTALL_DATA) pkgIndex.tcl $(DESTDIR)$(pkglibdir)/pkgIndex.tcl
	$(INSTALL_DATA) tclooConfig.sh $(DESTDIR)$(pkglibdir)/tclooConfig.sh
#	for p in $(SRC_DIR)/library/*.tcl ; do \
#	    destp=`basename $$p`; \
#	    echo " Install $$destp $(DESTDIR)$(pkglibdir)/$$destp"; \
#	    $(INSTALL_DATA) $$p $(DESTDIR)$(pkglibdir)/$$destp; \
#	done
................................................................................
	    echo "Installing $(SRC_DIR)/$$p" ; \
	    destp=`basename $$p`; \
	    $(INSTALL_DATA) $(SRC_DIR)/$$p $(DESTDIR)$(includedir)/$$destp ; \
	done;
install-libraries: libraries
	@echo "Installing $(PKG_STUB_LIB_FILE) in $(DESTDIR)$(pkglibdir)"
	@mkdir -p $(DESTDIR)$(pkglibdir)
	$(INSTALL_DATA) $(PKG_STUB_LIB_FILE) $(DESTDIR)$(pkglibdir)


#========================================================================
# Install documentation. Unix manpages should go in the $(mandir) directory.
#========================================================================

install-doc: doc
	@echo "Installing documentation in $(DESTDIR)$(mandir)"

Changes to generic/tclOO.c.

1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
....
1571
1572
1573
1574
1575
1576
1577









1578
1579
1580
1581
1582
1583
1584
....
1654
1655
1656
1657
1658
1659
1660









1661
1662
1663
1664
1665
1666
1667
    const char *targetName,
    const char *targetNamespaceName)
{
    Object *oPtr = (Object *) sourceObject, *o2Ptr;
    FOREACH_HASH_DECLS;
    Method *mPtr;
    Class *mixinPtr;
    Tcl_Obj *keyPtr, *filterObj;
    int i;

    /*
     * Sanity checks.
     */

    if (targetName == NULL && oPtr->classPtr != NULL) {
................................................................................
     * Copy the object's filter list to the new object.
     */

    DUPLICATE(o2Ptr->filters, oPtr->filters, Tcl_Obj *);
    FOREACH(filterObj, o2Ptr->filters) {
	Tcl_IncrRefCount(filterObj);
    }










    /*
     * Copy the object's flags to the new object, clearing those that must be
     * kept object-local. The duplicate is never deleted at this point, nor is
     * it the root of the object system or in the midst of processing a filter
     * call.
     */
................................................................................
	 * Duplicate the source class's filters.
	 */

	DUPLICATE(cls2Ptr->filters, clsPtr->filters, Tcl_Obj *);
	FOREACH(filterObj, cls2Ptr->filters) {
	    Tcl_IncrRefCount(filterObj);
	}










	/*
	 * Duplicate the source class's mixins (which cannot be circular
	 * references to the duplicate).
	 */

	FOREACH(mixinPtr, cls2Ptr->mixins) {






|







 







>
>
>
>
>
>
>
>
>







 







>
>
>
>
>
>
>
>
>







1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
....
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
....
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
    const char *targetName,
    const char *targetNamespaceName)
{
    Object *oPtr = (Object *) sourceObject, *o2Ptr;
    FOREACH_HASH_DECLS;
    Method *mPtr;
    Class *mixinPtr;
    Tcl_Obj *keyPtr, *filterObj, *variableObj;
    int i;

    /*
     * Sanity checks.
     */

    if (targetName == NULL && oPtr->classPtr != NULL) {
................................................................................
     * Copy the object's filter list to the new object.
     */

    DUPLICATE(o2Ptr->filters, oPtr->filters, Tcl_Obj *);
    FOREACH(filterObj, o2Ptr->filters) {
	Tcl_IncrRefCount(filterObj);
    }

    /*
     * Copy the object's variable resolution list to the new object.
     */

    DUPLICATE(o2Ptr->variables, oPtr->variables, Tcl_Obj *);
    FOREACH(variableObj, o2Ptr->variables) {
	Tcl_IncrRefCount(variableObj);
    }

    /*
     * Copy the object's flags to the new object, clearing those that must be
     * kept object-local. The duplicate is never deleted at this point, nor is
     * it the root of the object system or in the midst of processing a filter
     * call.
     */
................................................................................
	 * Duplicate the source class's filters.
	 */

	DUPLICATE(cls2Ptr->filters, clsPtr->filters, Tcl_Obj *);
	FOREACH(filterObj, cls2Ptr->filters) {
	    Tcl_IncrRefCount(filterObj);
	}

	/*
	 * Copy the source class's variable resolution list.
	 */

	DUPLICATE(cls2Ptr->variables, clsPtr->variables, Tcl_Obj *);
	FOREACH(variableObj, cls2Ptr->variables) {
	    Tcl_IncrRefCount(variableObj);
	}

	/*
	 * Duplicate the source class's mixins (which cannot be circular
	 * references to the duplicate).
	 */

	FOREACH(mixinPtr, cls2Ptr->mixins) {

Changes to tests/oo.test.

692
693
694
695
696
697
698



























































































































699
700
701
702
703
704
705
....
1461
1462
1463
1464
1465
1466
1467






















1468
1469
1470
1471
1472
1473
1474
	}
	forward ns curns
    }
    expr {[[fooClass new] ns] ne [[fooClass new] ns]}
} -cleanup {
    fooClass destroy
} -result 1




























































































































test oo-7.1 {OO: inheritance 101} -setup {
    oo::class create superClass
    oo::class create subClass
    subClass create instance
} -body {
    oo::define superClass method doit x {lappend ::result $x}
................................................................................
    bar create tester
    tester testme
    foo destroy
    tester testme
    bar destroy
    return $result
} {::foo->::baseline ::foo->::baseline ::bar->::tester ::bar->::tester}























test oo-16.1 {OO: object introspection} -body {
    info object
} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?argument ...?\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}






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







 







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







692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
....
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
	}
	forward ns curns
    }
    expr {[[fooClass new] ns] ne [[fooClass new] ns]}
} -cleanup {
    fooClass destroy
} -result 1
test oo-6.8 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
    oo::class create fooClass
} -constraints bug-3400658 -body {
    oo::define fooClass {
	forward test my handler
	method handler {a b c} {}
    }
    fooClass create ::foo
    foo test
} -returnCodes error -cleanup {
    fooClass destroy
} -result {wrong # args: should be "foo test a b c"}
test oo-6.9 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
    oo::class create fooClass
} -body {
    oo::define fooClass {
	forward test my handler
	method handler {a b c} {list $a,$b,$c}
    }
    fooClass create ::foo
    foo test 1 2 3
} -cleanup {
    fooClass destroy
} -result 1,2,3
test oo-6.10 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
    oo::class create fooClass
} -constraints bug-3400658 -body {
    oo::define fooClass {
	forward test my handler
	method handler {a b c} {list $a,$b,$c}
    }
    fooClass create ::foo
    foo test 1 2
} -returnCodes error -cleanup {
    fooClass destroy
} -result {wrong # args: should be "foo test a b c"}
test oo-6.11 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
    oo::object create foo
} -constraints bug-3400658 -body {
    oo::objdefine foo {
	forward test my handler
	method handler {a b c} {}
    }
    foo test
} -returnCodes error -cleanup {
    foo destroy
} -result {wrong # args: should be "foo test a b c"}
test oo-6.12 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
    oo::object create foo
} -body {
    oo::objdefine foo {
	forward test my handler
	method handler {a b c} {list $a,$b,$c}
    }
    foo test 1 2 3
} -cleanup {
    foo destroy
} -result 1,2,3
test oo-6.13 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
    oo::object create foo
} -constraints bug-3400658 -body {
    oo::objdefine foo {
	forward test my handler
	method handler {a b c} {list $a,$b,$c}
    }
    foo test 1 2
} -returnCodes error -cleanup {
    foo destroy
} -result {wrong # args: should be "foo test a b c"}
test oo-6.14 {Bug 3400658: forwarding and wrongargs rewriting - multistep} -setup {
    oo::class create fooClass
} -constraints bug-3400658 -body {
    oo::define fooClass {
	forward test my handler1 p
	forward handler1 my handler q
	method handler {a b c} {}
    }
    fooClass create ::foo
    foo test
} -returnCodes error -cleanup {
    fooClass destroy
} -result {wrong # args: should be "foo test c"}
test oo-6.15 {Bug 3400658: forwarding and wrongargs rewriting - multistep} -setup {
    oo::class create fooClass
} -body {
    oo::define fooClass {
	forward test my handler1 p
	forward handler1 my handler q
	method handler {a b c} {list $a,$b,$c}
    }
    fooClass create ::foo
    foo test 1
} -cleanup {
    fooClass destroy
} -result q,p,1
test oo-6.16 {Bug 3400658: forwarding and wrongargs rewriting - via alias} -setup {
    oo::class create fooClass
} -constraints bug-3400658 -body {
    oo::define fooClass {
	forward test handler1 foo bar
	forward handler2 my handler x
	method handler {a b c d} {list $a,$b,$c,$d}
	export eval
    }
    fooClass create ::foo
    foo eval {
	interp alias {} [namespace current]::handler1 \
	    {} [namespace current]::my handler2
    }
    foo test 1 2 3
} -returnCodes error -cleanup {
    fooClass destroy
} -result {wrong # args: should be "foo test d"}
test oo-6.18 {Bug 3408830: more forwarding cases} -setup {
    oo::class create fooClass
} -body {
    oo::define fooClass {
	forward len  string length
    }
    [fooClass create foo] len a b
} -returnCodes error -cleanup {
    fooClass destroy
} -result {wrong # args: should be "::foo len string"}

test oo-7.1 {OO: inheritance 101} -setup {
    oo::class create superClass
    oo::class create subClass
    subClass create instance
} -body {
    oo::define superClass method doit x {lappend ::result $x}
................................................................................
    bar create tester
    tester testme
    foo destroy
    tester testme
    bar destroy
    return $result
} {::foo->::baseline ::foo->::baseline ::bar->::tester ::bar->::tester}
test oo-15.4 {OO: object cloning - Bug 3474460} -setup {
    oo::class create ArbitraryClass
} -body {
    ArbitraryClass create foo
    oo::objdefine foo variable a b c
    oo::copy foo bar
    info object variable bar
} -cleanup {
    ArbitraryClass destroy
} -result {a b c}
test oo-15.5 {OO: class cloning - Bug 3474460} -setup {
    oo::class create ArbitraryClass
} -body {
    oo::class create Foo {
	superclass ArbitraryClass
	variable a b c
    }
    oo::copy Foo Bar
    info class variable Bar
} -cleanup {
    ArbitraryClass destroy
} -result {a b c}

test oo-16.1 {OO: object introspection} -body {
    info object
} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?argument ...?\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}