From 1b5ba8e022836fa8ab93bc90df1b34a29ea6e134 Mon Sep 17 00:00:00 2001
From: Hans-Christoph Steiner <hans@eds.org>
Date: Thu, 17 Jan 2013 14:18:26 -0500
Subject: Imported Upstream version 2.1.1

---
 test/tester.tcl | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)

(limited to 'test/tester.tcl')

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} {
-- 
cgit v1.2.3