# -*- Tcl -*-

package prefer latest

package require nx

::nx::configure defaultMethodCallProtection false
package require nx::test

#
# The same tests are in this test suite, once with and once without
# checking
#
# Make sure, checking is turned on
#
::nsf::configure checkresult true

nx::test configure -count 10000
nx::test case int-returns {
  nx::Class create C {
    # scripted method without paramdefs
    :method bar-ok1 {a b} {return 1}
    :method bar-ok2 {a b} {return $a}
    # scripted method with paramdefs
    :method bar-nok {a b:integer} {return a}
    # alias to tcl-cmd (no param defs)
    :alias incr -frame object ::incr
    :alias lappend -frame object ::lappend
    :create c1
  }

  ::nsf::method::property C bar-ok1 returns integer
  ::nsf::method::property C bar-ok2 returns integer
  ::nsf::method::property C bar-nok returns integer
  ::nsf::method::property C incr returns integer
  ::nsf::method::property C lappend returns integer

  ? {c1 bar-ok1 1 2} 1
  ? {c1 bar-ok2 1 2} 1
  ? {c1 bar-nok 1 2} {expected integer but got "a" as return value}

  ? {c1 incr x} 1
  ? {c1 incr x} 10002

  ? {c1 lappend l e1} {expected integer but got "e1" as return value}

  # query the returns value
  ? {::nsf::method::property C lappend returns} integer

  # reset it to empty
  ? {::nsf::method::property C lappend returns ""} ""
  ? {::nsf::method::property C bar-ok1 returns ""} ""
  ? {::nsf::method::property C bar-ok2 returns ""} ""
  ? {::nsf::method::property C bar-nok returns ""} ""

  # no checking
  ? {c1 bar-ok1 1 2} 1
  ? {c1 bar-ok2 1 2} 1
  ? {c1 bar-nok 1 2} a
  ? {c1 lappend l e2} "e1 e2"

  # query returns "", if there is no returns checking
  ? {::nsf::method::property C lappend returns} ""
  ? {::nsf::method::property ::nx::Class method returns} ""

}

nx::test configure -count 10
nx::test case app-specific-returns {

  ::nx::methodParameterSlot object method type=range {name value arg} {
    lassign [split $arg -] min max
    if {$value < $min || $value > $max} {
      error "Value '$value' of parameter $name not between $min and $max"
    }
    return $value
  }

  nx::Class create C {
    :method bar-ok1 {a b} {return 1}
    :method bar-ok2 {a b} {return $a}
    :method bar-nok {a b:integer} {return a}
    :alias incr -frame object ::incr
    :alias lappend -frame object ::lappend
    :create c1
  }

  ::nsf::method::property C bar-ok1 returns range,arg=1-3
  ::nsf::method::property C bar-ok2 returns range,arg=1-3
  ::nsf::method::property C bar-nok returns range,arg=1-3
  ::nsf::method::property C incr returns range,arg=1-30
  ::nsf::method::property C lappend returns range,arg=1-30

  ? {c1 bar-ok1 1 2} 1
  ? {c1 bar-ok2 1 2} 1
  ? {c1 bar-nok 1 2} {Value 'a' of parameter return-value not between 1 and 3}

  ? {c1 incr x} 1
  ? {c1 incr x} 12

  ? {c1 lappend l e1} {Value 'e1' of parameter return-value not between 1 and 30}
}

nx::test configure -count 1000
nx::test case converting-returns {

  ::nx::methodParameterSlot object method type=sex {name value args} {
    #puts stderr "[current] slot specific converter"
    switch -glob $value {
      m* {return m}
      f* {return f}
      default {error "expected sex but got $value"}
    }
  }

  nx::Class create C {
    :method bar-ok1 {a b} {return male}
    :method bar-ok2 {a b} {return $a}
    :method bar-nok {a b:integer} {return $b}
    :alias set -frame object ::set
    :create c1
  }

  ::nsf::method::property C bar-ok1 returns sex
  ::nsf::method::property C bar-ok2 returns sex
  ::nsf::method::property C bar-nok returns sex
  ::nsf::method::property C set returns sex

  ? {c1 bar-ok1 1 2} male
  ? {c1 bar-ok2 female 2} female
  ? {c1 bar-nok 1 6} {expected sex but got 6}

  ? {c1 set x male} male
  ? {c1 eval {set :x}} male
  ? {c1 set x} male

  ? {c1 set x hugo} {expected sex but got hugo}

  ::nsf::method::property C bar-ok1 returns sex,convert
  ::nsf::method::property C bar-ok2 returns sex,convert
  ::nsf::method::property C bar-nok returns sex,convert
  ::nsf::method::property C set returns sex,convert

  ? {c1 bar-ok1 1 2} m
  ? {c1 bar-ok2 female 2} f
  ? {c1 bar-nok 1 6} {expected sex but got 6}

  ? {c1 set x male} m
  ? {c1 eval {set :x}} male
  ? {c1 set x} m

  ? {c1 set x hugo} {expected sex but got hugo}
}

#
# turn off result checking
#
::nsf::configure checkresults false

::nx::test configure -count 1000
::nx::test case int-returns-nocheck {
  nx::Class create C {
    # scripted method without paramdefs
    :method bar-ok1 {a b} {return 1}
    :method bar-ok2 {a b} {return $a}
    # scripted method with paramdefs
    :method bar-nok {a b:integer} {return a}
    # alias to tcl-cmd (no param defs)
    :alias incr -frame object ::incr
    :alias lappend -frame object ::lappend
    :create c1
  }

  ::nsf::method::property C bar-ok1 returns integer
  ::nsf::method::property C bar-ok2 returns integer
  ::nsf::method::property C bar-nok returns integer
  ::nsf::method::property C incr returns integer
  ::nsf::method::property C lappend returns integer

  ? {c1 bar-ok1 1 2} 1
  ? {c1 bar-ok2 1 2} 1
  ? {c1 bar-nok 1 2} a

  ? {c1 incr x} 1
  ? {c1 incr x} 1002

  ? {c1 lappend l e1} e1

  # query the returns value
  ? {::nsf::method::property C lappend returns} integer

  # reset it to empty
  ? {::nsf::method::property C lappend returns ""} ""

  c1 eval {set :l e1}
  # no checking on lappend
  ? {c1 lappend l e2} "e1 e2"

  # query returns "", if there is no returns checking
  ? {::nsf::method::property C lappend returns} ""
  ? {::nsf::method::property ::nx::Class method returns} ""
}

::nx::test configure -count 10
::nx::test case app-specific-returns-nocheck {

  ::nx::methodParameterSlot object method type=range {name value arg} {
    lassign [split $arg -] min max
    if {$value < $min || $value > $max} {
      error "Value '$value' of parameter $name not between $min and $max"
    }
    return $value
  }

  nx::Class create C {
    :method bar-ok1 {a b} {return 1}
    :method bar-ok2 {a b} {return $a}
    :method bar-nok {a b:integer} {return a}
    :alias incr -frame object ::incr
    :alias lappend -frame object ::lappend
    :create c1
  }

  ::nsf::method::property C bar-ok1 returns range,arg=1-3
  ::nsf::method::property C bar-ok2 returns range,arg=1-3
  ::nsf::method::property C bar-nok returns range,arg=1-3
  ::nsf::method::property C incr returns range,arg=1-30
  ::nsf::method::property C lappend returns range,arg=1-30

  ? {c1 bar-ok1 1 2} 1
  ? {c1 bar-ok2 1 2} 1
  ? {c1 bar-nok 1 2} a

  ? {c1 incr x} 1
  ? {c1 incr x} 12

  ? {c1 lappend l e1} e1
}

::nx::test configure -count 1000
::nx::test case converting-returns-nocheck {

  ::nx::methodParameterSlot object method type=sex {name value args} {
    #puts stderr "[current] slot specific converter"
    switch -glob $value {
      m* {return m}
      f* {return f}
      default {error "expected sex but got $value"}
    }
  }

  nx::Class create C {
    :method bar-ok1 {a b} {return male}
    :method bar-ok2 {a b} {return $a}
    :method bar-nok {a b:integer} {return $b}
    :alias set -frame object ::set
    :create c1
  }

  #
  # turn off checker
  #
  ::nsf::method::property C bar-ok1 returns sex
  ::nsf::method::property C bar-ok2 returns sex
  ::nsf::method::property C bar-nok returns sex
  ::nsf::method::property C set returns sex

  ? {c1 bar-ok1 1 2} male
  ? {c1 bar-ok2 female 2} female
  ? {c1 bar-nok 1 6} 6

  ? {c1 set x male} male
  ? {c1 eval {set :x}} male
  ? {c1 set x} male

  ? {c1 set x hugo} hugo

  #
  # don't turn off converter
  #
  ::nsf::method::property C bar-ok1 returns sex,convert
  ::nsf::method::property C bar-ok2 returns sex,convert
  ::nsf::method::property C bar-nok returns sex,convert
  ::nsf::method::property C set returns sex,convert

  ? {c1 bar-ok1 1 2} m
  ? {c1 bar-ok2 female 2} f
  ? {c1 bar-nok 1 6} {expected sex but got 6}

  ? {c1 set x male} m
  ? {c1 eval {set :x}} male
  ? {c1 set x} m

  ? {c1 set x hugo} {expected sex but got hugo}
}


::nsf::configure checkresults true

::nx::test case int-returns-sugar {
  nx::Class create C {
    # scripted method without paramdefs
    :method bar-ok1 {a b} -returns integer {return 1}
    :method bar-ok2 {a b} -returns integer {return $a}
    # scripted method with paramdefs
    :method bar-nok {a b:integer} -returns integer {return a}
    # alias to tcl-cmd (no param defs)
    :alias incr -returns integer -frame object ::incr
    :alias lappend -returns integer -frame object ::lappend
    :forward ++ -returns integer ::expr 1 +
    :forward | -returns integer ::append _
    :public object method instances {} -returns object,1..n {:info instances}
    :create c1
  }

  package req nx::serializer
  set s [C serialize]
  puts $s
  ? [list set _ [regsub -all returns $s returns s]] 8 "occurrences of returns"

  ? {c1 bar-ok1 1 2} 1
  ? {c1 bar-ok2 1 2} 1
  ? {c1 ++ 1000} 1001
  ? {c1 | a} {expected integer but got "a" as return value}
  ? {::nsf::method::property ::C ::nsf::classes::C::bar-nok returns} integer
  ? {c1 bar-nok 1 2} {expected integer but got "a" as return value}

  ? {C instances} ::c1

  ? {c1 incr x} 1
  ? {c1 incr x} 1002

  ? {c1 lappend l e1} {expected integer but got "e1" as return value}

  # query the returns value
  ? {::nsf::method::property C lappend returns} integer

  # reset it to empty
  ? {::nsf::method::property C lappend returns ""} ""
  ? {::nsf::method::property C bar-ok1 returns ""} ""
  ? {::nsf::method::property C bar-ok2 returns ""} ""
  ? {::nsf::method::property C bar-nok returns ""} ""
  ? {::nsf::method::property C ++ returns ""} ""
  ? {::nsf::method::property C | returns ""} ""

  # no checking
  ? {c1 bar-ok1 1 2} 1
  ? {c1 bar-ok2 1 2} 1
  ? {c1 bar-nok 1 2} a
  ? {c1 lappend l e2} "e1 e2"
  ? {c1 ++ 1000} 1001
  ? {c1 | a} "a"

  # query returns "", if there is no returns checking
  ? {::nsf::method::property C lappend returns} ""
  ? {::nsf::method::property ::nx::Class method returns} ""

}

::nx::test case returns-string-checks {
  ::nx::Class create C {
    #
    # strings test with "string is alpha" checker
    #
    :public method get1 {} -returns alpha { return a }
    :public method get2 {} -returns alpha { return 1 }
    :public method get3 {} -returns alpha,1..n { return {a b c} }
    :public method get4 {} -returns alpha,1..n { return {a 1 c} }
    #
    # built-in checker
    #
    :public method get5 {} -returns integer { return 2 }
    :public method get6 {} -returns integer { return a }
    :public method get7 {} -returns integer,1..n { return {1 2 3} }
    :public method get8 {} -returns integer,1..n { return {1 2 a} }

    :create a
  }

  ? {a get1} a
  ? {a get2} {expected alpha but got "1" as return value}
  ? {a get3} {a b c}
  ? {a get4} {invalid value in "a 1 c": expected alpha but got "1" as return value}
  ? {a get5} 2
  ? {a get6} {expected integer but got "a" as return value}
  ? {a get7} {1 2 3}
  ? {a get8} {invalid value in "1 2 a": expected integer but got "a" as return value}


  nsf::proc ::foo1 {-a:integer} {return ok}
  ? ::foo1 "ok"

  nsf::proc ::foo2 {-a:integer} -returns integer {return ok}
  ? ::foo2 {expected integer but got "ok" as return value}

  nsf::proc ::foo2b {-a:integer} -returns boolean {return ok}
  ? ::foo2b {expected boolean but got "ok" as return value}

  nsf::proc ::foo3 {-a:integer} -returns integer {return 1}
  ? ::foo3 1

  nsf::proc ::foo4 {-a:integer} -returns alpha {return 1}
  ? ::foo4 {expected alpha but got "1" as return value}

  nsf::proc ::foo5 {-a:integer} -returns alpha {return abc}
  ? ::foo5 abc

  nsf::proc ::foo6 {-a:integer} -returns alpha,1..n {return {a b c}}
  ? ::foo6 {a b c}

  nsf::proc ::foo7 {-a:integer} -returns alpha,1..n {return {a 2 c}}
  ? ::foo7 {invalid value in "a 2 c": expected alpha but got "2" as return value}

  nsf::proc ::foo8 {-a:integer} -returns integer,1..n {return {1 2}}
  ? ::foo8 {1 2}

  nsf::proc ::foo9 {-a:integer} -returns integer,1..n {return {a 2 c}}
  ? ::foo9 {invalid value in "a 2 c": expected integer but got "a" as return value}

}


::nx::test case empty-paramdefs-robustedness {
  ::nx::Object create ku {
    # 1: Create an empty or checker-free parameter spec
    :object method foo {} {;}
    ? [:info object method parameters foo] ""
    # 2: A call to ::nsf::method::property which might require NsfParamDefs
    ? [list ::nsf::method::property [::nx::current] foo returns] ""
    # 3: Check, if "info method parameter" still works
    ? [:info object method parameters foo] ""
    ? [list ::nsf::method::property [::nx::current] foo returns] ""
    # 4: Set methodproperty to some value and check again
    ::nsf::method::property [::nx::current] foo returns int
    ? [list ::nsf::method::property [::nx::current] foo returns] "int"
    ? [:info object method parameters foo] ""
    # 5: Reset methodproperty and query again
    ::nsf::method::property [::nx::current] foo returns ""
    ? [list ::nsf::method::property [::nx::current] foo returns] ""
    ? [:info object method parameters foo] ""
  }
}

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