# testing var resolution for namespace-shadowed objects 

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


proc ? {cmd expected {msg ""}} {
  set count 1
  if {$msg ne ""} {
    set t [Test new -cmd $cmd -count $count -msg $msg]
  } else {
    set t [Test new -cmd $cmd -count $count]
  }
  $t expected $expected 
  $t run
}


###########################################
# Basic tests for var resolution under 
# per-object namespaces ...
###########################################
set ::globalVar 1
Object 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
###########################################

Object o -eval {
  my requireNamespace
  global z
  my instvar y
  set x 1
  set y 2
  set z 3
  set [self]::X 4
}
set ::o::Y 5

? {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 

o destroy
unset ::z

###########################################
# mix & match namespace and object interfaces
###########################################

Object 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} "" 1
? {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
###########################################

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

Object o -requireNamespace
Object 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 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
###############################################

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

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
###############################################
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 {} {puts ${.x};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 for the compiled var resolver with eval
###############################################
puts "array tests"
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
? {c1 info vars} "a z"


###############################################
# tests for the var resolver
###############################################
Class 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 C
C method bar {args} {
  #puts stderr "[self] bar called with [list $args]"
  return $args
}
C instforward 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
::xotcl::alias ::C Set -objscope ::set
::xotcl::alias ::C Unset -objscope ::unset

::C create ::c
namespace eval ::c {}
? {namespace exists ::c} 1
? {::xotcl::Object isobject ::c} 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