System.Data.SQLite

Check-in [62de6a5613]
Login

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

Overview
Comment:Update Eagle script library in externals to support logging of test setting overrides to the test log file.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 62de6a56130931a3c1a06f89c7ef9720a7613e84
User & Date: mistachkin 2012-05-05 00:25:39.606
Context
2012-05-05
01:22
Fix some comments. check-in: 3e63eb3d59 user: mistachkin tags: trunk
00:25
Update Eagle script library in externals to support logging of test setting overrides to the test log file. check-in: 62de6a5613 user: mistachkin tags: trunk
2012-05-04
20:09
Commit any changes back to the original connection pool list prior to returning the connection handle from the pool. check-in: 35b8195272 user: mistachkin tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to Externals/Eagle/lib/Eagle1.0/init.eagle.
221
222
223
224
225
226
227
















































228
229
230
231
232
233
234
      # NOTE: Grab the value at the specified column.
      #
      set result [getColumnValue $row $column $default $wrap]
    }

    return $result
  }

















































  proc readFile { fileName } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set file_id [open $fileName RDONLY]
    fconfigure $file_id -encoding binary -translation binary; # BINARY DATA







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
      # NOTE: Grab the value at the specified column.
      #
      set result [getColumnValue $row $column $default $wrap]
    }

    return $result
  }

  proc tqputs { channel string } {
    #
    # NOTE: If an output channel was provided, use it; otherwise, ignore the
    #       message.
    #
    if {[string length $channel] > 0} then {
      puts -nonewline $channel $string
    }

    tqlog $string
  }

  proc tqlog { string } {
    #
    # NOTE: If an empty string is supplied by the caller, do nothing.
    #
    if {[string length $string] > 0} then {
      #
      # NOTE: *SPECIAL* The special global variable "test_log_queue" is used
      #       by the [tlog] script library procedure from the test package to
      #       enable it to emit "queued" data into the test log file prior to
      #       emitting the string requested by its caller.  The only job for
      #       this procedure is to populate the "test_log_queue" variable for
      #       later use by the test package.
      #
      if {[info exists ::test_log_queue]} then {
        #
        # NOTE: Use the next queued test log entry.
        #
        set entry [expr {[array size ::test_log_queue] + 1}]
      } else {
        #
        # NOTE: Use the first queued test log entry.
        #
        set entry 1
      }

      #
      # NOTE: Add the new entry to the test log queue.  All entries will be
      #       sent to the actual test log file the very next time the [tlog]
      #       command from the test package is executed.
      #
      set ::test_log_queue($entry) $string
    }

    return ""
  }

  proc readFile { fileName } {
    #
    # NOTE: This should work properly in both Tcl and Eagle.
    #
    set file_id [open $fileName RDONLY]
    fconfigure $file_id -encoding binary -translation binary; # BINARY DATA
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
    # NOTE: Exports the necessary commands from this package and import them
    #       into the global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list \
        exportAndImportPackageCommands isEagle isMono getEnvironmentVariable \
        getPluginPath getDictionaryValue getColumnValue getRowColumnValue \
        appendArgs haveGaruda lappendArgs readFile filter map reduce \
        getPlatformInfo execShell combineFlags] false false

    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }

  #
  # NOTE: Provide the Eagle library package to the interpreter.
  #
  package provide Eagle.Library \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}








|













1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
    # NOTE: Exports the necessary commands from this package and import them
    #       into the global namespace.
    #
    exportAndImportPackageCommands [namespace current] [list \
        exportAndImportPackageCommands isEagle isMono getEnvironmentVariable \
        getPluginPath getDictionaryValue getColumnValue getRowColumnValue \
        appendArgs haveGaruda lappendArgs readFile filter map reduce \
        getPlatformInfo execShell combineFlags tqputs tqlog] false false

    ###########################################################################
    ############################## END Tcl ONLY ###############################
    ###########################################################################
  }

  #
  # NOTE: Provide the Eagle library package to the interpreter.
  #
  package provide Eagle.Library \
    [expr {[isEagle] ? [info engine PatchLevel] : "1.0"}]
}

Changes to Externals/Eagle/lib/Eagle1.0/test.eagle.
38
39
40
41
42
43
44
45
46
47
48
49
50


























51

52
53
54
55
56
57
58
    }

    tlog $string
  }

  proc tlog { string } {
    #
    # NOTE: If a log file was configured, use it; otherwise,
    #       ignore the message.
    #
    set fileName [getTestLog]

    if {[string length $fileName] > 0} then {


























      appendSharedLogFile $fileName $string

    }
  }

  proc getSoftwareRegistryKey { wow64 } {
    if {$wow64 && [info exists ::tcl_platform(machine)] && \
        $::tcl_platform(machine) eq "amd64"} then {
      #







|
|




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>







38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
    }

    tlog $string
  }

  proc tlog { string } {
    #
    # NOTE: If a test log file was configured, use it; otherwise, ignore the
    #       message.
    #
    set fileName [getTestLog]

    if {[string length $fileName] > 0} then {
      #
      # NOTE: Check for any queued test log data that needs to be sent to the
      #       log file prior to sending the current string.
      #
      if {[info exists ::test_log_queue]} then {
        #
        # NOTE: Process each queued test log entry, in order, sending them to
        #       the test log file (as long as they are not empty strings).
        #       Each entry is removed from the queue after it is sent to the
        #       test log file.
        #
        foreach entry [lsort -integer [array names ::test_log_queue]] {
          set newString $::test_log_queue($entry)

          if {[string length $newString] > 0} then {
            appendSharedLogFile $fileName $newString
          }

          unset ::test_log_queue($entry)
        }
      }

      #
      # NOTE: If an empty string is supplied by the caller, do nothing.
      #
      if {[string length $string] > 0} then {
        appendSharedLogFile $fileName $string
      }
    }
  }

  proc getSoftwareRegistryKey { wow64 } {
    if {$wow64 && [info exists ::tcl_platform(machine)] && \
        $::tcl_platform(machine) eq "amd64"} then {
      #
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245







246
247
248
249
250
251
252
253
254
255
256
257





258
259
260
261
262
263
264
            "\", it does not exist\n"]
      }
    }
  }

  proc processTestArguments { varName args } {
    #
    # NOTE: We are going to place the configured options in
    #       the variable identified by the name provided by
    #       the caller.
    #
    upvar 1 $varName array

    #
    # TODO: Add more support for standard tcltest options here.
    #
    set options [list -configuration -constraints -exitOnComplete -file \
        -logFile -match -no -notFile -postTest -preTest -skip -stopOnFailure \
        -suffix -threshold]

    foreach {name value} $args {







      if {[lsearch -exact $options $name] != -1} then {
        set array($name) $value

        tputs $::test_channel [appendArgs \
            "---- overrode test option \"" $name "\" with value \"" $value \
            \"\n]
      } else {
        tputs $::test_channel [appendArgs \
            "---- unknown test option \"" $name "\" with value \"" $value \
            "\" ignored\n"]
      }
    }





  }

  proc getTemporaryPath {} {
    #
    # NOTE: Build the list of "temporary directory" override
    #       environment variables to check.
    #







|
|
<











>
>
>
>
>
>
>



|



|




>
>
>
>
>







252
253
254
255
256
257
258
259
260

261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
            "\", it does not exist\n"]
      }
    }
  }

  proc processTestArguments { varName args } {
    #
    # NOTE: We are going to place the configured options in the variable
    #       identified by the name provided by the caller.

    #
    upvar 1 $varName array

    #
    # TODO: Add more support for standard tcltest options here.
    #
    set options [list -configuration -constraints -exitOnComplete -file \
        -logFile -match -no -notFile -postTest -preTest -skip -stopOnFailure \
        -suffix -threshold]

    foreach {name value} $args {
      #
      # NOTE: Use the [tqputs] command here just in case the test log file
      #       has not been setup yet (i.e. by default, this procedure is
      #       almost always called by the test prologue file prior to the
      #       test log file having been setup and we do not want to just
      #       lose this output).
      #
      if {[lsearch -exact $options $name] != -1} then {
        set array($name) $value

        tqputs $::test_channel [appendArgs \
            "---- overrode test option \"" $name "\" with value \"" $value \
            \"\n]
      } else {
        tqputs $::test_channel [appendArgs \
            "---- unknown test option \"" $name "\" with value \"" $value \
            "\" ignored\n"]
      }
    }

    #
    # NOTE: Now, attempt to flush the test log queue, if available.
    #
    tlog ""
  }

  proc getTemporaryPath {} {
    #
    # NOTE: Build the list of "temporary directory" override
    #       environment variables to check.
    #
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
          if {[lindex $args 0] eq "-nonewline"} then {
            set channel [lindex $args 1]
            set newLine ""
          }
        }
      }

      if {[info exists channel]} then {
        if {$channel eq "stdout"} then {
          #
          # NOTE: Write output for stdout to the test channel.
          #
          return [tputs $::test_channel [appendArgs [lindex $args end] \
              $newLine]]
        }
      }

      #
      # NOTE: If we haven't returned by now, we don't know how to
      #       handle the input.  Let puts handle it.
      #
      return [eval ::tcl::save::puts $args]







|
<
|
|
|
|
|
<







578
579
580
581
582
583
584
585

586
587
588
589
590

591
592
593
594
595
596
597
          if {[lindex $args 0] eq "-nonewline"} then {
            set channel [lindex $args 1]
            set newLine ""
          }
        }
      }

      if {[info exists channel] && $channel eq "stdout"} then {

        #
        # NOTE: Write output for stdout to the test channel.
        #
        return [tputs $::test_channel [appendArgs [lindex $args end] \
            $newLine]]

      }

      #
      # NOTE: If we haven't returned by now, we don't know how to
      #       handle the input.  Let puts handle it.
      #
      return [eval ::tcl::save::puts $args]
Changes to Externals/Eagle/lib/Eagle1.0/vendor.eagle.
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
      set result 0

      foreach varName $varNames {
        if {[uplevel 1 [list info exists $varName]]} then {
          incr result

          if {!$quiet} then {
            puts -nonewline $channel [appendArgs \
                "Found vendor-specific test override \"" $varName "\".\n"]
          }
        }
      }

      return $result
    }








|
|







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
      set result 0

      foreach varName $varNames {
        if {[uplevel 1 [list info exists $varName]]} then {
          incr result

          if {!$quiet} then {
            tqputs $channel [appendArgs \
                "---- found vendor-specific test override \"" $varName "\".\n"]
          }
        }
      }

      return $result
    }

93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
          #
          if {![info exists ::env(EAGLELIBPATH)] || \
              [lsearch -exact $::env(EAGLELIBPATH) $dir2] == -1} then {
            #
            # NOTE: If we have NOT been instructed to be quiet, report now.
            #
            if {!$quiet} then {
              puts -nonewline $channel [appendArgs \
                  "Found vendor-specific test package directory \"" $dir2 \
                  "\", adding...\n"]
            }

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







|
|
|







93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
          #
          if {![info exists ::env(EAGLELIBPATH)] || \
              [lsearch -exact $::env(EAGLELIBPATH) $dir2] == -1} then {
            #
            # NOTE: If we have NOT been instructed to be quiet, report now.
            #
            if {!$quiet} then {
              tqputs $channel [appendArgs \
                  "---- found vendor-specific test package directory \"" \
                  $dir2 "\", adding...\n"]
            }

            #
            # NOTE: Append the directory to the necessary environment variable
            #       so that it will get picked up when Eagle actually rebuilds
            #       the auto-path list (below).
            #
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
        set dir [file dirname $dir]
      }

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

      #
      # NOTE: Directory not found, return failure.
      #
      return false
    }

    proc setupInterpreterTestPath { channel dir quiet } {
      set testPath [object invoke -flags +NonPublic Interpreter.GetActive \
          TestPath]

      if {$dir ne $testPath} then {
        object invoke -flags +NonPublic Interpreter.GetActive TestPath $dir

        if {!$quiet} then {
          puts -nonewline $channel [appendArgs \
              "Set interpreter test path to \"" $dir \".\n]
        }
      }
    }

    checkForTestOverrides stdout \
        [list binary_directory build_base_directory build_directory \
              common_directory connection_flags database_directory \







|
|
















|
|







128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
        set dir [file dirname $dir]
      }

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

      #
      # NOTE: Directory not found, return failure.
      #
      return false
    }

    proc setupInterpreterTestPath { channel dir quiet } {
      set testPath [object invoke -flags +NonPublic Interpreter.GetActive \
          TestPath]

      if {$dir ne $testPath} then {
        object invoke -flags +NonPublic Interpreter.GetActive TestPath $dir

        if {!$quiet} then {
          tqputs $channel [appendArgs \
              "---- set interpreter test path to \"" $dir \".\n]
        }
      }
    }

    checkForTestOverrides stdout \
        [list binary_directory build_base_directory build_directory \
              common_directory connection_flags database_directory \
Changes to Tests/tkt-996d13cd87.eagle.
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
        object invoke -flags +NonPublic \
            System.Data.SQLite.SQLiteConnectionPool _poolClosed 0
    }] == 0} then {
      set havePoolCounts true
    } else {
      set havePoolCounts false

      tputs $test_channel [appendArgs \
          "==== WARNING: connection pool counts are not available\n"]
    }

    proc getPoolCounts {} {
      #
      # NOTE: If we have the ability to determine the opened/closed pool
      #       counts, fetch them now; otherwise, just set them to zero.
      #







|
|







34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
        object invoke -flags +NonPublic \
            System.Data.SQLite.SQLiteConnectionPool _poolClosed 0
    }] == 0} then {
      set havePoolCounts true
    } else {
      set havePoolCounts false

      tputs $test_channel \
          "==== WARNING: connection pool counts are not available\n"
    }

    proc getPoolCounts {} {
      #
      # NOTE: If we have the ability to determine the opened/closed pool
      #       counts, fetch them now; otherwise, just set them to zero.
      #