TclOO Package

Check-in [0a6e9f1ea3]
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:Update to 1.0.4
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk | release | release-1.0.4 | corresponds-to-Tcl8.6.5
Files: files | file ages | folders
SHA1: 0a6e9f1ea3b045b12bf6a920b4bc91c86a40eecc
User & Date: dkf 2016-03-01 00:07:14
Context
2016-04-20
07:58
[6adfa8fddf] Fix test target check-in: e5b56214c7 user: gahr tags: trunk
2016-03-01
00:07
Update to 1.0.4 check-in: 0a6e9f1ea3 user: dkf tags: trunk, release, release-1.0.4, corresponds-to-Tcl8.6.5
2015-11-22
08:36
tcl:3d96b7076e Prevent crashes when destroying an object's class inside a method call. check-in: 426f9ef2c6 user: dkf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to README.md.

1
2
3
4
5
6
7
8
9
10
11
12
..
20
21
22
23
24
25
26
27
28
29

30
31
32
33
34
35
36
37

38
39
40
41


42
43
44
45
46
47
48
49
50
51
52
53
Release of TclOO Version 1.0.2
==============================

This officially corresponds to the version of TclOO that is included with Tcl
8.6.2, except for features (notably coroutine support and bytecode compilation
of some commands) that require the 8.6 runtime.

TclOO: An Object System for Tcl
===============================

TclOO is an object system for Tcl that has been designed to provide high
performance while still allowing as much flexibility as possible, and to be a
................................................................................
dependent on other Tcl 8.6 features.

The heritage of TclOO can be traced back to a number of other object systems,
notably including XOTcl, incr Tcl, and Snit. It also draws on experience with
object systems in other languages like C++, Java and Ruby (despite being
somewhat different from each of them).

Changes in TclOO 1.0.1
----------------------
Bugfixes for:


* <http://core.tcl.tk/tcl/info/7d52e1101b>

* <http://core.tcl.tk/tcl/info/75b8433707>

* <http://core.tcl.tk/tcl/info/f51efe99a7>

No API changes.


For a full description of all changes, see:

* <http://core.tcl.tk/tcloo/timeline?from=release-1.0.1&to=release-1.0.2>



Building
--------

TclOO 1.0.2 uses the TEA3 build system. These instructions are known to work
on Linux, OSX and Windows (with msys installed).

1. Make sure you have a source distribution of Tcl 8.5 somewhere; you will
   need it to build TclOO. (Note that this functionality is incorporated
   directly into Tcl 8.6; you do not need this package with that version.)

2. Run the configure shell script in this directory. You may well want to
|



|







 







|

|
>

<
<
<
<
<
<
<
>



|
>
>




|







1
2
3
4
5
6
7
8
9
10
11
12
..
20
21
22
23
24
25
26
27
28
29
30
31







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Release of TclOO Version 1.0.4
==============================

This officially corresponds to the version of TclOO that is included with Tcl
8.6.5, except for features (notably coroutine support and bytecode compilation
of some commands) that require the 8.6 runtime.

TclOO: An Object System for Tcl
===============================

TclOO is an object system for Tcl that has been designed to provide high
performance while still allowing as much flexibility as possible, and to be a
................................................................................
dependent on other Tcl 8.6 features.

The heritage of TclOO can be traced back to a number of other object systems,
notably including XOTcl, incr Tcl, and Snit. It also draws on experience with
object systems in other languages like C++, Java and Ruby (despite being
somewhat different from each of them).

Changes in TclOO 1.0.4
----------------------
* TIP #436 <http://tip.tcl.tk/436.html> was implemented, which makes `info
  object isa` not produce errors when presented with non-objects.








* Various bugs in class destruction were addressed.

For a full description of all changes, see:

* <http://core.tcl.tk/tcloo/timeline?from=release-1.0.2&to=release-1.0.4>

Note that there were no meaningful changes in 1.0.3.

Building
--------

TclOO 1.0.4 uses the TEA3 build system. These instructions are known to work
on Linux, OSX and Windows (with msys installed).

1. Make sure you have a source distribution of Tcl 8.5 somewhere; you will
   need it to build TclOO. (Note that this functionality is incorporated
   directly into Tcl 8.6; you do not need this package with that version.)

2. Run the configure shell script in this directory. You may well want to

Changes to README.txt.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
..
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79


80
81
82
83
84
85
86
87
88
89
Object Oriented Programming Package for Tcl (TclOO) Version 1.0.2

Copyright 2005-2014 Donal K. Fellows

License
=======

See the file "license.terms" for the license under which this software is
made available. This file must have been part of the distribution under
which you received this file.

Building
========

TclOO 1.0.2 uses the TEA3 build system. These instructions are known to work
on Linux, OSX and Windows (with msys installed).

1) Make sure you have a source distribution of Tcl 8.5 somewhere; you will
   need it to build TclOO. (Note that this functionality is incorporated
   directly into Tcl 8.6; you do not need this package with that version.)

2) Run the configure shell script in this directory. You may well want to
................................................................................
set sum [summation new]
puts "Start with [$sum value]"
for {set i 1} {$i <= 10} {incr i} {
    puts "Add $i to get [$sum add $i]"
}
summation destroy

Significant Changes from 1.0.1 Release
====================================
Bugfixes for:
* http://core.tcl.tk/tcl/info/7d52e1101b
* http://core.tcl.tk/tcl/info/75b8433707
* http://core.tcl.tk/tcl/info/f51efe99a7

No API changes.

For a full description of all changes, see:
 http://core.tcl.tk/tcloo/timeline?from=release-1.0.1&to=release-1.0.2



Compatibility Warnings
======================
Names of classes, methods or variables that begin with a hyphen can now cause
issues with some definitions (i.e., they are reserved to slotted operations).
The fix is to precede the name with a "--" argument in the problem definition;
see the [oo::define] documentation for the affected definitions.

Method names that are proper multi-element lists are reserved for future
functionality.
|













|







 







|

|
|
|
<

<
<

|
>
>










1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
..
62
63
64
65
66
67
68
69
70
71
72
73

74


75
76
77
78
79
80
81
82
83
84
85
86
87
88
Object Oriented Programming Package for Tcl (TclOO) Version 1.0.4

Copyright 2005-2014 Donal K. Fellows

License
=======

See the file "license.terms" for the license under which this software is
made available. This file must have been part of the distribution under
which you received this file.

Building
========

TclOO 1.0.4 uses the TEA3 build system. These instructions are known to work
on Linux, OSX and Windows (with msys installed).

1) Make sure you have a source distribution of Tcl 8.5 somewhere; you will
   need it to build TclOO. (Note that this functionality is incorporated
   directly into Tcl 8.6; you do not need this package with that version.)

2) Run the configure shell script in this directory. You may well want to
................................................................................
set sum [summation new]
puts "Start with [$sum value]"
for {set i 1} {$i <= 10} {incr i} {
    puts "Add $i to get [$sum add $i]"
}
summation destroy

Significant Changes from 1.0.2 Release
====================================
* TIP #436 <http://tip.tcl.tk/436.html> was implemented, which makes `info
  object isa` not produce errors when presented with non-objects.
* Various bugs in class destruction were addressed.




For a full description of all changes, see:
 http://core.tcl.tk/tcloo/timeline?from=release-1.0.2&to=release-1.0.4

Note that there were no meaningful changes in 1.0.3.

Compatibility Warnings
======================
Names of classes, methods or variables that begin with a hyphen can now cause
issues with some definitions (i.e., they are reserved to slotted operations).
The fix is to precede the name with a "--" argument in the problem definition;
see the [oo::define] documentation for the affected definitions.

Method names that are proper multi-element lists are reserved for future
functionality.

Changes to configure.

1
2
3
4
5
6
7
8
9
10
...
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
....
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
....
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
....
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
....
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
....
8577
8578
8579
8580
8581
8582
8583
8584
8585
8586
8587
8588
8589
8590
8591
....
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649
8650
8651
8652
8653
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69 for TclOO 1.0.2.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
................................................................................
subdirs=
MFLAGS=
MAKEFLAGS=

# Identity of this package.
PACKAGE_NAME='TclOO'
PACKAGE_TARNAME='tcloo'
PACKAGE_VERSION='1.0.2'
PACKAGE_STRING='TclOO 1.0.2'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H
................................................................................
#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures TclOO 1.0.2 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.
................................................................................

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of TclOO 1.0.2:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
................................................................................
    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
TclOO configure 1.0.2
generated by GNU Autoconf 2.69

Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit
................................................................................
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_type
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by TclOO $as_me 1.0.2, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  $ $0 [email protected]

_ACEOF
exec 5>>config.log
{
................................................................................
test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Save the log message, to keep $0 and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by TclOO $as_me 1.0.2, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 [email protected]
................................................................................

Report bugs to the package provider."

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
TclOO config.status 1.0.2
configured by $0, generated by GNU Autoconf 2.69,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."


|







 







|
|







 







|







 







|







 







|







 







|







 







|







 







|







1
2
3
4
5
6
7
8
9
10
...
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
....
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
....
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
....
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
....
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
....
8577
8578
8579
8580
8581
8582
8583
8584
8585
8586
8587
8588
8589
8590
8591
....
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649
8650
8651
8652
8653
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.69 for TclOO 1.0.4.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
................................................................................
subdirs=
MFLAGS=
MAKEFLAGS=

# Identity of this package.
PACKAGE_NAME='TclOO'
PACKAGE_TARNAME='tcloo'
PACKAGE_VERSION='1.0.4'
PACKAGE_STRING='TclOO 1.0.4'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#ifdef HAVE_SYS_TYPES_H
................................................................................
#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures TclOO 1.0.4 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.
................................................................................

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of TclOO 1.0.4:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-option-checking  ignore unrecognized --enable/--with options
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
................................................................................
    cd "$ac_pwd" || { ac_status=$?; break; }
  done
fi

test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
  cat <<\_ACEOF
TclOO configure 1.0.4
generated by GNU Autoconf 2.69

Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit
................................................................................
  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno

} # ac_fn_c_check_type
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by TclOO $as_me 1.0.4, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  $ $0 [email protected]

_ACEOF
exec 5>>config.log
{
................................................................................
test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1

cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# Save the log message, to keep $0 and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
This file was extended by TclOO $as_me 1.0.4, which was
generated by GNU Autoconf 2.69.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 [email protected]
................................................................................

Report bugs to the package provider."

_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
TclOO config.status 1.0.4
configured by $0, generated by GNU Autoconf 2.69,
  with options \\"\$ac_cs_config\\"

Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."

Changes to configure.in.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
dnl#
dnl# When changing the version number, you *must* change the following:
dnl#	generic/tclOO.h, tests/oo.test, tests/ooNext2.test
dnl#
dnl# You should also change the following:
dnl#	README.txt, README.md, win/TclOO.rc
dnl#
AC_INIT([TclOO],[1.0.2])
AC_CONFIG_AUX_DIR(tclconfig)
AC_CONFIG_HEADERS(config.h)

TEA_INIT([3.9])
TEA_PATH_TCLCONFIG
TEA_LOAD_TCLCONFIG
TEA_PREFIX






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
dnl#
dnl# When changing the version number, you *must* change the following:
dnl#	generic/tclOO.h, tests/oo.test, tests/ooNext2.test
dnl#
dnl# You should also change the following:
dnl#	README.txt, README.md, win/TclOO.rc
dnl#
AC_INIT([TclOO],[1.0.4])
AC_CONFIG_AUX_DIR(tclconfig)
AC_CONFIG_HEADERS(config.h)

TEA_INIT([3.9])
TEA_PATH_TCLCONFIG
TEA_LOAD_TCLCONFIG
TEA_PREFIX

Changes to doc/Class.3.

67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
.AP Tcl_Class class in
Reference to the class to operate upon.
.AP "const char" *name in
The name of the object to create, or NULL if a new unused name is to be
automatically selected.
.AP "const char" *nsName in
The name of the namespace to create for the object's private use, or NULL if a
new unused name is to be automatically selected.

.AP int objc in
The number of elements in the \fIobjv\fR array.
.AP "Tcl_Obj *const" *objv in
The arguments to the command to create the instance of the class.
.AP int skip in
The number of arguments at the start of the argument array, \fIobjv\fR, that
are not arguments to any constructors.






|
>







67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
.AP Tcl_Class class in
Reference to the class to operate upon.
.AP "const char" *name in
The name of the object to create, or NULL if a new unused name is to be
automatically selected.
.AP "const char" *nsName in
The name of the namespace to create for the object's private use, or NULL if a
new unused name is to be automatically selected. The namespace must not
already exist.
.AP int objc in
The number of elements in the \fIobjv\fR array.
.AP "Tcl_Obj *const" *objv in
The arguments to the command to create the instance of the class.
.AP int skip in
The number of arguments at the start of the argument array, \fIobjv\fR, that
are not arguments to any constructors.

Changes to generic/tclOO.c.

55
56
57
58
59
60
61


62
63
64
65
66
67
68
...
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
...
836
837
838
839
840
841
842

















































843
844
845
846
847
848
849
...
912
913
914
915
916
917
918
919
920
921
922
923
924
925

926
927
928
929
930
931
932
...
933
934
935
936
937
938
939
940
941
942
943
944
945

946
947
948
949
950
951
952
....
1136
1137
1138
1139
1140
1141
1142




1143
1144
1145
1146
1147
1148
1149
1150
1151
....
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179

1180
1181
1182
1183
1184
1185
1186
1187
1188
....
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
....
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
....
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
....
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
 * Function declarations for things defined in this file.
 */

static Class *		AllocClass(Tcl_Interp *interp, Object *useThisObj,
			    Foundation *fPtr);
static Object *		AllocObject(Foundation *fPtr, Tcl_Interp *interp,
			    const char *nameStr, const char *nsNameStr);


static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
			    Method *mPtr, Tcl_Obj *namePtr,
			    Method **newMPtrPtr);
static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
			    Method *mPtr, Tcl_Obj *namePtr);
static void		DeletedDefineNamespace(ClientData clientData);
static void		DeletedObjdefNamespace(ClientData clientData);
................................................................................
 */

static void
ObjectRenamedTrace(
    ClientData clientData,	/* The object being deleted. */
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    const char *oldName,	/* What the object was (last) called. */
    const char *newName,	/* Always NULL. */
    int flags)			/* Why was the object deleted? */
{
    Object *oPtr = clientData;
    Foundation *fPtr = oPtr->fPtr;

    /*
     * If this is a rename and not a delete of the object, we just flush the
................................................................................
    DelRef(fPtr->objectCls);
    DelRef(oPtr);
}
 
/*
 * ----------------------------------------------------------------------
 *

















































 * ReleaseClassContents --
 *
 *	Tear down the special class data structure, including deleting all
 *	dependent classes and objects.
 *
 * ----------------------------------------------------------------------
 */
................................................................................
    }

    /*
     * Squelch classes that this class has been mixed into.
     */

    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
	if (mixinSubclassPtr == NULL) {
	    continue;
	}
	if (!Deleted(mixinSubclassPtr->thisPtr)) {
	    Tcl_DeleteCommandFromToken(interp,
		    mixinSubclassPtr->thisPtr->command);
	}

	DelRef(mixinSubclassPtr->thisPtr);
	DelRef(mixinSubclassPtr);
    }
    if (clsPtr->mixinSubs.list != NULL) {
	ckfree((char *) clsPtr->mixinSubs.list);
	clsPtr->mixinSubs.list = NULL;
	clsPtr->mixinSubs.num = 0;
................................................................................
    }

    /*
     * Squelch subclasses of this class.
     */

    FOREACH(subclassPtr, clsPtr->subclasses) {
	if (subclassPtr == NULL || IsRoot(subclassPtr)) {
	    continue;
	}
	if (!Deleted(subclassPtr->thisPtr)) {
	    Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
	}

	DelRef(subclassPtr->thisPtr);
	DelRef(subclassPtr);
    }
    if (clsPtr->subclasses.list != NULL) {
	ckfree((char *) clsPtr->subclasses.list);
	clsPtr->subclasses.list = NULL;
	clsPtr->subclasses.num = 0;
................................................................................
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(oPtr->metadataPtr);
	ckfree((char *) oPtr->metadataPtr);
	oPtr->metadataPtr = NULL;
    }





    if (clsPtr != NULL) {
	Class *superPtr;
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	if (clsPtr->metadataPtr != NULL) {
	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
		metadataTypePtr->deleteProc(value);
	    }
................................................................................
	FOREACH(filterObj, clsPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	}
	if (i) {
	    ckfree((char *) clsPtr->filters.list);
	    clsPtr->filters.num = 0;
	}
	FOREACH(mixinPtr, clsPtr->mixins) {
	    if (!Deleted(mixinPtr->thisPtr)) {
		TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
	    }
	}
	if (i) {
	    ckfree((char *) clsPtr->mixins.list);
	    clsPtr->mixins.num = 0;
	}
	FOREACH(superPtr, clsPtr->superclasses) {
	    if (!Deleted(superPtr->thisPtr)) {
		TclOORemoveFromSubclasses(clsPtr, superPtr);
	    }
	}
	if (i) {
	    ckfree((char *) clsPtr->superclasses.list);

	    clsPtr->superclasses.num = 0;
	}
	if (clsPtr->subclasses.list) {
	    ckfree((char *) clsPtr->subclasses.list);
	    clsPtr->subclasses.num = 0;
	}
	if (clsPtr->instances.list) {
	    ckfree((char *) clsPtr->instances.list);
	    clsPtr->instances.num = 0;
................................................................................
	if (subPtr == subclsPtr) {
	    goto removeSubclass;
	}
    }
    return;

  removeSubclass:
    if (Deleted(superPtr->thisPtr)) {
	superPtr->subclasses.list[i] = NULL;
    } else {
	superPtr->subclasses.num--;
	if (i < superPtr->subclasses.num) {
	    superPtr->subclasses.list[i] =
		    superPtr->subclasses.list[superPtr->subclasses.num];
	}
	superPtr->subclasses.list[superPtr->subclasses.num] = NULL;
    }
................................................................................
	if (subPtr == subclsPtr) {
	    goto removeSubclass;
	}
    }
    return;

  removeSubclass:
    if (Deleted(superPtr->thisPtr)) {
	superPtr->mixinSubs.list[i] = NULL;
    } else {
	superPtr->mixinSubs.num--;
	if (i < superPtr->mixinSubs.num) {
	    superPtr->mixinSubs.list[i] =
		    superPtr->mixinSubs.list[superPtr->mixinSubs.num];
	}
	superPtr->mixinSubs.list[superPtr->mixinSubs.num] = NULL;
    }
................................................................................
     * object cloning only).
     */

    if (objc >= 0) {
	CallContext *contextPtr = TclOOGetCallContext(oPtr,NULL,CONSTRUCTOR);

	if (contextPtr != NULL) {
	    int result, flags;
	    Tcl_InterpState state;

	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    contextPtr->callPtr->flags |= CONSTRUCTOR;
	    contextPtr->skip = skip;

	    /*
................................................................................

	    if (((Interp*) interp)->ensembleRewrite.sourceObjs) {
		((Interp*) interp)->ensembleRewrite.numInsertedObjs += skip-1;
		((Interp*) interp)->ensembleRewrite.numRemovedObjs += skip-1;
	    }
	    AddRef(oPtr);
	    result = TclOOInvokeContext(interp, contextPtr, objc, objv);
	    flags = oPtr->flags;

	    /*
	     * It's an error if the object was whacked in the constructor.
	     * Force this if it isn't already an error (don't want to lose
	     * errors by accident...)  [Bug 2903011]
	     */







>
>







 







|







 







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







 







<
<
<




>







 







|





>







 







>
>
>
>

<







 







<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
>
|
|







 







|
<
<







 







|
<
<







 







|







 







<







55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
...
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
...
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
...
963
964
965
966
967
968
969



970
971
972
973
974
975
976
977
978
979
980
981
...
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
....
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197

1198
1199
1200
1201
1202
1203
1204
....
1210
1211
1212
1213
1214
1215
1216



1217












1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
....
1355
1356
1357
1358
1359
1360
1361
1362


1363
1364
1365
1366
1367
1368
1369
....
1428
1429
1430
1431
1432
1433
1434
1435


1436
1437
1438
1439
1440
1441
1442
....
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
....
1649
1650
1651
1652
1653
1654
1655

1656
1657
1658
1659
1660
1661
1662
 * Function declarations for things defined in this file.
 */

static Class *		AllocClass(Tcl_Interp *interp, Object *useThisObj,
			    Foundation *fPtr);
static Object *		AllocObject(Foundation *fPtr, Tcl_Interp *interp,
			    const char *nameStr, const char *nsNameStr);
static void		ClearMixins(Class *clsPtr);
static void		ClearSuperclasses(Class *clsPtr);
static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
			    Method *mPtr, Tcl_Obj *namePtr,
			    Method **newMPtrPtr);
static int		CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
			    Method *mPtr, Tcl_Obj *namePtr);
static void		DeletedDefineNamespace(ClientData clientData);
static void		DeletedObjdefNamespace(ClientData clientData);
................................................................................
 */

static void
ObjectRenamedTrace(
    ClientData clientData,	/* The object being deleted. */
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    const char *oldName,	/* What the object was (last) called. */
    const char *newName,	/* What it's getting renamed to. (unused) */
    int flags)			/* Why was the object deleted? */
{
    Object *oPtr = clientData;
    Foundation *fPtr = oPtr->fPtr;

    /*
     * If this is a rename and not a delete of the object, we just flush the
................................................................................
    DelRef(fPtr->objectCls);
    DelRef(oPtr);
}
 
/*
 * ----------------------------------------------------------------------
 *
 * ClearMixins, ClearSuperclasses --
 *
 *	Utility functions for correctly clearing the list of mixins or
 *	superclasses of a class. Will ckfree() the list storage.
 *
 * ----------------------------------------------------------------------
 */

static void
ClearMixins(
    Class *clsPtr)
{
    int i;
    Class *mixinPtr;

    if (clsPtr->mixins.num == 0) {
	return;
    }

    FOREACH(mixinPtr, clsPtr->mixins) {
	TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
    }
    ckfree((char *) clsPtr->mixins.list);
    clsPtr->mixins.list = NULL;
    clsPtr->mixins.num = 0;
}

static void
ClearSuperclasses(
    Class *clsPtr)
{
    int i;
    Class *superPtr;

    if (clsPtr->superclasses.num == 0) {
	return;
    }

    FOREACH(superPtr, clsPtr->superclasses) {
	TclOORemoveFromSubclasses(clsPtr, superPtr);
    }
    ckfree((char *) clsPtr->superclasses.list);
    clsPtr->superclasses.list = NULL;
    clsPtr->superclasses.num = 0;
}
 
/*
 * ----------------------------------------------------------------------
 *
 * ReleaseClassContents --
 *
 *	Tear down the special class data structure, including deleting all
 *	dependent classes and objects.
 *
 * ----------------------------------------------------------------------
 */
................................................................................
    }

    /*
     * Squelch classes that this class has been mixed into.
     */

    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {



	if (!Deleted(mixinSubclassPtr->thisPtr)) {
	    Tcl_DeleteCommandFromToken(interp,
		    mixinSubclassPtr->thisPtr->command);
	}
	ClearMixins(mixinSubclassPtr);
	DelRef(mixinSubclassPtr->thisPtr);
	DelRef(mixinSubclassPtr);
    }
    if (clsPtr->mixinSubs.list != NULL) {
	ckfree((char *) clsPtr->mixinSubs.list);
	clsPtr->mixinSubs.list = NULL;
	clsPtr->mixinSubs.num = 0;
................................................................................
    }

    /*
     * Squelch subclasses of this class.
     */

    FOREACH(subclassPtr, clsPtr->subclasses) {
	if (IsRoot(subclassPtr)) {
	    continue;
	}
	if (!Deleted(subclassPtr->thisPtr)) {
	    Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
	}
	ClearSuperclasses(subclassPtr);
	DelRef(subclassPtr->thisPtr);
	DelRef(subclassPtr);
    }
    if (clsPtr->subclasses.list != NULL) {
	ckfree((char *) clsPtr->subclasses.list);
	clsPtr->subclasses.list = NULL;
	clsPtr->subclasses.num = 0;
................................................................................
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(oPtr->metadataPtr);
	ckfree((char *) oPtr->metadataPtr);
	oPtr->metadataPtr = NULL;
    }

    /*
     * If this was a class, there's additional deletion work to do.
     */

    if (clsPtr != NULL) {

	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	if (clsPtr->metadataPtr != NULL) {
	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
		metadataTypePtr->deleteProc(value);
	    }
................................................................................
	FOREACH(filterObj, clsPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	}
	if (i) {
	    ckfree((char *) clsPtr->filters.list);
	    clsPtr->filters.num = 0;
	}
















	ClearMixins(clsPtr);
	ClearSuperclasses(clsPtr);

	if (clsPtr->subclasses.list) {
	    ckfree((char *) clsPtr->subclasses.list);
	    clsPtr->subclasses.num = 0;
	}
	if (clsPtr->instances.list) {
	    ckfree((char *) clsPtr->instances.list);
	    clsPtr->instances.num = 0;
................................................................................
	if (subPtr == subclsPtr) {
	    goto removeSubclass;
	}
    }
    return;

  removeSubclass:
    if (!Deleted(superPtr->thisPtr)) {


	superPtr->subclasses.num--;
	if (i < superPtr->subclasses.num) {
	    superPtr->subclasses.list[i] =
		    superPtr->subclasses.list[superPtr->subclasses.num];
	}
	superPtr->subclasses.list[superPtr->subclasses.num] = NULL;
    }
................................................................................
	if (subPtr == subclsPtr) {
	    goto removeSubclass;
	}
    }
    return;

  removeSubclass:
    if (!Deleted(superPtr->thisPtr)) {


	superPtr->mixinSubs.num--;
	if (i < superPtr->mixinSubs.num) {
	    superPtr->mixinSubs.list[i] =
		    superPtr->mixinSubs.list[superPtr->mixinSubs.num];
	}
	superPtr->mixinSubs.list[superPtr->mixinSubs.num] = NULL;
    }
................................................................................
     * object cloning only).
     */

    if (objc >= 0) {
	CallContext *contextPtr = TclOOGetCallContext(oPtr,NULL,CONSTRUCTOR);

	if (contextPtr != NULL) {
	    int result;
	    Tcl_InterpState state;

	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    contextPtr->callPtr->flags |= CONSTRUCTOR;
	    contextPtr->skip = skip;

	    /*
................................................................................

	    if (((Interp*) interp)->ensembleRewrite.sourceObjs) {
		((Interp*) interp)->ensembleRewrite.numInsertedObjs += skip-1;
		((Interp*) interp)->ensembleRewrite.numRemovedObjs += skip-1;
	    }
	    AddRef(oPtr);
	    result = TclOOInvokeContext(interp, contextPtr, objc, objv);


	    /*
	     * It's an error if the object was whacked in the constructor.
	     * Force this if it isn't already an error (don't want to lose
	     * errors by accident...)  [Bug 2903011]
	     */

Changes to generic/tclOO.h.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
#ifndef TCLOO_H_INCLUDED
#define TCLOO_H_INCLUDED

/*
 * Must match version at top of ../configure.in
 */

#define TCLOO_VERSION "1.0.2"
#define TCLOO_PATCHLEVEL TCLOO_VERSION

#include "tcl.h"

/*
 * For C++ compilers, use extern "C"
 */






|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
#ifndef TCLOO_H_INCLUDED
#define TCLOO_H_INCLUDED

/*
 * Must match version at top of ../configure.in
 */

#define TCLOO_VERSION "1.0.4"
#define TCLOO_PATCHLEVEL TCLOO_VERSION

#include "tcl.h"

/*
 * For C++ compilers, use extern "C"
 */

Changes to tests/oo.test.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
3431
3432
3433
3434
3435
3436
3437












3438
3439
3440
3441
3442
3443
3444
#
# Copyright (c) 2006-2013 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

package require TclOO 1.0.2 ;# Should match value in configure.in
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
................................................................................
	[info object class appleClass oo::class] \
	[catch { orange }] [info object class orange] \
	[appleClass create pear]
} -cleanup {
    unset -nocomplain result
    fruitMetaclass destroy
} -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear}












 
cleanupTests
return

# Local Variables:
# mode: tcl
# End:






|







 







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







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
....
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
#
# Copyright (c) 2006-2013 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

package require TclOO 1.0.4 ;# Should match value in configure.in
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
................................................................................
	[info object class appleClass oo::class] \
	[catch { orange }] [info object class orange] \
	[appleClass create pear]
} -cleanup {
    unset -nocomplain result
    fruitMetaclass destroy
} -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear}
test oo-35.3 {Bug 593baa032c: superclass list teardown} {
    # Bug makes this crash, especially with mem-debugging on
    oo::class create B {}
    oo::class create D {superclass B}
    namespace eval [info object namespace D] [list [namespace which B] destroy]
} {}
test oo-35.4 {Bug 593baa032c: mixins list teardown} {
    # Bug makes this crash, especially with mem-debugging on
    oo::class create B {}
    oo::class create D {mixin B}
    namespace eval [info object namespace D] [list [namespace which B] destroy]
} {}
 
cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/ooNext2.test.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#
# Copyright (c) 2010-2011 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

package require TclOO 1.0.2 ;# Should match value in configure.in
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {






|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
#
# Copyright (c) 2010-2011 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#

package require TclOO 1.0.4 ;# Should match value in configure.in
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2
    namespace import -force ::tcltest::*
}

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {

Changes to win/TclOO.rc.

2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#define ALPHA	0
#define BETA	1
#define RELEASE	2

LANGUAGE 0x9, 0x2
VS_VERSION_INFO VERSIONINFO
    FILEVERSION		1,0,RELEASE,2
    PRODUCTVERSION	1,0,RELEASE,2
    FILEFLAGSMASK	0x3fL
#ifdef DEBUG
    FILEFLAGS	 	VS_FF_DEBUG
#else
    FILEFLAGS	 	0x0L
#endif
    FILEOS		VOS__WINDOWS32






|
|







2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
#define ALPHA	0
#define BETA	1
#define RELEASE	2

LANGUAGE 0x9, 0x2
VS_VERSION_INFO VERSIONINFO
    FILEVERSION		1,0,RELEASE,4
    PRODUCTVERSION	1,0,RELEASE,4
    FILEFLAGSMASK	0x3fL
#ifdef DEBUG
    FILEFLAGS	 	VS_FF_DEBUG
#else
    FILEFLAGS	 	0x0L
#endif
    FILEOS		VOS__WINDOWS32