]> git.imager.perl.org - imager.git/blobdiff - lib/Imager/Test.pm
update FT2 Changes
[imager.git] / lib / Imager / Test.pm
index 0793d91332a37d0e3b07b41fd240193c1c48ce8a..1c3837af19e80c8111270670bc32d135951775df 100644 (file)
@@ -7,7 +7,7 @@ use vars qw(@ISA @EXPORT_OK $VERSION);
 use Carp qw(croak carp);
 use Config;
 
-$VERSION = "1.001";
+$VERSION = "1.003";
 
 @ISA = qw(Exporter);
 @EXPORT_OK = 
@@ -572,14 +572,22 @@ sub image_bounds_checks {
   my $black = Imager::Color->new(0, 0, 0);
   require Imager::Color::Float;
   my $blackf = Imager::Color::Float->new(0, 0, 0);
-  $builder->ok(!$im->setpixel(x => -1, y => 0, color => $black), 'bounds check set (-1, 0)');
-  $builder->ok(!$im->setpixel(x => 10, y => 0, color => $black), 'bounds check set (10, 0)');
-  $builder->ok(!$im->setpixel(x => 0, y => -1, color => $black), 'bounds check set (0, -1)');
-  $builder->ok(!$im->setpixel(x => 0, y => 10, color => $black), 'bounds check set (0, 10)');
-  $builder->ok(!$im->setpixel(x => -1, y => 0, color => $blackf), 'bounds check set (-1, 0) float');
-  $builder->ok(!$im->setpixel(x => 10, y => 0, color => $blackf), 'bounds check set (10, 0) float');
-  $builder->ok(!$im->setpixel(x => 0, y => -1, color => $blackf), 'bounds check set (0, -1) float');
-  $builder->ok(!$im->setpixel(x => 0, y => 10, color => $blackf), 'bounds check set (0, 10) float');
+  $builder->ok($im->setpixel(x => -1, y => 0, color => $black) == 0,
+              'bounds check set (-1, 0)');
+  $builder->ok($im->setpixel(x => 10, y => 0, color => $black) == 0,
+              'bounds check set (10, 0)');
+  $builder->ok($im->setpixel(x => 0, y => -1, color => $black) == 0,
+              'bounds check set (0, -1)');
+  $builder->ok($im->setpixel(x => 0, y => 10, color => $black) == 0,
+              'bounds check set (0, 10)');
+  $builder->ok($im->setpixel(x => -1, y => 0, color => $blackf) == 0,
+              'bounds check set (-1, 0) float');
+  $builder->ok($im->setpixel(x => 10, y => 0, color => $blackf) == 0,
+              'bounds check set (10, 0) float');
+  $builder->ok($im->setpixel(x => 0, y => -1, color => $blackf) == 0,
+              'bounds check set (0, -1) float');
+  $builder->ok($im->setpixel(x => 0, y => 10, color => $blackf) == 0,
+              'bounds check set (0, 10) float');
 }
 
 sub test_colorf_gpix {
@@ -753,8 +761,10 @@ sub std_font_tests {
  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
+    skip("no native UTF8 support in this version of perl", 11
       unless $] >= 5.006;
+    skip("overloading handling of magic is broken in this version of perl", 11)
+      unless $] >= 5.008;
     Imager->log("utf8 magic tests\n");
     my $over = bless {}, "Imager::Test::OverUtf8";
     my $text = "A".chr(0x2010)."A";
@@ -809,11 +819,16 @@ sub std_font_tests {
       $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");
+  SKIP:
+    {
+      Imager->log("magic: has_chars\n");
+      $font->can("has_chars")
+       or skip "No has_chars aupport", 2;
+      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);
@@ -852,16 +867,26 @@ sub std_font_tests {
     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:
+    {
+      $font->can_glyph_names
+       or skip "No glyph_names support", 2;
+      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");
+    }
+  SKIP:
+    {
+      $font->can("has_chars")
+       or skip "No has_chars support", 2;
+      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");
+    }
   }
 }