# -*- Tcl -*-

package prefer latest

package req nx::test

#
# make sure, the defaultAccessor is "none"
#

#puts stderr "*** default defaultAccessor '[nx::configure defaultAccessor]'"
nx::configure defaultAccessor none

#####################################################################
# class-level properties
#####################################################################
#
# Test class-level properties and variables without -incremental
#
nx::test case class-level {

  nx::Class create C {
    :property {a a1}
    :property -accessor public {b b1}
    :property -accessor protected {c c1}
    :property -accessor private {d d1}
    :property -accessor none {e e1}
    :variable va va1
    :variable -accessor public vb vb1
    :variable -accessor protected vc vc1
    :variable -accessor private vd vd1
    :variable -accessor none ve ve1

    # a non-configurable property is a variable
    :property -accessor none -configurable false {vf vf1}
    
    :public method call-local {v} {: -local $v get}
    
    :create c1
  }

  #
  # just the public properties are accessible via the configure interface
  #
  ? {c1 info lookup syntax configure} {?-e /value/? ?-a /value/? ?-b /value/? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?}

  ? {lsort [C info slots]} "::C::slot::____C.d ::C::slot::____C.vd ::C::slot::a ::C::slot::b ::C::slot::c ::C::slot::e ::C::slot::va ::C::slot::vb ::C::slot::vc ::C::slot::ve ::C::slot::vf"


  ? {::C::slot::a definition} "::C property -accessor none {a a1}"
  ? {::C::slot::b definition} "::C property -accessor public {b b1}"
  ? {::C::slot::c definition} "::C variable -accessor protected c c1"
  ? {::C::slot::____C.d definition} "::C variable -accessor private d d1"
  ? {::C::slot::e definition} "::C property -accessor none {e e1}"
  ? {::C::slot::va definition} "::C variable -accessor none va va1"
  ? {::C::slot::vb definition} "::C variable -accessor public vb vb1"
  ? {::C::slot::vc definition} "::C variable -accessor protected vc vc1"
  ? {::C::slot::____C.vd definition} "::C variable -accessor private vd vd1"
  ? {::C::slot::ve definition} "::C variable -accessor none ve ve1"
  ? {::C::slot::vf definition} "::C variable -accessor none vf vf1"

  
  ? {c1 cget -a} a1
  ? {c1 cget -b} b1
  ? {c1 cget -c} "cget: unknown configure parameter -c"
  ? {c1 cget -d} "cget: unknown configure parameter -d"
  ? {c1 cget -va} "cget: unknown configure parameter -va"
  ? {c1 cget -vb} "cget: unknown configure parameter -vb"
  ? {c1 cget -vc} "cget: unknown configure parameter -vc"
  ? {c1 cget -vd} "cget: unknown configure parameter -vd"
  ? {c1 cget -ve} "cget: unknown configure parameter -ve"
  ? {c1 cget -vf} "cget: unknown configure parameter -vf"

  #
  # No incremental used, so "a" and "e" have no slots
  #
  
  ? {c1 info lookup method a} ""  
  ? {c1 info lookup method b} "::nsf::classes::C::b"
  ? {c1 info lookup method c} "::nsf::classes::C::c"
  ? {c1 info lookup method d} "::nsf::classes::C::d"
  ? {c1 info lookup method e} ""  
  ? {c1 info lookup method f} ""  

  ? {c1 info lookup method va} "" 
  ? {c1 info lookup method vb} "::nsf::classes::C::vb"
  ? {c1 info lookup method vc} "::nsf::classes::C::vc"
  ? {c1 info lookup method vd} "::nsf::classes::C::vd"
  ? {c1 info lookup method ve} "" 
  ? {c1 info lookup method vf} "" 

  #
  # Check protection of accessors
  #
  
  ? {nsf::method::property C b call-protected} 0
  ? {nsf::method::property C c call-protected} 1
  ? {nsf::method::property C d call-protected} 1  
  ? {nsf::method::property C vb call-protected} 0
  ? {nsf::method::property C vc call-protected} 1
  ? {nsf::method::property C vd call-protected} 1

  ? {nsf::method::property C b call-private} 0
  ? {nsf::method::property C c call-private} 0
  ? {nsf::method::property C d call-private} 1
  ? {nsf::method::property C vb call-private} 0
  ? {nsf::method::property C vc call-private} 0
  ? {nsf::method::property C vd call-private} 1

  #
  # do we have variables set?
  #
  
  ? {c1 eval "info exists :a"} 1
  ? {c1 eval "info exists :b"} 1
  ? {c1 eval "info exists :c"} 1
  ? {c1 eval "info exists :d"} 0
  ? {c1 eval "info exists :va"} 1
  ? {c1 eval "info exists :vb"} 1
  ? {c1 eval "info exists :vc"} 1
  ? {c1 eval "info exists :vd"} 0
  ? {c1 eval "info exists :ve"} 1
  ? {c1 eval "info exists :vf"} 1

  #
  # can we call the accessor directly or via "eval"
  #
  
  ? {c1 a} {::c1: unable to dispatch method 'a'}
  ? {c1 b get} b1
  ? {c1 c} {::c1: unable to dispatch method 'c'}
  ? {c1 d} {::c1: unable to dispatch method 'd'}
 
  ? {c1 eval ":a"} {::c1: unable to dispatch method 'a'}
  ? {c1 eval ":b get"} b1
  ? {c1 eval ":c get"} c1
  ? {c1 eval ":d"} {::c1: unable to dispatch method 'd'}
  
  
  ? {c1 va} {::c1: unable to dispatch method 'va'}
  ? {c1 vb get} vb1
  ? {c1 vc} {::c1: unable to dispatch method 'vc'}
  ? {c1 vd} {::c1: unable to dispatch method 'vd'}
  
  ? {c1 eval ":va"} {::c1: unable to dispatch method 'va'}
  ? {c1 eval ":vb get"} vb1
  ? {c1 eval ":vc get"} vc1
  ? {c1 eval ":vd"} {::c1: unable to dispatch method 'vd'}

  #
  # check the behavior of "private" properties and variables
  #
  ? {c1 call-local d} d1
  ? {c1 call-local vd} vd1

  ? {lsort [c1 info vars]} "__private a b c e va vb vc ve vf"
  ? {c1 eval "array get :__private"} "::C,vd vd1 ::C,d d1"

  #
  # check incremental operations for properties (should fail in all
  # cases)
  #

  set unknowns "valid are: {assign definition destroy get getParameterSpec getPropertyDefinitionOptions onError parameter reconfigure setCheckedInstVar}"
  ? {c1 b add x} {property b of ::C is not multivalued}
  #? {c1 b add x} "method 'add' unknown for slot ::C::slot::b; $unknowns"
  ? {c1 c add x} {::c1: unable to dispatch method 'c'}
  ? {c1 eval {:c add x}} {property c of ::C is not multivalued}
  #? {c1 eval {:c add x}} "method 'add' unknown for slot ::C::slot::c; $unknowns"
  ? {c1 d add x} {::c1: unable to dispatch method 'd'}
  ? {c1 eval {:d add x}} {::c1: unable to dispatch method 'd'}
  ? {c1 e add x} {::c1: unable to dispatch method 'e'}

  #
  # check incremental operations for variables (should fail in all
  # cases)
  #

  ? {c1 va add x} {::c1: unable to dispatch method 'va'}
  ? {c1 vb add x} {property vb of ::C is not multivalued}
  #? {c1 vb add x} "method 'add' unknown for slot ::C::slot::vb; $unknowns"
  ? {c1 vc add x} {::c1: unable to dispatch method 'vc'}
  ? {c1 eval {:vc add x}} {property vc of ::C is not multivalued}
  #? {c1 eval {:vc add x}} "method 'add' unknown for slot ::C::slot::vc; $unknowns"
  ? {c1 vd add x} {::c1: unable to dispatch method 'vd'}
  ? {c1 eval {:vd add x}} {::c1: unable to dispatch method 'vd'}
  ? {c1 ve add x} {::c1: unable to dispatch method 've'}


  #
  # The accessor should be a setter due to incremental
  #

  ? {C info method definition b} {::C public forward b -prefix value= ::C::slot::b %1 %self b}

  #
  # check error message on a typo. The following command does a
  # recreate.
  #
  ? {C property -accessor proceted {b b1}} {accessor value 'proceted' invalid; might be one of public|protected|private or none}

  #
  # The accessor is deleted due to the error
  #

  ? {C info method definition b} {}
}



 
#
# test class-level properties and variables with -incremental
#
nx::test case class-level-incremental {

  nx::Class create CC {
    :property -incremental {a a1}
    :property -accessor public -incremental {b b1}
    :property -accessor protected -incremental {c c1}
    :property -accessor private -incremental {d d1}
    :property -accessor none -incremental {e e1}
    
    :variable -incremental va va1
    :variable -accessor public -incremental vb vb1
    :variable -accessor protected -incremental vc vc1
    :variable -accessor private -incremental vd vd1
    :variable -accessor none -incremental ve ve1
    
    :public method call-local {v} {: -local $v get}
    :public method add-local {var value} {: -local $var add $value}
    
    :create c1
  }
  
  #
  # The use of "-incremental" implies multivalued
  #
  ? {c1 info lookup syntax configure} {?-e /value .../? ?-a /value .../? ?-b /value .../? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?}
  
  ? {c1 cget -a} a1
  ? {c1 cget -b} b1
  ? {c1 cget -c} "cget: unknown configure parameter -c"
  ? {c1 cget -d} "cget: unknown configure parameter -d"
  ? {c1 cget -va} "cget: unknown configure parameter -va"
  ? {c1 cget -vb} "cget: unknown configure parameter -vb"
  ? {c1 cget -vc} "cget: unknown configure parameter -vc"
  ? {c1 cget -vd} "cget: unknown configure parameter -vd"

  #
  # The use of "-incremental" implies an accessor
  #
  
  ? {c1 info lookup method a} "::nsf::classes::CC::a"  ;# forcing accessor
  ? {c1 info lookup method b} "::nsf::classes::CC::b"
  ? {c1 info lookup method c} "::nsf::classes::CC::c"
  ? {c1 info lookup method d} "::nsf::classes::CC::d"

  ? {c1 info lookup method va} "::nsf::classes::CC::va" ;# forcing accessor
  ? {c1 info lookup method vb} "::nsf::classes::CC::vb"
  ? {c1 info lookup method vc} "::nsf::classes::CC::vc"
  ? {c1 info lookup method vd} "::nsf::classes::CC::vd"

  #
  # The use of "-incremental" implies an accessor, which is public
  #
  
  ? {nsf::method::property CC a call-protected} 0
  ? {nsf::method::property CC b call-protected} 0
  ? {nsf::method::property CC c call-protected} 1
  ? {nsf::method::property CC d call-protected} 1  
  ? {nsf::method::property CC va call-protected} 0
  ? {nsf::method::property CC vb call-protected} 0
  ? {nsf::method::property CC vc call-protected} 1
  ? {nsf::method::property CC vd call-protected} 1

  ? {nsf::method::property CC a call-private} 0
  ? {nsf::method::property CC b call-private} 0
  ? {nsf::method::property CC c call-private} 0
  ? {nsf::method::property CC d call-private} 1
  ? {nsf::method::property CC va call-private} 0
  ? {nsf::method::property CC vb call-private} 0
  ? {nsf::method::property CC vc call-private} 0
  ? {nsf::method::property CC vd call-private} 1

  #
  # do we have variables set?
  #
  
  ? {c1 eval "info exists :a"} 1
  ? {c1 eval "info exists :b"} 1
  ? {c1 eval "info exists :c"} 1
  ? {c1 eval "info exists :d"} 0
  ? {c1 eval "info exists :va"} 1
  ? {c1 eval "info exists :vb"} 1
  ? {c1 eval "info exists :vc"} 1
  ? {c1 eval "info exists :vd"} 0

  #
  # can we call the accessor directly or via "eval"
  #
  
  ? {c1 a get} a1
  ? {c1 b get} b1
  ? {c1 c} {::c1: unable to dispatch method 'c'}
  ? {c1 d} {::c1: unable to dispatch method 'd'}
 
  ? {c1 eval ":a get"} a1
  ? {c1 eval ":b get"} b1
  ? {c1 eval ":c get"} c1
  ? {c1 eval ":d"} {::c1: unable to dispatch method 'd'}
  
  
  ? {c1 va get} va1
  ? {c1 vb get} vb1
  ? {c1 vc} {::c1: unable to dispatch method 'vc'}
  ? {c1 vd} {::c1: unable to dispatch method 'vd'}
  
  ? {c1 eval ":va get"} va1
  ? {c1 eval ":vb get"} vb1
  ? {c1 eval ":vc get"} vc1
  ? {c1 eval ":vd get"} {::c1: unable to dispatch method 'vd'}

  #
  # check the behavior of "private" properties and variables
  #
  ? {c1 call-local d} d1
  ? {c1 call-local vd} vd1

  ? {lsort [c1 info vars]} "__private a b c e va vb vc ve"
  ? {c1 eval "array get :__private"} "::CC,vd vd1 ::CC,d d1"

  #
  # check incremental operations for properties
  #

  ? {c1 a add x} {x a1}

  ? {c1 b add x} {x b1}
  ? {c1 c add x} {::c1: unable to dispatch method 'c'}
  ? {c1 eval {:c add x}} {x c1}
  ? {c1 d add x} {::c1: unable to dispatch method 'd'}
  ? {c1 eval {:d add x}} {::c1: unable to dispatch method 'd'}
  ? {c1 add-local d x} {x d1}
  ? {c1 e add x} {x e1}
  ? {c1 e delete x} {e1}
  ? {c1 e get} {e1}
  ? {c1 e delete -nocomplain x} {e1}
  ? {c1 e delete x} "::c1: 'x' is not in variable 'e' (values are: 'e1')"
  ? {c1 e delete -nocomplain e1} ""
  ? {c1 e get} ""
  ? {c1 e unset} ""
  ? {c1 e get} {can't read "e": no such variable}

  #
  # check incremental operations for variables
  #

  ? {c1 va add x} {x va1}
  ? {c1 vb add x} {x vb1}
  ? {c1 vc add x} {::c1: unable to dispatch method 'vc'}
  ? {c1 eval {:vc add x}} {x vc1}
  ? {c1 vd add x} {::c1: unable to dispatch method 'vd'}
  ? {c1 eval {:vd add x}} {::c1: unable to dispatch method 'vd'}
  ? {c1 add-local vd x} {x vd1}
  ? {c1 ve add x} {x ve1}
  ? {c1 ve delete x} {ve1}
  ? {c1 ve get} {ve1}
  ? {c1 ve delete -nocomplain x} {ve1}
  ? {c1 ve delete x} "::c1: 'x' is not in variable 've' (values are: 've1')"
  ? {c1 ve delete -nocomplain ve1} ""
  ? {c1 ve get} ""
  ? {c1 ve unset} ""
  ? {c1 ve get} {can't read "ve": no such variable}

  #
  # The accessor should be a forwarder due to incremental
  #

  ? {CC info method definition b} {::CC public forward b -prefix value= ::CC::slot::b %1 %self b}

  #
  # check error message
  #
  ? {CC property -accessor proceted -incremental {b b1}} {accessor value 'proceted' invalid; might be one of public|protected|private or none}

  #
  # The accessor is deleted due to the error
  #
  ? {CC info method definition b} {}


}

#####################################################################
# object-level properties 
#####################################################################
#
# Test object-level properties and variables without -incremental
#
nx::test case object-level {
  
  nx::Object create o1 {
    :object property {a a1}
    :object property -accessor public {b b1}
    :object property -accessor protected {c c1}
    :object property -accessor private {d d1}
    :object property -accessor none {e e1}
    
    :object variable va va1
    :object variable -accessor public vb vb1
    :object variable -accessor protected vc vc1
    :object variable -accessor private vd vd1
    :object variable -accessor none ve ve1
    
    :public object method call-local {v} {: -local $v get}
    
  }
  
  #
  # check the slot for "a"
  #
  ? {o1 info lookup slots a} ::o1::per-object-slot::a

  #
  # just the public properties are accessible via the configure interface
  #
  
  ? {o1 info lookup syntax configure} {?-e /value/? ?-a /value/? ?-b /value/? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?}

  #
  # just the public properties are accessible via the cget interface
  #
  
  ? {o1 cget -a} a1
  ? {o1 cget -b} b1
  ? {o1 cget -c} {cget: unknown configure parameter -c}
  ? {o1 cget -d} {cget: unknown configure parameter -d}
  ? {o1 cget -va} {cget: unknown configure parameter -va}
  ? {o1 cget -vb} {cget: unknown configure parameter -vb}
  ? {o1 cget -vc} {cget: unknown configure parameter -vc}
  ? {o1 cget -vd} {cget: unknown configure parameter -vd}
  

  #
  # We do not have accessors in the default case and in the explicit "none" case.
  #

  ? {o1 info lookup method a} ""
  ? {o1 info lookup method b} "::o1::b"
  ? {o1 info lookup method c} "::o1::c"
  ? {o1 info lookup method d} "::o1::d" 
  ? {o1 info lookup method e} ""

  ? {o1 info lookup method va} ""
  ? {o1 info lookup method vb} "::o1::vb"
  ? {o1 info lookup method vc} "::o1::vc"
  ? {o1 info lookup method vd} "::o1::vd"
  ? {o1 info lookup method ve} ""

  #
  # check public/protected/private settings
  #
  ? {nsf::method::property o1 b call-protected} 0
  ? {nsf::method::property o1 c call-protected} 1
  ? {nsf::method::property o1 d call-protected} 1
  ? {nsf::method::property o1 vb call-protected} 0
  ? {nsf::method::property o1 vc call-protected} 1
  ? {nsf::method::property o1 vd call-protected} 1
  
  ? {nsf::method::property o1 b call-private} 0
  ? {nsf::method::property o1 c call-private} 0
  ? {nsf::method::property o1 d call-private} 1
  ? {nsf::method::property o1 vb call-private} 0
  ? {nsf::method::property o1 vc call-private} 0
  ? {nsf::method::property o1 vd call-private} 1

  #
  # check if instance variables are created
  #
  
  ? {o1 eval "info exists :a"} 1
  ? {o1 eval "info exists :b"} 1
  ? {o1 eval "info exists :c"} 1
  ? {o1 eval "info exists :d"} 0
  ? {o1 eval "info exists :e"} 1
  ? {o1 eval "info exists :va"} 1
  ? {o1 eval "info exists :vb"} 1
  ? {o1 eval "info exists :vc"} 1
  ? {o1 eval "info exists :vd"} 0
  ? {o1 eval "info exists :ve"} 1

  #
  # check if we can dispatch accessors directly or via "eval"
  #
  
  ? {o1 a} {::o1: unable to dispatch method 'a'}
  ? {o1 b get} b1
  ? {o1 c} {::o1: unable to dispatch method 'c'}
  ? {o1 d} {::o1: unable to dispatch method 'd'}
  
  ? {o1 eval ":a"} {::o1: unable to dispatch method 'a'}
  ? {o1 eval ":b get"} b1
  ? {o1 eval ":c get"} c1
  ? {o1 eval ":d"} {::o1: unable to dispatch method 'd'}

  ? {o1 va} {::o1: unable to dispatch method 'va'}
  ? {o1 vb get} vb1
  ? {o1 vc} {::o1: unable to dispatch method 'vc'}
  ? {o1 vd} {::o1: unable to dispatch method 'vd'}
  
  ? {o1 eval ":va"} {::o1: unable to dispatch method 'va'}
  ? {o1 eval ":vb get"} vb1
  ? {o1 eval ":vc get"} vc1
  ? {o1 eval ":vd"} {::o1: unable to dispatch method 'vd'}

  #
  # check dispatch of private accessors and private variables
  #
  ? {o1 call-local d} d1  
  ? {o1 call-local vd} vd1
  
  ? {lsort [o1 info vars]} "__private a b c e va vb vc ve"
  ? {o1 eval "array get :__private"} "::o1,d d1 ::o1,vd vd1"

  #
  # check error message
  #
  ? {o1 object property -accessor proceted {b b1}} {accessor value 'proceted' invalid; might be one of public|protected|private or none}
}

#
# test object-level properties and variables with -incremental
#
nx::test case object-level-incremental {

  nx::Object create o1 {
    :object property -incremental {a a1}
    :object property -accessor public -incremental {b b1}
    :object property -accessor protected -incremental {c c1}
    :object property -accessor private -incremental {d d1}
    :object property -accessor none -incremental {e e1}
    
    :object variable -incremental va va1
    :object variable -accessor public -incremental vb vb1
    :object variable -accessor protected -incremental vc vc1
    :object variable -accessor private -incremental vd vd1
    :object variable -accessor none -incremental ve ve1
    
    :public object method call-local {v} {: -local $v get}
    :public object method add-local {var value} {: -local $var add $value}
  }
  
  #
  # The use of "-incremental" implies multivalued
  #
  ? {o1 info lookup syntax configure} {?-e /value .../? ?-a /value .../? ?-b /value .../? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?}
  
  ? {o1 cget -a} a1
  ? {o1 cget -b} b1
  ? {o1 cget -c} {cget: unknown configure parameter -c}
  ? {o1 cget -d} {cget: unknown configure parameter -d}
  ? {o1 cget -va} {cget: unknown configure parameter -va}
  ? {o1 cget -vb} {cget: unknown configure parameter -vb}
  ? {o1 cget -vc} {cget: unknown configure parameter -vc}
  ? {o1 cget -vd} {cget: unknown configure parameter -vd}

  #
  # The use of "-incremental" implies an accessor
  #
  
  ? {o1 info lookup method a} "::o1::a"  ;# forcing accessor
  ? {o1 info lookup method b} "::o1::b"
  ? {o1 info lookup method c} "::o1::c"
  ? {o1 info lookup method d} "::o1::d"

  ? {o1 info lookup method va} "::o1::va" ;# forcing accessor
  ? {o1 info lookup method vb} "::o1::vb"
  ? {o1 info lookup method vc} "::o1::vc"
  ? {o1 info lookup method vd} "::o1::vd"

  #
  # The use of "-incremental" implies an accessor, which is public
  #
  
  ? {nsf::method::property o1 a call-protected} 0
  ? {nsf::method::property o1 b call-protected} 0
  ? {nsf::method::property o1 c call-protected} 1
  ? {nsf::method::property o1 d call-protected} 1  
  ? {nsf::method::property o1 va call-protected} 0
  ? {nsf::method::property o1 vb call-protected} 0
  ? {nsf::method::property o1 vc call-protected} 1
  ? {nsf::method::property o1 vd call-protected} 1

  ? {nsf::method::property o1 a call-private} 0
  ? {nsf::method::property o1 b call-private} 0
  ? {nsf::method::property o1 c call-private} 0
  ? {nsf::method::property o1 d call-private} 1
  ? {nsf::method::property o1 va call-private} 0
  ? {nsf::method::property o1 vb call-private} 0
  ? {nsf::method::property o1 vc call-private} 0
  ? {nsf::method::property o1 vd call-private} 1

  #
  # do we have variables set?
  #
  
  ? {o1 eval "info exists :a"} 1
  ? {o1 eval "info exists :b"} 1
  ? {o1 eval "info exists :c"} 1
  ? {o1 eval "info exists :d"} 0
  ? {o1 eval "info exists :va"} 1
  ? {o1 eval "info exists :vb"} 1
  ? {o1 eval "info exists :vc"} 1
  ? {o1 eval "info exists :vd"} 0

  #
  # can we call the accessor directly or via "eval"
  #
  
  ? {o1 a get} a1
  ? {o1 b get} b1
  ? {o1 c} {::o1: unable to dispatch method 'c'}
  ? {o1 d} {::o1: unable to dispatch method 'd'}
 
  ? {o1 eval ":a get"} a1
  ? {o1 eval ":b get"} b1
  ? {o1 eval ":c get"} c1
  ? {o1 eval ":d"} {::o1: unable to dispatch method 'd'}
  
  
  ? {o1 va get} va1
  ? {o1 vb get} vb1
  ? {o1 vc} {::o1: unable to dispatch method 'vc'}
  ? {o1 vd} {::o1: unable to dispatch method 'vd'}
  
  ? {o1 eval ":va get"} va1
  ? {o1 eval ":vb get"} vb1
  ? {o1 eval ":vc get"} vc1
  ? {o1 eval ":vd"} {::o1: unable to dispatch method 'vd'}

  #
  # check the behavior of "private" properties and variables
  #
  ? {o1 call-local d} d1
  ? {o1 call-local vd} vd1

  ? {lsort [o1 info vars]} "__private a b c e va vb vc ve"
  ? {o1 eval "array get :__private"} "::o1,d d1 ::o1,vd vd1"

  #
  # check incremental operations for properties
  #

  ? {o1 a add x} {x a1}

  ? {o1 b add x} {x b1}
  ? {o1 c add x} {::o1: unable to dispatch method 'c'}
  ? {o1 eval {:c add x}} {x c1}
  ? {o1 d add x} {::o1: unable to dispatch method 'd'}
  ? {o1 eval {:d add x}} {::o1: unable to dispatch method 'd'}
  ? {o1 add-local d x} {x d1}
  ? {o1 e add x} {x e1}

  #
  # check incremental operations for variables
  #

  ? {o1 va add x} {x va1}
  ? {o1 vb add x} {x vb1}
  ? {o1 vc add x} {::o1: unable to dispatch method 'vc'}
  ? {o1 eval {:vc add x}} {x vc1}
  ? {o1 vd add x} {::o1: unable to dispatch method 'vd'}
  ? {o1 eval {:vd add x}} {::o1: unable to dispatch method 'vd'}
  ? {o1 add-local vd x} {x vd1}
  ? {o1 ve add x} {x ve1}


  #
  # The accessor should be a forwarder due to incremental
  #

  ? {o1 info object method definition b} {::o1 public object forward b -prefix value= ::o1::per-object-slot::b %1 %self b}

  #
  # check error message
  #
  ? {o1 object property -accessor proceted {b b1}} {accessor value 'proceted' invalid; might be one of public|protected|private or none}

  #
  # The accessor is deleted due to the error
  #

  ? {o1 info object method definition b} {}

}

#
# Tests for experimental "value add", "value assign" ...
#

# nx::test case property-value-incremental {

#   nx::Object create o1 {
#     :object property -incremental {a a1}
#   }

#   ? {o1 a add x} {x a1}
#   ? {o1 a assign {a1}} {a1}
  
#   nsf::configure debug 2
#   ? {o1 a value add x    } {x a1}
#   ? {o1 a value assign {a b c}} {a b c}
#   ? {o1 a value get      } {a b c}
#   ? {o1 a value add x    } {x a b c}
#   ? {o1 a value add z end} {x a b c z}
# }

#
# Test interactions between multiplicity and incremental
#
nx::test case property-incremental-multiplicity {

  nx::Object create o1 {
    :object property -incremental a:integer,0..n
    :object property -incremental b:integer,1..n
    :object property -incremental c:integer,0..1
    :object property -incremental d:integer,1..1 
  }

  ? {o1 info object slots a} "::o1::per-object-slot::a"
  ? {[o1 info object slots a] eval {set :multiplicity}} "0..n"
  ? {[o1 info object slots b] eval {set :multiplicity}} "1..n"
  ? {[o1 info object slots c] eval {set :multiplicity}} "0..n"
  ? {[o1 info object slots d] eval {set :multiplicity}} "1..n"

  ? {o1 info variable definition [o1 info object variables a]} \
      "::o1 object property -accessor public -incremental a:integer,0..n"
  ? {o1 info variable definition [o1 info object variables b]} \
      "::o1 object property -accessor public -incremental b:integer,1..n"
  ? {o1 info variable definition [o1 info object variables c]} \
      "::o1 object property -accessor public -incremental c:integer,0..n"
  ? {o1 info variable definition [o1 info object variables d]} \
      "::o1 object property -accessor public -incremental d:integer,1..n"

  ? {o1 a set {1 2 3}} {1 2 3}
  ? {o1 b set {1 2 3}} {1 2 3}

  ? {o1 a set ""} {}
  ? {o1 b set ""} {invalid value for parameter 'value': list is not allowed to be empty}
  ? {o1 c set ""} {}
  ? {o1 d set ""} {invalid value for parameter 'value': list is not allowed to be empty}
  
}

#####################################################################
# tests with class object
#####################################################################
#
# check performance of class-level configure and cget
#
nx::test case class-object-properties {

  nx::Class create C {
    :property {a a1}
    :variable va va1
    
    :object property {b b1}
    :object variable vb b1
    
    :create c1
  }

  #
  # just the public properties are accessible via the configure interface
  #
  
  ? {c1 info lookup syntax configure} {?-a /value/? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?}

  ? {c1 cget -a} a1
  ? {c1 configure -a a2} ""

  ? {C info lookup syntax configure} {?-b /value/? ?-mixins /mixinreg .../? ?-superclasses /class .../? ?-filters /filterreg .../? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?}

  ? {C cget -b} b1
  ? {C configure -b b2} ""
  ? {C cget -b} b2
}

nx::test case exists-on-props {
  nx::Class create C {
    :object property {A A1}
    :property {a a1}
    
    :object property -accessor public {B B1}
    :property -accessor public {b b1}
    :object property -accessor public BB
    :property -accessor public bb

    :object property -accessor protected {C C1}
    :property -accessor protected {c c1}
    
    :object property -accessor private {D D1}
    :property -accessor private {d d1}

    :create c1

    :public object method do {args} {
      : {*}$args
    }

    :public method do {args} {
      : {*}$args
    }

    :public object method doLocal {args} {
      : -local {*}$args
    }
    
    :public method doLocal {args} {
      : -local {*}$args
    }
    
  }

  ? {::C A exists} \
      "method 'A' unknown for ::C; in order to create an instance of class ::C, consider using '::C create A ?...?'"
  ? {::c1 a exists} "::c1: unable to dispatch method 'a'"

  ? {::C B exists} 1
  ? {::c1 b exists} 1

  ? {::C B get} "B1"
  ? {::c1 b get} "b1"

  ? {::C BB exists} 0
  ? {::c1 bb exists} 0
  
  ? {::C do C exists} 1
  ? {::C eval {info exists :C}} 1
  ? {::c1 do c exists} 1
  ? {::c1 eval {info exists :c}} 1

  ? {::C do C unset} ""
  ? {::c1 do c unset} ""

  ? {::C do C exists} 0
  ? {::C eval {info exists :C}} 0
  ? {::c1 do c exists} 0
  ? {::c1 eval {info exists :c}} 0

  # interaction: exists + private
  
  ? {::C doLocal D exists} 1
  ? {::c1 doLocal d exists} 1

  ? {::C doLocal D unset} ""
  ? {::c1 doLocal d unset} ""

  ? {::C doLocal D exists} 0
  ? {::c1 doLocal d exists} 0

  ? {::C D exists} \
      "method 'D' unknown for ::C; in order to create an instance of class ::C, consider using '::C create D ?...?'"
  ? {::c1 d exists} "::c1: unable to dispatch method 'd'"
  
}


#####################################################################
# performance tests
#####################################################################
nx::test configure -count 10000
#
# check performance of class-level configure and cget
#
nx::test case class-level-perf {

  nx::Class create C {
    :property {a a1}
    :property -accessor public {b b1}
    :property -accessor protected {c c1}
    :property -accessor private {d d1}
    :property -accessor none {e e1}
    
    :variable va va1
    :variable -accessor public vb vb1
    :variable -accessor protected vc vc1
    :variable -accessor private vd vd1
    :variable -accessor none ve ve1
    
    :create c1
  }

  nx::Class create D {
    :object property {cp 101}
    :property {a a1}
    :property -accessor public {b b1}
    :property -accessor protected {c c1}
    :property -accessor private {d d1}
    :property -accessor none {e e1}
    
    :variable va va1
    :variable -accessor public vb vb1
    :variable -accessor protected vc vc1
    :variable -accessor private vd vd1
    :variable -accessor none ve ve1
    
    :create d1
  }

  #
  # just the public properties are accessible via the configure interface
  #
  package require nx::volatile
  
  ? {c1 info lookup syntax configure} {?-e /value/? ?-a /value/? ?-b /value/? ?-volatile? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?}

  set e [C eval :__object_configureparameter]
  ? {C eval :__object_configureparameter} $e

  ? {c1 cget -a} a1
  ? {c1 configure -a a2} ""

  ? {C configure -class ::nx::Class} ""
  ? {C cget -class} ::nx::Class
  ? {C cget -mixin} ""
  ? {C cget -filter} ""
  
  #  ? {C cget -noinit} 0
  ? {C cget -volatile} 0

  #
  # check influence of class-level per-object properties
  #
  ? {d1 info lookup syntax configure} {?-e /value/? ?-a /value/? ?-b /value/? ?-volatile? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?}

  set e [D eval :__object_configureparameter]
  ? {D eval :__object_configureparameter} $e

  ? {d1 cget -a} a1
  ? {d1 configure -a a2} ""

  ? {D configure -class ::nx::Class} ""
  ? {D cget -class} ::nx::Class

  ? {D cget -cp} 101
  ? {D configure -cp 102} ""
  ? {D cget -cp} 102
}

#
# check performance of class-level configure and cget
#

nx::test case object-level-perf {

  nx::Object create o1 {
    :object property {a a1}
    :object property -accessor public {b b1}
    :object property -accessor protected {c c1}
    :object property -accessor private {d d1}
    :object property -accessor none {e e1}
    
    :object variable va va1
    :object variable -accessor public vb vb1
    :object variable -accessor protected vc vc1
    :object variable -accessor private vd vd1
    :object variable -accessor none ve ve1
  }

  #
  # just the public properties are accessible via the configure interface
  #
  
  ? {o1 info lookup syntax configure} {?-e /value/? ?-a /value/? ?-b /value/? ?-object-mixins /mixinreg .../? ?-object-filters /filterreg .../? ?-class /class/? ?/__initblock/?}

  set e [o1 eval :__object_configureparameter]

  ? {o1 eval :__object_configureparameter} $e

  ? {o1 cget -a} a1
  ? {o1 configure -a a2} ""

  ? {o1 b get} b1
  ? {o1 b set b2} "b2"

  ? {o1 configure -class ::nx::Object} ""
  ? {o1 cget -class} ::nx::Object
}

nx::test case extend-parent-class-info {

  nx::Class create Foo
  nx::Class create Bar -superclass Foo
  ? {llength [Bar info lookup parameters create]} 5
  #
  # extend the superclass, subclass should become aware of this
  #
  Foo property y
  ? {llength [Bar info lookup parameters create]} 6
}

nx::test case extend-parent-class-info-cache {

  nx::Class create Foo
  nx::Class create Bar -superclass Foo
  ? {llength [Bar info lookup parameters create]} 5
  #
  # Let Bar cache the objectparameters, and extend later the
  # superclass
  #
  Bar new
  Foo property y
  ? {llength [Bar info lookup parameters create]} 6
}

nx::test case extend-parent-class-info-cache-configure {

  nx::Class create Foo
  nx::Class create Bar -superclass Foo
  ? {llength [Bar info lookup parameters create]} 5
  #
  # Let Bar cache the objectparameters, and extend later the
  # superclass
  #
  Bar create b1
  Foo property y
  # access objectparameter indirectly via configure
  ? {b1 configure -y 2} ""
}

nx::test case extend-class-mixin-info {
  
  nx::Class create Baz
  nx::Class create Foo -mixin Baz
  nx::Class create Bar -mixin Foo
  Bar create bar; # cache becomes hot!
  ? {llength [Bar info lookup parameters create]} 5

  Foo property y
  ? {llength [Bar info lookup parameters create]} 6

  Baz property z
  ? {llength [Bar info lookup parameters create]} 7

  Baz delete property z
  ? {llength [Bar info lookup parameters create]} 6

  Foo delete property y
  ? {llength [Bar info lookup parameters create]} 5

}

nx::test case extend-class-mixin-configure {
  
  nx::Class create Baz
  nx::Class create Foo -mixin Baz
  nx::Class create Bar -mixin Foo
  Bar create bar; # cache becomes hot!

  Foo property y
  bar configure -y 1
  ? {bar cget -y} 1

  Baz property z
  bar configure -z 2
  ? {bar cget -z} 2
  bar configure -y 3
  ? {bar cget -y} 3

  Bar property w
  bar configure -w 4
  ? {bar cget -w} 4

}

nx::test case dynamic-transitive-mixin-info {
  
  nx::Class create Foo
  nx::Class create Bar
  nx::Class create Baz

  Bar create bar; # cache object parameters in class Bar
  Baz create baz; # cache object parameters in class Baz

  ? {llength [Bar info lookup parameters create]} 5

  Foo property y
  ? {llength [Bar info lookup parameters create]} 5

  Bar mixins add Foo
  ? {llength [Bar info lookup parameters create]} 6
  ? {bar configure -y 1} ""

  ? {llength [Baz info lookup parameters create]} 5
  Baz mixins add Bar
  ? {llength [Baz info lookup parameters create]} 6

  Foo property z
  ? {llength [Baz info lookup parameters create]} 7
  ? {baz configure -z 1} ""
  ? {bar configure -z 1} ""

}

nx::test configure -count 1
nx::test case indirect-transitive-mixin-info {

  nx::Class create M0 {:public method foo {} {return M}}
  nx::Class create M1 -superclass M0
  nx::Class create M2 -superclass M1

  nx::Class create C {:public method foo {} {return C}}
  nx::Class create D -superclass C

  C create c1
  D create d1
  M0 create m0
  M1 create m1
  M2 create m2

  ? {lmap p [C info lookup parameters create] {nsf::parameter::info name $p}} \
      "objectName object-mixins object-filters class __initblock"
  set base [llength [lmap p [C info lookup parameters create] {nsf::parameter::info name $p}]]

  ? [list set _ $base] 5

  ? {llength [C info lookup parameters create]} $base
  ? {llength [D info lookup parameters create]} $base
  ? {llength [M0 info lookup parameters create]} $base
  ? {llength [M1 info lookup parameters create]} $base
  ? {llength [M2 info lookup parameters create]} $base

  M0 property x

  ? {llength [M0 info lookup parameters create]} [expr {$base + 1}]
  ? {llength [M1 info lookup parameters create]} [expr {$base + 1}]
  ? {llength [M2 info lookup parameters create]} [expr {$base + 1}]

  ? {c1 foo} C
  ? {d1 foo} C

  ? {c1 info precedence} "::C ::nx::Object"
  ? {d1 info precedence} "::D ::C ::nx::Object"

  ? {C info subclasses -dependent} "::C ::D"
  ? {C info subclasses -closure} "::C ::D"
  ? {M0 info subclasses -dependent} "::M0 ::M1 ::M2"
  ? {M0 info subclasses -closure} "::M0 ::M1 ::M2"

  #puts stderr =========C-mixin-add-M2
  C mixins add M2
  #puts stderr =========

  ? {c1 foo} M
  ? {d1 foo} M

  ? {c1 info precedence} "::M2 ::M1 ::M0 ::C ::nx::Object"
  ? {d1 info precedence} "::M2 ::M1 ::M0 ::D ::C ::nx::Object"

  ? {C info heritage} "::M2 ::M1 ::M0 ::nx::Object"
  ? {D info heritage} "::M2 ::M1 ::M0 ::C ::nx::Object"

  ? {C info subclasses -dependent} "::C ::D"
  ? {C info subclasses -closure} "::C ::D"
  ? {M0 info subclasses -dependent} "::M0 ::M1 ::M2 ::C ::D"
  ? {M0 info subclasses -closure} "::M0 ::M1 ::M2"


  # Only M2 is a direct mixin, visible through "mixinof",
  # but query-able via transitive -closure operator

  ? {M2 info mixinof} "::C"
  ? {M2 info mixinof -closure} "::C ::D"

  ? {M1 info mixinof} ""
  ? {M1 info mixinof -closure} "::C ::D"

  ? {M0 info mixinof} ""
  ? {M0 info mixinof -closure} "::C ::D"

  ? {lmap p [C info lookup parameters create] {nsf::parameter::info name $p}} \
      "objectName x object-mixins object-filters class __initblock"

  ? {llength [C info lookup parameters create]} [expr {$base + 1}]
  ? {llength [D info lookup parameters create]} [expr {$base + 1}]

  #puts stderr =========-M1-property
  M1 property y
  #puts stderr =========
  ? {C info heritage} "::M2 ::M1 ::M0 ::nx::Object"

  #::nsf::parameter::cache::classinvalidate ::C

  ? {lmap p [C info lookup parameters create] {nsf::parameter::info name $p}} \
      "objectName y x object-mixins object-filters class __initblock"

  ? {lmap p [M0 info lookup parameters create] {nsf::parameter::info name $p}} \
      "objectName x object-mixins object-filters class __initblock"

  ? {lmap p [M1 info lookup parameters create] {nsf::parameter::info name $p}} \
      "objectName y x object-mixins object-filters class __initblock"

  ? {llength [C info lookup parameters create]} [expr {$base + 2}]
  ? {llength [D info lookup parameters create]} [expr {$base + 2}]
  ? {llength [M0 info lookup parameters create]} [expr {$base + 1}]
  ? {llength [M1 info lookup parameters create]} [expr {$base + 2}]
  ? {llength [M2 info lookup parameters create]} [expr {$base + 2}]

  # clearning the mixin has to reset the orders of the instances of C and D
  #puts stderr =========C-mixin-clear
  C mixins clear
  #puts stderr =========

  ? {c1 foo} C
  ? {d1 foo} C

  ? {c1 info precedence} "::C ::nx::Object"
  ? {d1 info precedence} "::D ::C ::nx::Object"
}


#
# See bug report at:
# https://groups.google.com/forum/#!topic/comp.lang.tcl/F9cn_Ah4js4
#
nx::test case bug-clt-configurable-false-cget {
  nx::Class create D;
  D property -configurable false "nix";
  D create d;
  # Provide for a shared parameter name Tcl_Obj, to enable intrep
  # sharing between "cget" and "configure". The original bug report
  # ran into the critical path using an interactive shell, with intrep
  # sharing occurring via literals.
  set flag "-nix"; 
  catch {d cget $flag}
  catch {d configure $flag anix} msg opts
  ? [list string match "invalid non-positional argument '-nix', *"  [dict get $opts -errorinfo]] 1
}
 



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