[rt #71469] make default text color non-transparent

[imager.git] / t / t36oofont.t

diff --git a/t/t36oofont.t b/t/t36oofont.t
index cab30fe7b50a8357258fd13b774b5a81dd34e6ca..2982681531c56397ad7e7abcb3e4543e5775a8af 100644 (file)
--- a/t/t36oofont.t
+++ b/t/t36oofont.t
@@ -10,86 +10,39 @@ use strict;
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
+use Test::More tests => 16;
 
-my $loaded;
-BEGIN { $| = 1; print "1..20\n"; }
-END {print "not ok 1\n" unless $loaded;}
-use Imager;
-require "t/testtools.pl";
-$loaded=1;
-okx(1, "loaded");
+BEGIN { use_ok('Imager') };
 
-init_log("testout/t36oofont.log", 1);
+BEGIN {
+  require Imager::Test;
+  Imager::Test->import(qw(isnt_image));
+}
 
-my $fontname_tt=$ENV{'TTFONTTEST'}||'./fontfiles/dodge.ttf';
-my $fontname_pfb=$ENV{'T1FONTTESTPFB'}||'./fontfiles/dcr10.pfb';
+-d "testout" or mkdir "testout";
 
+Imager->open_log(log => "testout/t36oofont.log");
+
+my $fontname_tt=$ENV{'TTFONTTEST'}||'./fontfiles/dodge.ttf';
 
 my $green=Imager::Color->new(92,205,92,128);
 die $Imager::ERRSTR unless $green;
 my $red=Imager::Color->new(205, 92, 92, 255);
 die $Imager::ERRSTR unless $red;
 
-if (i_has_format("t1") and -f $fontname_pfb) {
-
-  my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
-
-  my $font=Imager::Font->new(file=>$fontname_pfb,size=>25)
-    or die $img->{ERRSTR};
-
-  okx(1, "created font");
-
-  okx($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
-      "draw text");
-  $img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
-
-  my $text="LLySja";
-  my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
-
-  okx(@bbox == 7, "bounding box list length");
-
-  $img->box(box=>\@bbox, color=>$green);
-
-  # "utf8" support
-  $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
-  okx($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1,
-                   overline=>1),
-      "draw 'utf8' hand-encoded text");
-
-  okx($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1, 
-                   underline=>1, channel=>2),
-      "channel 'utf8' hand-encoded text");
-
-  if($] >= 5.006) {
-    eval q{$text = "A\x{2010}A"};
-    okx($img->string(font=>$font, text=>$text, 'x'=>180, 'y'=>50,
-                    strikethrough=>1),
-       "draw native UTF8 text");
-    okx($img->string(font=>$font, text=>$text, 'x'=>220, 'y'=>50, channel=>1),
-       "channel native UTF8 text");
-  }
-  else {
-    skipx(2, "perl too old for native utf8");
-  }
-
-  okx($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'),
-      "write t36oofont1.ppm")
-    or print "# ",$img->errstr,"\n";
-
-} else {
-  skipx(8, "T1lib missing or disabled");
-}
-
-if (i_has_format("tt") and -f $fontname_tt) {
+SKIP:
+{
+  $Imager::formats{"tt"} && -f $fontname_tt
+    or skip("FT1.x missing or disabled", 14);
 
   my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
 
   my $font=Imager::Font->new(file=>$fontname_tt,size=>25)
     or die $img->{ERRSTR};
 
-  okx(1, "create TT font object");
+  ok(1, "create TT font object");
 
-  okx($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
+  ok($img->string(font=>$font, text=>"XMCLH", 'x'=>100, 'y'=>100),
       "draw text");
 
   $img->line(x1=>0, x2=>300, y1=>50, y2=>50, color=>$green);
@@ -97,36 +50,53 @@ if (i_has_format("tt") and -f $fontname_tt) {
   my $text="LLySja";
   my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
 
-  okx(@bbox == 7, "bbox list size");
+  is(@bbox, 8, "bbox list size");
 
   $img->box(box=>\@bbox, color=>$green);
 
   $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
-  okx($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1),
+  ok($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1),
       "draw hand-encoded UTF8 text");
 
-  if($] >= 5.006) {
+ SKIP:
+  {
+    $] >= 5.006
+      or skip("perl too old for native utf8", 1);
     eval q{$text = "A\x{2010}A"};
-    okx($img->string(font=>$font, text=>$text, 'x'=>200, 'y'=>50),
+    ok($img->string(font=>$font, text=>$text, 'x'=>200, 'y'=>50),
        "draw native UTF8 text");
   }
-  else {
-    skipx(1, "perl too old for native utf8");
-  }
 
-  okx($img->write(file=>"testout/t36oofont2.ppm", type=>'pnm'),
+  ok($img->write(file=>"testout/t36oofont2.ppm", type=>'pnm'),
       "write t36oofont2.ppm")
     or print "# ", $img->errstr,"\n";
 
-  okx($font->utf8, "make sure utf8 method returns true");
+  ok($font->utf8, "make sure utf8 method returns true");
 
   my $has_chars = $font->has_chars(string=>"\x01A");
-  okx($has_chars eq "\x00\x01", "has_chars scalar");
+  is($has_chars, "\x00\x01", "has_chars scalar");
   my @has_chars = $font->has_chars(string=>"\x01A");
-  okx(!$has_chars[0], "has_chars list 0");
-  okx($has_chars[1], "has_chars list 1");
-} else {
-  skipx(10, "FT1.x missing or disabled");
+  ok(!$has_chars[0], "has_chars list 0");
+  ok($has_chars[1], "has_chars list 1");
+
+  { # RT 71469
+    my $font1 = Imager::Font->new(file => $fontname_tt, type => "tt");
+    my $font2 = Imager::Font::Truetype->new(file => $fontname_tt);
+
+    for my $font ($font1, $font2) {
+      print "# ", join(",", $font->{color}->rgba), "\n";
+
+      my $im = Imager->new(xsize => 20, ysize => 20, channels => 4);
+
+      ok($im->string(text => "T", font => $font, y => 15),
+        "draw with default color")
+       or print "# ", $im->errstr, "\n";
+      my $work = Imager->new(xsize => 20, ysize => 20);
+      my $cmp = $work->copy;
+      $work->rubthrough(src => $im);
+      isnt_image($work, $cmp, "make sure something was drawn");
+    }
+  }
 }
 
-okx(1, "end");
+ok(1, "end");