diff options
author | Steve Bennett <steveb@workware.net.au> | 2016-03-24 20:50:23 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2016-03-27 11:01:48 +1000 |
commit | 45c9e90f3956ae5b8e561be046153bcb6ffc0985 (patch) | |
tree | 05994e1aed852670a235fd7bce0d22c5d81ef235 | |
parent | bd25a29a3766bcf9327c8c8d032d0bb773ca4e6a (diff) | |
download | jimtcl-45c9e90f3956ae5b8e561be046153bcb6ffc0985.zip jimtcl-45c9e90f3956ae5b8e561be046153bcb6ffc0985.tar.gz jimtcl-45c9e90f3956ae5b8e561be046153bcb6ffc0985.tar.bz2 |
oo: constructor, unknown and bug fixes
- Added support for constructor, runs on new object creation
- Added support for "unknown" method
- Rename some dispatch variables (add double underscore) to avoid collision with user variables
Signed-off-by: Steve Bennett <steveb@workware.net.au>
-rw-r--r-- | README.oo | 14 | ||||
-rw-r--r-- | examples/ootest.tcl | 17 | ||||
-rw-r--r-- | oo.tcl | 26 |
3 files changed, 47 insertions, 10 deletions
@@ -100,6 +100,18 @@ on a specific object. the instance variables, and evaluate the body in that context. This can be used for one-off evaluation to avoid declaring a method. +RESERVED METHODS +---------------- +The following methods are special + + constructor:: + If this method exists, it is invoked (with no arguments) after an object is created + + unknown methodname ...:: + If an undefined method is invoked, and this method exists, it is called with the methodname + and the original arguments + + CREATING OBJECTS ---------------- An object is created with the 'new' method, or simply by using the classname shortcut. @@ -120,6 +132,8 @@ For example: . $b get balance 1000 +If the 'constructor' method exists, it is invoked just after the object is created + DECLARING METHODS ----------------- In addition to the predefined methods, new methods may be declared, or existing diff --git a/examples/ootest.tcl b/examples/ootest.tcl index d3d48c3..731e46a 100644 --- a/examples/ootest.tcl +++ b/examples/ootest.tcl @@ -13,6 +13,14 @@ puts "Account vars=[Account vars]" puts "Account methods=[Account methods]" puts "" +# Create a constructor. This does validation, but it could +# do other things +Account method constructor {} { + if {$balance < 0} { + error "Can't initialise account with a -ve balance" + } +} + # Now flesh out the class with some methods # Could use 'Account method' here instead Account method deposit {amount} { @@ -57,10 +65,17 @@ $a describe puts "" # Now create a new subclass +# Could change the initial balance here too class CreditAccount Account { limit -1000 - balance -20 } + +CreditAccount method constructor {} { + # Dummy constructor + # If desired, manually invoke the baseclass constructor + super constructor +} + # Override the 'withdraw' method to allow overdrawing CreditAccount method withdraw {amount} { if {$balance - $amount < $limit} {error "Sorry $name, that would exceed your credit limit of [expr -$limit]"} @@ -41,18 +41,26 @@ proc class {classname {baseclasses {}} classvars} { # This is the object dispatcher for $classname. # Store the classname in both the ref value and tag, for debugging # ref tag (for debugging) - proc [ref $classname $classname "$classname finalize"] {method args} {classname instvars} { + set obj [ref $classname $classname "$classname finalize"] + proc $obj {method args} {classname instvars} { if {![exists -command "$classname $method"]} { - return -code error "$classname, unknown method \"$method\": should be [join [$classname methods] ", "]" + if {![exists -command "$classname unknown"]} { + return -code error "$classname, unknown method \"$method\": should be [join [$classname methods] ", "]" + } + return ["$classname unknown" $method {*}$args] } "$classname $method" {*}$args } + if {[exists -command "$classname constructor"]} { + $obj constructor + } + return $obj } # Finalizer to invoke destructor during garbage collection proc "$classname finalize" {ref classname} { $ref destroy } # Method creator - proc "$classname method" {method arglist body} classname { - proc "$classname $method" $arglist {body} { + proc "$classname method" {method arglist __body} classname { + proc "$classname $method" $arglist {__body} { # Make sure this isn't incorrectly called without an object if {![uplevel exists instvars]} { return -code error -level 2 "\"[lindex [info level 0] 0]\" method called with no object" @@ -60,9 +68,9 @@ proc class {classname {baseclasses {}} classvars} { set self [lindex [info level -1] 0] # Note that we can't use 'dict with' here because # the dict isn't updated until the body completes. - foreach _ [$self vars] {upvar 1 instvars($_) $_} - unset _ - eval $body + foreach __ [$self vars] {upvar 1 instvars($__) $__} + unset __ + eval $__body } } # Other simple class procs @@ -77,9 +85,9 @@ proc class {classname {baseclasses {}} classvars} { # Pre-defined some instance methods $classname method destroy {} { rename $self "" } $classname method get {var} { set $var } - $classname method eval {{locals {}} code} { + $classname method eval {{locals {}} __code} { foreach var $locals { upvar 2 $var $var } - eval $code + eval $__code } return $classname } |