1
2
3
4
5
6
7
8
9
10
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
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
79
80
81
82
83
84
85
86
87
88
89
90
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
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
From upstream commit https://www.fossil-scm.org/fossil/info/19c216391a0ad79e
--- fossil-src-1.34/test/file1.test
+++ fossil-src-1.34/test/file1.test
@@ -15,10 +15,12 @@
#
############################################################################
#
# File utilities
#
+
+repo_init
proc simplify-name {testname args} {
set i 1
foreach {path result} $args {
fossil test-simplify-name $path
@@ -65,10 +67,13 @@
if {$::tcl_platform(os)=="Windows NT"} {
simplify-name 108 //?/a:/a/b a:/a/b //?/UNC/a/b //a/b //?/ {}
simplify-name 109 \\\\?\\a:\\a\\b a:/a/b \\\\?\\UNC\\a\\b //a/b \\\\?\\ {}
}
+
+# This is needed because we are now running outside of the Fossil checkout.
+file mkdir file1; cd file1
# Those directories are only needed for the testcase being able to "--chdir" to it.
file mkdir test1
file mkdir test1/test2
From upstream commit https://www.fossil-scm.org/fossil/info/ad6de6383391bd4d
--- fossil-src-1.34/test/utf.test
+++ fossil-src-1.34/test/utf.test
@@ -39,26 +39,29 @@
test utf-check-$testname.$i {$::RESULT eq $result}
incr i
}
}
+unset -nocomplain enc
array set enc [list \
0 binary \
1 binary \
2 unicode \
3 unicode-reverse \
]
+unset -nocomplain bom
array set bom [list \
0 "" \
1 \xEF\xBB\xBF \
2 [expr {$tcl_platform(byteOrder) eq "littleEndian" ? \
"\xFF\xFE" : "\xFE\xFF"}] \
3 [expr {$tcl_platform(byteOrder) eq "littleEndian" ? \
"\xFE\xFF" : "\xFF\xFE"}] \
]
+unset -nocomplain data
array set data [list \
0 "" \
1 \r \
2 \n \
3 \r\n \
@@ -239,10 +242,11 @@
178 \xF4\x90\x80\x80\r \
179 \xF4\x90\x80\x80\n \
180 \xF4\x90\x80\x80\r\n \
]
+unset -nocomplain extraData
array set extraData [list \
0 "" \
1 Z \
]
Backport from upstream https://www.fossil-scm.org/fossil/info/60285f5876512817
with additional non-zero exit in case of failures.
--- fossil-src-1.34/test/merge6.test
+++ fossil-src-1.34/test/merge6.test
@@ -62,6 +62,6 @@
fossil ls
test merge_multi-4 {[normalize_result] eq {f1
f2
f3
-f4}}
+f4}} knownBug
--- fossil-src-1.34/test/merge_renames.test
+++ fossil-src-1.34/test/merge_renames.test
@@ -156,13 +156,13 @@
}
if {$deletes!=0} {
# failed
protOut "Error, the merge should not delete any file"
- test merge_renames-2 0
+ test merge_renames-3 0
} else {
- test merge_renames-2 1
+ test merge_renames-3 1
}
######################################
# Test 4 #
# Reported: Ticket [67176c3aa4] #
@@ -198,14 +198,14 @@
fossil ls
test merge_renames-5 {[normalize_result] eq {f1
f2
-f3}}
+f3}} knownBug
######################################
#
# Tests for troubles not specifically linked with renames but that I'd like to
# write:
# [c26c63eb1b] - 'merge --backout' does not handle conflicts properly
# [953031915f] - Lack of warning when overwriting extra files
# [4df5f38f1e] - Troubles merging a file delete with a file change
--- fossil-src-1.34/test/tester.tcl
+++ fossil-src-1.34/test/tester.tcl
@@ -58,10 +58,18 @@
set VERBOSE 1
set argv [lreplace $argv $i $i]
} else {
set VERBOSE 0
}
+
+set i [lsearch $argv -strict]
+if {$i>=0} {
+ set STRICT 1
+ set argv [lreplace $argv $i $i]
+} else {
+ set STRICT 0
+}
if {[llength $argv]==0} {
foreach f [lsort [glob $testdir/*.test]] {
set base [file root [file tail $f]]
lappend argv $base
@@ -327,20 +335,30 @@
}
# Perform a test
#
set test_count 0
-proc test {name expr} {
+proc test {name expr {constraints ""}} {
global bad_test test_count
incr test_count
+ set knownBug [expr {"knownBug" in $constraints}]
set r [uplevel 1 [list expr $expr]]
if {$r} {
- protOut "test $name OK"
+ if {$knownBug && !$::STRICT} {
+ protOut "test $name OK (knownBug)?"
+ } else {
+ protOut "test $name OK"
+ }
} else {
- protOut "test $name FAILED!"
- lappend bad_test $name
- if {$::HALT} exit
+ if {$knownBug && !$::STRICT} {
+ protOut "test $name FAILED (knownBug)!"
+ } else {
+ protOut "test $name FAILED!"
+ if {$::VERBOSE} {protOut "RESULT: $RESULT"}
+ lappend bad_test $name
+ if {$::HALT} exit
+ }
}
}
set bad_test {}
# Return a random string N characters long.
@@ -445,4 +455,5 @@
protOut "***** Final result: $nErr errors out of $test_count tests"
if {$nErr>0} {
protOut "***** Failures: $bad_test"
+ exit 1
}
|