Fossil

Check-in [3a578e04]
Login

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

Overview
Comment:All test files must now call 'repo_init', using an empty string if they do not require a new repository.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | testerCleanup
Files: files | file ages | folders
SHA1:3a578e049598d1dba9e0632c552c604135051b3a
User & Date: mistachkin 2016-03-02 08:13:59
Original User & Date: drh 2016-03-02 08:13:59
Context
2016-03-02
08:25
Adjust the 'merge5' test as well. check-in: b460373e user: mistachkin tags: testerCleanup
08:13
All test files must now call 'repo_init', using an empty string if they do not require a new repository. check-in: 3a578e04 user: mistachkin tags: testerCleanup
07:31
Do not rely on 'clock seconds' (alone) being unique between 'repo_init' calls. Make temporary directory deletion more robust. Only save the current directory on the first 'repo_init' call per test. check-in: 004b3ffd user: mistachkin tags: testerCleanup
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to test/cmdline.test.

13
14
15
16
17
18
19


20
21
22
23
24
25
26
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Test command line parsing
#



proc cmd-line {testname args} {
  set i 1
  foreach {cmdline result} $args {
    fossil test-echo $cmdline
    test cmd-line-$testname.$i {[lrange [split $::RESULT \n] 3 end]=="\{argv\[2\] = \[$result\]\}"}
    incr i







>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Test command line parsing
#

repo_init ""

proc cmd-line {testname args} {
  set i 1
  foreach {cmdline result} $args {
    fossil test-echo $cmdline
    test cmd-line-$testname.$i {[lrange [split $::RESULT \n] 3 end]=="\{argv\[2\] = \[$result\]\}"}
    incr i

Changes to test/comment.test.

14
15
16
17
18
19
20




21
22
23
24
25
26
27
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Test comment formatting and printing.
#





fossil test-comment-format "" ""
test comment-1 {$RESULT eq "\n(1 lines output)"}

###############################################################################

fossil test-comment-format --decode "" ""
test comment-2 {$RESULT eq "\n(1 lines output)"}







>
>
>
>







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Test comment formatting and printing.
#

repo_init ""

###############################################################################

fossil test-comment-format "" ""
test comment-1 {$RESULT eq "\n(1 lines output)"}

###############################################################################

fossil test-comment-format --decode "" ""
test comment-2 {$RESULT eq "\n(1 lines output)"}

Changes to test/contains-selector.test.

13
14
15
16
17
18
19


20
21
22
23
24
25
26
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Test containsSelector() function in src/style.c
#



proc contains-selector {testId css selectorResultMap} {
  set css [string trim $css]
  set filename [file join $::tempPath compare-selector.css]
  set fh [open $filename w]
  puts -nonewline $fh $css
  close $fh







>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Test containsSelector() function in src/style.c
#

repo_init ""

proc contains-selector {testId css selectorResultMap} {
  set css [string trim $css]
  set filename [file join $::tempPath compare-selector.css]
  set fh [open $filename w]
  puts -nonewline $fh $css
  close $fh

Changes to test/delta1.test.

13
14
15
16
17
18
19


20
21
22
23
24
25
26
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Tests of the delta mechanism.
#



# Use test script files as the basis for this test.
#
# For each test, copy the file intact to "./t1".  Make
# some random changes in "./t2".  Then call test-delta on the
# two files to make sure that deltas between these two files
# work properly.







>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Tests of the delta mechanism.
#

repo_init ""

# Use test script files as the basis for this test.
#
# For each test, copy the file intact to "./t1".  Make
# some random changes in "./t2".  Then call test-delta on the
# two files to make sure that deltas between these two files
# work properly.

Changes to test/glob.test.

13
14
15
16
17
18
19


20
21
22
23
24
25
26
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Test glob pattern parsing
#



proc glob-parse {testname args} {
  set i 1
  foreach {pattern string result} $args {
    fossil test-glob $pattern $string
    test glob-parse-$testname.$i {$::RESULT eq $result}
    incr i







>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Test glob pattern parsing
#

repo_init ""

proc glob-parse {testname args} {
  set i 1
  foreach {pattern string result} $args {
    fossil test-glob $pattern $string
    test glob-parse-$testname.$i {$::RESULT eq $result}
    incr i

Changes to test/merge1.test.

13
14
15
16
17
18
19


20
21
22
23
24
25
26
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Tests of the 3-way merge
#



write_file_indented t1 {
  111 - This is line one of the demo program - 1111
  222 - The second line program line in code - 2222
  333 - This is a test of the merging algohm - 3333
  444 - If all goes well, we will be pleased - 4444
  555 - we think it well and other stuff too - 5555







>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Tests of the 3-way merge
#

repo_init ""

write_file_indented t1 {
  111 - This is line one of the demo program - 1111
  222 - The second line program line in code - 2222
  333 - This is a test of the merging algohm - 3333
  444 - If all goes well, we will be pleased - 4444
  555 - we think it well and other stuff too - 5555

Changes to test/merge2.test.

13
14
15
16
17
18
19


20
21
22
23
24
25
26
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Tests of the delta mechanism.
#



set filelist [glob $testdir/*]
foreach f $filelist {
  if {[file isdir $f]} continue
  set base [file root [file tail $f]]
  if {[string match "utf16*" $base]} continue
  set f1 [read_file $f]







>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Tests of the delta mechanism.
#

repo_init ""

set filelist [glob $testdir/*]
foreach f $filelist {
  if {[file isdir $f]} continue
  set base [file root [file tail $f]]
  if {[string match "utf16*" $base]} continue
  set f1 [read_file $f]

Changes to test/merge3.test.

13
14
15
16
17
18
19


20
21
22
23
24
25
26
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Tests of the 3-way merge
#



proc merge-test {testid basis v1 v2 result} {
  write_file t1 [join [string trim $basis] \n]\n
  write_file t2 [join [string trim $v1] \n]\n
  write_file t3 [join [string trim $v2] \n]\n
  fossil 3-way-merge t1 t2 t3 t4
  set x [read_file t4]







>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Tests of the 3-way merge
#

repo_init ""

proc merge-test {testid basis v1 v2 result} {
  write_file t1 [join [string trim $basis] \n]\n
  write_file t2 [join [string trim $v1] \n]\n
  write_file t3 [join [string trim $v2] \n]\n
  fossil 3-way-merge t1 t2 t3 t4
  set x [read_file t4]

Changes to test/merge4.test.

13
14
15
16
17
18
19


20
21
22
23
24
25
26
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Tests of the 3-way merge
#



proc merge-test {testid basis v1 v2 result1 result2} {
  write_file t1 [join [string trim $basis] \n]\n
  write_file t2 [join [string trim $v1] \n]\n
  write_file t3 [join [string trim $v2] \n]\n
  fossil 3-way-merge t1 t2 t3 t4
  fossil 3-way-merge t1 t3 t2 t5







>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Tests of the 3-way merge
#

repo_init ""

proc merge-test {testid basis v1 v2 result1 result2} {
  write_file t1 [join [string trim $basis] \n]\n
  write_file t2 [join [string trim $v1] \n]\n
  write_file t3 [join [string trim $v2] \n]\n
  fossil 3-way-merge t1 t2 t3 t4
  fossil 3-way-merge t1 t3 t2 t5

Changes to test/tester.tcl.

197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
...
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
...
248
249
250
251
252
253
254
255





256
257
258
259
260
261
262
...
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
...
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613

614
615
616
617
618
619
620
621
622
623
624

625
626
627
628
629
630
631
    set projectName <unknown>
    set localRoot <unknown>
    regexp -line -- {^project-name: (.*)$} $res dummy projectName
    set projectName [string trim $projectName]
    regexp -line -- {^local-root: (.*)$} $res dummy localRoot
    set localRoot [string trim $localRoot]
    error "Detected an open checkout of project \"$projectName\",\
rooted at \"$localRoot\", testing halted"
  }
}

proc get_script_or_fail {} {
  set fileName [file normalize [info script]]
  if {[string length $fileName] == 0 || ![file exists $fileName]} {
    error "Failed to obtain the file name of the test being run."
................................................................................
    } else {
      if {[catch {file delete $path} error] == 0} {
        return
      }
    }
    after [expr {$try * 100}]
  }
  error "cannot delete \"$path\": $error"
}

proc test_cleanup {} {
  if {![info exists ::tempRepoPath]} {return}
  if {![file exists $::tempRepoPath]} {return}
  if {![file isdirectory $::tempRepoPath]} {return}
  set tempPathEnd [expr {[string length $::tempPath] - 1}]
................................................................................
    robust_delete $repoPath YES_DO_IT; # FORCE, arbitrary children.
    set seedPath [file join $::tempRepoPath $repoSeed]
    robust_delete $seedPath; # NO FORCE.
  }
  # Next, attempt to gracefully delete the temporary repository directory
  # for this process.
  robust_delete $::tempRepoPath
  # Finally, attempt to gracefully delete the temporary home directory.





  if {$::tcl_platform(platform) eq "windows"} {
    robust_delete [file join $::tempHomePath _fossil]
  } else {
    robust_delete [file join $::tempHomePath .fossil]
  }
  robust_delete $::tempHomePath
}
................................................................................
}

#
# Create and open a new Fossil repository and clean the checkout
#
proc repo_init {{filename ".rep.fossil"}} {
  set_home_to_elsewhere

  set ::tempRepoPath [file join $::tempPath repo_[pid]]

  set repoSeed [appendArgs [string trim [clock seconds] -] _ [getSeqNo]]
  lappend ::tempRepoSeeds $repoSeed
  set repoPath [file join \
      $::tempRepoPath $repoSeed [file tail [get_script_or_fail]]]
  if {[catch {
    file mkdir $repoPath
  } error] != 0} {
    error "could not make directory \"$repoPath\",\
please set TEMP variable in environment: $error"
  }
  if {![info exists ::tempSavedPwd]} {set ::tempSavedPwd [pwd]}; cd $repoPath

  exec $::fossilexe new $filename
  exec $::fossilexe open $filename
  exec $::fossilexe set mtime-changes off

}

# This procedure only returns non-zero if the Tcl integration feature was
# enabled at compile-time and is now enabled at runtime.
proc is_tcl_usable_by_fossil {} {
  fossil test-th-eval "hasfeature tcl"
  if {$::RESULT ne "1"} {return 0}
................................................................................

set tempPath [file normalize $tempPath]

if {[catch {
  set tempFile [file join $tempPath temporary.txt]
  write_file $tempFile [clock seconds]; file delete $tempFile
} error] != 0} {
  error "could not write file \"$tempFile\" in directory \"$tempPath\",\
please set TEMP variable in environment: $error"
}

set tempHomePath [file join $tempPath home_[pid]]

if {[catch {
  file mkdir $tempHomePath
} error] != 0} {
  error "could not make directory \"$tempHomePath\",\
please set TEMP variable in environment: $error"
}

protInit $fossilexe

foreach testfile $argv {
  set dir [file root [file tail $testfile]]
  file delete -force $dir
  file mkdir $dir
  set origwd [pwd]
  cd $dir
  protOut "***** $testfile ******"
  source $testdir/$testfile.test
  protOut "***** End of $testfile: [llength $bad_test] errors so far ******"
  cd $origwd
}

set nErr [llength $bad_test]
if {$nErr>0 || !$::QUIET} {
  protOut "***** Final results: $nErr errors out of $test_count tests" 1
}
if {$nErr>0} {
  protOut "***** Considered failures: $bad_test" 1
}







|







 







|







 







|
>
>
>
>
>







 







>
|
>







|
|


>
|
|
|
>







 







|
|







|
|



>

<
<
<
<
<



<

>







197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
...
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
...
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
...
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
...
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624





625
626
627

628
629
630
631
632
633
634
635
636
    set projectName <unknown>
    set localRoot <unknown>
    regexp -line -- {^project-name: (.*)$} $res dummy projectName
    set projectName [string trim $projectName]
    regexp -line -- {^local-root: (.*)$} $res dummy localRoot
    set localRoot [string trim $localRoot]
    error "Detected an open checkout of project \"$projectName\",\
rooted at \"$localRoot\", testing halted."
  }
}

proc get_script_or_fail {} {
  set fileName [file normalize [info script]]
  if {[string length $fileName] == 0 || ![file exists $fileName]} {
    error "Failed to obtain the file name of the test being run."
................................................................................
    } else {
      if {[catch {file delete $path} error] == 0} {
        return
      }
    }
    after [expr {$try * 100}]
  }
  error "Could not delete \"$path\", error: $error"
}

proc test_cleanup {} {
  if {![info exists ::tempRepoPath]} {return}
  if {![file exists $::tempRepoPath]} {return}
  if {![file isdirectory $::tempRepoPath]} {return}
  set tempPathEnd [expr {[string length $::tempPath] - 1}]
................................................................................
    robust_delete $repoPath YES_DO_IT; # FORCE, arbitrary children.
    set seedPath [file join $::tempRepoPath $repoSeed]
    robust_delete $seedPath; # NO FORCE.
  }
  # Next, attempt to gracefully delete the temporary repository directory
  # for this process.
  robust_delete $::tempRepoPath
  # Finally, attempt to gracefully delete the temporary home directory,
  # unless forbidden by external forces.
  if {![info exists ::tempKeepHome]} {delete_temporary_home}
}

proc delete_temporary_home {} {
  if {$::tcl_platform(platform) eq "windows"} {
    robust_delete [file join $::tempHomePath _fossil]
  } else {
    robust_delete [file join $::tempHomePath .fossil]
  }
  robust_delete $::tempHomePath
}
................................................................................
}

#
# Create and open a new Fossil repository and clean the checkout
#
proc repo_init {{filename ".rep.fossil"}} {
  set_home_to_elsewhere
  if {![info exists ::tempRepoPath]} {
    set ::tempRepoPath [file join $::tempPath repo_[pid]]
  }
  set repoSeed [appendArgs [string trim [clock seconds] -] _ [getSeqNo]]
  lappend ::tempRepoSeeds $repoSeed
  set repoPath [file join \
      $::tempRepoPath $repoSeed [file tail [get_script_or_fail]]]
  if {[catch {
    file mkdir $repoPath
  } error] != 0} {
    error "Could not make directory \"$repoPath\",\
please set TEMP variable in environment, error: $error"
  }
  if {![info exists ::tempSavedPwd]} {set ::tempSavedPwd [pwd]}; cd $repoPath
  if {[string length $filename] > 0} {
    exec $::fossilexe new $filename
    exec $::fossilexe open $filename
    exec $::fossilexe set mtime-changes off
  }
}

# This procedure only returns non-zero if the Tcl integration feature was
# enabled at compile-time and is now enabled at runtime.
proc is_tcl_usable_by_fossil {} {
  fossil test-th-eval "hasfeature tcl"
  if {$::RESULT ne "1"} {return 0}
................................................................................

set tempPath [file normalize $tempPath]

if {[catch {
  set tempFile [file join $tempPath temporary.txt]
  write_file $tempFile [clock seconds]; file delete $tempFile
} error] != 0} {
  error "Could not write file \"$tempFile\" in directory \"$tempPath\",\
please set TEMP variable in environment, error: $error"
}

set tempHomePath [file join $tempPath home_[pid]]

if {[catch {
  file mkdir $tempHomePath
} error] != 0} {
  error "Could not make directory \"$tempHomePath\",\
please set TEMP variable in environment, error: $error"
}

protInit $fossilexe
set ::tempKeepHome 1
foreach testfile $argv {





  protOut "***** $testfile ******"
  source $testdir/$testfile.test
  protOut "***** End of $testfile: [llength $bad_test] errors so far ******"

}
unset ::tempKeepHome; delete_temporary_home
set nErr [llength $bad_test]
if {$nErr>0 || !$::QUIET} {
  protOut "***** Final results: $nErr errors out of $test_count tests" 1
}
if {$nErr>0} {
  protOut "***** Considered failures: $bad_test" 1
}

Changes to test/th1-docs.test.

13
14
15
16
17
18
19


20
21
22
23
24
25
26
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# TH1 Docs
#



fossil test-th-eval "hasfeature th1Docs"

if {$::RESULT ne "1"} {
  puts "Fossil was not compiled with TH1 docs support."; return
}








>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# TH1 Docs
#

repo_init ""

fossil test-th-eval "hasfeature th1Docs"

if {$::RESULT ne "1"} {
  puts "Fossil was not compiled with TH1 docs support."; return
}

Changes to test/utf.test.

13
14
15
16
17
18
19


20
21
22
23
24
25
26
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Test UTF-8/UTF-16 detection
#



proc swap_byte_order {str} {
  set result ""
  for {set i 0} {$i < [string length $str]} {incr i} {
    set c [scan [string index $str $i] %c]
    set c [expr {(($c << 8) & 0xFF00) | (($c >> 8) & 0xFF)}]
    append result [format %c $c]







>
>







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
#   drh@hwaci.com
#   http://www.hwaci.com/drh/
#
############################################################################
#
# Test UTF-8/UTF-16 detection
#

repo_init ""

proc swap_byte_order {str} {
  set result ""
  for {set i 0} {$i < [string length $str]} {incr i} {
    set c [scan [string index $str $i] %c]
    set c [expr {(($c << 8) & 0xFF00) | (($c >> 8) & 0xFF)}]
    append result [format %c $c]