System.Data.SQLite

Check-in [b7162effee]
Login

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

Overview
Comment:Enhance the test suite infrastructure to handle having the tests in their own directory.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b7162effee741b1c3a4d8396422c51c8a9728fbc
User & Date: mistachkin 2015-06-06 00:24:07.052
Context
2015-06-09
20:24
Use the correct PRAGMA to set the journal mode while opening a connection with ZipVFS enabled. check-in: acdc40ff05 user: mistachkin tags: trunk
2015-06-06
00:24
Enhance the test suite infrastructure to handle having the tests in their own directory. check-in: b7162effee user: mistachkin tags: trunk
2015-06-05
22:04
Refactor how the test suite infrastructure package is handled. check-in: 8728586263 user: mistachkin tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to Externals/Eagle/lib/Eagle1.0/vendor.eagle.
209
210
211
212
213
214
215














































































216
217
218
219
220
221
222
      }

      #
      # NOTE: Directory not found, return failure.
      #
      return false
    }















































































    proc setupInterpreterTestPath { channel dir quiet } {
      if {[llength [info commands debug]] > 0 && \
          [llength [info subcommands debug testpath]] > 0 && \
          [catch {debug testpath} testPath] == 0} then {
        if {$dir ne $testPath} then {
          debug testpath $dir







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







209
210
211
212
213
214
215
216
217
218
219
220
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
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
      }

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

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

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

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

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

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

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

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

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












305
306
307
308
309
310
311
312
313
314
315
316
317
318
    checkForTestOverrides stdout [expr {[info exists test_overrides] ? \
        $test_overrides : [list binary_directory build_base_directory \
        build_directory common_directory connection_flags database_directory \
        datetime_format execute_on_setup release_version scratch_directory \
        temporary_directory test_clr test_clr_v2 test_clr_v4 \
        test_configuration test_configurations test_constraints test_machine \
        test_net_fx test_overrides test_platform test_suite test_year \
        test_years test_year_clr_v2 test_year_clr_v4 vendor_directory]}] false


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

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

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













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

          "vendor_directory"}] [info exists ::env(quietAddTestSuiteToAutoPath)]

      unset have_vendor_directory













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

    #
    # HACK: Prevent the Eagle core test suite infrastructure from checking
    #       test constraints that are time-consuming and/or most likely to







|
>
















|
|






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









|
>
|



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





|
|







337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
    checkForTestOverrides stdout [expr {[info exists test_overrides] ? \
        $test_overrides : [list binary_directory build_base_directory \
        build_directory common_directory connection_flags database_directory \
        datetime_format execute_on_setup release_version scratch_directory \
        temporary_directory test_clr test_clr_v2 test_clr_v4 \
        test_configuration test_configurations test_constraints test_machine \
        test_net_fx test_overrides test_platform test_suite test_year \
        test_years test_year_clr_v2 test_year_clr_v4 vendor_directory \
        vendor_test_directory]}] false

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

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

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

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

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

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

      unset have_vendor_directory

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

      unset have_vendor_test_directory

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

    #
    # HACK: Prevent the Eagle core test suite infrastructure from checking
    #       test constraints that are time-consuming and/or most likely to
Changes to lib/System.Data.SQLite/common.eagle.
2283
2284
2285
2286
2287
2288
2289

2290
2291
2292
2293
2294
2295
2296
      return $code
    }

    proc setupDbInterruptCallback { channel log } {
      tputs $channel "---- setting up debugger interrupt callback... "

      if {[catch {

        set ::env(quietSetupInterpreterTestPath) 1

        try {
          #
          # NOTE: Make sure the script debugger and the isolated interpreter
          #       are setup and ready for use.
          #







>







2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
      return $code
    }

    proc setupDbInterruptCallback { channel log } {
      tputs $channel "---- setting up debugger interrupt callback... "

      if {[catch {
        set ::env(quietFindInterpreterTestPath) 1
        set ::env(quietSetupInterpreterTestPath) 1

        try {
          #
          # NOTE: Make sure the script debugger and the isolated interpreter
          #       are setup and ready for use.
          #
2349
2350
2351
2352
2353
2354
2355

2356
2357
2358
2359
2360
2361
2362
                    "==== WARNING: cannot cancel any queries: " \
                    "the \"object\" command is not available\n"]
              }
            }
          }}
        } finally {
          catch {unset ::env(quietSetupInterpreterTestPath)}

        }
      } error] == 0} then {
        addConstraint interruptCallback.sqlite3

        tputs $channel yes\n
      } else {
        tputs $channel [appendArgs "no, error: " \n\t $error \n]







>







2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
                    "==== WARNING: cannot cancel any queries: " \
                    "the \"object\" command is not available\n"]
              }
            }
          }}
        } finally {
          catch {unset ::env(quietSetupInterpreterTestPath)}
          catch {unset ::env(quietFindInterpreterTestPath)}
        }
      } error] == 0} then {
        addConstraint interruptCallback.sqlite3

        tputs $channel yes\n
      } else {
        tputs $channel [appendArgs "no, error: " \n\t $error \n]