summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--tests/bitmap.test9
-rw-r--r--tests/border.test9
-rw-r--r--tests/color.test16
-rw-r--r--tests/cursor.test9
4 files changed, 29 insertions, 14 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/border.test b/tests/border.test
index 2ca64c1..d6ff5c7 100644
--- a/tests/border.test
+++ b/tests/border.test
@@ -127,16 +127,18 @@ test border-2.2 {Tk_Free3DBorder - unlinking from list} -constraints {
destroy .b .t2 .t3 .t
} -result {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}
+
test border-3.1 {FreeBorderObjProc} -constraints {
testborder
} -setup {
set result {}
+ proc copy {s} {return [string index $s 0][string range $s 1 end]}
} -body {
- set x [join purple]
+ set x [copy purple]
button .b -bg $x -text .b1
- set y [join purple]
+ set y [copy purple]
.b configure -bg $y
- set z [join purple]
+ set z [copy purple]
.b configure -bg $z
lappend result [testborder purple]
set x red
@@ -148,6 +150,7 @@ test border-3.1 {FreeBorderObjProc} -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}} {}}