X-Git-Url: http://git.imager.perl.org/imager.git/blobdiff_plain/a6d9b73704e6b26e5888b966aa53a46a865b82b8..d5fb1fdfe77529d2d55e62dc4024b51c3e44e60b:/t/t30t1font.t

diff --git a/t/t30t1font.t b/t/t30t1font.t
index 385128bc..da5b5863 100644
--- a/t/t30t1font.t
+++ b/t/t30t1font.t
@@ -7,37 +7,47 @@
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 use strict;
-use Test::More tests => 64;
-BEGIN { use_ok(Imager => ':all') }
+use Test::More;
+use Imager ':all';
+use Imager::Test qw(diff_text_with_nul is_color3);
+use Cwd qw(getcwd abs_path);
 
 #$Imager::DEBUG=1;
 
+i_has_format("t1")
+  or plan skip_all => "t1lib unavailble or disabled";
+
+plan tests => 95;
+
 init_log("testout/t30t1font.log",1);
 
-my $deffont = './fontfiles/dcr10.pfb';
+my $deffont = 'fontfiles/dcr10.pfb';
 
 my $fontname_pfb=$ENV{'T1FONTTESTPFB'}||$deffont;
 my $fontname_afm=$ENV{'T1FONTTESTAFM'}||'./fontfiles/dcr10.afm';
 
+-f $fontname_pfb
+  or skip_all("cannot find fontfile for type 1 test $fontname_pfb");
+-f $fontname_afm
+  or skip_all("cannot find fontfile for type 1 test $fontname_afm");
+
 SKIP:
 {
-  if (!(i_has_format("t1")) ) {
-    skip("t1lib unavailable or disabled", 63);
-  }
-  elsif (! -f $fontname_pfb) {
-    skip("cannot find fontfile for type 1 test $fontname_pfb", 63);
-  }
-  elsif (! -f $fontname_afm) {
-    skip("cannot find fontfile for type 1 test $fontname_afm", 63);
-  }
-
   print "# has t1\n";
 
-  i_t1_set_aa(1);
+  #i_t1_set_aa(1);
+
+  unlink "t1lib.log"; # lose it if it exists
+  init(t1log=>0);
+  ok(!-e("t1lib.log"), "disable t1log");
+  init(t1log=>1);
+  ok(-e("t1lib.log"), "enable t1log");
+  init(t1log=>0);
+  unlink "t1lib.log";
 
   my $fnum=Imager::i_t1_new($fontname_pfb,$fontname_afm); # this will load the pfb font
   unless (ok($fnum >= 0, "load font $fontname_pfb")) {
-    skip("without the font I can't do a thing", 48);
+    skip("without the font I can't do a thing", 90);
   }
 
   my $bgcolor=Imager::Color->new(255,0,0,0);
@@ -123,14 +133,6 @@ SKIP:
   print "# debug: ",join(" x ",i_t1_bbox(0,50,"eses",4) ),"\n";
   print "# debug: ",join(" x ",i_t1_bbox(0,50,"llll",4) ),"\n";
 
-  unlink "t1lib.log"; # lose it if it exists
-  init(t1log=>0);
-  ok(!-e("t1lib.log"), "disable t1log");
-  init(t1log=>1);
-  ok(-e("t1lib.log"), "enable t1log");
-  init(t1log=>0);
-  unlink "t1lib.log";
-
   # character existance tests - uses the special ExistenceTest font
   my $exists_font = 'fontfiles/ExistenceTest.pfb';
   my $exists_afm = 'fontfiles/ExistenceText.afm';
@@ -152,6 +154,7 @@ SKIP:
     is(length($exists), 2, "return scalar length");
     ok(ord(substr($exists, 0, 1)), "we have an exclamation mark");
     ok(!ord(substr($exists, 1, 1)), "we have no upper-case A");
+    i_t1_destroy($font_num);
   }
   
   my $font = Imager::Font->new(file=>$exists_font, type=>'t1');
@@ -178,9 +181,9 @@ SKIP:
     # names
     my $face_name = Imager::i_t1_face_name($font->{id});
     print "# face $face_name\n";
-    ok($face_name eq 'ExistenceTest', "face name");
+    is($face_name, 'ExistenceTest', "face name");
     $face_name = $font->face_name;
-    ok($face_name eq 'ExistenceTest', "face name");
+    is($face_name, 'ExistenceTest', "face name");
 
     my @glyph_names = $font->glyph_names(string=>"!J/");
     is($glyph_names[0], 'exclam', "check exclam name OO");
@@ -251,6 +254,124 @@ SKIP:
     }
     ok($im->write(file=>'testout/t30align.ppm'), "save align image");
   }
+
+ SKIP:
+  {
+    # see http://rt.cpan.org/Ticket/Display.html?id=20555
+    print "# bounding box around spaces\n";
+    # SpaceTest contains 3 characters, space, ! and .undef
+    # only characters that define character zero seem to illustrate
+    # the problem we had with spaces
+    my $space_fontfile = "fontfiles/SpaceTest.pfb";
+    my $font = Imager::Font->new(file => $space_fontfile, type => 't1');
+    ok($font, "loaded $deffont")
+      or skip("failed to load $deffont" . Imager->errstr, 13);
+    my $bbox = $font->bounding_box(string => "", size => 36);
+    print "# empty string bbox: @$bbox\n";
+    is($bbox->start_offset, 0, "empty string start_offset");
+    is($bbox->end_offset, 0, "empty string end_offset");
+    is($bbox->advance_width, 0, "empty string advance_width");
+    is($bbox->ascent, 0, "empty string ascent");
+    is($bbox->descent, 0, "empty string descent");
+
+    # a single space
+    my $bbox_space = $font->bounding_box(string => " ", size => 36);
+    print "# space bbox: @$bbox_space\n";
+    is($bbox_space->start_offset, 0, "single space start_offset");
+    is($bbox_space->end_offset, $bbox_space->advance_width, 
+       "single space end_offset");
+    cmp_ok($bbox_space->ascent, '>=', $bbox_space->descent,
+	   "single space ascent/descent");
+
+    my $bbox_bang = $font->bounding_box(string => "!", size => 36);
+    print "# '!' bbox: @$bbox_bang\n";
+
+    # space ! space
+    my $bbox_spbangsp = $font->bounding_box(string => " ! ", size => 36);
+    print "# ' ! ' bbox: @$bbox_spbangsp\n";
+    my $exp_advance = $bbox_bang->advance_width + 2 * $bbox_space->advance_width;
+    is($bbox_spbangsp->advance_width, $exp_advance, "sp ! sp advance_width");
+    is($bbox_spbangsp->start_offset, 0, "sp ! sp start_offset");
+    is($bbox_spbangsp->end_offset, $exp_advance, "sp ! sp end_offset");
+  }
+
+ SKIP:
+  { # http://rt.cpan.org/Ticket/Display.html?id=20554
+    # this is "A\xA1\x{2010}A"
+    # the t1 driver is meant to ignore any UTF8 characters over 0xff
+    print "# issue 20554\n";
+    my $text = pack("C*", 0x41, 0xC2, 0xA1, 0xE2, 0x80, 0x90, 0x41);
+    my $tran_text = "A\xA1A";
+    my $font = Imager::Font->new(file => 'fontfiles/dcr10.pfb', type => 't1');
+    $font
+      or skip("cannot load font fontfiles/fcr10.pfb:".Imager->errstr, 1);
+    my $bbox_utf8 = $font->bounding_box(string => $text, utf8 => 1, size => 36);
+    my $bbox_tran = $font->bounding_box(string => $tran_text, size => 36);
+    is($bbox_utf8->advance_width, $bbox_tran->advance_width,
+       "advance widths should match");
+  }
+  { # string output cut off at NUL ('\0')
+    # https://rt.cpan.org/Ticket/Display.html?id=21770 cont'd
+    my $font = Imager::Font->new(file => 'fontfiles/dcr10.pfb', type => 't1');
+    ok($font, "loaded dcr10.pfb");
+
+    diff_text_with_nul("a\\0b vs a", "a\0b", "a", 
+		       font => $font, color => '#FFFFFF');
+    diff_text_with_nul("a\\0b vs a", "a\0b", "a", 
+		       font => $font, channel => 1);
+
+    # UTF8 encoded \xBF
+    my $pound = pack("C*", 0xC2, 0xBF);
+    diff_text_with_nul("utf8 pound\0pound vs pound", "$pound\0$pound", $pound,
+		       font => $font, color => '#FFFFFF', utf8 => 1);
+    diff_text_with_nul("utf8 dash\0dash vs dash", "$pound\0$pound", $pound,
+		       font => $font, channel => 1, utf8 => 1);
+
+  }
+
+  { # RT 11972
+    # when rendering to a transparent image the coverage should be
+    # expressed in terms of the alpha channel rather than the color
+    my $font = Imager::Font->new(file=>'fontfiles/dcr10.pfb', type=>'t1');
+    my $im = Imager->new(xsize => 40, ysize => 20, channels => 4);
+    ok($im->string(string => "AB", size => 20, aa => 2, color => '#F00',
+		   x => 0, y => 15, font => $font),
+       "draw to transparent image");
+    my $im_noalpha = $im->convert(preset => 'noalpha');
+    my $im_pal = $im->to_paletted(make_colors => 'mediancut');
+    my @colors = $im_pal->getcolors;
+    is(@colors, 2, "should be only 2 colors");
+    @colors = sort { ($a->rgba)[0] <=> ($b->rgba)[0] } @colors;
+    is_color3($colors[0], 0, 0, 0, "check we got black");
+    is_color3($colors[1], 255, 0, 0, "and red");
+  }
+
+ SKIP:
+  { # RT 60509
+    # checks that a c:foo or c:\foo path is handled correctly on win32
+    my $type = "t1";
+    $^O eq "MSWin32" || $^O eq "cygwin"
+      or skip("only for win32", 2);
+    my $dir = getcwd
+      or skip("Cannot get cwd", 2);
+    if ($^O eq "cygwin") {
+      $dir = Cygwin::posix_to_win_path($dir);
+    }
+    my $abs_path = abs_path($deffont);
+    my $font = Imager::Font->new(file => $abs_path, type => $type);
+    ok($font, "found font by absolute path")
+      or print "# path $abs_path\n";
+    undef $font;
+
+    $^O eq "cygwin"
+      and skip("cygwin doesn't support drive relative DOSsish paths", 1);
+    my ($drive) = $dir =~ /^([a-z]:)/i
+      or skip("cwd has no drive letter", 2);
+    my $drive_path = $drive . $deffont;
+    $font = Imager::Font->new(file => $drive_path, type => $type);
+    ok($font, "found font by drive relative path")
+      or print "# path $drive_path\n";
+  }
 }
 
 #malloc_state();