############################################################################### # # 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 getSQLiteCompileOptionPrefix {} { # # NOTE: See if the compile option prefix setting has been overridden # by the user (e.g. on the command line). # if {[info exists ::compile_option_prefix] && \ [string length $::compile_option_prefix] > 0} then { # # NOTE: Use the specified compile option prefix. # return $::compile_option_prefix } else { # # NOTE: Use the default compile option prefix. # return compileOption.SQLite. } } proc haveSQLiteDefineConstant { name } { return [haveConstraint \ [appendArgs [getSQLiteDefineConstantPrefix] $name]] } proc haveSQLiteCompileOption { name } { return [haveConstraint \ [appendArgs [getSQLiteCompileOptionPrefix] $name]] } proc getBuildNative {} { # # NOTE: Check if we are being forced to treat this as a native build. # This is normally done (automatically) only when the mixed-mode # assembly is in use; however, in some circumstances it is useful # to force this behavior. # if {[info exists ::test_native] && \ [string is boolean -strict $::test_native]} then { return $::test_native } else { return false } } 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, 2015, or 2017 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 "set test_year 2017" # -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", "2015", or "2017" 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? } } } } proc getBuildNativeYear {} { if {[info exists ::test_native_year] && \ [string length $::test_native_year] > 0} then { # # NOTE: Use the specified test year for native binaries. If this # variable is not set, the value returned by [getBuildYear] # will be used. # return $::test_native_year } else { # # NOTE: Fallback on the (normal) build year for managed binaries. # return [getBuildYear] } } proc getBuildNativeYearForDotNetCore { year } { if {[isDotNetCore] && [isWindows]} then { return 2015; # HACK: Special case, use 2015 native binaries. } elseif {[string length $year] > 0} then { return $year } else { return [getBuildNativeYear] } } 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 } elseif {[isDotNetCore]} then { # # NOTE: Running on .NET Core, prioritize its list of test years. # return [list NetStandard20] } else { # # NOTE: Use the default list of test years (i.e. all). # return [list 2005 2008 2010 2012 2013 2015 2017 NetStandard20] } } # # 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 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" / "netFx462"? } 2017 { return netFx47; # TODO: Or "netFx471" / "netFx472"? } NetStandard20 { return netStandard20 } 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 true} } { # # 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: Possibly use the specified test platform. If this variable # is not set, the default value will be based on the machine # architecture. Normally, this is done for builds that involve # the mixed-mode assembly. # 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. Normally, this is done for builds that involve the # mixed-mode assembly. # 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. # Normally, this is done for builds that involve the mixed-mode # assembly. # 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 getBuildConfigurationSuffix {} { # # NOTE: See if the test configuration suffix has been overridden by # the user (e.g. on the command line). # if {[info exists ::test_configuration_suffix] && \ [string length $::test_configuration_suffix] > 0} then { # # NOTE: Use the specified test configuration suffix. # return $::test_configuration_suffix } else { # # NOTE: Use the default test configuration suffix, which should be # an empty string. # return "" } } proc getBuildNativeConfigurationSuffix {} { # # NOTE: See if the test native configuration suffix has been # overridden by the user (e.g. on the command line). # if {[info exists ::test_native_configuration_suffix] && \ [string length $::test_native_configuration_suffix] > 0} then { # # NOTE: Use the specified test native configuration suffix. # return $::test_native_configuration_suffix } else { # # NOTE: Use the default test native configuration suffix, which # should be an empty string. # return "" } } proc getBuildNativeConfigurationSuffixForDotNetCore { suffix } { if {[isDotNetCore] && [isWindows]} then { return NativeOnly; # HACK: Special case, use 2015 native binaries. } elseif {[string length $suffix] > 0} then { return $suffix } else { return [getBuildNativeConfigurationSuffix] } } proc getBuildConfigurationSuffixes {} { # # NOTE: See if the list of test configuration suffixes has been # overridden by the user (e.g. on the command line). # if {[info exists ::test_configuration_suffixes] && \ [llength $::test_configuration_suffixes] > 0} then { # # NOTE: Use the specified list of test configurations suffixes. # return $::test_configuration_suffixes } elseif {[isDotNetCore]} then { # # NOTE: Running on .NET Core, prioritize its test configuration # suffixes for library files. # return [list NetStandard20 ""] } else { # # NOTE: Use the default list of test configurations suffixes. # return [list ""] } } proc getBuildExtra {} { if {[info exists ::test_extra] && \ [string length $::test_extra] > 0} then { # # NOTE: Use the specified extra output directory. # return $::test_extra } elseif {[isDotNetCore]} then { # # NOTE: Running on .NET Core, use the extra output directory for # library files. # return netstandard2.0 } else { # # NOTE: No extra output directory is required. # return "" } } proc getBuildExtras {} { # # NOTE: See if the list of extra output directories has been overridden # by the user (e.g. on the command line). # if {[info exists ::test_extras] && \ [llength $::test_extras] > 0} then { # # NOTE: Use the specified list of extra output directories. # return $::test_extras } elseif {[isDotNetCore]} then { # # NOTE: Running on .NET Core, prioritize its extra output directory # for library files. # return [list netstandard2.0 ""] } else { # # NOTE: Use default list of extra output directories, which is one # empty string (no-op). # return [list ""] } } 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 isDarwin {} { return [expr { [info exists ::tcl_platform(os)] && $::tcl_platform(os) eq "Darwin" }] } 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 Win32, always use the standard native library # file name "sqlite3.dll". # return [list sqlite3.dll] } elseif {[isDotNetCore]} then { # # When running on .NET Core, return the same native library # file name that is used on Windows (i.e. otherwise, assume # we are running on Mono and use its P/Invoke conventions). # return [list sqlite3.dll] } elseif {[isDarwin]} then { # # NOTE: When running on Darwin (i.e. the kernel of iOS / Mac OS X), # return the Mac OS X native library file name. This file # name is normally required for Mono. # return [list libsqlite3.dylib] } else { # # NOTE: Otherwise, return the generic POSIX native library file # name. This file name is normally required for Mono. # return [list 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 Win32, always use the interop assembly file # name "SQLite.Interop.dll". # return [list SQLite.Interop.dll] } elseif {[isDotNetCore]} then { # # When running on .NET Core, return the same interp assembly # file name that is used on Windows (i.e. otherwise, assume # we are running on Mono and use its P/Invoke conventions). # return [list SQLite.Interop.dll] } elseif {[isDarwin]} then { # # NOTE: When running on Darwin (i.e. the kernel of iOS / Mac OS X), # return the Mac OS X interp assembly file name. This file # name is normally required for Mono. # return [list libSQLite.Interop.dylib] } else { # # NOTE: Otherwise, return the generic POSIX interp assembly file # name. This file name is normally required for Mono. # return [list libSQLite.Interop.so] } } proc getCoreExtensionBinaryFileName { {default ""} } { set fileName [getCoreBinaryFileName] if {[file exists $fileName]} then { return $fileName } return $default } proc isBuildAvailable { native skipNative 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: If we are skipping looking for the native components, stop # now. # if {$skipNative} then { return true } # # 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: If the machine name is unavailable, there is nothing else we # can do. # if {![info exists ::tcl_platform(machine)]} then { return false } # # 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 "" false $directory $varName] } proc joinBuildDirectory { native path year platform configuration extra } { # # 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 $extra] } else { return [file join $path bin $year $configuration bin $extra] } } proc getBuildDirectory { managedOnly } { # # 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 [expr { !$managedOnly && ([getBuildNative] || [hasRuntimeOption native]) }] return [joinBuildDirectory $native [getBuildBaseDirectory] \ [expr {$managedOnly ? [getBuildYear] : [getBuildNativeYear]}] \ [getBuildPlatform $native] [appendArgs [getBuildConfiguration] \ [expr {$managedOnly ? [getBuildConfigurationSuffix] : \ [getBuildNativeConfigurationSuffix]}]] [expr {$managedOnly ? \ [getBuildExtra] : ""}]] } } 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 managedOnly {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 $managedOnly] $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 [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 getStringMapForTclEscape {} { return [list \\ \\\\ \[ \\\[ \] \\\] \$ \\\$] } 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 " \{" [string map \ [getStringMapForTclEscape] [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 true} } { set directory [getBinaryDirectory] if {[string length $directory] == 0} then { if {$verbose} then { tputs $::test_channel [appendArgs \ "---- skipped moving \"System.Data.SQLite.dll.config\", " \ "no binary 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 writeSystemDataSQLiteDllConfig { data {verbose true} } { set directory [getBinaryDirectory] if {[string length $directory] == 0} then { if {$verbose} then { tputs $::test_channel [appendArgs \ "---- skipped moving \"System.Data.SQLite.dll.config\", " \ "no binary directory\n"] } return } set fileName [file normalize \ [file join $directory System.Data.SQLite.dll.config]] writeFile $fileName $data if {$verbose} then { tputs $::test_channel \ "---- wrote \"System.Data.SQLite.dll.config\"\n" } return $fileName } proc moveEagleShellMdaConfig { {restore false} {verbose true} } { set directory [getBinaryDirectory] if {[string length $directory] == 0} then { if {$verbose} then { tputs $::test_channel [appendArgs \ "---- skipped moving \"EagleShell.exe.mda.config\", " \ "no binary directory\n"] } return } set fileName(1) [file normalize \ [file join $directory EagleShell.exe.mda.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 writeEagleShellMdaConfig { data {verbose true} } { set directory [getBinaryDirectory] if {[string length $directory] == 0} then { if {$verbose} then { tputs $::test_channel [appendArgs \ "---- skipped moving \"EagleShell.exe.mda.config\", " \ "no binary directory\n"] } return } set fileName [file normalize \ [file join $directory EagleShell.exe.mda.config]] writeFile $fileName $data if {$verbose} then { tputs $::test_channel \ "---- wrote \"EagleShell.exe.mda.config\"\n" } return $fileName } 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 true} } { 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 managedOnly {platform ""} {newFileName ""} {verbose true} } { 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 $managedOnly $platform] } else { set targetFileName [getBuildFileName \ $fileName $managedOnly $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 managedOnly {platform ""} {newFileName ""} {verbose true} } { set sourceFileName [getBuildFileName $fileName $managedOnly $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 true} } { 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 managedOnly {platform ""} {verbose true} } { set fileName [getBuildFileName $fileName $managedOnly $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 managedOnly {platform ""} {pdb true} {verbose true} } { tryCopyBuildFile $fileName $managedOnly $platform "" $verbose if {$pdb} then { tryCopyBuildFile [appendArgs \ [file rootname $fileName] .pdb] $managedOnly $platform "" $verbose } } proc tryDeleteAssembly { fileName {platform ""} {pdb true} {verbose true} } { 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: If the machine name is unavailable, there is nothing else we # can do. # if {![info exists ::tcl_platform(machine)]} then { return false } # # 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_SESSION_EXTENSION INTEROP_SHA1_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] { foreach suffix [getBuildConfigurationSuffixes] { foreach extra [getBuildExtras] { # # 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] # # NOTE: Build the fully qualified directory where the # necessary components for System.Data.SQLite should # be found. # set directory [joinBuildDirectory $native \ [getBuildBaseDirectory] $year $platform [appendArgs \ $configuration $suffix] $extra] tputs $channel [appendArgs \ "---- checking for System.Data.SQLite build \"" [expr \ {$native ? "native/" : ""}] [expr {[string length \ $platform] > 0 ? [appendArgs $platform /] : ""}] \ $year / [appendArgs $configuration $suffix] "\"... "] # # NOTE: Do the necessary files exist? Currently, no other # steps are taken to verify this build is actually # viable. # set skipNative [expr {[isDotNetCore] && [isWindows]}] if {[isBuildAvailable $native $skipNative $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_native $skipNative set ::test_year $year set ::test_native_year \ [getBuildNativeYearForDotNetCore $year] set ::test_platform $platform set ::test_configuration $configuration set ::test_configuration_suffix $suffix set ::test_native_configuration_suffix \ [getBuildNativeConfigurationSuffixForDotNetCore \ $suffix] set ::test_extra $extra tputs $channel [appendArgs \ "yes, selected (" [expr {$native ? "native/" : ""}] \ [expr {[string length $platform] > 0 ? [appendArgs \ $platform /] : ""}] $year / [appendArgs \ $configuration $suffix] [expr {[string length \ $extra] > 0 ? [appendArgs / $extra] : ""}] ")\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 if {![file exists $directory] || \ ![file isdirectory $directory]} then { tputs $channel [appendArgs \ "---- environment variable \"System.Data.SQLite\" is an " \ "invalid directory, skipping check for releases...\n"] return false } 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 # # NOTE: Record version of the SQLite core library for later use # by test constraint expressions, etc. If this value has # already been set (or overridden), skip setting it. # if {![info exists ::core_library_version]} then { set ::core_library_version $version } 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 checkForSQLiteCompileOption { channel name } { tputs $channel [appendArgs \ "---- checking for SQLite interop assembly compile option \"" \ $name "\"... "] if {[catch { object invoke -flags +NonPublic \ System.Data.SQLite.SQLite3 InteropCompileOptions } compileOptions] == 0} then { if {[lsearch -exact -nocase $compileOptions $name] != -1} then { # # NOTE: Yes, this compile option was enabled when the interop # assembly was compiled. # addConstraint [appendArgs [getSQLiteCompileOptionPrefix] $name] tputs $channel yes\n } else { tputs $channel no\n } } else { tputs $channel error\n } tputs $channel [appendArgs \ "---- checking for SQLite core library compile option \"" \ $name "\"... "] if {[catch { object invoke -flags +NonPublic \ System.Data.SQLite.SQLite3 SQLiteCompileOptions } compileOptions] == 0} then { if {[lsearch -exact -nocase $compileOptions $name] != -1} then { # # NOTE: Yes, this compile option was enabled when the SQLite # core library was compiled. # addConstraint [appendArgs [getSQLiteCompileOptionPrefix] $name] tputs $channel yes\n } else { tputs $channel no\n } } else { tputs $channel error\n } } proc getDateTimeFormat { {timeZone true} } { # # 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 [appendArgs \ "yyyy-MM-dd HH:mm:ss.FFFFFFF" [expr {$timeZone ? "K" : ""}]] } } proc getDateTimeTicks { value {local ""} {default ""} } { if {[string length $value] == 0} then { return $default } if {[catch { set dateTime [object invoke -create \ -parametertypes [list String String IFormatProvider \ System.Globalization.DateTimeStyles] DateTime ParseExact \ $value [getDateTimeFormat] null AdjustToUniversal] }]} then { return $default } if {[string is boolean -strict $local]} then { set dateTime [object invoke -create DateTime SpecifyKind \ $dateTime Utc] } else { return [object invoke $dateTime Ticks] } if {$local} then { return [object invoke $dateTime ToLocalTime.Ticks] } else { return [object invoke $dateTime ToUniversalTime.Ticks] } } 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 resetException {} { # # NOTE: Reset exception associated with this interpreter (to null). # This (private) property is maintained on a per-thread basis. # object invoke -flags +NonPublic Interpreter.GetActive Exception null return "" } proc catchAndSetException { script {varName ""} } { # # NOTE: Evaluate the script provided by our caller in their context. # catch {uplevel 1 $script} # # NOTE: Grab the (private) exception property from this interpreter, # for this thread, and add as an opaque object handle in the # context of our caller. # if {[string length $varName] > 0} then { upvar 1 $varName exception } set exception [object invoke \ -alias -flags +NonPublic Interpreter.GetActive Exception] return "" } proc compileCSharpWith { text memory symbols strict resultsVarName errorsVarName fileNames args } { try { # # 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 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 } finally { # # NOTE: If the C# compiler was invoked using [exec], reset the # previous process identifier now (i.e. that way, it does # not show up as being "leaked"). # if {[isDotNetCore]} then { catch {info previouspid true} } } } 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 {} { if {[catch {executeSql "PRAGMA page_size;" scalar} result] == 0} then { return $result } else { return 0 } } proc getDbDefaultCacheSize {} { if {[catch {executeSql "PRAGMA cache_size;" scalar} result] == 0} then { return $result } else { return 0 } } 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 normalizeExceptionMessage { value } { if {[string length $value] == 0} then {return $value} return [string map [list \r\n " ==> " \n " ==> "] $value] } 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 \(0x(?:0|8)[0-9A-Fa-f]{7}\):\ (.+?) (?: )?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 { set connection [getDbConnection] try { cleanupDb $fileName db false false false } finally { object flags $connection -NoDispose; freeDbConnection } } } 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 } } # # 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 \"] : ""}] \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 \"] : ""}] \n] } } else { if {![info exists ::no(emitSharedFlags)] && \ ![info exists ::no(emitSharedFlagsIfUnavailable)]} then { tputs $::test_channel [appendArgs \ "---- shared connection flags for " $database \ " are: \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 \"] : ""}] \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 \"] : ""}] \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 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 getTestProperties { {flags ""} {quiet false} } { # # NOTE: Start with "Flags" property for the new connection, if any. # set result [getFlagsProperty $flags $quiet] # # NOTE: Add the name of the current test file, if available. This is # only used for debugging. # if {[info exists ::test_file]} then { append result TestFile= $::test_file \; } # # NOTE: Add the name of the current test, if available. This is only # used for debugging. # if {[info exists ::eagle_tests(CurrentName)]} then { append result TestName= $::eagle_tests(CurrentName) \; } return $result } 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: Add the name of the current test file, if available. This is # only used for debugging. # if {[info exists ::test_file]} then { append connection {;TestFile=${::test_file}} } # # NOTE: Add the name of the current test, if available. This is only # used for debugging. # if {[info exists ::eagle_tests(CurrentName)]} then { append connection {;TestName=${::eagle_tests(CurrentName)}} } # # NOTE: For clarity, append a final semicolon to the connection string. # append connection \; # # 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 removeDbTransaction { transaction } { # # NOTE: Remove the database transaction provided by our caller from the # list of those known to the Eagle interpreter. # object invoke -flags +NonPublic Interpreter.GetActive.transactions \ Remove $transaction } proc getRowsFromDataTable { dataTable {valueCallback ""} } { 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] } # # NOTE: Setup some Tcl return code constants. # set Ok 0; set Error 1; set Return 2; set Break 3; set Continue 4 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 $valueCallback] > 0} then { set code [catch { $valueCallback $dataTable $dataRow $index $value } newValue] if {$code == $Ok} then { # # NOTE: Use the specified (new?) row value. # lappend row [list $names($index) $newValue] } elseif {$code == $Error} then { # # NOTE: Use the (new?) NULL row value. # lappend row [list $names($index)] } elseif {$code == $Return} then { # # NOTE: Skip remaining values for this row. # break } elseif {$code == $Break} then { # # NOTE: Skip processing this row value. # } elseif {$code == $Continue} then { # # NOTE: Use default row value handling. # } } else { set code $Continue } if {$code == $Continue} then { 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]] ": \n"] } else { tputs $channel \t\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; initially, assume all files will # be deleted successfully, if necessary. # set success true 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(cleanupDbFiles)]} then { # # NOTE: Attempt to delete the test WAL file, if any, now. # set walFileName [appendArgs $fileName -wal] if {[file exists $walFileName]} then { # # NOTE: If there is a WAL file, it should be zero bytes at this # point. # if {[set size [file size $walFileName]] == 0} then { # # NOTE: We somehow failed to delete the WAL file, report why. # if {[catch {file delete $walFileName} error]} then { tputs $::test_channel [appendArgs \ "==== WARNING: failed to delete WAL file \"" $walFileName \ "\" during cleanup, error: " \n\t $error \n] set success false } } else { tputs $::test_channel [appendArgs \ "==== WARNING: WAL file \"" $walFileName "\" is " $size \ " bytes in size, skipping all file deletions...\n"] return 1; # error } } # # NOTE: Attempt to delete the test SHM file, if any, now. # set shmFileName [appendArgs $fileName -shm] if {[file exists $shmFileName] && \ [catch {file delete $shmFileName} error]} then { # # NOTE: We somehow failed to delete the SHM file, report why. # tputs $::test_channel [appendArgs \ "==== WARNING: failed to delete SHM file \"" $shmFileName \ "\" during cleanup, error: " \n\t $error \n] set success false } # # NOTE: Attempt to delete the test database file now. # if {[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] set success false } } else { # # NOTE: Show that we skipped deleting the file. # tputs $::test_channel [appendArgs \ "==== WARNING: skipped deleting database file \"" $fileName \ "\" during cleanup\n"] } } return [expr {$success ? 0 : 1}] } 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 saveEagleShellEnvironment {} { upvar 1 savedEnv savedEnv saveEnvironmentVariables [list NoMutexes] savedEnv } proc restoreEagleShellEnvironment {} { upvar 1 savedEnv savedEnv restoreEnvironmentVariables [list NoMutexes] savedEnv } proc saveMdaConfigEnvironment {} { upvar 1 savedEnv savedEnv saveEnvironmentVariables [list COMPLUS_MDA] savedEnv } proc restoreMdaConfigEnvironment {} { upvar 1 savedEnv savedEnv restoreEnvironmentVariables [list COMPLUS_MDA] savedEnv } proc saveGetSettingValueEnvironment {} { upvar 1 savedEnv savedEnv saveEnvironmentVariables [list \ No_Expand No_SQLiteGetSettingValue No_SQLiteXmlConfigFile] \ savedEnv } proc restoreGetSettingValueEnvironment {} { upvar 1 savedEnv savedEnv restoreEnvironmentVariables [list \ No_Expand No_SQLiteGetSettingValue No_SQLiteXmlConfigFile] \ savedEnv } proc saveSQLiteConnectionEnvironment {} { upvar 1 savedEnv savedEnv saveEnvironmentVariables [list \ DefaultFlags_SQLiteConnection No_SQLiteConnectionNewParser] \ savedEnv upvar 1 savedConnectionFlags savedConnectionFlags if {[info exists ::connection_flags]} then { set savedConnectionFlags $::connection_flags } else { unset -nocomplain savedConnectionFlags } } proc restoreSQLiteConnectionEnvironment {} { upvar 1 savedEnv savedEnv restoreEnvironmentVariables [list \ DefaultFlags_SQLiteConnection No_SQLiteConnectionNewParser] \ savedEnv upvar 1 savedConnectionFlags savedConnectionFlags if {[info exists savedConnectionFlags]} then { set ::connection_flags $savedConnectionFlags unset -nocomplain savedConnectionFlags } else { unset -nocomplain ::connection_flags } } 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 { if {!$quiet} then { 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 { if {!$quiet} 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 { if {!$quiet} then { 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 blobCount] { 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 { if {!$quiet} then { 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 getSettingReadCount { name {viaFile false} } { if {[haveConstraint buildConfiguration.Debug] && [catch { object invoke -flags +NonPublic -alias \ System.Data.SQLite.DebugData GetSettingReadCounts $viaFile } settingReadCounts] == 0} then { if {[string length $name] > 0} then { if {[$settingReadCounts TryGetValue $name value]} then { tputs $::test_channel [appendArgs \ "---- setting \"" $name "\" was read " $value " times" \ [expr {$viaFile ? " from the configuration file" : ""}] \n] return $value } } else { set nameCount [$settingReadCounts Count] set valueCount 0 object foreach -alias pair $settingReadCounts { incr valueCount [$pair Value] tputs $::test_channel [appendArgs \ "---- setting \"" [$pair Key] "\" was read " [$pair Value] \ " times" [expr {$viaFile ? " from the configuration file" : \ ""}] \n] } return [list $nameCount $valueCount] } } if {[string length $name] > 0} then { tputs $::test_channel [appendArgs \ "---- setting \"" $name "\" was not read" [expr {$viaFile ? \ " from the configuration file" : ""}] \n] } else { tputs $::test_channel [appendArgs \ "---- no settings were read" [expr {$viaFile ? \ " from the configuration file" : ""}] \n] } return -1 } proc getOtherCount { name } { if {[haveConstraint buildConfiguration.Debug] && [catch { object invoke -flags +NonPublic -alias \ System.Data.SQLite.DebugData GetOtherCounts } otherCounts] == 0} then { if {[string length $name] > 0} then { if {[$otherCounts TryGetValue $name value]} then { tputs $::test_channel [appendArgs \ "---- other counter \"" $name "\" has value " $value \n] return $value } } else { set nameCount [$otherCounts Count] set valueCount 0 object foreach -alias pair $otherCounts { incr valueCount [$pair Value] tputs $::test_channel [appendArgs \ "---- other counter \"" [$pair Key] "\" has value " \ [$pair Value] \n] } return [list $nameCount $valueCount] } } if {[string length $name] > 0} then { tputs $::test_channel [appendArgs \ "---- other counter \"" $name "\" has no value\n"] } else { tputs $::test_channel "---- there are no other counters\n" } return -1 } proc reportSQLiteResources { channel {quiet false} {reset true} {collect true} } { # # NOTE: If possible, always reset the cached assembly directory # and the cached XML configuration file name. # if {[haveSQLiteObjectCommand]} then { if {[catch { object invoke -flags +NonPublic \ System.Data.SQLite.UnsafeNativeMethods \ ResetCachedAssemblyDirectory } error] == 0} then { if {!$quiet} then { tputs $channel "---- reset cached assembly directory\n" } } else { if {!$quiet} then { tputs $channel [appendArgs \ "==== WARNING: failed to reset cached assembly directory, " \ "error: " \n\t $error \n] } } if {[catch { object invoke -flags +NonPublic \ System.Data.SQLite.UnsafeNativeMethods \ ResetCachedXmlConfigFileName } error] == 0} then { if {!$quiet} then { tputs $channel "---- reset cached XML configuration file name\n" } } else { if {!$quiet} then { tputs $channel [appendArgs \ "==== WARNING: failed to reset cached XML configuration " \ "file name, error: " \n\t $error \n] } } } # # NOTE: If available, report on (and possibly reset) the runtime # configuration statistics. # if {[haveSQLiteObjectCommand] && \ [haveConstraint buildConfiguration.Debug]} then { if {[catch { object invoke -flags +NonPublic -alias \ System.Data.SQLite.DebugData GetSettingReadCounts false } 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 { object invoke -flags +NonPublic -alias \ System.Data.SQLite.DebugData ClearSettingReadCounts false } error] == 0} then { if {!$quiet} then { tputs $channel [appendArgs \ "---- reset setting statistics for the previous " \ $nameCount " names and " $valueCount " values read\n"] } } else { if {!$quiet} then { tputs $channel [appendArgs \ "==== WARNING: failed to reset setting statistics for " \ "the previous " $nameCount " names and " $valueCount \ " values read, error: " \n\t $error \n] } } } } if {[catch { object invoke -flags +NonPublic -alias \ System.Data.SQLite.DebugData GetSettingReadCounts true } settingFileReadCounts] == 0} then { set nameCount [$settingFileReadCounts Count] set valueCount 0 object foreach -alias pair $settingFileReadCounts { incr valueCount [$pair Value] if {!$quiet} then { tputs $channel [appendArgs \ "---- setting \"" [$pair Key] "\" was read " \ [$pair Value] " times from the configuration file\n"] } } if {$reset} then { if {[catch { object invoke -flags +NonPublic -alias \ System.Data.SQLite.DebugData ClearSettingReadCounts true } error] == 0} then { if {!$quiet} then { tputs $channel [appendArgs \ "---- reset setting statistics for the previous " \ $nameCount " names and " $valueCount " values read " \ "from the configuration file\n"] } } else { if {!$quiet} then { tputs $channel [appendArgs \ "==== WARNING: failed to reset setting statistics for " \ "the previous " $nameCount " names and " $valueCount \ " values read from the configuration file, error: " \n\t \ $error \n] } } } } if {[catch { object invoke -flags +NonPublic -alias \ System.Data.SQLite.DebugData GetOtherCounts } otherCounts] == 0} then { set nameCount [$otherCounts Count] set valueCount 0 object foreach -alias pair $otherCounts { incr valueCount [$pair Value] if {!$quiet} then { tputs $channel [appendArgs \ "---- other counter \"" [$pair Key] "\" has value " \ [$pair Value] \n] } } if {$reset} then { if {[catch { object invoke -flags +NonPublic -alias \ System.Data.SQLite.DebugData ClearOtherCounts } error] == 0} then { if {!$quiet} then { tputs $channel [appendArgs \ "---- reset other counters for the previous " \ $nameCount " names and " $valueCount " values\n"] } } else { if {!$quiet} then { tputs $channel [appendArgs \ "==== WARNING: failed to reset other counters for " \ "the previous " $nameCount " names and " $valueCount \ " values, 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 resetSQLiteDirectories { channel native } { # # NOTE: Attempt to use the native API (via the managed assembly)? # if {$native} 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 { # # 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] } } } } 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 { resetSQLiteDirectories $channel true } } 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 { resetSQLiteDirectories $channel false } } # # 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 copySampleDatabaseFiles {} { uplevel 1 { # # NOTE: Copy (or re-copy) the reference database file used for this # unit test to the build directory in case it has been changed # by a previous test run. # file copy -force $northwindEfDbFile \ [file join [getBuildDirectory true] [file tail $northwindEfDbFile]] } } proc moveTestLogFile { path } { if {[info exists ::test_log] && [file exists $::test_log]} then { set old_test_log $::test_log set new_test_log [file join $path [file tail $old_test_log]] file copy $old_test_log $new_test_log; file delete $old_test_log set ::test_log $new_test_log if {[info exists ::test_log_path]} then { set ::test_log_path $path } tputs $::test_channel [appendArgs \ "---- moved test log from \"" $old_test_log "\" to \"" \ $new_test_log \"\n] } } proc showSQLiteBuildParameters { channel } { # # NOTE: Check if the native build flag has been forcibly set. # tputs $channel \ "---- checking for System.Data.SQLite build native override... " set native [getBuildNative] if {[string length $native] > 0} then { addConstraint [appendArgs buildNative. $native] tputs $channel [appendArgs \" $native \"\n] } else { addConstraint buildNative.none tputs $channel \n } # # 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 $channel \ "---- checking for System.Data.SQLite build year... " set year [getBuildYear] if {[string length $year] > 0} then { addConstraint [appendArgs buildYear. $year] tputs $channel [appendArgs \" $year \"\n] } else { addConstraint buildYear.none tputs $channel \n } tputs $channel \ "---- checking for System.Data.SQLite build native year... " set year [getBuildNativeYear] if {[string length $year] > 0} then { addConstraint [appendArgs buildNativeYear. $year] tputs $channel [appendArgs \" $year \"\n] } else { addConstraint buildNativeYear.none tputs $channel \n } tputs $channel \ "---- checking for System.Data.SQLite build platform... " set platform [getBuildPlatform true] if {[string length $platform] > 0} then { addConstraint [appendArgs buildPlatform. $platform] tputs $channel [appendArgs \" $platform \"\n] } else { addConstraint buildPlatform.none tputs $channel \n } set architecture [architectureForPlatform $platform] tputs $channel \ "---- checking for System.Data.SQLite build architecture... " if {[string length $architecture] > 0} then { addConstraint [appendArgs buildArchitecture. $architecture] tputs $channel [appendArgs \" $architecture \"\n] } else { addConstraint buildArchitecture.none tputs $channel \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 $channel \ "---- checking for System.Data.SQLite build .NET Framework... " set netFx [getBuildNetFx] if {[string length $netFx] > 0} then { addConstraint [appendArgs buildFramework. $netFx] tputs $channel [appendArgs \" $netFx \"\n] } else { addConstraint buildFramework.none tputs $channel \n } # # NOTE: Check the current build configuration. This should normally # be either "Debug" or "Release". # tputs $channel \ "---- checking for System.Data.SQLite build configuration... " set configuration [getBuildConfiguration] if {[string length $configuration] > 0} then { addConstraint [appendArgs buildConfiguration. $configuration] tputs $channel [appendArgs \" $configuration \"\n] } else { addConstraint buildConfiguration.none tputs $channel \n } # # NOTE: Check the current build configuration suffix. This will # normally be either "NetStandard20" or an empty string. # tputs $channel \ "---- checking for System.Data.SQLite build configuration suffix... " set suffix [getBuildConfigurationSuffix] if {[string length $suffix] > 0} then { addConstraint [appendArgs buildConfigurationSuffix. $suffix] tputs $channel [appendArgs \" $suffix \"\n] } else { addConstraint buildConfigurationSuffix.none tputs $channel \n } tputs $channel [appendArgs \ "---- checking for System.Data.SQLite build native configuration " \ "suffix... "] set suffix [getBuildNativeConfigurationSuffix] if {[string length $suffix] > 0} then { addConstraint [appendArgs buildNativeConfigurationSuffix. $suffix] tputs $channel [appendArgs \" $suffix \"\n] } else { addConstraint buildNativeConfigurationSuffix.none tputs $channel \n } # # NOTE: Check the current build extra directory. This will normally # be either "netstandard2.0" or an empty string. # tputs $channel \ "---- checking for System.Data.SQLite build extra... " set extra [getBuildExtra] if {[string length $extra] > 0} then { addConstraint [appendArgs buildExtra. $extra] tputs $channel [appendArgs \" $extra \"\n] } else { addConstraint buildExtra.none tputs $channel \n } } proc runSQLiteTestPrologue {} { # # NOTE: Skip running our custom prologue if the main one has been # skipped. # if {![info exists ::no(prologue.eagle)]} then { # # NOTE: Save the environment variables that we intend to change for # the test suite. # saveEnvironmentVariables \ [list Initialize_SQLiteLog] ::testSuiteSavedEnv # # NOTE: Force the managed logging subsystem to attempt to initialize # itself more than once. # set ::env(Initialize_SQLiteLog) 1 # # NOTE: Load the "before-constraints" custom per-user and/or per-host # test settings now. # uplevel 1 [list loadSQLiteTestSettings $::test_channel .before] # # NOTE: Show (and log) the global parameters that control where the # build directory should be. # showSQLiteBuildParameters $::test_channel # # 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: 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 netFx462 netFx45 netFx47 netFx45 \ netFx471 netFx45 netFx472 netFx45 netStandard20 netFx45] \ [getBuildNetFx]]] EntityFramework.dll]] # # NOTE: Build the list of native assembly files that we handle. # set nativeFileNames [list] eval lappend nativeFileNames [getNativeLibraryFileNamesOnly] eval lappend nativeFileNames [getInteropAssemblyFileNamesOnly] # # NOTE: Build the list of mixed-mode assembly files that we handle. # set mixedFileNames [list] if {[hasRuntimeOption native]} then { lappend mixedFileNames System.Data.SQLite.dll } # # NOTE: Build the list of managed assembly files that we handle. # set managedFileNames [list \ System.Data.SQLite.Linq.dll System.Data.SQLite.EF6.dll] if {![hasRuntimeOption native]} then { lappend managedFileNames System.Data.SQLite.dll } # # NOTE: Show the various lists of file names that are handled by this # procedure. # tputs $::test_channel [appendArgs \ "---- list of \"configuration\" file names is: " \ [expr {[llength $configFileNames] > 0 ? $configFileNames : \ ""}] \n] tputs $::test_channel [appendArgs \ "---- list of \"MDA configuration\" file names is: " \ [expr {[llength $mdaConfigFileNames] > 0 ? $mdaConfigFileNames : \ ""}] \n] tputs $::test_channel [appendArgs \ "---- list of \"external\" file names is: " \ [expr {[llength $externalFileNames] > 0 ? $externalFileNames : \ ""}] \n] tputs $::test_channel [appendArgs \ "---- list of \"native\" file names is: " \ [expr {[llength $nativeFileNames] > 0 ? $nativeFileNames : \ ""}] \n] tputs $::test_channel [appendArgs \ "---- list of \"mixed\" file names is: " \ [expr {[llength $mixedFileNames] > 0 ? $mixedFileNames : \ ""}] \n] tputs $::test_channel [appendArgs \ "---- list of \"managed\" file names is: " \ [expr {[llength $managedFileNames] > 0 ? $managedFileNames : \ ""}] \n] # # 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 $mixedFileNames { removeConstraint [appendArgs file_ $fileName] } foreach fileName $managedFileNames { removeConstraint [appendArgs file_ $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: Show (and log) the global parameters that control where # the build directory should be. The auto-selection may # have modified some of these parameters. # showSQLiteBuildParameters $::test_channel } # # 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 true } foreach fileName $externalFileNames { tryDeleteBinaryFile $fileName } } if {![info exists ::no(deleteSqliteNativeFiles)]} then { if {![info exists ::no(deleteSqliteImplicitNativeFiles)]} 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(deleteSqliteMixedFiles)]} then { # # NOTE: If the "native" runtime option is set, delete implicit # mixed-mode assembly files as well. This runtime option # check is handled when building the list of mixed-mode # assembly file names. # if {![info exists ::no(deleteSqliteImplicitMixedFiles)]} then { foreach fileName $mixedFileNames { tryDeleteAssembly $fileName } } if {![info exists ::no(deleteSqliteNonImplicitFiles)]} then { if {![info exists ::no(deleteSqlitePlatformFiles)] && \ [string length $platform] > 0} then { foreach fileName $mixedFileNames { tryDeleteAssembly $fileName $platform } } if {![info exists ::no(deleteSqliteArchitectureFiles)] && \ [string length $architecture] > 0} then { foreach fileName $mixedFileNames { tryDeleteAssembly $fileName $architecture } } } } if {![info exists ::no(deleteSqliteManagedFiles)]} then { foreach fileName $managedFileNames { tryDeleteAssembly $fileName } } } # # NOTE: Show (and log) the global parameters that control where # the build directory should be. # showSQLiteBuildParameters $::test_channel # # 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 directories MUST exist for # the testing process to continue. # set directory [getBuildDirectory false] 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 native 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 native build directory \"" \ $directory "\", all testing halted"] } set directory [getBuildDirectory true] 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 managed 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 managed build directory \"" \ $directory "\", all testing halted"] } set logDirectory $directory } else { set logDirectory [getBuildDirectory true] } # # NOTE: We're going to move the test log file to the directory # containing the managed assemblies being tested. # moveTestLogFile $logDirectory # # NOTE: Skip trying to copy any files if instructed. # if {![info exists ::no(copySqliteFiles)]} then { if {![info exists ::no(copySqliteConfigFiles)]} then { tputs $::test_channel \ "---- copying \"configuration\" files...\n" foreach fileName $configFileNames { tryCopyBuildFile $fileName true } } 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. # tputs $::test_channel \ "---- copying \"MDA configuration\" files...\n" foreach fileName $mdaConfigFileNames { tryCopyBinaryFile EagleShell.exe.mda.config true "" $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. # tputs $::test_channel "---- copying \"external\" files...\n" 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(copySqliteImplicitNativeFiles)] && \ [isDefaultBuildPlatform]} then { tputs $::test_channel \ "---- copying implicit \"native\" files...\n" foreach fileName $nativeFileNames { tryCopyAssembly $fileName false } } if {![info exists ::no(copySqliteNonImplicitFiles)]} then { if {![info exists ::no(copySqlitePlatformFiles)] && \ [string length $platform] > 0} then { tputs $::test_channel [appendArgs \ "---- copying \"native\" files for platform \"" \ $platform \"...\n] foreach fileName $nativeFileNames { tryCopyAssembly $fileName false $platform } } if {![info exists ::no(copySqliteArchitectureFiles)] && \ [string length $architecture] > 0} then { tputs $::test_channel [appendArgs \ "---- copying \"native\" files for architecture \"" \ $architecture \"...\n] foreach fileName $nativeFileNames { tryCopyAssembly $fileName false $architecture } } if {![info exists ::no(copySqliteForcedNativeFiles)] && \ [getBuildNative]} then { tputs $::test_channel \ "---- copying forced \"native\" files...\n" foreach fileName $nativeFileNames { tryCopyAssembly $fileName false } } } } if {![info exists ::no(copySqliteMixedFiles)]} then { # # NOTE: If the "native" runtime option is set, copy implicit # mixed-mode assembly files as well. The runtime option # check is handled when building the list of mixed-mode # assembly file names. # if {![info exists ::no(copySqliteImplicitMixedFiles)]} then { tputs $::test_channel \ "---- copying implicit \"mixed\" files...\n" foreach fileName $mixedFileNames { tryCopyAssembly $fileName false } } if {![info exists ::no(copySqliteNonImplicitFiles)]} then { if {![info exists ::no(copySqlitePlatformFiles)] && \ [string length $platform] > 0} then { tputs $::test_channel [appendArgs \ "---- copying \"mixed\" files for platform \"" \ $platform \"...\n] foreach fileName $mixedFileNames { tryCopyAssembly $fileName false $platform } } if {![info exists ::no(copySqliteArchitectureFiles)] && \ [string length $architecture] > 0} then { tputs $::test_channel [appendArgs \ "---- copying \"mixed\" files for architecture \"" \ $architecture \"...\n] foreach fileName $mixedFileNames { tryCopyAssembly $fileName false $architecture } } if {![info exists ::no(copySqliteForcedMixedFiles)] && \ [getBuildNative]} then { tputs $::test_channel \ "---- copying forced \"mixed\" files...\n" foreach fileName $mixedFileNames { tryCopyAssembly $fileName false } } } } if {![info exists ::no(copySqliteManagedFiles)]} then { tputs $::test_channel "---- copying \"managed\" files...\n" foreach fileName $managedFileNames { tryCopyAssembly $fileName true } } } # # 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 $nativeFileNames { catch { tputs $::test_channel [appendArgs \ "---- file version of \"" native/ $fileNameOnly \ "\"... \"" [file version [getBinaryFileName \ $fileNameOnly]] \"\n] } } foreach fileNameOnly $mixedFileNames { catch { tputs $::test_channel [appendArgs \ "---- file version of \"" mixed/ $fileNameOnly \ "\"... \"" [file version [getBinaryFileName \ $fileNameOnly]] \"\n] } } foreach fileNameOnly $managedFileNames { catch { tputs $::test_channel [appendArgs \ "---- file version of \"" managed/ $fileNameOnly \ "\"... \"" [file version [getBinaryFileName \ $fileNameOnly]] \"\n] } } if {[string length $platform] > 0} then { foreach fileNameOnly $nativeFileNames { catch { tputs $::test_channel [appendArgs \ "---- file version of \"" native/platform/ \ $platform / $fileNameOnly "\"... \"" [file \ version [getBinaryFileName $fileNameOnly \ $platform]] \"\n] } } foreach fileNameOnly $mixedFileNames { catch { tputs $::test_channel [appendArgs \ "---- file version of \"" mixed/platform/ \ $platform / $fileNameOnly "\"... \"" [file \ version [getBinaryFileName $fileNameOnly \ $platform]] \"\n] } } } if {[string length $architecture] > 0} then { foreach fileNameOnly $nativeFileNames { catch { tputs $::test_channel [appendArgs \ "---- file version of \"" native/architecture/ \ $architecture / $fileNameOnly "\"... \"" [file \ version [getBinaryFileName $fileNameOnly \ $architecture]] \"\n] } } foreach fileNameOnly $mixedFileNames { catch { tputs $::test_channel [appendArgs \ "---- file version of \"" mixed/architecture/ \ $architecture / $fileNameOnly "\"... \"" [file \ version [getBinaryFileName $fileNameOnly \ $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 { if {[catch { object invoke Utility GetAssemblies } assemblies] == 0 || [catch { object invoke AppDomain.CurrentDomain GetAssemblies } assemblies] == 0} then { 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] ] \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: Reset cached "break into debugger" setting so that it can be # used during the test file, if needed. # if {![info exists ::no(resetBreakIntoDebugger)] && \ [haveSQLiteObjectCommand]} then { if {[catch { object invoke -flags +NonPublic \ System.Data.SQLite.HelperMethods ResetBreakIntoDebugger } result] == 0} then { tputs $::test_channel [appendArgs \ "---- call ResetBreakIntoDebugger()... ok\n"] } else { tputs $::test_channel [appendArgs \ "---- call ResetBreakIntoDebugger()... error: " \ \n\t $result \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_SESSION_EXTENSION \ INTEROP_SHA1_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_462 NET_47 NET_471 NET_472 NET_COMPACT_20 NET_STANDARD_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: Attempt to determine if various compile-time options needed for # test constraints were enabled for the interop assembly and/or # for the SQLite core library. # foreach compileOption [list \ CODEC EXTENSION_FUNCTIONS HAS_CODEC INCLUDE_CEROD INCLUDE_EXTRA \ INCLUDE_SEE INCLUDE_ZIPVFS JSON1_EXTENSION LEGACY_CLOSE LOG \ PERCENTILE_EXTENSION REGEXP_EXTENSION SESSION_EXTENSION \ SHA1_EXTENSION TEST_EXTENSION TOTYPE_EXTENSION VIRTUAL_TABLE] { # # NOTE: Check if the compile-time option is listed in the list # kept track of by the interop assembly and/or the SQLite # core library. # checkForSQLiteCompileOption $::test_channel $compileOption } # # 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: Now check if the interop assembly was also compiled with # support for encrypted databases. # if {[haveSQLiteCompileOption CODEC] || \ [haveSQLiteCompileOption INCLUDE_SEE]} then { # # NOTE: Finally, check if the SQLite core library was compiled # with support for encrypted databases. # if {[haveSQLiteCompileOption HAS_CODEC]} then { # # NOTE: Yes, add constraint for use by the test suite. # addConstraint System.Data.SQLite.Encryption } } } # # 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] ] \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] ] \n] } else { tputs $::test_channel unknown\n } } # # NOTE: Show the active test constraints. # tputs $::test_channel [appendArgs "---- constraints: " \ [formatList [lsort [getConstraints]] ] \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 {} { # # NOTE: Skip running our custom files prologue if the main one has been # skipped. # if {![info exists ::no(prologue.eagle)]} then { 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 true] set installerExeFile \ [getBuildFileName Installer.exe true] set sqliteDesignerDllFile \ [getBuildFileName SQLite.Designer.dll true] set systemDataSQLiteDllFile \ [getBuildFileName System.Data.SQLite.dll true] set systemDataSQLiteLinqDllFile \ [getBuildFileName System.Data.SQLite.Linq.dll true] set systemDataSQLiteEf6DllFile \ [getBuildFileName System.Data.SQLite.EF6.dll true] set testExeFile [getBuildFileName test.exe true] set testLinqExeFile [getBuildFileName testlinq.exe true] set testEf6ExeFile [getBuildFileName testef6.exe true] # # 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 testInstallVs2017LogFile [file nativename [file join \ [getSQLiteTestDataPath] Installer_Test_Vs2017.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]] set testUninstallVs2017LogFile [file nativename [file join \ [getSQLiteTestDataPath] Uninstaller_Test_Vs2017.log]] ##################################################################### if {![info exists ::no(checkForSqliteFiles)]} then { 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 $testInstallVs2017LogFile]]]} then { checkForFile $test_channel $testInstallVs2017LogFile } 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 } if {![haveConstraint [appendArgs file_ \ [file tail $testUninstallVs2017LogFile]]]} then { checkForFile $test_channel $testUninstallVs2017LogFile } } } } } proc runSQLiteTestFilesEpilogue {} { # # NOTE: Skip running our custom files epilogue if the main one has been # skipped. # if {![info exists ::no(epilogue.eagle)]} then { uplevel 1 { unset -nocomplain \ testUninstallVs2017LogFile testUninstallVs2015LogFile \ testUninstallVs2013LogFile testUninstallVs2012LogFile \ testUninstallVs2010LogFile testUninstallVs2008LogFile \ testUninstallVs2005LogFile testInstallVs2017LogFile \ 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 } # # NOTE: Restore the previously saved environment variables that we # changed for the test suite. # restoreEnvironmentVariables \ [list Initialize_SQLiteLog] ::testSuiteSavedEnv } } ########################################################################### ############################# 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 }