mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-15 19:35:25 -05:00
f36a1ebaab
* gnu/packages/version-control.scm (fossil): New variable. * gnu/packages/patches/fossil-test-fixes.patch: New patch. * gnu/local.mk (dist_patch_DATA): Add it.
189 lines
4.9 KiB
Diff
189 lines
4.9 KiB
Diff
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
|
|
}
|