t/t10pie.t

   1 #!perl -w
   2 use strict;
   3 use Imager::Graph::Pie;
   4 use lib 't/lib';
   5 use Imager::Font::Test;
   6 use Imager::Graph::Test qw(cmpimg);
   7 use Test::More;
   8
   9 -d 'testout'
  10   or mkdir "testout", 0700
  11   or die "Could not create output directory: $!";
  12
  13 ++$|;
  14
  15 use Imager qw(:handy);
  16
  17 #my $fontfile = 'ImUgly.ttf';
  18 #my $font = Imager::Font->new(file=>$fontfile, type => 'ft2', aa=>1)
  19 #  or plan skip_all => "Cannot create font object: ",Imager->errstr,"\n";
  20 my $font = Imager::Font::Test->new();
  21
  22 my @data = ( 100, 180, 80, 20, 2, 1, 0.5 );
  23 my @labels = qw(alpha beta gamma delta epsilon phi gi);
  24
  25 plan tests => 41;
  26
  27 my $pie = Imager::Graph::Pie->new;
  28 ok($pie, "creating pie chart object");
  29
  30 # this may change output quality too
  31
  32 print "# Imager version: $Imager::VERSION\n";
  33 print "# Font type: ",ref $font,"\n";
  34
  35 my $img1 = $pie->draw(data=>\@data, labels=>\@labels, font=>$font,
  36                       title=>{ text=>'Imager::Graph::Pie', size=>32 },
  37                       features=>{ outline=>1, labels=>1, pieblur=>0, },
  38                       outline=>{ line => '404040' },
  39                      );
  40
  41 ok($img1, "drawing first pie chart")
  42   or print "# ",$pie->error,"\n";
  43 cmpimg($img1, "testimg/t10_pie1.png", 196880977);
  44 $img1->write(file=>'testout/t10_pie1.ppm')
  45   or die "Cannot save pie1: ",$img1->errstr,"\n";
  46
  47 my $img2 = $pie->draw(data=>\@data,
  48                       labels=>\@labels,
  49                       font=>$font,
  50                       title=>{ text=>'Imager::Graph::Pie', size=>36 },
  51                       features=>{ labelspconly=>1, _debugblur=>1,
  52                                   legend=>1 },
  53                       legend=>{ border=>'000000', fill=>'C0C0C0', },
  54                       fills=>[ qw(404040 606060 808080 A0A0A0 C0C0C0 E0E0E0) ],
  55                      );
  56
  57 ok($img2, "drawing second pie chart")
  58   or print "# ",$pie->error,"\n";
  59 cmpimg($img2, "testimg/t10_pie2.png", 255956289);
  60 $img2->write(file=>'testout/t10_pie2.ppm')
  61   or die "Cannot save pie2: ",$img2->errstr,"\n";
  62
  63 my $img3 = $pie->draw(data=>\@data, labels=>\@labels,
  64                       font=>$font, style=>'fount_lin',
  65                       features=>[ 'legend', 'labelspconly', ],
  66                       legend=>{ valign=>'center' });
  67 ok($img3, "third chart")
  68   or print "# ",$pie->error,"\n";
  69 $img3->write(file=>'testout/t10_lin_fount.ppm')
  70   or die "Cannot save pie3: ",$img3->errstr,"\n";
  71 cmpimg($img3, "testimg/t10_lin_fount.png", 180_000);
  72
  73 my $img4 = $pie->draw(data=>\@data, labels=>\@labels,
  74                       font=>$font, style=>'fount_rad',
  75                       features=>[ 'legend', 'labelspc', ],
  76                       legend=>{ valign=>'bottom',
  77                                 halign=>'left',
  78                                 border=>'000080' });
  79 ok($img4, "fourth chart")
  80   or print "# ",$pie->error,"\n";
  81 $img4->write(file=>'testout/t10_rad_fount.ppm')
  82   or die "Cannot save pie3: ",$img4->errstr,"\n";
  83 cmpimg($img4, "testimg/t10_rad_fount.png", 120_000);
  84
  85 my $img5 = $pie->draw(data=>\@data, labels=>\@labels,
  86                       font=>$font, style=>'mono',
  87                       features=>[ 'allcallouts', 'labelspc' ],
  88                       legend=>{ valign=>'bottom',
  89                                 halign=>'right' });
  90 ok($img5, "fifth chart")
  91   or print "# ",$pie->error,"\n";
  92 $img5->write(file=>'testout/t10_mono.ppm')
  93   or die "Cannot save pie3: ",$img5->errstr,"\n";
  94 cmpimg($img5, "testimg/t10_mono.png", 550_000);
  95
  96 my $img6 = $pie->draw(data=>\@data, labels=>\@labels,
  97                       font=>$font, style=>'fount_lin',
  98                       features=>[ 'allcallouts', 'labelspc', 'legend' ],
  99                       legend=>
 100                       {
 101                        valign=>'top',
 102                        halign=>'center',
 103                        orientation => 'horizontal',
 104                        fill => { solid => Imager::Color->new(0, 0, 0, 32) },
 105                        patchborder => undef,
 106                        #size => 30,
 107                       });
 108 ok($img6, "sixth chart")
 109   or print "# ",$pie->error,"\n";
 110 $img6->write(file=>'testout/t10_hlegend.ppm')
 111   or die "Cannot save pie6: ",$img5->errstr,"\n";
 112 cmpimg($img6, "testimg/t10_hlegend.png", 550_000);
 113
 114 {
 115   # RT #34813
 116   # zero sized segments were drawn to cover the whole circle
 117   my @data = ( 10, 8, 5, 0.000 );
 118   my @labels = qw(alpha beta gamma);
 119   my @warned;
 120   local $SIG{__WARN__} =
 121     sub {
 122       print STDERR $_[0];
 123       push @warned, $_[0]
 124     };
 125
 126   my $img = $pie->draw
 127     (
 128      data => \@data,
 129      labels => \@labels,
 130      font => $font,
 131      features => [ 'legend', 'labelspc', 'outline' ],
 132     );
 133   ok($img, "create graph with no 'others'");
 134   ok($img->write(file => 'testout/t10_noother.ppm'),
 135      "save it");
 136   cmpimg($img, 'testimg/t10_noother.png', 500_000);
 137   unless (is(@warned, 0, "should be no warnings")) {
 138     diag($_) for @warned;
 139   }
 140 }
 141
 142 { # RT #535
 143   # no font parameter would crash
 144   my $im = $pie->draw
 145     (
 146      data => \@data,
 147      title => 'test',
 148     );
 149   ok(!$im, "should fail to produce titled graph with no font");
 150   like($pie->error, qr/title\.font/, "message should mention which font");
 151
 152   $im = $pie->draw
 153     (
 154      labels => \@labels,
 155      data => \@data,
 156      features => [ 'legend' ],
 157     );
 158   ok(!$im, "should fail to produce legended graph with no font");
 159   like($pie->error, qr/legend\.font/, "message should mention which font");
 160
 161   $im = $pie->draw
 162     (
 163      data => \@data,
 164      labels => \@labels,
 165      features => [ 'legend' ],
 166      legend => { orientation => "horizontal" },
 167     );
 168   ok(!$im, "should fail to produce horizontal legended graph with no font");
 169   like($pie->error, qr/legend\.font/, "message should mention which font");
 170
 171   $im = $pie->draw
 172     (
 173      data => \@data,
 174      labels => \@labels,
 175     );
 176   ok(!$im, "should fail to produce labelled graph with no font");
 177   like($pie->error, qr/label\.font/, "message should mention which font");
 178
 179   $im = $pie->draw
 180     (
 181      data => \@data,
 182      labels => \@labels,
 183      features => [ 'allcallouts' ],
 184      label => { font => $font },
 185     );
 186   ok(!$im, "should fail to produce callout labelled graph with no font");
 187   like($pie->error, qr/callout\.font/, "message should mention which font");
 188
 189   # shouldn't need to set label font if doing all callouts
 190   $im = $pie->draw
 191     (
 192      data => \@data,
 193      labels => \@labels,
 194      features => [ 'allcallouts' ],
 195      callout => { font => $font },
 196     );
 197   ok($im, "should produce callout labelled graph with only callout font")
 198     or print "# ", $pie->error, "\n";
 199
 200   # shouldn't need to set callout font if doing all labels
 201   $im = $pie->draw
 202     (
 203      data => [ 1, 1, 1 ],
 204      labels => [ qw/a b c/ ],
 205      label => { font => $font }
 206     );
 207   ok($im, "should produce label only graph with only label font");
 208 }
 209
 210 {
 211   # draw with an empty data array is bad
 212   # problem reported and fixed by Patrick Michaud
 213   my $im = $pie->draw(data => []);
 214   ok(!$im, "fail to draw with empty data");
 215   like($pie->error, qr/No values/, "message appropriate");
 216 }
 217
 218 { # pie charts can't represent negative values
 219   # problem reported and fixed by Patrick Michaud
 220   my $im = $pie->draw(data => [ 10, -1, 10 ]);
 221   ok(!$im, "fail to draw with negative value");
 222   is($pie->error, "Data index 1 is less than zero", "check message");
 223 }
 224
 225 { # pie can't represent all zeros
 226   # problem reported and fixed by Patrick Michaud
 227   my $im = $pie->draw(data => [ 0, 0, 0 ]);
 228   ok(!$im, "fail to draw with all zero values");
 229   is($pie->error, "Sum of all data values is zero", "check message");
 230 }
 231
 232 {
 233   # test methods used to set features
 234   # adds test coverage for otherwise uncovered methods
 235   my $pie = Imager::Graph::Pie->new;
 236   $pie->add_data_series(\@data);
 237   $pie->set_labels(\@labels);
 238   $pie->set_font($font);
 239   $pie->set_style("mono");
 240   $pie->show_callouts_onAll_segments();
 241   $pie->show_label_percentages();
 242   $pie->set_legend_horizontal_align("right");
 243   $pie->set_legend_vertical_align("bottom");
 244   my $im = $pie->draw();
 245
 246   ok($im, "made mono test using methods");
 247   cmpimg($im, "testimg/t10_mono.png", 550_00);
 248 }
 249
 250 {
 251   # more method coverage
 252   my $pie = Imager::Graph::Pie->new;
 253   $pie->add_data_series(\@data);
 254   $pie->set_labels(\@labels);
 255   $pie->set_font($font);
 256   $pie->set_style("fount_lin");
 257   $pie->show_legend();
 258   $pie->show_only_label_percentages();
 259   $pie->set_legend_vertical_align("center");
 260   my $im = $pie->draw();
 261
 262   ok($im, "made lin_found test using methods");
 263   cmpimg($im, "testimg/t10_lin_fount.png", 180_000);
 264 }
 265
 266 {
 267   my $pie = Imager::Graph::Pie->new;
 268   my $im = $pie->draw(width => -1, data => \@data);
 269   ok(!$im, "shouldn't be able to create neg width image");
 270   print "# ", $pie->error, "\n";
 271   cmp_ok($pie->error, '=~', qr/^Error creating image/, "check error message");
 272 }