###############################################################################
#
# object-refcount.eagle --
#
# Extensible Adaptable Generalized Logic Engine (Eagle)
#
# Copyright (c) 2007-2012 by Joe Mistachkin.  All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: $
#
###############################################################################

source [file join [file normalize [file dirname [info script]]] prologue.eagle]

###############################################################################

runTest {test object-98.1 {reference counts} -setup {
  unset -nocomplain x y
} -body {
  list [set x [object create System.Object]] [llength [info objects]] \
      [unset x] [llength [info objects]] [set x [object create System.Object]] \
      [set y $x] [llength [info objects]] [unset x] [llength [info objects]] \
      [unset y] [llength [info objects]]
} -cleanup {
  unset -nocomplain x y
} -constraints {eagle refCount} -match regexp -result {^System#Object#\d+ 2\
\{\} 1 System#Object#\d+ System#Object#\d+ 2 \{\} 2 \{\} 1$}}

###############################################################################

runTest {test object-98.2 {reference counts, proc return} -setup {
  unset -nocomplain r s t u v w x z error

  proc foo1 {} {
    return [object create System.String foo1]
  }

  proc foo2 {} {
    return [object create -alias System.String foo2]
  }

  proc foo3 {} {
    set result [object create System.String foo3]; return $result
  }

  proc foo4 {} {
    set result [object create -alias System.String foo4]; return $result
  }

  proc foo5 {} {
    set result [object create System.String foo5]; return ""
  }

  if {0} then {
    foreach z [info objects] {
      if {[regexp -- {^System#String#\d+$} $z]} then {
        catch {object dispose $z}
      }
    }
    unset z
  }
} -body {
  foo1; set r [foo1]; # return without variable
  foo2; set s [foo2]; # return with alias without variable
  [$s ToString]; set t [[$s ToString]]; # return from alias without variable
  foo3; set u [foo3]; # return with variable
  foo4; set v [foo4]; # return with alias with variable
  [$v ToString]; set w [[$v ToString]]; # return from alias with variable
  foo5; set x [foo5]; # return nothing

  list [lsort [info objects]] [object refcount $r] [object refcount $s] \
      [object refcount $t] [object refcount $u] [object refcount $v] \
      [object refcount $w] [catch {object refcount $x} error] $error
} -cleanup {
  foreach z [info objects] {
    if {[regexp -- {^System#String#\d+$} $z]} then {
      catch {object dispose $z}
    }
  }
  unset z

  rename foo1 ""
  rename foo2 ""
  rename foo3 ""
  rename foo4 ""
  rename foo5 ""

  unset -nocomplain r s t u v w x error
} -constraints {eagle refCount} -match regexp -result \
{^\{System#String#\d+ System#String#\d+ System#String#\d+\
System#String#\d+ System#String#\d+ System#String#\d+\
System#String#\d+ System#String#\d+ System#String#\d+\
System#String#\d+ System#String#\d+ System#String#\d+ null\}\
2 2 2 2 2 2 1\
\{invalid object name ""\}$}}

###############################################################################

runTest {test object-98.3 {reference counts, env array element} -body {
  list [set x [object create Int32]] [object refcount $x] \
      [set env(object-98.3) $x] [object refcount $x] \
      [unset env(object-98.3)] [object refcount $x] \
      [unset x] [llength [info objects]]
} -cleanup {
  catch {unset -nocomplain env(object-98.3)}
  unset -nocomplain x
} -constraints {eagle refCount} -match regexp -result {^System#Int32#\d+ 1\
System#Int32#\d+ 2 \{\} 1 \{\} 1$}}

###############################################################################

runTest {test object-98.4 {reference counts, unset env array} -body {
  list [set env(object-98.4) [object create Int32]] \
      [object refcount $env(object-98.4)] [llength [info objects]] \
      [unset env] [llength [info objects]]
} -cleanup {
  catch {unset -nocomplain env(object-98.4)}; # NOTE: Redundant (?).

  #
  # NOTE: Since unsetting the entire env array does not actually call
  #       the SetEnvironmentVariable method on each of the variables
  #       (i.e. because it is a per-process resource and that would
  #       be somewhat destructive), we need to manually call the
  #       SetEnvironmentVariable method for the environment variable
  #       we added in this test to prevent future calls to set that
  #       environment variable from thinking that it already existed.
  #
  object invoke Environment SetEnvironmentVariable object-98.4 null
} -constraints {eagle refCount} -isolationLevel Interpreter -match regexp \
-result {^System#Int32#\d+ 1 2 \{\} 1$}}

###############################################################################

runTest {test object-98.5 {reference counts, element index} -body {
  list [set x([object create Int32]) foo] [object refcount [array names x]] \
      [llength [info objects]] [unset x] [llength [info objects]]
} -cleanup {
  unset -nocomplain x
} -constraints {eagle refCount} -result {foo 1 2 {} 1}}

###############################################################################

runTest {test object-98.6 {reference counts, array set/unset (value)} -body {
  #
  # NOTE: The reference count for $y will be mismanaged if the test fails
  #       because the [array set] does not add a reference to the contained
  #       object.  Subsequently, when [unset y] is executed, the object will
  #       be removed when it should not be (i.e. there should be a reference
  #       to it via $x(3)).
  #
  list [set y [object create Int32]] [array set x \
      [list 1 [object create Int32] 2 [object create Int32] 3 $y]] \
      [llength [info objects]] [unset x(1)] [llength [info objects]] \
      [unset y] [llength [info objects]] [array unset x] \
      [llength [info objects]]
} -cleanup {
  unset -nocomplain x y
} -constraints {eagle refCount} -match regexp -result \
{^System#Int32#\d+ \{\} 4 \{\} 3 \{\} 3 \{\} 1$}}

###############################################################################

runTest {test object-98.7 {reference counts, array set/unset (index)} -body {
  #
  # NOTE: The reference count for $y will be mismanaged if the test fails
  #       because the [array set] does not add a reference to the contained
  #       object.  Subsequently, when [unset y] is executed, the object will
  #       be removed when it should not be (i.e. there should be a reference
  #       to it via the third array element name).
  #
  list [set y [object create Int32]] [array set x \
      [list [object create Int32] 1 2 [object create Int32] $y 3]] \
      [llength [info objects]] [unset x(2)] [llength [info objects]] \
      [unset y] [llength [info objects]] [array unset x] \
      [llength [info objects]]
} -cleanup {
  unset -nocomplain x y
} -constraints {eagle refCount} -match regexp -result \
{^System#Int32#\d+ \{\} 4 \{\} 3 \{\} 3 \{\} 1$}}

###############################################################################

runTest {test object-98.8 {alias with -aliasreference option} -setup {
  unset -nocomplain x y
} -body {
  set x(1) [object create System.Int32]
  set x(2) [object create -alias System.Int32]
  set x(3) [object create -alias -aliasreference System.Int32]

  #
  # NOTE: We need to grab the string values for the opaque handles we just
  #       created without adding any references to them.
  #
  append x(4) " " $x(1)
  append x(5) " " $x(2)
  append x(6) " " $x(3)

  list [object refcount $x(1)] [object refcount $x(2)] [object refcount $x(3)] \
      [unset x(1)] [unset x(2)] [unset x(3)] \
      [catch {object refcount [string trim $x(4)]} y] $y \
      [catch {object refcount [string trim $x(5)]} y] $y \
      [catch {object refcount [string trim $x(6)]} y] $y \
      [catch {rename [string trim $x(4)] ""}] \
      [catch {rename [string trim $x(5)] ""}] \
      [catch {rename [string trim $x(6)] ""}] \
      [catch {object refcount [string trim $x(4)]} y] $y \
      [catch {object refcount [string trim $x(5)]} y] $y \
      [catch {object refcount [string trim $x(6)]} y] $y
} -cleanup {
  unset -nocomplain x y
} -constraints {eagle refCount} -match regexp -result {^1 1 2 \{\} \{\} \{\} 1\
\{invalid object name "System#Int32#\d+"\} 1 \{invalid object name\
"System#Int32#\d+"\} 0 1 1 1 0 1 \{invalid object name "System#Int32#\d+"\} 1\
\{invalid object name "System#Int32#\d+"\} 1 \{invalid object name\
"System#Int32#\d+"\}$}}

###############################################################################

source [file join [file normalize [file dirname [info script]]] epilogue.eagle]
