blob: 1d0c9195980162f6eda2c01ddd78fbf8afabafd3 (
plain)
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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
# CaseData.tcl --
#
# Contains data for test cases
#
# Copyright (c) 1996, Expert Interface Technologies
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# GetHomeDirs --
#
# Returns a list of user names (prefixed with tilde) and their
# home directories
#
proc GetHomeDirs {} {
set tryList {root ftp admin operator uucp adm man john ioi}
if [catch {
lappend tryList [exec whoami]
}] {
catch {
lappend tryList [exec logname]
}
}
set list {}
foreach user $tryList {
if [info exists done($user)] {
continue
}
set expanded [tixFile tilde ~$user]
if ![tixStrEq $expanded ~$user] {
lappend list [list ~$user $expanded]
}
set done($user) 1
}
return $list
}
# GetCases_FsNormDir --
#
# Returns a set of test cases for verifying whether a non-normalized
# directory is properly notmalized
#
proc GetCases_FsNormDir {} {
if [tixStrEq [tix platform] unix] {
# PATHNAME to TEST expected result Causes error for
# tixFSNormDir?
#----------------------------------------------------------------
set list {
{. "" 1}
{foo "" 1}
{~nosuchuser "" 1}
{~nosuchuser/../ "" 1}
{/ / 0}
{/// / 0}
{/./ / 0}
{/./. / 0}
{/./. / 0}
{/././.././../ / 0}
{/etc /etc 0}
{/etc/../etc /etc 0}
{/etc/../etc/./ /etc 0}
{/etc/../etc/./ /etc 0}
{/etc/../usr/./lib /usr/lib 0}
}
foreach userInfo [GetHomeDirs] {
lappend list [list [lindex $userInfo 0] [lindex $userInfo 1] 0]
}
} else {
set list [list \
[list . "" 1] \
[list foo "" 1] \
[list .. "" 1] \
[list ..\\foo "" 1] \
[list ..\\dat\\. "" 1] \
[list C: "" 1] \
[list C:\\ C: 0] \
[list c:\\ C: 0] \
[list C:\\\\ C: 0] \
[list C:\\ C: 0] \
[list C:\\. C: 0] \
[list C:\\Windows C:\\Windows 0] \
[list C:\\Windows\\System C:\\Windows\\System 0] \
[list C:\\Windows\\.. C: 0] \
]
}
return $list
}
# GetCases_FSNorm --
#
# Returns a set of test cases for testing the tixFSNorm command.
#
proc GetCases_FSNorm {} {
global tixPriv
if [tixStrEq [tix platform] unix] {
# PATHNAME to TEST context <---------- Expected Result ----------------------------------->
# path vpath(todo) files(todo) patterns(todo)
#----------------------------------------------------------------
set list {
{. / / }
{./ / / }
{./////./ / / }
{.. / / }
{../ / / }
{../.. / / }
{../../../ / / }
{/etc / /etc }
{/etc///../etc/// / /etc }
{/etc///../etc///.. / / }
{/etc///../etc///../ / / }
{/etc/. / /etc }
{/./etc/. / /etc }
{/./././etc/. / /etc }
{/usr/./././local/./lib//// / /usr/local/lib }
{./././././etc/ / /etc }
{/etc/../etc / /etc }
{/etc/../etc/../etc / /etc }
{/etc/../etc/../ / / }
{~foobar/foo / /~foobar }
{~foobar/foo/ / /~foobar/foo }
}
} else {
set p $tixPriv(WinPrefix)
set list [list \
[list . $p\\C: $p\\C: ] \
[list .\\. $p\\C: $p\\C: ] \
[list .\\Windows $p\\C: $p\\C:\\Windows ] \
[list .\\Windows\\..\\ $p\\C: $p\\C: ] \
[list tmp\\ $p\\C: $p\\C:\\tmp ] \
[list "no such file" $p\\C: $p\\C: ] \
[list "autoexec.bat" $p\\C: $p\\C: ] \
[list "ignore/slash\\dd" $p\\C: $p\\C:\\ignore/slash ] \
[list "has space\\" $p\\C: "$p\\C:\\has space" ] \
[list "has space" $p\\C: "$p\\C:" ] \
]
# ToDo:
# (1) xx\xx\C: + .. should be xx\xx
# (2) xx\xx\C: + D: should be xx\xx\D:
}
return $list
}
|
