From: Tony Cook <tony@develop-help.com>
Date: Sat, 23 Feb 2013 03:26:55 +0000 (+1100)
Subject: pull some basic tests all fonts should pass into Imager::Test
X-Git-Tag: v0.94_01~13
X-Git-Url: http://git.imager.perl.org/imager.git/commitdiff_plain/76ae98a683ec17cc95c7e70f59bff5ff6c26f528

pull some basic tests all fonts should pass into Imager::Test

and make sure T1 passes them
---

diff --git a/MANIFEST b/MANIFEST
index de6a5ab0..14a74e1b 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -387,6 +387,7 @@ T1/README
 T1/t/t10type1.t
 T1/t/t20oo.t
 T1/t/t30thread.t
+T1/t/t90std.t			Standard font tests for T1
 T1/T1.pm
 T1/T1.xs
 T1/typemap
diff --git a/T1/MANIFEST b/T1/MANIFEST
index 88f3ac83..703dc6b8 100644
--- a/T1/MANIFEST
+++ b/T1/MANIFEST
@@ -14,5 +14,6 @@ MANIFEST.SKIP
 README
 t/t10type1.t
 t/t20oo.t
+t/t90std.t
 T1.pm
 T1.xs
diff --git a/T1/T1.pm b/T1/T1.pm
index 2f7b3bd9..60322658 100644
--- a/T1/T1.pm
+++ b/T1/T1.pm
@@ -157,6 +157,10 @@ sub utf8 {
   1;
 }
 
+sub can_glyph_names {
+  1;
+}
+
 sub face_name {
   my ($self) = @_;
 
diff --git a/T1/T1.xs b/T1/T1.xs
index 54bdfaa8..c38c516a 100644
--- a/T1/T1.xs
+++ b/T1/T1.xs
@@ -195,7 +195,7 @@ i_t1_glyph_names(font, text_sv, utf8 = 0)
             ch = *text++;
             --len;
           }
-          EXTEND(SP, 1);
+          EXTEND(SP, count);
           if (i_t1_glyph_name(font, ch, name, sizeof(name))) {
             ST(count) = sv_2mortal(newSVpv(name, 0));
           }
diff --git a/T1/t/t10type1.t b/T1/t/t10type1.t
index bb0843d2..9dc29e1c 100644
--- a/T1/t/t10type1.t
+++ b/T1/t/t10type1.t
@@ -8,7 +8,7 @@ use Cwd qw(getcwd abs_path);
 
 #$Imager::DEBUG=1;
 
-plan tests => 132;
+plan tests => 110;
 
 ok($Imager::formats{t1}, "must have t1");
 
@@ -118,7 +118,7 @@ SKIP:
     ok(abs($utf8box[2] - $base[2]) <= $maxdiff, 
       "compare box sizes native $utf8box[2] vs $base[2] (maxerror $maxdiff)");
     eval q{$text = "A\xA1\xA2\x01\x1F\x{0100}A"};
-    ok($fnum->text($backgr, 10, 220, $bgcolor, 32, $text, 0, 1, 0, "uso"),
+    ok($fnum->text($backgr, 10, 220, $bgcolor, 32, $text, 0, 1, "uso"),
        "more complex output");
   }
 
@@ -226,35 +226,6 @@ SKIP:
            "display smaller than advance");
   }
 
-  { # invalid UTF8 handling at the OO level
-    my $im = Imager->new(xsize => 80, ysize => 20);
-    my $bad_utf8 = pack("C", 0xC0);
-    Imager->_set_error("");
-    ok(!$im->string(font => $font, size => 1, text => $bad_utf8, utf8 => 1,
-		    y => 18, x => 2),
-       "drawing invalid utf8 should fail");
-    is($im->errstr, "invalid UTF8 character", "check error message");
-    Imager->_set_error("");
-    ok(!$im->string(font => $font, size => 1, text => $bad_utf8, utf8 => 1,
-		    y => 18, x => 2, channel => 1),
-       "drawing invalid utf8 should fail (channel)");
-    is($im->errstr, "invalid UTF8 character", "check error message");
-    Imager->_set_error("");
-    ok(!$font->bounding_box(string => $bad_utf8, size => 30, utf8 => 1),
-       "bounding_box() bad utf8 should fail");
-    is(Imager->errstr, "invalid UTF8 character", "check error message");
-    Imager->_set_error("");
-    is_deeply([ $font->glyph_names(string => $bad_utf8, utf8 => 1) ],
-	      [ ],
-	      "glyph_names returns empty list for bad string");
-    is(Imager->errstr, "invalid UTF8 character", "check error message");
-    Imager->_set_error("");
-    is_deeply([ $font->has_chars(string => $bad_utf8, utf8 => 1) ],
-	      [ ],
-	      "has_chars returns empty list for bad string");
-    is(Imager->errstr, "invalid UTF8 character", "check error message");
-  }
-
  SKIP:
   { print "# alignment tests\n";
     my $font = Imager::Font->new(file=>$deffont, type=>'t1');
@@ -432,92 +403,8 @@ SKIP:
     is($im->errstr, "i_t1_text(): T1_AASetString failed: Invalid Argument in Function Call",
        "check error message");
   }
-
- SKIP:
-  { # check magic is handled correctly
-    # https://rt.cpan.org/Ticket/Display.html?id=83438
-    skip("no native UTF8 support in this version of perl", 10) 
-      unless $] >= 5.006;
-    my $font = Imager::Font->new(file=>$deffont, type=>'t1');
-    ok($font, "loaded deffont OO")
-      or skip("could not load font:".Imager->errstr, 4);
-    Imager->log("utf8 magic tests\n");
-    my $over = bless {}, "OverUtf8";
-    my $text = chr(0x2010)."A";
-    my $white = Imager::Color->new("#FFF");
-    my $base_draw = Imager->new(xsize => 80, ysize => 20);
-    ok($base_draw->string(font => $font,
-			  text => $text,
-			  x => 2,
-			  y => 18,
-			  size => 15,
-			  color => $white,
-			  aa => 1),
-       "magic: make a base image");
-    my $test_draw = Imager->new(xsize => 80, ysize => 20);
-    ok($test_draw->string(font => $font,
-			  text => $over,
-			  x => 2,
-			  y => 18,
-			  size => 15,
-			  color => $white,
-			  aa => 1),
-       "magic: draw with overload");
-    is_image($base_draw, $test_draw, "check they match");
-    $test_draw->write(file => "testout/utf8tdr.ppm");
-    $base_draw->write(file => "testout/utf8bdr.ppm");
-
-    my $base_cp = Imager->new(xsize => 80, ysize => 20);
-    $base_cp->box(filled => 1, color => "#808080");
-    my $test_cp = $base_cp->copy;
-    ok($base_cp->string(font => $font,
-			text => $text,
-			y => 2,
-			y => 18,
-			size => 16,
-			channel => 2,
-			aa => 1),
-       "magic: make a base image (channel)");
-    Imager->log("magic: draw to channel with overload\n");
-    ok($test_cp->string(font => $font,
-			text => $over,
-			y => 2,
-			y => 18,
-			size => 16,
-			channel => 2,
-			aa => 1),
-       "magic: draw with overload (channel)");
-    is_image($test_cp, $base_cp, "check they match");
-    #$test_cp->write(file => "testout/utf8tcp.ppm");
-    #$base_cp->write(file => "testout/utf8bcp.ppm");
-
-    Imager->log("magic: has_chars");
-    is_deeply([ $font->has_chars(string => $text) ], [ '', 1 ],
-	      "magic: has_chars with normal utf8 text");
-    is_deeply([ $font->has_chars(string => $over) ], [ '', 1 ],
-	      "magic: has_chars with magic utf8 text");
-
-    Imager->log("magic: bounding_box\n");
-    my @base_bb = $font->bounding_box(string => $text, size => 30);
-    is_deeply([ $font->bounding_box(string => $over, size => 30) ],
-	      \@base_bb,
-	      "check bounding box magic");
-
-  SKIP:
-    {
-      Imager->log("magic: glyph_names\n");
-      is_deeply([ $font->glyph_names(string => $text, reliable_only => 0) ],
-		[ undef, "A" ],
-		"magic: glyph_names with normal utf8 text");
-      is_deeply([ $font->glyph_names(string => $over, reliable_only => 0) ],
-		[ undef, "A" ],
-		"magic: glyph_names with magic utf8 text");
-    }
-  }
 }
 
 
 #malloc_state();
 
-package OverUtf8;
-use overload '""' => sub { chr(0x2010)."A" };
diff --git a/T1/t/t90std.t b/T1/t/t90std.t
new file mode 100644
index 00000000..a10fb141
--- /dev/null
+++ b/T1/t/t90std.t
@@ -0,0 +1,16 @@
+#!perl -w
+use strict;
+use Imager::Test qw(std_font_tests std_font_test_count);
+use Imager::Font;
+use Test::More tests => std_font_test_count();
+
+my $font = Imager::Font->new(file => "fontfiles/dcr10.pfb",
+			     type => "t1");
+
+SKIP:
+{
+  $font
+    or skip "Cannot load font", std_font_test_count();
+  std_font_tests({ font => $font,
+		   has_chars => [ 1, '', 1 ]});
+}
diff --git a/lib/Imager/Test.pm b/lib/Imager/Test.pm
index 88bcd838..0793d913 100644
--- a/lib/Imager/Test.pm
+++ b/lib/Imager/Test.pm
@@ -1,12 +1,13 @@
 package Imager::Test;
 use strict;
+use Test::More;
 use Test::Builder;
 require Exporter;
 use vars qw(@ISA @EXPORT_OK $VERSION);
-use Carp qw(croak);
+use Carp qw(croak carp);
 use Config;
 
-$VERSION = "1.000";
+$VERSION = "1.001";
 
 @ISA = qw(Exporter);
 @EXPORT_OK = 
@@ -38,6 +39,8 @@ $VERSION = "1.000";
      test_color_gpix
      test_colorf_glin
      can_test_threads
+     std_font_tests
+     std_font_test_count
      );
 
 sub diff_text_with_nul {
@@ -731,6 +734,141 @@ sub mask_tests {
 
 }
 
+sub std_font_test_count {
+  return 21;
+}
+
+sub std_font_tests {
+  my ($opts) = @_;
+
+  my $font = $opts->{font}
+    or carp "Missing font parameter";
+
+  my $name_font = $opts->{glyph_name_font} || $font;
+
+  my $has_chars = $opts->{has_chars} || [ 1, '', 1 ];
+
+  my $glyph_names = $opts->{glyph_names} || [ "A", undef, "A" ];
+
+ SKIP:
+  { # check magic is handled correctly
+    # https://rt.cpan.org/Ticket/Display.html?id=83438
+    skip("no native UTF8 support in this version of perl", 10) 
+      unless $] >= 5.006;
+    Imager->log("utf8 magic tests\n");
+    my $over = bless {}, "Imager::Test::OverUtf8";
+    my $text = "A".chr(0x2010)."A";
+    my $white = Imager::Color->new("#FFF");
+    my $base_draw = Imager->new(xsize => 80, ysize => 20);
+    ok($base_draw->string(font => $font,
+			  text => $text,
+			  x => 2,
+			  y => 18,
+			  size => 15,
+			  color => $white,
+			  aa => 1),
+       "magic: make a base image");
+    my $test_draw = Imager->new(xsize => 80, ysize => 20);
+    ok($test_draw->string(font => $font,
+			  text => $over,
+			  x => 2,
+			  y => 18,
+			  size => 15,
+			  color => $white,
+			  aa => 1),
+       "magic: draw with overload");
+    is_image($base_draw, $test_draw, "check they match");
+    if ($opts->{files}) {
+      $test_draw->write(file => "testout/utf8tdr.ppm");
+      $base_draw->write(file => "testout/utf8bdr.ppm");
+    }
+
+    my $base_cp = Imager->new(xsize => 80, ysize => 20);
+    $base_cp->box(filled => 1, color => "#808080");
+    my $test_cp = $base_cp->copy;
+    ok($base_cp->string(font => $font,
+			text => $text,
+			y => 2,
+			y => 18,
+			size => 16,
+			channel => 2,
+			aa => 1),
+       "magic: make a base image (channel)");
+    Imager->log("magic: draw to channel with overload\n");
+    ok($test_cp->string(font => $font,
+			text => $over,
+			y => 2,
+			y => 18,
+			size => 16,
+			channel => 2,
+			aa => 1),
+       "magic: draw with overload (channel)");
+    is_image($test_cp, $base_cp, "check they match");
+    if ($opts->{files}) {
+      $test_cp->write(file => "testout/utf8tcp.ppm");
+      $base_cp->write(file => "testout/utf8bcp.ppm");
+    }
+
+    Imager->log("magic: has_chars");
+    is_deeply([ $font->has_chars(string => $text) ], $has_chars,
+	      "magic: has_chars with normal utf8 text");
+    is_deeply([ $font->has_chars(string => $over) ], $has_chars,
+	      "magic: has_chars with magic utf8 text");
+
+    Imager->log("magic: bounding_box\n");
+    my @base_bb = $font->bounding_box(string => $text, size => 30);
+    is_deeply([ $font->bounding_box(string => $over, size => 30) ],
+	      \@base_bb,
+	      "check bounding box magic");
+
+  SKIP:
+    {
+      $font->can_glyph_names
+	or skip "No glyph_names", 2;
+      Imager->log("magic: glyph_names\n");
+      my @text_names = $name_font->glyph_names(string => $text, reliable_only => 0);
+      is_deeply(\@text_names, $glyph_names,
+		"magic: glyph_names with normal utf8 text");
+      my @over_names = $name_font->glyph_names(string => $over, reliable_only => 0);
+      is_deeply(\@over_names, $glyph_names,
+		"magic: glyph_names with magic utf8 text");
+    }
+  }
+
+  { # invalid UTF8 handling at the OO level
+    my $im = Imager->new(xsize => 80, ysize => 20);
+    my $bad_utf8 = pack("C", 0xC0);
+    Imager->_set_error("");
+    ok(!$im->string(font => $font, size => 1, text => $bad_utf8, utf8 => 1,
+		    y => 18, x => 2),
+       "drawing invalid utf8 should fail");
+    is($im->errstr, "invalid UTF8 character", "check error message");
+    Imager->_set_error("");
+    ok(!$im->string(font => $font, size => 1, text => $bad_utf8, utf8 => 1,
+		    y => 18, x => 2, channel => 1),
+       "drawing invalid utf8 should fail (channel)");
+    is($im->errstr, "invalid UTF8 character", "check error message");
+    Imager->_set_error("");
+    ok(!$font->bounding_box(string => $bad_utf8, size => 30, utf8 => 1),
+       "bounding_box() bad utf8 should fail");
+    is(Imager->errstr, "invalid UTF8 character", "check error message");
+    Imager->_set_error("");
+    is_deeply([ $font->glyph_names(string => $bad_utf8, utf8 => 1) ],
+	      [ ],
+	      "glyph_names returns empty list for bad string");
+    is(Imager->errstr, "invalid UTF8 character", "check error message");
+    Imager->_set_error("");
+    is_deeply([ $font->has_chars(string => $bad_utf8, utf8 => 1) ],
+	      [ ],
+	      "has_chars returns empty list for bad string");
+    is(Imager->errstr, "invalid UTF8 character", "check error message");
+  }
+}
+
+package Imager::Test::OverUtf8;
+use overload '""' => sub { "A".chr(0x2010)."A" };
+
+
 1;
 
 __END__
@@ -877,6 +1015,14 @@ color or channel parameter.
 
 This was explicitly created for regression tests on #21770.
 
+=item std_font_tests({ font => $font })
+
+Perform standard font interface tests.
+
+=item std_font_test_count()
+
+The number of tests performed by std_font_tests().
+
 =back
 
 =head2 Helper functions