System.Data.SQLite
Check-in [ecd546a7a7]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Update Eagle in externals to the pre-beta 34 release code.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: ecd546a7a7f0066aaac641272dc63ee9e12ca70e
User & Date: mistachkin 2015-08-15 06:38:07
Context
2015-08-15
17:08
Compilation fixes for the debug build. check-in: 8195809af1 user: mistachkin tags: trunk
06:38
Update Eagle in externals to the pre-beta 34 release code. check-in: ecd546a7a7 user: mistachkin tags: trunk
2015-08-14
03:44
Fix help description of the 'Cache Size' connection string property. check-in: 5e16011b0c user: mistachkin tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to Externals/Eagle/bin/Eagle.dll.

cannot compute difference between binary files

Changes to Externals/Eagle/bin/EagleShell.exe.

cannot compute difference between binary files

Changes to Externals/Eagle/bin/EagleShell32.exe.

cannot compute difference between binary files

Changes to Externals/Eagle/bin/x64/Spilornis.dll.

cannot compute difference between binary files

Changes to Externals/Eagle/bin/x86/Spilornis.dll.

cannot compute difference between binary files

Changes to Externals/Eagle/lib/Eagle1.0/init.eagle.

  2033   2033         if {[llength $args] > 2} then {
  2034   2034           error "wrong # args: should be \"parray a ?pattern?\""
  2035   2035         }
  2036   2036   
  2037   2037         upvar 1 $a array
  2038   2038   
  2039   2039         if {![array exists array]} {
  2040         -        error "\"$a\" isn't an array"
         2040  +        error [appendArgs \" $a "\" isn't an array"]
  2041   2041         }
  2042   2042   
  2043   2043         set names [lsort [eval array names array $args]]
  2044   2044         set maxLength 0
  2045   2045   
  2046   2046         foreach name $names {
  2047   2047           set length [string length $name]
................................................................................
  2154   2154           # NOTE: Old style test, use [test1] command.
  2155   2155           #
  2156   2156           set command test1
  2157   2157         }
  2158   2158   
  2159   2159         return [uplevel 1 [list $command $name $description] $args]
  2160   2160       }
         2161  +
         2162  +    proc isObjectHandle { value } {
         2163  +      set pattern [string map [list \\ \\\\ \[ \\\[ \] \\\]] $value]
         2164  +      set objects [info objects $pattern]
         2165  +
         2166  +      if {[llength $objects] == 1 && [lindex $objects 0] eq $value} then {
         2167  +        return true
         2168  +      }
         2169  +
         2170  +      return false
         2171  +    }
         2172  +
         2173  +    proc isManagedType { name } {
         2174  +      if {[llength [info commands object]] > 0} then {
         2175  +        if {![isObjectHandle $name]} then {
         2176  +          if {[catch {
         2177  +            object members -matchnameonly -nameonly -pattern Equals $name
         2178  +          } result] == 0 && $result eq "Equals"} then {
         2179  +            return true
         2180  +          }
         2181  +        }
         2182  +      }
         2183  +
         2184  +      return false
         2185  +    }
         2186  +
         2187  +    proc canGetManagedType { name {varName ""} } {
         2188  +      if {[llength [info commands object]] > 0} then {
         2189  +        if {![isObjectHandle $name]} then {
         2190  +          set cultureInfo [object invoke Interpreter.GetActive CultureInfo]
         2191  +          set type null
         2192  +
         2193  +          set code [object invoke -create -alias -flags +NonPublic \
         2194  +              Value GetType "" $name null null None $cultureInfo type]
         2195  +
         2196  +          if {[$code ToString] eq "Ok"} then {
         2197  +            if {[string length $varName] > 0} then {
         2198  +              upvar 1 $varName typeName
         2199  +            }
         2200  +
         2201  +            set typeName [$type AssemblyQualifiedName]
         2202  +
         2203  +            if {[isManagedType $typeName]} then {
         2204  +              return true
         2205  +            }
         2206  +          }
         2207  +        }
         2208  +      }
         2209  +
         2210  +      return false
         2211  +    }
         2212  +
         2213  +    proc unknownObjectInvoke { level name args } {
         2214  +      #
         2215  +      # NOTE: This is an [unknown] procedure that attempts to lookup the
         2216  +      #       name as a CLR type and then attempts to use [object invoke]
         2217  +      #       with it, merging options and arguments as necessary.
         2218  +      #
         2219  +      if {[llength [info commands object]] > 0 && \
         2220  +          ([isManagedType $name] || [canGetManagedType $name name])} then {
         2221  +        #
         2222  +        # NOTE: Get possible options for the [object invoke] sub-command.
         2223  +        #
         2224  +        set options [object invoke Utility GetInvokeOptions Invoke]
         2225  +
         2226  +        #
         2227  +        # NOTE: Create argument list for the artificial [object invoke]
         2228  +        #       alias.  This always has two arguments.
         2229  +        #
         2230  +        set arguments1 [object create ArgumentList object invoke]
         2231  +
         2232  +        #
         2233  +        # NOTE: Create argument list for the entire command being handled.
         2234  +        #       There may be options right after the command name itself.
         2235  +        #
         2236  +        set arguments2 [eval \
         2237  +            object create ArgumentList [concat [list $name] $args]]
         2238  +
         2239  +        #
         2240  +        # NOTE: Setup output arguments needed for the MergeArguments method.
         2241  +        #
         2242  +        set arguments3 null; set error null
         2243  +
         2244  +        #
         2245  +        # NOTE: Attempt to merge the option and non-option arguments into a
         2246  +        #       single list of arguments.
         2247  +        #
         2248  +        set code [object invoke -alias -flags +NonPublic \
         2249  +            Interpreter.GetActive MergeArguments $options $arguments1 \
         2250  +            $arguments2 2 1 false false arguments3 error]
         2251  +
         2252  +        #
         2253  +        # NOTE: Was the argument merging process successful?
         2254  +        #
         2255  +        if {$code eq "Ok"} then {
         2256  +          #
         2257  +          # NOTE: Jump up from our call frame (and optionally that of our
         2258  +          #       caller) and attempt to invoke the specified static object
         2259  +          #       method with the final list of merged arguments.
         2260  +          #
         2261  +          return [uplevel [expr {$level + 1}] [$arguments3 ToString]]
         2262  +        } else {
         2263  +          #
         2264  +          # NOTE: Failed to merge the arguments, raise an error.
         2265  +          #
         2266  +          error [$error ToString]
         2267  +        }
         2268  +      }
         2269  +
         2270  +      continue; # NOTE: Not handled.
         2271  +    }
  2161   2272   
  2162   2273       proc unknown { name args } {
  2163   2274         #
  2164         -      # NOTE: This is a stub unknown procedure that simply produces an
  2165         -      #       appropriate error message.
         2275  +      # NOTE: This is an [unknown] procedure that normally produces an
         2276  +      #       appropriate error message; however, it can optionally try
         2277  +      #       to invoke a static object method.
  2166   2278         #
  2167   2279         # TODO: Add support for auto-loading packages here in the future?
  2168   2280         #
  2169         -      return -code error "invalid command name \"$name\""
         2281  +      if {[hasRuntimeOption unknownObjectInvoke] && \
         2282  +          [llength [info commands object]] > 0} then {
         2283  +        #
         2284  +        # NOTE: In the context of the caller, attempt to invoke a static
         2285  +        #       object method using the specified arguments (which may
         2286  +        #       contain variable names).
         2287  +        #
         2288  +        if {[catch {
         2289  +          eval unknownObjectInvoke 1 [list $name] $args
         2290  +        } result] == 0} then {
         2291  +          #
         2292  +          # NOTE: The static object method was invoked successfully.
         2293  +          #       Return its result.
         2294  +          #
         2295  +          return -code ok $result
         2296  +        } elseif {[string length $result] > 0} then {
         2297  +          #
         2298  +          # NOTE: Attempting to invoke the static object method raised
         2299  +          #       an error.  Re-raise it now.  If no error message was
         2300  +          #       provided, fallback on the default (below).
         2301  +          #
         2302  +          return -code error $result
         2303  +        }
         2304  +      }
         2305  +
         2306  +      return -code error [appendArgs "invalid command name \"" $name \"]
  2170   2307       }
  2171   2308   
  2172   2309       namespace eval ::tcl::tm {
  2173   2310         #
  2174   2311         # NOTE: Ideally, this procedure should be created in the "::tcl::tm"
  2175   2312         #       namespace.
  2176   2313         #
................................................................................
  2193   2330   
  2194   2331       proc tclLog { string } {
  2195   2332         #
  2196   2333         # NOTE: This should work properly in both Tcl and Eagle.
  2197   2334         #
  2198   2335         catch {puts stderr $string}
  2199   2336       }
         2337  +
         2338  +    proc makeProcedureFast { name fast } {
         2339  +      #
         2340  +      # NOTE: This should work properly in Eagle only.
         2341  +      #
         2342  +      catch {
         2343  +        uplevel 1 [list object invoke -flags +NonPublic \
         2344  +            Interpreter.GetActive MakeProcedureFast $name $fast]
         2345  +      }
         2346  +    }
  2200   2347   
  2201   2348       proc makeVariableFast { name fast } {
  2202   2349         #
  2203   2350         # NOTE: This should work properly in Eagle only.
  2204   2351         #
  2205   2352         catch {
  2206   2353           uplevel 1 [list object invoke -flags +NonPublic \
................................................................................
  2239   2386             }
  2240   2387           }
  2241   2388         }
  2242   2389   
  2243   2390         foreach dir [split [exec -unicode $::env(ComSpec) /u /c dir \
  2244   2391             /ahd /b [appendArgs \" [file nativename $pattern] \"]] \n] {
  2245   2392           set dir [string trim $dir]
         2393  +
         2394  +        if {[string length $dir] > 0} then {
         2395  +          set dir [getDirResultPath $pattern $dir]
         2396  +
         2397  +          if {[lsearch -variable -exact -nocase result $dir] == -1} then {
         2398  +            lappend result $dir
         2399  +          }
         2400  +        }
         2401  +      }
         2402  +
         2403  +      return $result
         2404  +    }
         2405  +
         2406  +    proc findDirectoriesRecursive { pattern } {
         2407  +      #
         2408  +      # NOTE: Block non-Windows platforms since this is Windows specific.
         2409  +      #
         2410  +      if {![isWindows]} then {
         2411  +        error "not supported on this operating system"
         2412  +      }
         2413  +
         2414  +      #
         2415  +      # NOTE: This should work properly in Eagle only.
         2416  +      #
         2417  +      set dir ""; set result [list]
         2418  +
         2419  +      #
         2420  +      # HACK: Optimize the variable access in this procedure to be
         2421  +      #       as fast as possible.
         2422  +      #
         2423  +      makeVariableFast dir true; makeVariableFast result true
         2424  +
         2425  +      foreach dir [split [exec -unicode $::env(ComSpec) /u /c dir \
         2426  +          /ad /s /b [appendArgs \" [file nativename $pattern] \"]] \n] {
         2427  +        set dir [string trim $dir]
         2428  +
         2429  +        if {[string length $dir] > 0} then {
         2430  +          set dir [getDirResultPath $pattern $dir]
         2431  +
         2432  +          if {[lsearch -variable -exact -nocase result $dir] == -1} then {
         2433  +            lappend result $dir
         2434  +          }
         2435  +        }
         2436  +      }
         2437  +
         2438  +      foreach dir [split [exec -unicode $::env(ComSpec) /u /c dir \
         2439  +          /ahd /s /b [appendArgs \" [file nativename $pattern] \"]] \n] {
         2440  +        set dir [string trim $dir]
  2246   2441   
  2247   2442           if {[string length $dir] > 0} then {
  2248   2443             set dir [getDirResultPath $pattern $dir]
  2249   2444   
  2250   2445             if {[lsearch -variable -exact -nocase result $dir] == -1} then {
  2251   2446               lappend result $dir
  2252   2447             }
................................................................................
  2393   2588             [file normalize $pattern]]
  2394   2589   
  2395   2590         eval lappend result [glob -nocomplain -types {d hidden} \
  2396   2591             [file normalize $pattern]]
  2397   2592   
  2398   2593         return $result
  2399   2594       }
         2595  +
         2596  +    proc findDirectoriesRecursive { pattern } {
         2597  +      #
         2598  +      # NOTE: Block non-Windows platforms since this is Windows specific.
         2599  +      #
         2600  +      if {![isWindows]} then {
         2601  +        error "not supported on this operating system"
         2602  +      }
         2603  +
         2604  +      #
         2605  +      # NOTE: This should work properly in Tcl only.
         2606  +      #
         2607  +      set result [list]
         2608  +
         2609  +      catch {
         2610  +        foreach dir [split [exec $::env(ComSpec) /c dir /ad /s /b \
         2611  +            [file nativename $pattern]] \n] {
         2612  +          set dir [string trim $dir]
         2613  +
         2614  +          if {[string length $dir] > 0} then {
         2615  +            set dir [getDirResultPath $pattern $dir]
         2616  +
         2617  +            #
         2618  +            # HACK: The -nocase option to [lsearch] is only available
         2619  +            #       starting with Tcl 8.5.
         2620  +            #
         2621  +            if {$::tcl_version >= 8.5} then {
         2622  +              if {[lsearch -exact -nocase $result $dir] == -1} then {
         2623  +                lappend result $dir
         2624  +              }
         2625  +            } else {
         2626  +              if {[lsearch -exact [string tolower $result] \
         2627  +                  [string tolower $dir]] == -1} then {
         2628  +                lappend result $dir
         2629  +              }
         2630  +            }
         2631  +          }
         2632  +        }
         2633  +      }
         2634  +
         2635  +      catch {
         2636  +        foreach dir [split [exec $::env(ComSpec) /c dir /ahd /s /b \
         2637  +            [file nativename $pattern]] \n] {
         2638  +          set dir [string trim $dir]
         2639  +
         2640  +          if {[string length $dir] > 0} then {
         2641  +            set dir [getDirResultPath $pattern $dir]
         2642  +
         2643  +            #
         2644  +            # HACK: The -nocase option to [lsearch] is only available
         2645  +            #       starting with Tcl 8.5.
         2646  +            #
         2647  +            if {$::tcl_version >= 8.5} then {
         2648  +              if {[lsearch -exact -nocase $result $dir] == -1} then {
         2649  +                lappend result $dir
         2650  +              }
         2651  +            } else {
         2652  +              if {[lsearch -exact [string tolower $result] \
         2653  +                  [string tolower $dir]] == -1} then {
         2654  +                lappend result $dir
         2655  +              }
         2656  +            }
         2657  +          }
         2658  +        }
         2659  +      }
         2660  +
         2661  +      return $result
         2662  +    }
  2400   2663   
  2401   2664       proc findFiles { pattern } {
  2402   2665         #
  2403   2666         # NOTE: This should work properly in Tcl only.
  2404   2667         #
  2405   2668         eval lappend result [glob -nocomplain -types {f} \
  2406   2669             [file normalize $pattern]]
................................................................................
  2428   2691           foreach fileName [split [exec $::env(ComSpec) /c dir /a-d /s /b \
  2429   2692               [file nativename $pattern]] \n] {
  2430   2693             set fileName [string trim $fileName]
  2431   2694   
  2432   2695             if {[string length $fileName] > 0} then {
  2433   2696               set fileName [getDirResultPath $pattern $fileName]
  2434   2697   
  2435         -            if {[lsearch -exact -nocase $result $fileName] == -1} then {
  2436         -              lappend result $fileName
         2698  +            #
         2699  +            # HACK: The -nocase option to [lsearch] is only available
         2700  +            #       starting with Tcl 8.5.
         2701  +            #
         2702  +            if {$::tcl_version >= 8.5} then {
         2703  +              if {[lsearch -exact -nocase $result $fileName] == -1} then {
         2704  +                lappend result $fileName
         2705  +              }
         2706  +            } else {
         2707  +              if {[lsearch -exact [string tolower $result] \
         2708  +                  [string tolower $fileName]] == -1} then {
         2709  +                lappend result $fileName
         2710  +              }
  2437   2711               }
  2438   2712             }
  2439   2713           }
  2440   2714         }
  2441   2715   
  2442   2716         catch {
  2443   2717           foreach fileName [split [exec $::env(ComSpec) /c dir /ah-d /s /b \
  2444   2718               [file nativename $pattern]] \n] {
  2445   2719             set fileName [string trim $fileName]
  2446   2720   
  2447   2721             if {[string length $fileName] > 0} then {
  2448   2722               set fileName [getDirResultPath $pattern $fileName]
  2449   2723   
  2450         -            if {[lsearch -exact -nocase $result $fileName] == -1} then {
  2451         -              lappend result $fileName
         2724  +            #
         2725  +            # HACK: The -nocase option to [lsearch] is only available
         2726  +            #       starting with Tcl 8.5.
         2727  +            #
         2728  +            if {$::tcl_version >= 8.5} then {
         2729  +              if {[lsearch -exact -nocase $result $fileName] == -1} then {
         2730  +                lappend result $fileName
         2731  +              }
         2732  +            } else {
         2733  +              if {[lsearch -exact [string tolower $result] \
         2734  +                  [string tolower $fileName]] == -1} then {
         2735  +                lappend result $fileName
         2736  +              }
  2452   2737               }
  2453   2738             }
  2454   2739           }
  2455   2740         }
  2456   2741   
  2457   2742         return $result
  2458   2743       }
................................................................................
  2510   2795           isSameFileName getEnvironmentVariable combineFlags getCompileInfo \
  2511   2796           getPlatformInfo getPluginPath appendArgs lappendArgs \
  2512   2797           getDictionaryValue getColumnValue getRowColumnValue tqputs tqlog \
  2513   2798           readFile readSharedFile writeFile appendFile appendLogFile \
  2514   2799           appendSharedFile appendSharedLogFile readAsciiFile writeAsciiFile \
  2515   2800           readUnicodeFile writeUnicodeFile getDirResultPath addToPath \
  2516   2801           removeFromPath execShell lshuffle ldifference filter map reduce \
  2517         -        getLengthModifier debug findDirectories findFiles findFilesRecursive \
  2518         -        exportAndImportPackageCommands] false false
         2802  +        getLengthModifier debug findDirectories findDirectoriesRecursive \
         2803  +        findFiles findFilesRecursive exportAndImportPackageCommands] false \
         2804  +        false
  2519   2805   
  2520   2806       ###########################################################################
  2521   2807       ############################## END Tcl ONLY ###############################
  2522   2808       ###########################################################################
  2523   2809     }
  2524   2810   
  2525   2811     #
  2526   2812     # NOTE: Provide the Eagle library package to the interpreter.
  2527   2813     #
  2528   2814     package provide Eagle.Library \
  2529   2815       [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
  2530   2816   }
  2531   2817   

Changes to Externals/Eagle/lib/Eagle1.0/shell.eagle.

    26     26       ###########################################################################
    27     27   
    28     28       #
    29     29       # NOTE: Commands specific to initializing the Eagle interactive shell
    30     30       #       environment should be placed here.
    31     31       #
    32     32       proc help { args } {
           33  +      host result Break [appendArgs \
           34  +          "\nFor interactive help please use: #help " $args \
           35  +          "\nFor commercial support, please use: #support\n"]
           36  +
           37  +      catch {
           38  +        object invoke Interpreter.GetActive Host.WriteLine \
           39  +            "\nPlease press any key to continue...\n"
           40  +
           41  +        set key null; object invoke Interpreter.GetActive \
           42  +            Host.ReadKey true key
           43  +      }
           44  +
    33     45         eval lappend command #help $args; debug icommand $command
    34         -      error "for interactive help please use: #help $args"
           46  +    }
           47  +
           48  +    proc #support {} {
           49  +      # <help>
           50  +      # Shows the requirements for obtaining commercial support and/or
           51  +      # redirects to the appropriate web site using the default browser.
           52  +      # </help>
           53  +
           54  +      if {[catch {
           55  +        package require Licensing.Enterprise
           56  +        set fileName(1) [certificate current]
           57  +
           58  +        if {[string length $fileName(1)] == 0} then {
           59  +          error "No certificate file is available."
           60  +        }
           61  +
           62  +        set certificate [certificate import -alias $fileName(1)]
           63  +
           64  +        if {[string length $certificate] == 0} then {
           65  +          error [appendArgs \
           66  +              "No certificate is available, current file \"" \
           67  +              $fileName(1) "\" could not be imported."]
           68  +        }
           69  +
           70  +        if {[catch {
           71  +          certificate flags -hasflags S -hasall -strict $certificate
           72  +        } error(2)]} then {
           73  +          error [appendArgs \
           74  +              "Support is not enabled for certificate \"" \
           75  +              [$certificate Id] " - " [$certificate EntityName] \
           76  +              "\", the original error message was: \{" $error(2) \
           77  +              \}.]
           78  +        }
           79  +
           80  +        set uri [$certificate -create -alias Support]
           81  +
           82  +        if {[string length $uri] == 0} then {
           83  +          error [appendArgs \
           84  +              "No support information found in certificate \"" \
           85  +              [$certificate Id] " - " [$certificate EntityName] \".]
           86  +        }
           87  +
           88  +        if {[$uri Scheme] ni [list http https]} then {
           89  +          error [appendArgs \
           90  +              "Support URI scheme \"" [$uri Scheme] \
           91  +              "\" in certificate \"" [$certificate Id] " - " \
           92  +              [$certificate EntityName] "\" is not supported, " \
           93  +              "must be \"http\" or \"https\"."]
           94  +        }
           95  +
           96  +        exec -shell [$uri ToString] &
           97  +      } error(1)]} then {
           98  +        set fileName(2) [file tempname]; set fileData ""
           99  +
          100  +        foreach varName [lsort [info vars]] {
          101  +          if {$varName in [list fileData]} then {
          102  +            continue
          103  +          }
          104  +
          105  +          if {$varName eq "certificate" && \
          106  +              [string length $certificate] > 0} then {
          107  +            append fileData [appendArgs \n \
          108  +                [list array set certificate \
          109  +                [$certificate -flags +NonPublic \
          110  +                ToDictionary.KeysAndValuesToString \
          111  +                null false]]]
          112  +
          113  +            continue
          114  +          }
          115  +
          116  +          if {[array exists $varName]} then {
          117  +            append fileData [appendArgs \n \
          118  +                [list array set $varName [array get $varName]]]
          119  +          } else {
          120  +            append fileData [appendArgs \n \
          121  +                [list set $varName [set $varName]]]
          122  +          }
          123  +        }
          124  +
          125  +        append fileData \n; writeFile $fileName(2) $fileData
          126  +        set ::eagle_shell(errorFileName) $fileName(2)
          127  +
          128  +        error [appendArgs \
          129  +            "\n\nIn order to obtain commercial support, at least " \
          130  +            "one of the\nfollowing requirements must be met:\n\n" \
          131  +            "\t1. Valid, non-expired commercial license agreement\n" \
          132  +            "\t   for Eagle Enterprise Edition.\n\n" \
          133  +            "\t2. Valid, non-expired commercial support contract\n" \
          134  +            "\t   for Eagle Standard Edition.\n\n" \
          135  +            "The original error information was saved to the file:\n\n" \
          136  +            [string repeat - 60] \n $fileName(2) \n [string repeat - 60] \
          137  +            "\n\nPlease provide this file when contacting support."]
          138  +      }
    35    139       }
    36    140   
    37    141       ###########################################################################
    38    142       ############################# END Eagle ONLY ##############################
    39    143       ###########################################################################
    40    144     } else {
    41    145       ###########################################################################

Changes to Externals/Eagle/lib/Eagle1.0/test.eagle.

   233    233       }
   234    234     }
   235    235   
   236    236     proc testArrayGet { varName {integer false} } {
   237    237       #
   238    238       # NOTE: Returns the results of [array get] in a well-defined order.
   239    239       #
          240  +    if {[string length $varName] == 0} then {
          241  +      return [list]
          242  +    }
          243  +
   240    244       upvar 1 $varName array
   241    245   
   242    246       #
   243    247       # NOTE: Build the command that will sort the array names into order.
   244    248       #
   245    249       set command [list lsort]
   246    250       if {$integer} then {lappend command -integer}
................................................................................
   477    481           tputs $::test_channel [appendArgs \
   478    482               "---- skipped " $type " file: \"" $fileName \
   479    483               "\", it does not exist\n"]
   480    484         }
   481    485       }
   482    486     }
   483    487   
   484         -  proc processTestArguments { varName args } {
          488  +  proc processTestArguments { varName strict args } {
          489  +    #
          490  +    # NOTE: Initially, there are no unknown (i.e. unprocessed) arguments.
          491  +    #
          492  +    set result [list]
          493  +
   485    494       #
   486    495       # NOTE: We are going to place the configured options in the variable
   487    496       #       identified by the name provided by the caller.
   488    497       #
   489         -    upvar 1 $varName array
          498  +    if {[string length $varName] > 0} then {
          499  +      upvar 1 $varName array
          500  +    }
   490    501   
   491    502       #
   492         -    # TODO: Add more support for standard tcltest options here.
          503  +    # TODO: Add more support for standard "tcltest" options here.
   493    504       #
   494    505       set options [list \
   495         -        -breakOnLeak -configuration -constraints -exitOnComplete -file \
   496         -        -logFile -machine -match -no -notFile -platform -postTest -preTest \
   497         -        -postWait -preWait -randomOrder -skip -startFile -stopFile \
   498         -        -stopOnFailure -stopOnLeak -suffix -suite -tclsh -threshold]
          506  +        -breakOnLeak -configuration -constraints -exitOnComplete \
          507  +        -file -logFile -machine -match -no -notFile -platform \
          508  +        -postTest -preTest -postWait -preWait -randomOrder -skip \
          509  +        -startFile -stopFile -stopOnFailure -stopOnLeak -suffix \
          510  +        -suite -tclsh -threshold]
   499    511   
   500    512       set length [llength $args]
   501    513   
   502    514       for {set index 0} {$index < $length} {incr index} {
   503    515         #
   504    516         # NOTE: Grab the current list element, which should be the name of
   505    517         #       the test option.
................................................................................
   535    547           # NOTE: Is there another list element available for the value?  If
   536    548           #       not, it does not conform to the standard command line name
   537    549           #       and value pattern.
   538    550           #
   539    551           if {$index + 1 < $length} then {
   540    552             incr index; set value [lindex $args $index]
   541    553   
   542         -          tqputs $::test_channel [appendArgs \
   543         -              "---- unknown test option \"" $name "\" with value \"" \
   544         -              $value "\" ignored\n"]
          554  +          if {!$strict && [lsearch -exact $options $value] != -1} then {
          555  +            incr index -1; # HACK: Resynchronize with valid test option.
          556  +            lappend result [list $name]
          557  +
          558  +            tqputs $::test_channel [appendArgs \
          559  +                "---- no value for unknown test option \"" $name \
          560  +                "\", ignored, backing up one for test option \"" \
          561  +                $value \"...\n]
          562  +          } else {
          563  +            lappend result [list $name $value]
          564  +
          565  +            tqputs $::test_channel [appendArgs \
          566  +                "---- unknown test option \"" $name "\" with value \"" \
          567  +                $value "\", ignored\n"]
          568  +          }
   545    569           } else {
          570  +          lappend result [list $name]
          571  +
   546    572             tqputs $::test_channel [appendArgs \
   547    573                 "---- no value for unknown test option \"" $name \
   548         -              "\" ignored\n"]
          574  +              "\", ignored\n"]
   549    575           }
   550    576         } else {
   551    577           #
   552         -        # NOTE: This is not an option of *any* kind that we know about.
   553         -        #       Ignore it and issue a warning.
          578  +        # NOTE: Is there another list element available for the value?  If
          579  +        #       not, it does not conform to the standard command line name
          580  +        #       and value pattern.
   554    581           #
   555         -        tqputs $::test_channel [appendArgs \
   556         -            "---- unknown argument \"" $name "\" ignored\n"]
          582  +        if {$index + 1 < $length} then {
          583  +          incr index; set value [lindex $args $index]
          584  +
          585  +          if {!$strict && [lsearch -exact $options $value] != -1} then {
          586  +            incr index -1; # HACK: Resynchronize with valid test argument.
          587  +            lappend result [list $name]
          588  +
          589  +            tqputs $::test_channel [appendArgs \
          590  +                "---- no value for unknown argument \"" $name \
          591  +                "\", ignored, backing up one for test option \"" \
          592  +                $value \"...\n]
          593  +          } else {
          594  +            lappend result [list $name $value]
          595  +
          596  +            tqputs $::test_channel [appendArgs \
          597  +                "---- unknown argument \"" $name "\" with value \"" \
          598  +                $value "\", ignored\n"]
          599  +          }
          600  +        } else {
          601  +          #
          602  +          # NOTE: This is not an option of *any* kind that we know about.
          603  +          #       Ignore it and issue a warning.
          604  +          #
          605  +          lappend result [list $name]
          606  +
          607  +          tqputs $::test_channel [appendArgs \
          608  +              "---- unknown argument \"" $name "\", ignored\n"]
          609  +        }
   557    610         }
   558    611       }
   559    612   
   560    613       #
   561    614       # NOTE: Now, attempt to flush the test log queue, if available.
   562    615       #
   563    616       tlog ""
          617  +
          618  +    #
          619  +    # NOTE: Return the nested list of unknown arguments, formatted as
          620  +    #       name/value pairs, to the caller.
          621  +    #
          622  +    return $result
   564    623     }
   565    624   
   566    625     proc getTclShellFileName { automatic kits } {
   567    626       #
   568    627       # NOTE: Start out with an empty list of candiate Tcl shells.
   569    628       #
   570    629       set shells [list]
   571    630   
   572    631       #
   573    632       # NOTE: Check all environment variables we know about that
   574    633       #       may contain the path where the Tcl shell is located.
   575    634       #
   576         -    foreach name [list Eagle_Tcl_Shell Tcl_Shell] {
          635  +    foreach name [list Eagle_Tcl_Shell Tcl_Shell EAGLE_TCLSH TCLSH] {
   577    636         set value [getEnvironmentVariable $name]
   578    637   
   579    638         #
   580    639         # TODO: Possibly add a check if the file actually exists
   581    640         #       here.
   582    641         #
   583    642         if {[string length $value] > 0} then {
................................................................................
  1292   1351       if {![info exists ::no(epilogue.eagle)] && [info exists ::path]} then {
  1293   1352         unset ::path
  1294   1353       }
  1295   1354     }
  1296   1355   
  1297   1356     proc hookPuts {} {
  1298   1357       #
  1299         -    # NOTE: This code was stolen from tcltest and heavily modified to work
  1300         -    #       with Eagle.
         1358  +    # NOTE: This code was stolen from "tcltest" and heavily modified to
         1359  +    #       work with Eagle.
  1301   1360       #
  1302   1361       proc [namespace current]::testPuts { args } {
  1303   1362         switch [llength $args] {
  1304   1363           1 {
  1305   1364             #
  1306   1365             # NOTE: Only the string to be printed is specified (stdout).
  1307   1366             #
................................................................................
  2313   2372     proc isTestSuiteRunning {} {
  2314   2373       #
  2315   2374       # NOTE: Return non-zero if the test suite appears to be running.
  2316   2375       #
  2317   2376       return [expr {[info exists ::test_suite_running] && \
  2318   2377           $::test_suite_running}]
  2319   2378     }
         2379  +
         2380  +  proc getTestChannelOrDefault {} {
         2381  +    if {[info exists ::test_channel]} then {
         2382  +      return $::test_channel
         2383  +    }
         2384  +
         2385  +    return stdout; # TODO: Good default?
         2386  +  }
         2387  +
         2388  +  proc checkForAndSetTestPath { whatIf {quiet false} } {
         2389  +    #
         2390  +    # NOTE: Everything in this procedure requires access to the file system;
         2391  +    #       therefore, it cannot be used in a stock "safe" interpreter.
         2392  +    #
         2393  +    if {![interp issafe] && ![info exists ::test_path]} then {
         2394  +      #
         2395  +      # NOTE: Grab the name of the current script file.  If this is an empty
         2396  +      #       string, many test path checks will have to be skipped.
         2397  +      #
         2398  +      set script [info script]
         2399  +
         2400  +      #
         2401  +      # NOTE: Eagle and native Tcl have different requirements and possible
         2402  +      #       locations for the test path; therefore, handle them separately.
         2403  +      #
         2404  +      if {[isEagle]} then {
         2405  +        #
         2406  +        # NOTE: Grab the base directory and the library directory.  Without
         2407  +        #       these, several test path checks will be skipped.
         2408  +        #
         2409  +        set library [getTestLibraryDirectory]; set base [info base]
         2410  +
         2411  +        if {[string length $library] > 0} then {
         2412  +          #
         2413  +          # NOTE: Try the source release directory structure.  For this
         2414  +          #       case, the final test path would be:
         2415  +          #
         2416  +          #           $library/../../Library/Tests
         2417  +          #
         2418  +          set ::test_path [file normalize [file join [file dirname [file \
         2419  +              dirname $library]] Library Tests]]
         2420  +
         2421  +          if {!$quiet} then {
         2422  +            tqputs [getTestChannelOrDefault] [appendArgs \
         2423  +                "---- checking #1 for Eagle test path at \"" \
         2424  +                $::test_path \"...\n]
         2425  +          }
         2426  +        }
         2427  +
         2428  +        if {[string length $base] > 0 && ($whatIf || \
         2429  +            ![info exists ::test_path] || ![file exists $::test_path] || \
         2430  +            ![file isdirectory $::test_path])} then {
         2431  +          #
         2432  +          # NOTE: Try the source release directory structure again; this
         2433  +          #       time, assume only the embedded script library was used.
         2434  +          #       For this case, the final test path would be:
         2435  +          #
         2436  +          #           $base/Library/Tests
         2437  +          #
         2438  +          set ::test_path [file normalize [file join $base Library Tests]]
         2439  +
         2440  +          if {!$quiet} then {
         2441  +            tqputs [getTestChannelOrDefault] [appendArgs \
         2442  +                "---- checking #2 for Eagle test path at \"" \
         2443  +                $::test_path \"...\n]
         2444  +          }
         2445  +        }
         2446  +
         2447  +        if {[string length $script] > 0 && ($whatIf || \
         2448  +            ![info exists ::test_path] || ![file exists $::test_path] || \
         2449  +            ![file isdirectory $::test_path])} then {
         2450  +          #
         2451  +          # NOTE: Try for the test package directory.  For this case, the
         2452  +          #       final test path would be:
         2453  +          #
         2454  +          #           $script/../Test1.0
         2455  +          #
         2456  +          set ::test_path [file normalize [file join [file dirname [file \
         2457  +              dirname $script]] [appendArgs Test [info engine Version]]]]
         2458  +
         2459  +          if {!$quiet} then {
         2460  +            tqputs [getTestChannelOrDefault] [appendArgs \
         2461  +                "---- checking #3 for Eagle test path at \"" \
         2462  +                $::test_path \"...\n]
         2463  +          }
         2464  +        }
         2465  +
         2466  +        if {[string length $base] > 0 && ($whatIf || \
         2467  +            ![info exists ::test_path] || ![file exists $::test_path] || \
         2468  +            ![file isdirectory $::test_path])} then {
         2469  +          #
         2470  +          # NOTE: Try for the test package directory again; this time, use
         2471  +          #       the base path and assume the source release directory
         2472  +          #       structure.  For this case, the final test path would be:
         2473  +          #
         2474  +          #           $base/lib/Test1.0
         2475  +          #
         2476  +          set ::test_path [file normalize [file join $base lib [appendArgs \
         2477  +              Test [info engine Version]]]]
         2478  +
         2479  +          if {!$quiet} then {
         2480  +            tqputs [getTestChannelOrDefault] [appendArgs \
         2481  +                "---- checking #4 for Eagle test path at \"" \
         2482  +                $::test_path \"...\n]
         2483  +          }
         2484  +        }
         2485  +
         2486  +        if {[string length $base] > 0 && ($whatIf || \
         2487  +            ![info exists ::test_path] || ![file exists $::test_path] || \
         2488  +            ![file isdirectory $::test_path])} then {
         2489  +          #
         2490  +          # NOTE: Try for the test package directory again; this time, use
         2491  +          #       the base path.  For this case, the final test path would
         2492  +          #       be:
         2493  +          #
         2494  +          #           $base/Test1.0
         2495  +          #
         2496  +          set ::test_path [file normalize [file join $base [appendArgs \
         2497  +              Test [info engine Version]]]]
         2498  +
         2499  +          if {!$quiet} then {
         2500  +            tqputs [getTestChannelOrDefault] [appendArgs \
         2501  +                "---- checking #5 for Eagle test path at \"" \
         2502  +                $::test_path \"...\n]
         2503  +          }
         2504  +        }
         2505  +
         2506  +        if {[string length $library] > 0 && ($whatIf || \
         2507  +            ![info exists ::test_path] || ![file exists $::test_path] || \
         2508  +            ![file isdirectory $::test_path])} then {
         2509  +          #
         2510  +          # NOTE: This must be a binary release, no "Library" directory
         2511  +          #       then.  Also, binary releases have an upper-case "Tests"
         2512  +          #       directory name that originates from the "update.bat"
         2513  +          #       tool.  This must match the casing used in "update.bat".
         2514  +          #       For this case, the final test path would be:
         2515  +          #
         2516  +          #           $library/../../Tests
         2517  +          #
         2518  +          set ::test_path [file normalize [file join [file dirname [file \
         2519  +              dirname $library]] Tests]]
         2520  +
         2521  +          if {!$quiet} then {
         2522  +            tqputs [getTestChannelOrDefault] [appendArgs \
         2523  +                "---- checking #6 for Eagle test path at \"" \
         2524  +                $::test_path \"...\n]
         2525  +          }
         2526  +        }
         2527  +
         2528  +        if {[string length $base] > 0 && ($whatIf || \
         2529  +            ![info exists ::test_path] || ![file exists $::test_path] || \
         2530  +            ![file isdirectory $::test_path])} then {
         2531  +          #
         2532  +          # NOTE: Fallback to using the base directory and checking for a
         2533  +          #       "Tests" directory beneath it.  For this case, the final
         2534  +          #       test path would be:
         2535  +          #
         2536  +          #           $base/Tests
         2537  +          #
         2538  +          set ::test_path [file normalize [file join $base Tests]]
         2539  +
         2540  +          if {!$quiet} then {
         2541  +            tqputs [getTestChannelOrDefault] [appendArgs \
         2542  +                "---- checking #7 for Eagle test path at \"" \
         2543  +                $::test_path \"...\n]
         2544  +          }
         2545  +        }
         2546  +
         2547  +        if {!$quiet} then {
         2548  +          tqputs [getTestChannelOrDefault] [appendArgs \
         2549  +              "---- final Eagle test path is \"" \
         2550  +              [expr {[info exists ::test_path] ? \
         2551  +              $::test_path : "<none>"}] \"\n]
         2552  +        }
         2553  +      } else {
         2554  +        if {[string length $script] > 0} then {
         2555  +          #
         2556  +          # NOTE: Try the source release directory structure.  For this
         2557  +          #       case, the final test path would be:
         2558  +          #
         2559  +          #           $script/../../Library/Tests
         2560  +          #
         2561  +          set ::test_path [file normalize [file join [file dirname [file \
         2562  +              dirname [file dirname $script]]] Library Tests]]
         2563  +
         2564  +          if {!$quiet} then {
         2565  +            tqputs [getTestChannelOrDefault] [appendArgs \
         2566  +                "---- checking #1 for Tcl test path at \"" \
         2567  +                $::test_path \"...\n]
         2568  +          }
         2569  +        }
         2570  +
         2571  +        if {[string length $script] > 0 && ($whatIf || \
         2572  +            ![info exists ::test_path] || ![file exists $::test_path] || \
         2573  +            ![file isdirectory $::test_path])} then {
         2574  +          #
         2575  +          # NOTE: Try for the test package directory.  For this case, the
         2576  +          #       final test path would be:
         2577  +          #
         2578  +          #           $script/../Test1.0
         2579  +          #
         2580  +          set ::test_path [file normalize [file join [file dirname [file \
         2581  +              dirname $script]] Test1.0]]
         2582  +
         2583  +          if {!$quiet} then {
         2584  +            tqputs [getTestChannelOrDefault] [appendArgs \
         2585  +                "---- checking #2 for Tcl test path at \"" \
         2586  +                $::test_path \"...\n]
         2587  +          }
         2588  +        }
         2589  +
         2590  +        if {[string length $script] > 0 && ($whatIf || \
         2591  +            ![info exists ::test_path] || ![file exists $::test_path] || \
         2592  +            ![file isdirectory $::test_path])} then {
         2593  +          #
         2594  +          # NOTE: This must be a binary release, no "Library" directory
         2595  +          #       then.  Also, binary releases have an upper-case "Tests"
         2596  +          #       directory name that originates from the "update.bat"
         2597  +          #       tool.  This must match the casing used in "update.bat".
         2598  +          #       For this case, the final test path would be:
         2599  +          #
         2600  +          #           $script/../../Tests
         2601  +          #
         2602  +          set ::test_path [file normalize [file join [file dirname [file \
         2603  +              dirname [file dirname $script]]] Tests]]
         2604  +
         2605  +          if {!$quiet} then {
         2606  +            tqputs [getTestChannelOrDefault] [appendArgs \
         2607  +                "---- checking #3 for Tcl test path at \"" \
         2608  +                $::test_path \"...\n]
         2609  +          }
         2610  +        }
         2611  +
         2612  +        if {!$quiet} then {
         2613  +          tqputs [getTestChannelOrDefault] [appendArgs \
         2614  +              "---- final Tcl test path is \"" \
         2615  +              [expr {[info exists ::test_path] ? \
         2616  +              $::test_path : "<none>"}] \"\n]
         2617  +        }
         2618  +      }
         2619  +    }
         2620  +  }
  2320   2621   
  2321   2622     proc configureTcltest { match skip constraints imports force } {
         2623  +    #
         2624  +    # NOTE: Eagle and native Tcl have different configuration requirements
         2625  +    #       for the "tcltest" package.  For Eagle, the necessary testing
         2626  +    #       functionality is built-in.  In native Tcl, the package must be
         2627  +    #       loaded now and that cannot be done in a "safe" interpreter.
         2628  +    #
  2322   2629       if {[isEagle]} then {
  2323   2630         #
  2324   2631         # HACK: Flag the "test" and "runTest" script library procedures so
  2325   2632         #       that they use the script location of their caller and not
  2326   2633         #       their own.
  2327   2634         #
  2328   2635         # BUGBUG: Even this does not yet fix the script location issues in
................................................................................
  2333   2640         #
  2334   2641         # NOTE: Setup the necessary compatibility shims for the test suite.
  2335   2642         #
  2336   2643         namespace eval ::tcltest {}; # HACK: Force namespace creation now.
  2337   2644         setupTestShims true [expr {![isTestSuiteRunning]}]
  2338   2645   
  2339   2646         #
  2340         -      # NOTE: Fake having the tcltest package.
         2647  +      # NOTE: Fake having the package as the functionality is built-in.
  2341   2648         #
  2342   2649         package provide tcltest 2.2.10; # Tcl 8.4
  2343         -    } else {
         2650  +    } elseif {![interp issafe]} then {
  2344   2651         #
  2345         -      # NOTE: Attempt to detect if the tcltest package is already loaded.
         2652  +      # NOTE: Attempt to detect if the package is already loaded.
  2346   2653         #
  2347   2654         set loaded [expr {[catch {package present tcltest}] == 0}]
  2348   2655   
  2349   2656         #
  2350         -      # NOTE: Always attempt to load the tcltest package.
         2657  +      # NOTE: Always attempt to load the package.
  2351   2658         #
  2352   2659         package require tcltest
  2353   2660   
  2354   2661         #
  2355         -      # NOTE: Configure tcltest for our use (only when it was not loaded).
         2662  +      # NOTE: Configure it for our use (only when it was not loaded).
  2356   2663         #
  2357   2664         if {!$loaded} then {
  2358   2665           ::tcltest::configure -verbose bpste
  2359   2666         }
  2360   2667   
  2361   2668         #
  2362   2669         # NOTE: We need to copy the Eagle test names to match over to Tcl.
................................................................................
  2527   2834   
  2528   2835           if {[info exists test_flags(-constraints)]} then {
  2529   2836               eval lappend eagle_tests(Constraints) $test_flags(-constraints)
  2530   2837           }
  2531   2838         }
  2532   2839       }
  2533   2840   
  2534         -    proc getTestChannelOrDefault {} {
  2535         -      if {[info exists ::test_channel]} then {
  2536         -        return $::test_channel
  2537         -      }
  2538         -
  2539         -      return stdout; # TODO: Good default?
  2540         -    }
  2541         -
  2542   2841       proc setupTestShims { setup {quiet false} } {
  2543   2842         if {$setup} then {
  2544   2843           #
  2545   2844           # HACK: Compatibility shim(s) for use with various tests in the Tcl
  2546   2845           #       test suite.  Make sure these commands do not already exist
  2547   2846           #       prior to attempt to adding them.
  2548   2847           #
................................................................................
  3088   3387         object unimport -importpattern System.Windows.Forms.Layout
  3089   3388         object unimport -importpattern System.Windows.Forms.PropertyGridInternal
  3090   3389         object unimport -importpattern System.Windows.Forms.VisualStyles
  3091   3390       }
  3092   3391   
  3093   3392       proc getTestLibraryDirectory {} {
  3094   3393         #
  3095         -      # NOTE: First, query the location of the script library.
  3096         -      #
  3097         -      set result [info library]
  3098         -
         3394  +      # NOTE: First, query the location of the script library.  This will
         3395  +      #       not work right in a "safe" interpreter.
  3099   3396         #
  3100         -      # NOTE: Next, If the script library is embedded within the core
  3101         -      #       library itself (i.e. the script library location refers
  3102         -      #       to a file, not a directory), strip off the file name.
  3103         -      #
  3104         -      if {[file exists $result] && [file isfile $result]} then {
  3105         -        set result [file dirname $result]
         3397  +      if {[catch {info library} result] == 0} then {
         3398  +        #
         3399  +        # NOTE: Next, If the script library is embedded within the core
         3400  +        #       library itself (i.e. the script library location refers
         3401  +        #       to a file, not a directory), strip off the file name.
         3402  +        #
         3403  +        if {[file exists $result] && [file isfile $result]} then {
         3404  +          set result [file dirname $result]
         3405  +        }
         3406  +
         3407  +        #
         3408  +        # NOTE: Finally, return the resulting script library directory.
         3409  +        #
         3410  +        return $result
  3106   3411         }
  3107   3412   
  3108         -      #
  3109         -      # NOTE: Finally, return the resulting script library directory.
  3110         -      #
  3111         -      return $result
         3413  +      return ""
  3112   3414       }
  3113   3415   
  3114   3416       #
  3115         -    # NOTE: Setup the test path relative to the library path.
         3417  +    # NOTE: Check for the test path in the various well-known locations
         3418  +    #       and set the associated variable.
  3116   3419       #
  3117         -    if {![interp issafe] && ![info exists ::test_path]} then {
  3118         -      #
  3119         -      # NOTE: Try the source release directory structure.  For this case,
  3120         -      #       the final test path would be:
  3121         -      #
  3122         -      #           $library/../../Library/Tests
  3123         -      #
  3124         -      set ::test_path [file join [file normalize [file dirname \
  3125         -          [file dirname [getTestLibraryDirectory]]]] Library Tests]
  3126         -
  3127         -      if {![file exists $::test_path] || \
  3128         -          ![file isdirectory $::test_path]} then {
  3129         -        #
  3130         -        # NOTE: Try the source release directory structure again; this time,
  3131         -        #       assume only the embedded script library was used.  For this
  3132         -        #       case, the final test path would be:
  3133         -        #
  3134         -        #           $base/Library/Tests
  3135         -        #
  3136         -        set ::test_path [file join [info base] Library Tests]
  3137         -      }
  3138         -
  3139         -      if {![file exists $::test_path] || \
  3140         -          ![file isdirectory $::test_path]} then {
  3141         -        #
  3142         -        # NOTE: Try for the test package directory.  For this case, the final
  3143         -        #       test path would be:
  3144         -        #
  3145         -        #           $script/../Test1.0
  3146         -        #
  3147         -        set ::test_path [file join [file normalize [file dirname \
  3148         -            [file dirname [info script]]]] [appendArgs Test \
  3149         -            [info engine Version]]]
  3150         -      }
  3151         -
  3152         -      if {![file exists $::test_path] || \
  3153         -          ![file isdirectory $::test_path]} then {
  3154         -        #
  3155         -        # NOTE: Try for the test package directory again; this time, use the
  3156         -        #       base path and assume the source release directory structure.
  3157         -        #       For this case, the final test path would be:
  3158         -        #
  3159         -        #           $base/lib/Test1.0
  3160         -        #
  3161         -        set ::test_path [file join [info base] lib [appendArgs Test \
  3162         -            [info engine Version]]]
  3163         -      }
  3164         -
  3165         -      if {![file exists $::test_path] || \
  3166         -          ![file isdirectory $::test_path]} then {
  3167         -        #
  3168         -        # NOTE: Try for the test package directory again; this time, use the
  3169         -        #       base path.  For this case, the final test path would be:
  3170         -        #
  3171         -        #           $base/Test1.0
  3172         -        #
  3173         -        set ::test_path [file join [info base] [appendArgs Test \
  3174         -            [info engine Version]]]
  3175         -      }
  3176         -
  3177         -      if {![file exists $::test_path] || \
  3178         -          ![file isdirectory $::test_path]} then {
  3179         -        #
  3180         -        # NOTE: This must be a binary release, no "Library" directory then.
  3181         -        #       Also, binary releases have an upper-case "Tests" directory
  3182         -        #       name that originates from the "update.bat" tool.  This must
  3183         -        #       match the casing used in "update.bat".  For this case, the
  3184         -        #       final test path would be:
  3185         -        #
  3186         -        #           $library/../../Tests
  3187         -        #
  3188         -        set ::test_path [file join [file normalize [file dirname \
  3189         -            [file dirname [getTestLibraryDirectory]]]] Tests]
  3190         -      }
  3191         -
  3192         -      if {![file exists $::test_path] || \
  3193         -          ![file isdirectory $::test_path]} then {
  3194         -        #
  3195         -        # NOTE: Fallback to using the base directory and checking for a
  3196         -        #       "Tests" directory beneath it.  For this case, the final
  3197         -        #       test path would be:
  3198         -        #
  3199         -        #           $base/Tests
  3200         -        #
  3201         -        set ::test_path [file join [info base] Tests]
  3202         -      }
         3420  +    if {![info exists ::no(checkForAndSetTestPath)]} then {
         3421  +      checkForAndSetTestPath false [expr {![isTestSuiteRunning]}]
  3203   3422       }
  3204   3423   
  3205   3424       #
  3206         -    # NOTE: Fake having the tcltest package unless we are prevented.
         3425  +    # NOTE: Fake loading and configuring the "tcltest" package unless we
         3426  +    #       are prevented.
  3207   3427       #
  3208   3428       if {![info exists ::no(configureTcltest)]} then {
  3209   3429         configureTcltest [list] [list] [list] [list] false
  3210   3430       }
  3211   3431   
  3212   3432       ###########################################################################
  3213   3433       ############################# END Eagle ONLY ##############################
................................................................................
  3235   3455               double($::tcltest::numTests(Total)))}]
  3236   3456         }
  3237   3457   
  3238   3458         return 0; # no tests were run, etc.
  3239   3459       }
  3240   3460   
  3241   3461       #
  3242         -    # NOTE: Setup the test path relative to the path of this file.
         3462  +    # NOTE: Check for the test path in the various well-known locations
         3463  +    #       and set the associated variable.
  3243   3464       #
  3244         -    if {![interp issafe] && ![info exists ::test_path]} then {
  3245         -      #
  3246         -      # NOTE: Try the source release directory structure.
  3247         -      #
  3248         -      set ::test_path [file join [file normalize [file dirname \
  3249         -          [file dirname [file dirname [info script]]]]] Library Tests]
  3250         -
  3251         -      if {![file exists $::test_path] || \
  3252         -          ![file isdirectory $::test_path]} then {
  3253         -        #
  3254         -        # NOTE: Try for the test package directory.
  3255         -        #
  3256         -        set ::test_path [file join [file normalize [file dirname \
  3257         -            [file dirname [info script]]]] Test1.0]
  3258         -      }
  3259         -
  3260         -      if {![file exists $::test_path] || \
  3261         -          ![file isdirectory $::test_path]} then {
  3262         -        #
  3263         -        # NOTE: This must be a binary release, no "Library" directory then.
  3264         -        #       Also, binary releases have an upper-case "Tests" directory
  3265         -        #       name that originates from the "update.bat" tool.  This must
  3266         -        #       match the casing used in "update.bat".
  3267         -        #
  3268         -        set ::test_path [file join [file normalize [file dirname \
  3269         -            [file dirname [file dirname [info script]]]]] Tests]
  3270         -      }
         3465  +    if {![info exists ::no(checkForAndSetTestPath)]} then {
         3466  +      checkForAndSetTestPath false [expr {![isTestSuiteRunning]}]
  3271   3467       }
  3272   3468   
  3273   3469       #
  3274         -    # NOTE: Load and configure the tcltest package unless we are prevented.
         3470  +    # NOTE: Load and configure the "tcltest" package unless we are prevented.
  3275   3471       #
  3276         -    if {![interp issafe] && ![info exists ::no(configureTcltest)]} then {
         3472  +    if {![info exists ::no(configureTcltest)]} then {
  3277   3473         configureTcltest [list] [list] [list] [list test testConstraint] false
  3278   3474       }
  3279   3475   
  3280   3476       #
  3281   3477       # NOTE: We need several of our test related commands in the global
  3282   3478       #       namespace as well.
  3283   3479       #
................................................................................
  3292   3488           getTestSuffix testExec testClrExec execTestShell isRandomOrder \
  3293   3489           isBreakOnLeak isStopOnFailure isStopOnLeak isExitOnComplete \
  3294   3490           returnInfoScript runTestPrologue runTestEpilogue hookPuts unhookPuts \
  3295   3491           runTest testDebugBreak testArrayGet testShim tsource \
  3296   3492           recordTestStatistics reportTestStatistics formatList formatListAsDict \
  3297   3493           pathToRegexp inverseLsearchGlob removePathFromFileNames formatDecimal \
  3298   3494           clearTestPercent reportTestPercent runAllTests isTestSuiteRunning \
  3299         -        configureTcltest machineToPlatform getPassPercentage \
  3300         -        getSkipPercentage] false false
         3495  +        getTestChannelOrDefault checkForAndSetTestPath configureTcltest \
         3496  +        machineToPlatform getPassPercentage getSkipPercentage] false false
  3301   3497   
  3302   3498       ###########################################################################
  3303   3499       ############################## END Tcl ONLY ###############################
  3304   3500       ###########################################################################
  3305   3501     }
  3306   3502   
  3307   3503     #
  3308   3504     # NOTE: Provide the Eagle test package to the interpreter.
  3309   3505     #
  3310   3506     package provide Eagle.Test \
  3311   3507       [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
  3312   3508   }
  3313   3509   

Changes to Externals/Eagle/lib/Test1.0/all.eagle.

    38     38   #
    39     39   #       When using the above code snippet, the following code snippet may also
    40     40   #       be used at the very end of the corresponding "all.eagle" file instead
    41     41   #       of evaluating the "epilogue.eagle" file directly:
    42     42   #
    43     43   #           runTestEpilogue
    44     44   #
           45  +if {![info exists test_all_path]} then {
           46  +  set test_all_path \
           47  +      [file normalize [file dirname [info script]]]
           48  +}
           49  +
    45     50   if {![info exists test_path]} then {
    46         -  set test_path [file normalize [file dirname [info script]]]
           51  +  set test_path [file normalize [file join \
           52  +      [file dirname [file dirname $test_all_path]] \
           53  +      Library Tests]]
    47     54   }
    48     55   
    49         -source [file join $test_path prologue.eagle]
           56  +source [file join $test_all_path prologue.eagle]
    50     57   
    51     58   set no(prologue.eagle) true
    52     59   set no(epilogue.eagle) true
    53     60   
    54     61   set test_time [time {
    55     62     runAllTests $test_channel $test_path \
    56     63         [getTestFiles [list $test_path] $test_flags(-file) \
    57     64             $test_flags(-notFile)] \
    58         -      [list [file tail [info script]] *.tcl pkgIndex.eagle \
    59         -          constraints.eagle epilogue.eagle prologue.eagle] \
           65  +      [list [file tail [info script]] *.tcl \
           66  +          epilogue.eagle prologue.eagle] \
    60     67         $test_flags(-startFile) $test_flags(-stopFile)
    61     68   }]
    62     69   
    63     70   tputs $test_channel [appendArgs "---- all tests completed in " $test_time \n]
    64     71   unset test_time
    65     72   
    66     73   unset no(epilogue.eagle)
    67     74   unset no(prologue.eagle)
    68     75   
    69     76   if {[array size no] == 0} then {unset no}
    70     77   
    71         -source [file join $test_path epilogue.eagle]
           78  +source [file join $test_all_path epilogue.eagle]

Changes to Externals/Eagle/lib/Test1.0/constraints.eagle.

    52     52       #
    53     53       # NOTE: This job of this procedure is to return the list of "known"
    54     54       #       versions of Mono supported by the test suite infrastructure.
    55     55       #
    56     56       return [list \
    57     57           [list 2 0] [list 2 2] [list 2 4] [list 2 6] [list 2 8] [list 2 10] \
    58     58           [list 2 11] [list 2 12] [list 3 0] [list 3 1] [list 3 2] [list 3 3] \
    59         -        [list 3 4] [list 3 5] [list 3 6] [list 3 8] [list 3 10] [list 3 12]]
           59  +        [list 3 4] [list 3 5] [list 3 6] [list 3 8] [list 3 10] [list 3 12] \
           60  +        [list 4 0]]
    60     61     }
    61     62   
    62     63     #
    63     64     # NOTE: This procedure was adapted from the one listed on the Tcl Wiki page
    64     65     #       at "http://wiki.tcl.tk/43".  It is only intended to be used on very
    65     66     #       small lists because of its heavy use of recursion and complexity on
    66     67     #       the order of O(N!).
................................................................................
    99    100   
   100    101       #
   101    102       # NOTE: If this Eagle version lacks [interp readylimit] -OR- it has
   102    103       #       the default value (i.e. it always fully checks readiness),
   103    104       #       return true.
   104    105       #
   105    106       return [expr {
   106         -      [catch {interp readylimit {}} readylimit] != 0 || $readylimit == 0
          107  +      [catch {interp readylimit {}} readylimit] || $readylimit == 0
   107    108       }]
   108    109     }
   109    110   
   110    111     #
   111    112     # NOTE: This procedure should return non-zero if the "whoami" command may
   112    113     #       be executed by the test suite infrastructure outside the context
   113    114     #       of any specific tests.
................................................................................
   311    312           # NOTE: If the test suite file exists, add it to the list of file
   312    313           #       names to process.
   313    314           #
   314    315           if {[file exists $fileName]} then {
   315    316             lappend fileNames $fileName
   316    317           }
   317    318         }
          319  +
          320  +      #
          321  +      # TODO: If additional test suite files are added within the base
          322  +      #       package path, add them here as well.
          323  +      #
          324  +      foreach fileNameOnly [list \
          325  +          all.eagle constraints.eagle epilogue.eagle pkgIndex.eagle \
          326  +          pkgIndex.tcl prologue.eagle] {
          327  +        #
          328  +        # NOTE: First, check if the file resides in the Eagle-specific
          329  +        #       package sub-directory.  Failing that, fallback to using
          330  +        #       the base package path itself.
          331  +        #
          332  +        set fileName [file join \
          333  +            $::test_package_path Test1.0 $fileNameOnly]
          334  +
          335  +        if {![file exists $fileName]} then {
          336  +          set fileName [file join $::test_package_path $fileNameOnly]
          337  +        }
          338  +
          339  +        #
          340  +        # NOTE: If the test suite file exists, add it to the list of file
          341  +        #       names to process.
          342  +        #
          343  +        if {[file exists $fileName]} then {
          344  +          lappend fileNames $fileName
          345  +        }
          346  +      }
   318    347       }
   319    348   
   320    349       #
   321    350       # NOTE: Check if the test package path is available.
   322    351       #
   323    352       if {[info exists ::test_path]} then {
   324    353         #
   325    354         # TODO: If additional test suite files are added within the test
   326    355         #       package path, add them here as well.
   327    356         #
   328         -      foreach fileNameOnly [list \
   329         -          all.eagle constraints.eagle epilogue.eagle pkgIndex.eagle \
   330         -          pkgIndex.tcl prologue.eagle] {
          357  +      foreach fileNameOnly [list all.eagle epilogue.eagle prologue.eagle] {
   331    358           #
   332    359           # NOTE: Check if the file resides in the test package directory.
   333    360           #
   334    361           set fileName [file join $::test_path $fileNameOnly]
   335    362   
   336    363           #
   337    364           # NOTE: If the test suite file exists, add it to the list of file
................................................................................
  1582   1609         addConstraint timeIntensive
  1583   1610   
  1584   1611         tputs $channel yes\n
  1585   1612       } else {
  1586   1613         tputs $channel no\n
  1587   1614       }
  1588   1615     }
         1616  +
         1617  +  proc checkForFullTest { channel } {
         1618  +    tputs $channel "---- checking for full testing... "
         1619  +
         1620  +    #
         1621  +    # NOTE: Are we allowed to do full testing (i.e. to run rarely
         1622  +    #       needed tests)?
         1623  +    #
         1624  +    if {![info exists ::no(fullTest)]} then {
         1625  +      addConstraint fullTest
         1626  +
         1627  +      tputs $channel yes\n
         1628  +    } else {
         1629  +      tputs $channel no\n
         1630  +    }
         1631  +  }
  1589   1632   
  1590   1633     proc checkForMemoryIntensive { channel } {
  1591   1634       tputs $channel "---- checking for memory intensive testing... "
  1592   1635   
  1593   1636       #
  1594   1637       # NOTE: Are we allowed to do memory intensive testing?
  1595   1638       #
................................................................................
  1945   1988           addConstraint strongName
  1946   1989   
  1947   1990           tputs $channel yes\n
  1948   1991         } else {
  1949   1992           tputs $channel no\n
  1950   1993         }
  1951   1994       }
         1995  +
         1996  +    proc checkForStrongNameKey { channel } {
         1997  +      tputs $channel "---- checking for strong name key... "
         1998  +
         1999  +      if {[catch {info engine PublicKeyToken} publicKeyToken] == 0 && \
         2000  +          [string length $publicKeyToken] > 0} then {
         2001  +        #
         2002  +        # NOTE: Add a test constraint for this specific strong name key.
         2003  +        #
         2004  +        addConstraint [appendArgs strongName. $publicKeyToken]
         2005  +
         2006  +        #
         2007  +        # NOTE: Show the strong name key that we found.
         2008  +        #
         2009  +        tputs $channel [appendArgs "yes (" $publicKeyToken ")\n"]
         2010  +
         2011  +        #
         2012  +        # BUGBUG: Tcl 8.4 does not seem to like this expression because it
         2013  +        #         contains the "ni" operator added in Tcl 8.5 (and Tcl 8.4
         2014  +        #         tries to compile it even though it will only be evaluated
         2015  +        #         in Eagle).
         2016  +        #
         2017  +        set expr {$publicKeyToken ni \
         2018  +            "29c6297630be05eb 1e22ec67879739a2 358030063a832bc3"}
         2019  +
         2020  +        if {[expr $expr]} then {
         2021  +          #
         2022  +          # NOTE: The Eagle core library is strong name signed with a key that
         2023  +          #       is not official.  This is also not an error, per se; however,
         2024  +          #       it may cause some tests to fail and it should be reported to
         2025  +          #       the user and noted in the test suite log file.
         2026  +          #
         2027  +          addConstraint strongName.unofficial
         2028  +
         2029  +          #
         2030  +          # NOTE: Unless forbidden, issue and log a warning.
         2031  +          #
         2032  +          if {![info exists no(warningForStrongNameKey)] && \
         2033  +              ![haveConstraint quiet]} then {
         2034  +            tputs $channel [appendArgs \
         2035  +                "==== WARNING: unofficial Eagle strong name signature " \
         2036  +                "detected: " $publicKeyToken \n]
         2037  +          }
         2038  +        } else {
         2039  +          #
         2040  +          # NOTE: Several tests require one of the official strong name keys to
         2041  +          #       be used in order for them to pass.
         2042  +          #
         2043  +          addConstraint strongName.official
         2044  +
         2045  +          tputs $channel [appendArgs \
         2046  +              "---- official Eagle strong name signature detected: " \
         2047  +              $publicKeyToken \n]
         2048  +        }
         2049  +      } else {
         2050  +        #
         2051  +        # NOTE: The Eagle core library is not signed with a strong name key.
         2052  +        #       This is not an error, per se; however, it may cause selected
         2053  +        #       tests to fail and it should be reported to the user and noted
         2054  +        #       in the test suite log file.
         2055  +        #
         2056  +        addConstraint strongName.none
         2057  +
         2058  +        #
         2059  +        # NOTE: Show that we did not find a strong name key.
         2060  +        #
         2061  +        tputs $channel no\n
         2062  +
         2063  +        #
         2064  +        # NOTE: Unless forbidden, issue and log a warning.
         2065  +        #
         2066  +        if {![info exists no(warningForStrongNameKey)] && \
         2067  +            ![haveConstraint quiet]} then {
         2068  +          tputs $channel \
         2069  +              "==== WARNING: no Eagle strong name signature detected...\n"
         2070  +        }
         2071  +      }
         2072  +    }
  1952   2073   
  1953   2074       proc checkForCertificate { channel } {
  1954   2075         tputs $channel "---- checking for certificate... "
  1955   2076   
  1956   2077         if {[catch {
  1957   2078           object invoke Interpreter.GetActive GetCertificate
  1958   2079         } certificate] == 0 && [string length $certificate] > 0} then {
................................................................................
  1963   2084           addConstraint certificate
  1964   2085   
  1965   2086           #
  1966   2087           # NOTE: Attempt to query the subject from the certificate.
  1967   2088           #
  1968   2089           if {[catch {
  1969   2090             object invoke $certificate Subject
  1970         -        } subject] != 0 || [string length $subject] == 0} then {
         2091  +        } subject] || [string length $subject] == 0} then {
  1971   2092             #
  1972   2093             # TODO: No certificate subject, better handling here?
  1973   2094             #
  1974   2095             set subject unknown
  1975   2096           }
  1976   2097   
  1977   2098           tputs $channel [appendArgs "yes (" $subject ")\n"]
................................................................................
  2065   2186         tputs $channel "---- checking for default application domain... "
  2066   2187   
  2067   2188         if {[catch {
  2068   2189           object invoke AppDomain CurrentDomain
  2069   2190         } appDomain] == 0 && [string length $appDomain] > 0} then {
  2070   2191           if {[catch {
  2071   2192             object invoke $appDomain IsDefaultAppDomain
  2072         -        } default] != 0 || [string length $default] == 0} then {
         2193  +        } default] || [string length $default] == 0} then {
  2073   2194             set default false
  2074   2195           }
  2075   2196   
  2076         -        if {[catch {object invoke $appDomain Id} id] != 0 || \
         2197  +        if {[catch {object invoke $appDomain Id} id] || \
  2077   2198               [string length $id] == 0} then {
  2078   2199             set id unknown
  2079   2200           }
  2080   2201   
  2081   2202           if {$default} then {
  2082   2203             addConstraint defaultAppDomain
  2083   2204   
................................................................................
  2372   2493   
  2373   2494           tputs $channel [appendArgs $result ", " $::tcl_platform(processBits) \
  2374   2495               -bit " " $::tcl_platform(machine) \n]
  2375   2496         } else {
  2376   2497           tputs $channel "no, unknown\n"
  2377   2498         }
  2378   2499       }
         2500  +
         2501  +    proc checkForTestCallStack { channel } {
         2502  +      tputs $channel "---- checking for test call stack... "
         2503  +
         2504  +      #
         2505  +      # NOTE: Search for a call frame with associated arguments.
         2506  +      #       At this point, there must be at least one such call
         2507  +      #       frame (this one).  Therefore, this loop will always
         2508  +      #       terminate.
         2509  +      #
         2510  +      set index 0; set arguments [list]
         2511  +      set script {info level [info level]}
         2512  +
         2513  +      while {1} {
         2514  +        set level [appendArgs ## $index]
         2515  +
         2516  +        if {[catch {uplevel $level $script} arguments] == 0} then {
         2517  +          break
         2518  +        }
         2519  +
         2520  +        incr index
         2521  +      }
         2522  +
         2523  +      #
         2524  +      # NOTE: Grab the command name from the arguments, if any.
         2525  +      #
         2526  +      set command [expr {
         2527  +        [llength $arguments] > 0 ? [lindex $arguments 0] : ""
         2528  +      }]
         2529  +
         2530  +      #
         2531  +      # HACK: Make sure the call stack does not end up confusing
         2532  +      #       the tests that rely on absolute call frames.
         2533  +      #
         2534  +      if {$command in [list checkForTestCallStack]} then {
         2535  +        addConstraint testCallStack
         2536  +
         2537  +        tputs $channel [appendArgs "yes (\"" $command "\")\n"]
         2538  +
         2539  +        #
         2540  +        # NOTE: We are done here, return now.
         2541  +        #
         2542  +        return
         2543  +      }
         2544  +
         2545  +      tputs $channel [appendArgs "no (\"" $command "\")\n"]
         2546  +    }
  2379   2547   
  2380   2548       proc checkForGarudaDll { channel } {
  2381   2549         #
  2382   2550         # NOTE: Skip automatic Tcl shell machine detection if we are not
  2383   2551         #       allowed to execute external commands.
  2384   2552         #
  2385   2553         if {[canExecTclShell]} then {
................................................................................
  3218   3386             return
  3219   3387           }
  3220   3388         }
  3221   3389   
  3222   3390         tputs $channel no\n
  3223   3391       }
  3224   3392   
  3225         -    proc checkForNetFx45 { channel } {
  3226         -      tputs $channel "---- checking for .NET Framework 4.5... "
         3393  +    proc getFrameworkSetup46Value {} {
         3394  +      #
         3395  +      # NOTE: Check if we are running on Windows 10 or later.
         3396  +      #
         3397  +      if {[isWindows] && $::tcl_platform(osVersion) >= 10.0} then {
         3398  +        #
         3399  +        # NOTE: We are running on Windows 10, return the special value.
         3400  +        #
         3401  +        return 393295
         3402  +      }
         3403  +
         3404  +      #
         3405  +      # NOTE: We are not running on Windows 10, return the normal value.
         3406  +      #
         3407  +      return 393297
         3408  +    }
         3409  +
         3410  +    proc checkForNetFx4x { channel } {
         3411  +      tputs $channel "---- checking for .NET Framework 4.x... "
  3227   3412   
  3228   3413         #
  3229   3414         # NOTE: Platform must be Windows for this constraint to even be
  3230   3415         #       checked (i.e. we require the registry).
  3231   3416         #
  3232   3417         if {[isWindows]} then {
  3233   3418           #
................................................................................
  3260   3445             #
  3261   3446             # NOTE: If the "release" value is greater than or equal to 378758
  3262   3447             #       (or 378675 for Windows 8.1), then the .NET Framework 4.5.1
  3263   3448             #       is installed.  However, if the "release" value is also
  3264   3449             #       greater than or equal to 379893, then the .NET Framework
  3265   3450             #       4.5.2 is installed, which is an in-place upgrade to 4.5.1
  3266   3451             #       (and 4.5).  If the "release" value is also greater than or
  3267         -          #       equal to 393246, then the .NET Framework 4.6 is installed,
  3268         -          #       which is an in-place upgrade to 4.5.x.
         3452  +          #       equal to 393297 (393295 on Windows 10), then the .NET
         3453  +          #       Framework 4.6 is installed, which is an in-place upgrade
         3454  +          #       to 4.5.x.
  3269   3455             #
  3270         -          # TODO: Change the value 393246 when the .NET Framework 4.6 goes
  3271         -          #       final.
  3272         -          #
  3273         -          if {$release >= 393246} then {
         3456  +          if {$release >= [getFrameworkSetup46Value]} then {
         3457  +            addConstraint dotNet451OrHigher
         3458  +            addConstraint dotNet452OrHigher
  3274   3459               addConstraint dotNet46
  3275   3460               addConstraint dotNet46OrHigher
  3276   3461   
  3277   3462               set version 4.6
  3278   3463             } elseif {$release >= 379893} then {
         3464  +            addConstraint dotNet451OrHigher
  3279   3465               addConstraint dotNet452
  3280   3466               addConstraint dotNet452OrHigher
  3281   3467   
  3282   3468               set version 4.5.2
  3283   3469             } elseif {$release >= 378675} then {
  3284   3470               addConstraint dotNet451
  3285   3471               addConstraint dotNet451OrHigher
................................................................................
  3520   3706           checkForGaruda checkForShell checkForDebug checkForTk checkForVersion \
  3521   3707           checkForCommand checkForNamespaces checkForTestExec \
  3522   3708           checkForTestMachine checkForTestPlatform checkForTestConfiguration \
  3523   3709           checkForTestSuffix checkForFile checkForPathFile checkForNativeCode \
  3524   3710           checkForTip127 checkForTip194 checkForTip207 checkForTip241 \
  3525   3711           checkForTip285 checkForTip405 checkForTip426 checkForTip429 \
  3526   3712           checkForTiming checkForPerformance checkForBigLists \
  3527         -        checkForTimeIntensive checkForMemoryIntensive checkForStackIntensive \
  3528         -        checkForInteractive checkForInteractiveCommand checkForUserInteraction \
  3529         -        checkForNetwork checkForCompileOption checkForKnownCompileOptions] \
  3530         -        false false
         3713  +        checkForTimeIntensive checkForFullTest checkForMemoryIntensive \
         3714  +        checkForStackIntensive checkForInteractive checkForInteractiveCommand \
         3715  +        checkForUserInteraction checkForNetwork checkForCompileOption \
         3716  +        checkForKnownCompileOptions] false false
  3531   3717   
  3532   3718       ###########################################################################
  3533   3719       ############################## END Tcl ONLY ###############################
  3534   3720       ###########################################################################
  3535   3721     }
  3536   3722   
  3537   3723     #
  3538   3724     # NOTE: Provide the Eagle test constraints package to the interpreter.
  3539   3725     #
  3540   3726     package provide Eagle.Test.Constraints \
  3541   3727       [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
  3542   3728   }
  3543   3729   

Changes to Externals/Eagle/lib/Test1.0/epilogue.eagle.

    21     21   
    22     22     #
    23     23     # NOTE: Verify that the current call frame is correct and that the
    24     24     #       interpreter call stack has not been imbalanced by previous
    25     25     #       tests or other errors.  This check only applies to Eagle.
    26     26     #
    27     27     if {[isEagle] && [llength [info commands object]] > 0} then {
    28         -    catch {
    29         -      #
    30         -      # NOTE: Check the name of the current call frame against the one
    31         -      #       that should be used for evaluating this script file.
    32         -      #
    33         -      if {[object invoke -flags +NonPublic \
    34         -              Interpreter.GetActive.CurrentFrame Name] ne \
    35         -          [list source [file normalize [info script]]]} then {
    36         -        unset -nocomplain test_suite_running
    37         -        error "cannot run, current frame is not for this script"
    38         -      }
           28  +    #
           29  +    # NOTE: Check the name of the current call frame against the one
           30  +    #       that should be used for evaluating this script file.
           31  +    #
           32  +    if {[object invoke -flags +NonPublic \
           33  +            Interpreter.GetActive.CurrentFrame Name] ne \
           34  +        [list source [file normalize [info script]]]} then {
           35  +      unset -nocomplain test_suite_running
           36  +      error "cannot run epilogue, current frame not for this script"
    39     37       }
    40     38     }
    41     39   
    42     40     #
    43     41     # NOTE: Make sure all the variables used by this epilogue are unset.
    44     42     #
    45     43     unset -nocomplain memory stack name count passedOrSkipped percent \

Changes to Externals/Eagle/lib/Test1.0/prologue.eagle.

    19     19       error "cannot run, current level is not global"
    20     20     }
    21     21   
    22     22     #
    23     23     # NOTE: Make sure all the variables used by this prologue are unset.
    24     24     #
    25     25     unset -nocomplain pkg_dir pattern dummy directory name value exec encoding \
    26         -      host memory stack drive publicKeyToken expr server database timeout \
    27         -      user password percent checkout timeStamp loaded
           26  +      host memory stack drive server database timeout user password percent \
           27  +      checkout timeStamp loaded
    28     28   
    29     29     #
    30     30     # NOTE: Indicate that the test suite is currently running.
    31     31     #
    32     32     if {![info exists test_suite_running] || !$test_suite_running} then {
    33     33       set test_suite_running true
    34     34     }
    35     35   
           36  +  #
           37  +  # NOTE: Set the location of the test suite package, if necessary.
           38  +  #
           39  +  if {![info exists test_all_path]} then {
           40  +    set test_all_path [file normalize [file dirname [info script]]]
           41  +  }
           42  +
    36     43     #
    37     44     # NOTE: Set the location of the test suite, if necessary.
    38     45     #
    39     46     if {![info exists test_path]} then {
    40         -    set test_path [file normalize [file dirname [info script]]]
           47  +    set test_path [file normalize [file join \
           48  +        [file dirname [file dirname $test_all_path]] Library Tests]]
    41     49     }
    42     50   
    43     51     #
    44     52     # NOTE: Set the location of the test suite data, if necessary.
    45     53     #
    46     54     if {![info exists test_data_path]} then {
    47     55       set test_data_path [file join $test_path data]
................................................................................
   177    185     # NOTE: Make sure our primary package path is part of the auto-path.
   178    186     #
   179    187     if {[lsearch -exact $auto_path $test_package_path] == -1} then {
   180    188       lappend auto_path $test_package_path
   181    189     }
   182    190   
   183    191     #
   184         -  # NOTE: Make sure our test package path is part of the auto-path.
          192  +  # NOTE: Make sure the test suite package is part of the auto-path.
          193  +  #
          194  +  if {[lsearch -exact $auto_path $test_all_path] == -1} then {
          195  +    lappend auto_path $test_all_path
          196  +  }
          197  +
          198  +  #
          199  +  # NOTE: Make sure the test suite is part of the auto-path.  This is
          200  +  #       now done for legacy compatibility only.
   185    201     #
   186    202     if {[lsearch -exact $auto_path $test_path] == -1} then {
   187    203       lappend auto_path $test_path
   188    204     }
   189    205   
   190    206     #############################################################################
   191    207   
................................................................................
   216    232     #
   217    233     # NOTE: Verify that the current call frame is correct and that the
   218    234     #       interpreter call stack has not been imbalanced by previous
   219    235     #       tests or other errors.  This check only applies to Eagle.
   220    236     #       This block requires the "Eagle.Library" package.
   221    237     #
   222    238     if {[isEagle] && [llength [info commands object]] > 0} then {
   223         -    catch {
   224         -      #
   225         -      # NOTE: Check the name of the current call frame against the one
   226         -      #       that should be used for evaluating this script file.
   227         -      #
   228         -      if {[object invoke -flags +NonPublic \
   229         -              Interpreter.GetActive.CurrentFrame Name] ne \
   230         -          [list source [file normalize [info script]]]} then {
   231         -        unset -nocomplain test_suite_running
   232         -        error "cannot run, current frame is not for this script"
   233         -      }
          239  +    #
          240  +    # NOTE: Check the name of the current call frame against the one
          241  +    #       that should be used for evaluating this script file.
          242  +    #
          243  +    if {[object invoke -flags +NonPublic \
          244  +            Interpreter.GetActive.CurrentFrame Name] ne \
          245  +        [list source [file normalize [info script]]]} then {
          246  +      unset -nocomplain test_suite_running
          247  +      error "cannot run prologue, current frame not for this script"
   234    248       }
   235    249     }
   236    250   
   237    251     #############################################################################
   238    252   
   239    253     #
   240    254     # NOTE: Set the local root directory of the source checkout (i.e. of Eagle
................................................................................
   305    319     set test_flags(-stopOnLeak) ""; # default to continue on leak.
   306    320     set test_flags(-exitOnComplete) ""; # default to not exit after complete.
   307    321     set test_flags(-preTest) ""; # default to not evaluating anything.
   308    322     set test_flags(-postTest) ""; # default to not evaluating anything.
   309    323     set test_flags(-preWait) ""; # default to not waiting.
   310    324     set test_flags(-postWait) ""; # default to not waiting.
   311    325     set test_flags(-tclsh) ""; # Tcl shell, default to empty.
          326  +  set test_flags(-bad) [list]; # these are the unrecognized arguments.
          327  +  set test_flags(-no) [list]; # default to not having any restrictions.
   312    328   
   313    329     #
   314    330     # NOTE: Check for and process any command line arguments.
   315    331     #
   316    332     if {[info exists argv]} then {
   317         -    eval processTestArguments test_flags $argv
          333  +    set test_flags(-bad) [eval processTestArguments test_flags false $argv]
   318    334   
   319    335       if {[info exists test_flags(-no)] && \
   320    336           [string length $test_flags(-no)] > 0} then {
   321    337         #
   322    338         # NOTE: Set the test run restrictions based on the provided command line
   323    339         #       argument value (which is assumed to be a "dictionary-style" list
   324    340         #       containing name/value pairs to add to the global "no" array).
................................................................................
   728    744   
   729    745     tputs $test_channel [appendArgs "---- executable: \"" \
   730    746         $bin_file \"\n]
   731    747   
   732    748     tputs $test_channel [appendArgs "---- command line: " \
   733    749         [expr {[info exists argv] && [string length $argv] > 0 ? \
   734    750             $argv : "<none>"}] \n]
          751  +
          752  +  tputs $test_channel [appendArgs "---- unrecognized arguments: " \
          753  +      [expr {[info exists test_flags(-bad)] && \
          754  +          [string length $test_flags(-bad)] > 0 ? \
          755  +              $test_flags(-bad) : "<none>"}] \n]
   735    756   
   736    757     tputs $test_channel [appendArgs "---- logging to: " \
   737    758         [expr {[info exists test_log] && [string length $test_log] > 0 ? \
   738    759             [appendArgs \" $test_log \"] : "<none>"}] \n]
   739    760   
   740    761     tputs $test_channel [appendArgs "---- pass threshold: " \
   741    762         [expr {[info exists test_threshold] && \
................................................................................
   880    901         #       "debug-1.4", "glob-99.*", "object-10.*", "perf-2.2",
   881    902         #       and various other places within the test suite code
   882    903         #       itself.
   883    904         #
   884    905         checkForQuiet $test_channel false
   885    906       }
   886    907   
   887         -    #
   888         -    # NOTE: Has strong name key detection been disabled?
   889         -    #
   890         -    if {![info exists no(strongNameKey)]} then {
   891         -      catch {info engine PublicKeyToken} publicKeyToken
   892         -
   893         -      if {[string length $publicKeyToken] == 0} then {
   894         -        #
   895         -        # NOTE: The Eagle core library is not signed with a strong name key.
   896         -        #       This is not an error, per se; however, it may cause selected
   897         -        #       tests to fail and it should be reported to the user and noted
   898         -        #       in the test suite log file.
   899         -        #
   900         -        addConstraint strongName.none
   901         -
   902         -        if {![info exists no(warningForStrongNameKey)] && \
   903         -            ![haveConstraint quiet]} then {
   904         -          tputs $test_channel \
   905         -              "==== WARNING: no Eagle strong name signature detected...\n"
   906         -        }
   907         -      } else {
   908         -        #
   909         -        # NOTE: Add a test constraint for this specific strong name key.
   910         -        #
   911         -        addConstraint [appendArgs strongName. $publicKeyToken]
   912         -
   913         -        #
   914         -        # BUGBUG: Tcl 8.4 does not seem to like this expression because it
   915         -        #         contains the "ni" operator added in Tcl 8.5 (and Tcl 8.4
   916         -        #         tries to compile it even though it will only be evaluated
   917         -        #         in Eagle).
   918         -        #
   919         -        set expr {$publicKeyToken ni \
   920         -            "29c6297630be05eb 1e22ec67879739a2 358030063a832bc3"}
   921         -
   922         -        if {[expr $expr]} then {
   923         -          #
   924         -          # NOTE: The Eagle core library is strong name signed with a key that
   925         -          #       is not official.  This is also not an error, per se; however,
   926         -          #       it may cause some tests to fail and it should be reported to
   927         -          #       the user and noted in the test suite log file.
   928         -          #
   929         -          addConstraint strongName.unofficial
   930         -
   931         -          if {![info exists no(warningForStrongNameKey)] && \
   932         -              ![haveConstraint quiet]} then {
   933         -            tputs $test_channel [appendArgs \
   934         -                "==== WARNING: unofficial Eagle strong name signature " \
   935         -                "detected: " $publicKeyToken \n]
   936         -          }
   937         -        } else {
   938         -          #
   939         -          # NOTE: Several tests require one of the official strong name keys to
   940         -          #       be used in order for them to pass.
   941         -          #
   942         -          addConstraint strongName.official
   943         -
   944         -          tputs $test_channel [appendArgs \
   945         -              "---- official Eagle strong name signature detected: " \
   946         -              $publicKeyToken \n]
   947         -        }
   948         -
   949         -        unset expr
   950         -      }
   951         -
   952         -      unset publicKeyToken
   953         -    }
   954         -
   955    908       #
   956    909       # NOTE: Has administrator detection support been disabled?  We do
   957    910       #       this check [nearly] first as it may [eventually] be used
   958    911       #       to help determine if other constraints should be skipped.
   959    912       #
   960    913       if {![info exists no(administrator)]} then {
   961    914         checkForAdministrator $test_channel
................................................................................
  1039    992       if {![info exists no(machine)]} then {
  1040    993         checkForMachine $test_channel 32 intel; # (i.e. x86)
  1041    994         checkForMachine $test_channel 32 arm;   # (i.e. arm)
  1042    995         checkForMachine $test_channel 64 ia64;  # (i.e. itanium)
  1043    996         checkForMachine $test_channel 64 amd64; # (i.e. x64)
  1044    997       }
  1045    998   
          999  +    #
         1000  +    # NOTE: Has test suite call stack probing been disabled?
         1001  +    #
         1002  +    if {![info exists no(testCallStack)]} then {
         1003  +      checkForTestCallStack $test_channel
         1004  +    }
         1005  +
  1046   1006       #
  1047   1007       # NOTE: Has culture detection support been disabled?
  1048   1008       #
  1049   1009       if {![info exists no(culture)]} then {
  1050   1010         checkForCulture $test_channel
  1051   1011       }
  1052   1012   
................................................................................
  1066   1026   
  1067   1027       #
  1068   1028       # NOTE: Has strong name detection support been disabled?
  1069   1029       #
  1070   1030       if {![info exists no(strongName)]} then {
  1071   1031         checkForStrongName $test_channel
  1072   1032       }
         1033  +
         1034  +    #
         1035  +    # NOTE: Has strong name key detection been disabled?
         1036  +    #
         1037  +    if {![info exists no(strongNameKey)]} then {
         1038  +      checkForStrongNameKey $test_channel
         1039  +    }
  1073   1040   
  1074   1041       #
  1075   1042       # NOTE: Has certificate detection support been disabled?
  1076   1043       #
  1077   1044       if {![info exists no(certificate)]} then {
  1078   1045         checkForCertificate $test_channel
  1079   1046       }
................................................................................
  1613   1580           #
  1614   1581           # NOTE: For test "lpermute-1.3".
  1615   1582           #
  1616   1583           checkForObjectMember $test_channel Eagle._Tests.Default \
  1617   1584               *TestPermute*
  1618   1585         }
  1619   1586   
         1587  +      if {![info exists no(testDynamicCallback)]} then {
         1588  +        #
         1589  +        # NOTE: For tests "object-8.1??".
         1590  +        #
         1591  +        checkForObjectMember $test_channel Eagle._Tests.Default \
         1592  +            *TestCallDynamicCallback0*
         1593  +
         1594  +        checkForObjectMember $test_channel Eagle._Tests.Default \
         1595  +            *TestCallDynamicCallback1*
         1596  +
         1597  +        checkForObjectMember $test_channel Eagle._Tests.Default \
         1598  +            *TestCallDynamicCallback2*
         1599  +
         1600  +        checkForObjectMember $test_channel Eagle._Tests.Default \
         1601  +            *TestCallDynamicCallback3*
         1602  +
         1603  +        checkForObjectMember $test_channel Eagle._Tests.Default \
         1604  +            *TestGetDynamicCallbacks*
         1605  +
         1606  +        checkForObjectMember $test_channel Eagle._Tests.Default \
         1607  +            *TestCallStaticDynamicCallback0*
         1608  +
         1609  +        checkForObjectMember $test_channel Eagle._Tests.Default \
         1610  +            *TestCallStaticDynamicCallback1*
         1611  +
         1612  +        checkForObjectMember $test_channel Eagle._Tests.Default \
         1613  +            *TestCallStaticDynamicCallback2*
         1614  +
         1615  +        checkForObjectMember $test_channel Eagle._Tests.Default \
         1616  +            *TestCallStaticDynamicCallback3*
         1617  +
         1618  +        checkForObjectMember $test_channel Eagle._Tests.Default \
         1619  +            *TestGetStaticDynamicCallbacks*
         1620  +      }
         1621  +
  1620   1622         #
  1621   1623         # NOTE: Has DateTime testing support been disabled?
  1622   1624         #
  1623   1625         if {![info exists no(testDateTime)]} then {
  1624   1626           #
  1625   1627           # NOTE: For test "vwait-1.11".
  1626   1628           #
................................................................................
  2115   2117         #
  2116   2118         # NOTE: For test "hash-1.1".
  2117   2119         #
  2118   2120         checkForNetFx20ServicePack $test_channel
  2119   2121       }
  2120   2122   
  2121   2123       #
  2122         -    # NOTE: Has .NET Framework 4.5 testing support been disabled?
         2124  +    # NOTE: Has .NET Framework 4.x testing support been disabled?
  2123   2125       #
  2124         -    if {![info exists no(netFx45)]} then {
         2126  +    if {![info exists no(netFx4x)]} then {
  2125   2127         #
  2126   2128         # NOTE: For test "object-12.1.*".
  2127   2129         #
  2128         -      checkForNetFx45 $test_channel
         2130  +      checkForNetFx4x $test_channel
  2129   2131       }
  2130   2132   
  2131   2133       #
  2132   2134       # NOTE: Has target framework testing support been disabled?
  2133   2135       #
  2134   2136       if {![info exists no(targetFramework)]} then {
  2135   2137         checkForTargetFramework $test_channel
................................................................................
  2351   2353       #
  2352   2354       # NOTE: For tests "benchmark-1.3[89]" and "benchmark-1.40".
  2353   2355       #
  2354   2356       if {![info exists no(benchmark.txt)]} then {
  2355   2357         checkForFile $test_channel [file join $test_data_path benchmark.txt]
  2356   2358       }
  2357   2359   
         2360  +    #
         2361  +    # NOTE: For test "benchmark-1.42".
         2362  +    #
         2363  +    if {![info exists no(pngDump.txt)]} then {
         2364  +      checkForFile $test_channel [file join $test_data_path pngDump.txt]
         2365  +    }
         2366  +
  2358   2367       #
  2359   2368       # NOTE: For test "garuda-1.1".
  2360   2369       #
  2361   2370       if {![info exists no(pkgAll.tcl)]} then {
  2362   2371         checkForFile $test_channel [file join $base_path Native Package \
  2363   2372             Tests all.tcl] pkgAll.tcl
  2364   2373       }
................................................................................
  2365   2374   
  2366   2375       #
  2367   2376       # NOTE: For tests "subst-1.*".
  2368   2377       #
  2369   2378       if {![info exists no(bad_subst.txt)]} then {
  2370   2379         checkForFile $test_channel [file join $test_data_path bad_subst.txt]
  2371   2380       }
         2381  +
         2382  +    #
         2383  +    # NOTE: For test "processIsolation-1.1".
         2384  +    #
         2385  +    if {![info exists no(isolated.eagle)]} then {
         2386  +      checkForFile $test_channel [file join $test_data_path isolated.eagle]
         2387  +    }
  2372   2388   
  2373   2389       #
  2374   2390       # NOTE: This is not currently used by any tests.
  2375   2391       #
  2376   2392       if {![info exists no(evaluate.eagle)]} then {
  2377   2393         checkForFile $test_channel [file join $test_data_path evaluate.eagle]
  2378   2394       }
................................................................................
  2619   2635     if {![info exists no(checkForBigLists)]} then {
  2620   2636       checkForBigLists $test_channel
  2621   2637     }
  2622   2638   
  2623   2639     if {![info exists no(checkForTimeIntensive)]} then {
  2624   2640       checkForTimeIntensive $test_channel
  2625   2641     }
         2642  +
         2643  +  if {![info exists no(checkForFullTest)]} then {
         2644  +    checkForFullTest $test_channel
         2645  +  }
  2626   2646   
  2627   2647     if {![info exists no(checkForMemoryIntensive)]} then {
  2628   2648       checkForMemoryIntensive $test_channel
  2629   2649     }
  2630   2650   
  2631   2651     if {![info exists no(checkForStackIntensive)]} then {
  2632   2652       checkForStackIntensive $test_channel