better file vols
authorVince Darley <vincentdarley@sourceforge.net>
Thu, 27 Sep 2001 19:02:34 +0000 (19:02 +0000)
committerVince Darley <vincentdarley@sourceforge.net>
Thu, 27 Sep 2001 19:02:34 +0000 (19:02 +0000)
tests/vfsUrl.test [new file with mode: 0644]

diff --git a/tests/vfsUrl.test b/tests/vfsUrl.test
new file mode 100644 (file)
index 0000000..75d61c2
--- /dev/null
@@ -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