Tcl Source Code

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

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

Overview
Comment:fix filesystem-7.1.x tests in install environment [3549770], as suggested by Twylite temporary workaround for winPipe failing tests (still work to do)
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a748572cd1e3bcf563e522192523061847347059
User & Date: jan.nijtmans 2012-07-30 15:03:43
Context
2012-07-30
15:13
fix event-tests running with tcltest86.dll check-in: f589421a83 user: jan.nijtmans tags: trunk
15:03
fix filesystem-7.1.x tests in install environment [3549770], as suggested by Twylite temporary worka... check-in: a748572cd1 user: jan.nijtmans tags: trunk
14:09
unneeded variable check-in: d54ed135c4 user: jan.nijtmans tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/fileSystem.test.

︙︙
15
16
17
18
19
20
21

22
23
24
25
26
27
28

29
30
31
32
33
34
35


    catch {
	file delete -force link.file
	file delete -force dir.link
	file delete -force [file join dir.dir linkinside.file]
    }


catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    set ::ddever [lindex [lsort [package versions dde]] end]
    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]
    set ::regver [lindex [lsort [package versions registry]] end]
    set ::reglib [lindex [package ifneeded registry $::regver] 1]

}

# Test for commands defined in Tcltest executable
testConstraint testfilesystem  	    [llength [info commands ::testfilesystem]]
testConstraint testsetplatform 	    [llength [info commands ::testsetplatform]]
testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]]









>



|

|

>








15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37


    catch {
	file delete -force link.file
	file delete -force dir.link
	file delete -force [file join dir.dir linkinside.file]
    }

testConstraint loaddll 0
catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    set ::ddever [package require dde]
    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]
    set ::regver  [package require registry]
    set ::reglib [lindex [package ifneeded registry $::regver] 1]
    testConstraint loaddll 0
}

# Test for commands defined in Tcltest executable
testConstraint testfilesystem  	    [llength [info commands ::testfilesystem]]
testConstraint testsetplatform 	    [llength [info commands ::testsetplatform]]
testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]]
︙︙
506
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

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

test filesystem-7.1.1 {load from vfs} -setup {
    set dir [pwd]
} -constraints {win testsimplefilesystem} -body {
    # This may cause a crash on exit
    cd [file dirname [info nameof]]
    testsimplefilesystem 1
    # This loads dde via a complex copy-to-temp operation
    load simplefs:/$::ddelib dde
    testsimplefilesystem 0
    return ok
    # The real result of this test is what happens when Tcl exits.
} -cleanup {
    cd $dir
} -result ok
test filesystem-7.1.2 {load from vfs, and then unload again} -setup {
    set dir [pwd]
} -constraints {win testsimplefilesystem} -body {
    # This may cause a crash on exit
    cd [file dirname [info nameof]]
    testsimplefilesystem 1
    # This loads reg via a complex copy-to-temp operation
    load simplefs:/$::reglib Registry
    unload simplefs:/$::reglib
    testsimplefilesystem 0
    return ok
    # The real result of this test is what happens when Tcl exits.
} -cleanup {
    cd $dir
} -result ok
test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} -setup {








|

|


|








|

|


|
|








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

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

test filesystem-7.1.1 {load from vfs} -setup {
    set dir [pwd]
} -constraints {win testsimplefilesystem loaddll} -body {
    # This may cause a crash on exit
    cd [file dirname $::reglib]
    testsimplefilesystem 1
    # This loads dde via a complex copy-to-temp operation
    load simplefs:/[file tail $::ddelib] dde
    testsimplefilesystem 0
    return ok
    # The real result of this test is what happens when Tcl exits.
} -cleanup {
    cd $dir
} -result ok
test filesystem-7.1.2 {load from vfs, and then unload again} -setup {
    set dir [pwd]
} -constraints {win testsimplefilesystem loaddll} -body {
    # This may cause a crash on exit
    cd [file dirname $::reglib]
    testsimplefilesystem 1
    # This loads reg via a complex copy-to-temp operation
    load simplefs:/[file tail $::reglib] Registry
    unload simplefs:/[file tail $::reglib]
    testsimplefilesystem 0
    return ok
    # The real result of this test is what happens when Tcl exits.
} -cleanup {
    cd $dir
} -result ok
test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} -setup {
︙︙

Changes to tests/winPipe.test.

︙︙
19
20
21
22
23
24
25

26
27
28
29
30
31
32

set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]

testConstraint exec         [llength [info commands exec]]
testConstraint cat32        [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole  [expr {![testConstraint AllocConsole]}]


set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
append big $big	
append big $big
append big $big
append big $big








>








19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]

testConstraint exec         [llength [info commands exec]]
testConstraint cat32        [file exists $cat32]
testConstraint AllocConsole [catch {puts console1 ""}]
testConstraint RealConsole  [expr {![testConstraint AllocConsole]}]
testConstraint testexcept 0; # TODO: fix this

set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
append big $big	
append big $big
append big $big
append big $big
︙︙
186
187
188
189
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

    fconfigure $f  -buffering none -blocking 0
    fileevent $f readable "readResults $f"
    set x 0
    set result ""
    vwait x
    list $result $x [contents $path(stderr)]
} "{$big} 1 stderr32"
test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "testexcept float_underflow"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGFPE}
test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "testexcept access_violation"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGSEGV}
test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "testexcept illegal_instruction"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGILL}
test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "testexcept ctrl+c"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGINT}









|






|






|






|








187
188
189
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

    fconfigure $f  -buffering none -blocking 0
    fileevent $f readable "readResults $f"
    set x 0
    set result ""
    vwait x
    list $result $x [contents $path(stderr)]
} "{$big} 1 stderr32"
test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "testexcept float_underflow"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGFPE}
test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "testexcept access_violation"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGSEGV}
test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "testexcept illegal_instruction"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGILL}
test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "testexcept ctrl+c"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGINT}
︙︙

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