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

Test parameter count 1

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 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'}

#
# 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 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"

# overwrite-protect object specific method
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!}