Index: Makefile.in
===================================================================
diff -u -r88fcf6ba94c9eea2caff8238f891d127b63e8093 -r471c9589c601e576f2bc5f3e2dd4c554a0ceee1c
--- Makefile.in (.../Makefile.in) (revision 88fcf6ba94c9eea2caff8238f891d127b63e8093)
+++ Makefile.in (.../Makefile.in) (revision 471c9589c601e576f2bc5f3e2dd4c554a0ceee1c)
@@ -512,6 +512,7 @@
$(TCLSH) $(src_test_dir_native)/interp.test -libdir $(PLATFORM_DIR) $(TESTFLAGS)
$(TCLSH) $(src_test_dir_native)/serialize.test -libdir $(PLATFORM_DIR) $(TESTFLAGS)
$(TCLSH) $(src_test_dir_native)/plain-object-method.test -libdir $(PLATFORM_DIR) $(TESTFLAGS)
+ $(TCLSH) $(src_test_dir_native)/class-method.test -libdir $(PLATFORM_DIR) $(TESTFLAGS)
$(TCLSH) $(src_doc_dir_native)/example-scripts/bagel.tcl -libdir $(PLATFORM_DIR) $(TESTFLAGS)
$(TCLSH) $(src_doc_dir_native)/example-scripts/container.tcl -libdir $(PLATFORM_DIR) $(TESTFLAGS)
$(TCLSH) $(src_doc_dir_native)/example-scripts/rosetta-abstract-type.tcl -libdir $(PLATFORM_DIR) $(TESTFLAGS)
Index: TODO
===================================================================
diff -u -r199e95f5c3774fc56dfb85a47f99c0b8141bf29e -r471c9589c601e576f2bc5f3e2dd4c554a0ceee1c
--- TODO (.../TODO) (revision 199e95f5c3774fc56dfb85a47f99c0b8141bf29e)
+++ TODO (.../TODO) (revision 471c9589c601e576f2bc5f3e2dd4c554a0ceee1c)
@@ -4556,17 +4556,21 @@
nx::configure plain-object-method-warning on|off
- completed coverage and test cases
+package nx::class-method:
+- convenience package similar to nx::plain-object-method
+- allow for usage "C class method ..." in addition to
+ "C object method".
+- made warnings configurable via
+ nx::configure class-method-warning on|off
+- completed coverage and test cases
+
========================================================================
TODO:
- reconsider
#? {c1 cget -mixin} ""
? {c1 cget -object-mixin} ""
-- test cases
- complete coverage tests/plain-object-method.test
- provide coverage tests/class.test
-
- reconsider lower multiplicty on
-object-mixin, -mixin...
Index: library/nx/class-method.tcl
===================================================================
diff -u -r377258585e6d0715ad1da6430c833f6f346326f7 -r471c9589c601e576f2bc5f3e2dd4c554a0ceee1c
--- library/nx/class-method.tcl (.../class-method.tcl) (revision 377258585e6d0715ad1da6430c833f6f346326f7)
+++ library/nx/class-method.tcl (.../class-method.tcl) (revision 471c9589c601e576f2bc5f3e2dd4c554a0ceee1c)
@@ -1,74 +1,118 @@
package provide nx::class-method 1.0
+#
+# Provide a convenience layer to class methods/variables by using
+# "class method" rather than "object method". This reflects the naming
+# conventions of NX 2.0b4 and earlier. By using this package, one can
+# use instead of
+#
+# nx::Class create C {
+# :public object method foo args {....}
+# :object property p:integer
+# :object mixin add M
+# #...
+# puts [:info object methods]
+# }
+#
+# a terminology closer to text book vocabulary
+#
+# package require nx::class-method
+#
+# nx::Object create o {
+# :public class method foo args {....}
+# :class property p:integer
+# :class mixin add M
+# #...
+# puts [:class info methods]
+# }
+#
+# Note that for object specific methods of object, have still to be
+# defined via "object method" etc. (see also package
+# nx::plain-object-method).
+#
+
+#
+# make "class" an accepted method defining method
+#
namespace eval ::nsf {
array set ::nsf::methodDefiningMethod {
class 1
}
}
namespace eval ::nx {
- nx::Class eval {
- :public alias "class method" ::nx::Object::slot::__object::method
-
- :public alias "class alias" ::nx::Object::slot::__object::alias
- :public alias "class forward" ::nx::Object::slot::__object::forward
- #:public method "class forward" args {
- # puts stderr "CLASS CMD: [self] [current method] [current args]"
- # :public object forward {*}$args
- #}
-
- :public alias "class info" ::nx::Object::slot::__info
-
- :public method "class filter" args {
- set what filter
- switch [llength $args] {
- 0 {return [::nsf::relation [::nsf::self] object-$what]}
- 1 {return [::nsf::relation [::nsf::self] object-$what {*}$args]}
- default {return [::nx::Object::slot::$what [lindex $args 0] \
- [::nsf::self] object-$what \
- {*}[lrange $args 1 end]]
+ #
+ # Define a method to allow configuration for tracing of the
+ # convenience methods. Use
+ #
+ # nx::configure class-method-warning on|off
+ #
+ # for activation/deactivation of tracing. This might be
+ # useful for porting legacy NX programs or for testing
+ # default-configuration compliance.
+ #
+ nx::configure public object method class-method-warning {onoff:boolean,optional} {
+ if {[info exists onoff]} {
+ set :class-method-warning $onoff
+ } else {
+ if {[info exists :class-method-warning]} {
+ if {${:class-method-warning}} {
+ uplevel {::nsf::log warn "class method: [self] [current method] [current args]"}
}
}
}
- :public method "class mixin" args {
- set what mixin
- switch [llength $args] {
- 0 {return [::nsf::relation [::nsf::self] object-$what]}
- 1 {return [::nsf::relation [::nsf::self] object-$what {*}$args]}
- default {return [::nx::Object::slot::$what [lindex $args 0] \
- [::nsf::self] object-$what \
- {*}[lrange $args 1 end]]
- }
- }
- }
- :public alias "class filterguard" ::nsf::methods::object::filterguard
- :public alias "class mixinguard" ::nsf::methods::object::mixinguard
-
}
- #
- # provide aliases for "class property" and "class variable"
- #
- ::nx::Class eval {
- :alias "class property" ::nsf::classes::nx::Object::property
- :alias "class variable" ::nsf::classes::nx::Object::variable
- }
- #
- # provide aliases for "class delete"
- #
- ::nx::Class eval {
- :alias "class delete property" ::nx::Object::slot::__delete::property
- :alias "class delete variable" ::nx::Object::slot::__delete::variable
- :alias "class delete method" ::nx::Object::slot::__delete::method
+ nx::Class eval {
+
+ #
+ # Definitions redirected to "object"
+ #
+ foreach m {
+ alias
+ filter
+ forward
+ method
+ mixin
+ property
+ variable
+ } {
+ :public method "class $m" {args} {
+ nx::configure class-method-warning
+ :object [current method] {*}[current args]
+ }
+ }
+
+ #
+ # info subcommands
+ #
+ foreach m {
+ method methods slots variables
+ "filter guards" "filter methods"
+ "mixin guards" "mixin classes"
+ } {
+ :public method "class info $m" {args} [subst -nocommands {
+ nx::configure class-method-warning
+ :info object $m {*}[current args]
+ }]
+ }
}
#
- # info redirector
+ # Deletions
#
- ::nx::Class eval {
- :alias "class info" ::nx::Object::slot::__info
+ foreach m {
+ property
+ variable
+ method
+ } {
+ nx::Class public method "class delete $m" {args} {
+ nx::configure class-method-warning
+ :delete object [current method] {*}[current args]
+ }
}
+
######################################################################
# Provide method "require"
######################################################################
@@ -77,13 +121,15 @@
# method require, base cases
#
:method "require class method" {methodName} {
+ nx::configure class-method-warning
::nsf::method::require [::nsf::self] $methodName 1
return [:info lookup method $methodName]
}
#
# method require, public explicitly
#
:method "require public class method" {methodName} {
+ nx::configure class-method-warning
set result [:require class method $methodName]
::nsf::method::property [self] $result call-protected false
return $result
@@ -92,6 +138,7 @@
# method require, protected explicitly
#
:method "require protected class method" {methodName} {
+ nx::configure class-method-warning
set result [:require class method $methodName]
::nsf::method::property [self] $result call-protected true
return $result
@@ -100,6 +147,7 @@
# method require, private explicitly
#
:method "require private class method" {methodName} {
+ nx::configure class-method-warning
set result [:require class method $methodName]
::nsf::method::property [self] $result call-private true
return $result
Index: library/nx/plain-object-method.tcl
===================================================================
diff -u -r199e95f5c3774fc56dfb85a47f99c0b8141bf29e -r471c9589c601e576f2bc5f3e2dd4c554a0ceee1c
--- library/nx/plain-object-method.tcl (.../plain-object-method.tcl) (revision 199e95f5c3774fc56dfb85a47f99c0b8141bf29e)
+++ library/nx/plain-object-method.tcl (.../plain-object-method.tcl) (revision 471c9589c601e576f2bc5f3e2dd4c554a0ceee1c)
@@ -1,5 +1,34 @@
package provide nx::plain-object-method 1.0
+#
+# Provide a convenience layer to define/introspect object specific
+# methods without having to use the "object" modifier. By using this
+# package, one can use instead of
+#
+# nx::Object create o {
+# :public object method foo args {....}
+# :object property p:integer
+# :object mixin add M
+# #...
+# puts [:info object methods]
+# }
+#
+# simply
+#
+# package require nx::plain-object-method
+#
+# nx::Object create o {
+# :public method foo args {....}
+# :property p:integer
+# :mixin add M
+# #...
+# puts [:info methods]
+# }
+#
+# Note that for object specific methods of classes, one has still to
+# use "object method" etc. (see also package nx::plass-method).
+#
+
namespace eval ::nx {
#
@@ -8,7 +37,9 @@
#
# nx::configure plain-object-method-warning on|off
#
- # for activation/deactivation of tracing
+ # for activation/deactivation of tracing. This might be
+ # useful for porting legacy NX programs or for testing
+ # default-configuration compliance.
#
nx::configure public object method plain-object-method-warning {onoff:boolean,optional} {
if {[info exists onoff]} {
@@ -27,17 +58,26 @@
#
# Definitions redirected to "object"
#
- foreach m {alias filter forward method mixin property variable} {
+ foreach m {
+ alias
+ filter
+ forward
+ method
+ mixin
+ property
+ variable
+ } {
:public method $m {args} {
nx::configure plain-object-method-warning
:object [current method] {*}[current args]
}
}
#
- # info subcmmands
+ # info subcommands
#
- foreach m {method methods slots variables
+ foreach m {
+ method methods slots variables
"filter guards" "filter methods"
"mixin guards" "mixin classes"
} {
@@ -47,6 +87,20 @@
}]
}
+ #
+ # deletions for object
+ #
+ foreach m {
+ "property"
+ "variable"
+ "method"
+ } {
+ nx::Object public method "delete $m" {args} {
+ nx::configure plain-object-method-warning
+ :delete object [current method] {*}[current args]
+ }
+ }
+
}
Index: tests/class-method.test
===================================================================
diff -u
--- tests/class-method.test (revision 0)
+++ tests/class-method.test (revision 471c9589c601e576f2bc5f3e2dd4c554a0ceee1c)
@@ -0,0 +1,124 @@
+# -*- Tcl -*-
+package require nx::test
+
+#
+# The first test series without the conveniance layer
+#
+nx::Test case class-methods-0 {
+ nx::Class create M1
+ nx::Class create C {
+ ? {::C public class method foo {} {return foo}} "'class' is not a method defining method"
+ :public object method f args {next}
+ }
+ ? {::C class mixin M1} \
+ "method 'class' unknown for ::C; consider '::C create class mixin M1' instead of '::C class mixin M1'"
+ ? {::C class filter f} \
+ "method 'class' unknown for ::C; consider '::C create class filter f' instead of '::C class filter f'"
+
+ ? {lsort [::C info object methods]} "f"
+ ? {lsort [::C info]} \
+ "valid submethods of ::C info: children class configure filter has heritage info instances lookup method methods mixin mixinof name object parameter parent precedence slots subclass superclass variable variables vars"
+}
+
+#
+# require the conveniance layer
+# and make it verbose
+#
+package require nx::class-method
+nx::configure class-method-warning on
+
+
+nx::Test case class-methods-1 {
+ nx::Class create M1
+ nx::Class create ::C {
+ :public class method foo {} {return [:pm1]}
+ :public class method f args {next}
+ :protected class method pm1 args {return pm1}
+ :public class alias a ::C::pm1
+ :public class forward fwd %self pm1
+ :private class method priv args {return priv}
+ :class method pm2 args {return pm2}
+ :class property -accessor public p
+ :class variable v1 1
+ :class variable -incremental v2:integer 1
+ #
+ # public, protected, private
+ # alias, forward
+ #
+ }
+ ? {::C info object methods} "v2 p foo fwd a f"
+ ? {lsort [::C info object methods -callprotection protected]} "per-object-slot pm1 pm2"
+ ? {lsort [::C info object methods -callprotection private]} "priv"
+
+ ? {::C class info methods} "v2 p foo fwd a f"
+ ? {lsort [::C class info methods -callprotection protected]} "per-object-slot pm1 pm2"
+ ? {lsort [::C class info methods -callprotection private]} "priv"
+
+ ? {::C class info variables} "::C::per-object-slot::v2 ::C::per-object-slot::p"
+ ? {::C info object variables} "::C::per-object-slot::v2 ::C::per-object-slot::p"
+ ? {::C class info slots} "::C::per-object-slot::v2 ::C::per-object-slot::p"
+
+ ? {::C pm1} \
+ "method 'pm1' unknown for ::C; consider '::C create pm1 ' instead of '::C pm1 '"
+ ? {::C foo} "pm1"
+ ? {::C a} "pm1"
+ ? {::C fwd} "pm1"
+
+ ? {::C class mixin M1} ::M1
+ ? {::C class info mixin classes} ::M1
+ ? {::C class mixin ""} ""
+ ? {::C class info mixin classes} ""
+
+ ? {::C class filter f} f
+ ? {::C class info filter methods} f
+ ? {::C class filter ""} ""
+ ? {::C class info filter methods} ""
+
+ ? {lsort [::C info object methods]} "a f foo fwd p v2"
+ ? {lsort [::C info]} \
+ "valid submethods of ::C info: children class configure filter has heritage info instances lookup method methods mixin mixinof name object parameter parent precedence slots subclass superclass variable variables vars"
+}
+
+#
+# delete class method, class property, class variable
+#
+nx::Test case class-methods-2 {
+ nx::Class create ::C {
+ :public class method foo {} {return foo}
+ :class property -accessor public p
+ :class variable -incremental v1:integer 1
+ }
+
+ ? {C class info methods} "p foo v1"
+ ? {C class info variables} "::C::per-object-slot::p ::C::per-object-slot::v1"
+
+ ? {C class delete method foo} ""
+ ? {C class info methods} "p v1"
+ ? {C class info variables} "::C::per-object-slot::p ::C::per-object-slot::v1"
+
+ ? {C class delete property p} ""
+ ? {C class info methods} "v1"
+ ? {C class info variables} "::C::per-object-slot::v1"
+
+ ? {C class delete variable v1} ""
+ ? {C class info methods} ""
+ ? {C class info variables} ""
+
+}
+
+#
+# require method
+#
+
+nx::Test case class-methods-2 {
+
+ nsf::method::provide set {::nsf::method::alias set -frame object ::set}
+
+ nx::Class create ::C {
+ :require class method set
+ }
+
+ ? {C class info methods} "set"
+ ? {C info object methods} "set"
+
+}
\ No newline at end of file
Index: tests/plain-object-method.test
===================================================================
diff -u -r199e95f5c3774fc56dfb85a47f99c0b8141bf29e -r471c9589c601e576f2bc5f3e2dd4c554a0ceee1c
--- tests/plain-object-method.test (.../plain-object-method.test) (revision 199e95f5c3774fc56dfb85a47f99c0b8141bf29e)
+++ tests/plain-object-method.test (.../plain-object-method.test) (revision 471c9589c601e576f2bc5f3e2dd4c554a0ceee1c)
@@ -35,10 +35,6 @@
:property -accessor public p
:variable v1 1
:variable -incremental v2:integer 1
- #
- # public, protected, private
- # alias, forward
- #
}
? {o info methods} "v2 p foo fwd a f"
? {lsort [o info methods -callprotection protected]} "per-object-slot pm1 pm2"
@@ -66,3 +62,47 @@
? {lsort [o info object methods]} "a f foo fwd p v2"
? {lsort [o info]} "valid submethods of ::o info: children class filter has info lookup method methods mixin name object parameter parent precedence slots variable variables vars"
}
+
+#
+# delete class method, class property, class variable
+#
+nx::Test case plain-methods-2 {
+ nx::Object create ::o {
+ :public method foo {} {return foo}
+ :property -accessor public p
+ :variable -incremental v1:integer 1
+ }
+
+ ? {o info methods} "p foo v1"
+ ? {o info variables} "::o::per-object-slot::p ::o::per-object-slot::v1"
+
+ ? {o delete method foo} ""
+ ? {o info methods} "p v1"
+ ? {o info variables} "::o::per-object-slot::p ::o::per-object-slot::v1"
+
+ ? {o delete property p} ""
+ ? {o info methods} "v1"
+ ? {o info variables} "::o::per-object-slot::v1"
+
+ ? {o delete variable v1} ""
+ ? {o info methods} ""
+ ? {o info variables} ""
+
+}
+
+#
+# require method
+#
+
+nx::Test case plain-methods-3 {
+
+ nsf::method::provide set {::nsf::method::alias set -frame object ::set}
+
+ nx::Object create ::o {
+ :require method set
+ }
+
+ ? {::o info methods} "set"
+ ? {::o info object methods} "set"
+
+}
\ No newline at end of file