URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [tests/] [general/] [fs.tcl] - Blame information for rev 1765

Details | Compare with Previous | View Log


# fs.tcl --
#
#       Test the portable file handling ("FS") routines.
#
# 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.
#
 
proc About {} {
    return "Testing portable file handling routines"
}
 
proc Test {} {
    global tixPriv errorInfo
 
    TestBlock fs-1.1 {tixFSPath command} {
        if {$tixPriv(test:platform) == "windows"} {
            #   PATHNAME                     expected VPATH result
            #-------------------------------------------------------
            set list [list \
                [list :px:\\C:        C:\\      0] \
                [list :px:\\c:         ""       1] \
            ]
            regsub -all :px: $list $tixPriv(WinPrefix) list
 
            foreach item "$list" {
                set vpath [lindex $item 0]
                set want  [lindex $item 1]
                set experr [lindex $item 2]
 
 
                TestBlock fs-1.1.1 "tixFSPath $vpath" {
                    set err [catch {
                        set got [tixFSPath $vpath]
                    }]
 
                    if $experr {
                        Assert {$err == $experr}
                    } else {
                        Assert {[tixStrEq $want $got]}
                    }
                }
            }
        }
    }
 
    TestBlock fs-1.2 {tixFSIsNorm command} {
        if {$tixPriv(test:platform) == "unix"} {
 
            #   PATHNAME to TEST                     expected result
            #-------------------------------------------------------
            set list {
                {/home/ioi                      1}
                {/foo.bar                       1}
                {/.../foo                       1}
                {/.../foo/bar/...               1}
                {/.../.foo/bar/...              1}
                {/.../.f./bar/...               1}
                {/.../.f./bar/...               1}
                {/..a/...                       1}
                {"/. / "                        1}
                {//a                            0}
                {/a/b/                          0}
                {/a/b//                         0}
                {/a/b/.                         0}
                {a/b                            0}
                {a/b/.                          0}
                {/./b                           0}
                {/../b                          0}
                {/../../b                       0}
                {/./a/../b/..                   0}
                {~ioi                           0}
                {/~ioi                          1}
                {/                              1}
            }
        } else {
            set list {
                {C:/                            0}
                {foo                            0}
                {c:                             0}
                {C:                             1}
                {C:\\Windows                    1}
                {C:\\                           0}
                {C:\\..\\Windows                0}
                {C:\\...\\Windows               1}
                {C:\\.../Windows                1}
                {C:\\.\\Windows                 0}
                {..                             0}
                {..\\..                         0}
                {..\\                           0}
                {.                              0}
                {.\\.                           0}
                {.\\                            0}
                {C:\\.                          0}
                {C:Windows                      0}
                {C:\\Windows\\App               1}
                {"C:\\My Programs\\~App"        1}
            }
        }
 
        foreach item $list {
            set text [lindex $item 0]
            set want [lindex $item 1]
 
 
            TestBlock fs-1.2.1 "tixFSIsNorm $text" {
                Assert {[tixFSIsNorm $text] == $want}
            }
        }
    }
 
    TestBlock fs-1.3 {tixFSNormDir command} {
        foreach item [GetCases_FsNormDir] {
            set text    [lindex $item 0]
            set want    [lindex $item 1]
            set wanterr [lindex $item 2]
 
            if !$wanterr {
                # Check test case error
                Assert {[tixFSIsNorm $want]}
            }
 
            TestBlock fs-1.3.1 "tixFSNormDir $text" {
                set err [catch {
                    set got [tixFSNormDir $text]
                }]
 
                Assert {$err == $wanterr}
                if {!$err} {
                    Assert {[tixStrEq $want $got]}
                }
            }
        }
    }
 
    TestBlock fs-1.4 {tixFSNorm command} {
        set list [GetCases_FSNorm]
 
        set appPWD [pwd]
        foreach item $list {
            set text    [lindex $item 0]
            set context [lindex $item 1]
            set want    [lindex $item 2]
 
            TestBlock fs-1.4.1 "tixFSNorm $context $text" {
                set lst [tixFSNorm $context $text]
                set dir [lindex $lst 1]
                Assert {[tixStrEq $want $dir]}
                Assert {[tixStrEq [pwd] $appPWD]}
            }
        }
    }
 
    TestBlock fs-1.5 {tilde handling} {
        if {$tixPriv(test:platform) == "unix"} {
            set who "nobody"
            if {[string comp $who "nobody"] == 0} {
                catch {set who [exec whoami]}
            }
            if {[string comp $who "nobody"] == 0} {
                catch {set who [exec logname]}
            }
            set home /
            catch {
                set home [glob ~$who]
            }
            set list {
                {~$who          {$home              $home   ""  ""}}
                {~              {$home              $home   ""  ""}}
                {~/*.*          {$home/*.*          $home   ""  "*.*"}}
                {"~/*.* *.tcl"  {"$home/*.* *.tcl"  $home   ""  "*.* *.tcl"}}
            }
 
            foreach item $list {
                set item [subst $item]
                set text [lindex $item 0]
                set want [lindex $item 1]
 
                TestBlock fs-1.5.1 "tixFSNorm \[pwd\] $text" {
                    set list [tixFSNorm [pwd] $text]
 
                    Assert {
                        [tixStrEq [lindex $list 0] [lindex $want 0]] &&
                        [tixStrEq [lindex $list 1] [lindex $want 1]] &&
                        [tixStrEq [lindex $list 2] [lindex $want 2]] &&
                        [tixStrEq [lindex $list 3] [lindex $want 3]]
                    }
                }
            }
        }
    }
 
    TestBlock fs-1.6 {tixFSVPath} {
        if {$tixPriv(test:platform) == "unix"} {
 
            #   PATHNAME to TEST            expected     Causes error for
            #                               result        tixFSVPath?
            #----------------------------------------------------------------
            set list {
                {.                              ""              1}
                {foo                            ""              1}
                {./                             ""              1}
            }
        } else {
            set list {
                {.                              ""              1}
            }
            regsub -all ^:px: $list $tixPriv(WinPrefix) list
        }
 
        # (ToDo): write the test
        #
    }
 
    TestBlock fs-2.1 {obsolete tests} {
        # Some obsolete test. Should be taken out.
        #
        if {$tixPriv(test:platform) == "unix"} {
            set home [glob ~]
            if {$home == "/"} {
                set homeprefix {}
            } else {
                set homeprefix $home
            }
 
            # it shouldn't do itemname substitution
            #
            Assert {[tixFileIntName *] == "*"}
            Assert {[tixFileIntName ~/*] == "$homeprefix/*"}
 
            Assert {[tixFileIntName /home/ioi/../foo/bar/..] == "/home/foo"}
        }
    }
}

Browse

Tools

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tix/] [tests/] [general/] [fs.tcl] - Blame information for rev 1765

Line No.	Rev	Author	Line
1	578	markom	`# fs.tcl --`
2			`#`
3			`# Test the portable file handling ("FS") routines.`
4			`#`
5			`# Copyright (c) 1996, Expert Interface Technologies`
6			`#`
7			`# See the file "license.terms" for information on usage and redistribution`
8			`# of this file, and for a DISCLAIMER OF ALL WARRANTIES.`
9			`#`
10
11			`proc About {} {`
12			`return "Testing portable file handling routines"`
13			`}`
14
15			`proc Test {} {`
16			`global tixPriv errorInfo`
17
18			`TestBlock fs-1.1 {tixFSPath command} {`
19			`if {$tixPriv(test:platform) == "windows"} {`
20			`# PATHNAME expected VPATH result`
21			`#-------------------------------------------------------`
22			`set list [list \`
23			`[list :px:\\C: C:\\ 0] \`
24			`[list :px:\\c: "" 1] \`
25			`]`
26			`regsub -all :px: $list $tixPriv(WinPrefix) list`
27
28			`foreach item "$list" {`
29			`set vpath [lindex $item 0]`
30			`set want [lindex $item 1]`
31			`set experr [lindex $item 2]`
32
33
34			`TestBlock fs-1.1.1 "tixFSPath $vpath" {`
35			`set err [catch {`
36			`set got [tixFSPath $vpath]`
37			`}]`
38
39			`if $experr {`
40			`Assert {$err == $experr}`
41			`} else {`
42			`Assert {[tixStrEq $want $got]}`
43			`}`
44			`}`
45			`}`
46			`}`
47			`}`
48
49			`TestBlock fs-1.2 {tixFSIsNorm command} {`
50			`if {$tixPriv(test:platform) == "unix"} {`
51
52			`# PATHNAME to TEST expected result`
53			`#-------------------------------------------------------`
54			`set list {`
55			`{/home/ioi 1}`
56			`{/foo.bar 1}`
57			`{/.../foo 1}`
58			`{/.../foo/bar/... 1}`
59			`{/.../.foo/bar/... 1}`
60			`{/.../.f./bar/... 1}`
61			`{/.../.f./bar/... 1}`
62			`{/..a/... 1}`
63			`{"/. / " 1}`
64			`{//a 0}`
65			`{/a/b/ 0}`
66			`{/a/b// 0}`
67			`{/a/b/. 0}`
68			`{a/b 0}`
69			`{a/b/. 0}`
70			`{/./b 0}`
71			`{/../b 0}`
72			`{/../../b 0}`
73			`{/./a/../b/.. 0}`
74			`{~ioi 0}`
75			`{/~ioi 1}`
76			`{/ 1}`
77			`}`
78			`} else {`
79			`set list {`
80			`{C:/ 0}`
81			`{foo 0}`
82			`{c: 0}`
83			`{C: 1}`
84			`{C:\\Windows 1}`
85			`{C:\\ 0}`
86			`{C:\\..\\Windows 0}`
87			`{C:\\...\\Windows 1}`
88			`{C:\\.../Windows 1}`
89			`{C:\\.\\Windows 0}`
90			`{.. 0}`
91			`{..\\.. 0}`
92			`{..\\ 0}`
93			`{. 0}`
94			`{.\\. 0}`
95			`{.\\ 0}`
96			`{C:\\. 0}`
97			`{C:Windows 0}`
98			`{C:\\Windows\\App 1}`
99			`{"C:\\My Programs\\~App" 1}`
100			`}`
101			`}`
102
103			`foreach item $list {`
104			`set text [lindex $item 0]`
105			`set want [lindex $item 1]`
106
107
108			`TestBlock fs-1.2.1 "tixFSIsNorm $text" {`
109			`Assert {[tixFSIsNorm $text] == $want}`
110			`}`
111			`}`
112			`}`
113
114			`TestBlock fs-1.3 {tixFSNormDir command} {`
115			`foreach item [GetCases_FsNormDir] {`
116			`set text [lindex $item 0]`
117			`set want [lindex $item 1]`
118			`set wanterr [lindex $item 2]`
119
120			`if !$wanterr {`
121			`# Check test case error`
122			`Assert {[tixFSIsNorm $want]}`
123			`}`
124
125			`TestBlock fs-1.3.1 "tixFSNormDir $text" {`
126			`set err [catch {`
127			`set got [tixFSNormDir $text]`
128			`}]`
129
130			`Assert {$err == $wanterr}`
131			`if {!$err} {`
132			`Assert {[tixStrEq $want $got]}`
133			`}`
134			`}`
135			`}`
136			`}`
137
138			`TestBlock fs-1.4 {tixFSNorm command} {`
139			`set list [GetCases_FSNorm]`
140
141			`set appPWD [pwd]`
142			`foreach item $list {`
143			`set text [lindex $item 0]`
144			`set context [lindex $item 1]`
145			`set want [lindex $item 2]`
146
147			`TestBlock fs-1.4.1 "tixFSNorm $context $text" {`
148			`set lst [tixFSNorm $context $text]`
149			`set dir [lindex $lst 1]`
150			`Assert {[tixStrEq $want $dir]}`
151			`Assert {[tixStrEq [pwd] $appPWD]}`
152			`}`
153			`}`
154			`}`
155
156			`TestBlock fs-1.5 {tilde handling} {`
157			`if {$tixPriv(test:platform) == "unix"} {`
158			`set who "nobody"`
159			`if {[string comp $who "nobody"] == 0} {`
160			`catch {set who [exec whoami]}`
161			`}`
162			`if {[string comp $who "nobody"] == 0} {`
163			`catch {set who [exec logname]}`
164			`}`
165			`set home /`
166			`catch {`
167			`set home [glob ~$who]`
168			`}`
169			`set list {`
170			`{~$who {$home $home "" ""}}`
171			`{~ {$home $home "" ""}}`
172			`{~/. {$home/. $home "" "."}}`
173			`{"~/. .tcl" {"$home/.* .tcl" $home "" ".* *.tcl"}}`
174			`}`
175
176			`foreach item $list {`
177			`set item [subst $item]`
178			`set text [lindex $item 0]`
179			`set want [lindex $item 1]`
180
181			`TestBlock fs-1.5.1 "tixFSNorm \[pwd\] $text" {`
182			`set list [tixFSNorm [pwd] $text]`
183
184			`Assert {`
185			`[tixStrEq [lindex $list 0] [lindex $want 0]] &&`
186			`[tixStrEq [lindex $list 1] [lindex $want 1]] &&`
187			`[tixStrEq [lindex $list 2] [lindex $want 2]] &&`
188			`[tixStrEq [lindex $list 3] [lindex $want 3]]`
189			`}`
190			`}`
191			`}`
192			`}`
193			`}`
194
195			`TestBlock fs-1.6 {tixFSVPath} {`
196			`if {$tixPriv(test:platform) == "unix"} {`
197
198			`# PATHNAME to TEST expected Causes error for`
199			`# result tixFSVPath?`
200			`#----------------------------------------------------------------`
201			`set list {`
202			`{. "" 1}`
203			`{foo "" 1}`
204			`{./ "" 1}`
205			`}`
206			`} else {`
207			`set list {`
208			`{. "" 1}`
209			`}`
210			`regsub -all ^:px: $list $tixPriv(WinPrefix) list`
211			`}`
212
213			`# (ToDo): write the test`
214			`#`
215			`}`
216
217			`TestBlock fs-2.1 {obsolete tests} {`
218			`# Some obsolete test. Should be taken out.`
219			`#`
220			`if {$tixPriv(test:platform) == "unix"} {`
221			`set home [glob ~]`
222			`if {$home == "/"} {`
223			`set homeprefix {}`
224			`} else {`
225			`set homeprefix $home`
226			`}`
227
228			`# it shouldn't do itemname substitution`
229			`#`
230			`Assert {[tixFileIntName ] == ""}`
231			`Assert {[tixFileIntName ~/] == "$homeprefix/"}`
232
233			`Assert {[tixFileIntName /home/ioi/../foo/bar/..] == "/home/foo"}`
234			`}`
235			`}`
236			`}`