# -*- Tcl -*-

package prefer latest

package require nx
package require nx::test

#::nx::configure defaultMethodCallProtection false

set objectFilter "-object-filters:filterreg,slot=::nx::Object::slot::object-filters,slotset,method=object-filter,0..n"
set objectMixin "-object-mixins:mixinreg,slot=::nx::Object::slot::object-mixins,slotset,method=object-mixin,0..n"
set initBlock "__initblock:cmd,optional,nodashalnum"
set filter "-filters:filterreg,slot=::nx::Class::slot::filters,slotset,method=class-filter,0..n"

set ::trailer "$objectMixin $objectFilter -class:class,alias,method=::nsf::methods::object::class $initBlock"


nx::test case dummy {
  ? {::namespace current} ::
  set o [Object create o]

  ? {::nsf::object::exists ::o} 1
}
? {::nsf::object::exists ::o} 0

#
# simple test case for parameter passing
#
nx::test case syntax {
  ::nx::Class create C

  ? {::nsf::method::alias C} \
      {required argument 'methodName' is missing, should be:
        ::nsf::method::alias /object/ ?-per-object? /methodName/ ?-frame method|object|default? ?-protection call-protected|redefine-protected|none? /cmdName/}

  ? {::nsf::method::alias C foo ::set} "::nsf::classes::C::foo"

  ? {::nsf::method::alias C foo ::set 1} \
      {invalid argument '1', maybe too many arguments; should be "::nsf::method::alias /object/ ?-per-object? /methodName/ ?-frame method|object|default? ?-protection call-protected|redefine-protected|none? /cmdName/"}

  ? {C eval {:property x -class D}} {invalid argument 'D', maybe too many arguments; should be "::C property ?-accessor /value/? ?-class /value/? ?-configurable /boolean/? ?-incremental? ?-trace /value/? /spec/ ?/initblock/?"} "Test whether the colon prefix is suppressed"
}

#######################################################
# parametercheck
#######################################################
nx::test configure -count 1000
nx::test case parametercheck {

  nx::Object create o1
  nx::Class create C {
    :property a
    :property {b:boolean}
    :property {c 1}
  }
  C create c1
  nx::Class create M
  c1 object mixins set M

  ? {::nsf::object::exists o1} 1
  ? {::nsf::object::exists o1000} 0

  ? {::nsf::is class C} 1
  ? {C info has type ::nx::Class} 1

  ? {::nsf::is baseclass ::nx::Object} 1
  #? {::nx::Object info is baseclass} 1
  ? {::nsf::is baseclass C} 0
  #? {C info is baseclass} 0

  ? {::nsf::is class ::nx::Object} 1
  ? {::nsf::is ::nx::Object class} {invalid value constraints "::nx::Object"}

  ? {::nsf::is object o1} 1
  ? {::nsf::is object o1} 1
  ? {::nsf::is object o1000} 0
  ? {::nsf::is -complain object o1000} {expected object but got "o1000"}
  ? {::nsf::is integer 1} 1
  ? {::nsf::is object,type=::C c1} 1
  ? {::nsf::is -complain object,type=::C o} {expected object but got "o"}
  ? {::nsf::is object,type=::C o} 0

  ? {c1 info has mixin ::M} 1
  ? {c1 info has mixin ::M1} {expected class but got "::M1" for parameter "class"}

  ? {c1 info has type C} 1
  ? {c1 info has type C1} {expected class but got "C1" for parameter "class"}

  ? {c1 ::nsf::methods::object::info::hastype C} 1
  ? {::nsf::dispatch c1 ::nsf::methods::object::info::hastype C} 1

  ? {::nsf::is object o1} 1
  ? {::nsf::is object o100} 0
  ? {::nsf::is integer 1} 1
  ? {::nsf::is object,type=::C c1} 1
  ? {::nsf::is object,type=::C o} 0

  # test built-in converter via ::nsf::is
  ? {::nsf::is boolean 1} 1
  ? {::nsf::is boolean on} 1
  ? {::nsf::is boolean true} 1
  ? {::nsf::is boolean t} 1
  ? {::nsf::is boolean f} 1
  ? {::nsf::is boolean a} 0

  ? {::nsf::is integer 0x0} 1
  ? {::nsf::is integer 0xy} 0

  # built in converter, but not allowed
  ? {::nsf::is switch 1} {invalid value constraints "switch": invalid parameter type "switch" for argument "value"; type "switch" only allowed for non-positional arguments}
  ? {::nsf::is superclass M} {invalid value constraints "superclass"}

  # don't allow convert;
  # well we have to allow it, since "-returns" uses the same mechanism
  #? {::nsf::is integer,convert 1} {invalid value constraints "integer,convert"}

  # tcl checker
  ? {::nsf::is upper ABC} 1
  ? {::nsf::is upper Abc} 0
  ? {::nsf::is lower Abc} 0
  ? {::nsf::is lower abc} 1

  #? {::nsf::is type c1 C} 1
  #? {::nsf::is type o C} 0
  #? {::nsf::is object o -type C} 0
  #? {::nsf::is object o -hasmixin C} 0

  # scripted checker
  ? {::nsf::is metaclass ::nx::Class} 1
  ? {::nsf::is metaclass ::nx::Object} 0

  ? {::nsf::is -complain class o1} {expected class but got "o1"}
  ? {::nsf::is class o1} 0
  ? {::nsf::is -complain class nx::test} 1
  ? {::nsf::is -complain object,1..* [list o1 nx::test]} 1

  ? {::nsf::is -complain integer,1..* [list 1 2 3]} 1
  ? {::nsf::is -complain integer,1..* [list 1 2 3 a]} \
      {invalid value in "1 2 3 a": expected integer but got "a"}
  ? {::nsf::is -complain object,type=::C c1} 1
  ? {::nsf::is -complain object,type=::C o} \
      {expected object but got "o"} \
      "object, but different type"
  ? {::nsf::is -complain object,type=::C c} \
      {expected object but got "c"} \
      "no object"
  ? {::nsf::is -complain object,type=::nx::Object c1} 1 "general type"

  # do not allow "currently unknown" user defined types in parametercheck
  ? {::nsf::is -complain in1 aaa} {invalid value constraints "in1"}

  ? {::nsf::is -complain lower c} 1 "lowercase char"
  ? {::nsf::is -complain lower abc} 1 "lowercase chars"
  ? {::nsf::is -complain lower Abc} {expected lower but got "Abc"}
  ? {string is lower abc} 1 "tcl command 'string is lower'"

  ? {::nsf::is -complain {i:integer 1} 2} {invalid value constraints "i:integer 1"}
}

nx::test configure -count 10
nx::test case multiple-method-checkers {
  nx::Object create o {
    :public object method foo {} {
      ::nsf::is metaclass ::XYZ
      ::nsf::is metaclass ::nx::Object
    }

    :public object method bar {} {
      ::nsf::is metaclass ::XYZ
      ::nsf::is metaclass ::XYZ
    }

    :public object method bar2 {} {
      ::nsf::is metaclass ::nx::Object
      ::nsf::is metaclass ::nx::Object
    }
  }

  ? {o foo} 0
  ? {o bar} 0

  ? {::nsf::is metaclass ::XYZ} 0
  ? {::nsf::is metaclass ::nx::Object} 0

  ? {o foo} 0
  ? {o bar2} 0
}

#######################################################
# param manager
#######################################################
nx::test configure -count 10000
nx::test case param-manager {

  nx::Object create ::paramManager {
    :object method type=sex {name value} {
      return "agamous"
    }
  }

  ? {::nsf::is -complain sex,slot=::paramManager female} "1"
}
#######################################################
# cononical feature table
#######################################################
#
# parameter options
#   required
#   optional
#   multivalued
#   noarg
#   arg=
#   substdefault:  if no value given, subst on default (result is substituted value);
#                  susbt cmd can use variable resolvers,
#                  works for scripted/c-methods and obj-parm,
#                  automatically set by "$slot toParameterSpec" if default contains "[" ... "]".
#
#   initcmd:       evaluate body in an xotcl nonleaf frame, called via configure
#                  (example: last arg on create)
#   alias,forward  call specified method in an xotcl nonleaf frame, called via configure;
#                  specified value is the first argument unless "noarg" is used
#                  (example: -noinit).
#
# parameter type   multivalued  required  noarg  type=   arg=  parametercheck  methodParm  objectParm
#  initcmd            NO         YES        NO    NO      NO      NO       NO/POSSIBLE    YES
#  alias,forward      NO         YES        YES   NO      YES     NO       NO/POSSIBLE    YES
#
#  relation           NO         YES        NO    NO      YES     NO          NO          YES
#  stringtype         YES        YES        NO    NO      NO      YES         YES         YES
#
#  switch             NO         NO         NO    NO      NO      NO          YES         NO
#  integer            YES        YES        NO    NO      NO      YES         YES         YES
#  boolean            YES        YES        NO    NO      NO      YES         YES         YES
#  object             YES        YES        NO    YES     NO      YES         YES         YES
#  class              YES        YES        NO    YES     NO      YES         YES         YES
#
#  userdefined        YES        YES        NO    NO      YES     YES         YES         YES
#
# tclObj + converterArg (alnum..xdigit)            Attribute ... -type alnum
# object + converterArg (some class, e.g. ::C)     Attribute ... -type ::C    Attribute -type object -arg ::C
# class  + converterArg (some metaclass, e.g. ::M)                            Attribute -type class -arg ::M
#
#
#::xotcl::Slot {
#     {name "[namespace tail [::xotcl::self]]"}
#     {methodname}
#     {domain "[lindex [regexp -inline {^(.*)::slot::[^:]+$} [::xotcl::self]] 1]"}
#     {defaultmethods {get assign}}
#     {manager "[::xotcl::self]"}
#     {multivalued false}
#     {per-object false}
#     {required false}
#     default
#     type
# } -- No instances
#
# ::xotcl::RelationSlot -superclass ::xotcl::Slot {
#     {multivalued true}
#     {type relation}
#     {elementtype ::nx::Class}
# } -- sample instances: class superclass, mixin filter
#
# ::nx::VariableSlot -superclass ::xotcl::Slot {
#     {value_check once}
#     defaultcmd
#     valuecmd
#     valuechangedcmd
#     arg
# } -- typical object parameters
#
# MethodParameterSlot -attributes {type required multivalued noarg arg}
# -- typical method parameters


#######################################################
# objectparameter
#######################################################
nx::test configure -count 10
nx::test case objectparameter {

  nx::Class create C {
    :property a
    :property {b:boolean}
    :property {c 1}
  }
  C create c1

  ? {C eval :__object_configureparameter} \
      "-mixins:mixinreg,slot=::nx::Class::slot::mixins,slotset,method=class-mixin,0..n {-superclasses:class,alias,method=::nsf::methods::class::superclass,1..n ::nx::Object} -filters:filterreg,slot=::nx::Class::slot::filters,slotset,method=class-filter,0..n -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"

  #### TODO: remove or add
  #? {c1 eval :__object_configureparameter} \
  #    "::c1: unable to dispatch method '__objectparameter'"
}

#######################################################
# reclass to nx::Object, no need to do anything on caching
#######################################################
nx::test case reclass {

  nx::Class create C {
    :property a
    :property {b:boolean}
    :property {c 1}
  }
  C create c1

  ? {c1 info lookup slots -source application} "::C::slot::a ::C::slot::b ::C::slot::c"

  nsf::relation::set c1 class nx::Object

  ? {c1 info lookup slots -source application} ""

  nx::Class create D -superclass C {:property d:required}
  D create d1 -d 100

  ? {d1 info lookup slots -source application} \
      "::D::slot::d ::C::slot::a ::C::slot::b ::C::slot::c"

  ? {d1 eval :__object_configureparameter} \
      "-d:required -a -b:boolean {-c 1} $::trailer"
}

#######################################################
# Add mixin
#######################################################
nx::test case objparam-mixins {

  nx::Class create C {
    :property a
    :property {b:boolean}
    :property {c 1}
  }
  nx::Class create D -superclass C {
    :property d:required
  }
  D create d1 -d 100

  nx::Class create M {
    :property m1
    :property m2
    :property b
  }
  nx::Class create M2 {
    :property b2
  }
  D mixins set M

  ? {d1 eval :__object_configureparameter} \
      "-b -m1 -m2 -d:required -a {-c 1} $::trailer" \
    "mixin added"

  M mixins set M2

  ? {d1 eval :__object_configureparameter} \
      "-b2 -b -m1 -m2 -d:required -a {-c 1} $::trailer" \
    "transitive mixin added"
  D mixins set ""
  #we should have again the old interface

  ? {d1 eval :__object_configureparameter} \
      "-d:required -a -b:boolean {-c 1} $::trailer"

  C mixins set M
  ? {d1 eval :__object_configureparameter} \
      "-b2 -b -m1 -m2 -d:required -a {-c 1} $::trailer" \
      "mixin added"
  C mixins set ""
  #we should have again the old interface

  ? {d1 eval :__object_configureparameter} \
      "-d:required -a -b:boolean {-c 1} $::trailer"
}

#######################################################
# test passed arguments
#######################################################

nx::test case passed-arguments {

  nx::Class create C {
    :property a
    :property b:boolean
    :property {c 1}
  }
  nx::Class create D -superclass C {:property d:required}

  ? {catch {D create d1 -d 123}} 0 "create d1 with required argument given"
  ? {catch {D create d1}} 1 "create d1 without required argument given"
  #puts stderr current=[namespace current]

  ? {D create d1} \
      {required argument 'd' is missing, should be:
        ::d1 configure -d /value/ ?-a /value/? ?-b /boolean/? ?-c /value/? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?}

  ? {D create d2 -d x -b a} \
      {expected boolean but got "a" for parameter "-b"} \
      "create d2 without required argument given"

  D create d1 -d 1
  D public method foo {-b:boolean -r:required,int {-x:int aaa} {-object:object} {-class:class}} {
    #if {[info exists x]} {puts stderr x=$x}
  }

  ? {d1 foo} \
      {required argument 'r' is missing, should be:
        ::d1 foo ?-b /boolean/? -r /integer/ ?-x /integer/? ?-object /object/? ?-class /class/?} \
      "call method without a required argument"

  ? {d1 foo -r a} \
      {expected integer but got "a" for parameter "-r"} \
      "required argument is not integer"

  ? {d1 foo -r 1} \
      {expected integer but got "aaa" for parameter "-x"} \
      "default value is not of type integer"

  ? {d1 foo -r 1 -x 1 -object d1} \
      "" \
      "pass object"

  ? {d1 foo -r 1 -x 1 -object d11} \
      {expected object but got "d11" for parameter "-object"} \
      "pass non-existing object"

  ? {d1 foo -r 1 -x 1 -class D} \
      "" \
      "pass class"

  ? {d1 foo -r 1 -x 1 -class d1} \
      {expected class but got "d1" for parameter "-class"} \
      "pass object instead of class"

  ? {d1 foo -r 1 -x 1 -class D11} \
      {expected class but got "D11" for parameter "-class"} \
      "pass non-existing class"

  ? {D public method foo {a:double} {return $a}} \
      {::nsf::classes::D::foo} \
      "allow 'string is XXXX' for argument checking"
  ? {d1 foo 1} 1 "check int as double"
  ? {d1 foo 1.1} 1.1 "check double as double"
  ? {d1 foo 1.1a} {expected double but got "1.1a" for parameter "a"} "check non-double as double"
  ? {D info method parameters foo} a:double
}

#######################################################
# non required positional arguments
#######################################################
nx::test case non-reg-args {

  nx::Class create D
  D create d1

  D public method foo {a b:optional c:optional} {
    return "[info exists a]-[info exists b]-[info exists c]"
  }
  ? {d1 foo 1 2} "1-1-0" "omit optional argument"
  ? {d1 foo 1} "1-0-0" "omit optional arguments"

  # non required positional arguments and args
  D public method foo {a b:optional c:optional args} {
    return "[info exists a]-[info exists b]-[info exists c]-[info exists args]"
  }
  ? {d1 foo 1 2} "1-1-0-1" "omit optional argument"
  ? {d1 foo 1} "1-0-0-1" "omit optional arguments"
}

#######################################################
# multivalued arguments
#######################################################
nx::test case multivalued {

  nx::Class create D
  D create d1
  nx::Object create o

  D public method foo {m:integer,0..n} {
    return $m
  }
  ? {d1 foo ""} "" "empty list"
  ? {d1 foo 1} "1" "single value"
  ? {d1 foo {1 2}} "1 2" "multiple values"
  ? {d1 foo {1 a 2}} \
      {invalid value in "1 a 2": expected integer but got "a" for parameter "m"} \
      "multiple values with wrong value"

  D public method foo {m:object,0..n} {
    return $m
  }
  ? {d1 foo ""} "" "empty list"
  ? {d1 foo o} "o" "single value"
  ? {d1 foo {o d1 x}} \
      {invalid value in "o d1 x": expected object but got "x" for parameter "m"} \
      "multiple values"

  nx::Class create Foo {
    :property ints:integer,1..*
  }
  ? {Foo create foo -ints {1 2}} "::foo"
  ? {Foo create foo -ints {1 a 2}} {invalid value in "1 a 2": expected integer but got "a" for parameter "-ints"}

  # make slot incremental
  Foo property -incremental ints:integer,1..*

  # TODO? the following does not work. Should we revive it?
  #Foo::slot::ints eval {
  #  set :incremental 1
  #  :reconfigure
  #}

  Foo create foo -ints {1 2}
  ? {foo ints add 0} "0 1 2"
  ? {foo ints add a} {expected integer but got "a" for parameter "value"}
}

#######################################################
# subst default tests
#######################################################
nx::test case subst-default {

  nx::Class create D {
    :property -accessor public {c 1}
    :property {d 2}

    :create d1

    :public method bar {
      {-s:substdefault "[current]"}
      {-literal "[current]"}
      {-c:substdefault "[:c get]"}
      {-d:integer,substdefault "$d"}
    } {
      return $s-$literal-$c-$d
    }
  }

  ? {d1 bar -c 1} {::d1-[current]-1-2} "substdefault in method parameter"

  set ::X 1001
  nx::Class create Bar -superclass D {
    :property {s:substdefault "[current]"}
    :property {literal "[current]"}
    :property {c:substdefault "[:info class]"}
    :property {d "literal $d"}
    :property {e:substdefault {noliteral $::X}}
  }

  ? {Bar property -accessor public ss:switch} "::nsf::classes::Bar::ss"

  ? {Bar create bar1} ::bar1
  #puts stderr [bar1 __objectparameter]

  ? {subst {[bar1 cget -s]-[bar1 cget -literal]-[bar1 cget -c]-[bar1 cget -d]-[bar1 cget -e]}} \
      {::bar1-[current]-::Bar-literal $d-noliteral 1001} \
      "substdefault in object parameter 1"

  ? {Bar create bar2} ::bar2
  ? {subst {[bar2 cget -s]-[bar2 cget -literal]-[bar2 cget -c]-[bar2 cget -d]-[bar1 cget -e]}} \
      {::bar2-[current]-::Bar-literal $d-noliteral 1001} \
      "substdefault in object parameter 2"

  # Observation:
  #  - substdefault for '$' in property defaults does not make much sense.
  #    deactivated for now; otherwise we would need "\\"

  D public method bar {
                {-s:substdefault "[current]"}
                {-literal "[current]"}
                {-c:substdefault "[:c get]"}
                {-d:integer,substdefault "$d"}
                {-switch:switch}
                {-optflag}
                x
                y:integer
                {z 1}
              } {
    return $s-$literal-$c-$d
  }

  ? {D info method args bar} {s literal c d switch optflag x y z} "all args"
  ? {D info method parameters bar} \
      {{-s:substdefault "[current]"} {-literal "[current]"} {-c:substdefault "[:c get]"} {-d:integer,substdefault "$d"} -switch:switch -optflag x y:integer {z 1}} \
      "query method parameter"


  ? {D public method foo {s:switch} {return 1}} \
      {invalid parameter type "switch" for argument "s"; type "switch" only allowed for non-positional arguments}

  D public method foo {a b {-c 1} {-d} x {-end 100}} {
    set result [list]
    foreach v [[current class] info method args [current method]] {
      lappend result $v [info exists $v]
    }
    return $result
  }
  ? {d1 foo 1 2 3} \
      "a 1 b 1 c 1 d 0 x 1 end 1" \
      "parse multiple groups of nonpos args"

  D public method foo {a b c {end 100}} {
    set result [list]
    foreach v [[current class] info method args [current method]] {
      lappend result $v [info exists $v]
    }
    return $result
  }
  ? {d1 foo 1 2 3} \
      "a 1 b 1 c 1 end 1" \
      "query arguments with default, no paramdefs needed"

  #######################################################
  # Query method parameter
  #######################################################

  ? {D info method parameters foo} \
      "a b c {end 100}" \
      "query instparams with default, no paramdefs needed"

  ? {nx::Class info method parameters method} \
      "-debug:switch -deprecated:switch name arguments:parameter,0..* -checkalways:switch -returns body" \
      "query instparams for scripted method 'method'"

  ? {nx::Object info method parameters ::nsf::method::forward} \
      "object:object -per-object:switch method -default -earlybinding:switch -onerror -prefix -frame -verbose:switch target:optional args" \
      "query parameter for C-defined cmd 'nsf::forward'"

  nx::Object require method autoname
  ? {nx::Object info method parameters autoname} \
      "-instance:switch -reset:switch name" \
      "query parameter for C-defined method 'autoname'"

  D method "a b" {x y} {return $x-$y}
  D object method "c d" {x y z} {return $x-$y}
  ? {D info method parameters "a b"} "x y"
  ? {D info object method parameters "c d"} "x y z"
}

#######################################################
# user defined parameter value checkers
#######################################################
nx::test case user-value-checker {

  nx::Class create D {:property d}
  D create d1

  # Create a user-defined value checker for method parameters,
  # without extra argument
  ::nx::methodParameterSlot object method type=mytype {name value} {
    if {$value < 1 || $value > 3} {
      error "value '$value' of parameter $name is not between 1 and 3"
    }
  }

  D public method foo {a:mytype} {
    return a=$a
  }
  d1 foo 1

  ? {d1 foo 10} \
      "value '10' of parameter a is not between 1 and 3" \
      "value not between 1 and 3"

  D public method foo {a:unknowntype} {
    return $a
  }

  ? {d1 foo 10} \
      "::nx::methodParameterSlot: unable to dispatch method 'type=unknowntype'" \
      "missing type checker"

  #
  # Create a user-defined value-checker for method parameters,
  # with an extra argument
  #
  ::nx::methodParameterSlot object method type=in {name value arg} {
    if {$value ni [split $arg |]} {
      error "value '$value' of parameter $name not in permissible values $arg"
    }
    return $value
  }

  #
  # Trivial test case
  #

  D public method foo {a:in,arg=a|b|c} {
    return a=$a
  }

  ? {d1 foo a} "a=a"
  ? {d1 foo 10} \
      "value '10' of parameter a not in permissible values a|b|c" \
      "invalid value"

  #
  # Test case with positional and non-positional arguments, and default
  #

  D public method foo {a:in,arg=a|b|c b:in,arg=good|bad {-c:in,arg=a|b a}} {
    return a=$a,b=$b,c=$c
  }

  ? {d1 foo a good -c b} "a=a,b=good,c=b"
  ? {d1 foo a good} "a=a,b=good,c=a"
  ? {d1 foo b "very good"} \
      "value 'very good' of parameter b not in permissible values good|bad" \
      "invalid value (not included)"

  #
  # Create a user-defined value checker for method parameters,
  # without extra argument
  #
  ::nx::methodParameterSlot object method type=commaRange {name value arg} {
    lassign [split $arg ,] min max
    if {$value < $min || $value > $max} {
      error "value '$value' of parameter $name not between $min and $max"
    }
    return $value
  }

  D public method foo {a:commaRange,arg=1,,3} {
    return a=$a
  }

  ? {d1 foo 2} "a=2"
  ? {d1 foo 10} \
      "value '10' of parameter a not between 1 and 3" \
      "invalid value"

  #
  # two commas at the end
  #
  D public method foo {a:commaRange,arg=1,,} {return a=$a}
  ? {d1 foo 2} {value '2' of parameter a not between 1 and }

  #
  # one comma at the end
  #
  D public method foo {a:commaRange,arg=1,} {return a=$a}
  ? {d1 foo 2} {value '2' of parameter a not between 1 and }

  #
  # Classical range check
  #
  ::nx::methodParameterSlot object method type=range {name value arg} {
    lassign [split $arg -] min max
    if {$value < $min || $value > $max} {
      error "value '$value' of parameter $name not between $min and $max"
    }
    return $value
  }

  D public method foo {a:range,arg=1-3 {-b:range,arg=2-6 3} c:range,arg=5-10} {
    return a=$a,b=$b,c=$c
  }

  ? {d1 foo 2 -b 4 9} "a=2,b=4,c=9"
  ? {d1 foo 2 10} "a=2,b=3,c=10"
  ? {d1 foo 2 11} \
      "value '11' of parameter c not between 5 and 10" \
      "invalid value"

  # define type twice
  ? {D public method foo {a:int,range,arg=1-3} {return a=$a}} \
      "parameter option 'range' unknown for parameter type 'integer'" \
      "invalid value"
  #
  # handling of arg with spaces/arg as list
  #
  ::nx::methodParameterSlot public object method type=list {name value arg} {
    #puts $value/$arg
    return $value
  }

  # handling spaces in "arg" is not not particular nice
  D public method foo {{"-a:list,arg=2 6" 3} {"b:list,arg=5 10"}} {
    return a=$a,b=$b
  }

  ? {d1 foo -a 2 10} "a=2,b=10"

}

nx::test case value-checker-call-check {

  nx::Class create PV {
    :property -accessor public h:foo,arg=123 {
      :object method type=foo {prop value arg} {
        incr ::counter(h)
        return
      }
    }
    :property -accessor public hs:0..*,foo {
      :object method type=foo {prop value} {
        incr ::counter(hs)
        return
      }
    }
  }

  ? {info exists ::counter(h)} 0
  set pv1 [PV new -h 121]
  ? {set ::counter(h)} 1
  $pv1 h set 212
  ? {set ::counter(h)} 2
  $pv1 configure -h 212
  ? {set ::counter(h)} 3

  unset -nocomplain ::counter(h)

  ? {info exists ::counter(hs)} 0
  set pv2 [PV new -hs 121]
  ? {set ::counter(hs)} 1
  $pv2 hs add 212
  ? {set ::counter(hs)} 2
  $pv1 configure -hs 313
  ? {set ::counter(hs)} 3

  unset -nocomplain ::counter(hs)

}


#######################################################
# testing object types in method parameters
#######################################################
nx::test case mp-object-types {

  nx::Class create C
  nx::Class create D -superclass C {:property d}

  nx::Class create M
  nx::Class create M2
  D create d1 -d 1
  C create c1 -object-mixins M
  C create c2 -object-mixins {{M -guard true}}
  C create c3 -object-mixins {M ::M2}
  C create c4 -object-mixins {{M -guard 1} M2}
  C create c5 -object-mixins {M {M2 -guard 2}}
  nx::Object create o

  ? {c1 object mixins get} ::M
  ? {c1 object mixins guard ::M} ""

  ? {c2 object mixins get} {{::M -guard true}}
  ? {c2 object mixins classes} ::M
  ? {c2 object mixins guard ::M} "true"

  ? {c3 object mixins get} {::M ::M2}
  ? {c3 object mixins guard M} ""
  ? {c3 object mixins guard M2} ""

  ? {c4 object mixins get} {{::M -guard 1} ::M2}
  ? {c4 object mixins classes} {::M ::M2}
  ? {c4 object mixins classes M} ::M
  ? {c4 object mixins classes M1} ""
  ? {c4 object mixins guard M} "1"
  ? {c4 object mixins guard M2} ""

  ? {c5 object mixins get} {::M {::M2 -guard 2}}
  ? {c5 object mixins classes} {::M ::M2}
  ? {c5 object mixins classes M} {::M}
  ? {c5 object mixins classes M1} ""
  ? {c5 object mixins guard M} ""
  ? {c5 object mixins guard M2} "2"

  D public method foo-base     {x:baseclass} {return $x}
  D public method foo-class    {x:class} {return $x}
  D public method foo-object   {x:object} {return $x}
  D public method foo-meta     {x:metaclass} {return $x}
  D public method foo-type     {x:object,type=::C} {return $x}

  ? {D info method parameters foo-base} "x:baseclass"
  ? {D info method parameters foo-type} "x:object,type=::C"

  ? {d1 foo-base ::nx::Object} "::nx::Object"
  ? {d1 foo-base C} \
      {expected baseclass but got "C" for parameter "x"} \
      "not a base class"

  ? {d1 foo-class D} "D"
  ? {d1 foo-class xxx} \
      {expected class but got "xxx" for parameter "x"} \
      "not a class"
  ? {d1 foo-class o} \
      {expected class but got "o" for parameter "x"} \
      "not a class"

  ? {d1 foo-meta ::nx::Class} "::nx::Class"
  ? {d1 foo-meta ::nx::Object} \
      {expected metaclass but got "::nx::Object" for parameter "x"} \
      "not a base class"

  ? {d1 foo-object o} "o"
  ? {d1 foo-object xxx} \
      {expected object but got "xxx" for parameter "x"} \
      "not an object"

  ? {d1 foo-type d1} "d1"
  ? {d1 foo-type c1} "c1"
  ? {d1 foo-type o} \
      {expected object of type ::C but got "o" for parameter "x"} \
      "o not of type ::C"
}

#######################################################
# substdefault
#######################################################
nx::test case substdefault {

  nx::Class create S {
    :property {x 1}
    :property {y b}
    :property {z {1 2 3}}
  }
  S create s1 {
    :public object method foo {{y:substdefault ${:x}}} {
      return $y
    }
    :public object method bar {{y:integer,substdefault ${:x}}} {
      return $y
    }
    :public object method baz {{x:integer,substdefault ${:y}}} {
      return $x
    }
    :public object method boz {{x:integer,0..n,substdefault ${:z}}} {
      return $x
    }
  }
  ? {s1 foo} 1
  ? {s1 foo 2} 2

  ? {S object method foo {a:substdefault} {return 1}} \
      {parameter option substdefault specified for parameter "a" without default value}

  ? {s1 bar} 1
  ? {s1 bar 3} 3
  ? {s1 bar a} {expected integer but got "a" for parameter "y"}

  ? {s1 baz} {expected integer but got "b" for parameter "x"}
  ? {s1 baz 20} 20
  s1 configure -y 100
  ? {s1 baz} 100
  ? {s1 baz 101} 101

  ? {s1 boz} {1 2 3}
  s1 configure -z {1 x 100}
  ? {s1 boz} {invalid value in "1 x 100": expected integer but got "x" for parameter "x"}
  ? {s1 boz {100 200}} {100 200}

  set ::aaa 100
  ? {s1 public object method foo {{a:substdefault $::aaa}} {return $a}} ::s1::foo

  ? {s1 foo} 100
  unset ::aaa
  ? {s1 foo} {can't read "::aaa": no such variable}

  ? {s1 public object method foo {{a:substdefault $aaa}} {return $a}} ::s1::foo
  ? {s1 foo} {can't read "aaa": no such variable}

  ? {s1 public object method foo {{a:substdefault [current]}} {return $a}} ::s1::foo
  ? {s1 foo} ::s1 "final test"
}

#######################################################
# testing substdefault for object parameters (per-class)
#######################################################
nx::test case substdefault-objparam-perclass {

  nx::Class create Bar {

    # no substdefault given
    :property {s0 "[current]"}

    # explicit substdefault
    :property {s1:substdefault "[current]"}

    # unneeded double substdefault
    :property {s2:substdefault,substdefault "[current]"}

    # substdefault with incremental
    :property -incremental {s3:substdefault "[current]"}
  }

  ? {Bar create ::b} ::b "create object"
  ? {b cget -s0} {[current]}
  ? {b cget -s1} "::b"
  ? {b cget -s2} "::b"
  ? {b cget -s3} "::b"
}

#######################################################
# testing substdefault for object parameters (per-object)
#######################################################
nx::test case substdefault-objparam-perobj {

  nx::Object create rab {

    # no substdefault given
    :object property {s0 "[current]"}

    # explicit substdefault
    :object property {s1:substdefault "[current]"}

    # unneeded double substdefault
    :object property {s2:substdefault,substdefault "[current]"}

    # substdefault with incremental
    :object property -incremental {s3:substdefault "[current]"}

    # no substdefault given
    :object variable s4 {[current]}

    # explicit substdefault
    :object variable s5:substdefault {[current]}

    # unneeded double substdefault
    :object variable s6:substdefault,substdefault {[current]}

    # substdefault with incremental
    :object variable -incremental s7:substdefault {[current]}
  }

  ? {rab cget -s0} {[current]}
  ? {rab cget -s1} "::rab"
  ? {rab cget -s2} "::rab"
  ? {rab cget -s3} "::rab"
  ? {rab eval {set :s4}} {[current]}
  ? {rab eval {set :s5}} "::rab"
  ? {rab eval {set :s6}} "::rab"
  ? {rab eval {set :s7}} "::rab"
}


#
# Test call of configure within constructor
#
nx::test case parameter-alias-default {

  ::nsf::method::require nx::Object __configure
  nx::Class create C {
    :property {a ""}
    :property {b 1}

    :method init {} {
      :__configure -b 1
    }
    :create c1
    :create c2 -a 0
  }

  ? {::c1 eval {set :a}} ""
  ? {::c1 eval {set :b}} 1
  ? {::c2 eval {set :a}} 0
  ? {::c2 eval {set :b}} 1
}


#######################################################
# testing object types in object parameters
#######################################################
nx::test case op-object-types {

  nx::Class create C
  nx::Class create D -superclass C {:property d}

  nx::Class create MC -superclass nx::Class
  MC create MC1
  nx::Class create M
  D create d1 -d 1
  C create c1 -object-mixins M
  nx::Object create o

  nx::Class create ParamTest {
    :property o:object
    :property c:class
    :property c1:class,type=::MC
    :property d:object,type=::C
    :property d1:object,type=C
    :property m:metaclass
    :property b:baseclass
    :property u:upper
    :property us:upper,1..*
    :property -incremental us2:upper,1..*
    :property {x:object,1..* {o}}
  }

  ? {ParamTest info lookup parameters create o} "-o:object"
  ? {ParamTest info lookup parameters create c} "-c:class"
  ? {ParamTest info lookup parameters create c1} "-c1:class,type=::MC"
  ? {ParamTest info lookup parameters create d} "-d:object,type=::C"
  ? {ParamTest info lookup parameters create d1} "-d1:object,type=::C"
  ? {ParamTest info lookup parameters create x} "{-x:object,1..* o}"
  ? {ParamTest info lookup parameters create u} "-u:upper,slot=::ParamTest::slot::u"
  ? {ParamTest info lookup parameters create us} "-us:upper,slot=::ParamTest::slot::us,1..*"

  ? {ParamTest create p -o o} ::p
  ? {ParamTest create p -o xxx} \
      {expected object but got "xxx" for parameter "-o"} \
      "not an object"

  ? {ParamTest create p -c C} ::p "class"
  ? {ParamTest create p -c o} \
      {expected class but got "o" for parameter "-c"} \
      "not a class"

  ? {ParamTest create p -c1 MC1} ::p "instance of meta-class MC"
  ? {ParamTest create p -c1 C} \
      {expected class of type ::MC but got "C" for parameter "-c1"} \
      "not an instance of meta-class MC"

  ? {ParamTest create p -d d1} ::p
  ? {ParamTest create p -d1 d1} ::p
  ? {ParamTest create p -d c1} ::p
  ? {ParamTest create p -d o} \
      {expected object of type ::C but got "o" for parameter "-d"} \
      "o not of type ::C"

  #? {ParamTest create p -mix c1} ::p
  #? {ParamTest create p -mix o} \
      {expected object with mixin M but got "o" for parameter "mix"} \
      "does not have mixin M"

  ? {ParamTest create p -u A} ::p
  ? {ParamTest create p -u c1} {expected upper but got "c1" for parameter "-u"}
  ? {ParamTest create p -us {A B c}} \
      {invalid value in "A B c": expected upper but got "c" for parameter "-us"}
  ParamTest::slot::us eval {
    set :incremental 1
    :reconfigure
  }
  ? {ParamTest create p -us {A B} -us2 {A B}} ::p
  ? {p us add C end} "A B C"
  ? {p us2 add C end} "A B C"

  ? {p configure -o o} \
      "" \
      "value is an object"

  ? {p configure -o xxx} \
      {expected object but got "xxx" for parameter "-o"} \
      "value is not an object"

  #
  # define multivalued property "os" via instance variables of the
  # slot object
  #
  ParamTest eval {
    #:property -accessor public os {
    #  :type object
    #  :multiplicity 1..n
    #}
    :property -accessor public os:object,1..n

  }

  ? {ParamTest info method definition os} "::ParamTest public forward os -prefix value= ::ParamTest::slot::os %1 %self os"

  ? {p os set o} \
      "o" \
      "value is a list of objects (1 element)"

  ? {p os set {o c1 d1}} \
      "o c1 d1" \
      "value is a list of objects (multiple elements)"

  ? {p os set {o xxx d1}} \
      {invalid value in "o xxx d1": expected object but got "xxx" for parameter "value"} \
      "list with invalid object"
}

#######################################################
# application specific multivalued converter
#######################################################
nx::test case multivalued-app-converter {

  ::nx::methodParameterSlot public object method type=sex {name value args} {
    #puts stderr "[current] slot specific converter"
    switch -glob $value {
      m* {return m}
      f* {return f}
      default {error "expected sex but got $value"}
    }
  }
  nx::Class create C {
    :public method foo {s:sex,0..*,convert} {return $s}
    :public method bar {s:sex,0..*} {return $s}
  }
  C create c1
  ? {c1 foo {male female mann frau}} "m f m f"
  ? {c1 bar {male female mann frau}} "male female mann frau"

  nx::Object create tmpObj
  tmpObj object method type=mType {name value arg:optional} {
    if {$value} {
      error "expected false but got $value"
    }
    # Note that this converter does NOT return a value; it converts all
    # values into empty strings.
  }
  ? {::nsf::is -complain mType,slot=::tmpObj,0..* {1 0}} \
      {invalid value in "1 0": expected false but got 1} \
      "fail on first value"
  ? {::nsf::is -complain mType,slot=::tmpObj,0..* {0 0 0}} 1 "all pass"
  ? {::nsf::is -complain mType,slot=::tmpObj,0..* {0 1}} \
      {invalid value in "0 1": expected false but got 1} \
      "fail o last value"
}
#######################################################
# application specific multivalued converter
#######################################################
nx::test case shadowing-app-converter {

  nx::Object create mySlot {
    :public object method type=integer {name value arg:optional} {
      return [expr {$value + 1}]
    }
  }
  nx::Object create o {
    :public object method foo {x:integer,slot=::mySlot,convert} {
      return $x
    }
  }

  ? {::nsf::is -complain integer,slot=::mySlot 1} 1
  ? {o foo 3} 4
}


#######################################################
# allow empty values
#######################################################
nx::test case allow-empty {

  nx::Object create o1
  nx::Object create o2
  nx::Object create o3

  nx::Object create o {
    :public object method foo {x:integer,0..1 y:integer os:object,0..*} {
      return $x
    }
  }

  ? {o foo 1 2 {o1 o2}} 1 "all values specified"
  ? {o foo "" 2 {o1 o2}} "" "first is empty"
  ? {o foo 1 "" {o1 o2}} {expected integer but got "" for parameter "y"} "second is empty"
  ? {o foo 1 2 {}} 1 "empty list"

  ? {o info object method parameters foo} "x:integer,0..1 y:integer os:object,0..*"

  o public object method foo {x:integer,0..1 y:integer os:object,1..*} {return $x}
  ? {o foo 1 2 {o1 "" o2}} {invalid value in "o1 "" o2": expected object but got "" for parameter "os"} \
      "list contains empty value"
  ? {o foo "" 2 {}} {invalid value for parameter 'os': list is not allowed to be empty} \
      "empty int, empty list of objects"
}
#######################################################
# slot specific converter
#######################################################
nx::test case slot-specific-converter {

  nx::Class create Person {

    :property -accessor public sex:sex,convert {
      :object method type=sex {name value} {
        #puts stderr "[self] slot specific converter"
        switch -glob $value {
          m* {return m}
          f* {return f}
          default {error "expected sex but got $value"}
        }
      }
    }

    :property -accessor public sexes:sex,0..*,convert {
      :object method type=sex {name value} {
        #puts stderr "[self] sexes slot specific converter"
        switch -glob $value {
          m* {return m}
          f* {return f}
          default {error "expected sex but got $value"}
        }
      }
    }
  }

  Person create p1 -sex male
  ? {p1 cget -sex} m
  ? {p1 sex get} m
  Person public method foo {s:sex,slot=::Person::slot::sex,convert} {return $s}
  ? {p1 foo male} m
  ? {p1 sex set male} m

  Person create p2 -sexes {male female}
  ? {p2 cget -sexes} {m f}
  ? {p2 sexes get} {m f}
  ? {p2 sexes add female} {f m f}
  ? {p2 sexes set {male female male}} {m f m}

  set count [nx::test cget -count]
  nx::test configure -count 1
  ? {p2 sexes delete female} {m m}
  ? {p2 sexes delete female} {::p2: 'f' is not in variable 'sexes' (values are: 'm m')}
  ? {p2 sexes delete -nocomplain female} {m m}
  ? {p2 sexes delete -nocomplain male} {m}
  ? {p2 sexes get} {m}
  nx::test configure -count $count

  Person public method bar {s:sex,0..*,slot=::Person::slot::sexes,convert} {return $s}
  ? {p2 bar {female male female}} {f m f}
}

#######################################################
# test for setters with parameters os
#######################################################
nx::test case setters {
  nx::Object create o
  nx::Class create C

  ? {::nsf::method::setter ::o :a} {invalid setter name ":a" (must not start with a dash or colon)}
  ? {::nsf::method::setter o a} "::o::a"
  ? {::nsf::method::setter C c} "::nsf::classes::C::c"
  ? {o info object method definition a} "::o public object setter a"
  ? {o info object method parameters a} "a"
  ? {o info object method args a} "a"
  ? {C info method definition c} "::C public setter c"
  ? {o a 1} "1"

  ? {::nsf::method::setter o a:integer} "::o::a"
  ? {::nsf::method::setter o ints:integer,1..*} "::o::ints"
  ? {::nsf::method::setter o o:object} "::o::o"

  ? {o info object method registrationhandle ints} "::o::ints"
  ? {o info object method definition ints} "::o public object setter ints:integer,1..*"
  ? {o info object method parameters ints} "ints:integer,1..*"
  ? {o info object method args ints} "ints"

  ? {o info object method registrationhandle o} "::o::o"
  ? {o info object method definition o} "::o public object setter o:object"
  ? {o info object method parameters o} "o:object"
  ? {o info object method args o} "o"

  ? {o a 2} 2
  ? {o a hugo} {expected integer but got "hugo" for parameter "a"}

  ? {o ints {10 100 1000}} {10 100 1000}
  ? {o ints hugo} {invalid value in "hugo": expected integer but got "hugo" for parameter "ints"}
  ? {o o o} o
  ? {::nsf::method::setter o {d default}} {parameter specification for "d" is not allowed to have default "default"}
  ? {::nsf::method::setter o "d\ndefault"} {parameter specification for "d" is not allowed to have default "default"}
  ? {::nsf::method::setter o -x} {invalid setter name "-x" (must not start with a dash or colon)}
}

nx::test case setters-wrongargs {
  nx::Object create o
  ::nsf::method::setter o z
  ? {o z -10} -10
  ? {o z} -10
  ? {o z -1 0} {wrong # args should be "::o z ?value?"}
}



#######################################################
# test for slot-optimizer
#######################################################
nx::test configure -count 1000
nx::test case slot-optimizer {

  nx::Class create C {
    :property -accessor public a
    :property -accessor public b:integer
    :property -accessor public c:integer,0..n
  }

  C create c1
  ? {c1 a set 1} 1
  ? {c1 b set 1} 1
  ? {c1 c set 1} 1
}

nx::test configure -count 10
nx::test case slot-nosetter {
  nx::Class create C {
    :property -accessor public a
    :property -accessor none b:integer
    :property -accessor none {c ""}
  }

  ? {C create c1 -a 1 -b 2} ::c1
  ? {c1 info vars} "a b c"
  ? {c1 a set 100} 100
  ? {c1 b 101} {::c1: unable to dispatch method 'b'}
  ? {c1 c 102} {::c1: unable to dispatch method 'c'}
}

nx::test configure -count 1000
nx::test case check-arguments {

  nx::Class create Foo {
    :public method noarg {} {return ""}
    :public method onearg {x} {return $x}
    :public method intarg {x:integer} {return $x}
    :public method intsarg {x:integer,1..*} {return $x}
    :public method boolarg {x:boolean} {return $x}
    :public method classarg {x:class} {return $x}
    :public method upperarg {x:upper} {return $x}
    :public method metaclassarg {x:metaclass} {return $x}
    :create f1
  }

  ? {f1 noarg} ""
  ? {f1 onearg 1} 1
  # built-in checker
  ? {f1 intarg 1} 1
  ? {f1 intarg a} {expected integer but got "a" for parameter "x"}
  ? {f1 intsarg {10 11 12}} {10 11 12}
  ? {f1 intsarg {10 11 1a2}} {invalid value in "10 11 1a2": expected integer but got "1a2" for parameter "x"}
  ? {f1 boolarg 1} 1
  ? {f1 boolarg a} {expected boolean but got "a" for parameter "x"}
  ? {f1 classarg ::Foo} ::Foo
  ? {f1 classarg f1} {expected class but got "f1" for parameter "x"}
  # tcl checker
  ? {f1 upperarg ABC} ABC
  ? {f1 upperarg abc} {expected upper but got "abc" for parameter "x"}
  # scripted  checker
  ? {f1 metaclassarg ::nx::Class} ::nx::Class
  ? {f1 metaclassarg ::Foo} {expected metaclass but got "::Foo" for parameter "x"}
}

nx::test case copy-with-required {
  nx::Class create C {
    :property n:required
  }
  C create c1 -n 1

  ? {c1 copy c2} "::c2"
}


#
# basic slot trace tests
#
nx::test case slot-traces {
  #
  # basic tests for object slots
  #
  ::nx::Object create o {
    :object property -accessor public -trace default a {
      :public object method value=default {obj var} {return 4 }
    }
    :object property -accessor public -trace get b {
      :public object method value=get {obj var} { return 44 }
    }
    :object property -accessor public -trace set c {
      :public object method value=set {obj var value} { ::nsf::var::set $obj $var 999 }
    }
  }

  ? {o a get} 4
  ? {o b get} 44
  ? {o c set 5} 999

  ? {::nsf::object::property o hasperobjectslots} 1

  o copy o2

  ? {o a get} 4
  ? {o b get} 44
  ? {o c set 5} 999
  ? {::nsf::object::property o2 hasperobjectslots} 1

  #
  # basic tests for class slots
  #

  ::nx::Class create C {
    :property -accessor public -trace default a {
      :public object method value=default {obj var} { return 4 }
    }
    :property -accessor public -trace get b {
      :public object method value=get {obj property} { return 44 }
    }
    :property -accessor public -trace set c {
      :public object method value=set {obj property value} { ::nsf::var::set $obj $property 999 }
    }
    :create c1
  }
  ? {c1 a get} 4
  ? {c1 b get} 44
  ? {c1 c set 5} 999

  c1 copy c2

  ? {c2 a get} 4
  ? {c2 b get} 44
  ? {c2 c set 5} 999

  C copy D
  D create d1

  ? {d1 a get} 4
  ? {d1 b get} 44
  ? {d1 c set 5} 999
}

nx::test case slot-trace-interaction {
  #
  # 1) Verify the controlled interactions between trace types
  #
  # per-object:
  #

  package req nx::serializer

  Object create o

  ? {o eval {info exists :a}} 0
  ? {o object property -trace default {a 0} { }} "'-trace default' can't be used together with default value"

  ? {o eval {info exists :a}} 0

  ? {o eval {info exists :b}} 0
  ? {o object property -trace get {b:integer 123} { }} ""
  ? {o eval {info exists :b}} 1
  ? {o object property -trace get {b:integer hello} { }} {expected integer but got "hello" for parameter "b"}

  ? {o eval {info exists :c}} 0
  ? {o object property -trace {default get} c { }} "'-trace default' and '-trace get' can't be used together"
  ? {o eval {info exists :c}} 0

  #
  # valuechangedcmd + default value are allowed
  #

  ? {o eval {info exists :a}} 0
  o object property -accessor public -trace set {a 0} {
    :public object method value=set {obj var value} {
      ::nsf::var::set -notrace $obj $var [expr {$value + 1}]
    }
  }

  ? {o eval {info exists :a}} 1

  ? {o a get} 0
  ? {o a set 1} 2
  ? {o a get} 2
  ? {o a set 2} 3

  ? {o eval {info exists :A}} 0
  o object property -trace set {A 0} {
    :public object method value=set {obj var value} {
      ::nsf::var::set -notrace $obj $var [expr {$value + 1}]
    }
  }
  ? {o eval {info exists :A}} 1
  ? {o cget -A} 0
  ? {o configure -A 1} ""
  ? {o cget -A} 2

  # per-class:
  Class create Klass

  ? {Klass property -trace default {a 0} { }} "'-trace default' can't be used together with default value"

  ? {Klass property -trace get {b 0} { }} ""

  ? {Klass property -trace {default get} c { }} "'-trace default' and '-trace get' can't be used together"

  Klass property -accessor public -trace set {a 0} {
    :public object method value=set {obj var value} {
      ::nsf::var::set -notrace $obj $var [expr {$value + 1}]
    }
  }

  Klass create k
  ? {k eval {info exists :a}} 1
  ? {k a get} 0; # should be 1, reflecting the corresponding per-object case above
  ? {k a set 1} 2
  ? {k a get} 2
  ? {k a set 2} 3

  #
  # 2) Have initcmd scripts escaped from C-level argument checking (in
  # the per-class check)
  #
  # a) against scalar checkers (as a simplistic case)

  Klass property -trace set b:boolean {
    :public object method value=set {obj property value} {
      return tr1e
    }

  }

  ? {catch {Klass create kk}} 0
  #
  # b) Structured trace scripts, containing lists. Check for
  # brace balancedness ...
  #
  # Background: Script blocks passed as initcmds should not be
  # subjected to *any* argument checking. This was not guaranteed,
  # previously. As a result, for example, upon multivalued argument
  # checking (e.g., 0..n) the argument (i.e., the initcmd block) was
  # tentatively expanded into a Tcl list. This failed for initcmd
  # scripts which do not qualify as valid list structures (a condition
  # not to be enforced).
  #
  # Below, we introduce three tests capturing the unwanted
  # interaction, now fixed. Note: This issue only affects
  # class-wide initcmds, as in the per-object case, the initcmds are
  # evaluated right away and not fiddled through the parameter handling
  # infrastructure.
  ::nx::Class create CC {
    :property -trace default a:0..n {
      :public object method value=default {obj property} { return 4 }
    }
    :property -trace get b:0..n {
      :public object method value=get {obj property} { return 44 }
    }
    :property -accessor public -trace set c:0..n {
      :public object method value=set {obj property value} { ::nsf::var::set $obj $property 999 }
    }
    :create ::cc
  }

  ? {cc cget -a} 4
  ? {cc cget -b} 44
  ? {cc c set 5} 999

}

::nsf::configure checkarguments off
nx::test case check-arguments-nocheck {

  nx::Class create Foo {
    :public method noarg {} {return ""}
    :public method onearg {x} {return $x}
    :public method intarg {x:integer} {return $x}
    :public method intsarg {x:integer,1..*} {return $x}
    :public method boolarg {x:boolean} {return $x}
    :public method classarg {x:class} {return $x}
    :public method upperarg {x:upper} {return $x}
    :public method metaclassarg {x:metaclass} {return $x}
    :create f1
  }

  ? {f1 noarg} ""
  ? {f1 onearg 1} 1
  # built-in checker
  ? {f1 intarg 1} 1
  ? {f1 intarg a} a
  ? {f1 intsarg {10 11 12}} {10 11 12}
  ? {f1 intsarg {10 11 1a2}} {10 11 1a2}
  ? {f1 boolarg 1} 1
  ? {f1 boolarg a} a
  ? {f1 classarg ::Foo} ::Foo
  ? {f1 classarg f1} f1
  # tcl checker
  ? {f1 upperarg ABC} ABC
  ? {f1 upperarg abc} abc
  # scripted  checker
  ? {f1 metaclassarg ::nx::Class} ::nx::Class
  ? {f1 metaclassarg ::Foo} ::Foo
}

nx::test configure -count 100

nx::test case checktype {
  nx::Object create o {
    :public object method f01 {} {::nsf::dispatch o ::nsf::methods::object::info::hastype ::nx::Object}
    :public object method f02 {} {::nsf::dispatch o ::nsf::methods::object::info::hastype   nx::Object}
    :public object method f03 {} {::nsf::dispatch o ::nsf::methods::object::info::hastype   nx::Object}

    :public object method f11 {} {::nsf::is object,type=::nx::Object o}
    :public object method f12 {} {::nsf::is object,type=nx::Object o}
    :public object method f13 {} {::nsf::is object,type=Object o}
  }

  ? {o f01} 1
  ? {o f02} 1
  ? {o f03} 1

  ? {o f11} 1
  ? {o f12} 1
  #? {o f13} 0
}

#
# testing namespace resolution in type checkers
#
namespace eval foo {
  nx::Class create C {
    :create c1
    :public method f21 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype nx::Object}
    :public method f22 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype C}
    :public method f31 {} {::nsf::is object,type=::nx::Object c1}
    :public method f32 {} {::nsf::is object,type=C c1}
  }

  nx::Object create o {
    :public object method f01 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype ::nx::Object}
    :public object method f02 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype   nx::Object}
    :public object method f03 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype   nx::Object}
    :public object method f04 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype foo::C}
    :public object method f05 {} {::nsf::dispatch c1 ::nsf::methods::object::info::hastype C}

    :public object method f11 {} {::nsf::is object,type=::nx::Object c1}
    :public object method f12 {} {::nsf::is object,type=nx::Object c1}; # resolves to ::foo::nx::Object
    :public object method f13 {} {::nsf::is object,type=Object c1}; # resolves to ::foo::Object
    :public object method f14 {} {::nsf::is object,type=C c1}; # resolves to ::foo::C
    :public object method f15 {} {::nsf::is object,type=[namespace which C] c1}; # ::foo::C
  }

  ? {o f01} 1
  ? {o f02} 1
  ? {o f03} 1
  ? {o f04} 1
  ? {o f05} 1

  ? {o f11} 1
  ? {o f12} 0
  ? {o f13} 0
  ? {o f14} 1
  ? {o f15} 1

  ? {c1 f21} 1
  ? {c1 f22} 1
  ? {c1 f31} 1
  ? {c1 f32} 1
}

nx::test case check-arguments {

  nx::Class create Foo {
    :method noarg {} {return ""}
    :method onearg {-x} {return $x}
    :method intarg {-x:integer} {return $x}
    :method intsarg {-x:integer,1..*} {return $x}
    :method boolarg {-x:boolean} {return $x}
    :method classarg {-x:class} {return $x}
    :method upperarg {-x:upper} {return $x}
    :method metaclassarg {-x:metaclass} {return $x}
  }

  ? {Foo info method syntax noarg} "/cls/ noarg"
  ? {Foo info method syntax onearg} "/cls/ onearg ?-x /value/?"
  ? {Foo info method syntax intarg} "/cls/ intarg ?-x /integer/?"
  ? {Foo info method syntax intsarg} "/cls/ intsarg ?-x /integer .../?"
  ? {Foo info method syntax boolarg} "/cls/ boolarg ?-x /boolean/?"
  ? {Foo info method syntax classarg} "/cls/ classarg ?-x /class/?"
  ? {Foo info method syntax upperarg} "/cls/ upperarg ?-x /upper/?"
  ? {Foo info method syntax metaclassarg} "/cls/ metaclassarg ?-x /metaclass/?"

  # return enumeration type
  ? {nx::Class info method syntax "info mixinof"} \
      "/cls/ info mixinof ?-closure? ?-scope all|class|object? ?/pattern/?"
}

#
# Check whether resetting via method "configure" changes values in the
# initialized object state.
#
nx::test case don't-reset-to-defaults {
  nx::Class create C {
    :property -accessor public {a 1}
    :create c1
  }
  ? {c1 cget -a} 1

  # change the value from the default to a different value
  ? {c1 a set 2} 2
  ? {c1 a get} 2
  # call configure ...
  c1 __configure
  # ... and check, it did not reset the value to the default
  ? {c1 a get} 2
}

nx::test case setter-under-coloncmd-and-interpvarresolver {
  # There are (at least) three forms of object-namespace alignment in
  # NSF:
  # 1. Same-named namespace (::omon) predates a same-named object
  # (::omon), the namespace is registered as per-object namespace with
  # the object upon object construction -> no NsColonVarResolver(),
  # InterpColonVarResolver() is responsible!
  # 2. an explicit per-object namespace creation using [:require
  # namespace] -> NsColonVarResolver() is put in place!
  # 3. nx::Object get per-object members (fields, methods) ->
  # NsColonVarResolver() is put in place!
  #
  # The following test covers scenario 1: Called from within
  # NsfSetterMethod(), SetInstVar() verifies, whether there is a
  # per-object namespace (objPtr->nsPtr); if so, TCL_NAMESPACE_ONLY is
  # set ... in this object/ns alignment scenario,
  # InterpColonVarResolver() (!) serves the var resolution request. It
  # effectively forward-passes the resolution request when sensing
  # TCL_NAMESPACE_ONLY by signalling TCL_CONTINUE. This is a consequence
  # of handling the "compiled [variable] vs. AVOID_RESOLVERS" case
  # InterpColonVarResolver(). As in colon-prefixed calls to the setter
  # method (via ColonCmd()), the colon prefix is present in the
  # name-carrying Tcl_Obj used to in SetInstVar(). As we set an object
  # frame context, we effectively end up with a colon-prefixed object
  # variable :(

  nx::Class create Omon
  ::nsf::method::setter Omon a1

  namespace eval omon {}
  Omon create omon
  omon a1 ""
  ? {omon info vars a1} "a1"
  ? {omon info vars :a1} ""
  omon eval {
    :a1 ""
    ? [list [current] info vars a1] "a1"
    # Prior to the fix, [:info vars] would have returned ":a1"
    ? [list [current] info vars :a1] ""
  }
}

#
# test required configure parameter
#

nx::test case req-param {
  ::nx::Class create C {
    :property y:required
    :property x:required
    :method init args {set ::_ "passed args '$args'"}
  }

  set ::_ ""
  ? {C create c2 -y 1 -x} {value for parameter '-x' expected}

  # Was the constructor called? Should not.
  ? {set ::_} ""

  # Did the object survive the error? Should not.
  ? {::nsf::is object c2} 0

  set ::_ ""
  ? {C create c2} \
"required argument 'x' is missing, should be:
        ::c2 configure -x /value/ -y /value/ ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?"

  # Was the constructor called? Should not.
  ? {set ::_} ""

  # Did the object survive the error? Should not.
  ? {::nsf::is object c2} 0

  # The following should run through without errors
  ? {C create c3 -y 1 -x 0} "::c3"
  ? {set ::_} "passed args ''"
  ? {c3 cget -x} "0"

  #
  # incremental property adding vs. required
  #
  nx::Class create D

  ? {D create d1} ::d1
  ? {d1 configure} ""

  D property x:required
  ? {d1 info lookup syntax configure} \
      "-x /value/ ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?"

  ? {d1 configure} \
      "required argument 'x' is missing, should be:
        ::d1 configure -x /value/ ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?"

  ? {d1 configure -x 123} ""
  ? {d1 cget -x} 123

  ? {d1 configure} ""
}




::nsf::configure checkarguments on

#
# Test type any (or other typechecker) in combination with
# substdefault via object parameter
#
nx::test case nsf-subdefault {
  nx::Class create C {
    :property {n1:substdefault "[namespace tail [::nsf::self]]"}
    :property {n2:substdefault,any "[namespace tail [::nsf::self]]"}
    :create c1
  }
  ? {c1 cget -n1} c1
  ? {c1 cget -n2} c1
}

#
# Test argument processing and namespace handling in nsf::procs
#

nx::test case nsf-proc {
  #
  # test inner namespace and handling of switches
  #
  nsf::proc ::nsf::mix {-per-object:switch -x:boolean} {
    return [namespace current]-${per-object}-[expr {[info exists x] ? $x : "NULL"}]
  }

  #
  # test handling of "-ad" flag
  #
  nsf::proc -ad ad_returnredirect {
    {-message {}}
    {-html:boolean}
    {-allow_complete_url:boolean}
    {-x:switch}
    target_url
  } {
    return [namespace current]-[lsort [info vars]]-$html_p-$allow_complete_url_p
  }

  #
  # test inner namespace and flag passing via -flag=$value notation
  #
  namespace eval ::ns1 {
    nsf::proc -ad foo {-s:boolean} {return [namespace current]-$s_p}
    nsf::proc bar {-s:switch} {return [namespace current]-[info exists s]}
    nsf::proc baz {-b:boolean arg} {return [namespace current]-[info exists b]-$arg}
    nsf::proc -ad pass0 {-s:boolean} {foo {*}[expr {$s_p ? "-s" : ""}]}
    nsf::proc -ad pass1 {-s:boolean} {foo -s=$s_p}
  }

  nx::test configure -count 1
  ? {::nsf::mix} "::nsf-0-NULL"
  ? {::nsf::mix -per-object} "::nsf-1-NULL"
  ? {::nsf::mix -x true} "::nsf-0-true"
  ? {::nsf::mix -x false} "::nsf-0-false"
  ? {::nsf::mix -per-object=1} "::nsf-1-NULL"
  ? {::nsf::mix -per-object=0} "::nsf-0-NULL"
  ? {ad_returnredirect /url} "::-allow_complete_url_p html_p message target_url x-0-0"
  ? {ad_returnredirect -html /url} "::-allow_complete_url_p html_p message target_url x-1-0"
  ? {ad_returnredirect -html=0 /url} "::-allow_complete_url_p html_p message target_url x-0-0"
  ? {ad_returnredirect -html=a /url} {expected boolean but got "a" for parameter "-html"}
  ? {::ns1::foo} "::ns1-0"
  ? {::ns1::foo -s} "::ns1-1"
  ? {::ns1::foo -s=1} "::ns1-1"
  ? {::ns1::foo -s=0} "::ns1-0"
  ? {::ns1::foo -s -s=0} "::ns1-0"
  ? {::ns1::baz -b true -- -b} "::ns1-1--b"
  ? {info body ad_returnredirect} {::nsf::__unset_unknown_args

    return [namespace current]-[lsort [info vars]]-$html_p-$allow_complete_url_p
  }

  nx::test configure -count 1000
  ? {::ns1::pass1} "::ns1-0"
  ? {::ns1::pass1 -s} "::ns1-1"
  ? {::ns1::pass0} "::ns1-0"
  ? {::ns1::pass0 -s} "::ns1-1"
}


#
# Test argument processing and namespace handling in nsf::procs
#

nx::test case xotcl-list-notation {
  nx::test configure -count 1

  package prefer latest
  package req XOTcl 2.0

  xotcl::Class create CC -parameter {package_id parameter_declaration user_id}

  # first, without list notation
  ? {CC create cc -package_id 123 -parameter_declaration o -user_id 4} "::cc"
  ? {cc package_id} 123
  ? {cc parameter_declaration} o
  ? {cc user_id} 4

  # new with list notation
  ? {CC create cc -package_id 234 [list -parameter_declaration oo] -user_id 456} ::cc
  ? {cc package_id} 234
  ? {cc parameter_declaration} oo
  ? {cc user_id} 456

  xotcl::Class create KK -parameter {a b c d}
  # new with (alternative) list notation
  ? {KK create kk "-a\r234" "-b\n456" "-c\f543" "-d\nddd"} ::kk
  ? {kk a} 234
  ? {kk b} 456
  ? {kk c} 543
  ? {kk d} ddd
}

#
# Test parameter alias and parameter forwarder
#
nx::test case parameter-alias {

  nx::Class create C {
    :property {x:alias}
    :property {A:alias,method=bar}
    :property {{F:forward,method=%self foo %1 a b c %method}}
    :property {D def}
    :public method x args {set :x $args}
    :public method foo args {set :foo $args}
    :public method bar args {set :bar $args}
    :create c1 -F 123 -x x1 -A aha
  }

  ? {c1 eval {set :x}} "x1"
  ? {c1 eval {set :foo}} "123 a b c F"
  ? {c1 eval {set :bar}} "aha"
  ? {lsort [c1 info lookup methods -source application]} "bar foo x"
}

#
# Test parameter alias and parameter forwarder with default value
#
nx::test case parameter-alias-default {

  nx::Class create C {
    :property {x1:alias "hugo"}
    :property {{F:forward,method=%self foo a %1 b c %method} "habicht"}
    :property {x2:alias,substdefault "[self]"}
    :public method x1 args {set :x1 $args}
    :public method x2 args {set :x2 $args}
    :public method foo args {set :foo $args}
    :create c1
  }

  ? {c1 eval {set :x1}} "hugo"
  ? {c1 eval {set :foo}} "a habicht b c F"
  ? {c1 eval {set :x2}} "::c1"
  ? {lsort [c1 info lookup methods -source application]} "foo x1 x2"
  ? {lsort [C info slots]} "::C::slot::F ::C::slot::x1 ::C::slot::x2"
  ? {::C::slot::x1 getParameterSpec} {-x1:alias hugo}
  ? {::C::slot::x2 getParameterSpec} {-x2:alias,substdefault {[self]}}
}



#
# Test interactions between per-object-mixins and objectparameters
# (case without per-object property)
#
nx::test case parameter-object-mixin-dependency {
  nx::Class create C {
    :property a1
    :create c1
  }
  nx::Class create D -superclass C
  nx::Class create M1 {:property b1:required}
  nx::Class create M2 {:property b2:required}

  ? {c1 eval :__object_configureparameter} "-a1 $::trailer"

  c1 object mixins set M1

  ? {c1 info precedence} "::M1 ::C ::nx::Object"

  ? {c1 eval :__object_configureparameter} "-b1:required -a1 $::trailer"

  #
  # Invalidate the object parameter and expect that the per-class
  # mixin does not harm
  #
  ::nsf::parameter::cache::classinvalidate C

  #
  # We have now "-b1:required" in the configure parameters.
  #
  # NSF checks, if the associated variable is already set, but
  # this does not work for aliases.... we could track whether or
  # not a required parameter was already provided, but that
  # requires most likely a more general handling.
  #
  ? {c1 configure -a1 x} \
"required argument 'b1' is missing, should be:
        ::c1 configure -b1 /value/ ?-a1 /value/? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?"

  #
  # The object parameter based on the per-object-mixins must not be
  # stored in the class based cache. Therefore, creating a new object
  # must not require b1

  ? {C create c2} ::c2

  #
  # the same should hold for subclasses
  #
  ? {D create d1} ::d1

  #
  # we have now per-object mixin of M1, we should have "-b1" but no
  # "-b2"
  #
  ? {c1 info object mixins} ::M1
  ? {c1 cget -object-mixin} ::M1
  ? {c1 info lookup parameters configure b*} "-b1:required"

  #
  # add one more mixin.
  #
  c1 object mixins add ::M2
  ? {c1 info object mixins} {::M2 ::M1}
  ? {c1 cget -object-mixin} {::M2 ::M1}
  ? {c1 info lookup parameters configure b1} "-b1:required"
  ? {c1 info lookup parameters configure b2} "-b2:required"
  ? {lsort [c1 info lookup parameters configure b*]} "-b1:required -b2:required"

  #
  # drop the mixins, the b* properties should be gone.
  #
  c1 object mixins set ""
  ? {c1 info object mixins} {}
  ? {lsort [c1 info lookup parameters configure b*]} ""

  #
  # add M1 again
  #
  c1 object mixins add ::M1
  ? {c1 info object mixins} {::M1}
  ? {c1 info lookup parameters configure b1} "-b1:required"
  ? {lsort [c1 info lookup parameters configure b*]} "-b1:required"
  #
  # We have the per-object cache; adding a per-object property should
  # flush the cache
  #
  c1 object property bo1
  ? {lsort [c1 info lookup parameters configure b*]} "-b1:required -bo1"
  c1 object property bo2
  ? {lsort [c1 info lookup parameters configure b*]} "-b1:required -bo1 -bo2"
  #
  # property deletion should invalidate the cache as well
  #
  c1 delete object property bo2
  ? {lsort [c1 info lookup parameters configure b*]} "-b1:required -bo1"
}


#
# Test interactions between per-object-mixins and objectparameters
# (case with per-object property)
#
nx::test case parameter-object-mixin-dependency-object-property {
  nx::Class create C {
    :property a1
    :create c1 {
      :object property a2
    }
  }
  nx::Class create D -superclass C
  nx::Class create M {:property b1:required}

  c1 object mixins set M

  ? {c1 info precedence} "::M ::C ::nx::Object"

  ? {lsort [C info slots -closure]} \
      "::C::slot::a1 ::nx::Object::slot::__initblock ::nx::Object::slot::class ::nx::Object::slot::object-filters ::nx::Object::slot::object-mixins"

  ? {c1 eval :__object_configureparameter} \
      "-a2 -b1:required -a1 $::trailer"

  #
  # invalidate object parameter and expect that the per-class mixin
  # does not harm
  #
  ::nsf::parameter::cache::classinvalidate C

  ? {c1 __configure -a1 x} \
"required argument 'b1' is missing, should be:
        ::c1 configure ?-a2 /value/? -b1 /value/ ?-a1 /value/? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?"

  ? {c1 info precedence} "::M ::C ::nx::Object"
  ? {lsort [C info slots -closure]} \
      "::C::slot::a1 ::nx::Object::slot::__initblock ::nx::Object::slot::class ::nx::Object::slot::object-filters ::nx::Object::slot::object-mixins"

  ? {c1 eval :__object_configureparameter} "-a2 -b1:required -a1 $::trailer"
  # should not require b1
  ? {C create c2} ::c2

}



#
# Test integer, wideinteger and bignums
#
nx::test configure -count 1000
nx::test case bignums {

  ::nx::Object create o {
    :public object method foo {x:int} { return $x }
    :public object method foo32 {x:int32} { return $x }
    :public object method bar {x:wideinteger} { return $x }
    :public object method baz {x:double} { return $x }
  }

  if {![string is integer [expr {2 ** 32}]]} {
    #
    # pre TIP 514 (< 8.7a2)
    # see https://core.tcl-lang.org/tips/doc/trunk/tip/514.md
    #

    #
    # In Tcl 8.5, "integer" means 32 bit integer
    #
    ? [list string is integer [expr {2 ** 31}]] 1
    ? [list string is integer [expr {2 ** 32}]] 0
    ? {o foo [expr {2 ** 16}]} "65536"
    ? {o foo [expr {2 ** 31}]} "2147483648"
    #? {o foo [expr {2 ** 32}]} {expected integer but got "4294967296" for parameter "x"}
    ? {o foo [expr {2 ** 32}]} "4294967296"


    ? [list string is integer [expr {2 ** 63}]] 0
    ? [list string is integer [expr {2 ** 64}]] 0
    #? {o foo [expr {2 ** 63}]} {expected integer but got "9223372036854775808" for parameter "x"}
    #? {o foo [expr {2 ** 64}]} {expected integer but got "18446744073709551616" for parameter "x"}
    ? {o foo [expr {2 ** 63}]} "9223372036854775808"
    ? {o foo [expr {2 ** 64}]} "18446744073709551616"
    ? {o foo [expr {2 ** 128}]} "340282366920938463463374607431768211456"

    ? {o foo [expr {wide(2 ** 63)}]} "-9223372036854775808"

    ? {o foo [expr {2.0}]} {expected integer but got "2.0" for parameter "x"}
    ? {o foo [expr {2.0 * 2}]} {expected integer but got "4.0" for parameter "x"}

    #
    # Note: In Tcl version less or equal 8.5.9 (to be precise, before
    # fossil check-in 769801ace1) there is a rounding issue for
    # doubles. It can be worked around by setting the tcl precision
    # level sufficiently high (see below). With check-in 769801ace1, or
    # with the 8.5.10 release version of Tcl, this work-around becomes
    # obsolete.
    #
    if {[::package vcompare [::info patchlevel] 8.5.9] < 1} {
      set ::nsf::savedTclPrecision $::tcl_precision
      set ::tcl_precision 17
    }

    ? {o foo [expr {2.0 ** 128}]} {expected integer but got "3.4028236692093846e+38" for parameter "x"}
    ? {o foo [expr {(2 ** 128)*1.0}]} {expected integer but got "3.4028236692093846e+38" for parameter "x"}

    if {[info exists ::nsf::savedTclPrecision]} {
      set ::tcl_precision $::nsf::savedTclPrecision
      unset ::nsf::savedTclPrecision
    }

    ? {o foo32 [expr {2 ** 31}]} "2147483648"
    ? {o foo32 [expr {2 ** 32}]} {expected int32 but got "4294967296" for parameter "x"}

    #
    # In Tcl 8.5, "wideinteger" means 64 bit integer
    #
    ? [list string is wideinteger [expr {2 ** 63}]] 1
    ? [list string is wideinteger [expr {2 ** 64}]] 0
    ? {o bar [expr {2 ** 63}]} "9223372036854775808"
    ? {o bar [expr {2 ** 64}]} {expected wideinteger but got "18446744073709551616" for parameter "x"}

    ? [list string is wideinteger [expr {wide(2 ** 64)}]] 1
    ? {o bar [expr {wide(2 ** 63)}]} "-9223372036854775808"
    ? {o bar [expr {wide(2 ** 64)}]} "0"

    #
    # In Tcl 8.5, "bignums" have to be checked with "double"
    #
    ? [list string is double [expr {2 ** 63}]] 1
    ? [list string is double [expr {2 ** 64}]] 1
    ? {o baz [expr {2 ** 63}]} "9223372036854775808"
    ? {o baz [expr {2 ** 64}]} "18446744073709551616"
    ? {o baz [expr {2 ** 128}]} "340282366920938463463374607431768211456"

  } else {

    #
    # post TIP 514 (>= 8.7a2)
    # see https://core.tcl-lang.org/tips/doc/trunk/tip/514.md
    #
    # [string is integer] is now equivalent to [string is entier], and
    # does not perform any representational range checks anymore.
    #

    #
    # [string is integer] means arbitrary-bit integers (equiv. to entier)
    #
    ? [list string is integer [expr {2 ** 31}]] 1
    ? [list string is integer [expr {2 ** 32}]] 1
    ? [list nsf::is int32 [expr {2 ** 32}]] 0
    ? [list nsf::is int32 [expr {2 ** 32 - 1}]] 1

    ? {o foo [expr {2 ** 16}]} "65536"
    ? {o foo [expr {2 ** 31}]} "2147483648"
    ? {o foo [expr {2 ** 32}]} "4294967296"


    ? [list string is integer [expr {2 ** 63 - 1}]] 1
    ? [list string is integer [expr {2 ** 64}]] 1
    ? [list nsf::is int32 [expr {2 ** 63 - 1}]] 0
    ? {o foo [expr {2 ** 63}]} "9223372036854775808"
    ? {o foo [expr {2 ** 64}]} "18446744073709551616"
    ? {o foo [expr {2 ** 128}]} "340282366920938463463374607431768211456"

    ? {o foo [expr {wide(2 ** 63)}]} "-9223372036854775808"

    ? {o foo [expr {2.0}]} {expected integer but got "2.0" for parameter "x"}
    ? {o foo [expr {2.0 * 2}]} {expected integer but got "4.0" for parameter "x"}

    ? {o foo [expr {2.0 ** 128}]} {expected integer but got "3.4028236692093846e+38" for parameter "x"}
    ? {o foo [expr {(2 ** 128)*1.0}]} {expected integer but got "3.4028236692093846e+38" for parameter "x"}

    ? {o foo32 [expr {2 ** 31}]} "2147483648"
    ? {o foo32 [expr {2 ** 32}]} {expected int32 but got "4294967296" for parameter "x"}

    # [string is wide] is now more picky about the upper 64-bit int bound: 2^63-1, and not 2^63

    ? [list string is wideinteger [expr {2 ** 63 - 1}]] 1
    ? [list string is wideinteger [expr {2 ** 63}]] 0
    ? {o bar [expr {2 ** 63 - 1}]} "9223372036854775807"
    ? {o bar [expr {2 ** 64}]} {expected wideinteger but got "18446744073709551616" for parameter "x"}

    ? [list string is wideinteger [expr {wide(2 ** 64)}]] 1
    ? {o bar [expr {wide(2 ** 63)}]} "-9223372036854775808"
    ? {o bar [expr {wide(2 ** 64)}]} "0"

    #
    # [string is integer] will accept arbitrarily sized numeric
    # strings (no range check)
    #

    ? [list string is int [expr {2 ** 63}]] 1
    ? [list string is int [expr {2 ** 64}]] 1
    ? {o baz [expr {2 ** 63}]} "9223372036854775808"
    ? {o baz [expr {2 ** 64}]} "18446744073709551616"
    ? {o baz [expr {2 ** 128}]} "340282366920938463463374607431768211456"

    #
    # [string is double] will accept arbitrarily sized doubles (no
    # range check)
    #

    ? [list string is double [expr {2 ** 63 * 0.1}]] 1
    ? [list string is double [expr {2 ** 64 * 0.1}]] 1
    ? {o baz [expr {2 ** 63 * 0.1}]} "9.223372036854776e+17"
    ? {o baz [expr {2 ** 64 * 0.1}]} "1.8446744073709553e+18"
    ? {o baz [expr {2 ** 128 * 0.1}]} "3.402823669209385e+37"


  }
}

nx::test case reconfigure-perobj-default {
  nx::Object create o
  ? {o eval {info exists :a}} 0
  o object property {a oldvalue}
  ? {o eval {info exists :a}} 1
  ? {o cget -a} oldvalue
  #
  # By unsetting the var, upon recreating the property slot (or
  # calling reconfigure upon the property) we can trigger
  # a re-assignment of the default value.
  #
  o eval {unset :a}
  ? {o eval {info exists :a}} 0
  #
  # re-assignment of the default is handled by init
  #
  o object property {a newvalue}
  ? {o eval {info exists :a}} 1
  ? {o cget -a} newvalue
  o eval {unset :a}
  ? {o eval {info exists :a}} 0
  [o info object slots a] configure -default anothervalue
  ? {o eval {info exists :a}} 0
  #
  # re-assignment must be requested by a reconfigure call
  #
  [o info object slots a] reconfigure
  ? {o eval {info exists :a}} 1
  ? {o cget -a} anothervalue
}

#
# nx::Object parameters (specified e.g. via attributes) are defined to
# configure fresh objects (therefore, the definition is on the class
# level). Therefore, object-level object parameter do not fulfill
# this purpose, since they can only be defined, *after* the object
# is created.
#
# In general, object parameters have creational aspects (providing
# configurations for the object creation, such as e.g. defaults, and
# configurations) and object-lifetime aspects (valid through the
# lifetime of objects, such as e.g. setters/checkers).
#
# nx::Object-level attributes cannot be used for the creational aspects
  # of object parameters.
#
# Strengths of object-level parameters:
# - same interface as class-level attributes
# - can use same meta-data mechanisms as for class-level attributes
#   (e.g. database types, property name in the database, persistence
#   information, ...)
  # - can use same setters/checkers as for class-level attributes
# - can use as well incremental as for class-level attributes
#
# Shortcomings of object-level parameters:
# - no nice introspection:
#   "info parameter ...." is defined on cls, not on obj
# - default handling is not the same as for classes level attributes
#   (we have already some special mechanisms to set instance
#   attributes, if they do not exist)
# - object-level parameters cannot be used in a "configure"
#   of the object, since configure allows the same signature
#   as on object creation, all object parameters are cached
#   on the class level
# - Since configure does not include object-level parameters,
#   positional object level parameters do not make sense, since they
#   cannot be called.

#
# test object level property and variable
#
nx::test case object-level-variable {

  nx::Object create ::enterprise {

    # just to get a reference value for the timing
    ? [list [self] eval {set :dummy 1}] "1"

    # set 2 variables, one via variable, one via property
    ? [list [self] object variable -nocomplain captain1 "James Kirk"] ""
    ? [list [self] object property -nocomplain [list captain2 "Jean Luc"]] ""

    # in both cases, we expect instance variables
    ? [list [self] eval {set :captain1}] "James Kirk"
    ? [list [self] eval {set :captain2}] "Jean Luc"

    # just for the property, we have accessors
    ? [list [self] info lookup method  captain1] ""
    ? [list [self] info lookup method  captain2] ""

    # set variable with a value checker
    ? [list [self] object variable  -nocomplain x1:int 1] ""
    ? [list [self] object property -nocomplain [list x2:int 2]] ""

    # set variable with a value checker and an invalid value
    ? [list [self] object variable y1:int a] {expected integer but got "a"}
    ? [list [self] object property [list y2:int b]] {expected integer but got "b" for parameter "y2"}

    # set variable again, without -nocomplain
    ? [list [self] object variable x1:int 1] {object ::enterprise has already an instance variable named 'x1'}
    ? [list [self] object property [list x2:int 2]] {object ::enterprise has already an instance variable named 'x2'}

    # set variable with a value checker, multiple
    ? [list [self] object variable  -nocomplain xm1:int,1..n {1 2 3}] ""
    ? [list [self] object property -nocomplain [list xm2:int,1..n {1 2 3}]] ""

    # in both cases, we expect instance variables
    ? [list [self] eval {set :xm1}] "1 2 3"
    ? [list [self] eval {set :xm2}] "1 2 3"

    # set variable with a value checker, multiple with invalid value
    ? [list [self] object variable -nocomplain xm1:int,1..n {1 2a 3}] \
        {invalid value in "1 2a 3": expected integer but got "2a"}
    ? [list [self] object property -nocomplain [list xm2:int,1..n {1 2a 3}]] \
        {invalid value in "1 2a 3": expected integer but got "2a" for parameter "xm2"}

    # useless definition
    ? [list [self] object variable dummy:int] \
        {variable definition for 'dummy' (without value and accessor) is useless}

    #
    # define an application specific converter
    #
    ::nx::ObjectParameterSlot method type=range {name value arg} {
      lassign [split $arg -] min max
      if {$value < $min || $value > $max} {
        error "value '$value' of parameter $name not between $min and $max"
      }
      return $value
    }

    #
    # Test usage of application specific converter in "variable" and
    # "property"; invalid value
    ? [list [self] object variable -nocomplain r1:range,arg=1-10 11] \
        {value '11' of parameter value not between 1 and 10}
    ? [list [self] object property -nocomplain [list r2:range,arg=1-10 11]] \
        {value '11' of parameter r2 not between 1 and 10}

    # valid value
    ? [list [self] object variable -nocomplain r1:range,arg=1-10 5] ""
    ? [list [self] object property -nocomplain [list r2:range,arg=1-10 5]] ""

    # testing incremental
    ? [list [self] object variable -incremental -nocomplain i:int,0..* {}] "::enterprise::i"
    ? [list [self] object property -incremental -nocomplain j:int,0..* {}] "::enterprise::j"
    :i add 1
    :j add 1
    ? [list [self] i get] "1"
    ? [list [self] j get] "1"
    :i add 2
    :j add 2
    ? [list [self] i get] "2 1"
    ? [list [self] j get] "2 1"
    ? [list [self] i add a] {expected integer but got "a" for parameter "value"}
    ? [list [self] j add a] {expected integer but got "a" for parameter "value"}
  }

  nx::Class create C {
    # set 2 class variables, one via variable, one via property
    ? [list [self] object variable -nocomplain v "v0"] ""
    ? [list [self] object property -nocomplain [list a "a0"]] ""

    # in both cases, we expect instance variables
    ? [list [self] eval {set :v}] "v0"
    ? [list [self] eval {set :a}] "a0"

    # check variable with value constraint
    ? [list [self] object variable -nocomplain x:int "0"] ""
    ? [list [self] object variable -nocomplain y:int "a0"] {expected integer but got "a0"}
  }

}

#
# test class level property and variable
#
nx::test case class-level-variable {
  nx::Class create C {

    # define 2 class-level variables, one via variable, one via property
    :variable v v0
    :property -accessor public {a a0}

    # create an instance
    :create c1
  }

  # in both cases, we expect instance variables for c1
  ? {lsort [c1 info vars]} {a v}
  ? {c1 eval {set :v}} "v0"
  ? {c1 eval {set :a}} "a0"

  #
  # We expect a specifiable object parameter for "a" but not for "v".
  # The parameter for v can be obtained via spec, but is not listed in
  # "info parameter syntax" or "info parameter definitions".
  #
#  ? {C info parameter list a} "-a"
  ? {C info lookup parameters create a} "{-a a0}"
#  ? {C info lookup syntax create a} "?-a /value/?"
  ? {C info lookup syntax create} "/objectName/ ?-a /value/? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?"

  ? {C info lookup parameters create v} ""
  ? {[C info slots v] definition} "::C variable -accessor none v v0"
#  ? {C info parameter list v} ""
#  ? {C info configure parameter v} ""

  ? {C create c2 -a 10} ::c2
  ? {C create c2 -v 10} \
      {invalid non-positional argument '-v', valid are: -a, -object-mixins, -object-filters, -class;
 should be "::c2 configure ?-a /value/? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?"}

  #
  # We expect a setter for "a" but not for "v".
  #
  ? {c1 info lookup method a} "::nsf::classes::C::a"
  ? {c1 info lookup method v} ""
}

#
# test classes with single variable definitions, and illegal names
#
nx::test case single-variable {
  ? {nx::Class create C {
    :variable v 1
    :create c1
  }} ::C
  ? {c1 info vars} v

  ? {nx::Class create D {
    :variable :v 1
  }} {leading colon in ':v' not allowed in parameter specification 'spec'}
}

#
# test deletion of class level property and variable
#
nx::test case delete-class-level-variable-and-property {
  nx::Class create C {

    # define 2 class-level variables, one via variable, one via property
    :variable v v0
    :property -accessor public {a a0}

    # create an instance
    :create c1
  }

  # the instance of C will have the two variables set ...
  ? {lsort [c1 info vars]} {a v}

  # ... and we expect an object parameter for a but not for v ...
  ? {C info lookup parameters create a} "{-a a0}"
  ? {C info lookup parameters create v} ""

  # ... and we expect a setter for a but not for v
  ? {c1 info lookup method a} "::nsf::classes::C::a"
  ? {c1 info lookup method v} ""

  # if we delete a class-level property or variable,
  # the object parameter and setters for "a" will be gone
  C delete variable v
  C delete property a
  ? {C info lookup parameters create a} ""
  ? {c1 info lookup method a} ""

  # already created instance variables will continue to exist
  ? {lsort [c1 info vars]} {a v}

  # in newly created objects, neither a or v will exist
  ? {C create c2} ::c2
  ? {lsort [c2 info vars]} {}
}

#
# test deletion of class level property and variable
#
nx::test case delete-object-level-variable-and-property {
  nx::Object create o {

    # define 2 object-level variables, one via variable, one via property
    :object variable v v0
    :object property -accessor public {a a0}
  }

  # the instance of C will have the two variables set ...
  ? {lsort [o info vars]} {a v}

  # ... and we expect a setter for a but not for v
  ? {o info lookup method a} "::o::a"
  ? {o info lookup method v} ""

  # nx::Object-level attributes and variables set und unset instance
  # variables.  If we delete an object-level property or variable,
  # the setters for "a" will be unset.
  o delete object variable v
  o delete object property a
  ? {o info lookup method a} ""

  # Both instance variables are unset
  ? {lsort [o info vars]} {}
}

#
# Testing object parameters of type "switch"
#

nx::test case object-parameter-switch {

  # Create a class with a property of type switch and an instance of
  # the class
  ? {::nx::Class create C {
    :property -accessor public foo:switch
    :create c1
  }} "::C"

  # When the object parameter is not specified at creation time, the
  # default is false, an instance variable is set with this value
  ? {lsort [c1 info vars]} {foo}
  ? {c1 eval {set :foo}} {0}

  # nx::Object parameter of type "switch" are more tricky, since e.g. a
  # setter with 0 arguments is a getter. When a setter is built, it
  # uses the parameter type "boolean" instead.
  ? {C info methods} "foo"
  ? {c1 info lookup method foo} "::nsf::classes::C::foo"
  ? {c1 foo get} 0
  ? {c1 foo set 1} 1
  ? {c1 foo get} 1

  # When the object parameter is specified, the instance variable has
  # a value of true (i.e. 1)
  C create c2 -foo
  ? {lsort [c2 info vars]} {foo}
  ? {c2 eval {set :foo}} {1}
  ? {c1 foo get} 1

  # One can pass false (and other values) with the = notation as well
  C create c3 -foo=false
  ? {lsort [c3 info vars]} {foo}
  ? {c3 eval {set :foo}} {false}

  # In the inverted case, the switch has a default of "true". If the
  # switch is specified, the valus is "false"
  C property {foo2:switch 1}
  C create c4
  ? {lsort [c4 info vars]} {foo foo2}
  ? {c4 eval {set :foo2}} {1}
  C create c5 -foo2
  ? {lsort [c5 info vars]} {foo foo2}
  ? {c5 eval {set :foo2}} {0}

  # nx::Object case: variables of type "switch" are like variables of type
  # boolean, except that without the specified value argument
  # (variable foo below), it sets the variable to "false".
  ? {::nx::Object create o1 {
    :object variable foo:switch
    :object variable bar:switch 1
  }} ::o1
  ? {o1 eval {set :foo}} 0 "check value of switch variable without default"
  ? {o1 eval {set :bar}} 1 "check value of switch variable with default"
}


#
# Test slots with configparameter true/false, accessor true/false
# against "slot definitions" and "info parameter"
#
nx::test case class-info-slots-types {
  #
  # "/cls/ info slot ..." shows all slots, including variables
  # "/cls/ info parameter ..." shows the parameter available for object parameterization
  #
  nx::Class create C {
    # variable has no configure parameter and no accessor
    :variable v 100
  }

  # "v" does NOT show up in "info configure parameters"
  ? {C info lookup parameters create v} ""
#  ? {C info parameter names} "noinit object-mixin class object-filter __initblock"

  # "v" does show up in "info slot ..."
  ? {C info slots} "::C::slot::v"
  ? {::C::slot::v definition} "::C variable -accessor none v 100"

  nx::Class create D {
    :property -accessor public {p0 200}
    :property -accessor none {p1 201}
    :property -accessor none {p2:noconfig 202}
    :property -accessor public {p3:noconfig 203}
  }

  # "p2" and "p3" do NOT show up in "info parameter"
  ? {D info lookup parameters create p*} "{-p0 200} {-p1 201}"

  # "p1" and "p2" do NOT show up in "info methods"
  ? {D info methods} "p0 p3"

  # all properties show up in "info slot"
  ? {D info slots} "::D::slot::p0 ::D::slot::p1 ::D::slot::p2 ::D::slot::p3"
  #? {D info slot definitions} "{::D property {p0 200}} {::D property -accessor none {p1 201}} {::D variable p2 202} {::D variable -accessor public p3 203}"
  #? {D info properties} "{p0 200} {p1 201} {p2:noconfig 202} {p3:noconfig 203}"

}


nx::test case object-info-slots-types {
  #
  # "/obj/ info slot ..." shows all slots, including variables
  #
  nx::Object create o1 {
    # plain object variable has no slot object
    :object variable v0 100
    # In case we require an accessor or e.g. incremental, slot objects
    # are created; incremental implies accessor
    :object variable -accessor public v1 100
    :object variable -incremental v2 100
  }

  # only the variables with slots show up in "info slot ..."
  ? {o1 info object slots} "::o1::per-object-slot::v2 ::o1::per-object-slot::v1"
  ? {::o1::per-object-slot::v2 definition} "::o1 object variable -accessor public v2:1..n 100"
  ? {::o1::per-object-slot::v1 definition} "::o1 object variable -accessor public v1 100"

  nx::Object create o2 {
    :object property -accessor public {p0 200}
    :object property -accessor none {p1 201}
    :object property -accessor none {p2:noconfig 202}
    :object property -accessor public {p3:noconfig 203}
  }

  # "p1" and "p2" do NOT show up in "info methods"
  ? {o2 info object methods} "p0 p3"

  # all properties with slots show up in "info slot"
  ? {o2 info object slots} "::o2::per-object-slot::p0 ::o2::per-object-slot::p1 ::o2::per-object-slot::p3"
  ? {[o2 info object slots p0] definition} "::o2 object property -accessor public {p0 200}"
  ? {[o2 info object slots p1] definition} "::o2 object property -accessor none {p1 201}"
  ? {[o2 info object slots p3] definition} "::o2 object variable -accessor public p3 203"

  #? {o2 info properties} "{p0 200} {p1 201} {p3:noconfig 203}"

}

nx::test case noconfig-switch-interaction {
  catch {nx::Object new { :object property x:switch,noconfig; :configure -x=1}} msg opts
  ? [list string match "invalid non-positional argument '-x=1',*"  [dict get $opts -errorinfo]] 1
  catch {nx::Class new { :property y:switch,noconfig; :new -y=1}} msg opts
  ? [list string match "invalid non-positional argument '-y=1',*"  [dict get $opts -errorinfo]] 1
}

#
# testing method properties
#
nx::test case properties {

  # simple properties
  #nx::Class create Foo -properties {a {b 1}}
  nx::Class create Foo {
    :property a
    :property {b 1}
  }

  ? {[Foo info slots a] definition} "::Foo property -accessor none a"
  ? {[Foo info slots b] definition} "::Foo property -accessor none {b 1}"

  #? {Foo info properties} "a {b 1}"

  # properties with value checker
  nx::Class create Foo {
    :property a:boolean
    :property {b:integer 1}
  }
  ? {[Foo info slots a] definition} "::Foo property -accessor none a:boolean"
  ? {[Foo info slots b] definition} "::Foo property -accessor none {b:integer 1}"

  # required/optional properties
  nx::Class create Foo {
    :property a:required
    :property b:boolean,required
  }
  ? {[Foo info slots a] definition} "::Foo property -accessor none a:required"
  ? {[Foo info slots b] definition} "::Foo property -accessor none b:boolean,required"

  # properties with multiplicity
  nx::Class create Foo {
    :property {ints:integer,0..n ""}
    :property objs:object,1..n
    :property obj:object,0..1
  }
  ? {[Foo info slots objs] definition} "::Foo property -accessor none objs:object,1..n"
  ? {[Foo info slots ints] definition} "::Foo property -accessor none {ints:integer,0..n {}}"
  ? {[Foo info slots obj] definition} "::Foo property -accessor none obj:object,0..1"
}

#
# The following test case sets a value of an instance variable via a
# side-effect of an aliased parameter. Side-effects from aliased
# parameters are discouraged, since the order of the evaluation should
# not matter of a declarative evaluation of the argument vector.
#
# Note that the order, in which is the arguments are provided is not
# significant for the evaluation order.
#
nx::test case side-effect-set-value {

  nx::Class create C {
    :public object method setObjectParams {spec} {
      :protected method __object_configureparameter {} [list return $spec]
      ::nsf::parameter::cache::classinvalidate [self]
    }
    :setObjectParams ""
  }

  C method second {arg} {
    set :first $arg
  }

  C setObjectParams {{-first "X"} -second:alias}
  ? {[C new -second Y] eval {set :first}} Y "side-effect overwrites default"

  C setObjectParams {-second:alias {-first "X"}}
  ? {[C new -second Y] eval {set :first}} Y "side-effect determines value"
}

nx::test case xotcl-configure-method {
  nx::test configure -count 1

  package prefer latest
  package req XOTcl 2.0

  #
  # attempt dispatch to unknown method
  #
  xotcl::Object create o
  ? {o configure -order 15} "::o: unable to dispatch method 'order' during '::o.order'"
}

#
# Test forwarding to slot object, when set is overloaded
#
nx::test case forward-to-set {
  set ::slotcalls 0
  nx::Class create Foo {
    :property -accessor public bar {
      :public object method value=set { object property value } {
        incr ::slotcalls 1
        nsf::var::set $object $property $value
      }
    }
  }

  # call without default, without object parameter value
  set o [Foo new]
  ? [list $o eval {info exists :bar}] 0
  ? {set ::slotcalls} 0
  ? [list $o bar get] {can't read "bar": no such variable}

  # call without default, with object parameter value

  set o [Foo new -bar "test"]
  ? [list $o eval {info exists :bar}] 1
  ? {set ::slotcalls} 1
  ? [list $o bar get] "test"

  # test cases for default
  set ::slotcalls 0
  nx::Class create Foo {
    :property -accessor public {baz 1} {
      :public object method value=set { object property value } {
        incr ::slotcalls 1
        nsf::var::set $object $property $value
      }
    }
  }

  # call with default, without object parameter value
  set o [Foo new]
  ? [list $o eval {info exists :baz}] 1
  ? {set ::slotcalls} 1 "baz without object parameter value"
  ? [list $o baz get] "1"

  # call with default, with object parameter value

  set o [Foo new -baz "test"]
  ? [list $o eval {info exists :baz}] 1
  ? {set ::slotcalls} 2 "baz with object parameter value"
  ? [list $o baz get] "test"
  ? {Foo info method exists baz} 1

}


#
# Test forwarding to slot vs. accessor none
#
nx::test case forward-to-set2 {
  set ::slotcalls 0

  ? {nx::Class create Foo {
    :property -accessor none bar {
      :public object method value=set { object property value } {
        incr ::slotcalls 1
        nsf::var::set $object $property $value
      }
    }}
  } "::Foo"

  # call without default, without object parameter value
  ? {catch {Foo new}} 0
  ? {set ::slotcalls} 0

  # test cases for default
  nx::Class create Foo {
    :property -accessor none {baz 1} {
      :public object method value=set { object property value } {
        incr ::slotcalls 1
        nsf::var::set $object $property $value
      }
    }
  }

  # call with default, without object parameter value
  ? {catch {Foo new}} 0
  ? {set ::slotcalls} 1

  # call with default, with object parameter value
  ? {catch {Foo new -baz "test"}} 0
  ? {set ::slotcalls} 2
  ? {Foo info method exists baz} 0
}


#
# Test slot initialize
#
nx::test case forward-to-incremental {
  set ::slotcalls 0

  ? {nx::Class create Foo {
    :property bar {
      :public object method initialize { object property } {
        incr ::slotcalls 1
      }
    }}
  } "::Foo"

  # initialize is supposed to be called regardless of some default
  ? {catch {Foo new}} 0
  ? {set ::slotcalls} 1

}

#
# Test interaction of name of property with the Tcl command behavior.
# Without the SlotContainerCmdResolver() the call to "list" in a
# property named "list" leads to a call to the container object
# ::Test2::slot::list instead of the intended ::list.
#
nx::test case slot-container-name-interaction {

  nx::Class create Test2 {
    :property -accessor public list {
      :public object method value=set { obj var val } {
        nsf::var::set $obj $var [list $obj $var $val]
      }
      :object method unknown { val obj var args } {
        return unknown
      }
    }
  }

  ? {Test2 create t2} ::t2
  ? {t2 list set 3} {::t2 list 3}
  ? {t2 list get} {::t2 list 3}
  ? {t2 list this should call unknown} "unknown"
}

nx::test case object-level-defaults {
  #
  # In the scenario below, setCheckedInstVar is executed and performs
  # an ::nsf::is value check on the default value. However, given the
  # custom set method, the parameter option slotset is passed on
  # to ::nsf::is which (currently) does not accept it:
  #
  # 'invalid value constraints
  # "slot=::objekt::per-object-slot::a,slotset"'
  #
  nx::Object create o
  ? {o eval {info exists :a}} 0
  ? {catch {
    o object variable -accessor public -initblock {
      :public object method value=set args {
        incr :assignCalled
        next
      }
    } a 1}} 0
  ? {o eval {info exists :a}} 1
  ? {o eval {info exists :assignCalled}} 0; # !!! should be 1
  ? {o a get} 1
}

nx::test case cmd-error-propagation {
  ? {nx::Object new {
    error "bow-wow"
  }} "bow-wow"

  ? {nx::Object new {
    :object method foo {} {
      error "bow-wow"
    }
    :foo
  }} "bow-wow"

  ? {nx::Object new {
    # Note: Creating a slot causes a destroy() to perform some cascading
    # operations which eventually reset the interp result at some
    # point.
    :object property x
    :object method foo {} { error "bow-wow" }
    :foo
  }} "bow-wow"

  ? {nx::Object new {
    :object method destroy {} {
      # This (inner) error message is swallowed and written to stderr
      # directly. The original (outer) error message is preserved.
      error "BOW-WOW"
    }
    :object method foo {} { error "bow-wow" }
    :foo
  }} "bow-wow"

}

#
# test argument processing in nsf::proc with checkalways
#

nx::test case nsf-proc-checkalways {

  #
  # one proc with checkalways
  #
  nsf::proc p1 {-x:integer} { return $x}
  nsf::proc -checkalways p2 {-x:integer} { return $x}

  ? {p1 -x 100} 100
  ? {p1 -x a100} {expected integer but got "a100" for parameter "-x"}

  ? {p2 -x 100} 100
  ? {p2 -x a100} {expected integer but got "a100" for parameter "-x"}

  nsf::configure checkarguments off
  ? {p1 -x a100} a100
  ? {p2 -x a100} {expected integer but got "a100" for parameter "-x"}

  nsf::configure checkarguments on
}

#
# test argument processing in methods with checkalways
#

nx::test case nsf-method-checkalways {

  #
  # one method with checkalways
  #

  nx::Class create C {
    :public method m1 {-x:integer} { return $x}
    :public method m2 {-x:integer} -checkalways { return $x}

    :public object method om1 {-x:integer} { return $x}
    :public object method om2 {-x:integer} -checkalways { return $x}

    :create c1
  }

  ? {c1 m1 -x 100} 100
  ? {c1 m2 -x 100} 100

  ? {c1 m1 -x a100} {expected integer but got "a100" for parameter "-x"}
  ? {c1 m2 -x a100} {expected integer but got "a100" for parameter "-x"}

  ? {C om1 -x 200} 200
  ? {C om2 -x 200} 200

  ? {C om1 -x a} {expected integer but got "a" for parameter "-x"}
  ? {C om2 -x a} {expected integer but got "a" for parameter "-x"}

  nsf::configure checkarguments off
  ? {c1 m1  -x a100} a100
  ? {c1 m2 -x a100} {expected integer but got "a100" for parameter "-x"}

  ? {C om1 -x a} a
  ? {C om2 -x a} {expected integer but got "a" for parameter "-x"}

  nsf::configure checkarguments on
}

#
# Test parameter::info with objects/classes and types
#
nx::test case parameter-get {
    nx::Class create C {
        :property foo:integer
        :property o:object,type=::nx::Object
        :property c:class
        :property m:metaclass
    }

    ? {C info lookup parameters create foo} "-foo:integer"
    ? {nsf::parameter::info type [C info lookup parameters create foo]} "integer"

    ? {C info lookup parameters create o} "-o:object,type=::nx::Object"
    ? {nsf::parameter::info type [C info lookup parameters create o]} "::nx::Object"

    ? {C info lookup parameters create c} "-c:class"
    ? {nsf::parameter::info type [C info lookup parameters create c]} "class"

    ? {C info lookup parameters create m} "-m:metaclass"
    ? {nsf::parameter::info type [C info lookup parameters create m]} "metaclass"
}


#
# Test parameter passing on new (disambiguate between -childof as a
# property and as a modifier)
#
nx::test case new-parameter-passing {
  nx::Class create C {
    :property childof
  }

  nx::Object create o

  proc isGlobalNew name {regexp {^::nsf::__#} $name}
  proc isONew name {regexp {^::o::__#} $name}

  ? {isGlobalNew [C new]} 1
  ? {isONew [C new -childof o]} 1

  ? {isGlobalNew [C new --]} 1
  ? {isGlobalNew [C new -- -childof x]} 1

  ? {isONew [C new -childof o -- -childof x]} 1

  #
  # When the parameter is given twice, we get a warning, the second
  # one "wins"
  #
  ? {isONew [C new -childof o -childof xxx]} 0

  # are the properties set correctly?
  set ::o1 [C new -childof o -- -childof x]
  ? {$::o1 cget -childof} x

  set ::o1 [C new -- -childof y]
  ? {$::o1 cget -childof} y

}

nx::test case value=changed {

  nx::Class create C {

    :property a {
      :public object method value=set {object property value} {
        incr ::slotset_$property
        nsf::var::set $object $property [expr {$value + 1}]
      }
    }

    :property -trace set b {
      :public object method value=set {object property value} {
        incr ::slotset_$property
        nsf::var::set -notrace $object $property [expr {$value + 1}]
      }
    }

    :property -accessor public -trace set c {
      :public object method value=set {object property value} {
        incr ::slotset_$property
        nsf::var::set -notrace $object $property [expr {$value + 1}]
      }
    }

    :public method foo {} {
      set :a 100
      set :b 100
      set :c 100
    }
  }
  set ::slotset_a 0
  set ::slotset_b 0
  set ::slotset_c 0

  ? {C create c1} ::c1
  ? {set ::slotset_a} 0
  ? {set ::slotset_b} 0
  ? {set ::slotset_c} 0

  c1 configure
  ? {set ::slotset_a} 0
  ? {set ::slotset_b} 0
  ? {set ::slotset_c} 0

  c1 configure -a 1 -b 1 -c 1
  ? {set ::slotset_a} 1
  ? {set ::slotset_b} 1
  ? {set ::slotset_c} 1
  ? {c1 cget -a} 2
  ? {c1 cget -b} 2
  ? {c1 cget -c} 2

  ? {c1 cget -a} 2
  ? {c1 cget -b} 2
  ? {c1 cget -c} 2


  set ::slotset_a 0
  set ::slotset_b 0
  set ::slotset_c 0
  c1 foo
  ? {set ::slotset_a} 0
  ? {set ::slotset_b} 1
  ? {set ::slotset_c} 1
  ? {c1 cget -a} 100
  ? {c1 cget -b} 101
  ? {c1 cget -c} 101

  set ::slotset_a 0
  set ::slotset_b 0
  set ::slotset_c 0

  ? {c1 a set 200} {::c1: unable to dispatch method 'a'}
  ? {c1 b set 200} {::c1: unable to dispatch method 'b'}
  ? {c1 c set 200} 201
  ? {set ::slotset_a} 0
  ? {set ::slotset_b} 0
  ? {set ::slotset_c} 1
}

nx::test case trace-meta-slot {

  ::nx::MetaSlot create ::nsv::TraceVariableSlot -superclass ::nx::VariableSlot {
    :property {trace {get set}}
    :public method value=set {obj varName value} {
      incr ::trace_set
      #puts stderr "SET nsv_set $obj $varName $value"
      next
    }
    :public method value=get {obj varName} {
      incr ::trace_get
      #puts stderr "GET nsv_set $obj $varName"
      next
    }
  }

  set ::trace_set 0
  set ::trace_get 0
  nx::Class create Foo {

    :property -class ::nsv::TraceVariableSlot x

    :public method exists {var} { info exists :$var }
    :public method get {var}    { set :$var }
    :public method foo {}       { incr :x }

    :create ::f1
  }

  #
  # Change the value of ::f1.x via configure
  #
  ? {set ::trace_set} 0
  ? {set ::trace_get} 0

  ? {::f1 configure -x "1"} ""

  ? {set ::trace_set} 2 ;# 2, since the next triggers the default setter, which has no "-notrace"
  ? {set ::trace_get} 0

  ? {::f1 exists x} 1
  ? {set ::trace_set} 2
  ? {set ::trace_get} 1

  ? {::f1 cget -x} "1"

  ? {set ::trace_set} 2
  ? {set ::trace_get} 3  ;# 3, since the next triggers the default setter, which has no "-notrace"


  #
  # Change the value of ::f1.x via configure again
  #
  ? {::f1 configure -x 2} ""
  ? {::f1 cget -x} "2"

  #
  # Change the value of ::f1.x via variable changes
  #
  set ::trace_set 0
  set ::trace_get 0

  ? {::f1 foo} "3"
  ? {set ::trace_set} 1
  ? {set ::trace_get} 1

  ? {::f1 cget -x} "3"
}

#
# test trace meta slot + default
#
nx::test case trace-meta-slot {

  ::nx::MetaSlot create ::nsv::TraceVariableSlot -superclass ::nx::VariableSlot {
    :property {trace {get set}}
    :public method value=set {obj varName value} {
      incr ::trace_set
      #puts stderr "SET nsv_set $obj $varName $value"
      next
    }
    :public method value=get {obj varName} {
      incr ::trace_get
      #puts stderr "GET nsv_set $obj $varName"
      next
    }
  }

  set ::trace_set 0
  set ::trace_get 0
  nx::Class create Foo {

    :property -class ::nsv::TraceVariableSlot {x 123}
    :property -class ::nsv::TraceVariableSlot {y 456}

    :public method exists {var} { info exists :$var }
    :public method vars {}      { :info vars}
    :public method get {var}    { set :$var }
    :public method foo {}       { incr :x }

    :create ::f1
  }

  #
  # State after creation
  #

  ? {set ::trace_set} 0
  ? {set ::trace_get} 0
  ? {lsort [::f1 vars]} "__initcmd x y"

  #
  # Change the value of ::f1.x via configure
  #

  ? {::f1 cget -x} "123"

  ? {set ::trace_set} 0
  ? {set ::trace_get} 2  ;# since the next triggers the default setter, which has no "-notrace"

  set ::trace_set 0
  set ::trace_get 0

  #
  # Change the value of ::f1.x via configure
  #
  ? {::f1 configure -x 2} ""

  ? {set ::trace_set} 2 ;# since the next triggers the default setter, which has no "-notrace"
  ? {set ::trace_get} 0

  ? {::f1 cget -x} "2"

  #
  # Change the value of ::f1.x via variable changes
  #
  set ::trace_set 0
  set ::trace_get 0

  ? {::f1 foo} "3"
  ? {set ::trace_set} 1
  ? {set ::trace_get} 1

  ? {::f1 cget -x} "3"
}




#
# Testing nsf::parseargs
#

nx::test case parseargs {

    ? {nsf::parseargs {a:int} {1}; info exists a} "1"
    ? {nsf::parseargs {a:int} {1}; info exists b} "0"
    ? {nsf::parseargs {a:int} {a}} {expected integer but got "a" for parameter "a"}

    ? {
        nsf::parseargs {-foo:int {-bar:int 2} baz} {hi}
        list [info exists foo] [info exists bar] [info exists baz]
    } "0 1 1"

    ? {
        nsf::parseargs -asdict {-foo:int {-bar:int 2} baz} {hi}
    } "bar 2 baz hi"

    #
    # Test with empty list of actual arguments
    #
    ? {apply {{} {nsf::parseargs {} {}; llength [info vars]}}} 0
    ? {apply {{} {nsf::parseargs {{x ""}} {}; info vars}}} x
    ? {apply {{} {nsf::parseargs {{x ""} {y ""}} {}; lsort [info vars]}}} {x y}
    ? {apply {{} {nsf::parseargs {{-a 1} {-b} {x ""} {y ""}} {}; lsort [info vars]}}} {a x y}

    ? {set bar} 2
    ? {set baz} hi

    ? {apply {{} {nsf::parseargs a 1; info exists a}}} "1"
    ? {apply {{} {nsf::parseargs {a b} {1 2}; expr {[info exists a]+[info exists b]}}}} "2"
    ? {apply {{} {nsf::parseargs {a b args} {1 2 3 4}; expr {[info exists a]+[info exists b]+[info exists args]}}}} "3"

    ? {apply {{} {nsf::parseargs a 1; expr {"a" in [info vars]};}}} 1

    # TODO: Are the below cases intended?
    #? {apply {{} {nsf::parseargs {a} {}; llength [info vars];}}} 0
    #? {apply {{} {nsf::parseargs {} {1}; llength [info vars];}}} 0
  }

#
# Testing name binding for type=/class/ converter
#

nx::test case type-converter-binding {
  #
  # Binding strategy: Unqualified names are qualified by the namespace
  # of the slot-owning object (domain). Resolution is lazy in the
  # sense that a qualified name is produced but not resolved upon slot
  # definition.
  #
  # set type [namespace qualifiers /obj/]::$type
  #
  # This has the same effect as (repeatedly) writing out
  # type=[namespace current]::$type, or similar, as part of a property
  # or variable spec.
  #

  namespace eval :: {
    namespace eval ns1 {
      namespace eval ns2 {
        nx::Class create A
      }
      nx::Class create A
      nx::Class create B {
        :property b1:object,type=A; # rewritten to ::ns1::A (not ::A as previously!).
        ? [list [:info slots b1] cget -type] ::ns1::A
        :property b2:object,type=ns2::A; # rewritten to ::ns1::ns2::A (not ::ns2::A as previously!).
        ? [list [:info slots b2] cget -type] ::ns1::ns2::A
      }
    }
    nx::Class create A {
      :property a1:object,type=B; # rewritten to ::B
      ? [list [:info slots a1] cget -type] ::B
      :property a2:object,type=ns1::B; # rewritten to ::ns1::B
      ? [list [:info slots a2] cget -type] ::ns1::B
      :property a3:object,type=::B; # untouched
      ? [list [:info slots a3] cget -type] ::B
      :property a4:object,type=[namespace qualifiers [namespace current]::]::B; # untouched, ::B
      ? [list [:info slots a4] cget -type] ::B
      :property a5:object,type=[namespace which B]; # untouched, "", will be dropped
      ? [list [:info slots a5] cget -type] {can't read "type": no such variable}
    }
    nx::Class create B
  }

  ? {catch {::ns1::B create b1 -b1 [::ns1::A new] -b2 [::ns1::ns2::A new]}} 0
}

nx::test case substdefault-hardening {
  nx::Class create K {
    :object property {p2 "$x"}
    :property {p4 "$y"}
    :create k
  }

  ? {::K cget -p2} {$x}
  ? {::k cget -p4} {$y}

  ? {::K object property {p3:substdefault "[[set _ 1]"}} {substdefault: default '[[set _ 1]' is not a complete script}
  ? {::K property {p5:substdefault "[[set _ 2]"}} {substdefault: default '[[set _ 2]' is not a complete script}

  ::K property {p6:substdefault "[set _ 2]]"}
  ? {[::K new] cget -p6} {2]}
  ::K object property {p7:substdefault "[set _ 7]]"}
  ? {::K cget -p7} {7]}

}

nx::test case type-reform {

  namespace eval :: {

    ::nsf::proc foo {p2:object,type=C} {
      return [$p2 info class]
    }
    nx::Class create C
    nx::Object create o {
      :public object method foo {p1:object,type=C} {
        return [$p1 info class]
      }
      :public object method faa {p1:object,type=C} -returns object,type=C {
        return $p1
      }
    }

    ::nsf::method::setter o s1:object,type=C
    ::nsf::method::setter C s2:object,type=C

    ::proc bar args {
      ::nsf::parseargs p1:object,type=C $args
      return [$p1 info class]
    }
    ::proc baz {a} {
      ::nsf::is object,type=C $a
      return [$a info class]
    }
    namespace eval ns1 {
      namespace eval ns2 {
        nx::Class create C
        nx::Class create A {
          :public method foo {p1:object,type=C} {
            return [$p1 info class]
          }
          :public method faa {p1:object,type=C} -returns object,type=C {
            return $p1
          }
        }
        ::nsf::proc foo {p2:object,type=C} {
          return [$p2 info class]
        }
        ::proc bar args {
          ::nsf::parseargs p2:object,type=C $args
          return [$p2 info class]
        }

        ::proc baz {a} {
          ::nsf::is object,type=C $a
          return [$a info class]
        }

        ::nsf::method::setter A s3:object,type=C
        ::nsf::method::setter A -per-object s4:object,type=C

      }
    }
  }

  set ::C ::ns1::ns2::C

  ## In the intrep (param structure), unqualified names will be qualified;
  ? {::o foo [::C new]} ::C
  ? {[::o faa [::C new]] info class} ::C
  ? {[::o s1 [::C new]] info class} ::C
  ? {[[::C new] s2 [::C new]] info class} ::C
  $::C create ::c1
  ? {[[::C new] s2 ::c1] info class} {expected object of type ::C but got "::c1" for parameter "s2"}
  ## the stringrep remains untouched (to allow for cloning, serializing
  ## method records more easily)
  ? {nsf::parameter::info type [::o info object method parameters foo p1]} C

  ? {[::ns1::ns2::A new] foo [$::C new]} $::C
  ? {nsf::parameter::info type [::ns1::ns2::A info method parameters foo p1]} C
  ? {[[::ns1::ns2::A new] faa [$::C new]] info class} $::C
  ? {[[::ns1::ns2::A new] s3 [$::C new]] info class} $::C
  ? {[::ns1::ns2::A s4 [$::C new]] info class} $::C

  ? {::ns1::ns2::foo [$::C new]} $::C

  ? {::foo [::C new]} ::C
  ? {::bar [::C new]} ::C
  ? {::baz [::C new]} ::C
  ? {::ns1::ns2::bar [$::C new]} $::C
  ? {::ns1::ns2::baz [$::C new]} $::C

  ## error msgs now contain the qualified type names
  ::C create ::c
  ? {[::ns1::ns2::A new] foo ::c} \
      "expected object of type ::ns1::ns2::C but got \"::c\" for parameter \"p1\""
}

#
# Check per-object variable default value checking.
# Every test can be performed only once due to the intended semantics
#
nx::test configure -count 1
nx::test case check-object-variables {
  ::nx::Object create o1
  ? {::o1 object variable v01:int 1} {}
  ? {::o1 object variable v11:int a} {expected integer but got "a"}

  ? {::o1 object variable v02:object,type=nx::Object ::nx::Object} {}
  ? {::o1 object variable v12:object,type=nx::Object a} {expected object but got "a"}

  ? {::o1 object variable v03:upper A} {}
  ? {::o1 object variable v13:upper a} {expected upper but got "a"}

  ? {::o1 object variable v04:lower,1..n "a b c"} {}
  ? {::o1 object variable v14:lower,1..n "a B c"} {invalid value in "a B c": expected lower but got "B"}

  ? {::o1 object variable err:object,type:nx::Object ::nx::Object} {invalid value constraints "type:nx::Object"}
}



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