###############################################################################
#
# library3.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]

###############################################################################
# MONO: Due to a Mono bug, some tests are disabled on Mono.
###############################################################################

runTest {test library-3.1 {declare and call Tcl functions} -body {
  set tcls [tcl find -architecture --]

  if {[llength $tcls] > 0} then {
    set dll [lindex $tcls 0]

    set added [addToPath [file nativename [file dirname $dll]]]

    set m4 [library load [file tail $dll]]; # test load via PATH

    if {$added} then {removeFromPath [file nativename [file dirname $dll]]}

    set d1 [library declare -module $m4 -functionname \
        Tcl_CreateInterp -callingconvention cdecl -returntype IntPtr]

    set d2 [library declare -module $m4 -functionname \
        Tcl_Eval -callingconvention cdecl -charset ansi -returntype \
        ReturnCode -parametertypes [list IntPtr String]]

    set d3 [library declare -module $m4 -functionname \
        Tcl_GetStringResult -callingconvention cdecl -returntype IntPtr \
        -parametertypes [list IntPtr]]

    set d4 [library declare -module $m4 -functionname \
        Tcl_DeleteInterp -callingconvention cdecl -parametertypes [list IntPtr]]

    set d5 [library declare -module $m4 -functionname \
        Tcl_Finalize -callingconvention cdecl]

    set i1 [library call -create $d1]; # Tcl_CreateInterp

    set code [library call $d2 $i1 {array names env}]; # Tcl_Eval

    set result [object invoke -nocase System.Runtime.InteropServices.Marshal \
        PtrToStringAnsi [set zz [library call -create $d3 $i1]]]
    unset zz

    library call $d4 $i1; # Tcl_DeleteInterp
    unset i1

    library call $d5; # Tcl_Finalize

    list $code [expr {[llength $result] > 0}] [unset result] \
      [llength [info delegates]] [llength [info modules]] \
      [library undeclare $d5] [library undeclare $d4] [library undeclare $d3] \
      [library undeclare $d2] [library undeclare $d1] [library unload $m4] \
      [llength [info delegates]] [llength [info modules]] \
      [llength [info objects]]
  } else {
    list "Tcl is not available"
  }
} -cleanup {
  unset -nocomplain tcls added dll m4 d1 d2 d3 d4 d5 i1 code result zz
} -constraints \
{eagle native dynamic refCount tclLibrary command.library compile.NATIVE} \
-isolationLevel Maximum -result {Ok True {} 5 1 {} {} {} {} {} {} 0 0 1}}

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

runTest {test library-3.2 {Tcl exit handler interaction} -body {
  if {![tcl ready]} then {tcl load}; # pre-load if necessary.

  set tcls [tcl find -architecture --]

  if {[llength $tcls] > 0} then {
    set dll [tcl module]; # must use the same one we actually just loaded.

    set added [addToPath [file nativename [file dirname $dll]]]

    set m4 [library load [file tail $dll]]; # test load via PATH

    if {$added} then {removeFromPath [file nativename [file dirname $dll]]}

    set d1 [library declare -module $m4 -functionname \
        Tcl_CreateInterp -callingconvention cdecl -returntype IntPtr]

    set d2 [library declare -module $m4 -functionname \
        Tcl_Eval -callingconvention cdecl -charset ansi -returntype \
        ReturnCode -parametertypes [list IntPtr String]]

    set d3 [library declare -module $m4 -functionname \
        Tcl_GetStringResult -callingconvention cdecl -returntype IntPtr \
        -parametertypes [list IntPtr]]

    set d4 [library declare -module $m4 -functionname \
        Tcl_DeleteInterp -callingconvention cdecl -parametertypes [list IntPtr]]

    set d5 [library declare -module $m4 -functionname \
        Tcl_Finalize -callingconvention cdecl]

    set i1 [library call -create $d1]; # Tcl_CreateInterp

    set code [library call $d2 $i1 {array names env}]; # Tcl_Eval

    set result [object invoke -nocase System.Runtime.InteropServices.Marshal \
        PtrToStringAnsi [set zz [library call -create $d3 $i1]]]
    unset zz

    library call $d4 $i1; # Tcl_DeleteInterp
    unset i1

    #
    # HACK: Temporarily alter the Tcl API object unload flags for the active
    #       interpreter.  We need this in order to be sure that the library
    #       module handle is freed (i.e. since, for safety reasons, the exit
    #       handler must now assume it is always being called via Tcl_Exit
    #       and it cannot actually free the library module handle in that
    #       case).  We should not need to restore these flags after the test
    #       because the Tcl API object for the active interpreter should be
    #       destroyed as soon as Tcl_Finalize is called.
    #
    object invoke -flags +NonPublic Interpreter.GetActive.tclApi \
        unloadFlags {FromExitHandler FreeLibrary}

    library call $d5; # Tcl_Finalize

    list $code [expr {[llength $result] > 0}] [unset result] \
      [llength [info delegates]] [llength [info modules]] \
      [library undeclare $d5] [library undeclare $d4] [library undeclare $d3] \
      [library undeclare $d2] [library undeclare $d1] [library unload $m4] \
      [llength [info delegates]] [llength [info modules]] \
      [llength [info objects]] [catch {tcl unload} msg] $msg
  } else {
    list "Tcl is not available"
  }
} -cleanup {
  unset -nocomplain tcls added dll m4 d1 d2 d3 d4 d5 i1 code result zz msg
} -constraints \
{eagle native dynamic refCount tclLibrary monoBug20 command.library\
compile.NATIVE primaryThread} -isolationLevel Maximum -result \
{Ok True {} 5 1 {} {} {} {} {} {} 0 0 1 1 {invalid Tcl API object}}}

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

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