# testing var resolution for namespace-shadowed objects 

package require XOTcl; xotcl::use xotcl2
package require xotcl::test

Test parameter count 1

::nx::core::alias ::nx::Object objeval -objscope ::eval 
::nx::core::alias ::nx::Object array -objscope ::array
::nx::core::alias ::nx::Object lappend -objscope ::lappend
::nx::core::alias ::nx::Object incr -objscope ::incr
::nx::core::alias ::nx::Object set -objscope ::set
::nx::core::alias ::nx::Object unset -objscope ::unset


###########################################
# Basic tests for var resolution under 
# per-object namespaces ...
###########################################
Test case globals
set ::globalVar 1
Object create o 
o requireNamespace
? {o info vars} ""
? {info exists ::globalVar} 1
? {set ::globalVar} 1
? {o exists globalVar} 0
? {o array exists globalVar} 0
o array set globalVar {1 2}
? {o exists globalVar} 1
? {o info vars} globalVar
? {o array exists globalVar} 1
? {set ::globalVar} 1
? {o set globalVar(1)} 2

o destroy
unset ::globalVar

###########################################
# scopes
###########################################
Test case scopes

Object create o 
Object create o2 {set :i 1}
o objeval {
  # require an namespace within an objscoped frame; it is necessary to replace
  # vartables on the stack
  :requireNamespace
  global g
  ::nx::core::importvar o2 i
  set x 1
  set :y 2
  set ::z 3
  set [self]::X 4
  set g 1
}
set ::o::Y 5
? {info vars ::x} ""

? {info exists ::z} 1
? {set ::z} 3
? {lsort [o info vars]} {X Y g i x y}
? {o exists x} 1
? {o exists y} 1
? {o exists z} 0
? {o exists X} 1
? {o exists Y} 1
? {o set y} 2
? {set ::g} 1 

o destroy
o2 destroy
unset ::z
unset ::g

# like the example above, but with the non-leaf initcmd

Object create o2 {set :i 1}
Object create o {
  :requireNamespace
  global g
  ::nx::core::importvar o2 i
  set x 1
  set :y 2
  set ::z 3
  set [self]::X 4
  set g 1
}
set ::o::Y 5
? {info vars ::x} ""

? {info exists ::z} 1
? {set ::z} 3
? {lsort [o info vars]} {X Y y}
? {o exists x} 0
? {o exists y} 1
? {o exists z} 0
? {o exists X} 1
? {o exists Y} 1
? {o set y} 2
? {set ::g} 1 

o destroy
o2 destroy
unset ::z
unset ::g
foreach v {::x ::z ::g} {unset -nocomplain $v}

###########################################
# mix & match namespace and object interfaces
###########################################
Test case namespaces

Object create o 
o requireNamespace
o set x 1
? {namespace eval ::o {set x}} 1
? {::o set x} 1
? {namespace eval ::o {set x 3}} 3
? {::o set x} 3
? {namespace eval ::o {info exists x}} 1
? {::o unset x} ""
? {::nx::core::existsvar o x} 0
? {o exists x} 0
? {info vars ::x} ""
? {namespace eval ::o {info exists x}} 0
o lappend y 3
? {namespace eval ::o {llength y}} 1
? {namespace eval ::o {unset y}} ""
? {::o exists y} 0
o destroy

###########################################
# array-specific tests
###########################################
Test case namespaces-array

Object create o 
o requireNamespace

? {o array exists a} 0
? {namespace eval ::o array exists a} 0
o array set a {1 2 3 4 5 6}
? {o array exists a} 1
? {namespace eval ::o array exists a} 1
? {namespace eval ::o array names a} [::o array names a]
? {namespace eval ::o array size a} [::o array size a]
? {o set a(1) 7} 7
? {namespace eval ::o array get a 1} {1 7}
? {namespace eval ::o set a(1) 2} 2
? {o array get a 1} {1 2}
? {::o unset a} ""
? {::o array unset a} ""
? {o array exists a} 0
? {namespace eval ::o array exists a} 0

o destroy

###########################################
# tests on namespace-qualified var names
###########################################
Test case namespaced-var-names
Object create o 
o requireNamespace
Object create o::oo 
o::oo requireNamespace

? {::o set ::x 1} 1
? {info exists ::x} [set ::x]
? {catch {unset ::x}} 0

? {::o set ::o::x 1} 1
? {o exists x} [::o set ::o::x]
? {namespace eval ::o unset x} ""
? {o exists x} 0

# Note, relatively qualified var names (not prefixed with ::*) 
# are always resolved relative to the per-object namespace
? {catch {::o set o::x 1} msg} 1
? {::o set oo::x 1} 1
? {o::oo exists x} [::o set oo::x]
? {o unset oo::x} ""
? {o::oo exists x} 0

o destroy

###########################################
# tests on namespace-qualified on objects
# without namespaces
###########################################

# the tests below fail. We could consider
# to require namespaces on the fly in the future
#Object create o
#? {::o set ::o::x 1} 1
#? {o exists x} [::o set ::o::x]
#? {namespace eval ::o unset x} ""
#? {o exists x} 0

#? {::o set o::x 1} 1
#? {o exists x} [::o set o::x]
#? {namespace eval ::o unset x} ""
#? {o exists x} 0

#o destroy

###############################################
# tests for the compiled var resolver on Object
###############################################
Test case var-resolver-object
Object create o
o method foo {x} {set :y 2; return ${:x},${:y}}
o method bar {} {return ${:x},${:y}}
o set x 1
? {o foo 1} "1,2" "create var y and fetch var x"
? {o bar} "1,2" "fetch two instance variables"
? {o info vars} "x y" 
# recreate object, check var caching; 
# we have to recreate bar, so no problem
Object create o
o set x 1
o method bar {} {return ${:x},${:y}}
? {catch {o bar}} "1" "compiled var y should not exist"
o destroy

###############################################
# tests for the compiled var resolver on Class
###############################################
Test case var-resolver-class
Class create C -parameter {{x 1}}
C create c1
C method foo {x} {set :y 2; return ${:x},${:y}}
C method bar {} {return ${:x},${:y}}
? {c1 info vars} "x" 
? {c1 foo 1} "1,2" "create var y and fetch var x"
? {c1 bar} "1,2" "fetch two instance variables"
? {c1 info vars} "x y" 
# recreate object, check var caching; 
# we do not have to recreate bar, compiled var persists,
# change must be detected
C create c1
#puts stderr "after recreate"
? {catch {c1 bar}} "1" "compiled var y should not exist"
? {c1 info vars} "x" 
c1 destroy
C destroy



###############################################
# tests for the compiled var resolver with eval
###############################################
Test case compiled-var-resolver
Class create C -parameter {{x 1}}
C create c1
C method foo {x} {
  set :y 2; 
  eval "set :z 3"
  return ${:x},${:y},${:z}
}
? {c1 info vars} "x"
? {c1 foo 1} "1,2,3"
? {c1 info vars} "x y z"
C create c1
? {c1 info vars} "x"
C method foo {x} {
  set cmd set
  lappend cmd :y
  lappend cmd 100
  eval $cmd
  return $x,${:y}
}
C method bar {} {return [info exists :x],[info exists :y]}
C method bar2 {} {if {[info exists :x]} {set :x 1000}; return [info exists :x],[info exists :y]}
? {c1 foo 1} "1,100"
? {c1 bar} "1,1"
? {c1 bar2} "1,1"
c1 unset x
? {c1 bar2} "0,1"
c1 destroy
C destroy

###############################################
# tests with array
###############################################

Class create C
C create c1
C method foo {} {
  array set :a {a 1 b 2 c 3}
  set :z 100
}
? {c1 info vars} ""
c1 foo
? {lsort [c1 info vars]} {a z}

###############################################
# tests for the var resolver
###############################################
Test case var-resolver
Class create C
C method bar0 {} {return ${:x}}
C method bar1 {} {set a ${:x}; return [info exists :x],[info exists :y]}
C method bar2 {} {return [info exists :x],[info exists :y]}
C method foo {} {
  array set :a {a 1 b 2 c 3}
  set :z 100
}
C create c1
c1 set x 100
? {c1 bar0} 100 "single compiled local"
? {c1 bar1} 1,0 "lookup one compiled var and one non-existing"
? {c1 bar2} 1,0 "lookup one non compiled var and one non-existing"
C create c2
? {c2 bar2} 0,0 "lookup two one non-existing, first access to varTable"
c1 foo
? {lsort [c1 info vars]} "a x z" "array variable set via resolver"
? {lsort [c1 array names a]} "a b c" "array looks ok"

###############################################
# first tests for the cmd resolver
###############################################
Class create C
C method bar {args} {
  #puts stderr "[self] bar called with [list $args]"
  return $args
}
C forward test %self bar
C method foo {} {
  # this works
  lappend :r [:bar x 1]
  lappend :r [:test a b c]
  # these kind of works, but vars are nowhere....
  :set x 1
  :incr x 1
  :incr x 1
  return [lappend :r ${:x}]
}
C create c3
? {c3 foo} "{x 1} {a b c} 3"

###############################################
# refined tests for the var resolver under
# Tcl namespaces parallelling XOTcl objects 
# (! not declared through requireNamespace !)
# e.g., "info hasnamespace" reports 0 rather
# than 1 as under "requireNamespace"
###############################################

set ::w 1
array set ::tmpArray {key value}

Class create ::C
::nx::core::alias ::C Set -objscope ::set
::nx::core::alias ::C Unset -objscope ::unset

::C create ::c
namespace eval ::c {}
? {namespace exists ::c} 1
? {::nx::core::objectproperty ::c object} 1
? {::c info hasnamespace} 0

? {::c Set w 2; expr {[::c Set w] == $::w}} 0
? {::c Unset w; info exists ::w} 1
? {::c Set tmpArray(key) value2; expr {[::c Set tmpArray(key)] == $::tmpArray(key)}} 0
? {::c Unset tmpArray(key); info exists ::tmpArray(key)} 1

::c destroy
::C destroy
unset ::w
unset ::tmpArray

##################################################
# Testing aliases for eval with and without flags 
#
#    -objscope, 
#    -nonleaf
#
# with a required namespace and without
##################################################
Test case eval-variants
::nx::core::alias ::nx::Object objeval -objscope ::eval 
::nx::core::alias ::nx::Object softeval -nonleaf ::eval 
::nx::core::alias ::nx::Object softeval2 ::eval 

set G 1

Object create o {
  set xxx 1
  set :x 1
  ? {info exists G} 1
}
? {o exists x} 1
? {o exists xxx} 0

? {info exists ::xxx} 0
unset -nocomplain ::xxx

# eval does an objcope, all vars are instance variables; can access preexisting global vars
o objeval {
  set aaa 1
  set :a 1
  ? {info exists G} 1
}

? {o exists a} 1
? {o exists aaa} 1

? {info exists ::aaa} 0
unset -nocomplain ::aaa

# softeval (with -nonleaf) behaves like the initcmd and sets just
# instance variables via resolver.

o softeval {
  set bbb 1
  set :b 1
  ? {info exists G} 1
}
? {o exists b} 1
? {o exists bbb} 0

? {info vars ::bbb} ""
unset -nocomplain ::bbb

# softeval2 never sets instance variables
o softeval2 {
  set zzz 1
  set :z 1
  ? {info exists G} 1
}
? {o exists z} 0
? {o exists zzz} 0

? {info vars ::zzz} ::zzz
unset -nocomplain ::zzz

? {lsort [o info vars]} "a aaa b x"
o destroy

# now with an object namespace 
Object create o
o requireNamespace

# objeval does an objcope, all vars are instance variables
o objeval {
  set ccc 1
  set :c 1
}
? {o exists c} 1
? {o exists ccc} 1

# softeval behaves like the creation initcmd (just set dot vars)
o softeval {
  set ddd 1
  set :d 1
}
? {o exists d} 1
? {o exists ddd} 0

# softeval2 never sets variables
o softeval2 {
  set zzz 1
  set :z 1
}
? {o exists z} 0
? {o exists zzz} 0
? {lsort [o info vars]} "c ccc d"
o destroy

#################################################################
# The same as above, but with some global vars.  The global vars
# should not influence the behavior on instance variables
#################################################################
Test case with-global-vars
foreach var {.x x xxx :a a aaa :b b bbb :c c ccc :d d ddd :z z zzz} {set $var 1}

Object create o {
  set xxx 1
  set :x 1
}
? {o exists x} 1
? {o exists xxx} 0

# objeval does an objcope, all vars are instance variables
o objeval {
  set aaa 1
  set :a 1
}
? {o exists a} 1
? {o exists aaa} 1

# softeval should behave like the creation initcmd (just set dot vars)
o softeval {
  set bbb 1
  set :b 1
}
? {o exists b} 1
? {o exists bbb} 0

# softeval2 never sets instance variables
o softeval2 {
  set zzz 1
  set :z 1
}
? {o exists z} 0
? {o exists zzz} 0

? {lsort [o info vars]} "a aaa b x"
o destroy

# now with namespace 
Object create o
o requireNamespace

# eval does an objcope, all vars are instance variables
o objeval {
  set ccc 1
  set :c 1
}
? {o exists c} 1
? {o exists ccc} 1

# softeval2 should behave like the creation initcmd (just set dot vars)
o softeval {
  set ddd 1
  set :d 1
}
? {o exists d} 1
? {o exists ddd} 0

# softeval2 never sets variables
o softeval2 {
  set zzz 1
  set :z 1
}
? {o exists z} 0
? {o exists zzz} 0
? {lsort [o info vars]} "c ccc d"
o destroy

##################################################
# Test with proc scopes
##################################################
Test case proc-scopes
::nx::core::alias ::nx::Object objscoped-eval -objscope ::eval 
::nx::core::alias ::nx::Object nonleaf-eval -nonleaf ::eval 
::nx::core::alias ::nx::Object plain-eval ::eval 

proc foo-via-initcmd {} {
  foreach v {x xxx} {unset -nocomplain ::$v}
  set p 1
  Object create o {
    set xxx 1
    set :x 1
    set ::result G=[info exists G],p=[info exists p]
  }
  return [o exists x]-[o exists xxx]-[info exists x]-[info exists xxx]-[info exists ::x]-[info exists ::xxx]-$::result
}

proc foo {type} {
  foreach v {x xxx} {unset -nocomplain ::$v}
  set p 1
  Object create o 
  o $type {
    set xxx 1
    set :x 1
    set ::result G=[info exists G],p=[info exists p]
  }
  return [o exists x]-[o exists xxx]-[info exists x]-[info exists xxx]-[info exists ::x]-[info exists ::xxx]-$::result
}

proc foo-tcl {what} {
  foreach v {x xxx} {unset -nocomplain ::$v}
  set p 1
  set body {
    set xxx 1
    set :x 1
    set ::result G=[info exists G],p=[info exists p]
  }
  switch $what {
    eval {eval $body}
    ns-eval {namespace eval [namespace current] $body}
  }
  return [o exists x]-[o exists xxx]-[info exists x]-[info exists xxx]-[info exists ::x]-[info exists ::xxx]-$::result
}

set G 1


 ? {foo-via-initcmd}    1-0-0-0-0-0-G=0,p=0
 ? {foo nonleaf-eval}   1-0-0-0-0-0-G=0,p=0
 ? {foo objscoped-eval} 1-1-0-0-0-0-G=0,p=0
 ? {foo plain-eval}     0-0-0-1-0-0-G=0,p=1
 ? {foo-tcl eval}       0-0-0-1-0-0-G=0,p=1
 ? {foo-tcl ns-eval}    0-0-0-0-0-1-G=1,p=0

##################################################
# dotCmd tests
##################################################
Test case dotcmd
set C 0
proc bar {} {incr ::C}
Class create Foo {
  :method init {} {set :c 0}
  :method callDot1 {} {:bar}
  :method callDot2 {} {:bar}
  :method callDot3 {} {:bar; ::bar; :bar}
  :method bar {} {incr :c}
}

Foo create f1
f1 callDot1
? {set ::C} 0
? {f1 eval {set :c}} 1

# call via callback
after 1 {f1 callDot2}
after 10 {set ::X 1}
vwait X

? {set ::C} 0
? {f1 eval {set :c}} 2

# call via callback, call :bar via .. from method
after 1 {f1 callDot3}
after 10 {set ::X 2}
vwait X

? {set ::C} 1
? {f1 eval {set :c}} 4


##################################################
# test for namespace resolver
##################################################
Test case nsresolver
namespace eval module {
  Class create C
  Class create M1
  Class create M2

  C mixin M1
  ? {::nx::core::relation C class-mixin} "::module::M1"

  C mixin add M2
  ? {::nx::core::relation C class-mixin} "::module::M2 ::module::M1"
}


##################################################
# test setting of instance variables for 
# objects with namespaces in and outside
# of an eval (one case uses compiler)
##################################################

Test case alias-dot-resolver-interp
# outside of eval scope (interpreted)
Class create V {
  set :Z 1
  set ZZZ 1
  :method bar {z} { return $z }
  :object method bar {z} { return $z }
  :create v {
    set zzz 2
    set :z 2
  }
}
? {lsort [V info vars]} {Z}
? {lsort [v info vars]} {z}

# dot-resolver/ dot-dispatcher used in aliased proc

Test case alias-dot-resolver {

  Class create V {
    set :Z 1
    set ZZZ 1
    :method bar {z} { return $z }
    :object method bar {z} { return $z }
    :create v {
      set :z 2
      set zzz 2
    }
  }
  ? {lsort [V info vars]} {Z}
  ? {lsort [v info vars]} {z}
}