# -*- Tcl -*-
package require nx
::nx::configure defaultMethodCallProtection false
package require nx::test
namespace import ::nx::*

Test parameter count 10

Class create C {
  # methods
  :method plain_method {} {return [current method]}
  :public method public_method {} {return [current method]}
  :protected method protected_method {} {return [current method]}

  # forwards
  :forward plain_forward %self plain_method
  :public forward public_forward %self public_method
  :protected forward protected_forward %self protected_method

  # setter
  :property plain_setter 
  :public property public_setter 
  :protected property protected_setter 

  # alias
  :alias plain_alias [C info method handle plain_method]
  :public alias public_alias [C info method handle public_method]
  :protected alias protected_alias [C info method handle protected_method]
  
  # class-object
  :class method plain_object_method {} {return [current method]}
  :public class method public_object_method {} {return [current method]}
  :protected class method protected_object_method {}  {return [current method]}
  :class forward plain_object_forward %self plain_object_method
  :public class forward public_object_forward %self public_object_method
  :protected class forward protected_object_forward %self protected_object_method
  :class property plain_object_setter 
  :public class property public_object_setter 
  :protected class property protected_object_setter 
  :class alias plain_object_alias [:class info method handle plain_object_method]
  :public class alias public_object_alias [:class info method handle public_object_method]
  :protected class alias protected_object_alias [:class info method handle protected_object_method]
}
C create c1 {
  # methods
  :method plain_object_method {} {return [current method]}
  :public method public_object_method {} {return [current method]}
  :protected method protected_object_method {} {return [current method]}

  # forwards
  :forward plain_object_forward %self plain_object_method
  :public forward public_object_forward %self public_object_method
  :protected forward protected_object_forward %self protected_object_method

  # setter
  :property plain_object_setter 
  :public property public_object_setter 
  :protected property protected_object_setter 

  # alias
  :alias plain_object_alias [:info method handle plain_object_method]
  :public alias public_object_alias [:info method handle public_object_method]
  :protected alias protected_object_alias [:info method handle protected_object_method]
}
C public property s0
C protected property s1
? {c1 s0 0} 0
? {::nsf::object::dispatch c1 s1 1} 1
C class property s3
? {C s3 3} 3

# create a fresh object (different from c1)
C create c2
# test scripted class level methods
Test case scripted-class-level-methods {
  ? {c2 plain_method} "plain_method"
  ? {c2 public_method} "public_method"
  ? {catch {c2 protected_method}} 1
  ? {::nsf::object::dispatch c2 protected_method} "protected_method"
}

# class level forwards
Test case class-level-forwards {
  ? {c2 plain_forward} "plain_method"
  ? {c2 public_forward} "public_method"
  ? {catch {c2 protected_forward}} 1
  ? {::nsf::object::dispatch c2 protected_forward} "protected_method"
}

# class level setter
Test case class-level-setter {
  ? {c2 plain_setter 1} "1"
  ? {c2 public_setter 2} "2"
  ? {catch {c2 protected_setter 3}} 1
  ? {::nsf::object::dispatch c2 protected_setter 4} "4"
}

# class level alias ....TODO: wanted behavior of [current method]? not "plain_alias"?
Test case class-level-alias {
  ? {c2 plain_alias} "plain_method"
  ? {c2 public_alias} "public_method"
  ? {catch {c2 protected_alias}} 1
  ? {::nsf::object::dispatch c2 protected_alias} "protected_method"
}

###########

# scripted class level methods
Test case scripted-class-object-level {
  ? {C plain_object_method} "plain_object_method"
  ? {C public_object_method} "public_object_method"
  ? {catch {C protected_object_method}} 1
  ? {::nsf::object::dispatch C protected_object_method} "protected_object_method"
}

# class level forwards
Test case class-object-level-forwards {
  ? {C plain_object_forward} "plain_object_method"
  ? {C public_object_forward} "public_object_method"
  ? {catch {C protected_object_forward}} 1
  ? {::nsf::object::dispatch C protected_object_forward} "protected_object_method"
}

# class level setter
Test case class-object-level-setter {
  ? {C plain_object_setter 1} "1"
  ? {C public_object_setter 2} "2"
  ? {catch {C protected_object_setter 3}} 1
  ? {::nsf::object::dispatch C protected_object_setter 4} "4"
}

# class level alias ....TODO: wanted behavior of [current method]? not "plain_alias"?
Test case class-object-level-alias {
  ? {C plain_object_alias} "plain_object_method"
  ? {C public_object_alias} "public_object_method"
  ? {catch {C protected_object_alias}} 1
  ? {::nsf::object::dispatch C protected_object_alias} "protected_object_method"
}

###########

# scripted object level methods
Test case scripted-object-level-methods {
  ? {c1 plain_object_method} "plain_object_method"
  ? {c1 public_object_method} "public_object_method"
  ? {catch {c1 protected_object_method}} 1
  ? {::nsf::object::dispatch c1 protected_object_method} "protected_object_method"
}

# object level forwards
Test case object-level-forwards {
  ? {c1 plain_object_forward} "plain_object_method"
  ? {c1 public_object_forward} "public_object_method"
  ? {catch {c1 protected_object_forward}} 1
  ? {::nsf::object::dispatch c1 protected_object_forward} "protected_object_method"
}

# object level setter
Test case object-level-setter {
  ? {c1 plain_object_setter 1} "1"
  ? {c1 public_object_setter 2} "2"
  ? {catch {c1 protected_object_setter 3}} 1
  ? {::nsf::object::dispatch c1 protected_object_setter 4} "4"
}

# object level alias ....TODO: wanted behavior of [current method]? not "plain_alias"?
Test case object-level-alias {
  ? {c1 plain_object_alias} "plain_object_method"
  ? {c1 public_object_alias} "public_object_method"
  ? {catch {c1 protected_object_alias}} 1
  ? {::nsf::object::dispatch c1 protected_object_alias} "protected_object_method"

  ? {lsort [c1 info methods]} \
      "plain_object_alias plain_object_forward plain_object_method plain_object_setter public_object_alias public_object_forward public_object_method public_object_setter"
  ? {lsort [C class info methods]} \
      "plain_object_alias plain_object_forward plain_object_method plain_object_setter public_object_alias public_object_forward public_object_method public_object_setter s3"
}

C destroy

Test case colondispatch {
  Object create ::o {
    #:public method foo args {;}
    :public method bar args {;}
  }
  ? {o :bar} "::o: methodname ':bar' must not start with a colon" 
  ? {o eval :bar} "" 
  ? {o :foo} "::o: methodname ':foo' must not start with a colon" 
  ? {o eval :foo} "::o: unable to dispatch method 'foo'" 
}

Test case mixinguards {
  # define a Class C and mixin class M
  Class create C
  Class create M

  # register the mixin on C as a class mixin and define a mixinguard
  C mixin M
  C mixin guard M {1 == 1}
  ? {C info mixin guard M} "1 == 1"
  C mixin guard M {}
  ? {C info mixin guard M} ""

  # now the same as class mixin and class mixin guard
  C class mixin M
  C class mixin guard M {1 == 1}
  ? {C class info mixin guard M} "1 == 1"
  C class mixin guard M {}
  ? {C class info mixin guard M} ""
}

Test case mixin-via-objectparam {
  # add an object and class mixin via object-parameter and via slots
  Class create M1; Class create M2; Class create M3; Class create M4
  Class create C -mixin M1 -object-mixin M2 {
    :mixin add M3
    :class mixin add M4
  }
  
  ? {lsort [C class info mixin classes]} "::M2 ::M4"
  #? {lsort [C class info mixin classes]} "::M2"

  ? {lsort [C info mixin classes]} "::M1 ::M3"
  #? {lsort [C info mixin classes]} "::M1"
  C destroy
  M1 destroy; M2 destroy; M3 destroy; M4 destroy;
}

# testing next via nonpos-args
Test case next-from-nonpos-args {
  
  Object create o {
    :method bar {-y:required -x:required} {
      #puts stderr "+++ o x=$x, y=$y [current args] ... next [current next]"
      return [list x $x y $y [current args]]
    }
  }
  Class create M {
    :method bar {-x:required -y:required} {
      #puts stderr "+++ M x=$x, y=$y [current args] ... next [current next]"
      return [list x $x y $y [current args] -- {*}[next]]
    }
  }
  
  o mixin M
  ? {o bar -x 13 -y 14} "x 13 y 14 {-x 13 -y 14} -- x 13 y 14 {-x 13 -y 14}"
  ? {o bar -y 14 -x 13} "x 13 y 14 {-y 14 -x 13} -- x 13 y 14 {-y 14 -x 13}"
}

# 
# test method property with protected/public
# 
Test case property-method {

  Class create C {
    set x [:property a]

    ? [list set _ $x] "::nsf::classes::C::a"

    # property with default
    :property {b b1}
    :public property {c c1}
    :protected property {d d1}

    set X [:class property A]
    ? [list set _ $X] "::C::A"
    
    # class property with default
    :class property {B B2}
    :public class property {C C2}
    :protected class property {D D2}
  }

  C create c1 -a 1
  ? {c1 a} 1
  ? {c1 b} b1
  ? {c1 c} c1
  ? {c1 d} "::c1: unable to dispatch method 'd'"

  ? {C A 2} 2
  ? {C A} 2
  ? {C B} B2
  ? {C C} C2
  ? {C D} "Method 'D' unknown for ::C. Consider '::C create D ' instead of '::C D '"

  Object create o {
    set x [:property a]
    ? [list set _ $x] "::o::a"

    # property with default
    :property {b b1}
    :public property {c c1}
    :protected property {d d1}
  }
  ? {o a 2} 2
  ? {o b} b1
  ? {o c} c1
  ? {o d} "::o: unable to dispatch method 'd'"
}

Test case subcmd {
  
  Class create Foo {

     :method "Info filter guard" {filter} {return [current object]-[current method]}
     :method "Info filter methods" {-guards pattern:optional} {return [current object]-[current method]}
     :method "Info args" {} {return [current object]-[current method]}
     :method "Info foo" {} {return [current object]-[current method]}

     :class method "INFO filter guard" {a b} {return [current object]-[current method]}
     :class method "INFO filter methods" {-guards pattern:optional} {return [current object]-[current method]}
   }
  
  ? {Foo INFO filter guard 1 2} ::Foo-guard
  ? {Foo INFO filter methods a*} ::Foo-methods
  
  Foo create f1 {
    :method "list length" {} {return [current object]-[current method]}
    :method "list reverse" {} {return [current object]-[current method]}
  }

  ? {f1 Info filter guard x} "::f1-guard"
  ? {f1 Info filter methods} "::f1-methods"
  ? {f1 Info args} "::f1-args"
  ? {f1 Info foo} "::f1-foo"

  ? {f1 list length} "::f1-length"
  ? {f1 list reverse} "::f1-reverse"
}

package req nx::serializer
Test case class-object-property {
  Class create C {
    :class property x
    :property a:int
    :create c1
  }
  ? {C x 1} 1
  ? {C x} 1
  ? {C info methods} "a"
  ? {C class info methods} x
  ? {c1 a b} {expected integer but got "b" for parameter "a"}
 
  set s(C) [C serialize]
  set s(c1) [c1 serialize]

  # Destroy object and class
  c1 destroy
  C destroy

  ? {nsf::object::exists c1} 0
  ? {nsf::object::exists C} 0

  # create it from the serialized code
  eval $s(C)
  eval $s(c1)

  # tests should work as again
  ? {C x} 1
  ? {C info methods} "a"
  ? {C class info methods} x
  ? {c1 a b} {expected integer but got "b" for parameter "a"}  
}

#
# Test method deletion
#
Test parameter count 1

Test case methoddelete {
  nx::Class create C {
    :public method foo {x} {return $x}
    :public class method bar {x} {return $x}
    :create c1
  }
  
  ? {::nsf::method::delete C x} "::C: cannot delete method 'x'"
  ? {::nsf::method::delete C -per-object x} "::C: cannot delete object specific method 'x'"
  ? {::nsf::method::delete C foo} ""
  ? {::nsf::method::delete C foo} "::C: cannot delete method 'foo'"
  ? {::nsf::method::delete C bar} "::C: cannot delete method 'bar'"
  ? {::nsf::method::delete C -per-object bar} ""
  ? {::nsf::method::delete C -per-object bar} "::C: cannot delete object specific method 'bar'"
}

#
# Test error message of method modifier
#
Test parameter count 1

Test case errormessage {
  nx::Class create C
  ? {C public method foo {x} {return $x}} "::nsf::classes::C::foo"
  ? {C public object method bar {x} {return $x}} \
      "'object' is not a method defining method"
  ? {C protected object method bar {x} {return $x}} \
      "'object' is not a method defining method"
  ? {C object method bar {x} {return $x}} \
      {Method 'object' unknown for ::C. Consider '::C create object method bar x {return $x}' instead of '::C object method bar x {return $x}'}
  ? {C public class object method bar {x} {return $x}} \
      "'object' not allowed to be modified by 'class'"
}

#
# test dispatch without object
#
Test case dispatch-without-object {

  nx::Object create o {
    # property defines a setter, we need a current object
    :property {a v}
    # the other methods don't require them as strong
    :forward b ::o2 bar
    :method foo {} {return [self]}
    :alias x ::o::foo
  }
  nx::Object create o2 {
    :public method bar {} {return [self]}
  }

  # dispatch methods without current object 
  ? ::o::a "Method ::o::a not dispatched on valid object"
  ? ::o::b "::o2"
  ? ::o::foo "No current object; command called outside the context of a Next Scripting method"
  ? ::o::x "No current object; x called outside the context of a Next Scripting method"
  # make a regular call, provide tcd->object with a value
  ? {::o x} "::o"
  # check, if missing object is still detected
  ? ::o::x "No current object; x called outside the context of a Next Scripting method"
  ? self "No current object; command called outside the context of a Next Scripting method"
}


#
# Test the current namespaces and resolution for
# a) top-level methods
# b) ensemble methods on level 1
# c) ensemble methods on level 2
#
nx::Test case scopes {
  Object create o1 {
    :public method foo {} {return [namespace current]-[namespace which info]}
    :public method "info foo" {} {return [namespace current]-[namespace which info]}
    :public method "info bar foo" {} {return [namespace current]-[namespace which info]}
  }

  ? {o1 foo} "::-::info"
  ? {o1 info foo} "::-::info"
  ? {o1 info bar foo} "::-::info"

  Class create C {
    :public method foo {} {return [namespace current]-[namespace which info]}
    :public method "info foo" {} {return [namespace current]-[namespace which info]}
    :public method "info bar foo" {} {return [namespace current]-[namespace which info]}
    :create c1
  }

  ? {c1 foo} "::-::info"
  ? {c1 info foo} "::-::info"
  ? {c1 info bar foo} "::-::info"
}

#
# Test the current namespaces and resolution for methods
# registered on a object in a certain namespace
# a) top-level methods
# b) ensemble methods on level 1
# c) ensemble methods on level 2
#
nx::Test case namespaced-scopes {

  namespace eval ::ns {
    Object create o1 {
      :public method foo {} {return [namespace current]-[namespace which info]}
      :public method "info foo" {} {return [namespace current]-[namespace which info]}
      :public method "info bar foo" {} {return [namespace current]-[namespace which info]}
    }
    Class create C {
      :public method foo {} {return [namespace current]-[namespace which info]}
      :public method "info foo" {} {return [namespace current]-[namespace which info]}
      :public method "info bar foo" {} {return [namespace current]-[namespace which info]}
      :create c1
    }
  }

  ? {ns::o1 foo} "::ns-::info"
  ? {ns::o1 info foo} "::ns-::info"
  ? {ns::o1 info bar foo} "::ns-::info"

  ? {ns::c1 foo} "::ns-::info"
  ? {ns::c1 info foo} "::ns-::info"
  ? {ns::c1 info bar foo} "::ns-::info"
}


#
# Test the current namespaces and resolution for methods
# registered on a sub object
# a) top-level methods
# b) ensemble methods on level 1
# c) ensemble methods on level 2
#
nx::Test case nested-scopes {
  Object create o 
  Object create o::o1 {
    :public method foo {} {return [namespace current]-[namespace which info]}
    :public method "info foo" {} {return [namespace current]-[namespace which info]}
    :public method "info bar foo" {} {return [namespace current]-[namespace which info]}
  }

  ? {o::o1 foo} "::o-::info"
  ? {o::o1 info foo} "::o-::info"
  ? {o::o1 info bar foo} "::o-::info"

  Class create o::C {
    :public method foo {} {return [namespace current]-[namespace which info]}
    :public method "info foo" {} {return [namespace current]-[namespace which info]}
    :public method "info bar foo" {} {return [namespace current]-[namespace which info]}
    :create c1
  }

  ? {c1 foo} "::o-::info"
  ? {c1 info foo} "::o-::info"
  ? {c1 info bar foo} "::o-::info"
}

#
# Test deletion of object-specific methods/attributes via "delete
# method" and "delete property"
#
# a) test attributes
# b) test simple methods
# c) test ensemble methods
#
nx::Test case delete-per-object {
  Object create o1 {
    :property a1
    :property a2
    :public method foo {} {return [namespace current]-[namespace which info]}
    :public method "info foo" {} {return [namespace current]-[namespace which info]}
    :public method "info bar foo" {} {return [namespace current]-[namespace which info]}
  }

  ? {o1 info methods -path} "{info foo} {info bar foo} foo a1 a2"
  ? {o1 info children} "::o1::info ::o1::per-object-slot"

  ? {o1 delete method bar} "::o1: cannot delete object specific method 'bar'"
  # For a1, we have a method and an property. We can delete the
  # method without the slot.
  ? {o1 delete method a1} ""
  # After the deletion of the accessor, the slot exists still
  ? {o1::per-object-slot info children} "::o1::per-object-slot::a1 ::o1::per-object-slot::a2"
  # If we perform now a "delete property a1", the slot will be removed.
  ? {o1 delete property a1} ""
  ? {o1::per-object-slot info children} "::o1::per-object-slot::a2"

  # try to delete the property again:
  ? {o1 delete property a1} "::o1: cannot delete object specific property 'a1'"

  ? {o1 info methods -path} "{info foo} {info bar foo} foo a2"
  ? {o1 delete property a2} ""
  ? {o1 info methods -path} "{info foo} {info bar foo} foo"

  ? {o1 delete method foo} ""
  ? {o1 info methods -path} "{info foo} {info bar foo}"

  ? {o1 delete method "info foo"} ""
  ? {o1 info methods -path} "{info bar foo}"

  ? {o1 delete method "info bar foo"} ""
  ? {o1 info methods -path} ""
}

#
# Test deletion of per-object methods/attributes defined on classes
# via the delete method
# a) test attributes
# b) test simple methods
# c) test ensemble methods
#
nx::Test case delete-per-object-on-class {
  Class create C {
    :class property a1
    :public class method foo {} {return [namespace current]-[namespace which info]}
    :public class method "info foo" {} {return [namespace current]-[namespace which info]}
    :public class method "info bar foo" {} {return [namespace current]-[namespace which info]}
    :property a2
  }

  ? {C class info methods -path} "{info foo} {info bar foo} foo a1"
  ? {C info children} "::C::info ::C::slot ::C::per-object-slot"

  ? {C class delete method bar} "::C: cannot delete object specific method 'bar'"

  ? {C class delete property a1} ""
  ? {C class info methods -path} "{info foo} {info bar foo} foo"
  ? {C class delete property a1} "::C: cannot delete object specific property 'a1'"

  ? {C class delete method foo} ""
  ? {C class info methods -path} "{info foo} {info bar foo}"

  ? {C class delete method "info foo"} ""
  ? {C class info methods -path} "{info bar foo}"

  ? {C class delete method "info bar foo"} ""
  ? {C class info methods -path} ""

  ? {C info methods} "a2"
  ? {C info slots} "::C::slot::a2"
}


#
# Test deletion of methods/attributes defined on classes via the
# delete method
# a) test attributes
# b) test simple methods
# c) test ensemble methods
#
nx::Test case delete-class-level-method {
  Class create C {
    :property a1
    :public method foo {} {return [namespace current]-[namespace which info]}
    :public method "info foo" {} {return [namespace current]-[namespace which info]}
    :public method "info bar foo" {} {return [namespace current]-[namespace which info]}
  }

  ? {C info methods -path} "{info foo} {info bar foo} foo a1"
  ? {C info children} "::C::slot"

  ? {C delete method bar} "::C: cannot delete method 'bar'"

  ? {C delete property a1} ""
  ? {C info methods -path} "{info foo} {info bar foo} foo"

  ? {C delete property a1} "::C: cannot delete property 'a1'"

  ? {C delete method foo} ""
  ? {C info methods -path} "{info foo} {info bar foo}"

  ? {C delete method "info foo"} ""
  ? {C info methods -path} "{info bar foo}"

  ? {C delete method "info bar foo"} ""
  ? {C info methods -path} ""
}

#
# simple unknown tests; 
# ensemble unknown tests are in submethods.test
#
nx::Test case test-simple-unknown {

  #
  # calling unknown with a plain "method" without arguments
  #
  ::nx::Class create A {
    :class method unknown args {? [list set _ $args] "hello"}
  }
  A hello

  #
  # calling unknown with a plain "method" with arguments
  #
  ::nx::Class create B {
    :class method unknown args {? [list set _ $args] "hello world"}
  }
  B hello world

  #
  # calling unknown with a method with spaces
  #
  ::nx::Class create C {
    :class method unknown args {? [list set _ $args] "{hello world}"}
  }
  C {hello world}


}