Tk Source Code

Check-in [47aadbfe]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Fix [ddeef0e069]: Some canvImg tests fail on macOS
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-ddeef0e069
Files: files | file ages | folders
SHA3-256: 47aadbfe0c55b69c8f7e5ee8146d0e5f924b4fb63ae6ef9e32224e2b2ba9b700
User & Date: fvogel 2018-04-30 18:49:38
References
2018-04-30
18:51 Ticket [ddeef0e0] Some canvImg tests fail on macOS status still Open with 5 other changes artifact: af775f00 user: fvogel
Context
2018-05-13
17:35
Fix [ddeef0e069]: Some canvImg tests fail on macOS check-in: 57efce1e user: fvogel tags: core-8-6-branch
2018-04-30
18:49
Fix [ddeef0e069]: Some canvImg tests fail on macOS Closed-Leaf check-in: 47aadbfe user: fvogel tags: bug-ddeef0e069
15:53
Fix [6d5042069f]: tk inactive does not work on macOS (tk-6.5 fails) check-in: adb7926c user: culler tags: core-8-6-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tkTest.c.

1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
    int drawableX, int drawableY)
				/* Coordinates in drawable corresponding to
				 * imageX and imageY. */
{
    TImageInstance *instPtr = (TImageInstance *) clientData;
    char buffer[200 + TCL_INTEGER_SPACE * 6];

    sprintf(buffer, "%s display %d %d %d %d %d %d",
	    instPtr->masterPtr->imageName, imageX, imageY, width, height,
	    drawableX, drawableY);
    Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL,
	    buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    if (width > (instPtr->masterPtr->width - imageX)) {
	width = instPtr->masterPtr->width - imageX;
    }
    if (height > (instPtr->masterPtr->height - imageY)) {
	height = instPtr->masterPtr->height - imageY;






|
|
<







1546
1547
1548
1549
1550
1551
1552
1553
1554

1555
1556
1557
1558
1559
1560
1561
    int drawableX, int drawableY)
				/* Coordinates in drawable corresponding to
				 * imageX and imageY. */
{
    TImageInstance *instPtr = (TImageInstance *) clientData;
    char buffer[200 + TCL_INTEGER_SPACE * 6];

    sprintf(buffer, "%s display %d %d %d %d",
	    instPtr->masterPtr->imageName, imageX, imageY, width, height);

    Tcl_SetVar2(instPtr->masterPtr->interp, instPtr->masterPtr->varName, NULL,
	    buffer, TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
    if (width > (instPtr->masterPtr->width - imageX)) {
	width = instPtr->masterPtr->width - imageX;
    }
    if (height > (instPtr->masterPtr->height - imageY)) {
	height = instPtr->masterPtr->height - imageY;

Changes to tests/canvImg.test.

169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
...
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
...
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
...
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
    .c itemconfigure i1 -image foo2
    update
    list $x $y [.c bbox i1]
} -cleanup {
	.c delete all
	image delete foo
	image delete foo2
} -result {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60 30 30}} {50 100 130 160}}
test canvImg-4.3 {ConfiugreImage procedure} -constraints testImageType -setup {
    .c delete all
} -body {
	image create test foo -variable x
    image create test foo2 -variable y
    foo2 changed 0 0 0 0 80 60
    .c create image 50 100 -image foo -tags i1 -anchor nw
................................................................................
    set x {}
    foo changed 2 4 6 8 30 15
    update
    return $x
} -cleanup {
	.c delete all
	image delete foo
} -result {{foo display 2 4 6 8 30 30}}

test canvImg-11.1 {TranslateImage procedure} -constraints testImageType -setup {
    .c delete all
} -body {
	image create test foo -variable x
    .c create image 50 100 -image foo -tags image -anchor nw
    update
................................................................................
    set x {}
    foo changed 2 4 6 8 40 50
    update
    return $x
} -cleanup {
	.c delete all
	image delete foo
} -result {{foo display 0 0 40 50 30 30}}
test canvImg-11.2 {ImageChangedProc procedure} -constraints {
	testImageType 
} -setup {
    .c delete all
} -body {
    image create test foo -variable x
    .c create image 50 100 -image foo -tags image -anchor center
................................................................................
    set y {}
    image create test foo -variable x
    update
    return $y
} -cleanup {
	.c delete all
	image delete foo foo2
} -result {{foo2 display 0 0 20 40 50 40}}

# cleanup
imageFinish
cleanupTests
return

# Local variables:
# mode: tcl
# End:






|







 







|







 







|







 







|









169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
...
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
...
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
...
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
    .c itemconfigure i1 -image foo2
    update
    list $x $y [.c bbox i1]
} -cleanup {
	.c delete all
	image delete foo
	image delete foo2
} -result {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60}} {50 100 130 160}}
test canvImg-4.3 {ConfiugreImage procedure} -constraints testImageType -setup {
    .c delete all
} -body {
	image create test foo -variable x
    image create test foo2 -variable y
    foo2 changed 0 0 0 0 80 60
    .c create image 50 100 -image foo -tags i1 -anchor nw
................................................................................
    set x {}
    foo changed 2 4 6 8 30 15
    update
    return $x
} -cleanup {
	.c delete all
	image delete foo
} -result {{foo display 2 4 6 8}}

test canvImg-11.1 {TranslateImage procedure} -constraints testImageType -setup {
    .c delete all
} -body {
	image create test foo -variable x
    .c create image 50 100 -image foo -tags image -anchor nw
    update
................................................................................
    set x {}
    foo changed 2 4 6 8 40 50
    update
    return $x
} -cleanup {
	.c delete all
	image delete foo
} -result {{foo display 0 0 40 50}}
test canvImg-11.2 {ImageChangedProc procedure} -constraints {
	testImageType 
} -setup {
    .c delete all
} -body {
    image create test foo -variable x
    .c create image 50 100 -image foo -tags image -anchor center
................................................................................
    set y {}
    image create test foo -variable x
    update
    return $y
} -cleanup {
	.c delete all
	image delete foo foo2
} -result {{foo2 display 0 0 20 40}}

# cleanup
imageFinish
cleanupTests
return

# Local variables:
# mode: tcl
# End:

Changes to tests/image.test.

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
..
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
...
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
...
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
    update
    set x {}
    image create test myimage -variable x
    update
    return $x
} -cleanup {
    imageCleanup
} -result {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}}
test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints {
	testImageType 
} -setup {
    .c delete all
    imageCleanup
} -body {
    image create test myimage -variable x
................................................................................
    set x {}
    image create test myimage -variable x
    update
    return $x
} -cleanup {
    .c delete all
    imageCleanup
} -result {{myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}}
test image-1.9 {Tk_ImageCmd procedure, "create" option} -constraints {
	testImageType 
} -body {
    image create test -badName foo
} -returnCodes error -result {bad option name "-badName"}
test image-1.10 {Tk_ImageCmd procedure, "create" option} -constraints {
    testImageType 
................................................................................
    set x {}
    foo changed 5 6 7 8 30 15
    update
    return $x
} -cleanup {
    .c delete all
    imageCleanup
} -result {{foo display 5 6 7 8 30 30}}
test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup {
    .c delete all
    imageCleanup
} -body {
    image create test foo -variable x
    .c create image 50 50 -image foo
    .c create image 90 100 -image foo
................................................................................
    set x {}
    foo changed 5 6 7 8 30 15
    update
    return $x
} -cleanup {
    .c delete all
    imageCleanup
} -result {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}}


test image-10.1 {Tk_GetImage procedure} -setup {
    imageCleanup
} -body {
    .c create image 100 10 -image bad_name
} -cleanup {
................................................................................
    .c delete i1
    pack .c
    update
    list [imageNames] $x
} -cleanup {
    .c delete all
    imageCleanup
} -result {foo {{foo free} {foo display 0 0 30 15 103 121}}}
test image-11.2 {Tk_FreeImage procedure} -constraints testImageType -setup {
    .c delete all
    imageCleanup
} -body {
    image create test foo -variable x
    .c create image 50 50 -image foo -tags i1
    set names [imageNames]






|







 







|







 







|







 







|







 







|







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
..
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
...
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
...
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
    update
    set x {}
    image create test myimage -variable x
    update
    return $x
} -cleanup {
    imageCleanup
} -result {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15} {myimage display 0 0 30 15}}
test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints {
	testImageType 
} -setup {
    .c delete all
    imageCleanup
} -body {
    image create test myimage -variable x
................................................................................
    set x {}
    image create test myimage -variable x
    update
    return $x
} -cleanup {
    .c delete all
    imageCleanup
} -result {{myimage get} {myimage get} {myimage display 0 0 30 15} {myimage display 0 0 30 15}}
test image-1.9 {Tk_ImageCmd procedure, "create" option} -constraints {
	testImageType 
} -body {
    image create test -badName foo
} -returnCodes error -result {bad option name "-badName"}
test image-1.10 {Tk_ImageCmd procedure, "create" option} -constraints {
    testImageType 
................................................................................
    set x {}
    foo changed 5 6 7 8 30 15
    update
    return $x
} -cleanup {
    .c delete all
    imageCleanup
} -result {{foo display 5 6 7 8}}
test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup {
    .c delete all
    imageCleanup
} -body {
    image create test foo -variable x
    .c create image 50 50 -image foo
    .c create image 90 100 -image foo
................................................................................
    set x {}
    foo changed 5 6 7 8 30 15
    update
    return $x
} -cleanup {
    .c delete all
    imageCleanup
} -result {{foo display 5 6 25 9} {foo display 0 0 12 14}}


test image-10.1 {Tk_GetImage procedure} -setup {
    imageCleanup
} -body {
    .c create image 100 10 -image bad_name
} -cleanup {
................................................................................
    .c delete i1
    pack .c
    update
    list [imageNames] $x
} -cleanup {
    .c delete all
    imageCleanup
} -result {foo {{foo free} {foo display 0 0 30 15}}}
test image-11.2 {Tk_FreeImage procedure} -constraints testImageType -setup {
    .c delete all
    imageCleanup
} -body {
    image create test foo -variable x
    .c create image 50 50 -image foo -tags i1
    set names [imageNames]