# -*- Tcl -*-

package prefer latest

package req nx
package req nx::test

# parameter/variable info reform
#
# /cls/ info configure parameters ?pattern? -> list of params
# /cls/ info configure syntax -> syntax output
#
# /cls/ info method parameters /methodname/ ?/pattern/? -> list of params
# /cls/ info method syntax /methodname/ -> syntax output
# /cls/ info variables ?/pattern/? -> list of variable handles
#
# /obj/ info object method parameters /methodname/ ?/pattern/? -> list of params
# /obj/ info object method syntax  /methodname/ -> syntax output
# /obj/ info object variables ?/pattern/? -> list of variable handles
#
# /obj/ info lookup configure parameters ?/pattern/? -> list of params
# /obj/ info lookup configure syntax -> syntax output
# /obj/ info lookup variables ?/pattern/? -> list of variable handles
#
# Context-free: work on any object, would not need object.
# /obj/ info parameter list|name|syntax /param/ -> value
# /obj/ info variable definition|name|parameter /handle/ -> value
#
nx::test case configure-parameters {
  nx::Class create Person {
    :property name
    :property age:integer
    :public method foo {-force:switch age:integer {name ""}} {return $age}
  }

  ? {join [Person info lookup parameters create] \n} \
"objectName
-age:integer
-name
-object-mixins:mixinreg,slot=::nx::Object::slot::object-mixins,slotset,method=object-mixin,0..n
-object-filters:filterreg,slot=::nx::Object::slot::object-filters,slotset,method=object-filter,0..n
-class:class,alias,method=::nsf::methods::object::class
__initblock:cmd,optional,nodashalnum"

  ? {Person info lookup parameters create age} "-age:integer"
  ? {Person info lookup parameters create {*a[gs]*}} "-age:integer -class:class,alias,method=::nsf::methods::object::class"
  ? {Person info lookup syntax create} "/objectName/ ?-age /integer/? ?-name /value/? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?"

  ? {Person info method parameters foo} {-force:switch age:integer {name ""}}
  ? {Person info method parameters foo force} "-force:switch"
  ? {Person info method parameters foo {*a[gm]*}} {age:integer {name ""}}
  ? {Person info method syntax foo} "/cls/ foo ?-force? /age/ ?/name/?"

  #? {Person info parameter syntax age:integer} "/age/"
  #? {Person info parameter syntax -force:switch} "?-force?"
  #? {Person info parameter name "a b"} "a"

  set emsg [join [list \
                      "wrong # of elements in parameter definition. " \
                      "Should be a list of 1 or 2 elements, but got: ''"] ""]

  foreach subcmd {default syntax type list name} {
    ? [list nsf::parameter::info $subcmd ""] $emsg
  }
  
  ? {nsf::parameter::info syntax age:integer} "/age/"
  ? {nsf::parameter::info syntax -force:switch} "?-force?"
  ? {nsf::parameter::info name "a b"} "a"


  ? {lmap p [Person info lookup parameters create] {nsf::parameter::info default $p}} "0 0 0 0 0 0 0"
  ? {lmap p [Person info method parameters foo] {nsf::parameter::info default $p}} "1 0 1"

  nx::Class create Bar {
    :property {p 9}
  }
  nx::Class create Foo -superclass Bar {
    :property a:integer
    :property {b:integer 123}
    :variable c 456
    :variable d:lower abc
    :variable -accessor public e:lower efg
    :property -accessor private {p 19}
    :property -accessor protected q
    :property -incremental i
    :public method m {} {: -local p get}
    :create f1
  }

  ? {lmap p [Foo info lookup parameters create] {nsf::parameter::info name $p}} \
      "objectName i a b p object-mixins object-filters class __initblock"
  ? {lmap p [Foo info lookup parameters create] {nsf::parameter::info default $p}} \
      "0 0 0 1 1 0 0 0 0"
  ? {lmap p [Foo info lookup parameters create] {nsf::parameter::info type $p}} \
      "{} {} integer integer {} mixinreg filterreg class {}"

  ? {join [lsort [::Foo info slots]] \n} \
"::Foo::slot::____Foo.p
::Foo::slot::a
::Foo::slot::b
::Foo::slot::c
::Foo::slot::d
::Foo::slot::e
::Foo::slot::i
::Foo::slot::q"

  ? {::Foo info lookup parameters create ?} "-i:1..n -a:integer {-b:integer 123} {-p 9}"
  ? {::Foo::slot::b definition} "::Foo property -accessor none {b:integer 123}"
  ? {::Foo::slot::i definition} "::Foo property -accessor public -incremental i:1..n"
  ? {::Foo::slot::____Foo.p definition} "::Foo variable -accessor private p 19"
  ? {::Foo::slot::d definition} "::Foo variable -accessor none d:lower abc"
  ? {::Foo::slot::e definition} "::Foo variable -accessor public e:lower efg"
  ? {::Foo::slot::q definition} "::Foo variable -accessor protected q"

  ? {join [lsort [::f1 info lookup slots]] \n} \
"::Bar::slot::p
::Foo::slot::____Foo.p
::Foo::slot::a
::Foo::slot::b
::Foo::slot::c
::Foo::slot::d
::Foo::slot::e
::Foo::slot::i
::Foo::slot::q
::nx::Object::slot::__initblock
::nx::Object::slot::class
::nx::Object::slot::object-filters
::nx::Object::slot::object-mixins"

  # get the configure value from p and the value of the private property via m
  ? {f1 cget -p} 9
  ? {f1 m} 19
  ? {lsort [f1 info vars]} "__private b c d e p"

  #package require nx::serializer
  #puts stderr [::Foo::slot::____Foo.p serialize]

  ? {llength [::f1 info lookup variables]} 9
  ? {join [lsort [::f1 info lookup variables]] \n} \
"::Bar::slot::p
::Foo::slot::____Foo.p
::Foo::slot::a
::Foo::slot::b
::Foo::slot::c
::Foo::slot::d
::Foo::slot::e
::Foo::slot::i
::Foo::slot::q"

  # One can get 2 values for "lookup variables p"; the private one an
  # the non-private, since both have the same name.  this is necessary
  # to obtain e.g. the definition of the private slot.
  ? {lsort [::f1 info lookup variables p]} "::Bar::slot::p ::Foo::slot::____Foo.p"
  
  ? {llength [::Foo info variables]} 8
  ? {join [lsort [::Foo info variables]] \n} \
"::Foo::slot::____Foo.p
::Foo::slot::a
::Foo::slot::b
::Foo::slot::c
::Foo::slot::d
::Foo::slot::e
::Foo::slot::i
::Foo::slot::q"

  ? {::Foo info variables p} "::Foo::slot::____Foo.p"
  ? {::Foo info slots p} "::Foo::slot::____Foo.p"

  set ::vs [lsort [::Foo info variables]]
  ? {join [lmap handle $::vs {::Foo info variable definition $handle}] \n} \
"::Foo variable -accessor private p 19
::Foo property -accessor none a:integer
::Foo property -accessor none {b:integer 123}
::Foo variable -accessor none c 456
::Foo variable -accessor none d:lower abc
::Foo variable -accessor public e:lower efg
::Foo property -accessor public -incremental i:1..n
::Foo variable -accessor protected q"

  set ::ps [lmap handle $::vs {::Foo info variable parameter $handle}]

  ? {join $::ps \n} \
"p 19
a:integer
b:integer 123
c 456
d:lower abc
e:lower efg
i:1..n
q"

  ? {lmap handle $::vs {::Foo info variable name $handle}} \
    "__private(::Foo,p) a b c d e i q"

  ? {lmap handle $::ps {nsf::parameter::info name $handle}} \
    "p a b c d e i q"
  ? {lmap handle $::ps {nsf::parameter::info default $handle}} \
    "1 0 1 1 1 1 0 0"
  ? {lmap handle $::ps {nsf::parameter::info type $handle}} \
    "{} integer integer {} lower lower {} {}"

  ? {nsf::parameter::info default "b:integer 123" ::var1} "1"
  ? {set ::var1} "123"

  ? {nsf::parameter::info default "b:integer 123" ::var2} "1"
  ? {set ::var2} "123"

}

nx::test case object-variables {
  nx::Class create Bar {
    :property {p 9}
  }
  nx::Class create Foo -superclass Bar {
    :property a:integer
    :property {b:integer 123}
    :variable c 456
    :variable d:lower abc
    :variable -accessor public e:lower efg
    :property -accessor private {p 19}
    :property -accessor protected q
    :property -incremental i
    :public method m {} {: -local p}
    :create f1
  }

  Foo create f2 {
    :object property 			oa:integer
    :object property 			{ob:integer 123}
    :object variable 			oc 456   	 ;# NO slot
    :object variable 			od:lower abc	 ;# NO slot
    :object variable -accessor public 	oe:lower efg
    :object property -incremental 	oi
    :object property -accessor private	{op 19}
    :object property -accessor protected	oq
    :public object method om {} {: -local p}
  }

  set ::ovs [lsort [::f2 info object variables]]

  ? {llength $::ovs} "6"   ;# oc, od missing
  ? {join $::ovs "\n"} \
"::f2::per-object-slot::____f2.op
::f2::per-object-slot::oa
::f2::per-object-slot::ob
::f2::per-object-slot::oe
::f2::per-object-slot::oi
::f2::per-object-slot::oq"


  ? {join [lmap handle $::ovs {::f2 info variable definition $handle}] \n} \
"::f2 object variable -accessor private op 19
::f2 object property -accessor none oa:integer
::f2 object property -accessor none {ob:integer 123}
::f2 object variable -accessor public oe:lower efg
::f2 object property -accessor public -incremental oi:1..n
::f2 object variable -accessor protected oq"

  ? {lmap handle $::ovs {::f2 info variable parameter $handle}} \
    "{op 19} oa:integer {ob:integer 123} {oe:lower efg} oi:1..n oq"
  ? {lmap handle $::ovs {::f2 info variable name $handle}} \
    "__private(::f2,op) oa ob oe oi oq"


  set ::ovs [lsort [::f2 info lookup variables]]
  ? {llength $::ovs} "15"   ;# oc, od missing
  ? {join $::ovs "\n"} \
"::Bar::slot::p
::Foo::slot::____Foo.p
::Foo::slot::a
::Foo::slot::b
::Foo::slot::c
::Foo::slot::d
::Foo::slot::e
::Foo::slot::i
::Foo::slot::q
::f2::per-object-slot::____f2.op
::f2::per-object-slot::oa
::f2::per-object-slot::ob
::f2::per-object-slot::oe
::f2::per-object-slot::oi
::f2::per-object-slot::oq"

  # redefine property a on the object level
  ::f2 object property -accessor none a:integer

  set ::ovs [lsort [::f2 info lookup variables]]
  ? {llength $::ovs} "15"   ;# oc, od missing
  ? {join $::ovs "\n"} \
"::Bar::slot::p
::Foo::slot::____Foo.p
::Foo::slot::b
::Foo::slot::c
::Foo::slot::d
::Foo::slot::e
::Foo::slot::i
::Foo::slot::q
::f2::per-object-slot::____f2.op
::f2::per-object-slot::a
::f2::per-object-slot::oa
::f2::per-object-slot::ob
::f2::per-object-slot::oe
::f2::per-object-slot::oi
::f2::per-object-slot::oq"

}

#
# Local variables:
#    mode: tcl
#    tcl-indent-level: 2
#    indent-tabs-mode: nil
# End: