From: Vince Darley <vincentdarley@sourceforge.net>
Date: Thu, 27 Sep 2001 19:02:34 +0000 (+0000)
Subject: better file vols
X-Git-Tag: vfs-1-2~104
X-Git-Url: http://privyetmir.co.uk/gitweb?a=commitdiff_plain;h=9f200a6357b192cd92dbdb5b30923aa89ac35acb;p=tclvfs

better file vols
---

diff --git a/tests/vfsUrl.test b/tests/vfsUrl.test
new file mode 100644
index 0000000..75d61c2
--- /dev/null
+++ b/tests/vfsUrl.test
@@ -0,0 +1,59 @@
+# Commands covered:  vfs::urltype::Mount and friends.
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 2001 by Vince Darley.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import ::tcltest::*
+}
+
+package require vfs
+
+test vfsUrl-1.1 {mount} {
+    vfs::urltype::Mount ftp
+} {Mounted at "ftp://"}
+
+test vfsUrl-1.2 {mount} {
+    file exists ftp://ftp.scriptics.com
+} {1}
+
+test vfsUrl-1.3 {mount} {
+    file delete -force README.tclversions
+    file copy ftp://ftp.scriptics.com/pub/tcl/README.tclversions .
+    set to README.tclversions
+    if {[file exists $to]} {
+	if {[file size $to] < 800} {
+	    set res "file too short"
+	} else {
+	    set res "ok"
+	}
+    } else {
+	set res "file doesn't exist"
+    }
+    file delete $to
+    set res
+} {ok}
+
+test vfsUrl-1.4 {file copy with typo} {
+    catch {file copy ftp://ftp.scriptxxics.com/pub/tcl/README.tclversions .}
+    set to README.tclversions
+    if {[file exists $to]} {
+	set res "file shouldn't exist!"
+	file delete -force $to
+    } else {
+	set res "file doesn't exist"
+    }
+    set res
+} {file doesn't exist}
+
+# cleanup
+::tcltest::cleanupTests
+return