diff options
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} { |