use SvPV to get the length of text to draw rather than strlen(), add

tests for the functionality.

https://rt.cpan.org/Ticket/Display.html?id=21770

diff --git a/Imager.xs b/Imager.xs
index da7d9512d7227d51f191db70816cb2bfd7de6f8b..e80395bff28dd0444d8ddcca87f3ad604fc7d97e 100644 (file)
--- a/Imager.xs
+++ b/Imager.xs
@@ -4416,7 +4416,7 @@ i_ft2_text(font, im, tx, ty, cl, cheight, cwidth, text, align, aa, vlayout, utf8
         RETVAL
 
 undef_int
-i_ft2_cp(font, im, tx, ty, channel, cheight, cwidth, text, align, aa, vlayout, utf8)
+i_ft2_cp(font, im, tx, ty, channel, cheight, cwidth, text_sv, align, aa, vlayout, utf8)
         Imager::Font::FT2 font
         Imager::ImgRaw im
         int tx
@@ -4424,18 +4424,22 @@ i_ft2_cp(font, im, tx, ty, channel, cheight, cwidth, text, align, aa, vlayout, u
         int channel
         double cheight
         double cwidth
-        char *text
+        SV *text_sv
         int align
         int aa
         int vlayout
         int utf8
+      PREINIT:
+       char const *text;
+       STRLEN len;
       CODE:
 #ifdef SvUTF8
         if (SvUTF8(ST(7)))
           utf8 = 1;
 #endif
+       text = SvPV(text_sv, len);
         RETVAL = i_ft2_cp(font, im, tx, ty, channel, cheight, cwidth, text,
-                          strlen(text), align, aa, vlayout, 1);
+                          len, align, aa, vlayout, 1);
       OUTPUT:
         RETVAL
 

diff --git a/MANIFEST b/MANIFEST
index 864702cd4a2e6fded68dcb27cfe5f8dffa0bc0eb..1277dc8d76570c854403b10a0c406166027f1f40 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -151,6 +151,7 @@ lib/Imager/ImageTypes.pod
 lib/Imager/Inline.pod           Using Imager with Inline::C
 lib/Imager/Matrix2d.pm
 lib/Imager/Regops.pm
+lib/Imager/Test.pm
 lib/Imager/Transform.pm
 lib/Imager/Transformations.pod
 lib/Imager/Tutorial.pod

diff --git a/META.yml b/META.yml
index 22b918c6d97f1a212746043733408af7bcb6b9b7..120db91d30c76487441c25858fe3fdb8503ae5d1 100644 (file)
--- a/META.yml
+++ b/META.yml
@@ -7,6 +7,8 @@ abstract: Perl extension for Generating 24 bit Images
 installdirs: site
 recommends:
   Parse::RecDescent: 0
+build_requires:
+  Test::More: 0.47
 license: perl
 dynamic_config: 1
 distribution_type: module

diff --git a/Makefile.PL b/Makefile.PL
index b7f54583747672c4aa2ab91bee7392a24882d3de..8ca21b058f134a5b4df5a94558fed74990df22d4 100644 (file)
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -5,7 +5,7 @@ use Cwd;
 use Config;
 use File::Spec;
 use Getopt::Long;
-use vars qw(%Recommends);
+use vars qw(%Recommends %BuildRequires);
 use ExtUtils::Manifest qw(maniread);
 use vars qw(%formats $VERBOSE $INCPATH $LIBPATH $NOLOG $DEBUG_MALLOC $MANUAL $CFLAGS $LFLAGS $DFLAGS);
 
@@ -161,6 +161,8 @@ my @objs = qw(Imager.o draw.o polygon.o image.o io.o iolayer.o
 
 $Recommends{Imager} =
   { 'Parse::RecDescent' => 0 };
+$BuildRequires{Imager} =
+  { 'Test::More' => 0.47 };
 
 my %opts=(
           'NAME'         => 'Imager',
@@ -171,6 +173,7 @@ my %opts=(
           'OBJECT'       => join(' ', @objs, $F_OBJECT),
           clean          => { FILES=>'testout meta.tmp rubthru.c scale.c' },
           PM             => gen_PM(),
+         PREREQ_PM      => $BuildRequires{Imager},
          );
 
 # eval to prevent warnings about versions with _ in them
@@ -852,6 +855,12 @@ YAML
       $meta .= "  $module: $version\n";
     }
   }
+  if (keys %{$BuildRequires{$opts->{NAME}}}) {
+    $meta .= "build_requires:\n";
+    while (my ($module, $version) = each %{$BuildRequires{$opts->{NAME}}}) {
+      $meta .= "  $module: $version\n";
+    }
+  }
   $meta .= <<YAML;
 license: perl
 dynamic_config: 1

diff --git a/lib/Imager/Test.pm b/lib/Imager/Test.pm
new file mode 100644 (file)
index 0000000..485b0f6
--- /dev/null
+++ b/lib/Imager/Test.pm
@@ -0,0 +1,71 @@
+package Imager::Test;
+use strict;
+use Test::Builder;
+require Exporter;
+use vars qw(@ISA @EXPORT_OK);
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(diff_text_with_nul);
+
+sub diff_text_with_nul {
+  my ($desc, $text1, $text2, @params) = @_;
+
+  my $builder = Test::Builder->new;
+
+  print "# $desc\n";
+  my $imbase = Imager->new(xsize => 100, ysize => 100);
+  my $imcopy = Imager->new(xsize => 100, ysize => 100);
+
+  $builder->ok($imbase->string(x => 5, 'y' => 50, size => 20,
+                              string => $text1,
+                              @params), "$desc - draw text1");
+  $builder->ok($imcopy->string(x => 5, 'y' => 50, size => 20,
+                              string => $text2,
+                              @params), "$desc - draw text2");
+  $builder->isnt_num(Imager::i_img_diff($imbase->{IMG}, $imcopy->{IMG}), 0,
+                    "$desc - check result different");
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Imager::Test - common functions used in testing Imager
+
+=head1 SYNOPSIS
+
+  use Imager::Test 'diff_text_with_nul';
+  diff_text_with_nul($test_name, $text1, $text2, @string_options);
+
+=head1 DESCRIPTION
+
+This is a repository of functions used in testing Imager.
+
+Some functions will only be useful in testing Imager itself, while
+others should be useful in testing modules that use Imager.
+
+No functions are exported by default.
+
+=head1 FUNCTIONS
+
+=over
+
+=item diff_text_with_nul($test_name, $text1, $text2, @optios)
+
+Creates 2 test images and writes $text1 to the first image and $text2
+to the second image with the string() method.  Each call adds 3 ok/not
+ok to the output of the test script.
+
+Extra options that should be supplied include the font and either a
+color or channel parameter.
+
+This was explicitly created for regression tests on #21770.
+
+=back
+
+=head1 AUTHOR
+
+Tony Cook <tony@develop-help.com>
+
+=cut

diff --git a/t/t30t1font.t b/t/t30t1font.t
index 2a3370f27544210a1ddcf6e7bb1882c2c468e4d2..cf7dac029b078ca8d1eb8113ac9a290b8ad4aa20 100644 (file)
--- a/t/t30t1font.t
+++ b/t/t30t1font.t
@@ -8,8 +8,9 @@
 # (It may become useful if the test is moved to ./t subdirectory.)
 use strict;
 use lib 't';
-use Test::More tests => 77;
+use Test::More tests => 90;
 BEGIN { use_ok(Imager => ':all') }
+use Imager::Test qw(diff_text_with_nul);
 
 #$Imager::DEBUG=1;
 
@@ -23,13 +24,13 @@ my $fontname_afm=$ENV{'T1FONTTESTAFM'}||'./fontfiles/dcr10.afm';
 SKIP:
 {
   if (!(i_has_format("t1")) ) {
-    skip("t1lib unavailable or disabled", 76);
+    skip("t1lib unavailable or disabled", 88);
   }
   elsif (! -f $fontname_pfb) {
-    skip("cannot find fontfile for type 1 test $fontname_pfb", 76);
+    skip("cannot find fontfile for type 1 test $fontname_pfb", 89);
   }
   elsif (! -f $fontname_afm) {
-    skip("cannot find fontfile for type 1 test $fontname_afm", 76);
+    skip("cannot find fontfile for type 1 test $fontname_afm", 89);
   }
 
   print "# has t1\n";
@@ -308,6 +309,24 @@ SKIP:
     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);
+
+  }
 }
 
 #malloc_state();

diff --git a/t/t35ttfont.t b/t/t35ttfont.t
index 3a0d7dc72722732d156a658491f9b2b9241f23a2..a5892a86b106e749ea91e2b1a9751c722299ceb0 100644 (file)
--- a/t/t35ttfont.t
+++ b/t/t35ttfont.t
@@ -1,16 +1,17 @@
 #!perl -w
 use strict;
 use lib 't';
-use Test::More tests => 72;
+use Test::More tests => 85;
 
 BEGIN { use_ok(Imager => ':all') }
 require "t/testtools.pl";
+use Imager::Test qw(diff_text_with_nul);
 
 init_log("testout/t35ttfont.log",2);
 
 SKIP:
 {
-  skip("freetype 1.x unavailable or disabled", 71) 
+  skip("freetype 1.x unavailable or disabled", 84) 
     unless i_has_format("tt");
   print "# has tt\n";
   
@@ -19,7 +20,7 @@ SKIP:
 
   if (!ok(-f $fontname, "check test font file exists")) {
     print "# cannot find fontfile for truetype test $fontname\n";
-    skip('Cannot load test font', 70);
+    skip('Cannot load test font', 83);
   }
 
   i_init_fonts();
@@ -258,5 +259,23 @@ SKIP:
       "outputting just a space was crashing");
   }
 
+  { # 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/ImUgly.ttf', type=>'tt');
+    ok($font, "loaded imugly");
+
+    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 \x{2010}
+    my $dash = pack("C*", 0xE2, 0x80, 0x90);
+    diff_text_with_nul("utf8 dash\0dash vs dash", "$dash\0$dash", $dash,
+                      font => $font, color => '#FFFFFF', utf8 => 1);
+    diff_text_with_nul("utf8 dash\0dash vs dash", "$dash\0$dash", $dash,
+                      font => $font, channel => 1, utf8 => 1);
+  }
+
   ok(1, "end of code");
 }

diff --git a/t/t38ft2font.t b/t/t38ft2font.t
index 143e706315deecd93fac0c6e7a306797bcec2dfd..d69ea6b70bb84c606b9daefac7a5ba367ee7d118 100644 (file)
--- a/t/t38ft2font.t
+++ b/t/t38ft2font.t
@@ -1,7 +1,7 @@
 #!perl -w
 use strict;
 use lib 't';
-use Test::More tests => 165;
+use Test::More tests => 178;
 ++$|;
 # Before `make install' is performed this script should be runnable with
 # `make test'. After `make install' it should work as `perl test.pl'
@@ -13,19 +13,21 @@ use Test::More tests => 165;
 
 BEGIN { use_ok(Imager => ':all') }
 
+use Imager::Test qw(diff_text_with_nul);
+
 init_log("testout/t38ft2font.log",2);
 
 my @base_color = (64, 255, 64);
 
 SKIP:
 {
-  i_has_format("ft2") or skip("no freetype2 library found", 164);
+  i_has_format("ft2") or skip("no freetype2 library found", 177);
 
   print "# has ft2\n";
   
   my $fontname=$ENV{'TTFONTTEST'}||'./fontfiles/dodge.ttf';
 
-  -f $fontname or skip("cannot find fontfile $fontname", 164);
+  -f $fontname or skip("cannot find fontfile $fontname", 177);
 
 
   my $bgcolor=i_color_new(255,0,0,0);
@@ -414,6 +416,7 @@ SKIP:
   }
 
   { # cannot output "0"
+    # https://rt.cpan.org/Ticket/Display.html?id=21770
     my $font = Imager::Font->new(file=>'fontfiles/ImUgly.ttf', type=>'ft2');
     ok($font, "loaded imugly");
     my $imbase = Imager->new(xsize => 100, ysize => 100);
@@ -430,6 +433,23 @@ SKIP:
     ok(Imager::i_img_diff($im->{IMG}, $imbase->{IMG}),
        "make sure we actually drew it");
   }
+  { # 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/ImUgly.ttf', type=>'ft2');
+    ok($font, "loaded imugly");
+
+    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 \x{2010}
+    my $dash = pack("C*", 0xE2, 0x80, 0x90);
+    diff_text_with_nul("utf8 dash\0dash vs dash", "$dash\0$dash", $dash,
+                      font => $font, color => '#FFFFFF', utf8 => 1);
+    diff_text_with_nul("utf8 dash\0dash vs dash", "$dash\0$dash", $dash,
+                      font => $font, channel => 1, utf8 => 1);
+  }
 }
 
 sub align_test {