diff options
author | Hans-Christoph Steiner <hans@eds.org> | 2013-01-17 14:18:26 -0500 |
---|---|---|
committer | Hans-Christoph Steiner <hans@eds.org> | 2013-01-17 14:18:26 -0500 |
commit | 1b5ba8e022836fa8ab93bc90df1b34a29ea6e134 (patch) | |
tree | e2a832468ccbf52965f18c37b3c4e692fe97ed06 /test/tester.tcl | |
parent | 487e15dc239ccdb3344d1c99ce120e872bab4a74 (diff) |
Imported Upstream version 2.1.1
Diffstat (limited to 'test/tester.tcl')
-rw-r--r-- | test/tester.tcl | 30 |
1 files changed, 30 insertions, 0 deletions
diff --git a/test/tester.tcl b/test/tester.tcl index 07eebcb..68b2c8d 100644 --- a/test/tester.tcl +++ b/test/tester.tcl @@ -19,6 +19,8 @@ # # Commands to manipulate the db and the file-system at a high level: # +# is_relative_file +# test_pwd # get_pwd # copy_file FROM TO # delete_file FILENAME @@ -212,6 +214,34 @@ proc do_copy_file {force from to} { } } +# Check if a file name is relative +# +proc is_relative_file { file } { + return [expr {[file pathtype $file] != "absolute"}] +} + +# If the VFS supports using the current directory, returns [pwd]; +# otherwise, it returns only the provided suffix string (which is +# empty by default). +# +proc test_pwd { args } { + if {[llength $args] > 0} { + set suffix1 [lindex $args 0] + if {[llength $args] > 1} { + set suffix2 [lindex $args 1] + } else { + set suffix2 $suffix1 + } + } else { + set suffix1 ""; set suffix2 "" + } + ifcapable curdir { + return "[get_pwd]$suffix1" + } else { + return $suffix2 + } +} + # Delete a file or directory # proc delete_file {args} { |