Tcl Source Code

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

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

Overview
Comment:Fix 2 failing tests on Windows 7. Fix backported from Tcl 8.6
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | core-8-4-branch
Files: files | file ages | folders
SHA1: 73ea2aa11cc5dc0d3848422fcc753306af954cab
User & Date: jan.nijtmans 2012-11-15 10:33:35
Context
2012-11-15
14:33
add missing macosx sections check-in: 72b6dd4575 user: jan.nijtmans tags: core-8-4-branch
12:44
merge 8.4 check-in: 9f46c3980e user: dgp tags: core-8-4-20-rc
10:40
merge-mark check-in: 36dcc8c210 user: jan.nijtmans tags: core-8-5-branch
10:33
Fix 2 failing tests on Windows 7. Fix backported from Tcl 8.6 check-in: 73ea2aa11c user: jan.nijtmans tags: core-8-4-branch
08:23
Remove all the long dead mac entries in tcl*.decls files

backport genStubs::forAllStubs function,...

 check-in: 1c47c5d187 user: jan.nijtmans tags: core-8-4-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tests/winFCmd.test.

︙︙
11
12
13
14
15
16
17















18
19
20
21
22
23
24

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}
















proc createfile {file {string a}} {
    set f [open $file w]
    puts -nonewline $f $string
    close $f
    return $string
}









>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








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

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

# Initialise the test constraints

testConstraint winVista 0
testConstraint win2000orXP 0
testConstraint winOlderThan2000 0
testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint testfile       [llength [info commands testfile]]
testConstraint testchmod      [llength [info commands testchmod]]
testConstraint cdrom 0
testConstraint exdev 0
testConstraint longFileNames 0

proc createfile {file {string a}} {
    set f [open $file w]
    puts -nonewline $f $string
    close $f
    return $string
}
︙︙
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

	}
	if {$x != ""} {
	    catch {eval file delete -force -- $x}
	}
    }
}

if {[string equal $tcl_platform(platform) "windows"]} {
    if {[string equal $tcl_platform(os) "Windows NT"] \
      && [string equal [string index $tcl_platform(osVersion) 0] "5"]} {
	tcltest::testConstraint win2000orXP 1

	tcltest::testConstraint winOlderThan2000 0
    } else {
	tcltest::testConstraint win2000orXP 0
	tcltest::testConstraint winOlderThan2000 1
    }
} else {
    tcltest::testConstraint win2000orXP 0
    tcltest::testConstraint winOlderThan2000 0
}

set ::tcltest::testConstraints(cdrom) 0
set ::tcltest::testConstraints(exdev) 0

# find a CD-ROM so we can test read-only filesystems.

set cdrom {}
if { [info commands ::testvolumetype] ne {} } {
    foreach p {d e f g h i j k l m n o p q r s t u v w x y z} {
        if { ! [catch { testvolumetype ${p}: } result] && $result eq {CDFS} } {








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








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

	}
	if {$x != ""} {
	    catch {eval file delete -force -- $x}
	}
    }
}

if {[testConstraint winOnly]} {

    set major [string index $tcl_platform(osVersion) 0]
    if {[testConstraint nt] && $major > 4} {
	if {$major > 5} {
	    testConstraint winVista 1
	} elseif {$major == 5} {
	    testConstraint win2000orXP 1

	}
    } else {

	testConstraint winOlderThan2000 1
    }
}



# find a CD-ROM so we can test read-only filesystems.

set cdrom {}
if { [info commands ::testvolumetype] ne {} } {
    foreach p {d e f g h i j k l m n o p q r s t u v w x y z} {
        if { ! [catch { testvolumetype ${p}: } result] && $result eq {CDFS} } {
︙︙
733
734
735
736
737
738
739
740
741

742
743


744

745
746
747
748
749
750
751

    contents td2/tf1
} {tf1}    
test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {pcOnly 95} {
    cleanup
    file mkdir td1
    list [catch {testfile cpdir td1 /} msg] $msg
} {1 {/ EEXIST}}
test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} {pcOnly nt} {
    cleanup

    file mkdir td1
    list [catch {testfile cpdir td1 /} msg] $msg


} {1 {/ EACCES}}

test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {pcOnly} {
    cleanup
    file mkdir td1
    testfile cpdir td1 td2
} {}
test winFCmd-7.17 {TraverseWinTree: recurse on files: one file} {pcOnly} {
    cleanup








|

>

|
>
>
|
>








744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766

    contents td2/tf1
} {tf1}    
test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {pcOnly 95} {
    cleanup
    file mkdir td1
    list [catch {testfile cpdir td1 /} msg] $msg
} {1 {/ EEXIST}}
test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
    cleanup
} -constraints {pcOnly nt} -body {
    file mkdir td1
    testfile cpdir td1 /
} -cleanup {
    cleanup
    # Windows7 returns EEXIST, XP returns EACCES
} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {pcOnly} {
    cleanup
    file mkdir td1
    testfile cpdir td1 td2
} {}
test winFCmd-7.17 {TraverseWinTree: recurse on files: one file} {pcOnly} {
    cleanup
︙︙
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127


cd $pwd
unset d dd pwd

test winFCmd-18.1 {Windows reserved path names} -constraints win -body {
    file pathtype com1
} -result "absolute"

test winFCmd-18.1.2 {Windows reserved path names} -constraints win -body {
    file pathtype com4
} -result "absolute"

test winFCmd-18.1.3 {Windows reserved path names} -constraints win -body {
    file pathtype com5
} -result "relative"

test winFCmd-18.1.4 {Windows reserved path names} -constraints win -body {
    file pathtype lpt3
} -result "absolute"

test winFCmd-18.1.5 {Windows reserved path names} -constraints win -body {
    file pathtype lpt4
} -result "relative"

test winFCmd-18.1.6 {Windows reserved path names} -constraints win -body {
    file pathtype nul
} -result "absolute"

test winFCmd-18.1.7 {Windows reserved path names} -constraints win -body {
    file pathtype null
} -result "relative"

test winFCmd-18.2 {Windows reserved path names} -constraints win -body {
    file pathtype com1:
} -result "absolute"

test winFCmd-18.3 {Windows reserved path names} -constraints win -body {
    file pathtype COM1
} -result "absolute"

test winFCmd-18.4 {Windows reserved path names} -constraints win -body {
    file pathtype CoM1:
} -result "absolute"

test winFCmd-18.5 {Windows reserved path names} -constraints win -body {
    file normalize com1:
} -result COM1

test winFCmd-18.6 {Windows reserved path names} -constraints win -body {
    file normalize COM1:
} -result COM1

test winFCmd-18.7 {Windows reserved path names} -constraints win -body {
    file normalize cOm1
} -result COM1

test winFCmd-18.8 {Windows reserved path names} -constraints win -body {
    file normalize cOm1:
} -result COM1

# This block of code used to occur after the "return" call, so I'm
# commenting it out and assuming that this code is still under construction.
#foreach source {tef ted tnf tnd "" nul com1} {








<



<



<



<



<



<



<



<



<



<



<



<



<








1080
1081
1082
1083
1084
1085
1086

1087
1088
1089

1090
1091
1092

1093
1094
1095

1096
1097
1098

1099
1100
1101

1102
1103
1104

1105
1106
1107

1108
1109
1110

1111
1112
1113

1114
1115
1116

1117
1118
1119

1120
1121
1122

1123
1124
1125
1126
1127
1128
1129


cd $pwd
unset d dd pwd

test winFCmd-18.1 {Windows reserved path names} -constraints win -body {
    file pathtype com1
} -result "absolute"

test winFCmd-18.1.2 {Windows reserved path names} -constraints win -body {
    file pathtype com4
} -result "absolute"

test winFCmd-18.1.3 {Windows reserved path names} -constraints win -body {
    file pathtype com5
} -result "relative"

test winFCmd-18.1.4 {Windows reserved path names} -constraints win -body {
    file pathtype lpt3
} -result "absolute"

test winFCmd-18.1.5 {Windows reserved path names} -constraints win -body {
    file pathtype lpt4
} -result "relative"

test winFCmd-18.1.6 {Windows reserved path names} -constraints win -body {
    file pathtype nul
} -result "absolute"

test winFCmd-18.1.7 {Windows reserved path names} -constraints win -body {
    file pathtype null
} -result "relative"

test winFCmd-18.2 {Windows reserved path names} -constraints win -body {
    file pathtype com1:
} -result "absolute"

test winFCmd-18.3 {Windows reserved path names} -constraints win -body {
    file pathtype COM1
} -result "absolute"

test winFCmd-18.4 {Windows reserved path names} -constraints win -body {
    file pathtype CoM1:
} -result "absolute"

test winFCmd-18.5 {Windows reserved path names} -constraints win -body {
    file normalize com1:
} -result COM1

test winFCmd-18.6 {Windows reserved path names} -constraints win -body {
    file normalize COM1:
} -result COM1

test winFCmd-18.7 {Windows reserved path names} -constraints win -body {
    file normalize cOm1
} -result COM1

test winFCmd-18.8 {Windows reserved path names} -constraints win -body {
    file normalize cOm1:
} -result COM1

# This block of code used to occur after the "return" call, so I'm
# commenting it out and assuming that this code is still under construction.
#foreach source {tef ted tnf tnd "" nul com1} {
︙︙
1149
1150
1151
1152
1153
1154
1155





#    }
#}

# cleanup
cleanup
::tcltest::cleanupTests
return












>
>
>
>

1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161

#    }
#}

# cleanup
cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

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