###############################################################################
#
# common.eagle --
#
# Written by Joe Mistachkin.
# Released to the public domain, use at your own risk!
#
###############################################################################
#
# NOTE: Use our own namespace here because even though we do not directly
# support namespaces ourselves, we do not want to pollute the global
# namespace if this script actually ends up being evaluated in Tcl.
#
namespace eval ::Eagle {
if {[isEagle]} then {
###########################################################################
############################ BEGIN Eagle ONLY #############################
###########################################################################
proc getSQLiteDefineConstantPrefix {} {
#
# NOTE: See if the define constant prefix setting has been overridden
# by the user (e.g. on the command line).
#
if {[info exists ::define_constant_prefix] && \
[string length $::define_constant_prefix] > 0} then {
#
# NOTE: Use the specified define constant prefix.
#
return $::define_constant_prefix
} else {
#
# NOTE: Use the default define constant prefix.
#
return defineConstant.System.Data.SQLite.
}
}
proc haveSQLiteDefineConstant { name } {
return [haveConstraint \
[appendArgs [getSQLiteDefineConstantPrefix] $name]]
}
proc getBuildYear {} {
#
# NOTE: See if the "year" setting has been overridden by the user (e.g.
# on the command line). This helps control exactly which set of
# binaries we are testing, those produced using the Visual Studio
# 2005, 2008, 2010, 2012, 2013, or 2015 build systems. To override
# this value via the command line, enter a command similar to one
# of the following (all on one line):
#
# EagleShell.exe -anyInitialize "set test_year 2005"
# -file .\path\to\all.eagle
#
# EagleShell.exe -anyInitialize "set test_year 2008"
# -file .\path\to\all.eagle
#
# EagleShell.exe -anyInitialize "set test_year 2010"
# -file .\path\to\all.eagle
#
# EagleShell.exe -anyInitialize "set test_year 2012"
# -file .\path\to\all.eagle
#
# EagleShell.exe -anyInitialize "set test_year 2013"
# -file .\path\to\all.eagle
#
# EagleShell.exe -anyInitialize "set test_year 2015"
# -file .\path\to\all.eagle
#
# EagleShell.exe -anyInitialize "unset -nocomplain test_year"
# -file .\path\to\all.eagle
#
if {[info exists ::test_year] && [string length $::test_year] > 0} then {
#
# NOTE: Use the specified test year. If this variable is not set, the
# default value will be based on whether or not Eagle has been
# compiled against the CLR v2.0 or CLR v4.0.
#
return $::test_year
} else {
#
# NOTE: If Eagle has been compiled against the CLR v4.0, use "2010" by
# default (we could use "2012", "2013", or "2015" in that case as
# well) as the test year; otherwise, use "2008" by default (we
# could use "2005" in that case as well). If another major
# [incompatible] version of the CLR is released, this check will
# have to be changed. The default test year to use for a
# particular CLR version may be overridden by setting the global
# variable "test_year_clr_v$X", where "$X" may [currently] be
# either "2" or "4".
#
if {[haveConstraint imageRuntime40]} then {
if {[info exists ::test_year_clr_v4] && \
[string length $::test_year_clr_v4] > 0} then {
#
# NOTE: Use the specified test year for the CLR v4.0.
#
return $::test_year_clr_v4
} else {
#
# NOTE: Use the default test year for the CLR v4.0.
#
return 2010; # TODO: Good "fallback" default?
}
} else {
if {[info exists ::test_year_clr_v2] && \
[string length $::test_year_clr_v2] > 0} then {
#
# NOTE: Use the specified test year for the CLR v2.0.
#
return $::test_year_clr_v2
} else {
#
# NOTE: Use the default test year for the CLR v2.0.
#
return 2008; # TODO: Good "fallback" default?
}
}
}
}
#
# NOTE: This procedure is only used when adding shimmed test constraints.
#
proc getBuildClrVersion {} {
if {[info exists ::test_clr] && [string length $::test_clr] > 0} then {
#
# NOTE: Use the specified test version for the CLR. If this variable
# is not set, the default value will be based on whether or not
# Eagle has been compiled against the CLR v2.0 or CLR v4.0.
#
return $::test_clr
} else {
#
# NOTE: Check if Eagle has been compiled against the CLR v4.0. If so,
# just use that CLR version. Otherwise, use the version for the
# CLR v2.0. If another major [incompatible] version of the CLR
# is released, this check will have to be changed. The default
# version value for a particular CLR version may be overridden
# by setting the global variable "test_clr_v$X", where "$X" may
# [currently] be either "2" or "4".
#
if {[haveConstraint imageRuntime40]} then {
if {[info exists ::test_clr_v4] && \
[string length $::test_clr_v4] > 0} then {
#
# NOTE: Use the specified test version for the CLR v4.0.
#
return $::test_clr_v4
} else {
#
# NOTE: Use the default test version for the CLR v4.0.
#
return 4.0.30319; # TODO: Good "fallback" default?
}
} else {
if {[info exists ::test_clr_v2] && \
[string length $::test_clr_v2] > 0} then {
#
# NOTE: Use the specified test version for the CLR v2.0.
#
return $::test_clr_v2
} else {
#
# NOTE: Use the default test version for the CLR v2.0.
#
return 2.0.50727; # TODO: Good "fallback" default?
}
}
}
}
proc getBuildYears {} {
#
# NOTE: See if the list of test years has been overridden by the user
# (e.g. on the command line).
#
if {[info exists ::test_years] && [llength $::test_years] > 0} then {
#
# NOTE: Use the specified list of test years.
#
return $::test_years
} else {
#
# NOTE: Use the default list of test years (i.e. all).
#
return [list 2005 2008 2010 2012 2013 2015]
}
}
proc getBuildNetFx {} {
#
# NOTE: See if the test .NET Framework setting has been overridden by
# the user (e.g. on the command line).
#
if {[info exists ::test_net_fx] && \
[string length $::test_net_fx] > 0} then {
#
# NOTE: Use the specified test .NET Framework.
#
return $::test_net_fx
} else {
set year [getBuildYear]
set yearVarName [appendArgs ::test_net_fx_ $year]
if {[info exists $yearVarName] && \
[string length [set $yearVarName]] > 0} then {
#
# NOTE: Use the specified test .NET Framework, based on the build
# year.
#
return [set $yearVarName]
} else {
#
# NOTE: Fallback to the "well known" .NET Framework version that
# is most closely associated with a particular version of
# Visual Studio.
#
switch -exact -- $year {
2005 {
return netFx20
}
2008 {
return netFx35
}
2010 {
return netFx40
}
2012 {
return netFx45
}
2013 {
return netFx451; # TODO: Or "netFx452"?
}
2015 {
return netFx46; # TODO: Or "netFx461"?
}
default {
return netFx35; # TODO: Good "fallback" default?
}
}
}
}
}
#
# NOTE: This procedure should return non-zero if the configured test
# platform is most likely the default for this machine.
#
proc isDefaultBuildPlatform { {verbose false} } {
#
# NOTE: Running on WoW64 is never the default platform.
#
if {[isRunningWoW64]} then {
if {$verbose} then {
tputs $::test_channel \
"---- detected non-default platform (WoW64)\n"
}
return false
}
#
# NOTE: This has a good chance of being the default platform.
#
if {$verbose} then {
tputs $::test_channel "---- detected default platform\n"
}
return true
}
proc getBuildPlatform { native } {
if {[info exists ::test_platform] && \
[string length $::test_platform] > 0} then {
#
# NOTE: Use the specified test platform. If this variable is not set,
# the default value will be based on the machine architecture.
#
return [expr {$native ? $::test_platform : ""}]
} elseif {[info exists ::test_machine] && \
[string length $::test_machine] > 0} then {
#
# NOTE: For native builds, return the platform name corresponding to
# the test machine architecture; otherwise, return an empty
# string.
#
return [expr {
$native ? [machineToPlatform $::test_machine] : ""
}]
} elseif {[info exists ::tcl_platform(machine)]} then {
#
# NOTE: For native builds, return the platform name corresponding to
# the machine architecture; otherwise, return an empty string.
#
return [expr {
$native ? [machineToPlatform $::tcl_platform(machine)] : ""
}]
} else {
#
# NOTE: No machine architecture is available, return an empty string.
# It is important to return an empty string here because the
# result of this procedure may be used with [file join].
#
return ""
}
}
proc getBuildConfiguration {} {
#
# NOTE: See if the "configuration" setting has been overridden by the
# user (e.g. on the command line). This helps control exactly
# which set of binaries we are testing (i.e. those built in the
# "Debug" or "Release" build configurations). To override this
# value via the command line, enter a command similar to one of
# the following (all on one line):
#
# EagleShell.exe -anyInitialize "set test_configuration Debug"
# -file .\path\to\all.eagle
#
# EagleShell.exe -anyInitialize "set test_configuration Release"
# -file .\path\to\all.eagle
#
# EagleShell.exe -file .\path\to\all.eagle -preTest
# "unset -nocomplain test_configuration"
#
if {[info exists ::test_configuration] && \
[string length $::test_configuration] > 0} then {
#
# NOTE: Use the specified test configuration. The default value used
# for this variable is typically "Release", as set by the test
# suite itself.
#
return $::test_configuration
} else {
#
# NOTE: Normally, we will never hit this case because the value of the
# test configuration variable is always set by the test suite
# itself; however, it can be overridden using the unset command
# from the -preTest option to the test suite.
#
return $::eagle_platform(configuration)
}
}
proc getBuildConfigurations {} {
#
# NOTE: See if the list of test configurations has been overridden by
# the user (e.g. on the command line).
#
if {[info exists ::test_configurations] && \
[llength $::test_configurations] > 0} then {
#
# NOTE: Use the specified list of test configurations.
#
return $::test_configurations
} else {
#
# NOTE: Use the default list of test configurations.
#
return [list Debug Release]
}
}
proc getBuildBaseDirectory {} {
#
# NOTE: Figure out the base directory where all the builds should be
# located. This will be the directory that contains the actual
# build output directory (e.g. parent of "bin").
#
if {[info exists ::build_base_directory] && \
[string length $::build_base_directory] > 0} then {
#
# NOTE: The location of the build base directory has been overridden;
# therefore, use it verbatim.
#
return $::build_base_directory
} elseif {[info exists ::common_directory] && \
[string length $::common_directory] > 0} then {
#
# NOTE: Next, fallback to the grandparent directory of the one
# containing this file (i.e. "common.eagle"), if available.
#
return [file dirname [file dirname $::common_directory]]
} elseif {[info exists ::path] && \
[string length $::path] > 0} then {
#
# NOTE: Finally, fallback to the parent directory of the EagleTest
# path. The EagleTest package guarantees that this variable
# will be set to the directory containing the first file to
# execute the [runTestPrologue] script library procedure.
#
return [file dirname $::path]
} else {
#
# NOTE: No path is available, return an empty string. This point
# should not be reached.
#
return ""
}
}
proc getSQLiteTestDataPath {} {
#
# NOTE: Figure out the directory where all the test data files should
# be located. This should be the "data" directory beneath the
# directory containing the actual test scripts.
#
return [file join $::path data]
}
proc isRunningWoW64 {} {
#
# NOTE: For now, just use the existing test constraint for detecting
# a WoW64 process.
#
return [haveConstraint wow64]
}
proc isMixedModeAssembly { fileName {varName ""} } {
#
# NOTE: First, make sure the test suite infrastructure is allowed to
# use the [exec] command.
#
if {![info exists ::no(exec)] && ![info exists ::no(corFlags)]} then {
#
# NOTE: If the location of CorFlags is present in the environment,
# use it; otherwise assume it is in the PATH.
#
set corFlags [expr {
[info exists ::env(CorFlags)] ? $::env(CorFlags) : "CorFlags"
}]
#
# NOTE: Attempt to execute CorFlags on the specified file.
#
if {[catch {
exec -- $corFlags [file nativename $fileName]
} exec] == 0} then {
#
# NOTE: If requested by our caller, attempt to determine the
# platform for the specified file as well.
#
if {[string length $varName] > 0} then {
#
# NOTE: Store the platform in the named variable in the
# context of our caller.
#
upvar 1 $varName platform
#
# NOTE: Attempt to extract the PE line from the captured
# output. If this value is "PE32" or "PE32+", the
# assembly file is 32-bit or 64-bit, respectively;
# otherwise, its type is unknown.
#
set pattern {^PE : (PE32|PE32\+)\s+$}
if {[regexp -line -- $pattern $exec dummy pe32]} then {
#
# HACK: This [switch] assumes that 32-bit executables are
# always x86 and that 64-bit executables are always
# x64.
#
switch -exact -- $pe32 {
PE32 {
set platform Win32
}
PE32+ {
set platform x64
}
default {
set platform ""
}
}
} else {
set platform ""
}
}
#
# NOTE: Attempt to extract the ILONLY line from the captured
# output. If this value is zero, the specified file must
# be a mixed-mode assembly; otherwise, it contains only
# managed components.
#
set pattern {^ILONLY : (0|1)\s+$}
if {![regexp -line -- $pattern $exec dummy ilOnly]} then {
return false
}
if {!$ilOnly} then {
return true
}
}
}
#
# NOTE: If the test suite cannot use [exec] or execution of CorFlags
# failed, return false.
#
return false
}
proc getNativeLibraryFileNamesOnly {} {
#
# NOTE: First, check if the list of native library file names has been
# manually overridden.
#
if {[info exists ::native_library_file_names] && \
[llength $::native_library_file_names] > 0} then {
#
# NOTE: The list of native library file names has been overridden;
# therefore, use it verbatim.
#
return $::native_library_file_names
} elseif {[isWindows]} then {
#
# NOTE: Otherwise, on Windows, always use the default file name
# "sqlite3.dll".
#
return [list sqlite3.dll]
} else {
#
# NOTE: Otherwise, return both the generic POSIX file name and the
# Mac OS X file name, since we do not currently have an easy
# way to detect which of those platforms we are running on.
#
return [list libsqlite3.dylib libsqlite3.so]
}
}
proc getInteropAssemblyFileNamesOnly {} {
#
# NOTE: First, check if the list of interop assembly file names has been
# manually overridden.
#
if {[info exists ::interop_assembly_file_names] && \
[llength $::interop_assembly_file_names] > 0} then {
#
# NOTE: The list of interop assembly file names has been overridden;
# therefore, use it verbatim.
#
return $::interop_assembly_file_names
} elseif {[isWindows]} then {
#
# NOTE: Otherwise, on Windows, always use the default file name
# "SQLite.Interop.dll".
#
return [list SQLite.Interop.dll]
} else {
#
# NOTE: Otherwise, return both the generic POSIX file name and the
# Mac OS X file name, since we do not currently have an easy
# way to detect which of those platforms we are running on.
#
return [list libSQLite.Interop.dylib libSQLite.Interop.so]
}
}
proc getCoreExtensionBinaryFileName { {default ""} } {
set fileName [getCoreBinaryFileName]
if {[file exists $fileName]} then {
return $fileName
}
return $default
}
proc isBuildAvailable { native directory {varName ""} } {
#
# NOTE: Build the fully qualified file name for the primary assembly
# containing the System.Data.SQLite managed components. It
# should be noted that this assembly file may also contain the
# native components, if a native build is in use.
#
set fileName [file nativename [file join $directory \
System.Data.SQLite.dll]]
if {![file exists $fileName]} then {
return false
}
#
# NOTE: Attempt to automatically detect if the primary assembly
# contains any native components, if necessary.
#
if {[string length $native] == 0} then {
if {[string length $varName] > 0} then {
upvar 1 $varName $varName
}
set native [isMixedModeAssembly $fileName $varName]
}
#
# NOTE: If the primary assembly also contains the native components,
# we have everything we need.
#
if {$native} then {
return true
}
#
# NOTE: What is the architecture for this machine?
#
set architecture [machineToPlatform $::tcl_platform(machine) true]
#
# NOTE: What is the platform for this machine?
#
set platform [machineToPlatform $::tcl_platform(machine)]
#
# NOTE: Build the fully qualified file name for the interop assembly
# containing the System.Data.SQLite native components. If this
# file exists, we should have everything we need.
#
foreach fileNameOnly [getInteropAssemblyFileNamesOnly] {
set fileName [file nativename [file join $directory \
$architecture $fileNameOnly]]
if {[file exists $fileName]} then {
return true
}
set fileName [file nativename [file join $directory \
$platform $fileNameOnly]]
if {[file exists $fileName]} then {
return true
}
set fileName [file nativename [file join $directory \
$fileNameOnly]]
if {[file exists $fileName]} then {
return true
}
}
#
# NOTE: Build the fully qualified file name for the SQLite core
# library. If this file exists, we should have everything we
# need.
#
foreach fileNameOnly [getNativeLibraryFileNamesOnly] {
set fileName [file nativename [file join $directory \
$architecture $fileNameOnly]]
if {[file exists $fileName]} then {
return true
}
set fileName [file nativename [file join $directory \
$platform $fileNameOnly]]
if {[file exists $fileName]} then {
return true
}
set fileName [file nativename [file join $directory \
$fileNameOnly]]
if {[file exists $fileName]} then {
return true
}
}
#
# NOTE: One or more native components needed by System.Data.SQLite
# are missing.
#
return false
}
proc isReleaseAvailable { directory {varName ""} } {
if {[string length $varName] > 0} then {
upvar 1 $varName $varName
}
return [isBuildAvailable "" $directory $varName]
}
proc joinBuildDirectory { native path year platform configuration } {
#
# NOTE: Figure out and then return the fully qualified path to the build
# directory based on all the arguments provided by our caller.
#
if {$native} then {
return [file join $path bin $year $platform $configuration]
} else {
return [file join $path bin $year $configuration bin]
}
}
proc getBuildDirectory {} {
#
# NOTE: See if the "native" runtime option has been set. If so, use the
# directory for the mixed-mode assembly (a.k.a. the native interop
# assembly). To enable this option via the command line, enter a
# command similar to one of the following (all on one line):
#
# EagleShell.exe -initialize -runtimeOption native
# -file .\path\to\all.eagle
#
# To enable this option via the command line prior to the "beta 16"
# release of Eagle, the following command must be used instead
# (also all on one line):
#
# EagleShell.exe -initialize -postInitialize
# "object invoke Interpreter.GetActive AddRuntimeOption native"
# -file .\path\to\all.eagle
#
if {[info exists ::build_directory] && \
[string length $::build_directory] > 0} then {
#
# NOTE: The location of the build directory has been overridden;
# therefore, use it verbatim.
#
return $::build_directory
} else {
#
# NOTE: If the "native" runtime option is set, the mixed-mode assembly
# is being tested. In that case, the path to the build directory
# will contain the platform name and all the binaries under test
# should be present in that directory. If the "native" runtime
# option is not set, the build directory will be considered to be
# "platform-neutral", with the notable exception of any native
# assembly (e.g. "SQLite.Interop.dll") copied there during the
# build process itself. If the build process somehow does not
# copy the native assembly for this platform, most of the tests
# in the suite will simply be skipped. Generally speaking, there
# are two ways to build the binaries when preparing to run the
# test suite:
#
# 1. Build the separate managed and native assemblies using some
# commands similar to:
#
# build.bat ${Configuration}ManagedOnly ${Platform}
# build.bat ${Configuration}NativeOnly ${Platform}
#
# Where ${Configuration} is either "Debug" or "Release" and
# ${Platform} is either "Win32" or "x64".
#
# 2. Build the mixed-mode assembly using a command similar to:
#
# build.bat ${Configuration} ${Platform}
#
# Where ${Configuration} is either "Debug" or "Release" and
# ${Platform} is either "Win32" or "x64". If this command is
# used, various tests that require supplementary managed
# assemblies (e.g. LINQ) may be skipped unless those binaries
# are subsequently copied into the correct directory (i.e. by
# "test_all.bat").
#
# Note that all of the build commands above will default to using
# the latest version of MSBuild available and the "test_year" may
# need to be adjusted accordingly to actually run the test suite.
# Refer to the comments in [getBuildYear] for more information on
# how to set this variable.
#
set native [hasRuntimeOption native]
return [joinBuildDirectory $native [getBuildBaseDirectory] \
[getBuildYear] [getBuildPlatform $native] [getBuildConfiguration]]
}
}
proc getReleaseVersion {} {
#
# NOTE: Figure out the release version for use with the build directory
# when checking for available releases.
#
if {[info exists ::release_version] && \
[string length $::release_version] > 0} then {
#
# NOTE: The release version has been overridden; therefore, use it
# verbatim.
#
return $::release_version
} else {
#
# NOTE: No release version is available, return an empty string.
# It is important to return an empty string here because the
# result of this procedure may be used with [file join].
#
return ""
}
}
proc getBuildFileName { fileName {platform ""} } {
#
# NOTE: Returns the specified file name as if it were located in the
# build directory, discarding any directory information present
# in the file name as provided by our caller.
#
set result [file nativename \
[file join [getBuildDirectory] $platform [file tail $fileName]]]
#
# HACK: When running on WoW64, assume the test executables are present
# with the "32" suffix on them.
#
if {[isRunningWoW64] && [file extension $result] eq ".exe"} then {
set result [appendArgs [file rootname $result] 32.exe]
}
return $result
}
proc getExternalDirectory {} {
#
# NOTE: This procedure returns the directory where the external binary
# files are located.
#
return [file nativename [file dirname [file dirname [info binary]]]]
}
proc getBinaryDirectory {} {
#
# NOTE: This procedure returns the directory where the test application
# itself (i.e. the Eagle shell) is located. This will be used as
# the destination for the copied System.Data.SQLite native and
# managed assemblies (i.e. because this is one of the few places
# where the CLR will actually find and load them properly).
#
if {[info exists ::binary_directory] && \
[string length $::binary_directory] > 0} then {
#
# NOTE: The location of the binary directory has been overridden;
# therefore, use it verbatim.
#
return $::binary_directory
} else {
return [info binary]
}
}
proc getExternalFileName { fileName } {
#
# NOTE: Returns the specified file name as if it were located in the
# directory containing the external binaries.
#
return [file nativename [file join [getExternalDirectory] $fileName]]
}
proc getBinaryFileName { fileName {platform ""} } {
#
# NOTE: Returns the specified file name as if it were located in the
# binary directory, discarding any directory information present
# in the file name as provided by our caller.
#
return [file nativename \
[file join [getBinaryDirectory] $platform [file tail $fileName]]]
}
proc getCoreBinaryFileName { {platform ""} {standard ""} } {
#
# NOTE: Returns the full path for the file containing the SQLite core
# native library code for this platform. First, check and see if
# the SQLite core native library has already been loaded. Next,
# fallback to what the full path should be, based on whether the
# mixed-mode assembly is being used and the name of the current
# platform.
#
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.UnsafeNativeMethods _SQLiteNativeModuleFileName
} fileName] == 0 && [string length $fileName] > 0} then {
#
# NOTE: The SQLite core native library has already been loaded via
# the native library pre-loader. Return that file name now.
#
return $fileName
}
#
# NOTE: If the "native" runtime option has been set, always return the
# file name for the mixed-mode assembly.
#
if {[hasRuntimeOption native]} then {
#
# NOTE: Return the mixed-mode assembly file name.
#
return [file nativename \
[file join [getBinaryDirectory] $platform System.Data.SQLite.dll]]
}
#
# NOTE: Are we attempting to automatically detect whether or not the
# interop assembly should be used?
#
set automatic [expr {[string length $standard] == 0}]
#
# NOTE: First, in either "automatic" or "non-standard" modes, attempt
# to find the native-only interop assembly.
#
if {$automatic || !$standard} then {
#
# NOTE: Attempt to determine the native-only interop assembly file
# name for this platform and then return it.
#
foreach fileNameOnly [getInteropAssemblyFileNamesOnly] {
set fileName [file nativename \
[file join [getBinaryDirectory] $platform $fileNameOnly]]
if {[file exists $fileName]} then {
return $fileName
}
}
}
#
# NOTE: Then, in either "automatic" or "standard" modes, attempt to
# find the standard SQLite library.
#
if {$automatic || $standard} then {
#
# NOTE: Attempt to determine the native-only standard SQLite library
# file name for this platform and then return it.
#
foreach fileNameOnly [getNativeLibraryFileNamesOnly] {
set fileName [file nativename \
[file join [getBinaryDirectory] $platform $fileNameOnly]]
if {[file exists $fileName]} then {
return $fileName
}
}
}
#
# NOTE: Was the managed assembly compiled expecting to deal with the
# standard core library?
#
if {[haveSQLiteDefineConstant SQLITE_STANDARD]} then {
#
# NOTE: Fallback to returning the native-only standard SQLite library
# file name for the platform.
#
set fileNamesOnly [getNativeLibraryFileNamesOnly]
if {[llength $fileNamesOnly] == 0} then {
return ""
}
return [file nativename [file join \
[getBinaryDirectory] $platform [lindex $fileNamesOnly 0]]]
} else {
#
# NOTE: Fallback to returning the native-only interop assembly file
# name for the platform.
#
set fileNamesOnly [getInteropAssemblyFileNamesOnly]
if {[llength $fileNamesOnly] == 0} then {
return ""
}
return [file nativename [file join \
[getBinaryDirectory] $platform [lindex $fileNamesOnly 0]]]
}
}
proc getCommonDirectory {} {
#
# NOTE: This procedure returns the directory where the test scripts
# should be located. By default, this just returns the Eagle
# binary directory.
#
if {[info exists ::common_directory] && \
[string length $::common_directory] > 0} then {
#
# NOTE: The location of the common directory has been set;
# therefore, use it.
#
return $::common_directory
} elseif {[info exists ::vendor_directory] && \
[string length $::vendor_directory] > 0} then {
#
# NOTE: The location of the vendor directory has been set;
# therefore, use it.
#
return $::vendor_directory
} elseif {[info exists ::tcl_library] && \
[string length $::tcl_library] > 0 && \
[file isdirectory $::tcl_library]} then {
#
# NOTE: The variable with the location of the script library is
# set and appears to be a real directory (i.e. not embedded
# within a file); therefore, use it.
#
return $::tcl_library
} else {
#
# NOTE: Fallback to the directory containing the executable.
#
return [info binary]
}
}
proc getDatabaseDirectory {} {
#
# NOTE: This procedure returns the directory where the test databases
# should be located. By default, this just uses the temporary
# directory configured for this system.
#
if {[info exists ::database_directory] && \
[string length $::database_directory] > 0} then {
#
# NOTE: The location of the database directory has been overridden;
# therefore, use it.
#
return $::database_directory
} elseif {[info exists ::scratch_directory] && \
[string length $::scratch_directory] > 0} then {
#
# NOTE: The location of the scratch directory has been overridden;
# therefore, use it.
#
return $::scratch_directory
} else {
return [getTemporaryPath]
}
}
proc getTemporaryDirectory {} {
#
# NOTE: This procedure returns the directory where the temporary files
# should be located. By default, this just uses the temporary
# directory configured for this system.
#
if {[info exists ::temporary_directory] && \
[string length $::temporary_directory] > 0} then {
#
# NOTE: The location of the temporary directory has been overridden;
# therefore, use it.
#
return $::temporary_directory
} elseif {[info exists ::scratch_directory] && \
[string length $::scratch_directory] > 0} then {
#
# NOTE: The location of the scratch directory has been overridden;
# therefore, use it.
#
return $::scratch_directory
} else {
return [getTemporaryPath]
}
}
proc getExecuteOnSetup {} {
if {[info exists ::execute_on_setup] && \
[string length $::execute_on_setup] > 0} then {
#
# NOTE: Return the configured SQL to execute during the connection
# setup procedure (i.e. for every test database connection).
#
return $::execute_on_setup
} else {
#
# NOTE: By default, there is no SQL to execute during the connection
# setup procedure (i.e. for every test database connection).
#
return ""
}
}
proc getTestOverridesPreamble { {extraVarNames ""} } {
set varNames [list]
#
# NOTE: If available, start with the master list of test override
# variables.
#
if {[info exists ::test_overrides] && \
[llength $::test_overrides] > 0} then {
eval lappend varNames $::test_overrides
}
#
# NOTE: If requested by our caller, add any additional variable
# names to copy now.
#
if {[llength $extraVarNames] > 0} then {
eval lappend varNames $extraVarNames
}
#
# NOTE: Build the script fragment to be returned by processing each
# variable name and adding the nececessary script fragments for
# each one.
#
set result ""
foreach varName $varNames {
#
# NOTE: Build the qualified global variable name.
#
set fullVarName [appendArgs :: $varName]
#
# NOTE: Does the variable exist in this interpreter context?
#
if {[info exists $fullVarName]} then {
#
# NOTE: Append a script fragment to the result that will correctly
# copy any contained value to another interpreter context.
#
append result \n "set " $fullVarName " \{" [set $fullVarName] \}
}
}
#
# NOTE: If the result contains one or more script fragments, append a
# newline.
#
if {[string length $result] > 0} then {
append result \n
}
return $result
}
proc moveSystemDataSQLiteDllConfig { {restore false} {verbose false} } {
set directory [object invoke AppDomain CurrentDomain.BaseDirectory]
if {[string length $directory] == 0} then {
if {$verbose} then {
tputs $::test_channel [appendArgs \
"---- skipped moving \"System.Data.SQLite.dll.config\", " \
"no base directory\n"]
}
return
}
set fileName(1) [file normalize \
[file join $directory System.Data.SQLite.dll.config]]
set fileName(2) [appendArgs $fileName(1) .moved]
if {$restore} then {
if {[file exists $fileName(2)]} then {
file rename $fileName(2) $fileName(1)
if {$verbose} then {
tputs $::test_channel [appendArgs \
"---- moved \"" $fileName(2) "\" to \"" \
$fileName(1) \"\n]
}
} else {
if {$verbose} then {
tputs $::test_channel [appendArgs \
"---- skipped moving \"" $fileName(2) \
"\", it does not exist\n"]
}
}
} else {
if {[file exists $fileName(1)]} then {
file rename $fileName(1) $fileName(2)
if {$verbose} then {
tputs $::test_channel [appendArgs \
"---- moved \"" $fileName(1) "\" to \"" \
$fileName(2) \"\n]
}
} else {
if {$verbose} then {
tputs $::test_channel [appendArgs \
"---- skipped moving \"" $fileName(1) \
"\", it does not exist\n"]
}
}
}
}
proc getAppDomainPreamble { {prefix ""} {suffix ""} } {
#
# NOTE: This procedure returns a test setup script fragment suitable for
# evaluation by an interpreter created in an isolated application
# domain. The script fragment being returned will be surrounded by
# the prefix and suffix "script fragments" specified by our caller,
# if any. The entire script being returned will be substituted via
# [subst], in the context of our caller, before being returned.
# This step is necessary so that some limited context information,
# primarily related to the testing directories, can be transferred
# to the interpreter in the isolated application domain, making it
# able to successfully run tests that require one or more of the
# files in one of the testing directories. Callers should keep in
# mind that the test script fragment being returned cannot rely on
# any script library procedures that are not provided by the Eagle
# library package (i.e. "init.eagle"), including those provided by
# the Eagle test package, unless the file containing them is loaded
# manually via some other mechanism (e.g. by including appropriate
# [package require] or [source] commands in the prefix or suffix
# script fragments). Also, all variable references and all nested
# commands (i.e. those in square brackets) contained in the final
# script fragment will end up being evaluated in the context of the
# calling interpreter and not the target interpreter created in the
# isolated application domain unless the dollar signs and/or square
# brackets are specially quoted with backslashes.
#
return [uplevel 1 [list subst [appendArgs $prefix {
#
# NOTE: The \[object\] command may be missing in some Eagle core
# library configurations. Cloning and using the procedure
# \[changeNativeRuntimeOption\] may help to mitigate this.
#
proc changeNativeRuntimeOption \
{[info args changeNativeRuntimeOption]} \
{[info body changeNativeRuntimeOption]}
catch {
changeNativeRuntimeOption [hasRuntimeOption native]
}
} [getTestOverridesPreamble [list path test_channel]] $suffix]]]
}
proc tryCopyExternalFile {
fileName {platform ""} {newFileName ""} {verbose false} } {
set sourceFileName [getExternalFileName $fileName]
if {![file exists $sourceFileName]} then {
if {$verbose} then {
tputs $::test_channel [appendArgs \
"---- skipped copying external file \"" $sourceFileName \
"\", it does not exist\n"]
}
return
}
if {[string length $newFileName] > 0} then {
set targetFileName [getBinaryFileName $newFileName $platform]
} else {
set targetFileName [getBinaryFileName $fileName $platform]
}
set targetDirectory [file dirname $targetFileName]
if {[catch {
if {![file exists $targetDirectory]} then {
file mkdir $targetDirectory
}
file copy -force $sourceFileName $targetFileName
}] == 0} then {
tputs $::test_channel [appendArgs \
"---- copied external file from \"" $sourceFileName "\" to \"" \
$targetFileName \"\n]
} else {
tputs $::test_channel [appendArgs \
"---- failed to copy external file from \"" $sourceFileName \
"\" to \"" $targetFileName \"\n]
}
}
proc tryCopyBinaryFile {
fileName {platform ""} {newFileName ""} {verbose false} } {
set sourceFileName [getBinaryFileName $fileName $platform]
if {![file exists $sourceFileName]} then {
if {$verbose} then {
tputs $::test_channel [appendArgs \
"---- skipped copying binary file \"" $sourceFileName \
"\", it does not exist\n"]
}
return
}
if {[string length $newFileName] > 0} then {
set targetFileName [getBuildFileName $newFileName $platform]
} else {
set targetFileName [getBuildFileName $fileName $platform]
}
set targetDirectory [file dirname $targetFileName]
if {[catch {
if {![file exists $targetDirectory]} then {
file mkdir $targetDirectory
}
file copy -force $sourceFileName $targetFileName
}] == 0} then {
tputs $::test_channel [appendArgs \
"---- copied binary file from \"" $sourceFileName "\" to \"" \
$targetFileName \"\n]
} else {
tputs $::test_channel [appendArgs \
"---- failed to copy binary file from \"" $sourceFileName \
"\" to \"" $targetFileName \"\n]
}
}
proc tryCopyBuildFile {
fileName {platform ""} {newFileName ""} {verbose false} } {
set sourceFileName [getBuildFileName $fileName $platform]
if {![file exists $sourceFileName]} then {
if {$verbose} then {
tputs $::test_channel [appendArgs \
"---- skipped copying build file \"" $sourceFileName \
"\", it does not exist\n"]
}
return
}
if {[string length $newFileName] > 0} then {
set targetFileName [getBinaryFileName $newFileName $platform]
} else {
set targetFileName [getBinaryFileName $fileName $platform]
}
set targetDirectory [file dirname $targetFileName]
if {[catch {
if {![file exists $targetDirectory]} then {
file mkdir $targetDirectory
}
file copy -force $sourceFileName $targetFileName
}] == 0} then {
tputs $::test_channel [appendArgs \
"---- copied build file from \"" $sourceFileName "\" to \"" \
$targetFileName \"\n]
} else {
tputs $::test_channel [appendArgs \
"---- failed to copy build file from \"" $sourceFileName \
"\" to \"" $targetFileName \"\n]
}
}
proc tryDeleteBinaryFile { fileName {platform ""} {verbose false} } {
set fileName [getBinaryFileName $fileName $platform]
if {![file exists $fileName]} then {
if {$verbose} then {
tputs $::test_channel [appendArgs \
"---- skipped deleting binary file \"" $fileName \
"\", it does not exist\n"]
}
return
}
if {[catch {file delete $fileName}] == 0} then {
tputs $::test_channel [appendArgs \
"---- deleted binary file \"" $fileName \"\n]
} else {
tputs $::test_channel [appendArgs \
"---- failed to delete binary file \"" $fileName \"\n]
}
}
proc tryDeleteBuildFile { fileName {platform ""} {verbose false} } {
set fileName [getBuildFileName $fileName $platform]
if {![file exists $fileName]} then {
if {$verbose} then {
tputs $::test_channel [appendArgs \
"---- skipped deleting build file \"" $fileName \
"\", it does not exist\n"]
}
return
}
if {[catch {file delete $fileName}] == 0} then {
tputs $::test_channel [appendArgs \
"---- deleted build file \"" $fileName \"\n]
} else {
tputs $::test_channel [appendArgs \
"---- failed to delete build file \"" $fileName \"\n]
}
}
proc tryCopyAssembly {
fileName {platform ""} {pdb true} {verbose false} } {
tryCopyBuildFile $fileName $platform "" $verbose
if {$pdb} then {
tryCopyBuildFile [appendArgs \
[file rootname $fileName] .pdb] $platform "" $verbose
}
}
proc tryDeleteAssembly {
fileName {platform ""} {pdb true} {verbose false} } {
tryDeleteBinaryFile $fileName $platform $verbose
if {$pdb} then {
tryDeleteBinaryFile [appendArgs \
[file rootname $fileName] .pdb] $platform $verbose
}
}
proc tryLoadAssembly { fileName {platform ""} } {
set fileName [getBinaryFileName $fileName $platform]
if {[catch {
set assembly [object load -loadtype File -alias $fileName]
}] == 0} then {
#
# NOTE: Now, add the necessary test constraint.
#
addConstraint [file rootname [file tail $fileName]]
#
# NOTE: Grab the image runtime version from the assembly because
# several tests rely on it having a certain value.
#
addConstraint [appendArgs [file tail $fileName] _ \
[$assembly ImageRuntimeVersion]]
#
# NOTE: Return the full path of the loaded file.
#
return $fileName
}
return ""
}
proc isSQLiteReady {} {
#
# NOTE: This procedure must return non-zero only if the SQLite native
# library and the System.Data.SQLite managed assembly are loaded
# and ready for use by the test suite. Currently, this procedure
# should be called only after the [tryLoadAssembly] procedure has
# been called to probe for the System.Data.SQLite managed assembly
# and the [checkForSQLite] procedure has been called to probe for
# the SQLite native library; otherwise, this procedure will simply
# always return zero.
#
return [expr {
[haveConstraint System.Data.SQLite] && [haveConstraint SQLite]
}]
}
proc matchPlatform { platform } {
#
# NOTE: An empty string for the platform means that the build is not
# [primarily] a native build; therefore, it always matches.
#
if {[string length $platform] == 0} then {
return true
}
#
# NOTE: Does the specified platform match up to the current process?
#
if {$platform eq [machineToPlatform $::tcl_platform(machine)]} then {
return true
}
#
# NOTE: The specified platform does not match up with the platform
# for the current process.
#
return false
}
proc haveSQLiteObjectCommand {} {
#
# NOTE: Is the [object] command currently available?
#
return [expr {[llength [info commands object]] > 0}]
}
proc checkForSQLiteObjectCommand { channel } {
tputs $channel "---- checking for \"object\" command usage... "
if {![info exists ::no(sqliteObjectCommand)] && \
[haveSQLiteObjectCommand]} then {
tputs $channel yes\n
} else {
#
# NOTE: Unless we are forbidden from doing so, add some constraints
# that will allow most of the test suite to run (i.e. those
# tests that do not directly rely upon the [object] command).
#
if {![info exists ::no(shimSQLiteAssemblyConstraints)]} then {
addConstraint SQLite
addConstraint SQLiteInterop
addConstraint System.Data.SQLite
addConstraint System.Data.SQLite.Encryption
addConstraint System.Data.SQLite.Linq
addConstraint [appendArgs \
System.Data.SQLite.dll_v [getBuildClrVersion]]
}
if {![info exists ::no(shimSQLiteDefineConstantConstraints)]} then {
foreach defineConstant [list \
INTEROP_EXTENSION_FUNCTIONS INTEROP_FTS5_EXTENSION \
INTEROP_JSON1_EXTENSION INTEROP_PERCENTILE_EXTENSION \
INTEROP_REGEXP_EXTENSION INTEROP_TEST_EXTENSION \
INTEROP_TOTYPE_EXTENSION INTEROP_VIRTUAL_TABLE \
USE_INTEROP_DLL] {
addConstraint [appendArgs \
[getSQLiteDefineConstantPrefix] $defineConstant]
}
}
if {![info exists ::no(shimSQLiteVisualStudioConstraints)]} then {
addConstraint [appendArgs visualStudio [getBuildYear]]
}
tputs $channel no\n
}
}
proc changeNativeRuntimeOption { native } {
if {[llength [info commands debug]] > 0 && \
[llength [info subcommands debug runtimeoption]] > 0 && [catch {
debug runtimeoption [expr {$native ? "add" : "remove"}] native
}] == 0} then {
return true
}
if {[haveSQLiteObjectCommand] && [catch {
object invoke Interpreter.GetActive [expr {$native ? \
"AddRuntimeOption" : "RemoveRuntimeOption"}] native
}] == 0} then {
return true
}
return false
}
proc checkForSQLiteBuilds { channel {select false} } {
#
# NOTE: Check for every possible valid combination of values used when
# locating out the build output directory, showing each available
# build variation along the way.
#
foreach native [list false true] {
foreach year [getBuildYears] {
foreach configuration [getBuildConfigurations] {
#
# NOTE: Figure out the effective build platform. This is
# based on whether or not a [primarily] native build
# is being used. For [primarily] non-native builds,
# this will be an empty string.
#
set platform [getBuildPlatform $native]
tputs $channel [appendArgs \
"---- checking for System.Data.SQLite build \"" [expr \
{$native ? "native/" : ""}] [expr {[string length \
$platform] > 0 ? [appendArgs $platform /] : ""}] $year \
/ $configuration "\"... "]
#
# NOTE: Build the fully qualified directory where the necessary
# components for System.Data.SQLite should be found.
#
set directory [joinBuildDirectory $native \
[getBuildBaseDirectory] $year $platform $configuration]
#
# NOTE: Do the necessary files exist? Currently, no other steps
# are taken to verify this build is actually viable.
#
if {[isBuildAvailable $native $directory]} then {
#
# NOTE: When in "select" mode, automatically select the first
# available build of System.Data.SQLite and then return
# immediately.
#
if {$select && [matchPlatform $platform]} then {
#
# NOTE: Manually override all the build directory selection
# related test settings in order to force this build
# of System.Data.SQLite to be used.
#
if {![changeNativeRuntimeOption $native]} then {
tputs $channel [appendArgs \
"no, failed to " [expr {$native ? "add" : "remove"}] \
" the \"native\" runtime option\n"]
return false
}
set ::test_year $year
set ::test_platform $platform
set ::test_configuration $configuration
tputs $channel [appendArgs \
"yes, selected (" [expr {$native ? "native/" : ""}] \
[expr {[string length $platform] > 0 ? [appendArgs \
$platform /] : ""}] $year / $configuration ")\n"]
return true
} else {
tputs $channel yes\n
}
} else {
tputs $channel no\n
}
}
}
}
return false
}
proc checkForSQLiteReleases { channel {select false} } {
#
# NOTE: Check for past releases of System.Data.SQLite in the directory
# contained in the "System.Data.SQLite" environment variable, if
# present.
#
if {[info exists ::env(System.Data.SQLite)] && \
[string length $::env(System.Data.SQLite)] > 0} then {
#
# NOTE: Build the fully qualified directory where the necessary
# components for System.Data.SQLite should be found.
#
set directory [file nativename [file join \
$::env(System.Data.SQLite) [getReleaseVersion]]]
tputs $channel [appendArgs \
"---- checking for System.Data.SQLite release \"" \
$directory "\"... "]
if {[isReleaseAvailable $directory platform]} then {
if {[string length $platform] == 0} then {
set platform unknown
}
if {$select && [matchPlatform $platform]} then {
set ::build_directory $directory
tputs $channel [appendArgs "yes, selected (" $platform ")\n"]
return true
} else {
tputs $channel [appendArgs "yes (" $platform ")\n"]
}
} else {
tputs $channel no\n
foreach path [lsort -decreasing [file list $directory *]] {
if {[file exists $path] && [file isdirectory $path]} then {
tputs $channel [appendArgs \
"---- checking for System.Data.SQLite release \"" \
$path "\"... "]
if {[isReleaseAvailable $path platform]} then {
if {[string length $platform] == 0} then {
set platform unknown
}
if {$select && [matchPlatform $platform]} then {
set ::build_directory $path
tputs $channel [appendArgs "yes, selected (" $platform ")\n"]
return true
} else {
tputs $channel [appendArgs "yes (" $platform ")\n"]
}
} else {
tputs $channel no\n
}
}
}
}
} else {
tputs $channel [appendArgs \
"---- environment variable \"System.Data.SQLite\" is not " \
"set, skipping check for releases...\n"]
}
return false
}
proc checkForSQLiteLibrary { channel } {
tputs $channel "---- checking for SQLite core library... "
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.SQLite3 SQLiteVersion
} version] == 0} then {
#
# NOTE: Check if the returned version was null. If so, make it easy
# to spot.
#
if {[string length $version] == 0} then {
set version null
}
#
# NOTE: Attempt to query the Fossil source identifier for the SQLite
# core library.
#
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.SQLite3 SQLiteSourceId
} sourceId]} then {
#
# NOTE: We failed to query the Fossil source identifier.
#
set sourceId unknown
}
#
# NOTE: Check if the returned Fossil source identifier was null. If
# so, make it easy to spot.
#
if {[string length $sourceId] == 0} then {
set sourceId null
}
#
# NOTE: Yes, the SQLite core library appears to be available.
#
addConstraint SQLite
tputs $channel [appendArgs "yes (" $version " " $sourceId ")\n"]
} else {
tputs $channel no\n
}
}
proc checkForSQLiteInterop { channel } {
tputs $channel "---- checking for SQLite interop assembly... "
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.SQLite3 InteropVersion
} version] == 0} then {
#
# NOTE: Check if the returned version was null. If so, make it easy
# to spot.
#
if {[string length $version] == 0} then {
set version null
}
#
# NOTE: Attempt to query the Fossil source identifier for the SQLite
# core library.
#
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.SQLite3 InteropSourceId
} sourceId]} then {
#
# NOTE: We failed to query the Fossil source identifier.
#
set sourceId unknown
}
#
# NOTE: Check if the returned Fossil source identifier was null. If
# so, make it easy to spot.
#
if {[string length $sourceId] == 0} then {
set sourceId null
}
#
# NOTE: Before actually adding the test constraint, make sure the
# version is valid (i.e. not just that we could query it).
#
if {$version ne "null"} then {
#
# NOTE: Yes, the SQLite interop assembly appears to be available.
#
addConstraint SQLiteInterop
set answer yes
} else {
set answer no
}
tputs $channel [appendArgs $answer " (" $version " " $sourceId ")\n"]
} else {
tputs $channel no\n
}
}
proc checkForSQLiteDefineConstant { channel name } {
tputs $channel [appendArgs \
"---- checking for System.Data.SQLite define constant \"" $name \
"\"... "]
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.SQLite3 DefineConstants
} defineConstants] == 0} then {
if {[lsearch -exact -nocase $defineConstants $name] != -1} then {
#
# NOTE: Yes, this define constant was enabled when the managed
# assembly was compiled.
#
addConstraint [appendArgs [getSQLiteDefineConstantPrefix] $name]
tputs $channel yes\n
} else {
tputs $channel no\n
}
} else {
tputs $channel error\n
}
}
proc getDateTimeFormat {} {
#
# NOTE: This procedure simply returns the "default" DateTime format used
# by the test suite.
#
if {[info exists ::datetime_format] && \
[string length $::datetime_format] > 0} then {
#
# NOTE: Return the manually overridden value for the DateTime format.
#
return $::datetime_format
} else {
#
# NOTE: Return an ISO8601 DateTime format compatible with SQLite,
# System.Data.SQLite, and suitable for round-tripping with the
# DateTime class of the framework. If this value is changed,
# various tests may fail.
#
return "yyyy-MM-dd HH:mm:ss.FFFFFFFK"
}
}
proc getProperties { object varName } {
upvar 1 $varName properties
set count 0
set names [list]
if {[isObjectHandle $object] && $object ne "null"} then {
eval lappend names [object members \
-membertypes Property -nameonly $object]
eval lappend names [object members \
-membertypes Field -nameonly $object]
}
foreach name $names {
if {[catch {
object invoke -objectflags +NoDispose $object $name
} value] == 0} then {
if {[isObjectHandle $value] && $value ne "null"} then {
set error null; object invoke -flags +NonPublic \
-marshalflags +NoHandle Interpreter.GetActive \
AddObjectReference Ok $value error
lappend properties(objects) [list $name $value]
} else {
lappend properties(values) [list $name $value]
}
incr count
} else {
lappend properties(errors) [list $name $::errorCode]
}
}
return $count
}
proc getAllProperties { object varName } {
upvar 1 $varName properties
set value $object
while {true} {
if {![info exists properties(seenObjects)] || \
$value ni $properties(seenObjects)} then {
getProperties $value properties
lappend properties(seenObjects) $value
}
if {![info exists properties(objects)]} then {
break
}
if {[llength $properties(objects)] == 0} then {
unset properties(objects); break
}
set value [lindex [lindex $properties(objects) 0] end]
set properties(objects) [lrange $properties(objects) 1 end]
}
if {[info exists properties(seenObjects)]} then {
foreach value $properties(seenObjects) {
if {$value eq $object} continue
catch {object dispose $value}
}
unset properties(seenObjects)
}
}
proc getVariables { varNames {objects false} } {
set result [list]
foreach varName $varNames {
if {[uplevel 1 [list array exists $varName]]} then {
set arrayName $varName
foreach elementName [uplevel 1 [list array names $arrayName]] {
set name [appendArgs $arrayName ( $elementName )]
set varValue [uplevel 1 [list set $name]]
if {$objects && [isObjectHandle $varValue]} then {
unset -nocomplain properties
getAllProperties $varValue properties
lappend result [list $name [array get properties]]
} else {
lappend result [list $name $varValue]
}
}
} else {
set varValue [uplevel 1 [list set $varName]]
if {$objects && [isObjectHandle $varValue]} then {
unset -nocomplain properties
getAllProperties $varValue properties
lappend result [list $varName [array get properties]]
} else {
lappend result [list $varName $varValue]
}
}
}
return $result
}
proc enumerableToList { enumerable } {
set result [list]
if {[string length $enumerable] == 0 || $enumerable eq "null"} then {
return $result
}
object foreach -alias item $enumerable {
if {[string length $item] > 0} then {
lappend result [$item ToString]
}
}
return $result
}
proc catchAndReturn { script {stackTrace false} {strict true} } {
#
# NOTE: Evaluate the script provided by our caller in their context,
# capturing both the result and the return code.
#
set code [catch {uplevel 1 $script} result]
#
# NOTE: Did the script provided by our caller NOT raise an error?
#
if {$strict && $code == 0 || !$strict && $code != 1} then {
#
# NOTE: Success. Return a list with the return code and the result.
#
return [list $code $result]
} elseif {$stackTrace} then {
#
# NOTE: Failure. Our caller wants a full stack trace (if applicable),
# return a list with the return code and the result verbatim.
#
return [list $code $result]
} else {
#
# NOTE: Failure. Our caller does not want a full stack trace (if
# applicable), return a list with the return code, the error
# code for the interpreter, and the error message up to the
# point where the stack trace should start.
#
return [list $code $::errorCode \
[extractSystemDataSQLiteExceptionMessage $result]]
}
}
proc compileCSharpWith {
text memory symbols strict resultsVarName errorsVarName fileNames
args } {
#
# NOTE: Since we are going to use this method name a lot, assign it to a
# variable first.
#
set add ReferencedAssemblies.Add
#
# NOTE: Create the base command to evaluate and add the property settings
# that are almost always needed by our unit tests (i.e. the System
# and System.Data assembly references).
#
set command [list \
compileCSharp $text $memory $symbols $strict results errors \
$add System.dll $add System.Data.dll $add System.Transactions.dll \
$add System.Xml.dll]
#
# NOTE: Add all the provided file names as assembly references.
#
foreach fileName $fileNames {
lappend command $add [getBinaryFileName $fileName]
}
#
# NOTE: Add the extra arguments, if any, to the command to evaluate.
#
eval lappend command $args
#
# NOTE: Alias the compiler local results and errors variables to the
# variable names provided by our caller.
#
if {[string length $resultsVarName] > 0} then {
upvar 1 $resultsVarName results
}
if {[string length $errorsVarName] > 0} then {
upvar 1 $errorsVarName errors
}
#
# NOTE: Evaluate the constructed [compileCSharp] command and return the
# result.
#
eval $command
}
proc isMemoryDb { fileName } {
#
# NOTE: Is the specified database file name really an in-memory database?
#
return [expr {$fileName eq ":memory:" || \
[string range $fileName 0 12] eq "file::memory:"}]
}
proc isTableInDb { name {varName db} } {
#
# NOTE: Refer to the specified variable (e.g. "db") in the context of our
# caller. It contains the database connection handle that will be
# used to execute the query used to determine if the named table is
# present in that database.
#
upvar 1 $varName db
#
# NOTE: Use the sqlite_master table to determine if the named table is
# present in the database.
#
set sql {
SELECT COUNT(*) FROM sqlite_master WHERE type = 'table' AND name = ?;
}
#
# NOTE: Return non-zero if the named table is present.
#
return [expr {
[sql execute -execute scalar $db $sql [list param1 String $name]] > 0
}]
}
proc getDbDefaultPageSize {} {
try {
set db [sql open -type SQLite {Data Source=:memory:;}]
return [sql execute -execute scalar $db "PRAGMA page_size;"]
} finally {
if {[info exists db]} then {
catch {sql close $db}
unset -nocomplain db
}
}
}
proc getDbDefaultCacheSize {} {
try {
set db [sql open -type SQLite {Data Source=:memory:;}]
return [sql execute -execute scalar $db "PRAGMA cache_size;"]
} finally {
if {[info exists db]} then {
catch {sql close $db}
unset -nocomplain db
}
}
}
proc useLegacyDbPageAndCacheSizes { varName } {
#
# NOTE: Refer to the specified variable (e.g. "db") in the context of our
# caller. It contains the database connection handle that will be
# used to execute queries used to set the page and cache sizes.
#
upvar 1 $varName db
sql execute $db {
PRAGMA page_size = 1024;
PRAGMA cache_size = 2000;
}
return [list \
[sql execute -execute scalar $db "PRAGMA page_size;"] \
[sql execute -execute scalar $db "PRAGMA cache_size;"]]
}
proc extractSystemDataSQLiteExceptionMessage { value } {
#
# NOTE: If the string conforms to format of the normal exception
# error strings, extract and return only the error message
# portion itself.
#
set patterns [list \
{System\.Data\.SQLite\.SQLiteException \(0x80004005\): (.+?) (?: )?at} \
{System\.Data\.SQLite\.SQLiteException: (.+?) (?: )?at} \
{Eagle\._Components\.Public\.ScriptException: (.+?) (?: )?at}]
foreach pattern $patterns {
if {[regexp -- $pattern $value dummy message]} then {
set message [string map [list \r\n \n] [string trim $message]]
set lines [split $message \n]
if {[llength $lines] == 2} then {
if {[lindex $lines 0] eq [lindex $lines 1]} then {
return [lindex $lines 0]
}
return [appendArgs [lindex $lines 0] " -- " [lindex $lines 1]]
}
return $message
}
}
return $value
}
proc trimSql { sql } {
return [regsub -all -- {\s+} [string trim $sql] " "]
}
proc executeSql { sql {execute none} {format none} {fileName ""} } {
if {[string length $fileName] == 0} then {set fileName :memory:}
setupDb $fileName "" "" "" "" "" false false false false db true
try {
return [uplevel 1 [list \
sql execute -execute $execute -format $format $db $sql]]
} finally {
cleanupDb $fileName db false false false
}
}
proc hasNoFlags { varName none } {
upvar 1 $varName flags
if {![info exists flags]} then {
return true
}
if {[string length $flags] == 0} then {
return true
}
if {$none && $flags eq "None"} then {
return true
}
return false
}
proc getConnectionFlags { fileName flags {quiet false} } {
#
# NOTE: Figure out which database file name or connection string these
# connection flags will actually apply to. This is not necessary
# in quiet mode because this information is only used for logging
# and reporting purposes.
#
if {!$quiet} then {
if {[string length $fileName] > 0} then {
set database [appendArgs "file name \"" $fileName \"]
} elseif {[info exists ::dataSource] && \
![array exists ::dataSource]} then {
set database [appendArgs "data source \"" $::dataSource \"]
} else {
set database <unknown>
}
}
#
# NOTE: Even though there is only one source of flags so far, they
# must be combined using the correct syntax for enumerated
# flag values for the .NET Framework.
#
set flags [combineFlags $flags ""]
#
# NOTE: Show (and log) the local connection flags and the associated
# data source or file name.
#
if {!$quiet} then {
if {![info exists ::no(emitLocalFlags)] && \
(![info exists ::no(emitLocalFlagsIfNone)] || \
![hasNoFlags flags false])} then {
tputs $::test_channel [appendArgs \
"---- local connection flags for " $database \
" are: " [expr {![hasNoFlags flags false] ? \
[appendArgs \" $flags \"] : "<none>"}] \n]
}
}
#
# NOTE: Show (and log) the shared connection flags.
#
if {!$quiet} then {
if {[catch {
object invoke System.Data.SQLite.SQLiteConnection SharedFlags
} sharedFlags] == 0} then {
if {![info exists ::no(emitSharedFlags)] && \
(![info exists ::no(emitSharedFlagsIfNone)] || \
![hasNoFlags sharedFlags true])} then {
tputs $::test_channel [appendArgs \
"---- shared connection flags for " $database \
" are: " [expr {![hasNoFlags sharedFlags true] ? \
[appendArgs \" $sharedFlags \"] : "<none>"}] \n]
}
} else {
if {![info exists ::no(emitSharedFlags)] && \
![info exists ::no(emitSharedFlagsIfUnavailable)]} then {
tputs $::test_channel [appendArgs \
"---- shared connection flags for " $database \
" are: <unavailable>\n"]
}
}
}
#
# NOTE: Show (and log) the detected global connection flags, if any.
#
if {!$quiet} then {
if {![info exists ::no(emitGlobalFlags)] && \
(![info exists ::no(emitGlobalFlagsIfNone)] || \
![hasNoFlags ::connection_flags false])} then {
tputs $::test_channel [appendArgs \
"---- global connection flags are: " \
[expr {![hasNoFlags ::connection_flags false] ? \
[appendArgs \" $::connection_flags \"] : "<none>"}] \n]
}
}
#
# NOTE: If there are any global (per test run) connection flags currently
# set, use them now (i.e. by combining them with the ones for this
# connection).
#
if {[info exists ::connection_flags]} then {
#
# NOTE: Combine and/or replace the connection flags and then show the
# new value.
#
set flags [combineFlags $flags $::connection_flags]
#
# NOTE: Show (and log) the new effective connection flags.
#
if {!$quiet} then {
if {![info exists ::no(emitCombinedFlags)] && \
(![info exists ::no(emitCombinedFlagsIfNone)] || \
![hasNoFlags flags false])} then {
tputs $::test_channel [appendArgs \
"---- combined connection flags for " $database \
" are: " [expr {![hasNoFlags flags false] ? \
[appendArgs \" $flags \"] : "<none>"}] \n]
}
}
}
return $flags
}
proc getFlagsProperty { {flags ""} {quiet false} } {
#
# NOTE: Determine what the combined (global and local) connection
# flags should be, possibly quietly.
#
set flags [getConnectionFlags "" $flags $quiet]
#
# NOTE: If no global or local connection flags were specified, the
# default connection flags should be used; therefore, return
# an empty string in that case.
#
if {[string length $flags] == 0} then {
return ""
}
#
# NOTE: In order to check if the default connection flags are being used
# it is necessary to attempt a conversion to the actual enumerated
# type. Failing that, the check against the default value will be
# skipped.
#
if {[catch {
set error null; # IGNORED
object invoke Utility TryParseFlagsEnum "" \
System.Data.SQLite.SQLiteConnectionFlags "" $flags null true \
true error
} value]} then {
#
# NOTE: Attempting to parse the connection flags caused a script
# error. Emit a warning to the test log file and continue
# using an emtpy string instead.
#
tlog [appendArgs \
"==== WARNING: failed to parse connection flags, error: " \
\n\t $value \n]
set value ""
}
#
# NOTE: If the combined flags string could not actually be converted
# to the enumerated type it is the default value, then just use
# it verbatim; otherwise, just return an empty string. In that
# case, the default connection flags will be used.
#
if {[string length $value] == 0 || $value ne "Default"} then {
#
# WARNING: This returns the string value of the combined flags, not
# the enumerated value. This is by design and should not
# be changed without careful consideration (e.g. it would
# prevent the SQLiteConnection class from allowing invalid
# ["magical"] meta-flags).
#
return [appendArgs "Flags=" $flags \;]
}
return ""
}
proc enableSharedCache { channel enable {quiet false} } {
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.UnsafeNativeMethods \
sqlite3_enable_shared_cache [expr int($enable)]
} result] == 0} then {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- call sqlite3_enable_shared_cache(" $enable \
")... ok: " $result \n]
}
} else {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- call sqlite3_enable_shared_cache(" $enable \
")... error: " \n\t $result \n]
}
}
}
proc setupDb {
fileName {mode ""} {dateTimeFormat ""} {dateTimeKind ""} {flags ""}
{extra ""} {qualify true} {delete true} {uri false}
{temporary true} {varName db} {quiet false} } {
#
# NOTE: First, see if our caller has requested an in-memory database.
#
set isMemory [isMemoryDb $fileName]
#
# NOTE: For now, all test databases used by the test suite are placed
# into the database directory. Each database and related files
# used by a test should be cleaned up by that test using the
# "cleanupDb" procedure, below.
#
if {!$isMemory && $qualify} then {
set fileName [file join [getDatabaseDirectory] [file tail $fileName]]
}
#
# NOTE: By default, delete any pre-existing database with the same file
# name if it currently exists.
#
if {!$isMemory && $delete && [file exists $fileName]} then {
#
# NOTE: Attempt to delete any pre-existing database with the same file
# name.
#
if {[catch {file delete $fileName} error]} then {
#
# NOTE: We somehow failed to delete the file, report why.
#
if {!$quiet} then {
tputs $::test_channel [appendArgs \
"==== WARNING: failed to delete database file \"" $fileName \
"\" during setup, error: " \n\t $error \n]
}
}
}
#
# NOTE: Refer to the specified variable (e.g. "db") in the context of our
# caller. The handle to the opened database will be stored there.
#
upvar 1 $varName db
#
# NOTE: Start building the connection string. The only required portion
# of the connection string is the data source, which contains the
# database file name itself. If our caller wants to use a URI as
# the data source, use the FullUri connection string property to
# prevent the data source string from being mangled.
#
if {$uri} then {
set connection {FullUri=${fileName}}
} else {
set connection {Data Source=${fileName}}
}
#
# NOTE: Since this procedure has no special knowledge of what the default
# setting is for the ToFullPath connection string propery, always
# add the value we know about to the connection string.
#
append connection {;ToFullPath=${qualify}}
#
# NOTE: If our caller specified a journal mode, add the necessary portion
# of the connection string now.
#
if {[string length $mode] > 0} then {
append connection {;Journal Mode=${mode}}
}
#
# NOTE: If our caller specified a DateTime format, add the necessary
# portion of the connection string now.
#
if {[string length $dateTimeFormat] > 0} then {
append connection {;DateTimeFormat=${dateTimeFormat}}
}
#
# NOTE: If our caller specified a DateTimeKind, add the necessary portion
# of the connection string now.
#
if {[string length $dateTimeKind] > 0} then {
append connection {;DateTimeKind=${dateTimeKind}}
}
#
# NOTE: Figure out what the final flags for this connection need to be.
#
set flags [getConnectionFlags $fileName $flags $quiet]
#
# NOTE: If our caller specified some SQLiteConnectionFlags, add the
# necessary portion of the connection string now.
#
if {[string length $flags] > 0} then {
append connection {;Flags=${flags}}
}
#
# NOTE: If our caller specified an extra payload to the connection
# string, append it now.
#
if {[string length $extra] > 0} then {
append connection \; $extra
}
#
# NOTE: Open the database connection now, placing the opaque handle value
# into the variable specified by our caller.
#
set db [sql open -type SQLite [subst $connection]]
#
# NOTE: Configure the temporary directory for the newly opened database
# connection now unless our caller forbids it.
#
if {$temporary && ![info exists ::no(setTemporaryDirectory)]} then {
sql execute $db [appendArgs \
"PRAGMA temp_store_directory = \"" [getTemporaryDirectory] \"\;]
}
#
# NOTE: Perform any extra per-connection setup for the newly opened
# database now unless our caller forbids it.
#
set executeOnSetup [getExecuteOnSetup]
if {[string length $executeOnSetup] > 0 && \
![info exists ::no(executeOnSetup)]} then {
#
# NOTE: This command may raise an error; if so, that is fine, as
# the enclosing test will then fail. The [subst] command is
# used on the SQL in case it needs to refer to state in our
# context.
#
sql execute $db [subst $executeOnSetup]
}
#
# NOTE: Always return the connection handle upon success.
#
return $db
}
proc getDbConnection { {varName db} } {
#
# NOTE: Refer to the specified variable (e.g. "db") in the context of our
# caller. The handle to the database previously opened via the
# [setupDb] procedure should be stored there.
#
upvar 1 $varName db
#
# NOTE: This returns the ADO.NET IDbConnection object instance for the
# specified databse handle. Since getting this object relies upon
# Eagle internals, great care should be taken to avoid disposing of
# this object or otherwise putting it into an invalid state.
#
if {[info exists db]} then {
if {[catch {
object invoke -flags +NonPublic -objectflags +NoDispose -alias \
Interpreter.GetActive.connections Item $db
} result] == 0} then {
#
# NOTE: Success, return the opaque object handle.
#
return $result
} else {
#
# NOTE: Failure, report why.
#
tputs $::test_channel [appendArgs \
"==== WARNING: failed to get connection handle for database \"" \
$db "\", error: " \n\t $result \n]
}
}
#
# NOTE: Failure, return an obviously invalid opaque object handle.
#
return ""
}
proc freeDbConnection { {varName connection} } {
#
# NOTE: Refer to the specified variable (e.g. "connection") in the
# context of our caller. The opaque object handle for an ADO.NET
# connection previously returned by [getDbConnection] should be
# stored there.
#
upvar 1 $varName connection
#
# NOTE: Attempt to remove the opaque object handle from the interpreter
# now. This [object dispose] call will not actually dispose of the
# underlying object because the +NoDispose flag was set on it
# during creation of the opaque object handle.
#
if {[info exists connection] && \
[catch {object dispose $connection} error]} then {
#
# NOTE: We somehow failed to remove the handle, report why.
#
tputs $::test_channel [appendArgs \
"==== WARNING: failed to remove connection handle \"" $connection \
"\", error: " \n\t $error \n]
}
}
proc addDbConnection { connection {varName db} } {
#
# NOTE: Refer to the specified variable (e.g. "db") in the context of our
# caller.
#
upvar 1 $varName db
#
# NOTE: Create a correctly formatted name for the database connection to
# be added to the list managed by the Eagle interpreter.
#
set db [object invoke -flags +NonPublic \
Eagle._Components.Private.FormatOps DatabaseObjectName $connection \
SQLiteConnection [object invoke Interpreter.GetActive NextId]]
#
# NOTE: Add the database connection provided by our caller to the list
# of those known to the Eagle interpreter.
#
object invoke -flags +NonPublic Interpreter.GetActive.connections Add \
$db $connection
}
proc getRowsFromDataTable { dataTable } {
set rows [list]
set count [$dataTable Columns.Count]
for {set index 0} {$index < $count} {incr index} {
set dataColumn [$dataTable -alias Columns.get_Item $index]
set names($index) [$dataColumn ColumnName]
}
object foreach -alias dataRow [set dataRows [$dataTable Rows]] {
set row [list]
for {set index 0} {$index < $count} {incr index} {
set value [$dataRow -create -alias get_Item $index]
if {[string length $value] > 0 && \
![object invoke Convert IsDBNull $value]} then {
lappend row [list $names($index) [$value ToString]]
} else {
lappend row [list $names($index)]
}
}
lappend rows $row
}
return $rows
}
proc dumpRowsFromDataTable { channel rows } {
set sequence 1
foreach row $rows {
tputs $channel [appendArgs \
[expr {$sequence > 1 ? "\n" : ""}] "---- ROW #" $sequence :\n]
foreach pair $row {
if {[llength $pair] >= 2} then {
tputs $channel [appendArgs \t \
[list [lindex $pair 0]] ": " [list [lindex $pair 1]] \n]
} elseif {[llength $pair] == 1} then {
tputs $channel [appendArgs \t \
[list [lindex $pair 0]] ": <null>\n"]
} else {
tputs $channel \t<empty>\n; # NOTE: No data?
}
}
incr sequence
}
}
proc cleanupDb { fileName {varName db} {collect true} {qualify true}
{delete true} } {
#
# NOTE: Attempt to force all pending "garbage" objects to be collected,
# including SQLite statements and backup objects; this should allow
# the underlying database file to be deleted.
#
if {$collect} then {
collectGarbage $::test_channel
}
#
# NOTE: Refer to the specified variable (e.g. "db") in the context of our
# caller. The handle to the database previously opened via the
# [setupDb] procedure should be stored there.
#
upvar 1 $varName db
#
# NOTE: Close the connection to the database now. This should allow us
# to delete the underlying database file.
#
if {[info exists db] && [catch {sql close $db} error]} then {
#
# NOTE: We somehow failed to close the database, report why.
#
tputs $::test_channel [appendArgs \
"==== WARNING: failed to close database \"" $db "\", error: " \
\n\t $error \n]
}
#
# NOTE: First, see if our caller has requested an in-memory database.
#
set isMemory [isMemoryDb $fileName]
#
# NOTE: Build the full path to the database file name. For now, all test
# database files are stored in the temporary directory.
#
if {!$isMemory && $qualify} then {
set fileName [file join [getDatabaseDirectory] [file tail $fileName]]
}
#
# NOTE: Check if the file still exists.
#
if {!$isMemory && $delete && [file exists $fileName]} then {
#
# NOTE: Skip deleting database files if somebody sets the global
# variable to prevent it.
#
if {![info exists ::no(cleanupDbFile)]} then {
#
# NOTE: Attempt to delete the test database file now.
#
if {[set code [catch {file delete $fileName} error]]} then {
#
# NOTE: We somehow failed to delete the file, report why.
#
tputs $::test_channel [appendArgs \
"==== WARNING: failed to delete database file \"" $fileName \
"\" during cleanup, error: " \n\t $error \n]
}
} else {
#
# NOTE: Show that we skipped deleting the file.
#
set code 0
tputs $::test_channel [appendArgs \
"==== WARNING: skipped deleting database file \"" $fileName \
"\" during cleanup\n"]
}
} else {
#
# NOTE: The file does not exist, success!
#
set code 0
}
return $code
}
proc saveEnvironmentVariables { names {varName ""} } {
#
# NOTE: For each name, does the live environment variable exist? If
# so, save the value for later; otherwise, make sure the saved
# value does not exist either. The live environment variables
# ARE NOT changed by this procedure.
#
if {[string length $varName] == 0} then {
set varName savedEnv
}
upvar 1 $varName savedEnv
foreach name $names {
if {[info exists ::env($name)]} then {
set savedEnv($name) $::env($name)
} else {
unset -nocomplain savedEnv($name)
}
}
#
# NOTE: This is self-cleaning. If no saved environment variables now
# exist, remove the array.
#
if {[array size savedEnv] == 0} then {
unset -nocomplain savedEnv
}
}
proc restoreEnvironmentVariables { names {varName ""} } {
#
# NOTE: For each name, does the saved environment variable exist? If
# so, restore the saved value and unset it; otherwise, make sure
# the live environment variable does not exist either (i.e. it
# was not set to begin with). Both saved and live environment
# variables ARE changed by this procedure.
#
if {[string length $varName] == 0} then {
set varName savedEnv
}
upvar 1 $varName savedEnv
foreach name $names {
if {[info exists savedEnv($name)]} then {
set ::env($name) $savedEnv($name)
unset -nocomplain savedEnv($name)
} else {
unset -nocomplain ::env($name)
}
}
#
# NOTE: This is self-cleaning. If no saved environment variables now
# exist, remove the array.
#
if {[array size savedEnv] == 0} then {
unset -nocomplain savedEnv
}
}
proc saveSQLiteConnectionEnvironment {} {
upvar 1 savedEnv savedEnv
saveEnvironmentVariables [list \
DefaultFlags_SQLiteConnection No_SQLiteConnectionNewParser] \
savedEnv
}
proc restoreSQLiteConnectionEnvironment {} {
upvar 1 savedEnv savedEnv
restoreEnvironmentVariables [list \
DefaultFlags_SQLiteConnection No_SQLiteConnectionNewParser] \
savedEnv
}
proc saveSQLiteConvertEnvironment {} {
upvar 1 savedEnv savedEnv
saveEnvironmentVariables [list \
Use_SQLiteConvert_DefaultDbType Use_SQLiteConvert_DefaultTypeName] \
savedEnv
}
proc restoreSQLiteConvertEnvironment {} {
upvar 1 savedEnv savedEnv
restoreEnvironmentVariables [list \
Use_SQLiteConvert_DefaultDbType Use_SQLiteConvert_DefaultTypeName] \
savedEnv
}
proc setupDbInterruptCallback { channel log } {
tputs $channel "---- setting up debugger interrupt callback... "
if {[catch {
saveEnvironmentVariables [list \
quietFindInterpreterTestPath quietSetupInterpreterTestPath]
try {
#
# NOTE: Prevent the vendor script from being noisy when creating
# the isolated interpreter.
#
set ::env(quietFindInterpreterTestPath) 1
set ::env(quietSetupInterpreterTestPath) 1
#
# NOTE: Make sure the script debugger and the isolated interpreter
# are setup and ready for use.
#
debug setup true true
#
# NOTE: Load the necessary packages into the isolated interpreter.
#
debug eval {
package require Eagle
package require Eagle.Library
package require Eagle.Test
}
#
# NOTE: Copy the necessary variables into the isolated interpreter.
#
debug invoke 0 set ::test_channel $channel; # NOTE: For [tputs].
debug invoke 0 set ::test_log $log; # NOTE: For [tlog].
#
# NOTE: Install the callback script to be evaluated in the isolated
# interpreter when this interpreter is interrupted by script
# cancellation, etc.
#
debug callback apply {{sender e} {
#
# NOTE: Check if this debugger callback is one that we care about.
#
set interruptTypes [split [$e InterruptType] ", "]
if {"Canceled" in $interruptTypes || \
"Unwound" in $interruptTypes} then {
#
# NOTE: Make sure the [object] command is available. Since
# this is an isolated interpreter, check for it the hard
# way.
#
if {[llength [info commands object]] > 0} then {
#
# NOTE: Iterate through all database connections known to the
# parent interpreter.
#
object foreach -alias pair [object invoke -flags +NonPublic \
$e Interpreter.connections] {
#
# NOTE: Attempt to cancel any SQL queries in progress on
# this database connection.
#
if {[catch {$pair Value.Cancel} error]} then {
tputs $::test_channel [appendArgs \n \
"==== WARNING: failed to cancel query for " \
"connection \"" [$pair Key] "\", error: " \n\t \
$error \n]
}
}
} else {
tputs $::test_channel [appendArgs \n \
"==== WARNING: cannot cancel any queries: " \
"the \"object\" command is not available\n"]
}
}
}}
} finally {
restoreEnvironmentVariables [list \
quietFindInterpreterTestPath quietSetupInterpreterTestPath]
}
} error] == 0} then {
addConstraint interruptCallback.sqlite3
tputs $channel yes\n
} else {
tputs $channel [appendArgs "no, error: " \n\t $error \n]
}
}
proc cleanupFile { fileName {collect true} {force false} } {
#
# NOTE: Attempt to force all pending "garbage" objects to be collected,
# including SQLite statements and backup objects; this should allow
# the underlying database file to be deleted.
#
if {$collect} then {
collectGarbage $::test_channel
}
#
# NOTE: Check if the file still exists.
#
if {[file exists $fileName]} then {
#
# NOTE: Skip deleting test files if somebody sets the global variable
# to prevent it.
#
if {$force || ![info exists ::no(cleanupFile)]} then {
#
# NOTE: Attempt to delete the test file now.
#
if {[set code [catch {file delete $fileName} error]]} then {
#
# NOTE: We somehow failed to delete the file, report why.
#
tputs $::test_channel [appendArgs \
"==== WARNING: failed to delete test file \"" $fileName \
"\" during cleanup, error: " \n\t $error \n]
}
} else {
#
# NOTE: Show that we skipped deleting the file.
#
set code 0
tputs $::test_channel [appendArgs \
"==== WARNING: skipped deleting test file \"" $fileName \
"\" during cleanup\n"]
}
} else {
#
# NOTE: The file does not exist, success!
#
set code 0
}
return $code
}
proc cleanupMemory { varName {quiet false} } {
if {[haveSQLiteObjectCommand] && \
[string length $varName] > 0} then {
#
# NOTE: Refer to the specified variable (e.g. "connection") in the
# context of our caller. The opaque object handle for an
# ADO.NET connection previously returned by [getDbConnection]
# should be stored there.
#
upvar 1 $varName connection
if {[catch {
object invoke $connection ReleaseMemory
} result]} then {
if {!$quiet} then {
tputs $::test_channel [appendArgs \
"==== WARNING: failed to release database memory, error: " \
\n\t $result \n]
}
}
}
if {[llength [info commands debug]] > 0} then {
if {[catch {
uplevel 1 [list debug purge]
} result]} then {
if {!$quiet} then {
tputs $::test_channel [appendArgs \
"==== WARNING: failed to purge call frame, error: " \
\n\t $result \n]
}
}
if {[catch {
uplevel 1 [list debug cleanup]
} result]} then {
if {!$quiet} then {
tputs $::test_channel [appendArgs \
"==== WARNING: failed to cleanup interpreter, error: " \
\n\t $result \n]
}
}
if {[catch {
uplevel 1 [list debug collect]
} result]} then {
if {!$quiet} then {
tputs $::test_channel [appendArgs \
"==== WARNING: failed to collect garbage, error: " \
\n\t $result \n]
}
}
}
}
proc setupMemoryCounters { varName } {
if {[haveSQLiteObjectCommand]} then {
upvar 1 $varName counter
set counter(1) [object create -alias \
System.Diagnostics.PerformanceCounter Process \
"Working Set" [file rootname [file tail $::bin_file]]]
set counter(2) [object create -alias \
System.Diagnostics.PerformanceCounter Process \
"Working Set Peak" [file rootname [file tail $::bin_file]]]
set counter(3) [object create -alias \
System.Diagnostics.PerformanceCounter Process \
"Private Bytes" [file rootname [file tail $::bin_file]]]
}
return ""
}
proc reportMemoryCounters { channel varName prefix } {
if {[haveSQLiteObjectCommand]} then {
upvar 1 $varName counter
tputs $channel [appendArgs \
"---- " $prefix " counter \"" \
[object invoke $counter(1) CounterName] "\" value is " \
[object invoke $counter(1) RawValue] \n]
tputs $channel [appendArgs \
"---- " $prefix " counter \"" \
[object invoke $counter(2) CounterName] "\" value is " \
[object invoke $counter(2) RawValue] \n]
tputs $channel [appendArgs \
"---- " $prefix " counter \"" \
[object invoke $counter(3) CounterName] "\" value is " \
[object invoke $counter(3) RawValue] \n]
}
}
proc collectGarbage { channel {milliseconds 1000} {quiet true} } {
if {[haveSQLiteObjectCommand]} then {
if {[catch {
object invoke GC GetTotalMemory false
} result] == 0} then {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- memory in use by the CLR before collection... " \
$result " bytes\n"]
}
} else {
tputs $channel [appendArgs \
"==== WARNING: failed to get CLR memory usage, error: " \
\n\t $result \n]
}
}
#########################################################################
#
# NOTE: Repeatedly attempt to collect garbage until the allotted number
# of milliseconds has elapsed. Always attempt to collect garbage
# at least once.
#
if {[haveSQLiteObjectCommand]} then {
set start [clock seconds]
set stop [expr {$start + ($milliseconds / 1000)}]
do {
#
# NOTE: Attempt to force a full garbage collection now. Report any
# error that is encountered if we fail.
#
if {[catch {
object invoke GC GetTotalMemory true
} error]} then {
tputs $channel [appendArgs \
"==== WARNING: failed full garbage collection, error: " \
\n\t $error \n]
}
set now [clock seconds]
} while {$start <= $now && $now < $stop}
}
#########################################################################
if {[haveSQLiteObjectCommand]} then {
if {[catch {
object invoke GC GetTotalMemory false
} result] == 0} then {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- memory in use by the CLR after collection... " \
$result " bytes\n"]
}
} else {
tputs $channel [appendArgs \
"==== WARNING: failed to get CLR memory usage, error: " \
\n\t $result \n]
}
}
}
proc getSQLiteHandleCounts { channel {quiet false} } {
set result [list]
if {[haveSQLiteObjectCommand] && \
[haveSQLiteDefineConstant COUNT_HANDLE]} then {
#
# NOTE: Add each critical handle count to the resulting list.
#
foreach name [list connectionCount statementCount backupCount] {
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.DebugData $name
} value] == 0} then {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- critical handle count \"" $name "\" is " $value \n]
}
lappend result $value
} else {
tputs $channel [appendArgs \
"==== WARNING: failed to get critical handle count \"" \
$name "\", error: " \n\t $value \n]
}
}
} elseif {!$quiet} then {
#
# NOTE: The actual handle counts are not available; therefore, just
# return an empty list.
#
tputs $channel "---- critical handle counts unavailable\n"
}
return $result
}
proc shutdownSQLite { channel {force false} {quiet false} } {
#
# NOTE: Make sure that SQLite core library is completely shutdown. This
# is used by tests that change configuration options and/or those
# that need to make sure logging is initialized (i.e. just in case
# the SQLite core library was initialized in the process prior to
# the SQLiteLog class being able to setup its logging callback).
# Normally, this should only be performed if SQLite is loaded and
# ready for use by the test suite.
#
if {$force || [isSQLiteReady]} then {
#
# BUGFIX: Make sure that any "leaked" transactions and/or connections
# are cleaned up before calling the native shutdown function.
#
foreach transaction [info transactions] {
if {[string match \
System#Data#SQLite#SQLiteTransaction#* $transaction]} then {
if {[catch {
sql transaction rollback $transaction
} error] == 0} then {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- rolled back leaked transaction \"" \
$transaction \"\n]
}
} else {
if {!$quiet} then {
tputs $channel [appendArgs \
"==== WARNING: failed to rollback leaked transaction \"" \
$transaction "\", error: " \n\t $error \n]
}
}
}
}
foreach db [info connections] {
if {[string match \
System#Data#SQLite#SQLiteConnection#* $db]} then {
if {[catch {sql close $db} error] == 0} then {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- closed leaked database \"" $db \"\n]
}
} else {
if {!$quiet} then {
tputs $channel [appendArgs \
"==== WARNING: failed to close leaked database \"" \
$db "\", error: " \n\t $error \n]
}
}
}
}
#
# BUGFIX: Before calling the native shutdown function, make sure both
# of the PRAGMA related directory names are freed.
#
checkForSQLiteDirectories $channel true
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.UnsafeNativeMethods sqlite3_shutdown
} result] == 0} then {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- call sqlite3_shutdown()... ok: " $result \n]
}
} else {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- call sqlite3_shutdown()... error: " \n\t $result \n]
}
}
}
}
proc reportSQLiteResources {
channel {quiet false} {reset true} {collect true} } {
#
# NOTE: If available, report on (and possibly reset) the runtime
# configuration statistics.
#
if {[haveSQLiteObjectCommand] && \
[haveConstraint buildConfiguration.Debug] && [catch {
object invoke -flags +NonPublic -alias \
System.Data.SQLite.DebugData settingReadCounts
} settingReadCounts] == 0} then {
set nameCount [$settingReadCounts Count]
set valueCount 0
object foreach -alias pair $settingReadCounts {
incr valueCount [$pair Value]
if {!$quiet} then {
tputs $channel [appendArgs \
"---- setting \"" [$pair Key] "\" was read " \
[$pair Value] " times\n"]
}
}
if {$reset} then {
if {[catch {$settingReadCounts Clear} error] == 0} then {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- reset setting statistics for the previous " \
$nameCount " names and " $valueCount " values read\n"]
}
} else {
tputs $channel [appendArgs \
"==== WARNING: failed to reset setting statistics for " \
"the previous " $nameCount " names and " $valueCount \
" values read, error: " \n\t $error \n]
}
}
}
if {[haveSQLiteObjectCommand] && \
[haveSQLiteDefineConstant INTEROP_VIRTUAL_TABLE] && \
[haveSQLiteDefineConstant TRACK_MEMORY_BYTES]} then {
if {!$quiet} then {
tputs $channel "---- current memory in use by SQLiteMemory... "
}
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.SQLiteMemory bytesAllocated
} memory] == 0} then {
if {!$quiet} then {
tputs $channel [appendArgs $memory " bytes\n"]
}
} else {
set memory unknown
if {!$quiet} then {
tputs $channel [appendArgs $memory \n]
}
}
if {!$quiet} then {
tputs $channel "---- maximum memory in use by SQLiteMemory... "
}
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.SQLiteMemory maximumBytesAllocated
} memory] == 0} then {
if {!$quiet} then {
tputs $channel [appendArgs $memory " bytes\n"]
}
} else {
set memory unknown
if {!$quiet} then {
tputs $channel [appendArgs $memory \n]
}
}
}
if {!$quiet} then {
tputs $channel "---- current memory in use by SQLite... "
}
if {[haveSQLiteObjectCommand]} then {
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.UnsafeNativeMethods sqlite3_memory_used
} memory] == 0} then {
if {!$quiet} then {
tputs $channel [appendArgs $memory " bytes\n"]
}
} else {
#
# NOTE: Maybe the SQLite core library is unavailable?
#
set memory unknown
if {!$quiet} then {
tputs $channel [appendArgs $memory \n]
}
}
} else {
set memory unavailable
if {!$quiet} then {
tputs $channel [appendArgs $memory \n]
}
}
set result $memory; # NOTE: Return memory in-use to our caller.
if {!$quiet} then {
tputs $channel "---- maximum memory in use by SQLite... "
}
if {[haveSQLiteObjectCommand]} then {
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.UnsafeNativeMethods \
sqlite3_memory_highwater 0
} memory] == 0} then {
if {!$quiet} then {
tputs $channel [appendArgs $memory " bytes\n"]
}
} else {
#
# NOTE: Maybe the SQLite core library is unavailable?
#
set memory unknown
if {!$quiet} then {
tputs $channel [appendArgs $memory \n]
}
}
} else {
set memory unavailable
if {!$quiet} then {
tputs $channel [appendArgs $memory \n]
}
}
if {$collect} then {
collectGarbage $channel
}
if {!$quiet} then {
tputs $channel "---- current memory in use by the CLR... "
}
if {[haveSQLiteObjectCommand]} then {
if {[catch {
object invoke GC GetTotalMemory false
} memory] == 0} then {
if {[string is integer -strict $memory]} then {
if {!$quiet} then {
tputs $channel [appendArgs $memory " bytes\n"]
}
} else {
set memory invalid
if {!$quiet} then {
tputs $channel [appendArgs $memory \n]
}
}
} else {
set memory unknown
if {!$quiet} then {
tputs $channel [appendArgs $memory \n]
}
}
} else {
set memory unavailable
if {!$quiet} then {
tputs $channel [appendArgs $memory \n]
}
}
return $result
}
proc checkForSQLiteDirectories { channel {reset false} } {
#
# NOTE: Check if the sqlite3_win32_set_directory function is available.
#
tputs $channel \
"---- checking for function sqlite3_win32_set_directory... "
#
# NOTE: This call to the sqlite3_win32_set_directory function uses the
# invalid value 0 for the first argument. This code is designed
# to check if calling the function will raise an exception (i.e.
# the actual result of the function does not matter as long as no
# directory is changed).
#
if {[isWindows] && [catch {
object invoke -flags +NonPublic \
System.Data.SQLite.UnsafeNativeMethods \
sqlite3_win32_set_directory 0 null
}] == 0} then {
#
# NOTE: Calling the sqlite3_win32_set_directory function does not
# cause an exception; therefore, it must be available (i.e.
# even though it should return a failure return code in this
# case).
#
addConstraint sqlite3_win32_set_directory
tputs $channel yes\n
#
# NOTE: Does our caller want to reset the directories?
#
if {$reset} then {
#
# NOTE: Now make sure the database and temporary directories are
# reset their default values, which should be null for both.
# Since the sqlite3_win32_set_directory function is available,
# use it.
#
for {set index 1} {$index < 3} {incr index} {
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.UnsafeNativeMethods \
sqlite3_win32_set_directory $index null
} result] == 0} then {
tputs $channel [appendArgs \
"---- call sqlite3_win32_set_directory(" $index \
", null)... ok: " $result \n]
} else {
tputs $channel [appendArgs \
"---- call sqlite3_win32_set_directory(" $index \
", null)... error: " \n\t $result \n]
}
}
}
} else {
tputs $channel no\n
#
# NOTE: Does our caller want to reset the directories? This can only
# be performed if SQLite is loaded and ready for use by the test
# suite.
#
if {$reset && [isSQLiteReady]} then {
#
# NOTE: Now make sure the database and temporary directories are
# reset their default values, which should be null for both.
# Since the sqlite3_win32_set_directory function does not
# appear to be available, use the associated PRAGMA commands
# instead.
#
foreach directory [list data_store_directory temp_store_directory] {
set sql [appendArgs "PRAGMA " $directory " = \"\";"]
if {[catch {executeSql $sql} result] == 0} then {
tputs $channel [appendArgs \
"---- execute PRAGMA " $directory "... ok: \"" \
$result \"\n]
} else {
tputs $channel [appendArgs \
"---- execute PRAGMA " $directory "... error: " \
\n\t $result \n]
}
}
}
}
#
# NOTE: Finally, show the current value of the database and temporary
# directories. This can only be performed if SQLite is loaded
# and ready for use by the test suite.
#
if {[isSQLiteReady]} then {
foreach directory [list data_store_directory temp_store_directory] {
tputs $channel [appendArgs "---- checking " $directory "... "]
set sql [appendArgs "PRAGMA " $directory \;]
if {[catch {executeSql $sql scalar} result] == 0} then {
tputs $channel [appendArgs "ok: \"" $result \"\n]
} else {
tputs $channel [appendArgs "error: " \n\t $result \n]
}
}
}
}
proc loadSQLiteTestSettings { channel {suffix ""} {quiet false} } {
#
# NOTE: Skip loading the settings if their usage has been disabled.
#
if {![info exists ::no(sqliteTestSettings)]} then {
#
# NOTE: Load custom per-user and/or per-host test settings now.
#
if {[info exists ::tcl_platform(user)]} then {
set userSettingsFileName [file join [getCommonDirectory] \
[appendArgs settings $suffix . $::tcl_platform(user) .eagle]]
if {[file exists $userSettingsFileName]} then {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- loading per-user test settings file \"" \
$userSettingsFileName \"...\n]
}
if {[catch {
uplevel 1 [list source $userSettingsFileName]
} error]} then {
if {!$quiet} then {
tputs $channel [appendArgs \
"==== WARNING: failed to load per-user settings file \"" \
$userSettingsFileName "\", error: " \n\t $error \n]
}
}
} else {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- skipped loading per-user test settings file \"" \
$userSettingsFileName "\", it does not exist\n"]
}
}
}
#######################################################################
if {[info exists ::tcl_platform(host)]} then {
set hostSettingsFileName [file join [getCommonDirectory] \
[appendArgs settings $suffix . $::tcl_platform(host) .eagle]]
if {[file exists $hostSettingsFileName]} then {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- loading per-host test settings file \"" \
$hostSettingsFileName \"...\n]
}
if {[catch {
uplevel 1 [list source $hostSettingsFileName]
} error]} then {
if {!$quiet} then {
tputs $channel [appendArgs \
"==== WARNING: failed to load per-host settings file \"" \
$hostSettingsFileName "\", error: " \n\t $error \n]
}
}
} else {
if {!$quiet} then {
tputs $channel [appendArgs \
"---- skipped loading per-host test settings file \"" \
$hostSettingsFileName "\", it does not exist\n"]
}
}
}
}
}
proc runSQLiteTestPrologue {} {
#
# NOTE: Skip running our custom prologue if the main one has been
# skipped.
#
if {![info exists ::no(prologue.eagle)]} then {
#
# NOTE: Load the "before-constraints" custom per-user and/or per-host
# test settings now.
#
uplevel 1 [list loadSQLiteTestSettings $::test_channel .before]
#
# NOTE: Check if the [object] command is available; if not, add some
# shims to make the test suite run smoother.
#
checkForSQLiteObjectCommand $::test_channel
#
# NOTE: Determine the names of the native platform and architecture.
#
set platform [getBuildPlatform true]
set architecture [architectureForPlatform $platform]
#
# NOTE: Show the platform and architecture used to help locate the
# native build files.
#
tputs $::test_channel [appendArgs \
"---- platform for locating native build files is \"" \
$platform \"\n]
tputs $::test_channel [appendArgs \
"---- architecture for locating native build files is \"" \
$architecture \"\n]
#
# NOTE: Build a list of configuration files that we handle.
#
set configFileNames [list \
System.Data.SQLite.dll.config]
#
# NOTE: Build a list of auxiliary Managed Debugging Assistants (MDA)
# configuration files that we handle.
#
set mdaConfigFileNames [list \
EagleShell32.exe.mda.config Installer.exe.mda.config \
test.exe.mda.config testlinq.exe.mda.config \
testef6.exe.mda.config]
#
# NOTE: Build the list of external files that we handle. Some of
# these files may be native and/or managed assemblies that are
# required to perform various tests.
#
set externalFileNames [list \
[file join EntityFramework lib [string map [list Fx ""] [string \
map [list netFx451 netFx45 netFx452 netFx45 netFx46 netFx45 \
netFx461 netFx45] [getBuildNetFx]]] EntityFramework.dll]]
#
# NOTE: Build the list of native assembly files that we handle. The
# reason the "System.Data.SQLite.dll" file is included here is
# because it could be the mixed-mode assembly.
#
set nativeFileNames [list]
eval lappend nativeFileNames [getNativeLibraryFileNamesOnly]
eval lappend nativeFileNames [getInteropAssemblyFileNamesOnly]
lappend nativeFileNames System.Data.SQLite.dll
#
# NOTE: Build the list of managed assembly files that we handle.
#
set managedFileNames [list \
System.Data.SQLite.dll System.Data.SQLite.Linq.dll \
System.Data.SQLite.EF6.dll]
#
# NOTE: Remove any test constraints that refer to the native and/or
# managed assembly files that we handle unless forbidden from
# doing so.
#
if {![info exists ::no(sqliteRemoveConstraints)]} then {
foreach fileName $configFileNames {
removeConstraint [appendArgs file_ $fileName]
}
foreach fileName $mdaConfigFileNames {
removeConstraint [appendArgs file_ $fileName]
}
foreach fileName $externalFileNames {
removeConstraint [appendArgs file_ [file tail $fileName]]
}
foreach fileName $nativeFileNames {
removeConstraint [appendArgs file_ $fileName]
}
foreach fileName $managedFileNames {
removeConstraint [appendArgs file_ $fileName]
}
}
#
# NOTE: Skip all System.Data.SQLite related file handling (deleting,
# copying, and loading) if instructed.
#
if {![info exists ::no(sqliteFiles)]} then {
#
# NOTE: Skip trying to delete any files if instructed.
#
if {![info exists ::no(deleteSqliteFiles)]} then {
if {![info exists ::no(deleteSqliteConfigFiles)]} then {
foreach fileName $configFileNames {
tryDeleteBinaryFile $fileName
}
}
if {![info exists ::no(deleteSqliteExternalFiles)]} then {
foreach fileName $mdaConfigFileNames {
tryDeleteBuildFile $fileName
}
foreach fileName $externalFileNames {
tryDeleteBinaryFile $fileName
}
}
if {![info exists ::no(deleteSqliteNativeFiles)]} then {
if {![info exists ::no(deleteSqliteImplicitFiles)]} then {
foreach fileName $nativeFileNames {
tryDeleteAssembly $fileName
}
}
if {![info exists ::no(deleteSqliteNonImplicitFiles)]} then {
if {![info exists ::no(deleteSqlitePlatformFiles)] && \
[string length $platform] > 0} then {
foreach fileName $nativeFileNames {
tryDeleteAssembly $fileName $platform
}
}
if {![info exists ::no(deleteSqliteArchitectureFiles)] && \
[string length $architecture] > 0} then {
foreach fileName $nativeFileNames {
tryDeleteAssembly $fileName $architecture
}
}
}
}
if {![info exists ::no(deleteSqliteManagedFiles)]} then {
foreach fileName $managedFileNames {
tryDeleteAssembly $fileName
}
}
}
#
# NOTE: Check for the "autoSelect" runtime option. If present,
# attempt to automatically select the first available
# build (or "release") of SQLite and System.Data.SQLite
# for use with the test suite.
#
if {[hasRuntimeOption autoSelect]} then {
if {![checkForSQLiteBuilds $::test_channel true]} then {
checkForSQLiteReleases $::test_channel true
}
}
#
# NOTE: Skip trying to verify the build directory if instructed;
# otherwise, make sure it actually exists or halt the entire
# testing process if it does not exist.
#
if {![info exists ::no(verifyBuildDirectory)]} then {
#
# NOTE: At this point, the build directory MUST exist as a
# valid directory for the testing process to continue.
#
set directory [getBuildDirectory]
if {![file exists $directory] || \
![file isdirectory $directory]} then {
#
# NOTE: Just prior to actually halting the testing process,
# add an error to the test log file.
#
tputs $::test_channel [appendArgs \
"---- could not verify build directory \"" $directory \
"\", all testing halted\n"]
#
# NOTE: Raising a script error from this point should halt
# the testing process.
#
error [appendArgs \
"could not verify build directory \"" $directory \
"\", all testing halted"]
}
}
#
# NOTE: Skip trying to copy any files if instructed.
#
if {![info exists ::no(copySqliteFiles)]} then {
if {![info exists ::no(copySqliteConfigFiles)]} then {
foreach fileName $configFileNames {
tryCopyBuildFile $fileName
}
}
if {![info exists ::no(copySqliteExternalFiles)]} then {
#
# NOTE: Copy the Managed Debugging Assistants (MDA) configuration
# file for the Eagle shell to the build output directory,
# while using each of the names of the various legacy test
# executables. This will help to make sure that all the
# legacy tests run with exactly the same set of Managed
# Debugging Assistants configured.
#
foreach fileName $mdaConfigFileNames {
tryCopyBinaryFile EagleShell.exe.mda.config "" $fileName
}
#
# NOTE: Copy the external binaries, if any, to the directory that
# contains the Eagle shell. This is typically used to make
# sure assemblies referenced by the ones being tested are
# available during the testing process.
#
foreach fileName $externalFileNames {
tryCopyExternalFile $fileName
}
}
if {![info exists ::no(copySqliteNativeFiles)]} then {
#
# NOTE: If the test platform is likely the default for this
# machine, also try to copy the native files to the
# binary location.
#
if {![info exists ::no(copySqliteImplicitFiles)] && \
[isDefaultBuildPlatform true]} then {
foreach fileName $nativeFileNames {
tryCopyAssembly $fileName
}
}
if {![info exists ::no(copySqliteNonImplicitFiles)]} then {
if {![info exists ::no(copySqlitePlatformFiles)] && \
[string length $platform] > 0} then {
foreach fileName $nativeFileNames {
tryCopyAssembly $fileName $platform
}
}
if {![info exists ::no(copySqliteArchitectureFiles)] && \
[string length $architecture] > 0} then {
foreach fileName $nativeFileNames {
tryCopyAssembly $fileName $architecture
}
}
}
}
if {![info exists ::no(copySqliteManagedFiles)]} then {
foreach fileName $managedFileNames {
tryCopyAssembly $fileName
}
}
}
#
# NOTE: Skip trying to load any files if instructed.
#
if {![info exists ::no(loadSqliteFiles)]} then {
if {![info exists ::no(loadSqliteImplicitFiles)]} then {
tryLoadAssembly System.Data.SQLite.dll
}
if {![info exists ::no(loadSqliteLinqFiles)]} then {
tryLoadAssembly System.Data.SQLite.Linq.dll
}
if {![info exists ::no(loadSqliteEf6Files)]} then {
tryLoadAssembly System.Data.SQLite.EF6.dll
}
if {![info exists ::no(loadSqliteNonImplicitFiles)]} then {
if {![info exists ::no(loadSqlitePlatformFiles)] && \
[string length $platform] > 0} then {
tryLoadAssembly System.Data.SQLite.dll $platform
}
if {![info exists ::no(loadSqliteArchitectureFiles)] && \
[string length $architecture] > 0} then {
tryLoadAssembly System.Data.SQLite.dll $architecture
}
}
}
}
foreach fileNameOnly [getNativeLibraryFileNamesOnly] {
catch {
tputs $::test_channel [appendArgs \
"---- file version of \"" $fileNameOnly "\"... \"" \
[file version [getBinaryFileName $fileNameOnly]] \"\n]
}
}
foreach fileNameOnly [getInteropAssemblyFileNamesOnly] {
catch {
tputs $::test_channel [appendArgs \
"---- file version of \"" $fileNameOnly "\"... \"" \
[file version [getBinaryFileName $fileNameOnly]] \"\n]
}
}
catch {
tputs $::test_channel [appendArgs \
"---- file version of \"System.Data.SQLite.dll\"... \"" \
[file version [getBinaryFileName System.Data.SQLite.dll]] \"\n]
}
catch {
tputs $::test_channel [appendArgs \
"---- file version of \"System.Data.SQLite.Linq.dll\"... \"" \
[file version [getBinaryFileName System.Data.SQLite.Linq.dll]] \
\"\n]
}
catch {
tputs $::test_channel [appendArgs \
"---- file version of \"System.Data.SQLite.EF6.dll\"... \"" \
[file version [getBinaryFileName System.Data.SQLite.EF6.dll]] \
\"\n]
}
if {[string length $platform] > 0} then {
foreach fileNameOnly [getNativeLibraryFileNamesOnly] {
catch {
tputs $::test_channel [appendArgs \
"---- file version of \"" $platform \
/ $fileNameOnly "\"... \"" [file version \
[getBinaryFileName $fileNameOnly $platform]] \"\n]
}
}
foreach fileNameOnly [getInteropAssemblyFileNamesOnly] {
catch {
tputs $::test_channel [appendArgs \
"---- file version of \"" $platform \
/ $fileNameOnly "\"... \"" [file version \
[getBinaryFileName $fileNameOnly $platform]] \"\n]
}
}
catch {
tputs $::test_channel [appendArgs \
"---- file version of \"" $platform \
"/System.Data.SQLite.dll\"... \"" [file version \
[getBinaryFileName System.Data.SQLite.dll $platform]] \"\n]
}
}
if {[string length $architecture] > 0} then {
foreach fileNameOnly [getNativeLibraryFileNamesOnly] {
catch {
tputs $::test_channel [appendArgs \
"---- file version of \"" $architecture \
/ $fileNameOnly "\"... \"" [file version \
[getBinaryFileName $fileNameOnly $architecture]] \"\n]
}
}
catch {
tputs $::test_channel [appendArgs \
"---- file version of \"" $architecture \
/ $fileNameOnly "\"... \"" [file version \
[getBinaryFileName $fileNameOnly $architecture]] \"\n]
}
catch {
tputs $::test_channel [appendArgs \
"---- file version of \"" $architecture \
"/System.Data.SQLite.dll\"... \"" [file version \
[getBinaryFileName System.Data.SQLite.dll $architecture]] \
\"\n]
}
}
#
# NOTE: Grab the list of managed assemblies for the current process
# and report on the System.Data.SQLite related ones.
#
if {[haveSQLiteObjectCommand]} then {
set assemblies [object invoke AppDomain.CurrentDomain GetAssemblies]
object foreach assembly $assemblies {
if {[string match \{System.Data.SQLite* $assembly]} then {
tputs $::test_channel [appendArgs \
"---- found loaded assembly: " $assembly \n]
}
}
}
catch {
tputs $::test_channel \
"---- define constants for \"System.Data.SQLite\"... "
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.SQLite3 DefineConstants
} defineConstants] == 0} then {
tputs $::test_channel [appendArgs [formatList [lsort \
$defineConstants] <none>] \n]
} else {
tputs $::test_channel unknown\n
}
}
catch {
tputs $::test_channel \
"---- source version of \"System.Data.SQLite.dll\"... "
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.SQLiteConnection ProviderVersion
} version] == 0} then {
if {[string length $version] == 0} then {
set version null
}
tputs $::test_channel [appendArgs $version \n]
} else {
tputs $::test_channel unknown\n
}
}
catch {
tputs $::test_channel \
"---- source checkout of \"System.Data.SQLite.dll\"... "
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.SQLiteConnection ProviderSourceId
} sourceId] == 0} then {
if {[string length $sourceId] == 0} then {
set sourceId null
}
tputs $::test_channel [appendArgs $sourceId \n]
} else {
tputs $::test_channel unknown\n
}
}
#
# NOTE: Check the available builds (and "releases") of SQLite and
# System.Data.SQLite.
#
checkForSQLiteBuilds $::test_channel
checkForSQLiteReleases $::test_channel
#
# NOTE: Now, we need to know if the SQLite core library is available
# (i.e. because the managed-only System.Data.SQLite assembly can
# load without it; however, it cannot do anything useful without
# it). If we are using the mixed-mode assembly and we already
# found it (above), this should always succeed.
#
checkForSQLiteLibrary $::test_channel
#
# NOTE: Check if the SQLite interop assembly is available.
#
checkForSQLiteInterop $::test_channel
#
# NOTE: Check the SQLite database and temporary directories.
#
checkForSQLiteDirectories $::test_channel
#
# NOTE: Attempt to determine if various compile-time options needed for
# test constraints were enabled for the managed assembly. There
# are some compile-time options that must also have been enabled
# for the interop assembly in order to be effective. For those
# options, it will be assumed that it was enabled for the interop
# assembly if it was enabled for the managed assembly.
#
foreach defineConstant [list \
CHECK_STATE COUNT_HANDLE DEBUG INTEROP_CODEC INTEROP_DEBUG \
INTEROP_EXTENSION_FUNCTIONS INTEROP_FTS5_EXTENSION \
INTEROP_INCLUDE_CEROD INTEROP_INCLUDE_EXTRA INTEROP_INCLUDE_SEE \
INTEROP_INCLUDE_ZIPVFS INTEROP_JSON1_EXTENSION \
INTEROP_LEGACY_CLOSE INTEROP_LOG INTEROP_PERCENTILE_EXTENSION \
INTEROP_REGEXP_EXTENSION INTEROP_TEST_EXTENSION \
INTEROP_TOTYPE_EXTENSION INTEROP_VIRTUAL_TABLE NET_20 NET_35 \
NET_40 NET_45 NET_451 NET_452 NET_46 NET_461 NET_COMPACT_20 \
PLATFORM_COMPACTFRAMEWORK PRELOAD_NATIVE_LIBRARY RETARGETABLE \
SQLITE_STANDARD THROW_ON_DISPOSED TRACE TRACE_CONNECTION \
TRACE_DETECTION TRACE_HANDLE TRACE_PRELOAD TRACE_SHARED \
TRACE_STATEMENT TRACE_WARNING TRACK_MEMORY_BYTES \
USE_ENTITY_FRAMEWORK_6 USE_INTEROP_DLL USE_PREPARE_V2 WINDOWS] {
#
# NOTE: Check if the compile-time option is listed in the list of
# "define constants" kept track of by the managed assembly.
#
checkForSQLiteDefineConstant $::test_channel $defineConstant
}
#
# NOTE: Check if the System.Data.SQLite provider was compiled with
# support for any encrypted databases.
#
if {[haveSQLiteDefineConstant INTEROP_CODEC] || \
[haveSQLiteDefineConstant INTEROP_INCLUDE_SEE]} then {
#
# NOTE: Yes, add generic constraint for use by the test suite.
#
addConstraint System.Data.SQLite.Encryption
}
#
# NOTE: Check the current build year. Basically, this indicates
# which version of MSBuild and/or Visual Studio was used to
# compile the assembly binaries under test.
#
tputs $::test_channel \
"---- checking for System.Data.SQLite build year... "
set year [getBuildYear]
addConstraint [appendArgs buildYear. $year]
tputs $::test_channel [appendArgs \" $year \"\n]
#
# NOTE: Check the current build .NET Framework. Basically, this
# indicates which version of the .NET Framework is being
# used by the assembly binaries under test.
#
tputs $::test_channel \
"---- checking for System.Data.SQLite build .NET Framework... "
set netFx [getBuildNetFx]
addConstraint [appendArgs buildFramework. $netFx]
tputs $::test_channel [appendArgs \" $netFx \"\n]
#
# NOTE: Check the current build configuration. This should normally
# be either "Debug" or "Release".
#
tputs $::test_channel \
"---- checking for System.Data.SQLite build configuration... "
set configuration [getBuildConfiguration]
addConstraint [appendArgs buildConfiguration. $configuration]
tputs $::test_channel [appendArgs \" $configuration \"\n]
#
# NOTE: Try to setup an interrupt callback using the script debugger
# that will cancel all SQL queries in progress for all database
# connections known to this interpreter.
#
if {![info exists ::no(sqliteInterruptCallback)]} then {
setupDbInterruptCallback $::test_channel $::test_log
}
#
# NOTE: Check for the native runtime option, which would mean we are
# using the mixed-mode assembly.
#
checkForRuntimeOption $::test_channel native
#
# NOTE: Check if the test suite should count the number of connections
# "opened" and "closed" from the pool when determining if a test
# passed. Disabling this behavior is sometimes necessary (e.g.
# during the release testing process) because there are several
# tests that rely on the "opened from pool" count being greater
# than zero. These tests may fail due to the non-deterministic
# behavior of the CLR GC, even when there is no bug in the code
# being tested.
#
checkForRuntimeOption $::test_channel noPoolCounts
#
# NOTE: Check if the test suite should use shared-cache mode.
#
checkForRuntimeOption $::test_channel sharedCache
#
# NOTE: Report the resource usage prior to running any tests.
#
reportSQLiteResources $::test_channel
#
# NOTE: Grab the list of native modules for the current process and
# report on the System.Data.SQLite related ones.
#
if {[haveSQLiteObjectCommand]} then {
set modules [object invoke \
System.Diagnostics.Process.GetCurrentProcess Modules]
object foreach -alias module $modules {
#
# NOTE: The module file name here must be normalized.
#
set fileName [file normalize [$module FileName]]
set fileNameOnly [file tail $fileName]
if {[lsearch -exact -nocase -- \
[getNativeLibraryFileNamesOnly] $fileNameOnly] != -1} then {
tputs $::test_channel [appendArgs \
"---- found loaded SQLite native library module: " \
$fileName \n]
} elseif {[lsearch -exact -nocase -- \
[getInteropAssemblyFileNamesOnly] $fileNameOnly] != -1} then {
tputs $::test_channel [appendArgs \
"---- found loaded SQLite interop assembly module: " \
$fileName \n]
}
}
}
catch {
tputs $::test_channel \
"---- compile-time options for SQLite core library... "
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.SQLite3 SQLiteCompileOptions
} compileOptions] == 0} then {
tputs $::test_channel [appendArgs [formatList [lsort \
$compileOptions] <none>] \n]
} else {
tputs $::test_channel unknown\n
}
}
catch {
tputs $::test_channel \
"---- compile-time options for SQLite interop assembly... "
if {[catch {
object invoke -flags +NonPublic \
System.Data.SQLite.SQLite3 InteropCompileOptions
} compileOptions] == 0} then {
tputs $::test_channel [appendArgs [formatList [lsort \
$compileOptions] <none>] \n]
} else {
tputs $::test_channel unknown\n
}
}
#
# NOTE: Show the active test constraints.
#
tputs $::test_channel [appendArgs "---- constraints: " \
[formatList [lsort [getConstraints]] <none>] \n]
#
# NOTE: Save the test constraints for use by threads created in this
# application domain. This is necessary because all the Eagle
# "test context" information is per-thread.
#
if {![info exists ::test_constraints]} then {
set ::test_constraints $::eagle_tests(constraints)
}
#
# NOTE: Load the "after-constraints" custom per-user and/or per-host
# test settings now.
#
uplevel 1 [list loadSQLiteTestSettings $::test_channel .after]
#
# NOTE: If necessary, enable shared-cache mode now.
#
if {[hasRuntimeOption sharedCache]} then {
enableSharedCache $::test_channel true
}
#
# NOTE: Show when our tests actually began (now).
#
tputs $::test_channel [appendArgs \
"---- System.Data.SQLite tests began at " \
[clock format [clock seconds]] \n]
}
}
proc runSQLiteTestFilesPrologue {} {
uplevel 1 {
#
# NOTE: Setup the variables that refer to the various non-data files
# required by the tests in this file.
#
set entityFrameworkDllFile \
[getBuildFileName EntityFramework.dll]
set installerExeFile [getBuildFileName Installer.exe]
set sqliteDesignerDllFile [getBuildFileName SQLite.Designer.dll]
set systemDataSQLiteDllFile \
[getBuildFileName System.Data.SQLite.dll]
set systemDataSQLiteLinqDllFile \
[getBuildFileName System.Data.SQLite.Linq.dll]
set systemDataSQLiteEf6DllFile \
[getBuildFileName System.Data.SQLite.EF6.dll]
set testExeFile [getBuildFileName test.exe]
set testLinqExeFile [getBuildFileName testlinq.exe]
set testEf6ExeFile [getBuildFileName testef6.exe]
#
# NOTE: Setup the variables that refer to the various data files
# required by the tests in this file.
#
set testLinqOutFile [file nativename [file join \
[getSQLiteTestDataPath] testlinq.out]]
set northwindEfDbFile [file nativename [file join \
[file dirname [file dirname [getSQLiteTestDataPath]]] \
testlinq northwindEF.db]]
set nonWalDbFile [file nativename [file join \
[getSQLiteTestDataPath] nonWal.db]]
set walDbFile [file nativename [file join \
[getSQLiteTestDataPath] wal.db]]
#
# NOTE: The various install/uninstall log files used to test the
# design-time component installer.
#
set testInstallVs2005LogFile [file nativename [file join \
[getSQLiteTestDataPath] Installer_Test_Vs2005.log]]
set testInstallVs2008LogFile [file nativename [file join \
[getSQLiteTestDataPath] Installer_Test_Vs2008.log]]
set testInstallVs2010LogFile [file nativename [file join \
[getSQLiteTestDataPath] Installer_Test_Vs2010.log]]
set testInstallVs2012LogFile [file nativename [file join \
[getSQLiteTestDataPath] Installer_Test_Vs2012.log]]
set testInstallVs2013LogFile [file nativename [file join \
[getSQLiteTestDataPath] Installer_Test_Vs2013.log]]
set testInstallVs2015LogFile [file nativename [file join \
[getSQLiteTestDataPath] Installer_Test_Vs2015.log]]
set testUninstallVs2005LogFile [file nativename [file join \
[getSQLiteTestDataPath] Uninstaller_Test_Vs2005.log]]
set testUninstallVs2008LogFile [file nativename [file join \
[getSQLiteTestDataPath] Uninstaller_Test_Vs2008.log]]
set testUninstallVs2010LogFile [file nativename [file join \
[getSQLiteTestDataPath] Uninstaller_Test_Vs2010.log]]
set testUninstallVs2012LogFile [file nativename [file join \
[getSQLiteTestDataPath] Uninstaller_Test_Vs2012.log]]
set testUninstallVs2013LogFile [file nativename [file join \
[getSQLiteTestDataPath] Uninstaller_Test_Vs2013.log]]
set testUninstallVs2015LogFile [file nativename [file join \
[getSQLiteTestDataPath] Uninstaller_Test_Vs2015.log]]
#######################################################################
if {![haveConstraint [appendArgs file_ \
[file tail $entityFrameworkDllFile]]]} then {
checkForFile $test_channel $entityFrameworkDllFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $installerExeFile]]]} then {
checkForFile $test_channel $installerExeFile Installer.exe
}
if {![haveConstraint [appendArgs file_ \
[file tail $sqliteDesignerDllFile]]]} then {
checkForFile $test_channel $sqliteDesignerDllFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $systemDataSQLiteDllFile]]]} then {
checkForFile $test_channel $systemDataSQLiteDllFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $systemDataSQLiteLinqDllFile]]]} then {
checkForFile $test_channel $systemDataSQLiteLinqDllFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $systemDataSQLiteEf6DllFile]]]} then {
checkForFile $test_channel $systemDataSQLiteEf6DllFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testExeFile]]]} then {
checkForFile $test_channel $testExeFile test.exe
}
if {![haveConstraint [appendArgs file_ \
[file tail $testLinqExeFile]]]} then {
checkForFile $test_channel $testLinqExeFile testlinq.exe
}
if {![haveConstraint [appendArgs file_ \
[file tail $testEf6ExeFile]]]} then {
checkForFile $test_channel $testEf6ExeFile testef6.exe
}
if {![haveConstraint [appendArgs file_ \
[file tail $testLinqOutFile]]]} then {
checkForFile $test_channel $testLinqOutFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $northwindEfDbFile]]]} then {
checkForFile $test_channel $northwindEfDbFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $nonWalDbFile]]]} then {
checkForFile $test_channel $nonWalDbFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $walDbFile]]]} then {
checkForFile $test_channel $walDbFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testInstallVs2005LogFile]]]} then {
checkForFile $test_channel $testInstallVs2005LogFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testInstallVs2008LogFile]]]} then {
checkForFile $test_channel $testInstallVs2008LogFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testInstallVs2010LogFile]]]} then {
checkForFile $test_channel $testInstallVs2010LogFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testInstallVs2012LogFile]]]} then {
checkForFile $test_channel $testInstallVs2012LogFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testInstallVs2013LogFile]]]} then {
checkForFile $test_channel $testInstallVs2013LogFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testInstallVs2015LogFile]]]} then {
checkForFile $test_channel $testInstallVs2015LogFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testUninstallVs2005LogFile]]]} then {
checkForFile $test_channel $testUninstallVs2005LogFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testUninstallVs2008LogFile]]]} then {
checkForFile $test_channel $testUninstallVs2008LogFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testUninstallVs2010LogFile]]]} then {
checkForFile $test_channel $testUninstallVs2010LogFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testUninstallVs2012LogFile]]]} then {
checkForFile $test_channel $testUninstallVs2012LogFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testUninstallVs2013LogFile]]]} then {
checkForFile $test_channel $testUninstallVs2013LogFile
}
if {![haveConstraint [appendArgs file_ \
[file tail $testUninstallVs2015LogFile]]]} then {
checkForFile $test_channel $testUninstallVs2015LogFile
}
}
}
proc runSQLiteTestFilesEpilogue {} {
uplevel 1 {
unset -nocomplain \
testUninstallVs2015LogFile testUninstallVs2013LogFile \
testUninstallVs2012LogFile testUninstallVs2010LogFile \
testUninstallVs2008LogFile testUninstallVs2005LogFile \
testInstallVs2015LogFile testInstallVs2013LogFile \
testInstallVs2012LogFile testInstallVs2010LogFile \
testInstallVs2008LogFile testInstallVs2005LogFile
unset -nocomplain \
northwindEfDbFile testLinqOutFile \
walDbFile nonWalDbFile
unset -nocomplain \
testEf6ExeFile testLinqExeFile \
testExeFile systemDataSQLiteEf6DllFile \
systemDataSQLiteLinqDllFile systemDataSQLiteDllFile \
sqliteDesignerDllFile installerExeFile \
entityFrameworkDllFile
}
}
proc runSQLiteTestEpilogue {} {
#
# NOTE: Skip running our custom epilogue if the main one has been
# skipped.
#
if {![info exists ::no(epilogue.eagle)]} then {
#
# NOTE: Show when our tests actually ended (now).
#
tputs $::test_channel [appendArgs \
"---- System.Data.SQLite tests ended at " \
[clock format [clock seconds]] \n]
#
# NOTE: Load the "epilogue" custom per-user and/or per-host test
# settings now.
#
uplevel 1 [list loadSQLiteTestSettings $::test_channel .epilogue]
#
# BUGFIX: Before checking the final resources in use by SQLite, make
# sure both of the PRAGMA related directory names are freed.
#
checkForSQLiteDirectories $::test_channel true
#
# NOTE: Also report the resource usage after running the tests.
#
reportSQLiteResources $::test_channel
#
# NOTE: Report the critical handle counts after running the tests.
#
getSQLiteHandleCounts $::test_channel
#
# NOTE: If necessary, disable shared-cache mode now.
#
if {[hasRuntimeOption sharedCache]} then {
enableSharedCache $::test_channel false
}
}
}
###########################################################################
############################# END Eagle ONLY ##############################
###########################################################################
}
#
# NOTE: Save the name of the directory containing this file.
#
if {![info exists common_directory]} then {
set common_directory [file dirname [info script]]
}
#
# NOTE: Provide the System.Data.SQLite test package to the interpreter.
#
package provide System.Data.SQLite.Test 1.0
}