# -*- Tcl -*-
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 emtpy
    ? {::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} {
	foreach {min max} [split $arg -] break
	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 emtpy
    ? {::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} {
	foreach {min max} [split $arg -] break
	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 "occurances 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 emtpy
    ? {::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 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] ""
  }
}