1 files changed, 176 insertions, 0 deletions
diff --git a/tcllib/modules/oometa/oometa.test b/tcllib/modules/oometa/oometa.test
new file mode 100644
index 0000000..ea9671a
--- /dev/null
+++ b/tcllib/modules/oometa/oometa.test
@@ -0,0 +1,176 @@
+# ooutil.test - Copyright (c) 2014-2015 Andreas Kupries
+
+# -------------------------------------------------------------------------
+
+source [file join \
+	[file dirname [file dirname [file join [pwd] [info script]]]] \
+	devtools testutilities.tcl]
+
+testsNeedTcl     8.5
+testsNeedTcltest 2
+
+testsNeed TclOO 1
+
+testing {
+  useLocal oometa.tcl oo::meta
+  useLocal oooption.tcl oo::option
+}
+
+# -------------------------------------------------------------------------
+# Test properties
+
+oo::class create foo {
+  property color blue
+  
+  constructor args {
+    my _staticInit
+    my configure {*}$args
+  }
+}
+
+oo::class create bar {
+  superclass ::foo
+  property shape oval
+  option color {
+    label Color
+    default green
+  }
+}
+
+test oo-class-meta-001 {Test accessing properties} {
+  foo meta get const color:
+} blue
+
+test oo-class-meta-002 {Test accessing properties} {
+  bar meta get const color:
+} blue
+
+test oo-class-meta-003 {Test accessing properties} {
+  bar meta get const shape:
+} oval
+
+bar create cheers color pink
+# Pulling the meta data from const will return
+# the value specified in the class
+test oo-object-meta-001 {Test accessing properties} {
+  cheers meta get const color:
+} blue
+
+# Accessing the data via cget pulls from the local
+# definition
+test oo-object-meta-001a {Test accessing properties} {
+  cheers meta cget color
+} pink
+# With or without the trailing :
+test oo-object-meta-001b {Test accessing properties} {
+  cheers meta cget color:
+} pink
+# And using the local cget
+test oo-object-meta-001c {Test accessing properties} {
+  cheers cget color
+} pink
+
+test  oo-object-meta-002 {Test accessing properties} {
+  cheers meta get const shape:
+} oval
+
+test  oo-object-meta-003 {Test accessing properties} {
+  cheers cget color
+} pink
+
+bar create moes
+test  oo-object-meta-004 {Test accessing properties} {
+  moes meta get const color:
+} blue
+
+test  oo-object-meta-004a {Test accessing properties} {
+  moes cget color
+} green
+
+test  oo-object-meta-004a {Test accessing properties} {
+  moes cget color:
+} green
+
+test  oo-object-meta-005 {Test accessing properties} {
+  moes meta get const shape:
+} oval
+
+test  oo-object-meta-006 {Test accessing properties} {
+  moes cget color
+} green
+
+test  oo-object-meta-007 {Test the CGET retrieves a property if an option doesn't exist} {
+  moes cget shape
+} oval
+
+###
+# Test altering a property
+###
+
+oo::define ::foo property woozle whoop
+
+test oo-modclass-meta-001 {Test accessing properties of an altered class} {
+  foo meta get const woozle:
+} whoop
+
+test oo-modclass-meta-002 {Test accessing properties of the descendent of an altered class} {
+  bar meta get const woozle:
+} whoop
+
+test oo-modobject-meta-001 {Test the accessing of properties of an instance of an altered class} {
+  moes meta get const woozle:
+} whoop
+
+test obj-meta-for-001 {Test object meta for} {
+  set result {}
+  moes meta for {key value} option {
+    lappend result $key $value
+  }
+  set result
+} {color {label: Color default: green}}
+
+test obj-meta-with-001 {Test object meta with} {
+  set result {}
+  moes meta with option {}
+  set color
+} {label: Color default: green}
+
+test obj-meta-for-001 {Test class meta for} {
+  set result {}
+  bar meta for {key value} option {
+    lappend result $key $value
+  }
+  set result
+} {color {label: Color default: green}}
+
+test obj-meta-with-001 {Test class meta with} {
+  set result {}
+  bar meta with option {}
+  set color
+} {label: Color default: green}
+
+# -------------------------------------------------------------------------
+
+# Test of recursive dicts
+
+oo::class create baz {
+  superclass ::bar
+  meta set option color default: purple  
+}
+
+test obj-meta-recursive-1 {Test that meta set works with recursive dicts} {
+  set result {}
+  baz meta get option color default:
+} {purple}
+
+test obj-meta-recursive-2 {Test that meta set works with recursive dicts} {
+  set result {}
+  baz meta get option color label:
+} {Color}
+
+testsuiteCleanup
+
+# Local variables:
+# mode: tcl
+# indent-tabs-mode: nil
+# End: