File: vfsUrl.test

package info (click to toggle)
tclvfs 1.3-1
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 1,384 kB
  • ctags: 415
  • sloc: tcl: 3,670; xml: 2,882; sh: 2,736; ansic: 1,264; makefile: 57
file content (99 lines) | stat: -rw-r--r-- 2,583 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
# 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::urltype

puts stdout "These tests require an internet connection, and might"
puts stdout "take a long time to complete."

set vfsTestDir [pwd]
if {![file writable $vfsTestDir]} {
    if {[info exists env(TEMP)] && [file writable $env(TEMP)]} {
	set vfsTestDir $env(TEMP)
	tcltest::testConstraint vfsWritable 1
	puts stdout "Using temporary directory for some files\
	  (since [pwd] is not writable)"
    } else {
	tcltest::testConstraint vfsWritable 0
    }
} else {
    tcltest::testConstraint vfsWritable 1
}

test vfsUrl-1.1 {mount} {
    vfs::urltype::Mount ftp
} {Mounted at "ftp://"}

test vfsUrl-1.2 {mount} {
    file exists ftp://ftp.tcl.tk
} {1}

test vfsUrl-1.3 {mounted volumes} {
    set idx [lsearch -exact [file volumes] ftp://]
    if {$idx < 0} {
	set res "No ftp:// volume!"
    } else {
	set res "New volume 'ftp://' mounted"
    }
    set res
} {New volume 'ftp://' mounted}

test vfsUrl-2.1 {auto-mount ftp and copy file} {vfsWritable} {
    file delete -force README.tclversions
    file copy ftp://ftp.tcl.tk/pub/tcl/README.tclversions $vfsTestDir
    set to [file join $vfsTestDir 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-2.2 {auto-mount bad ftp} {
    catch {file copy ftp://invalid.name.dom/pub/tcl/README.tclversions $vfsTestDir}
    set to [file join $vfsTestDir 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}

test vfsUrl-3.1 {mount http} {
    vfs::urltype::Mount http
} {Mounted at "http://"}

# cleanup
catch {
    # Unmount all successfully mounted volumes.
    foreach vol [file volumes] {
	if {[regexp {^([a-zA-Z]+):/?//$} $vol "" type]} {
	    catch {vfs::urltype::Unmount $type}
	}
    }
}

::tcltest::cleanupTests
return