# -*- Tcl -*-
package require nx::test

::nx::configure defaultMethodCallProtection false

#
# test, whether error message from a submethod contains method path
#
nx::test case info-errors {
  ? {::nx::Object info subclasses a b c} \
      {invalid argument 'b', maybe too many arguments; should be "::nx::Object info subclasses ?-closure? ?-dependent? ?/pattern/?"}
  ? {::nx::Object info object mixins a b c} \
      {invalid argument 'b', maybe too many arguments; should be "::nx::Object info object mixins ?-guards? ?/pattern/?"}
}

nx::test configure -count 10
nx::test case submethods {
  #Object method unknown {} {}
  Object create o1   
  ? {o1 foo} "::o1: unable to dispatch method 'foo'"
  
  #
  # test subcmd "tricky" names
  # - names called on ensemble objects from C (defaultmethod, unknown)
  # - names equal to helper methods of the ensemble object
  #
  Object create o {
    :object method "string length"  x {return [current method]}
    :object method "string tolower" x {return [current method]}
    :object method "string info" x {return [current method]}
    :object method "foo a x" {} {return [current method]}
    :object method "foo a y" {} {return [current method]}
    :object method "foo a subcmdName" {} {return [current method]}
    :object method "foo a defaultmethod" {} {return [current method]}
    :object method "foo a unknown" args {return [current method]}
    :object method "foo b" {} {return [current method]}
  }
  Class create Foo {
    :method "bar m1" {a:integer -flag} {;}
    :method "bar m2" {x:integer -y:boolean} {;}
    :method "baz a m1" {x:integer -y:boolean} {return m1}
    :method "baz a m2" {x:integer -y:boolean} {;}
    :method "baz b" {} {;}
  }
  
  ? {o string length 1} length
  ? {o string tolower 2} tolower
  ? {o string toupper 2} \
      {unable to dispatch sub-method "toupper" of ::o string; valid are: string info, string length, string tolower}

  ? {o string} "valid submethods of ::o string: info length tolower"

  ? {o foo a x} "x"
  ? {o foo a y} "y"
  ? {o foo a z} \
      {unable to dispatch sub-method "z" of ::o foo a; valid are: foo a defaultmethod, foo a subcmdName, foo a unknown, foo a x, foo a y}

  ? {o info object method type string} object
  # the following is a problem, when string has subcmd "info"
  #? {o::string info class} ::nx::EnsembleObject
  
  ? {o string length aaa} "length"
  ? {o string info class} "info"
  ? {o string hugo} \
      {unable to dispatch sub-method "hugo" of ::o string; valid are: string info, string length, string tolower}
  
  Foo create f1
  ? {f1 baz a m1 10} m1
  ? {f1 baz a m3 10} \
      {unable to dispatch sub-method "m3" of ::f1 baz a; valid are: baz a m1, baz a m2}

#unable to dispatch method <obj> baz a m3; valid subcommands of a: m1 m2}
#

nx::test configure -count 1 
nx::test case defaultmethod {
  Object create o {
    :object method "string length"  x {return [current method]}
    :object method "string tolower" x {return [current method]}
    :object method "string info" x {return [current method]}
    :object method "foo a x" {} {return [current method]}
    :object method "foo a y" {} {return [current method]}
    :object method "foo a subcmdName" {} {return [current method]}
    :object method "foo a defaultmethod" {} {return [current method]}
    :object method "foo a unknown" args {return [current method]}
    :object method "foo b" {} {return [current method]}
  }
  Class create Foo {
    :method "bar m1" {a:integer -flag} {;}
    :method "bar m2" {x:integer -y:boolean} {;}
    :method "baz a m1" {x:integer -y:boolean} {return m1}
    :method "baz a m2" {x:integer -y:boolean} {;}
    :method "baz b" {} {;}
    :create f1
  }

  ? {o string} "valid submethods of ::o string: info length tolower"
  ? {o foo} "valid submethods of ::o foo: a b"
  
  ? {f1 bar} "valid submethods of ::f1 bar: m1 m2"
  ? {f1 baz} "valid submethods of ::f1 baz: a b"
  ? {f1 baz a} "valid submethods of ::f1 baz a: m1 m2"
}

#
# testing ensemble objects with next
#
nx::test configure -count 1
nx::test case ensemble-next {

  nx::Class create FOO {
    # reduced ensemble
    :method foo args {lappend :v "FOO.foo//[nx::current method] ([nx::current args])"}

    # expanded ensemble
    :method "l1 l2 l3a" {x} {
      lappend :v "FOO.l1 l2 l3a//[nx::current method] ([nx::current args])"
    }
    :method "l1 l2 l3b" {x} {
      lappend :v "FOO.l1 l2 l3b//[nx::current method] ([nx::current args])"
    }
    # uplevel
    :method "bar x" {varname} {upvar $varname v; return [info exists v]}
    :method "baz" {} {
      set hugo 1
      return [:bar x hugo]
    }
  }
  nx::Class create M0 {
    :method "foo b x" {x} {
      lappend :v "M0.foo b x//[nx::current method] ([nx::current args])"
      nx::next
    }
    :method "foo b y" {x} {
      lappend :v "M0.foo b y//[nx::current method] ([nx::current args])"
      nx::next
    }
    :method "foo a" {x} {
      lappend :v "M0.foo a//[nx::current method] ([nx::current args])"
      nx::next
    }

    :method "l1 l2" {args} {
      lappend :v "l1 l2//[nx::current method] ([nx::current args])"
      nx::next
    }
  }

  nx::Class create M1 {
    :method "foo a" {x} {
      set :v [list "M1.foo a //[nx::current method] ([nx::current args])"]
      nx::next
    }
    :method "foo b x" {x} {
      set :v  [list "M1.foo b x //[nx::current method] ([nx::current args])"]
      nx::next
    }
    :method "foo b y" {x} {
      set :v  [list "M1.foo b y //[nx::current method] ([nx::current args])"]
      nx::next
    }

    :method "l1 l2 l3a" {x} {
      set :v  [list "M1.l1 l2 l3a//[nx::current method] ([nx::current args])"]
      nx::next
    }
    :method "l1 l2 l3b" {x} {
      set :v  [list "M1.l1 l2 l3b//[nx::current method] ([nx::current args])"]
      nx::next
    }
  }
  
  FOO mixins set {M1 M0}
  FOO create f1
  
  #
  # The last list element shows handling of less deep ensembles
  # (longer arg list is passed)
  #
  ? {f1 foo a 1} "{M1.foo a //a (1)} {M0.foo a//a (1)} {FOO.foo//foo (a 1)}"
  ? {f1 foo b x 1} "{M1.foo b x //x (1)} {M0.foo b x//x (1)} {FOO.foo//foo (b x 1)}"
  ? {f1 foo b y 1} "{M1.foo b y //y (1)} {M0.foo b y//y (1)} {FOO.foo//foo (b y 1)}"
  #
  # The middle list element shows shrinking (less deep ensembles), the
  # last element shows expansion via mixin (deeper ensemble is reached
  # via next)
  #
  ? {f1 l1 l2 l3a 100} "{M1.l1 l2 l3a//l3a (100)} {l1 l2//l2 (l3a 100)} {FOO.l1 l2 l3a//l3a (100)}"
}

nx::test case ensemble-partial-next {
  nx::Class create M {
    :public method "info has namespace" {} {
      nx::next
      return sometimes
    }
    :public method "info has something else" {} {
      return something
    }
    :public method "info has something path" {} {
      return [::nsf::current methodpath]
    }
    :public method "info has something better" {} {
      nx::next
      return better
    }
    :public method foo {} {
      return [::nsf::current methodpath]
    }
  }
  nx::Object mixins add M
  nx::Object create o1

  # call a submethod defined by a mixin, which does a next
  ? {o1 info has namespace} sometimes

  # call a submethod, which is not defined by the mixin
  ? {o1 info has type Object} 1
  ? {o1 info has type M} 0

  # call a submethod, which is nowhere defined
  ? {o1 info has typo M} \
      {unable to dispatch sub-method "typo" of ::o1 info has; valid are: info has mixin, info has namespace, info has something better, info has something else, info has something path, info has type}

  # call a submethod, which is only defined in the mixin
  ? {o1 info has something else} something

  # call a submethod, which is only defined in the mixin, and which
  # does a next (which should not complain)
  ? {o1 info has something better} better

  # ensemble path excluding "wrong" is mixed in
  ? {o1 info has something wrong} \
      {unable to dispatch sub-method "wrong" of ::o1 info has something; valid are: info has something better, info has something else, info has something path}

  # call defaultcmds on ensembles
  ? {lsort [o1 info has something]} "valid submethods of ::o1 info has something: better else path"

  # defaultcmd has to return also subcmds of other shadowed ensembles
  ? {lsort [o1 info has]} "valid submethods of ::o1 info has: mixin namespace something type"
  ? {lsort [o1 info]} \
      "valid submethods of ::o1 info: baseclass children class has info lookup name object parent precedence variable vars"

  # returning methodpath in ensemble
  ? {o1 info has something path} "info has something path"

  # returning methodpath outside ensemble
  ? {o1 foo} "foo"
}

#
# Check behavior of upvars in ensemble methods
#
nx::test case ensemble-upvar {

  nx::Class create FOO {
    :method "bar0 x" {varname} {upvar $varname v; return [info exists v]}
    :method "baz0" {} {
      set hugo 1
      return [:bar0 x hugo]
    }
    :method "bar1 x" {varname} {:upvar $varname v; return [info exists v]}
    :method "baz1" {} {
      set hugo 1
      return [:bar1 x hugo]
    }
    :create f1
  }
 
  ? {f1 baz0} 0
  ? {f1 baz1} 1
}

#
# Check behavior of next with arguments within an ensemble
#
nx::test case ensemble-next-with-args {
  nx::Object create o {
    :object method foo {x}          {return $x}
    :object method "e1 sm" {x}      {return $x}
    :object method "e2 sm1 sm2" {x} {return $x}
    :object method "e2 e2 e2" {x}   {return $x}
    :object method "e1 e1 e1" args  {return $args}
  }
  nx::Class create M {
    :method foo {}          {next 1}
    :method "e1 sm" {}      {next 2}
    :method "e2 sm1 sm2" {} {next 3}
    :method "e2 e2 e2" {}   {next 4}
    :method "e1 e1 e1" args {next {e1 e1 e1}}
  }
  o object mixins add M

  # case without ensemble
  ? {o foo} 1

  # ensemble depth 1, 1 arg
  ? {o e1 sm} 2

  # ensemble depth 2, 1 arg
  ? {o e2 sm1 sm2} 3

  # ensemble depth 2, 1 arg, same tcl-objs
  ? {o e2 e2 e2} 4

  # ensemble depth 2, multiple args, same tcl-objs
  ? {o e1 e1 e1} {e1 e1 e1}
}

nx::test configure -count 1
nx::test case ensemble-next-with-colon-prefix
namespace eval ::ns1 {
  nx::Object create obj {
    :public object method foo {} { return [:info class] } 
    :public object method ifoo {} { [current] ::nsf::methods::object::info::lookupmethod info} 
  }
  
  ? {obj info class} ::nx::Object
  ? {obj info lookup method info} ::nsf::classes::nx::Object::info
  ? {obj ifoo} ::nsf::classes::nx::Object::info
  
  ? {obj foo} ::nx::Object
  
  set infolookup ::nsf::methods::object::info::lookupmethod
  set infomethod  ::nsf::methods::object::info::method
  
  ? [list obj $infolookup info] ::nsf::classes::nx::Object::info
  ? [list obj $infomethod type ::nsf::classes::nx::Object::info] alias
  
  obj object method info {} {;}
  ? [list obj $infolookup info] ::ns1::obj::info
  ? [list obj $infomethod type ::ns1::obj::info] scripted
  ? {obj ifoo} ::ns1::obj::info
  ? {obj foo} {wrong # args: should be ":info"}

  # Now we try to overwrite the object specific method with an object
  # named "info"
  ? {nx::Object create obj::info} "refuse to overwrite cmd ::ns1::obj::info; delete/rename it before overwriting"
  rename obj::info ""
  ? {nx::Object create obj::info} ::ns1::obj::info
  ? [list obj $infolookup info] ::ns1::obj::info
  ? [list obj $infomethod type ::ns1::obj::info] object
  
  ? {obj ifoo} ::ns1::obj::info
  # To some surprise, we can can still call info class!
  # This works, since we do here an "ensemble-next" 
  #? {obj info class} ::nx::Object
  ? {obj info class} {::ns1::obj::info: unable to dispatch method 'class'}
  # The ensemble-next has in case of foo the leading colon on the
  # callstack (e.g. ":info"). Make sure that we can still call the
  # method via ensemle-next.
  #? {obj foo} ::nx::Object
  ? {obj foo} {::ns1::obj::info: unable to dispatch method 'class'}
}

#
# Leaf next: Do not trigger unknown handling (see also
# NextSearchAndInvoke())
#
nx::test case leaf-next-in-submethods {
  nx::Object create container {
    set :x 0
    :public object method "FOO bar" {} { 
      incr :x; next; # a "leaf next" 
    }
    :public object method intercept args { 
      incr :x; next; # a "filter next" 
    }
    :object filters set intercept
    :FOO bar
    # Rationale: A call count > 2 would indicate that the leaf next
    # triggers a further call into filter ...
    ? [list set _ ${:x}] 2
  }
}

nx::test case object-unknown {
  #
  # object level ensemble
  #
  nx::Object create o1 {
    :object method "i o a" {} {return a}
    :object method "i o b" {} {return b}
  }
  ? {o1 i o x} {unable to dispatch sub-method "x" of ::o1 i o; valid are: i o a, i o b}

  #
  # object level ensemble on class
  #
  nx::Class create C {
    :public object alias "i o a" ::nsf::methods::class::info::heritage
    :public object alias "i o b" ::nsf::methods::class::info::heritage
  }
  ? {C i o x} {unable to dispatch sub-method "x" of ::C i o; valid are: i o a, i o b}
  ? {C i o x y} {unable to dispatch sub-method "x" of ::C i o; valid are: i o a, i o b}

  #
  # Emulate the "info" and "info object" ensembles on nx::Object and nx::Class
  #
  nx::Object public method "i o a" {} {return a}
  nx::Object public alias "i o b" ::nsf::methods::class::info::heritage
  nx::Class public alias "i a" ::nsf::methods::class::info::heritage
  nx::Class public alias "i b" ::nsf::methods::class::info::heritage

  nx::Class create D {}
  ? {D i p} {unable to dispatch sub-method "p" of ::D i; valid are: i a, i b, i o a, i o b}
  ? {D i o a} a
  ? {D i o x} {unable to dispatch sub-method "x" of ::D i o; valid are: i o a, i o b}
  ? {D i o x y} {unable to dispatch sub-method "x" of ::D i o; valid are: i o a, i o b}

  ::nsf::method::delete nx::Class i
  ::nsf::method::delete nx::Object i
}

nx::test case unknown-in-info {
  nx::Class create C
  catch {C info x y z} err
  ? [list string match {unable to dispatch sub-method "x" of ::C info; valid are:*} $err] 1

  #C info object x y z
  catch {C info object x y z} err
  ? [list string match {unable to dispatch sub-method "x" of ::C info object; valid are:*} $err] 1; 
  ## --> unable to dispatch sub-method "object" of ::C info; valid are:
}

nx::test case submethods-and-filters {
  #
  # submethods as filters?
  #
  #set h [C public method "BAR bar" args {
  # next
  #}]
  #C filter {{BAR bar}}
}

nx::test case submethods-current-introspection {
  #
  # [current] & [current class]
  #
  nx::Object create o
  o public object method "FOO foo" {} {
    return "-[current]-[current class]-"
  }
  ? {o FOO foo} -::o--
  
  Class create C
  C public method "FOO foo" {} {
    return "-[current]-[current class]-"
  }
  C create c
  ? {c FOO foo} -::c-::C-

  C mixins set [Class create M1 {
    :public method "FOO foo" {} {
      return "-[current]-[current class][next]"
    }
  }]

  ? {c FOO foo} -::c-::M1-::c-::C-
  
  o object mixins set ::M1
  ? {o FOO foo} -::o-::M1-::o--

  o object mixins set {}
  C mixins set {}

  #
  # limit [current methodpath] to collect only ensemble methods?
  #

  o eval {
    :public object method faz {} {return [current methodpath]}
    ? [list set _ [:faz]] "faz"
  }

  #
  # [current callingmethod] & [current callingclass]
  #

  o eval {
    set body {expr {[:bar] eq "[current class]-[current]-[current methodpath]"}}
    :public object method "FOO foo" {} $body
    :public object method "BAR BUU boo" {} $body
    :public object method baz {} $body

    set calleeBody {return "[current callingclass]-[current callingobject]-[current callingmethod]"}
    :public object method bar {} $calleeBody
  }
  
  ? {o FOO foo} 1 "instance method ensemble 1"
  ? {o BAR BUU boo} 1 "instance method ensemble 2"
  ? {o baz} 1 "instance method"

  o eval {
    set calleeBody {return "[current callingclass]-[current callingobject]-[current callingmethod]"}
    :object method "a b" {} $calleeBody
    set body {expr {[:a b] eq "[current class]-[current]-[current methodpath]"}}
    :public object method "FOO foo" {} $body
    :public object method "BAR BUU boo" {} $body
    :public object method baz {} $body
  }

  ? {o FOO foo} 1 "object method ensemble 1"
  ? {o BAR BUU boo} 1 "object method ensemble 2"
  ? {o baz} 1 "object method"

  o eval {
    # TODO: :method "a b c" {} $calleeBody; FAILS -> "can't append to scripted"
    set calleeBody {return "[current callingclass]-[current callingobject]-[current callingmethod]"}
    :object method "x y z" {} $calleeBody;
    set body {expr {[:x y z] eq "[current class]-[current]-[current methodpath]"}}
    :public object method "FOO foo" {} $body
    :public object method "BAR BUU boo" {} $body
    :public object method baz {} $body
  }

  ? {o FOO foo} 1 "class level object method ensemble 1"
  ? {o BAR BUU boo} 1 "class level object method ensemble 2"
  ? {o baz} 1 "class level object method"
  
  #
  # Make sure that [current callingclass] works for submethods, as
  # expected
  #

  C eval {
    set body {expr {[:bar] eq "[current class]-[current]-[current methodpath]"}}
    :public method "FOO foo" {} $body
    :public method "BAR BUU boo" {} $body
    :public method baz {} $body

    :method bar {} {
      return "[current callingclass]-[current callingobject]-[current callingmethod]"
    }
  }

  set c [C new]
  ? [list $c FOO foo] 1
  ? [list $c BAR BUU boo] 1
  ? [list $c baz] 1

  #
  # [current calledmethod]
  # [current calledclass]
  #
  # Note: In my reading, [current calledmethod] cannot be made aware
  # of the methodpath of a submethod call being intercepted. This is
  # due to the callstack structure at the time of executing the filter
  # stack which is entirely agnostic of the submethod dispatch (this
  # dispatch has not occurred yet). For the same reason, we cannot
  # record the method path in the filter stack structure.
  #
  # From the filter method's perspective, the submethod selectors
  # ("foo" and "BUU boo" below) are simply arguments provided to the
  # top-level method. They can only be processed as part of the
  # filter-local argv.

  Class create Z {
    :object property msg
    :method intercept args {
      [current class] eval [list set :msg [list [lrange [current methodpath] 1 end-1] \
					       [current calledmethod] \
					       [current calledclass] \
					       [current nextmethod]]]
      next
    }
  }
  
  set c [Z new]

  Z filters set intercept

  foreach selector [list "FOO foo" "BAR BUU boo" "baz"] {
    Z public method $selector {} {;}
    set root [lindex $selector 0]
    set mh [Z info method registrationhandle $root]
    $c {*}$selector
    ? [list set _ [join [Z cget -msg] -]] -$root-::Z-$mh
  }

  Z filters set {}

}

#
# Test current args in ensemble methods
#
nx::test case current-args {
  nx::Class create C {
    :method foo {{-x 1} z:optional} {return [current args]}
    :method "bar foo" {{-x 1} z:optional} {return [current args]}
    :create c1
  }
  ? {c1 foo} ""
  ? {c1 bar foo} ""

  ? {c1 foo -x 2} "-x 2"
  ? {c1 bar foo -x 2} "-x 2"
}


#
# Test keepcallerself and perobjectdispatch with their respective
# interactions for plain object dispatch and for object dispatch via
# method interface
#

nx::test case per-object-dispatch {
  nx::Class create C {
    :public method foo {} {return foo-[self]}
    :public method baz {} {return [c1::1 baz]}
    :create c1 {
      :public object method bar {} {return bar-[self]}
    }
  }

  ? {c1 foo} "foo-::c1"
  ? {c1 bar} "bar-::c1"
  
  C create c1::1 {
    :public object method bar {} {return bar-[self]}
    :public object method baz {} {return baz-[self]}
  }

  #
  # Just the same as above
  #
  ? {c1::1 foo} "foo-::c1::1"
  ? {c1::1 bar} "bar-::c1::1"

  # if we specify anything special, then we have per-default
  # - keepcallerself false
  # - perobjectdispatch false

  ? {c1 1 foo} "foo-::c1::1"
  ? {c1 1 bar} "bar-::c1::1"
  ? {c1 baz} "baz-::c1::1"
  
  # just make setting explicit
  ::nsf::object::property ::c1::1 keepcallerself off
  ::nsf::object::property ::c1::1 perobjectdispatch off
  ? {c1 1 foo} "foo-::c1::1"
  ? {c1 1 bar} "bar-::c1::1"
  ? {c1 baz} "baz-::c1::1"

  # keepcallerself off   - the self in the called method is the invoked object
  # perobjectdispatch on - the instance method is not callable

  ::nsf::object::property ::c1::1 keepcallerself off
  ::nsf::object::property ::c1::1 perobjectdispatch on

  ? {c1 1 foo} {::c1::1: unable to dispatch method 'foo'}
  ? {c1 1 bar} "bar-::c1::1"
  ? {c1 baz} "baz-::c1::1"

  # keepcallerself on     - the self in the called method is the caller
  # perobjectdispatch on  - the instance method is not callable

  ::nsf::object::property ::c1::1 keepcallerself on
  ::nsf::object::property ::c1::1 perobjectdispatch on

  ? {c1 1 foo} {::c1::1: unable to dispatch method 'foo'}
  ? {c1 1 bar} "bar-::c1"
  #### ignore keepcallerself via interface with explicit receiver intentionally
  ? {c1 baz} "baz-::c1::1"

  # keepcallerself on      - the self in the called method is the caller
  # perobjectdispatch off  - the instance method is callable

  ::nsf::object::property ::c1::1 keepcallerself on
  ::nsf::object::property ::c1::1 perobjectdispatch off

  ? {c1 1 foo} "foo-::c1"
  ? {c1 1 bar} "bar-::c1"
  #### ignore keepcallerself via interface with explicit receiver intentionally
  ? {c1 baz} "baz-::c1::1"
}


#
# Test forwarding to child object, with respect to settings of the
# object properties keepcallerself and allowmethoddispatch
#
nx::test configure -count 1000
nx::test case child-obj-delegation {

  nx::Object create obj {
    nx::Object create [self]::child {
      :public object method foo {} {return [self]}
    }
    :public object forward link1 {%[self]::child}
    :public object forward link2 :child
    :public object method  link3 args {[self]::child {*}$args}
    :public object alias   link4 [self]::child
    :public object forward link5 [self]::child
  }

  #
  # Default case
  #   keepcallerself false
  #   perobjectdispatch false
  #

  ::nsf::object::property obj::child keepcallerself false
  ::nsf::object::property obj::child perobjectdispatch false
  
  ? {obj link1 foo} {::obj::child}
  #? {obj link2 foo} {::obj: unable to dispatch method 'child'}
  ? {obj link2 foo} {::obj::child}
  ? {obj link3 foo} {::obj::child}
  ? {obj link4 foo} {::obj::child}
  ? {obj link5 foo} {::obj::child}
  ? {obj child foo} {::obj::child}

  #? {lsort [obj info object methods child]} {}
  #? {lsort [obj info object methods]} {link1 link2 link3 link4 link5}
  #? {lsort [obj info lookup methods child]} {}
  #? {lsort [obj info lookup methods child*]} {}
  ? {lsort [obj info object methods child]} {child}
  ? {lsort [obj info object methods]} {child link1 link2 link3 link4 link5}
  ? {lsort [obj info lookup methods child]} {child}
  ? {lsort [obj info lookup methods child*]} {child}

  #
  # turn on keepcallerself and perobjectdispatch
  #
  ::nsf::object::property obj::child keepcallerself true
  ::nsf::object::property obj::child perobjectdispatch true

  ? {obj link1 foo} {::obj::child}
  #? {obj link2 foo} {::obj: unable to dispatch method 'child'}
  ? {obj link2 foo} {::obj}
  ? {obj link3 foo} {::obj::child}
  ? {obj link4 foo} {::obj}
  ? {obj link5 foo} {::obj::child}
  ? {obj child foo} {::obj}

  #? {lsort [obj info object methods child]} {}
  #? {lsort [obj info object methods]} {link1 link2 link3 link4 link5}
  #? {lsort [obj info lookup methods child]} {}
  #? {lsort [obj info lookup methods child*]} {}
  ? {lsort [obj info object methods child]} {child}
  ? {lsort [obj info object methods]} {child link1 link2 link3 link4 link5}
  ? {lsort [obj info lookup methods child]} {child}
  ? {lsort [obj info lookup methods child*]} {child}


  #
  # just perobjectdispatch
  #
  ::nsf::object::property obj::child keepcallerself false
  ::nsf::object::property obj::child perobjectdispatch true

  ? {obj link1 foo} {::obj::child}
  ? {obj link2 foo} {::obj::child}
  ? {obj link3 foo} {::obj::child}
  ? {obj link4 foo} {::obj::child}
  ? {obj link5 foo} {::obj::child}
  ? {obj child foo} {::obj::child}

  ? {lsort [obj info object methods child]} {child}
  ? {lsort [obj info object methods]} {child link1 link2 link3 link4 link5}
  ? {lsort [obj info lookup methods child]} {child}
  ? {lsort [obj info lookup methods child*]} {child}

  #
  # just keepcallerself
  #
  ::nsf::object::property obj::child keepcallerself true
  ::nsf::object::property obj::child perobjectdispatch false

  ? {obj link1 foo} {::obj::child}
  #? {obj link2 foo} {::obj: unable to dispatch method 'foo'}
  ? {obj link2 foo} {::obj}
  ? {obj link3 foo} {::obj::child}
  #? {obj link4 foo} {::obj: unable to dispatch method 'foo'}
  ? {obj link4 foo} {::obj}
  ? {obj link5 foo} {::obj::child}
  #? {obj child foo} {::obj: unable to dispatch method 'foo'}
  ? {obj child foo} {::obj}

  ? {lsort [obj info object methods child]} {child}
  ? {lsort [obj info object methods]} {child link1 link2 link3 link4 link5}
  ? {lsort [obj info lookup methods child]} {child}
  ? {lsort [obj info lookup methods child*]} {child}
}


#
# Examplify the current behavior of "keepcallerself" with and without
# the setting of "perobjectdispatch"
#
nx::test configure -count 1
nx::test case keepcallerself {

  nx::Class create C {:public method foo {} {return C-[self]}}
  nx::Class create D {:public method foo {} {return D-[self]}}

  C create c1 {
    ::nsf::object::property [self] keepcallerself true
    :public object method bar {} {return c1-[self]}
    :public object method baz {} {return c1-[self]}
  }

  D create d1 {
    :public object method bar {} {return d1-[self]}
    :public object alias c1 ::c1
  }
  
  # The normal dispatch ignores the keepcallerself completely
  ? {c1 bar} c1-::c1
  ? {c1 foo} C-::c1
  ? {c1 baz} c1-::c1

  # The dispatch via object aliased method calls actually "d1 bar",
  # although c1 is in the dispatch path
  #? {d1 c1 bar} d1-::d1
  #? {d1 c1 foo} D-::d1
  #? {d1 c1 baz} "::d1: unable to dispatch method 'baz'"
  ? {d1 c1 bar} c1-::d1
  ? {d1 c1 foo} C-::d1
  ? {d1 c1 baz} c1-::d1

  # The destroy destroys actually d1, not c1, although destroy is
  # dispatched originally on c1
  ? {d1 c1 destroy} ""
  ? {nsf::object::exists d1} 0
  ? {nsf::object::exists c1} 1

  # So, keepcallerself is currently pretty useless, unless used in
  # combination with "perobjectdispatch", which we set in the
  # following test cases

  C create c1 {
    ::nsf::object::property [self] keepcallerself true
    ::nsf::object::property [self] perobjectdispatch true
    :public object method bar {} {return c1-[self]}
    :public object method baz {} {return c1-[self]}
  }
  D create d1 {
    :public object method bar {} {return d1-[self]}
    :public object alias c1 ::c1
  }

  # The normal dispatch ignores the keepcallerself and
  # perobjectdispatch completely
  ? {c1 bar} c1-::c1
  ? {c1 foo} C-::c1
  ? {c1 baz} c1-::c1

  # The dispatch via object aliased method calls actually "d1 bar",
  # although c1 is in the dispatch path
  ? {d1 c1 bar} c1-::d1
  ? {d1 c1 foo} "::c1: unable to dispatch method 'foo'"
  ? {d1 c1 baz} c1-::d1
}


nx::test case ensemble-vs-simple-method {

  ? {nx::Class create C} ::C
  ? {C public method foo {args} {return foo/1}} "::nsf::classes::C::foo"
  ? {C public method "foo x" {args} {return foo/2}} \
      {refuse to overwrite method foo; delete/rename method first.}
  ? {C public method "foo x y" {args} {return foo/3}} \
      {refuse to overwrite method foo; delete/rename method first.}

  ? {C public method "bar x" {args} {return bar/2}} {::C::slot::__bar::x}
  ? {C public method "bar x y" {args} {return foo/3}} \
      {refuse to overwrite cmd ::C::slot::__bar::x; delete/rename it before overwriting}

  C create c1

  ? {c1 foo x y z} "foo/1"
  ? {c1 bar x y z} "bar/2"


  ? {nx::Object create o1} ::o1
  ? {o1 public object method foo {args} {return foo/1}} "::o1::foo"
  ? {o1 public object method "foo x" {args} {return foo/2}} \
      {refuse to overwrite object method foo; delete/rename object method first.}
  ? {o1 public object method "foo x y" {args} {return foo/3}} \
      {refuse to overwrite object method foo; delete/rename object method first.}

  ? {o1 public object method "bar x" {args} {return bar/2}} {::o1::bar::x}
  ? {o1 public object method "bar x y" {args} {return foo/3}} \
      {refuse to overwrite cmd ::o1::bar::x; delete/rename it before overwriting}

  ? {o1 foo x y z} "foo/1"
  ? {o1 bar x y z} "bar/2"
}

nx::test case ensemble-next-vs-colon-dispatch {
  nx::Class create A {
    :method "x s" args {
      next
      return [current class]
    }
  }
  
  nx::Class create B  -superclasses A {
    :public method "x s" args {
      return [list [current class] {*}[next]]
    }
    :create b
  }

  set sc "::B ::A"
  ? {b eval { :x s }} $sc
  ? {b eval { : x s }} $sc
  ? {b x s} $sc
}

nx::test case ensemble-callstack-introspection {
  set ::body {
    return [list [current nextmethod] [current isnextcall] {*}[next]]
  }
  
  nx::Class create A {
    set ::handle [:method "i s" args $::body]
    :create a
  }
  
  nx::Class create B  -superclasses A {
    :public method "i s" args $::body
    :create b
  }
  
  ? {b eval { :i s }} {{::nsf::classes::A::i s} 0 {} 1}
  ? {::nsf::cmd::info args [lindex [b eval { :i s }] 0]} "args"
  ? {::nsf::cmd::info definitionhandle [lindex [b eval { :i s }] 0]} $::handle
  ? {::nsf::cmd::info body [lindex [b eval { :i s }] 0]} $::body
  ? {b i s} {{::nsf::classes::A::i s} 0 {} 1};
  ? {::nsf::cmd::info args [lindex [b i s] 0]} "args"
  ? {::nsf::cmd::info definitionhandle [lindex [b i s] 0]} $::handle
  ? {::nsf::cmd::info body [lindex [b i s] 0]} $::body
  ? {a eval { :i s }} {{} 0}
  ? {a i s} {{} 0}
  
  unset -nocomplain ::handle
  unset -nocomplain ::body
}

::nx::configure defaultMethodCallProtection true

nx::test case ensemble-forwards {
  set C [nx::Class new {
    set handle [:forward "foo 1" string cat %method]
    ? [list info commands $handle] $handle
    set handle [:public forward "foo 2" string cat %method]
    ? [list info commands $handle] $handle
    set handle [:protected forward "foo 3" string cat %method]
    ? [list info commands $handle] $handle
    set handle [:private forward "foo 4" string cat %method]
    ? [list info commands $handle] $handle
    set handle [:object forward "foo 5" string cat %method]
    ? [list info commands $handle] $handle
    set handle [:public object forward "foo 6" string cat %method]
    ? [list info commands $handle] $handle
    set handle [:protected object forward "foo 7" string cat %method]
    ? [list info commands $handle] $handle
    set handle [:private object forward "foo 8" string cat %method]
    ? [list info commands $handle] $handle
  }]
  
  ? [list $C foo 6] "6"
  ? [list $C foo 5] "unable to dispatch sub-method \"5\" of $C foo; valid are: foo 6"
  ? [list $C eval {:foo 5}] "5"
  ? [list $C foo 7] "unable to dispatch sub-method \"7\" of $C foo; valid are: foo 6"
  ? [list $C eval {:foo 7}] "7"
  ? [list $C foo 8] "unable to dispatch sub-method \"8\" of $C foo; valid are: foo 6"
  ? [list $C eval {:foo 8}] "8"; # ! should not be possible !
  
  set c [$C new]
  
  ? [list $c foo 2] "2"
  ? [list $c foo 1] "unable to dispatch sub-method \"1\" of $c foo; valid are: foo 2"
  ? [list $c eval {:foo 1}] "1"
  ? [list $c foo 3] "unable to dispatch sub-method \"3\" of $c foo; valid are: foo 2"
  ? [list $c eval {:foo 3}] "3"
  ? [list $c foo 4] "unable to dispatch sub-method \"4\" of $c foo; valid are: foo 2"
  ? [list $c eval {:foo 4}] "4"; # ! should not be possible !

}

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