Fossil

Check-in [004b3ffd]
Login

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

Overview
Comment: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.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | testerCleanup
Files: files | file ages | folders
SHA1:004b3ffd938fd87c21caf220a77e9765cc2cf582
User & Date: mistachkin 2016-03-02 07:31:15
Context
2016-03-02
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
07:13
Refactoring, fixes to the previous check-in, etc. check-in: cda4cc8b user: mistachkin tags: testerCleanup
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to test/tester.tcl.

208
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
...
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
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."
  }
  return $fileName
}


















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}]
  if {[string length $::tempPath] == 0 || \
      [string range $::tempRepoPath 0 $tempPathEnd] ne $::tempPath} {
    error "Temporary repository path has wrong parent during cleanup."
  }
  if {[info exists ::tempSavedPwd]} {
    cd $::tempSavedPwd; unset ::tempSavedPwd
  }
  # First, attempt to delete the specific temporary repository directories
  # for this test file.
  set scriptName [file tail [get_script_or_fail]]
  foreach repoSeed $::tempRepoSeeds {
    set repoPath [file join $::tempRepoPath $repoSeed $scriptName]
    catch {file delete -force $repoPath}; # FORCE, arbitrary children.
    set seedPath [file join $::tempRepoPath $repoSeed]
    catch {file delete $seedPath}; # NO FORCE.
  }
  # Next, attempt to gracefully delete the temporary repository directory
  # for this process.
  catch {file delete $::tempRepoPath}
  # Finally, attempt to gracefully delete the temporary home directory.
  if {$::tcl_platform(platform) eq "windows"} {
    catch {file delete [file join $::tempHomePath _fossil]}
  } else {
    catch {file delete [file join $::tempHomePath .fossil]}
  }
  catch {file delete $::tempHomePath}
}

proc is_home_elsewhere {} {
  return [expr {[info exists ::env(FOSSIL_HOME)] && \
      $::env(FOSSIL_HOME) eq $::tempHomePath}]
}

................................................................................
}

#
# Create and open a new Fossil repository and clean the checkout
#
proc repo_init {{filename ".rep.fossil"}} {
  set_home_to_elsewhere
  set repoSeed [string trim [clock seconds] -]
  set ::tempRepoPath [file join $::tempPath repo_[pid]]

  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"
  }
  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.







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










<
|
<





|

|



|


|

|

|







 







<

>









|







208
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
...
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
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."
  }
  return $fileName
}

proc robust_delete { path {force ""} } {
  set error "unknown error"
  for {set try 0} {$try < 10} {incr try} {
    if {$force eq "YES_DO_IT"} {
      if {[catch {file delete -force $path} error] == 0} {
        return
      }
    } 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}]
  if {[string length $::tempPath] == 0 || \
      [string range $::tempRepoPath 0 $tempPathEnd] ne $::tempPath} {
    error "Temporary repository path has wrong parent during cleanup."
  }

  if {[info exists ::tempSavedPwd]} {cd $::tempSavedPwd; unset ::tempSavedPwd}

  # First, attempt to delete the specific temporary repository directories
  # for this test file.
  set scriptName [file tail [get_script_or_fail]]
  foreach repoSeed $::tempRepoSeeds {
    set repoPath [file join $::tempRepoPath $repoSeed $scriptName]
    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
}

proc is_home_elsewhere {} {
  return [expr {[info exists ::env(FOSSIL_HOME)] && \
      $::env(FOSSIL_HOME) eq $::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.