From 36ce0578065b95cf12b81e5a4edd95dea5707e22 Mon Sep 17 00:00:00 2001 From: wtschueller Date: Sun, 13 Jul 2014 10:48:31 +0200 Subject: Tcl: add test code for Bug 729092 --- testing/063/namespaceoo.xml | 13 +++++++++ testing/063/namespaceoo_1_1_helpers.xml | 28 +++++++++++++++++++ testing/063/namespaceoo_1_1define.xml | 28 +++++++++++++++++++ testing/063_bug_729092.tcl | 49 +++++++++++++++++++++++++++++++++ 4 files changed, 118 insertions(+) create mode 100644 testing/063/namespaceoo.xml create mode 100644 testing/063/namespaceoo_1_1_helpers.xml create mode 100644 testing/063/namespaceoo_1_1define.xml create mode 100644 testing/063_bug_729092.tcl diff --git a/testing/063/namespaceoo.xml b/testing/063/namespaceoo.xml new file mode 100644 index 0000000..eb0c93c --- /dev/null +++ b/testing/063/namespaceoo.xml @@ -0,0 +1,13 @@ + + + + oo + oo::define + oo::Helpers + + + + + + + diff --git a/testing/063/namespaceoo_1_1_helpers.xml b/testing/063/namespaceoo_1_1_helpers.xml new file mode 100644 index 0000000..5f157c8 --- /dev/null +++ b/testing/063/namespaceoo_1_1_helpers.xml @@ -0,0 +1,28 @@ + + + + oo::Helpers + + + + oo::Helpers::classvar + args + classvar + + + + Extension to TclOO to add static variables. Defines variables on the class instead of on the object. Can be used to enforce a limited number of instantiations. Do not modify! (unless you're waaay smarter than the writer of the below Tcl/Tk book). flynt2012tcl + + + + + + + + + + + + + + diff --git a/testing/063/namespaceoo_1_1define.xml b/testing/063/namespaceoo_1_1define.xml new file mode 100644 index 0000000..50891e6 --- /dev/null +++ b/testing/063/namespaceoo_1_1define.xml @@ -0,0 +1,28 @@ + + + + oo::define + + + + oo::define::classmethod + name?args??body? + classmethod + + + + Extension to TclOO to add static methods. Defines the method on the class instead of on the object. Can be used for the creation of megawidgets using TclOO by overriding the unknown method to detect if the user is trying to instantiate a widget (because the method will be unknown and start with a dot). Do not modify! (unless you're waaay smarter than the writer of the below Tcl/Tk book). flynt2012tcl + + + + + + + + + + + + + + diff --git a/testing/063_bug_729092.tcl b/testing/063_bug_729092.tcl new file mode 100644 index 0000000..7c35f95 --- /dev/null +++ b/testing/063_bug_729092.tcl @@ -0,0 +1,49 @@ +#// objective: test for bug 729092 - TCL: Full documentation not shown for procs in namespaces. +#// check: namespaceoo.xml +#// check: namespaceoo_1_1_helpers.xml +#// check: namespaceoo_1_1define.xml +#// config: EXTRACT_ALL = yes +#// config: GENERATE_HTML = yes + +# taken from +# https://bugzilla.gnome.org/show_bug.cgi?id=729092 + +## +# Extension to TclOO to add static methods. +# Defines the method on the class instead of on the object. Can be used for +# the creation of megawidgets using TclOO by overriding the unknown method to +# detect if the user is trying to instantiate a widget (because the method +# will be unknown and start with a dot). +# @warning Do not modify! (unless you're waaay smarter than the writer of the +# below Tcl/Tk book). +# @cite flynt2012tcl +# +proc ::oo::define::classmethod {name {args ""} {body ""}} { + # Create the method on the class if the caller gave arguments and body. + if {[llength [info level 0]] == 4} { + uplevel 1 [list self method $name $args $body] + } + # Get the name of the class being defined. + set cls [lindex [info level -1] 1] + # Make connection to private class "my" command by forwarding. + uplevel forward $name [info object namespace $cls]::my $name +} + +## +# Extension to TclOO to add static variables. +# Defines variables on the class instead of on the object. Can be used to +# enforce a limited number of instantiations. +# @warning Do not modify! (unless you're waaay smarter than the writer of the +# below Tcl/Tk book). +# @cite flynt2012tcl +# +proc ::oo::Helpers::classvar {args} { + # Get reference to class's namespace. + set nsCl [info object namespace [uplevel 1 {self class}]] + set nsObj [uplevel 1 {namespace current}] + # Link variables into local (caller's) scope. + foreach v $args { + uplevel "my variable $v" + upvar #0 ${nsCl}::$v ${nsObj}::$v + } +} \ No newline at end of file -- cgit v0.12