# -*- Tcl -*-
package req nx::test

proc traceStderr args {
  puts ">>> traceStderr HA! $args"
}

nx::Test case hidden-cmds {
  global i

  #
  # Create a slave interp for testing
  #
  set i [interp create]

  #
  # Some baseline
  #

  $i eval {
    proc foo {} {;}
  }
  $i hide foo

  ? {$i eval [list info commands ::nx::Object]} ""
  $i eval [list package req nx]
  ? {$i eval [list info commands ::nx::Object]} ::nx::Object
  #
  # Tcl's hiding mechansim only applies to objects/classes in the
  # top-level namespace. So any non-globally namespaced ones and
  # nested objects are not concerned ...
  #
  $i eval {nx::Object create ::o {
    :public method baz {} { return KO }
    :public method destroy {} {
      #
      # sets a global variable for tracing the processing of the
      # app-level destructor!
      #
      set ::[namespace tail [current object]] [current class] 
      next
    }
  }}
  $i eval {nx::Class create ::C {
    :public method destroy {} {
      #
      # sets a global variable for tracing the processing of the
      # app-level destructor!
      #
      set ::[namespace tail [current object]] [current class]
      next
    }

    :public method bar {} {
      return OK
    }
  }}
  $i eval {nx::Class create ::M {
    :public method foo {} {
      return [current object]-[:info class]-[current class]
    }
  }}
  ? {$i eval {info commands ::o}} ::o
  ? {$i eval {info commands ::C}} ::C
  ? {$i eval {info commands ::M}} ::M
  
  #
  # [interp hide] performs a partial and widely silent deletion
  # (Tcl_HideCommand(); note, while the idea resembles that of a
  # non-deleting rename, there is no C-level trace available!). The
  # object's Tcl_command cmdEpoch counter is increased. However,
  # hiding does not prune the command structure, nor does is the cmd's
  # client data touched. It is merely re-assigned to another,
  # interp-wide hash table. The object's command is no valid dispatch
  # target anymore ...
  #

  ? {interp hidden $i} "foo"
  $i hide o
  ? {interp hidden $i} "foo o"
  ? {$i eval ::o} "invalid command name \"::o\""
  ? {$i eval {info commands ::o}} ""

  ? {interp eval $i {::C create ::c}} ::c
  # set some relationships to test later ...
  ? {interp eval $i {::C mixin add ::M}} ::M
  ? {interp eval $i {::C class mixin add ::M}} ::M

  $i hide C
  ? {interp eval $i {::C create ::c2}} {invalid command name "::C"}

  #
  # However, the object structure is effectively preserved within the
  # object system and object relations are intact, e.g., the object is
  # still reported as an instance of a class.
  #

  ? {$i eval {nx::Object info instances ::o}} "::o"
  ? {interp invokehidden $i o ::nsf::methods::object::info::class} "::nx::Object"
  ? {interp invokehidden $i o info class} "::nx::Object"

  ? {interp eval $i {c info class}} ::C
  ? {interp invokehidden $i C info instances ::c} ::c
  ? {interp invokehidden $i C info mixin classes} ::M

  # Note, for all introspections that do *not* try to convert the
  # Tcl_Obj into an object or a class, but treat it as a pattern (or
  # the like) we are fine ...
  ? {$i eval {M info mixinof ::C}} "::C ::C"
  ? {$i eval {M info mixinof -scope class ::C}} "::C"
  ? {$i eval {M info mixinof -scope object ::C}} "::C"

  # dispatch to object-provided method (with the object being hidden)
  ? {interp eval $i {c bar}} OK
  
  # dispatch to class-provided methods (with the class being hidden)
  ? {interp eval $i {c bar}} OK

  # dispatch to mixed-in methods (which do basic introspection on the hidden object) ...
  ? {interp invokehidden $i C foo} ::C-::nx::Class-::M
  ? {interp eval $i {c foo}} ::c-::C-::M
  
  #
  # 1) Implicit destruction (through NSF's exit handler)
  #
  # An important characteristic of a hidden cmd is that it is cleaned
  # up later than ordinary, exposed (and namespaced) commands; see
  # DeleteInterpProc(). Hidden commands are processed during a interp
  # shutdown *after* the exit handler returned! 
  # 
  # For testing, we shutdown the NSF object systems in our slave
  # interp by using nsf::finalize; to do some smoke testing of the
  # cleanup results. As for the cleanup procedre, this is equivalent
  # to: interp delete $i


  $i eval {nsf::finalize -keepvars}

  # The destructor of e.g. object o sets a global variable with the
  # object name. The following test checks therfore, whether the
  # destructor was executed.
  #

  ? {$i eval { info exists ::o }} 1
  ? {$i eval {interp hidden}} foo
  ? {$i eval {info commands ::o}} ""
  ? {$i eval {info commands ::C}} ""
    
  #
  # Were the app-level destructors called effectively?
  #
  ? {$i eval { info exists ::o }} 1
  ? {$i eval { set ::o }} ""
  ? {$i eval { info exists ::c }} 1
  ? {$i eval { set ::c }} ::C

  interp delete $i
}

#
# Explicit destruction
#
nx::Test case hidden-cmds+explicit-delete {
  global i

  set i [interp create]
  $i eval {
    package req nx
    nx::Object create ::o2 {
      :public method destroy {} {
	next
	return ok
      }
    }}


  ? {$i eval {interp hidden}} ""
  ? {$i eval {info commands ::o2}} ::o2
  ? {$i eval {nx::Object info instances ::o2}} ::o2
  ? {$i eval {nsf::object::exists ::o2}} 1
  
  $i hide o2

  ? {$i eval {interp hidden}} o2
  ? {$i eval {info commands ::o2}} ""
  ? {$i eval {nx::Object info instances ::o2}} ::o2
  ? {$i eval {nsf::object::exists ::o2}} 0

  ? {interp invokehidden $i o2 destroy} "ok"

  ? {$i eval {interp hidden}} ""
  ? {$i eval {info commands ::o2}} ""
  ? {$i eval {nx::Object info instances ::o2}} ""
  ? {$i eval {nsf::object::exists ::o2}} 0
}


#
# hide and re-expose
#
nx::Test case hide-and-re-expose {
  global i

  set i [interp create]
  $i eval { 
    package req nx
    nx::Object create ::o {
      :public method destroy {} {
	incr ::[namespace tail [current]] 
	return OK
      }
      :public method foo {} {
	return [list [current object] [current class] [:info class] [[current] info class]]
      }
    }
    interp hide {} o
  }

  # Check hidden state
  ? {interp eval $i {interp hidden}} "o"
  ? {interp eval $i {info commands ::o}} ""
  ? {interp eval $i {nx::Object info instances ::o}} ::o
  ? {interp eval $i {nsf::object::exists ::o}} 0

  interp expose $i o

  # Check re-exposed state
  ? {interp eval $i {interp hidden}} ""
  ? {interp eval $i {info commands ::o}} "::o"
  ? {interp eval $i {nx::Object info instances ::o}} ::o
  ? {interp eval $i {nsf::object::exists ::o}} 1

  #
  # Is the object "alive"?
  #
  ? {$i eval {::o foo}} {::o {} ::nx::Object ::nx::Object}

  $i eval {nsf::finalize -keepvars}

  # Was the destructor called?
  ? {interp eval $i {info exists ::o}} 1
  ? {interp eval $i {set ::o}} 1
  
  # Check cleaned-up state
  ? {interp eval $i {interp hidden}} ""
  ? {interp eval $i {info commands ::o}} ""

  interp delete $i 
}

#
# hide/re-expose with "command renaming"
#
nx::Test case command-renaming {
  global i

  set i [interp create]
  $i eval { 
    package req nx
    nx::Object create ::o {
      :public method destroy {} {
	incr ::[namespace tail [current]] 
	return OK
      }
      :public method foo {} {
	catch {[current] info class} msg
	return [list [current object] [current class] [:info class] $msg]
      }
    }
    interp hide {} o O
  }

  # Check hidden state -> object command renamed

  ? {interp eval $i {interp hidden}} "O"
  ? {interp eval $i {info commands ::o}} ""
  ? {interp eval $i {nx::Object info instances ::o}} ::o
  ? {interp eval $i {nsf::object::exists ::o}} 0

  ? {interp invokehidden $i O foo} \
      {::o {} ::nx::Object {invalid command name "::o"}}

  interp expose $i O OO

  ? {interp eval $i {OO foo}} \
      {::o {} ::nx::Object {invalid command name "::o"}}

  ? {interp eval $i {interp hidden}} ""
  ? {interp eval $i {info commands ::o}} ""
  ? {interp eval $i {info commands ::OO}} ::OO
  ? {interp eval $i {nx::Object info instances ::o}} ::o
  ? {interp eval $i {nx::Object info instances ::OO}} ::o ;# should be ""?
  ? {interp eval $i {nsf::object::exists ::o}} 0
  ? {interp eval $i {nsf::object::exists ::OO}} 1

  $i eval {nsf::finalize -keepvars}
  
  # Was the destructor called?
  ? {interp eval $i {info exists ::o}} 1
  ? {interp eval $i {set ::o}} 1
    
  ? {interp eval $i {interp hidden}} {}
  ? {interp eval $i {info commands ::o}} {}

  interp delete $i 
}


#
# Rename namespaced object to global one and hide ...
#
nx::Test case namespaced-object {
  global i

  set i [interp create]
  $i eval { 
    package req nx
    namespace eval ::ns1 {
      nx::Object create o {
	:public method destroy {} {
	  incr ::[namespace tail [current]] 
	  return OK
	}
      }
    }
  }
  
  ? {$i hide ::ns1::o} \
      {cannot use namespace qualifiers in hidden command token (rename)}

  $i eval {::rename ::ns1::o ::X}

  ? {interp eval $i {interp hidden}} {}
  ? {interp eval $i {info commands ::X}} {::X}
  ? {interp eval $i {nx::Object info instances ::X}} {::X}
  ? {interp eval $i {nsf::object::exists ::X}} 1
  
  $i eval {interp hide {} X}

  ? {interp eval $i {interp hidden}} "X"
  ? {interp eval $i {info commands ::X}} {}
  ? {interp eval $i {nx::Object info instances ::X}} {::X}
  ? {interp eval $i {nsf::object::exists ::X}} 0

  $i eval {nsf::finalize -keepvars}

  ? {interp eval $i {info exists ::X}} 1
  ? {interp eval $i {set ::X}} 1

  interp delete $i
}

#
# Deletion order
#

nx::Test case deletion-order {
  global i

  set i [interp create]
  $i eval { 
    package req nx
    nx::Object create ::o {
      :public method destroy {} {
	incr ::[namespace tail [current]] 
	interp invokehidden {} C destroy
	next
      }
    }

    nx::Class create ::C {
      :public class method destroy {} {
	incr ::[namespace tail [current]] 
	next
      }
    }

  }
  $i hide o
  $i hide C
  $i eval {nsf::finalize -keepvars}

  ? {interp eval $i {info exists ::C}} 1
  ? {interp eval $i {set ::C}} 1
  ? {interp eval $i {info exists ::o}} 1
  ? {interp eval $i {set ::o}} 1
  
  interp delete $i
}

#
# Some stumbling blocks in destructors: [error] in app-level destroy
#
nx::Test case error-in-destroy-1 {
  global i

  set i [interp create]
  $i eval { 
    package req nx
    nx::Object create ::o {
      :public method destroy {} {
	error BAFF!
      }
    }
    interp hide {} o
  }
  
  ? {interp eval $i {::rename ::o ""}} \
      {can't delete "::o": command doesn't exist}

  ? {interp invokehidden $i o destroy} "BAFF!"

  ? {interp eval $i {interp hidden}} "o"
  ? {interp eval $i {info commands ::o}} ""
  ? {interp eval $i {nx::Object info instances ::o}} "::o"
  ? {interp eval $i {nsf::object::exists ::o}} 0

  $i eval {nsf::finalize}

  ? {interp eval $i {interp hidden}} ""
  ? {interp eval $i {info commands ::o}} ""

  interp delete $i
}

#
# Some stumbling blocks in destructors: [interp hide] in app-level
# destroy
#
nx::Test case error-in-destroy-2 {
  global i

  set i [interp create]
  $i eval { 
    package req nx
    proc ::bar {} {
      interp hide {} bar;
      return 1
    }
    
    nx::Object create ::o {
      :public method destroy {} {
	#
	# Would not be an issue in safe interps, as [interp hide] &
	# friends are disallowed ...
	#
	set res [catch {interp hide {} o} msg]
	#
	# TODO: a simple, uncaught 'interp hide {} o' leads to a lookup issue
	# and weird error handling; however, the cleanup is not
	# affected ...
	#

	next
	return OK
      }
    }
  }
  
  ? {interp eval $i {::bar}} 1
  ? {interp eval $i {::o destroy}} OK

  ? {interp eval $i {interp hidden}} "bar"
  ? {interp eval $i {info commands ::o}} ""
  ? {interp eval $i {nx::Object info instances ::o}} ""
  ? {interp eval $i {nsf::object::exists ::o}} 0

  interp delete $i
}

#
# Some stumbling blocks in destructors: [interp hide] in app-level destroy
#
nx::Test case error-in-destroy-3 {
  global i

  set i [interp create]
  $i eval { 
    package req nx
    nx::Object create ::o {
      :public method destroy {} {
	catch {::rename [current] ""} msg
	next
	return $msg
      }
    }
    interp hide {} o
  }

  ? {interp eval $i {::o destroy}} {invalid command name "::o"}

  ? {interp invokehidden $i o destroy} \
      {can't delete "::o": command doesn't exist}

  ? {interp eval $i {interp hidden}} ""
  ? {interp eval $i {info commands ::o}} ""
  ? {interp eval $i {nx::Object info instances ::o}} ""
  ? {interp eval $i {nsf::object::exists ::o}} 0

  interp delete $i 
}

#
# TODO: 
# - [current calledclass] seems broken -> returns NULL as string value?!
# - renames to "" in destroy run into an endless loop: 
# nx::Object create ::o {
#   :public method destroy {} {
#     ::rename [current] ""
#     next
#   }
#   :destroy
# }
# #