From c9609fa27feeb754fbbaa92539825a04d2c4d7f6 Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Fri, 2 Dec 2016 20:58:36 +0000
Subject: Fix [ad98f10b3a] and [bd0017bf79] - bitmap-4.1 and cursor-4.1 tests
 failures. Also, apply again the same pattern to fix color-4.1 that was also
 failing (when the colorsFree constraint was met) despite there was no such
 report (yet). Thanks to dgp.

---
 tests/bitmap.test |  9 ++++++---
 tests/color.test  | 16 +++++++++++-----
 tests/cursor.test |  9 ++++++---
 3 files changed, 23 insertions(+), 11 deletions(-)

diff --git a/tests/bitmap.test b/tests/bitmap.test
index bd9c47f..6996f88 100644
--- a/tests/bitmap.test
+++ b/tests/bitmap.test
@@ -84,12 +84,14 @@ test bitmap-3.1 {Tk_FreeBitmapFromObj - reference counts} -constraints {
 
 test bitmap-4.1 {FreeBitmapObjProc} -constraints {
     testbitmap
+} -setup {
+    proc copy {s} {return [string index $s 0][string range $s 1 end]}
 } -body {
-    set x [join questhead]
+    set x [copy questhead]
     button .b -bitmap $x
-    set y [join questhead]
+    set y [copy questhead]
     .b configure -bitmap $y
-    set z [join questhead]
+    set z [copy questhead]
     .b configure -bitmap $z
     set result {}
     lappend result [testbitmap questhead]
@@ -102,6 +104,7 @@ test bitmap-4.1 {FreeBitmapObjProc} -constraints {
     set y bogus
     return $result
 } -cleanup {
+    rename copy {}
     destroy .b
 } -result {{{1 3}} {{1 2}} {{1 1}} {}}
 
diff --git a/tests/color.test b/tests/color.test
index 237ec01..0b328cf 100644
--- a/tests/color.test
+++ b/tests/color.test
@@ -255,13 +255,17 @@ test color-3.4 {Tk_FreeColorFromObj - unlinking from list} colorsFree {
     lappend result [testcolor purple]
 } {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}
 
-test color-4.1 {FreeColorObjProc} colorsFree {
+test color-4.1 {FreeColorObjProc} -constraints {
+    colorsFree
+} -setup {
+    proc copy {s} {return [string index $s 0][string range $s 1 end]}
+} -body {
     destroy .b
-    set x [format purple]
+    set x [copy purple]
     button .b -foreground $x -text .b1
-    set y [format purple]
+    set y [copy purple]
     .b configure -foreground $y
-    set z [format purple]
+    set z [copy purple]
     .b configure -foreground $z
     set result {}
     lappend result [testcolor purple]
@@ -273,7 +277,9 @@ test color-4.1 {FreeColorObjProc} colorsFree {
     lappend result [testcolor purple]
     set y bogus
     set result
-} {{{1 3}} {{1 2}} {{1 1}} {}}
+} -cleanup {
+    rename copy {}
+} -result {{{1 3}} {{1 2}} {{1 1}} {}}
 
 destroy .t
 
diff --git a/tests/cursor.test b/tests/cursor.test
index 95c7b99..8d7ebb0 100644
--- a/tests/cursor.test
+++ b/tests/cursor.test
@@ -144,12 +144,14 @@ test cursor-3.1 {Tk_FreeCursorFromObj - reference counts} -constraints {
 
 test cursor-4.1 {FreeCursorObjProc} -constraints {
     testcursor
+} -setup {
+    proc copy {s} {return [string index $s 0][string range $s 1 end]}
 } -body {
-    set x [join heart]
+    set x [copy heart]
     button .b -cursor $x
-    set y [join heart]
+    set y [copy heart]
     .b configure -cursor $y
-    set z [join heart]
+    set z [copy heart]
     .b configure -cursor $z
     set result {}
     lappend result [testcursor heart]
@@ -162,6 +164,7 @@ test cursor-4.1 {FreeCursorObjProc} -constraints {
     set y bogus
     set result
 } -cleanup {
+    rename copy {}
     destroy .b
 } -result {{{1 3}} {{1 2}} {{1 1}} {}}
 
-- 
cgit v0.12