# -*- Tcl -*-

package prefer latest

package require nx
package require nx::test

nx::test configure -count 10
nx::test case method-require { 
  
  #
  # A few method-provides
  #
  # Some provides could be in e.g. nx.tcl, some could be loaded via
  # package require. We could as well think about an auto-indexer
  # producing these....
  #
  
  nsf::method::provide append   {::nsf::method::alias  append -frame object ::append}
  nsf::method::provide lappend  {::nsf::method::alias  lappend -frame object ::lappend}
  nsf::method::provide set      {::nsf::method::alias  set -frame object ::set}
  nsf::method::provide tcl::set {::nsf::method::alias  set -frame object ::set}
  nsf::method::provide exists   {::nsf::method::alias  exists ::nsf::methods::object::exists}
  nsf::method::provide foo      {::nsf::method::create foo {x y} {return x=$x,y=$y}}

  #
  # Provide an example for an application defined method provider
  #
  nsf::proc ::get_mixin {object -per-object:switch mixinClass methodName} {
    ::nsf::mixin $object -per-object=${per-object} $mixinClass
    return [$mixinClass info method registrationhandle $methodName]
  }
  # use the method provider
  nsf::method::provide x        {::get_mixin ::MIX x} {
    # here could be as well a package require, etc.
    ::nx::Class create ::MIX {:public method x {} {return x}}
  }
  
  #
  # Lets try it out:
  #
  
  nx::Class create C {
    :require method set
    :require method exists
    
    # required names can be different from registered names; if there
    # are multiple set methods, we could point to the right one
    ? [list [self] require method tcl::set] "::nsf::classes::C::set"
    
    # object methods
    ? [list [self] require object method lappend] "::C::lappend"
    
    # a scripted object method
    ? [list [self] require object method foo] "::C::foo"
    ? [list [self] require object method x] "::nsf::classes::MIX::x"
    ? [list [self] require method x] "::nsf::classes::MIX::x"
    
    # looks as well ok:
    ? [list [self] require namespace] ""
  }

  #
  # Try protected and public
  #
  ? {C require public method lappend} ::nsf::classes::C::lappend
  ? {::nsf::method::property C lappend call-protected} 0

  ? {C require protected method lappend} ::nsf::classes::C::lappend
  ? {::nsf::method::property C lappend call-protected} 1
  
  ? {C require protected object method set} ::C::set
  ? {::nsf::method::property C ::C::set call-protected} 1
  #
  # call these methods
  #
  C create c1
  ? {c1 set x 100} 100
  ? {c1 exists x} 1
  ? {C lappend some_list e1 e2} "e1 e2"
  ? {C foo 1 2} x=1,y=2
  ? {C x} x

  #
  # Definitions directly on object
  #
  Object create o1
  ? {o1 require object method set} ::o1::set
  ? {o1 require object method x} ::nsf::classes::MIX::x

  ? {o1 require public object method lappend} ::o1::lappend
  ? {::nsf::method::property o1 lappend call-protected} 0

  ? {o1 require protected object method lappend} ::o1::lappend
  ? {::nsf::method::property o1 lappend call-protected} 1

}

nx::test case parent-require { 
  
  ::nx::Class public object method __unknown {name} {
    #puts stderr "***** __unknown called with <$name>"
    ::nx::Object create $name
  }
  ::nsf::object::unknown::add nx {::nx::Class __unknown}

  nx::Class create C

  ? {C create ::o::o} "::o::o"
  ? {::o info class} "::nx::Object"
  ? {::o::o info class} "::C"

  ? {::nx::Object create ::a::b} "::a::b"
  ? {::a info class} "::nx::Object"
  ? {::a::b info class} "::nx::Object"

  ? {C create ::1::2::3::4} "::1::2::3::4"
  ? {::1 info class} "::nx::Object"
  ? {::1::2 info class} "::nx::Object"
  ? {::1::2::3 info class} "::nx::Object"
  ? {::1::2::3::4 info class} "::C"
}

#
# Test what happens if we try to redefine a "nonexistent" protected method.
#
nx::test case method-redefine-nonexistent {
  ? {nx::Class public method __alloc arg {return 1}} {refuse to overwrite protected method __alloc on ::nx::Class}
  ? {nx::Class public method __dealloc arg {return 1}} {refuse to overwrite protected method __dealloc on ::nx::Class}
  ? {nx::Class public method __recreate arg {return 1}} {refuse to overwrite protected method __recreate on ::nx::Class}
}

#
# Test what happens if a class-specific method is registered and
# called on an object.
#
nx::test case method-require-scope {
  nx::Object create o
  ::nsf::method::require o __alloc
  ? {o __alloc x} {method __alloc not dispatched on valid class}
}

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