Tcl Source Code

Check-in [b26424e522]
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:More cleaning up of the code to remove unnecessary [string equal]s in tests.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b26424e52289f9cd7e200315fc2f25be5c14006a
User & Date: dkf 2011-06-08 10:14:50
Context
2011-06-08
20:28
Reverted the fix for [Bug 3274728] committed on 2011-04-06 (rev [caf317ab68]) and replaced with one ... check-in: 04f804b338 user: andreask tags: trunk
10:14
More cleaning up of the code to remove unnecessary [string equal]s in tests. check-in: b26424e522 user: dkf tags: trunk
2011-06-06
13:48
Add test constraint, so 6.2 and 6.3 don't fail when the machine does not have support for ip6 Follow... check-in: 298a314c4f user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog. 







1
2
3
4
5
6
7
8
9
10
11
12







2011-06-06  Jan Nijtmans  <[email protected]>

	* tests/socket.test: Add test constraint, so 6.2 and
	  6.3 don't fail when the machine does not have support
	  for ip6. Follow-up to checkin from 2011-05-11 by rmax.

2011-06-02  Don Porter  <[email protected]>

	* generic/tclBasic.c:	Removed TclCleanupLiteralTable(), and old
	* generic/tclInt.h:	band-aid routine put in place while a fix
	* generic/tclLiteral.c:	for [Bug 994838] took shape.  No longer needed.


>
>
>
>
>
>


|
|
|








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

2011-06-08  Donal K. Fellows  <[email protected]>

	* tests/fileSystem.test: Reduce the amount of use of duplication of
	complex code to perform common tests, and convert others to do the
	test result check directly using Tcltest's own primitives.

2011-06-06  Jan Nijtmans  <[email protected]>

	* tests/socket.test: Add test constraint, so 6.2 and 6.3 don't fail
	when the machine does not have support for ip6. Follow-up to checkin
	from 2011-05-11 by rmax.

2011-06-02  Don Porter  <[email protected]>

	* generic/tclBasic.c:	Removed TclCleanupLiteralTable(), and old
	* generic/tclInt.h:	band-aid routine put in place while a fix
	* generic/tclLiteral.c:	for [Bug 994838] took shape.  No longer needed.
︙︙

Changes to tests/fileSystem.test.

︙︙
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

cd [tcltest::temporaryDirectory]
makeFile "test file" gorp.file
makeDirectory dir.dir
makeDirectory [file join dir.dir dirinside.dir]
makeFile "test file in directory" [file join dir.dir inside.file]

testConstraint unusedDrive 0



set drive {}
if {[testConstraint win]} {
    set vols [string map [list :/ {}] [file volumes]]
    for {set i 0} {$i < 26} {incr i} {
	set drive [format %c [expr {$i + 65}]]
	if {$drive ni $vols} {
	    testConstraint unusedDrive 1
	    break
	}
    }
    unset i vols
    # The variable 'drive' will be used below
}

testConstraint moreThanOneDrive 0
set drives [list]
if {[testConstraint win]} {
    set dir [pwd]

    foreach vol [file volumes] {
        if {![catch {cd $vol}]} {
            lappend drives $vol
        }
    }
    if {[llength $drives] > 1} {
        testConstraint moreThanOneDrive 1
    }
    # The variable 'drives' will be used below
    unset vol
    cd $dir
    unset dir
}



proc testPathEqual {one two} {
    if {$one eq $two} {
	return 1
    } else {
	return "not equal: $one $two"
    }

}

testConstraint hasLinks [expr {![catch {
    file link link.file gorp.file
    cd dir.dir
    file link \
	[file join linkinside.file] \








>
>
>
|
|
|
|
|
|
|
|
|
|
<
<
|
<
<
<
<
|
>
|
|
|
|
|
<
|
|
<
<
|
<
|
|
>
>


|
<
<

>








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

cd [tcltest::temporaryDirectory]
makeFile "test file" gorp.file
makeDirectory dir.dir
makeDirectory [file join dir.dir dirinside.dir]
makeFile "test file in directory" [file join dir.dir inside.file]

testConstraint unusedDrive 0
testConstraint moreThanOneDrive 0
apply {{} {
    # The variables 'drive' and 'drives' will be used below.
    variable drive {} drives {}
    if {[testConstraint win]} {
	set vols [string map [list :/ {}] [file volumes]]
	for {set i 0} {$i < 26} {incr i} {
	    set drive [format %c [expr {$i + 65}]]
	    if {$drive ni $vols} {
		testConstraint unusedDrive 1
		break
	    }
	}







	set dir [pwd]
	try {
	    foreach vol [file volumes] {
		if {![catch {cd $vol}]} {
		    lappend drives $vol
		}
	    }

	    testConstraint moreThanOneDrive [llength $drives]
	} finally {


	    cd $dir

	}
    }
} ::tcl::test::fileSystem}

proc testPathEqual {one two} {
    if {$one eq $two} {
	return "ok"


    }
    return "not equal: $one $two"
}

testConstraint hasLinks [expr {![catch {
    file link link.file gorp.file
    cd dir.dir
    file link \
	[file join linkinside.file] \
︙︙
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
149
150
151

} {0}
test filesystem-1.1 {link normalisation} {hasLinks} {
   string equal [file normalize dir.dir] [file normalize dir.link]
} {0}
test filesystem-1.2 {link normalisation} {hasLinks unix} {
    testPathEqual [file normalize [file join gorp.file foo]] \
	[file normalize [file join link.file foo]]
} {1}
test filesystem-1.3 {link normalisation} {hasLinks} {
    testPathEqual [file normalize [file join dir.dir foo]] \
	[file normalize [file join dir.link foo]]
} {1}
test filesystem-1.4 {link normalisation} {hasLinks} {
    testPathEqual [file normalize [file join dir.dir inside.file]] \
	[file normalize [file join dir.link inside.file]]
} {1}
test filesystem-1.5 {link normalisation} {hasLinks} {
    testPathEqual [file normalize [file join dir.dir linkinside.file]] \
	[file normalize [file join dir.dir linkinside.file]]
} {1}
test filesystem-1.6 {link normalisation} {hasLinks} {
    string equal [file normalize [file join dir.dir linkinside.file]] \
	[file normalize [file join dir.link inside.file]]
} {0}
test filesystem-1.7 {link normalisation} {hasLinks unix} {
    testPathEqual [file normalize [file join dir.link linkinside.file foo]] \
	[file normalize [file join dir.dir inside.file foo]]
} {1}
test filesystem-1.8 {link normalisation} {hasLinks} {
    string equal [file normalize [file join dir.dir linkinside.filefoo]] \
	[file normalize [file join dir.link inside.filefoo]]
} {0}
test filesystem-1.9 {link normalisation} {unix hasLinks} {
    file delete -force dir.link

    file link dir.link [file nativename dir.dir]
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir.link inside.file foo]]
} {1}
test filesystem-1.10 {link normalisation: double link} {unix hasLinks} {
    file link dir2.link dir.link
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir2.link inside.file foo]]
} {1}
makeDirectory dir2.file
test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} {
    file link [file join dir2.file dir2.link] [file join .. dir2.link]
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir2.file dir2.link inside.file foo]]
} {1}
test filesystem-1.12 {file new native path} {} {
    for {set i 0} {$i < 10} {incr i} {
	foreach f [lsort [glob -nocomplain -type l *]] {
	    catch {file readlink $f}
	}
    }
    # If we reach here we've succeeded. We used to crash above.








|



|



|



|







|




|

>



|




|





|








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

} {0}
test filesystem-1.1 {link normalisation} {hasLinks} {
   string equal [file normalize dir.dir] [file normalize dir.link]
} {0}
test filesystem-1.2 {link normalisation} {hasLinks unix} {
    testPathEqual [file normalize [file join gorp.file foo]] \
	[file normalize [file join link.file foo]]
} ok
test filesystem-1.3 {link normalisation} {hasLinks} {
    testPathEqual [file normalize [file join dir.dir foo]] \
	[file normalize [file join dir.link foo]]
} ok
test filesystem-1.4 {link normalisation} {hasLinks} {
    testPathEqual [file normalize [file join dir.dir inside.file]] \
	[file normalize [file join dir.link inside.file]]
} ok
test filesystem-1.5 {link normalisation} {hasLinks} {
    testPathEqual [file normalize [file join dir.dir linkinside.file]] \
	[file normalize [file join dir.dir linkinside.file]]
} ok
test filesystem-1.6 {link normalisation} {hasLinks} {
    string equal [file normalize [file join dir.dir linkinside.file]] \
	[file normalize [file join dir.link inside.file]]
} {0}
test filesystem-1.7 {link normalisation} {hasLinks unix} {
    testPathEqual [file normalize [file join dir.link linkinside.file foo]] \
	[file normalize [file join dir.dir inside.file foo]]
} ok
test filesystem-1.8 {link normalisation} {hasLinks} {
    string equal [file normalize [file join dir.dir linkinside.filefoo]] \
	[file normalize [file join dir.link inside.filefoo]]
} {0}
test filesystem-1.9 {link normalisation} -setup {
    file delete -force dir.link
} -constraints {unix hasLinks} -body {
    file link dir.link [file nativename dir.dir]
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir.link inside.file foo]]
} -result ok
test filesystem-1.10 {link normalisation: double link} {unix hasLinks} {
    file link dir2.link dir.link
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir2.link inside.file foo]]
} ok
makeDirectory dir2.file
test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} {
    file link [file join dir2.file dir2.link] [file join .. dir2.link]
    testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
	[file normalize [file join dir2.file dir2.link inside.file foo]]
} ok
test filesystem-1.12 {file new native path} {} {
    for {set i 0} {$i < 10} {incr i} {
	foreach f [lsort [glob -nocomplain -type l *]] {
	    catch {file readlink $f}
	}
    }
    # If we reach here we've succeeded. We used to crash above.
︙︙
194
195
196
197
198
199
200
201
202

203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223

224
225
226
227
228
229
230
231
232
233

234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254

} "${drive}:/a"
test filesystem-1.25 {file normalisation} {win unusedDrive} {
    file normalize ${drive}:/./.././../../a
} "${drive}:/a"
test filesystem-1.25.1 {file normalisation} {win unusedDrive} {
    file normalize ${drive}:/./.././..\\..\\a\\bb
} "${drive}:/a/bb"
test filesystem-1.26 {link normalisation: link and ..} {hasLinks} {
    file delete -force dir2.link

    set dir [file join dir2 foo bar]
    file mkdir $dir
    file link dir2.link [file join dir2 foo bar]
    set res [list [file normalize [file join dir2 foo x]] \
	    [file normalize [file join dir2.link .. x]]]
    testPathEqual [lindex $res 0] [lindex $res 1]
} 1
test filesystem-1.27 {file normalisation: up and down with ..} {
    set dir [file join dir2 foo bar]
    file mkdir $dir
    set dir2 [file join dir2 .. dir2 foo .. foo bar]
    set res [list [file normalize $dir] [file normalize $dir2]]
    set res2 [list [file exists $dir] [file exists $dir2]]
    if {![string equal [lindex $res 0] [lindex $res 1]]} {
	set res "exists: $res2, $res not equal"
    } else {
	set res "ok: $res2"
    }
} {ok: 1 1}
test filesystem-1.28 {link normalisation: link with .. and ..} {hasLinks} {
    file delete -force dir2.link

    set dir [file join dir2 foo bar]
    file mkdir $dir
    set to [file join dir2 .. dir2 foo .. foo bar]
    file link dir2.link $to
    set res [list [file normalize [file join dir2 foo x]] \
	    [file normalize [file join dir2.link .. x]]]
    testPathEqual [lindex $res 0] [lindex $res 1]
} 1
test filesystem-1.29 {link normalisation: link with ..} {hasLinks} {
    file delete -force dir2.link

    set dir [file join dir2 foo bar]
    file mkdir $dir
    set to [file join dir2 .. dir2 foo .. foo bar]
    file link dir2.link $to
    set res [file normalize [file join dir2.link x yyy z]]
    if {[string match *..* $res]} {
	return "$res must not contain '..'"
    }
    return "ok"
} {ok}
test filesystem-1.29.1 {link normalisation with two consecutive links} {hasLinks} {
    testPathEqual [file normalize [file join dir.link dirinside.link abc]] \
	[file normalize [file join dir.dir dirinside.dir abc]]
} {1}
file delete -force dir2.file
file delete -force dir2.link
file delete -force link.file dir.link
file delete -force dir2
file delete -force [file join dir.dir dirinside.link]
removeFile [file join dir.dir inside.file]
removeDirectory [file join dir.dir dirinside.dir]








|

>



|
|
<
|




|
|
<
<
<
<
<
|
|

>




|
|
<
|
|

>









|



|








190
191
192
193
194
195
196
197
198
199
200
201
202
203
204

205
206
207
208
209
210
211





212
213
214
215
216
217
218
219
220
221

222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246

} "${drive}:/a"
test filesystem-1.25 {file normalisation} {win unusedDrive} {
    file normalize ${drive}:/./.././../../a
} "${drive}:/a"
test filesystem-1.25.1 {file normalisation} {win unusedDrive} {
    file normalize ${drive}:/./.././..\\..\\a\\bb
} "${drive}:/a/bb"
test filesystem-1.26 {link normalisation: link and ..} -setup {
    file delete -force dir2.link
} -constraints {hasLinks} -body {
    set dir [file join dir2 foo bar]
    file mkdir $dir
    file link dir2.link [file join dir2 foo bar]
    testPathEqual [file normalize [file join dir2 foo x]] \
	    [file normalize [file join dir2.link .. x]]

} -result ok
test filesystem-1.27 {file normalisation: up and down with ..} {
    set dir [file join dir2 foo bar]
    file mkdir $dir
    set dir2 [file join dir2 .. dir2 foo .. foo bar]
    list [testPathEqual [file normalize $dir] [file normalize $dir2]] \
	[file exists $dir] [file exists $dir2]





} {ok 1 1}
test filesystem-1.28 {link normalisation: link with .. and ..} -setup {
    file delete -force dir2.link
} -constraints {hasLinks} -body {
    set dir [file join dir2 foo bar]
    file mkdir $dir
    set to [file join dir2 .. dir2 foo .. foo bar]
    file link dir2.link $to
    testPathEqual [file normalize [file join dir2 foo x]] \
	    [file normalize [file join dir2.link .. x]]

} -result ok
test filesystem-1.29 {link normalisation: link with ..} -setup {
    file delete -force dir2.link
} -constraints {hasLinks} -body {
    set dir [file join dir2 foo bar]
    file mkdir $dir
    set to [file join dir2 .. dir2 foo .. foo bar]
    file link dir2.link $to
    set res [file normalize [file join dir2.link x yyy z]]
    if {[string match *..* $res]} {
	return "$res must not contain '..'"
    }
    return "ok"
} -result {ok}
test filesystem-1.29.1 {link normalisation with two consecutive links} {hasLinks} {
    testPathEqual [file normalize [file join dir.link dirinside.link abc]] \
	[file normalize [file join dir.dir dirinside.dir abc]]
} ok
file delete -force dir2.file
file delete -force dir2.link
file delete -force link.file dir.link
file delete -force dir2
file delete -force [file join dir.dir dirinside.link]
removeFile [file join dir.dir inside.file]
removeDirectory [file join dir.dir dirinside.dir]
︙︙
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291


292
293
294
295
296
297
298
299
300


301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317

318
319
320
321
322

323
324
325
326


327
328
329
330
331

332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488

	regexp {C:/bar$} $res res
    }
    set res
} {C:/bar}
if {[testConstraint testsetplatform]} {
    testsetplatform $platform
}
test filesystem-1.34 {file normalisation with '/./'} {
    set res [file normalize /foo/bar/anc/./.tml]
    if {[string first "/./" $res] != -1} {
	set res "normalization of /foo/bar/anc/./.tml is: $res"
    } else {
	set res "ok"
    }
    set res
} {ok}
test filesystem-1.35 {file normalisation with '/./'} {
    set res [file normalize /ffo/bar/anc/./foo/.tml]
    if {[string first "/./" $res] != -1 || ([regsub -all "foo" $res "" reg] == 2)} {


	set res "normalization of /ffo/bar/anc/./foo/.tml is: $res"
    } else {
	set res "ok"
    }
    set res
} {ok}
test filesystem-1.36 {file normalisation with '/./'} {
    set res [file normalize /foo/bar/anc/././asdasd/.tml]
    if {[string first "/./" $res] != -1 || ([regsub -all "asdasd" $res "" reg] == 2) } {


	set res "normalization of /foo/bar/anc/././asdasd/.tml is: $res"
    } else {
	set res "ok"
    }
    set res
} {ok}
test filesystem-1.37 {file normalisation with '/./'} {
    set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....."
    set res [file norm $fname]
    if {[string first "//" $res] != -1} {
	set res "normalization of $fname is: $res"
    } else {
	set res "ok"
    }
    set res
} {ok}
test filesystem-1.38 {file normalisation with volume relative} \

  {win moreThanOneDrive} {
    set path "[string range [lindex $drives 0] 0 1]foo"
    set dir [pwd]
    cd [lindex $drives 1]
    set res [file norm $path]

    cd $dir
    set res
} "[lindex $drives 0]foo"
test filesystem-1.39 {file normalisation with volume relative} {win} {


    set drv C:/
    set dir [lindex [glob -type d -dir $drv *] 0]
    set old [pwd]
    cd $dir
    set res [file norm [string range $drv 0 1]]

    cd $old
    if {[string index $res end] eq "/"} {
        set res "Bad normalized path: $res"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.40 {file normalisation with repeated separators} {
    set a [file norm foo////bar]
    set b [file norm foo/bar]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.41 {file normalisation with repeated separators} {win} {
    set a [file norm foo\\\\\\bar]
    set b [file norm foo/bar]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /xxx/..]
    set b [file norm /]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /xxx/../]
    set b [file norm /]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /xxx/foo/../..]
    set b [file norm /]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /xxx/foo/../../]
    set b [file norm /]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /xxx/foo/../../bar]
    set b [file norm /bar]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /xxx/../../bar]
    set b [file norm /bar]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /xxx/../bar]
    set b [file norm /bar]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.47 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /..]
    set b [file norm /]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.48 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /../]
    set b [file norm /]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.49 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /.]
    set b [file norm /]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.50 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /./]
    set b [file norm /]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /../..]
    set b [file norm /]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}
test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} {
    set a [file norm /../../]
    set b [file norm /]
    if {![string equal $a $b]} {
        set res "Paths should be equal: $a , $b"
    } else {
        set res "ok"
    }
} {ok}

test filesystem-2.0 {new native path} {unix} {
   foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
       catch {file readlink $f}
   }
   # If we reach here we've succeeded. We used to crash above.
   expr 1
} {1}

# Make sure the testfilesystem hasn't been registered.
if {[testConstraint testfilesystem]} {
    while {![catch {testfilesystem 0}]} {}
}

test filesystem-3.1 {Tcl_FSRegister & Tcl_FSUnregister} testfilesystem {








|
|
<
<
<
<
<
|
<
|
|
<
>
>
|
<
<
|
<
<
|
|
<
>
>
|
<
<
|
<
<
|

|
<
<
<
<
<
|
<
|
>
|

<

|
>

<
|
|
>
>

|
<
<
|
>

<
<
<
|
<
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<

|
<
<
<
<
<
|
<






|
|








265
266
267
268
269
270
271
272
273





274

275
276

277
278
279


280


281
282

283
284
285


286


287
288
289





290

291
292
293
294

295
296
297
298

299
300
301
302
303
304


305
306
307



308


309
310





311

312
313





314

315
316





317

318
319





320

321
322





323

324
325





326

327
328





329

330
331





332

333
334





335

336
337





338

339
340





341

342
343





344

345
346





347

348
349





350

351
352





353

354
355
356
357
358
359
360
361
362
363
364
365
366
367
368

	regexp {C:/bar$} $res res
    }
    set res
} {C:/bar}
if {[testConstraint testsetplatform]} {
    testsetplatform $platform
}
test filesystem-1.34 {file normalisation with '/./'} -body {
    file normalize /foo/bar/anc/./.tml





} -match regexp -result {^(?:(?!/\./).)*$}

test filesystem-1.35a {file normalisation with '/./'} -body {
    file normalize /ffo/bar/anc/./foo/.tml

} -match regexp -result {^(?:(?!/\./).)*$}
test filesystem-1.35b {file normalisation with '/./'} {
    llength [regexp -all foo [file normalize /ffo/bar/anc/./foo/.tml]]


} 1


test filesystem-1.36a {file normalisation with '/./'} -body {
    file normalize /foo/bar/anc/././asdasd/.tml

} -match regexp -result {^(?:(?!/\./).)*$}
test filesystem-1.36b {file normalisation with '/./'} {
    llength [regexp -all asdasd [file normalize /foo/bar/anc/././asdasd/.tml]]


} 1


test filesystem-1.37 {file normalisation with '/./'} -body {
    set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....."
    file norm $fname





} -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$}

test filesystem-1.38 {file normalisation with volume relative} -setup {
    set dir [pwd]
} -constraints {win moreThanOneDrive} -body {
    set path "[string range [lindex $drives 0] 0 1]foo"

    cd [lindex $drives 1]
    file norm $path
} -cleanup {
    cd $dir

} -result "[lindex $drives 0]foo"
test filesystem-1.39 {file normalisation with volume relative} -setup {
    set old [pwd]
} -constraints {win} -body {
    set drv C:/
    cd [lindex [glob -type d -dir $drv *] 0]


    file norm [string range $drv 0 1]
} -cleanup {
    cd $old



} -match glob -result {*[^/]}


test filesystem-1.40 {file normalisation with repeated separators} {
    testPathEqual [file norm foo////bar] [file norm foo/bar]





} ok

test filesystem-1.41 {file normalisation with repeated separators} {win} {
    testPathEqual [file norm foo\\\\\\bar] [file norm foo/bar]





} ok

test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/..] [file norm /]





} ok

test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/../] [file norm /]





} ok

test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/foo/../..] [file norm /]





} ok

test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/foo/../../] [file norm /]





} ok

test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/foo/../../bar] [file norm /bar]





} ok

test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/../../bar] [file norm /bar]





} ok

test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /xxx/../bar] [file norm /bar]





} ok

test filesystem-1.47 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /..] [file norm /]





} ok

test filesystem-1.48 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /../] [file norm /]





} ok

test filesystem-1.49 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /.] [file norm /]





} ok

test filesystem-1.50 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /./] [file norm /]





} ok

test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /../..] [file norm /]





} ok

test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} {
    testPathEqual [file norm /../../] [file norm /]





} ok


test filesystem-2.0 {new native path} {unix} {
   foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
       catch {file readlink $f}
   }
   # If we reach here we've succeeded. We used to crash above.
   return ok
} ok

# Make sure the testfilesystem hasn't been registered.
if {[testConstraint testfilesystem]} {
    while {![catch {testfilesystem 0}]} {}
}

test filesystem-3.1 {Tcl_FSRegister & Tcl_FSUnregister} testfilesystem {
︙︙
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542

} {native}

test filesystem-4.0 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
    file exists foo
    testfilesystem 0
    set filesystemReport
} -match glob -result {*{access foo}}
test filesystem-4.1 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
    catch {file stat foo bar}
    testfilesystem 0
    set filesystemReport
} -match glob -result {*{stat foo}}
test filesystem-4.2 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
    catch {file lstat foo bar}
    testfilesystem 0
    set filesystemReport
} -match glob -result {*{lstat foo}}
test filesystem-4.3 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
    catch {glob *}
    testfilesystem 0
    set filesystemReport
} -match glob -result {*{matchindirectory *}*}

test filesystem-5.1 {cache and ~} -constraints testfilesystem -setup {
    set orig $::env(HOME)
} -body {
    set ::env(HOME) /foo/bar/blah
    set testdir ~








|






|






|






|








387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422

} {native}

test filesystem-4.0 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
    file exists foo
    testfilesystem 0
    return $filesystemReport
} -match glob -result {*{access foo}}
test filesystem-4.1 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
    catch {file stat foo bar}
    testfilesystem 0
    return $filesystemReport
} -match glob -result {*{stat foo}}
test filesystem-4.2 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
    catch {file lstat foo bar}
    testfilesystem 0
    return $filesystemReport
} -match glob -result {*{lstat foo}}
test filesystem-4.3 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
    catch {glob *}
    testfilesystem 0
    return $filesystemReport
} -match glob -result {*{matchindirectory *}*}

test filesystem-5.1 {cache and ~} -constraints testfilesystem -setup {
    set orig $::env(HOME)
} -body {
    set ::env(HOME) /foo/bar/blah
    set testdir ~
︙︙
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051

    file delete -force tilde
    cd $origdir
} -result {0 0 0 0 1}

# ----------------------------------------------------------------------

cleanupTests
unset -nocomplain drive
}
namespace delete ::tcl::test::fileSystem
return

# Local Variables:
# mode: tcl
# End:








|








917
918
919
920
921
922
923
924
925
926
927
928
929
930
931

    file delete -force tilde
    cd $origdir
} -result {0 0 0 0 1}

# ----------------------------------------------------------------------

cleanupTests
unset -nocomplain drive drives
}
namespace delete ::tcl::test::fileSystem
return

# Local Variables:
# mode: tcl
# End:

This page was generated in about 0.03s by Fossil 2.24 [f4ffefe708] 2024-04-17 14:02:19