Tcl Source Code

Check-in [5db36f952e]
Login

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

Overview
Comment:Test independence in fileSystem.test
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 5db36f952e4dd29bb8ad8c3a22165922730a2603
User & Date: dgp 2013-03-18 18:37:39
Context
2013-03-19
10:01
[Bug 3606387]: Fix isolation of test scan-7.4. Also updated scan.test to use tcltest 2 properly. check-in: 44ed41f429 user: dkf tags: trunk
2013-03-18
18:37
Test independence in fileSystem.test check-in: 5db36f952e user: dgp tags: trunk
18:35
Test independence in fileSystem.test check-in: bebb15f295 user: dgp tags: core-8-5-branch
18:00
Test independence in unixFCmd.test check-in: 704a4f5023 user: dgp tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/fileSystem.test.

134
135
136
137
138
139
140
141


142
143
144
145


146
147

148
149
150
151
152
153
154
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 *]] {







|
>
>



|
>
>


>







134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
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} -constraints {
    unix hasLinks
} -body {
    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]]
} -cleanup {
    file delete dir2.link
} -result ok 
makeDirectory dir2.file
test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} {
    file link dir2.link dir.link
    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 *]] {
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
   }
   # 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 {
    set result {}
    lappend result [testfilesystem 1]
    lappend result [testfilesystem 0]
    lappend result [catch {testfilesystem 0} msg] $msg
} {registered unregistered 1 failed}
test filesystem-3.3 {Tcl_FSRegister} testfilesystem {
    testfilesystem 1
    testfilesystem 1
    testfilesystem 0
    testfilesystem 0
} {unregistered}
test filesystem-3.4 {Tcl_FSRegister} testfilesystem {
    testfilesystem 1
    file system bar


} {reporting}
test filesystem-3.5 {Tcl_FSUnregister} testfilesystem {
    testfilesystem 0
    lindex [file system bar] 0
} {native}

test filesystem-4.0 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
    file exists foo







>

>














|


>
>
|

|







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
   }
   # 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]} {
  proc resetfs {} {
    while {![catch {testfilesystem 0}]} {}
  }
}

test filesystem-3.1 {Tcl_FSRegister & Tcl_FSUnregister} testfilesystem {
    set result {}
    lappend result [testfilesystem 1]
    lappend result [testfilesystem 0]
    lappend result [catch {testfilesystem 0} msg] $msg
} {registered unregistered 1 failed}
test filesystem-3.3 {Tcl_FSRegister} testfilesystem {
    testfilesystem 1
    testfilesystem 1
    testfilesystem 0
    testfilesystem 0
} {unregistered}
test filesystem-3.4 {Tcl_FSRegister} -constraints testfilesystem -body {
    testfilesystem 1
    file system bar
} -cleanup {
    testfilesystem 0
} -result {reporting}
test filesystem-3.5 {Tcl_FSUnregister} testfilesystem {
    resetfs
    lindex [file system bar] 0
} {native}

test filesystem-4.0 {testfilesystem} -constraints testfilesystem -body {
    testfilesystem 1
    set filesystemReport {}
    file exists foo