Tk Source Code

Changes On Branch fv-macos-scrollbar-tests
Login
☰Core Home Timeline Branches Tags Tickets Download Wiki
Patch Side-by-Side Diff

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

Changes In Branch fv-macos-scrollbar-tests Excluding Merge-Ins

This is equivalent to a diff from da5ba250 to d8819e41

2020-08-24
09:31
Fix duplicate test name scrollbar-3.50.1 check-in: a288b5fc user: fvogel tags: core-8-6-branch
09:30
Fix duplicate test name scrollbar-3.50.1 Closed-Leaf check-in: d8819e41 user: fvogel tags: fv-macos-scrollbar-tests
2018-10-18
20:22
All scrollbar tests pass on all platforms (but not all tests are run on all platforms) check-in: 9044983d user: fvogel tags: core-8-6-branch
20:16
Fix scrollbar.test: all tests that run on macOS now pass (and that's true for each platform BTW: Windows, Linux and macOS). check-in: 41f7a357 user: fvogel tags: fv-macos-scrollbar-tests
18:59
merge core-8-6-branch check-in: 9e5b972b user: fvogel tags: fv-macos-scrollbar-tests
18:55
Restore the remaining missing changes stripped out due to the recent merge/backout dance between branches (scrollbar fixes and Mojave fixes). check-in: a77fb428 user: fvogel tags: trunk
18:48
Restore the remaining missing changes stripped out due to the recent merge/backout dance between branches (scrollbar fixes and Mojave fixes). check-in: da5ba250 user: fvogel tags: core-8-6-branch
16:10
Fix clipboard behavior and remove the TkSuspendClipboard stub function. check-in: 0d51260c user: culler tags: core-8-6-branch

Changes to tests/scrollbar.test.
︙
14
15
16
17
18
19
20

21
22
23
24
25
26

27
28
29
30
31
32
33
34
35
36
37
38
























39
40
41
42
43
44
45

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28












29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59








+






+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








proc scroll args {
    global scrollInfo
    set scrollInfo $args
}

proc getTroughSize {w} {
    if {[testConstraint testmetrics]} {
        # Only Windows has [testmetrics]
	if [string match v* [$w cget -orient]] {
	    return [expr [winfo height $w] - 2*[testmetrics cyvscroll $w]]
	} else {
	    return [expr [winfo width $w] - 2*[testmetrics cxhscroll $w]]
	}	    
    } else {
        if {[tk windowingsystem] eq "x11"} {
        # Calculations here assume that the arrow area is a square.
	if [string match v* [$w cget -orient]] {
	    return [expr [winfo height $w] \
		    - ([winfo width $w] \
			- [$w cget -highlightthickness] \
			- [$w cget -bd] + 1)*2]
	} else {
	    return [expr [winfo width $w] \
		    - ([winfo height $w] \
			- [$w cget -highlightthickness] \
			- [$w cget -bd] + 1)*2]
	}
            # Calculations here assume that the arrow area is a square.
	    if [string match v* [$w cget -orient]] {
	        return [expr [winfo height $w] \
		        - ([winfo width $w] \
			    - [$w cget -highlightthickness] \
			    - [$w cget -bd] + 1)*2]
	    } else {
	        return [expr [winfo width $w] \
		        - ([winfo height $w] \
			    - [$w cget -highlightthickness] \
			    - [$w cget -bd] + 1)*2]
	    }
        } else {
            # macOS aqua
	    if [string match v* [$w cget -orient]] {
	        return [expr [winfo height $w] \
			- ([$w cget -highlightthickness] \
			  +[$w cget -bd])*2]
	    } else {
	        return [expr [winfo width $w] \
			- ([$w cget -highlightthickness] \
			  +[$w cget -bd])*2]
	    }
        }
    }
}

# XXX Note: this test file is woefully incomplete.  Right now there are
# only bits and pieces of tests.  Please make this file more complete
# as you fix bugs and add features.
︙
252
253
254
255
256
257
258
259

260
261
262
263
264
265

266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284

285
286

287





288
289
290
291
292
293
294

266
267
268
269
270
271
272

273
274
275
276
277
278

279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302

303
304
305
306
307
308
309
310
311
312
313
314








-
+





-
+



















+


+
-
+
+
+
+
+








test scrollbar-3.34 {ScrollbarWidgetCmd procedure, "fraction" option} {
    format {%.6g} [.s fraction 0 1000]
} {1}
test scrollbar-3.35 {ScrollbarWidgetCmd procedure, "fraction" option} {
    format {%.6g} [.s fraction 4 21]
} [format %.6g [expr (21.0 - ([winfo height .s] - [getTroughSize .s])/2.0) \
       /([getTroughSize .s] - 1)]]
test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} unix {
test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} x11 {
    format {%.6g} [.s fraction 4 179]
} {1}
test scrollbar-3.37 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics} {
    format {%.6g} [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s]]]
} {1}
test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} unix {
test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} x11 {
    format {%.6g} [.s fraction 4 178]
} {0.993711}
test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {testmetrics win} {
    expr \
    [format {%.6g} [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s] - 2]]] \
	== [format %g [expr (200.0 - [testmetrics cyvscroll .s]*2 - 2) \
			   / ($height - 1 - [testmetrics cyvscroll .s]*2)]]
} 1

toplevel .t -width 250 -height 100
wm geom .t +0+0
scrollbar .t.s -orient horizontal -borderwidth 2
place .t.s -width 201
update

test scrollbar-3.41 {ScrollbarWidgetCmd procedure, "fraction" option} {
    format {%.6g} [.t.s fraction 100 0]
} {0.5}
if {[testConstraint testmetrics]} {
    # Only Windows has [testmetrics]
    place configure .t.s -width [expr 2*[testmetrics cxhscroll .t.s]+1]
} else {
    if {[tk windowingsystem] eq "x11"} {
    place configure .t.s -width [expr [winfo height .t.s] - 2*([.t.s cget -highlightthickness] + [.t.s cget -bd] + 1)]
        place configure .t.s -width [expr [winfo height .t.s] - 2*([.t.s cget -highlightthickness] + [.t.s cget -bd] + 1)]
    } else {
        # macOS aqua
        place configure .t.s -width [expr 2*([.t.s cget -highlightthickness] + [.t.s cget -bd])]
    }
}
update
test scrollbar-3.42 {ScrollbarWidgetCmd procedure, "fraction" option} {
    format {%.6g} [.t.s fraction 100 0]
} {0}
destroy .t
test scrollbar-3.43 {ScrollbarWidgetCmd procedure, "get" option} {
︙
314
315
316
317
318
319
320
321

322
323




324
325
326
327
328
329
330
331
332
333
334

335
336




337
338
339
340
341
342
343

334
335
336
337
338
339
340

341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357

358
359
360
361
362
363
364
365
366
367
368
369
370
371








-
+


+
+
+
+










-
+


+
+
+
+








} {1 {wrong # args: should be ".s identify x y"}}
test scrollbar-3.48 {ScrollbarWidgetCmd procedure, "identify" option} {
    list [catch {.s identify bogus 2} msg] $msg
} {1 {expected integer but got "bogus"}}
test scrollbar-3.49 {ScrollbarWidgetCmd procedure, "identify" option} {
    list [catch {.s identify -1 bogus} msg] $msg
} {1 {expected integer but got "bogus"}}
test scrollbar-3.50 {ScrollbarWidgetCmd procedure, "identify" option} {
test scrollbar-3.50.1 {ScrollbarWidgetCmd procedure, "identify" option} notAqua {
    .s identify 5 5
} {arrow1}
test scrollbar-3.50.2 {ScrollbarWidgetCmd procedure, "identify" option} aqua {
    # macOS scrollbars have no arrows nowadays
    .s identify 5 5
} {trough1}
test scrollbar-3.51 {ScrollbarWidgetCmd procedure, "identify" option} {
    .s identify 5 35
} {trough1}
test scrollbar-3.52 {ScrollbarWidgetCmd procedure, "identify" option} {
    .s set .3 .6
    .s identify 5 80
} {slider}
test scrollbar-3.53 {ScrollbarWidgetCmd procedure, "identify" option} {
    .s identify 5 145
} {trough2}
test scrollbar-3.54 {ScrollbarWidgetCmd procedure, "identify" option} {unixOrPc} {
test scrollbar-3.54.1 {ScrollbarWidgetCmd procedure, "identify" option} notAqua {
    .s identify 5 195
} {arrow2}
test scrollbar-3.54.2 {ScrollbarWidgetCmd procedure, "identify" option} aqua {
    # macOS scrollbars have no arrows nowadays
    .s identify 5 195
} {trough2}
test scrollbar-3.56 {ScrollbarWidgetCmd procedure, "identify" option} unix {
    .s identify 0 0
} {}
test scrollbar-3.57 {ScrollbarWidgetCmd procedure, "set" option} {
    list [catch {.s set abc def} msg] $msg
} {1 {expected floating-point number but got "abc"}}
test scrollbar-3.58 {ScrollbarWidgetCmd procedure, "set" option} {
︙
452
453
454
455
456
457
458
459

460
461
462





463
464




465
466
467
468
469
470
471

480
481
482
483
484
485
486

487
488
489

490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507








-
+


-
+
+
+
+
+


+
+
+
+








} {}
test scrollbar-6.9 {ScrollbarPosition procedure} {
    .s identify -1 [expr [winfo height .s] / 2]
} {}
test scrollbar-6.10 {ScrollbarPosition procedure} {
    .s identify [winfo width .s] [expr [winfo height .s] / 2]
} {}
test scrollbar-6.11 {ScrollbarPosition procedure} unix {
test scrollbar-6.11.1 {ScrollbarPosition procedure} x11 {
    .s identify 8 4
} {arrow1}
test scrollbar-6.12 {ScrollbarPosition procedure} unix {
test scrollbar-6.11.2 {ScrollbarPosition procedure} aqua {
    # macOS scrollbars have no arrows nowadays
    .s identify 8 4
} {trough1}
test scrollbar-6.12.1 {ScrollbarPosition procedure} x11 {
    .s identify 8 19
} {arrow1}
test scrollbar-6.12.2 {ScrollbarPosition procedure} aqua {
    # macOS scrollbars have no arrows nowadays
    .s identify 8 19
} {trough1}
test scrollbar-6.14 {ScrollbarPosition procedure} win {
    .s identify [expr [winfo width .s] / 2] 0 
} {arrow1}
test scrollbar-6.15 {ScrollbarPosition procedure} {testmetrics win} {
    .s identify [expr [winfo width .s] / 2] [expr [testmetrics cyvscroll .s] - 1]
} {arrow1}
test scrollbar-6.16 {ScrollbarPosition procedure} unix {
︙
513
514
515
516
517
518
519
520

521
522




523

524
525




526
527
528
529
530
531
532

549
550
551
552
553
554
555

556
557
558
559
560
561
562

563
564
565
566
567
568
569
570
571
572
573
574
575
576








-
+


+
+
+
+
-
+


+
+
+
+








    .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \
						 + [testmetrics cyvscroll .s]]
} {trough2}
test scrollbar-6.28 {ScrollbarPosition procedure} {testmetrics win} {
    .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \
						 - [testmetrics cyvscroll .s] - 1]
} {trough2}
test scrollbar-6.29 {ScrollbarPosition procedure} unix {
test scrollbar-6.29.1 {ScrollbarPosition procedure} x11 {
    .s identify 8 180
} {arrow2}
test scrollbar-6.29.2 {ScrollbarPosition procedure} aqua {
    # macOS scrollbars have no arrows nowadays
    .s identify 8 180
} {trough2}
test scrollbar-6.30 {ScrollbarPosition procedure} unix {
test scrollbar-6.30.1 {ScrollbarPosition procedure} x11 {
    .s identify 8 195
} {arrow2}
test scrollbar-6.30.2 {ScrollbarPosition procedure} aqua {
    # macOS scrollbars have no arrows nowadays
    .s identify 8 195
} {trough2}
test scrollbar-6.32 {ScrollbarPosition procedure} {testmetrics win} {
    .s identify [expr [winfo width .s] / 2]  [expr [winfo height .s] \
						  - [testmetrics cyvscroll .s]]
} {arrow2}
test scrollbar-6.33 {ScrollbarPosition procedure} win {
    .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] - 1]
} {arrow2}
︙
547
548
549
550
551
552
553
554

555
556




557
558
559
560

561
562




563
564
565
566
567
568
569

591
592
593
594
595
596
597

598
599
600
601
602
603
604
605
606
607

608
609
610
611
612
613
614
615
616
617
618
619
620
621








-
+


+
+
+
+



-
+


+
+
+
+








toplevel .t -width 250 -height 150
wm geometry .t +0+0
scrollbar .t.s -orient horizontal -relief sunken -bd 2 -highlightthickness 2
place .t.s -width 200
.t.s set .2 .4
update

test scrollbar-6.39 {ScrollbarPosition procedure} unix {
test scrollbar-6.39.1 {ScrollbarPosition procedure} x11 {
    .t.s identify 4 8
} {arrow1}
test scrollbar-6.39.2 {ScrollbarPosition procedure} aqua {
    # macOS scrollbars have no arrows nowadays
    .t.s identify 4 8
} {trough1}
test scrollbar-6.40 {ScrollbarPosition procedure} win {
    .t.s identify 0 [expr [winfo height .t.s] / 2]
} {arrow1}
test scrollbar-6.41 {ScrollbarPosition procedure} unix {
test scrollbar-6.41.1 {ScrollbarPosition procedure} x11 {
    .t.s identify 82 8
} {slider}
test scrollbar-6.41.2 {ScrollbarPosition procedure} aqua {
    # macOS scrollbars have no arrows nowadays
    .t.s identify 82 8
} {trough2}
test scrollbar-6.43 {ScrollbarPosition procedure} {testmetrics win} {
    .t.s identify [expr int(.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll .t.s] \
		       - 1] [expr [winfo height .t.s] / 2] 
} {slider}
test scrollbar-6.44 {ScrollbarPosition procedure} unix {
    .t.s identify 100 18
} {trough2}
︙
579
580
581
582
583
584
585
586



587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605



606
607
608
609
610
611
612

631
632
633
634
635
636
637

638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658

659
660
661
662
663
664
665
666
667
668








-
+
+
+


















-
+
+
+








    update
    lappend result [.s cget -orient]
} {horizontal vertical}

catch {destroy .t}
toplevel .t
wm geometry .t +0+0
test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} {
test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} notAqua {
    # constrained by notAqua because this test clicks on an arrow of the
    # scrollbar - but macOS has no such arrows in modern scrollbars
    proc doit {args} { destroy .t.f }
    proc bgerror {args} {}
    destroy .t.f
    frame .t.f
    scrollbar .t.f.s -command doit
    pack .t.f -fill both -expand 1
    pack .t.f.s -fill y -expand 1 -side right
    wm geometry .t 100x100
    .t.f.s set 0 .5
    update
    set result [winfo exists .t.f.s]
    event generate .t.f.s <ButtonPress> -button 1 -x [expr [winfo width .t.f.s] / 2] -y 5
    event generate .t <ButtonRelease> -button 1
    update
    lappend result [winfo exists .t.f.s] [winfo exists .t.f]
    rename bgerror {}
    set result
} {1 0 0}
test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} {
test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} notAqua {
    # constrained by notAqua because this test clicks on an arrow of the
    # scrollbar - but macOS has no such arrows in modern scrollbars
    proc doit {args} { destroy .t.f.s }
    proc bgerror {args} {}
    destroy .t.f
    frame .t.f
    scrollbar .t.f.s -command doit
    pack .t.f -fill both -expand 1
    pack .t.f.s -fill y -expand 1 -side right
︙
This page was generated in about 0.022s by Fossil 2.27 [a6d506ecc4] 2025-07-09 13:52:53