System.Data.SQLite
Artifact Content
Not logged in

Artifact 2d082622874c4b686b28de5f04c24c7c634cf89e:


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

#
# STUB: This script file is a placeholder.  This file, when present, is always
#       evaluated when an interpreter is initialized.  Vendors distributing
#       Eagle can place custom application-specific, interpreter-specific
#       initialization and/or customizations in here.  Additionally, this file
#       may contain per-interpreter customizations required when porting to
#       new platforms, operating systems, etc.
#

###############################################################################
############################## BEGIN VENDOR CODE ##############################
###############################################################################
#
# 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 {
    proc checkForTestOverrides { channel varNames quiet } {
      set result 0

      foreach varName $varNames {
        if {![uplevel 1 [list info exists $varName]]} then {
          continue
        }

        incr result

        if {!$quiet} then {
          catch {
            tqputs $channel [appendArgs \
                "---- found vendor-specific test override \"" $varName \
                "\" with value \"" [uplevel 1 [list set $varName]] \"\n]
          }
        }
      }

      #
      # NOTE: Keep track of the list of test override variables, for later
      #       use by the test suite.  This needs to be done after the loop
      #       above because the variable used to keep track is listed with
      #       the other possible test override variables.
      #
      if {![uplevel 1 [list info exists test_overrides]]} then {
        uplevel 1 [list set test_overrides $varNames]
      }

      return $result
    }

    proc refreshAutoPath {} {
      if {[llength [info commands debug]] > 0 && \
          [llength [info subcommands debug refreshautopath]] > 0 && \
          [catch {debug refreshautopath true}] == 0} then {
        return debug
      }

      if {[llength [info commands object]] > 0 && \
          [catch {object invoke Utility RefreshAutoPathList true}] == 0} then {
        return object
      }

      return ""
    }

    proc addTestSuiteToAutoPath { channel varName quiet } {
      #
      # NOTE: Start with the directory containing this file.
      #
      set dir [file normalize [file dirname [info script]]]

      #
      # NOTE: Keep going until the directory name is empty OR is actually the
      #       root of the associated volume.
      #
      while {[string length $dir] > 0 && \
          [lsearch -exact -nocase -- [file volumes] $dir] == -1} {
        #
        # NOTE: Set the sub-directory where the package index file should
        #       be located within the directory to be searched.
        #
        set dir2 [file join lib System.Data.SQLite]

        #
        # NOTE: Does this directory have the necessary sub-directory that
        #       contains a package index file?
        #
        if {[file exists [file join $dir $dir2]] && \
            [file isdirectory [file join $dir $dir2]] && \
            [file exists [file join $dir $dir2 pkgIndex.eagle]] && \
            [file isfile [file join $dir $dir2 pkgIndex.eagle]]} then {
          #
          # NOTE: If requested, give our caller access to the name of the
          #       directory we just found.
          #
          if {[string length $varName] > 0} then {
            upvar 1 $varName dir3
          }

          #
          # NOTE: Ok, show the directory we found.
          #
          set dir3 [file join $dir $dir2]

          #
          # NOTE: We found the necessary directory to add to the auto-path;
          #       However, we cannot simply add it to the auto-path directly
          #       because the auto-path is dynamically constructed after this
          #       script is evaluated; therefore, set the Eagle library path
          #       environment variable and force the appropriate internal path
          #       list to be refreshed.
          #
          if {![info exists ::env(EAGLELIBPATH)] || \
              [lsearch -exact $::env(EAGLELIBPATH) $dir3] == -1} then {
            #
            # NOTE: If we have NOT been instructed to be quiet, report now.
            #
            if {!$quiet} then {
              catch {
                tqputs $channel [appendArgs \
                    "---- found vendor-specific test package directory \"" \
                    $dir3 "\", adding...\n"]
              }
            }

            #
            # NOTE: Append the directory to the necessary environment variable
            #       so that it will get picked up when Eagle actually rebuilds
            #       the auto-path list (below).
            #
            lappend ::env(EAGLELIBPATH) $dir3

            #
            # NOTE: Attempt to force Eagle to rebuild the auto-path for the
            #       current interpreter right now.
            #
            set refresh [refreshAutoPath]

            if {[string length $refresh] == 0} then {
              #
              # NOTE: Ok, maybe the [object] command is not available.  Rescan
              #       the package indexes using the [package scan] sub-command
              #       in that case.  The directories within EAGLELIBPATH will
              #       not be added to the auto-path; however, all the package
              #       indexes and their associated packages will be available.
              #
              if {!$quiet} then {
                catch {
                  tqputs $channel [appendArgs \
                      "---- unable to forcibly refresh auto-path list, " \
                      "scanning \"" $::env(EAGLELIBPATH) "\" instead...\n"]
                }
              }

              #
              # NOTE: In theory, this call to the [package scan] sub-command
              #       could fail, raising a script error here; however, that
              #       is highly unlikely.
              #
              eval package scan -host -normal -refresh -- $::env(EAGLELIBPATH)
            } else {
              if {!$quiet} then {
                catch {
                  tqputs $channel [appendArgs \
                      "---- forcibly refreshed auto-path list via \"" \
                      $refresh "\" command\n"]
                }
              }
            }
          }

          #
          # NOTE: We are done, return success.
          #
          return true
        }

        #
        # NOTE: Keep going up the directory tree...
        #
        set dir [file dirname $dir]
      }

      #
      # NOTE: If we have NOT been instructed to be quiet, report now.
      #
      if {!$quiet} then {
        catch {
          tqputs $channel \
              "---- could not find vendor-specific test package directory\n"
        }
      }

      #
      # NOTE: Directory not found, return failure.
      #
      return false
    }

    proc findInterpreterTestPath { channel dir varName quiet } {
      #
      # NOTE: Start with the specified directory.
      #
      set dir2 $dir

      #
      # NOTE: Keep going until the directory name is empty OR is actually the
      #       root of the associated volume.
      #
      while {[string length $dir2] > 0 && \
          [lsearch -exact -nocase -- [file volumes] $dir2] == -1} {
        #
        # NOTE: Set the sub-directory where the test suite file should be
        #       located within the directory to be searched.
        #
        set dir3 Tests

        #
        # NOTE: Does this directory have the necessary sub-directory that
        #       contains the test suite file?
        #
        if {[file exists [file join $dir2 $dir3]] && \
            [file isdirectory [file join $dir2 $dir3]] && \
            [file exists [file join $dir2 $dir3 all.eagle]] && \
            [file isfile [file join $dir2 $dir3 all.eagle]]} then {
          #
          # NOTE: If requested, give our caller access to the name of the
          #       directory we just found.
          #
          if {[string length $varName] > 0} then {
            upvar 1 $varName dir4
          }

          #
          # NOTE: Ok, show the directory we found.
          #
          set dir4 [file join $dir2 $dir3]

          #
          # NOTE: If we have NOT been instructed to be quiet, report now.
          #
          if {!$quiet} then {
            catch {
              tqputs $channel [appendArgs \
                  "---- found vendor-specific test suite directory \"" \
                  $dir4 \"\n]
            }
          }

          #
          # NOTE: We are done, return success.
          #
          return true
        }

        #
        # NOTE: Keep going up the directory tree...
        #
        set dir2 [file dirname $dir2]
      }

      #
      # NOTE: If we have NOT been instructed to be quiet, report now.
      #
      if {!$quiet} then {
        catch {
          tqputs $channel \
              "---- could not find vendor-specific test suite directory\n"
        }
      }

      #
      # NOTE: Directory not found, return failure.
      #
      return false
    }

    proc setupInterpreterTestPath { channel dir quiet } {
      if {[llength [info commands debug]] > 0 && \
          [llength [info subcommands debug testpath]] > 0 && \
          [catch {debug testpath} testPath] == 0} then {
        if {$dir ne $testPath} then {
          debug testpath $dir

          if {!$quiet} then {
            catch {
              tqputs $channel [appendArgs \
                  "---- set interpreter test path to \"" $dir \
                  "\" via \"debug\" command\n"]
            }
          }
        }
      } elseif {[llength [info commands object]] > 0 && [catch {
        object invoke -flags +NonPublic Interpreter.GetActive TestPath
      } testPath] == 0} then {
        if {$dir ne $testPath} then {
          object invoke -flags +NonPublic Interpreter.GetActive TestPath $dir

          if {!$quiet} then {
            catch {
              tqputs $channel [appendArgs \
                  "---- set interpreter test path to \"" $dir \
                  "\" via \"object\" command\n"]
            }
          }
        }
      } else {
        if {!$quiet} then {
          catch {
            tqputs $channel "---- cannot set interpreter test path\n"
          }
        }
      }
    }

    #
    # NOTE: Check for any overridden settings that may have been specified via
    #       the command line, etc.
    #
    checkForTestOverrides stdout [expr {[info exists test_overrides] ? \
        $test_overrides : [list binary_directory build_base_directory \
        build_directory common_directory connection_flags database_directory \
        datetime_format define_constant_prefix execute_on_setup \
        interop_assembly_file_names native_library_file_names release_version \
        scratch_directory temporary_directory test_clr test_clr_v2 \
        test_clr_v4 test_configuration test_configurations test_constraints \
        test_machine test_net_fx test_net_fx_2005 test_net_fx_2008 \
        test_net_fx_2010 test_net_fx_2012 test_net_fx_2013 test_net_fx_2015 \
        test_overrides test_platform test_suite test_year test_years \
        test_year_clr_v2 test_year_clr_v4 vendor_directory \
        vendor_test_directory]}] false

    #
    # NOTE: Set the name of the running test suite, if necessary.
    #
    if {![info exists test_suite]} then {
      set test_suite "System.Data.SQLite Test Suite for Eagle"
    }

    #
    # NOTE: When being evaluated in a "safe" interpreter, some steps must be
    #       skipped due to missing commands and/or sub-commands.
    #
    if {![interp issafe]} then {
      #
      # NOTE: This variable will contain the name of the directory containing
      #       the vendor-specific testing infrastructure.  If the variable does
      #       not exist, create it; otherwise, it has been overridden and the
      #       existing value should be left intact.
      #
      set have_vendor_directory [info exists vendor_directory]

      if {!$have_vendor_directory} then {
        set vendor_directory ""
      }

      #
      # NOTE: This variable will contain the name of the directory containing
      #       the vendor-specific test suite.  If the variable does not exist,
      #       create it; otherwise, it has been overridden and the existing
      #       value should be left intact.
      #
      set have_vendor_test_directory [info exists vendor_test_directory]

      if {!$have_vendor_test_directory} then {
        set vendor_test_directory ""
      }

      #
      # NOTE: This procedure will attempt to find the vendor-specific testing
      #       infrastructure directory and add it to the auto-path for the
      #       current interpreter.  Normally, this will also set the variable
      #       created above to point to the directory added to the auto-path;
      #       however, this will not be done if the variable was not created
      #       by us.
      #
      addTestSuiteToAutoPath stdout \
          [expr {$have_vendor_directory ? "" : "vendor_directory"}] \
          [info exists ::env(quietAddTestSuiteToAutoPath)]

      unset have_vendor_directory

      #
      # NOTE: This procedure will attempt to find the vendor-specific testing
      #       directory.  Normally, this will also set the variable created
      #       above to point to the directory; however, this will not be done
      #       if the variable was not created by us.
      #
      findInterpreterTestPath stdout $vendor_directory \
          [expr {$have_vendor_test_directory ? "" : "vendor_test_directory"}] \
          [info exists ::env(quietFindInterpreterTestPath)]

      unset have_vendor_test_directory

      #
      # NOTE: If we actually found a vendor-specific testing infrastructure
      #       directory then modify the TestPath property of the current
      #       interpreter to point directly to it.
      #
      if {[string length $vendor_test_directory] > 0} then {
        setupInterpreterTestPath stdout $vendor_test_directory [info exists \
            ::env(quietSetupInterpreterTestPath)]
      }
    }

    #
    # HACK: Prevent the Eagle core test suite infrastructure from checking
    #       test constraints that are time-consuming and/or most likely to
    #       be superfluous to third-party test suites (i.e. those that are
    #       not testing the Eagle core library itself).
    #
    set no(core) 1

    #
    # NOTE: Make the per-test connection flag output a little less noisy.
    #
    set no(emitLocalFlagsIfNone) 1
    set no(emitSharedFlagsIfNone) 1
    set no(emitGlobalFlagsIfNone) 1
    set no(emitCombinedFlagsIfNone) 1
  }
}

###############################################################################
############################### END VENDOR CODE ###############################
###############################################################################