diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | tests/imgPhoto.test | 64 |
2 files changed, 34 insertions, 34 deletions
@@ -1,3 +1,7 @@ +2008-08-28 Donal K. Fellows <dkf@users.sf.net> + + * tests/imgPhoto.test: Fix failures. [Bug 2080587] + 2008-08-28 Ania Pawelczyk <aniap@users.sourceforge.net> * tests/option.test: Update to tcltest2 diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test index e8d024a..ed4b23a 100644 --- a/tests/imgPhoto.test +++ b/tests/imgPhoto.test @@ -10,7 +10,7 @@ # # Author: Paul Mackerras (paulus@cs.anu.edu.au) # -# RCS: @(#) $Id: imgPhoto.test,v 1.33 2008/08/27 16:37:16 dgp Exp $ +# RCS: @(#) $Id: imgPhoto.test,v 1.34 2008/08/28 15:36:16 dkf Exp $ package require tcltest 2.2 namespace import ::tcltest::* @@ -39,6 +39,18 @@ proc checkImgTrans {img} { } return $result } +proc checkImgTransLoop {img script1 script2} { + set result {} + foreachPixel $img x y { + eval $script1 + lappend result {*}[checkImgTrans $img] + append result : + eval $script2 + lappend result {*}[checkImgTrans $img] + append result . + } + return $result +} image delete {*}[image names] set README [makeFile { @@ -699,46 +711,28 @@ test imgPhoto-4.66 {ImgPhotoCmd procedure: transparency get option} -setup { } -result {0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2} test imgPhoto-4.67 {ImgPhotoCmd procedure: transparency set option} -setup { image create photo photo1 - proc checkImgTransLoopSetReset {img width height} { - set result {} - foreachPixel img x y { - $img put white -to 0 0 3 3 - $img transparency set $x $y 1 - lappend result {*}[checkImgTrans $img] - append result : - $img transparency set $x $y 0 - lappend result {*}[checkImgTrans $img] - append result . - } - return $result - } } -body { photo1 put white -to 0 0 3 3 - checkImgTransLoopSetReset photo1 3 3 + checkImgTransLoop photo1 { + photo1 put white -to 0 0 3 3 + photo1 transparency set $x $y 1 + } { + photo1 transparency set $x $y 0 + } } -cleanup { - rename checkImgTransLoopSetReset {} image delete photo1 } -result {0,0:. 0,1:. 0,2:. 1,0:. 1,1:. 1,2:. 2,0:. 2,1:. 2,2:.} test imgPhoto-4.68 {ImgPhotoCmd procedure: transparency set option} -setup { image create photo photo1 - proc checkImgTransLoopResetSet {img width height} { - set result {} - foreachPixel $img x y { - $img blank - $img transparency set $x $y 0 - lappend result {*}[checkImgTrans $img] - append result : - $img transparency set $x $y 1 - lappend result {*}[checkImgTrans $img] - append result . - } - return $result - } } -body { photo1 put white -to 0 0 3 3 - checkImgTransLoopResetSet photo1 3 3 + checkImgTransLoop photo1 { + photo1 blank + photo1 transparency set $x $y 0 + } { + photo1 transparency set $x $y 1 + } } -cleanup { - catch {rename checkImgTransLoopResetSet {}} image delete photo1 } -result {0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,2 1,0 1,1 1,2 2,0 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 1,0 1,1 1,2 2,0 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 0,2 1,1 1,2 2,0 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 0,2 1,0 1,2 2,0 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 0,2 1,0 1,1 2,0 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 0,2 1,0 1,1 1,2 2,1 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,2: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2. 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1: 0,0 0,1 0,2 1,0 1,1 1,2 2,0 2,1 2,2.} test imgPhoto-4.69 {ImgPhotoCmd procedure: copy with -compositingrule} -setup { @@ -774,7 +768,7 @@ test imgPhoto-4.71 {ImgPhotoCmd procedure: copy with -compositingrule} -setup { checkImgTrans photo1 } -cleanup { image delete photo1 photo2 -} -result {0 2 2 0} +} -result {0,2 2,0} test imgPhoto-4.72 {ImgPhotoCmd procedure: copy with -compositingrule} -setup { # Test the compositing rules for copying images image create photo photo1 -width 3 -height 3 @@ -789,7 +783,7 @@ test imgPhoto-4.72 {ImgPhotoCmd procedure: copy with -compositingrule} -setup { checkImgTrans photo1 } -cleanup { image delete photo1 photo2 -} -result {0 2 2 0} +} -result {0,2 2,0} test imgPhoto-4.73 {ImgPhotoCmd procedure: copy with -compositingrule} -setup { # Test the compositing rules for copying images image create photo photo1 -width 3 -height 3 @@ -804,7 +798,7 @@ test imgPhoto-4.73 {ImgPhotoCmd procedure: copy with -compositingrule} -setup { checkImgTrans photo1 } -cleanup { image delete photo1 photo2 -} -result {0 2 1 1 2 0} +} -result {0,2 1,1 2,0} test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} -constraints { hasTeapotPhoto @@ -1123,7 +1117,9 @@ test imgPhoto-16.1 {copying to self doesn't access freed memory} -setup { # ---------------------------------------------------------------------- +catch {rename foreachPixel {}} catch {rename checkImgTrans {}} +catch {rename checkImgTransLoop {}} image delete {*}[image names] # cleanup |