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

nx::Test parameter count 1

nx::Test case call-protected {
  nx::Class create C {
    :public alias SET ::set
    :public method foo {} {return [current method]}
    :public method bar {} {return [current method]}
    :public method bar-foo {} {
      c1 foo
    }
    :public method bar-SET {} {
      c1 SET x 1
    }
  }
  
  C create c1
  C create c2
  
  ? {c1 SET x 1} {1}
  ? {c1 foo} {foo}
  ? {c1 bar-SET} {1}
  ? {c1 bar-foo} {foo}

  ::nsf::method::property C SET call-protected true
  ? {catch {c1 SET x 1} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'}
  ? {::nsf::object::dispatch c1 SET x 2} {2} "dispatch of protected methods works"
  ? {c1 foo} {foo}
  ? {c1 bar} {bar}
  ? {c1 bar-SET} {1}
  ? {c1 bar-foo} {foo}
  ? {catch {c2 bar-SET} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'}
  ? {c2 bar-foo} {foo}

  ::nsf::method::property C foo call-protected true
  ? {catch {c1 SET x 1} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'}
  ? {::nsf::object::dispatch c1 SET x 2} {2} "dispatch of protected methods works"
  ? {c1 bar} {bar} "other method work"
  ? {catch {c1 foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'}
  ? {c1 bar-SET} {1} "internal call of protected C implementend method"
  ? {c1 bar-foo} {foo} "internal call of protected Tcl implemented method"
  ? {catch {c2 bar-SET} errorMsg; set errorMsg} {::c1: unable to dispatch method 'SET'}
  ? {catch {c2 bar-foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'}

  # unset call protected
  ? {::nsf::method::property C SET call-protected} 1
  ::nsf::method::property C SET call-protected false
  ? {::nsf::method::property C SET call-protected} 0
  ? {::nsf::method::property C foo call-protected} 1
  ::nsf::method::property C foo call-protected false
  ? {::nsf::method::property C foo call-protected} 0
  
  ? {c1 SET x 3} 3
  ? {::nsf::object::dispatch c1 SET x 2} {2} 
  ? {c1 foo} {foo}
  ? {c1 bar} {bar}
  ? {c1 bar-SET} {1}
  ? {c1 bar-foo} {foo}
  ? {c2 bar-SET} 1
  ? {c2 bar-foo} {foo}

  # define a protected method
  C protected method foo {} {return [current method]}
  ? {::nsf::method::property C SET call-protected} 0
  ? {c1 SET x 3} 3
  ? {::nsf::object::dispatch c1 SET x 4} {4} 
  ? {catch {c1 foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'}
  ? {c1 bar} {bar}
  ? {c1 bar-SET} {1}
  ? {c1 bar-foo} foo
  ? {c2 bar-SET} 1
  ? {catch {c2 bar-foo} errorMsg; set errorMsg} {::c1: unable to dispatch method 'foo'}
}

nx::Test case redefined-protected {
  nx::Class create C {
    :public alias SET ::set
    :public method foo {} {return [current method]}
  }
  #
  # Define SET and foo as redefined-protected
  #
  ? {::nsf::method::property C SET redefine-protected true} 1
  ? {::nsf::method::property C foo redefine-protected true} 1
  
  ? {C method SET {a b c} {...}} \
      {Method 'SET' of ::C cannot be overwritten. Derive e.g. a sub-class!} \
      "redefine method SET"
  
  ? {C method foo {a b c} {...}} \
      {Method 'foo' of ::C cannot be overwritten. Derive e.g. a sub-class!} \
      "redefine method foo"
  
  # check a predefined protection
  ? {::nx::Class method create {a b c} {...}} \
      {Method 'create' of ::nx::Class cannot be overwritten. Derive e.g. a sub-class!} \
      "redefine method create"
  
  # try to redefine predefined protected method via alias
  ? {::nsf::method::alias nx::Class create ::set} \
      {Method 'create' of ::nx::Class cannot be overwritten. Derive e.g. a sub-class!} \
      "redefine alias create"
  
  # try to redefine via forward
  ? {C forward SET ::set} \
      {Method 'SET' of ::C cannot be overwritten. Derive e.g. a sub-class!} \
      "redefine forward SET"

  # try to redefine via setter
  ? {C property SET} \
      {Method 'SET' of ::C cannot be overwritten. Derive e.g. a sub-class!} \
      "redefine property SET"
  
  # redefine-protect object specific method
  nx::Object create o
  o method foo {} {return 13}
  ::nsf::method::property o foo redefine-protected true
  ? {o method foo {} {return 14}} \
      {Method 'foo' of ::o cannot be overwritten. Derive e.g. a sub-class!}
}

#
# test "nsf::my -local" on classes
#

nx::Test case class-my-local {
  nx::Class create Base {
    :private method baz {a b} { expr {$a + $b} }
    :public method foo {a b} { nsf::my -local baz $a $b }
  }
    
  nx::Class create Sub -superclass Base {
    :public method bar {a b} { nsf::my -local baz $a $b }
    :private method baz {a b} { expr {$a * $b} }

    :create s1
  }

  ? {s1 foo 3 4} 7
  ? {s1 bar 3 4} 12
  ? {s1 baz 3 4} {::s1: unable to dispatch method 'baz'}
}

#
# test "nsf::my -local" on objects
#
nx::Test case object-my-local {
  nx::Class create M {
    :public method foo {} {return "M [next]"}
    :public method foo2 {} {return "M2 [next]"}
  }
  nx::Object create o1 {
    :protected method foo {} {return o1}
    :public method foo2 {} {:foo}
    :public method bar {} {nsf::my -local foo}
  }

  ? {o1 foo} {::o1: unable to dispatch method 'foo'}
  ? {o1 bar} o1
  ? {o1 foo2} o1

  o1 mixin add M

  ? {o1 foo} "M o1"
  ? {o1 bar} "o1"
  ? {o1 foo2} "M2 M o1"

}

#
# test nsf::my + path instead of "nsf::my -local" on classes
#

nx::Test case my+handle-instead-of-my-local {
  nx::Class create Base {
    :protected method privateMethod {a b} { expr {$a + $b} }
    :public method foo {a b} { nsf::my [Base info method handle privateMethod] $a $b }
  }
    
  nx::Class create Sub -superclass Base {
    :public method bar {a b} { nsf::my [Sub info method handle privateMethod] $a $b }
    :public method privateMethod {a b} { expr {$a * $b} }

    :create s1
  }

  ? {s1 foo 3 4} 7
  ? {s1 bar 3 4} 12
} 

#
# test object::dispatch instead of "nsf::my -local" on classes
#

nx::Test case dispatch-instead-of-my-local {
  nx::Class create Base {
    :protected method privateMethod {a b} { expr {$a + $b} }
    :public method foo {a b} { nsf::object::dispatch [self] [Base info method handle privateMethod] $a $b }
  }
    
  nx::Class create Sub -superclass Base {
    :public method bar {a b} { nsf::object::dispatch [self] [Sub info method handle privateMethod] $a $b }
    :public method privateMethod {a b} { expr {$a * $b} }

    :create s1
  }

  ? {s1 foo 3 4} 7
  ? {s1 bar 3 4} 12
}  

#
# Test -system flag on dispatch with explicit receiver
#
nx::Test case system-flag {

  #
  # create an object, which overloads some system behavior
  #
  nx::Object create o1 {
    :public method info {} {return "overloads system info"}
    :public method destroy {} {return "overloads system destroy"}
    :public method method args {return "overloads method method"}
    :variable v 1
  }
  
  ? {o1 info} "overloads system info"
  ? {o1 ::nx::Object::slot::__info::vars} "v"
  ? {o1 [nx::Object info method origin "info vars"]} "v"
  ? {o1 -system info vars} "v"
  ? {nsf::object::dispatch o1 -system info vars} "v"

  ? {o1 method foo {} {return foo}} "overloads method method"
  ? {o1 -system public method foo {} {return foo}} "::o1::foo"
  
  ? {o1 destroy} "overloads system destroy"
  ? {nsf::object::exists o1} 1
  ? {o1 -system destroy} ""
  ? {nsf::object::exists o1} 0
  
  #
  # create a class, which overloads some system behavior
  #
  nx::Class create C {
    :public method info {} {return "overloads system info"}
    :public method destroy {} {return "overloads system destroy"}
    :variable v 1
    :create c1
  }

  ? {c1 info} "overloads system info"
  ? {c1 ::nx::Object::slot::__info::vars} "v"
  ? {c1 [nx::Object info method origin "info vars"]} "v"
  ? {c1 -system info vars} "v"
  ? {nsf::object::dispatch c1 -system info vars} "v"
  
  ? {c1 destroy} "overloads system destroy"
  ? {nsf::object::exists c1} 1
  ? {c1 -system destroy} ""
  ? {nsf::object::exists c1} 0
}

#
# Check my-local + private + next
#
# Never call a private method via "next", but allow "next" from
# private methods
#

nx::Test case class-my-local+next {

  nx::Class create Base {
    :private method baz {a b} { expr {$a + $b} }
    :protected method baz2 {a b} { expr {$a + $b} }
    :public method foo {a b} { nsf::my -local baz $a $b }
    :create b1
  }
  # we can call Base.baz only through Base.foo
  ? {b1 foo 4 5} 9
  ? {b1 baz 4 5} {::b1: unable to dispatch method 'baz'}

  # Define and register a mixin class, where method "foo" is calling a
  # private method via "my -local"
  nx::Class create Mix {
    :private method baz {a b} { expr {$a ** $b} }
    :public method foo {a b} { nsf::my -local baz $a $b }
  }

  b1 mixin add Mix

  # we can call Mix.baz only through Mix.foo
  ? {b1 foo 4 5} 1024
  ? {b1 baz 4 5} {::b1: unable to dispatch method 'baz'}

  #
  # the private method has a next
  #
  nx::Class create Intermediate -superclass Base {
    :private method baz {a b} { next }
    :private method baz2 {a b} { next }
    :public method foo {a b} { nsf::my -local baz $a $b }
    :public method foo2 {a b} { nsf::my -local baz2 $a $b }
    :create i1
  }

  # next in the private method reaches a private method, which is ignored
  ? {i1 foo 4 5} ""
  ? {i1 baz 4 5} {::i1: unable to dispatch method 'baz'}
  # next in the private method reaches a non-private method, which is honored
  ? {i1 foo2 4 5} 9
    
  nx::Class create Sub -superclass Intermediate {
    :public method bar {a b} { nsf::my -local baz $a $b }
    :private method baz {a b} { expr {$a * $b} }

    :create s1
  }

  # next in the private method reaches a private method, which is ignored
  ? {s1 foo 4 5} ""
  ? {s1 baz 4 5} {::s1: unable to dispatch method 'baz'}
  # next in the private method reaches a non-private method, which is honored
  ? {s1 foo2 4 5} 9
  ? {s1 bar 4 5} 20

  # add per-class mixin
  Sub mixin add Mix

  # foo is shadowed in the mixin and calls the mixin-private method
  ? {s1 foo 4 5} 1024
  ? {s1 baz 4 5} {::s1: unable to dispatch method 'baz'}

  # next in the private method reaches a non-private method, which is honored
  ? {s1 foo2 4 5} 9
  ? {s1 bar 4 5} 20
}