diff options
| -rw-r--r-- | examples/ootest.tcl | 2 | ||||
| -rw-r--r-- | oo.tcl | 6 |
2 files changed, 6 insertions, 2 deletions
diff --git a/examples/ootest.tcl b/examples/ootest.tcl index d04951e..d3d48c3 100644 --- a/examples/ootest.tcl +++ b/examples/ootest.tcl @@ -59,6 +59,7 @@ puts "" # Now create a new subclass class CreditAccount Account { limit -1000 + balance -20 } # Override the 'withdraw' method to allow overdrawing CreditAccount method withdraw {amount} { @@ -85,6 +86,7 @@ set b [CreditAccount new {name "John White"}] puts b.vars=[$b vars] puts b.classname=[$b classname] +puts "initial balance -> [$b see]" $b deposit 100 puts "deposit 100 -> [$b see]" @@ -10,16 +10,18 @@ # The *last* baseclass can be accessed directly with [super] # Later baseclasses take precedence if the same method exists in more than one proc class {classname {baseclasses {}} classvars} { + set baseclassvars {} foreach baseclass $baseclasses { # Start by mapping all methods to the parent class foreach method [$baseclass methods] { alias "$classname $method" "$baseclass $method" } # Now import the base class classvars - set classvars [dict merge $classvars [$baseclass classvars]] + set baseclassvars [dict merge $baseclassvars [$baseclass classvars]] # The last baseclass will win here proc "$classname baseclass" {} baseclass { return $baseclass } } - # Make sure that classvars is a dictionary + # Merge in the baseclass vars with lower precedence + set classvars [dict merge $baseclassvars $classvars] set vars [lsort [dict keys $classvars]] # This is the class dispatcher for $classname |