#!/usr/bin/perl -w # -*- perl -*- # Test case from https://rt.cpan.org/Ticket/Display.html?id=42043 # Fails if XFT=1 is activated. # Not in normal test suite, because result depends on fonts installed on system. use strict; use Getopt::Long; use Tk; use Tk::Config; use Tk::Font; BEGIN { if (!eval q{ use Test::More; 1; }) { print "1..0 # skip no Test::More module\n"; exit; } } my $Xft = $Tk::Config::xlib =~ /-lXft\b/; if (!$Xft) { plan skip_all => 'Hardcoded font values work only for XFT=1'; exit 0; } plan tests => 5; my $do_display; GetOptions("display" => \$do_display) or die "usage: $0 [-display]"; my $mw = MainWindow->new; { # The empty array does not work at all for XFT=0 my $label = $mw->Label(-text=>"small font, no bold",-font=>[])->pack; my %fa = $label->cget(-font)->actual; is_deeply(\%fa, { -weight => 'normal', -underline => 0, -family => 'Bitstream Vera Sans', -slant => 'roman', -size => -14, -overstrike => 0, }, 'Unchanged font size, normal weight'); } { my $label = $mw->Label(-text=>"small font, bold",-font=>[-weight=>'bold'])->pack; my %fa = $label->cget(-font)->actual; is_deeply(\%fa, { -weight => 'bold', -underline => 0, -family => 'Bitstream Vera Sans', -slant => 'roman', -size => -14, -overstrike => 0, }, 'Unchanged font size, bold'); } { my $label = $mw->Label(-text=>"32-point, bold",-font=>[-size=>'32', -weight=>'bold'])->pack; my %fa = $label->cget(-font)->actual; is_deeply(\%fa, { -weight => 'bold', -underline => 0, -family => 'Bitstream Vera Sans', -slant => 'roman', -size => -38, -overstrike => 0, }, '32 point size, bold'); } { my $label = $mw->Label(-text=>"32-point, bold, string spec",-font=>'{sans serif} 32 bold')->pack; my %fa = $label->cget(-font)->actual; is_deeply(\%fa, { -weight => 'bold', -underline => 0, -family => 'Bitstream Vera Sans', -slant => 'roman', -size => -38, -overstrike => 0, }, '32 point size, bold'); } { my $label = $mw->Label(-text=>"32-point, no bold",-font=>[-size=>'32'])->pack; my %fa = $label->cget(-font)->actual; is_deeply(\%fa, { -weight => 'normal', -underline => 0, -family => 'Bitstream Vera Sans', -slant => 'roman', -size => -38, -overstrike => 0, }, '32 point size, normal weight'); } if ($do_display) { my $button = $mw->Button(-text => "Quit", -command => sub { exit }) ->pack(); MainLoop; } __END__