added test to check for crash in set_internal() (and it's normal

return value)

diff --git a/t/t15color.t b/t/t15color.t
index 9dcccdee2c32cc2817d4c6b047a239ca5f6dc5ec..4f1e40077d0075a73ca0ca22c6e0aac3e6deb80f 100644 (file)
--- a/t/t15color.t
+++ b/t/t15color.t
@@ -6,7 +6,7 @@
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 
-BEGIN { $| = 1; print "1..4\n"; }
+BEGIN { $| = 1; print "1..5\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Imager;
 $loaded = 1;
@@ -20,6 +20,18 @@ my $c2 = Imager::Color->new(100, 150, 200);
 print test_col($c2, 100, 150, 200, 255) ? "ok 3\n" : "not ok 3\n";
 my $c3 = Imager::Color->new("#6496C8");
 print test_col($c3, 100, 150, 200, 255) ? "ok 4\n" : "not ok 4\n";
+# crashes in Imager-0.38pre8 and earlier
+my @foo;
+for (1..1000) {
+  push(@foo, Imager::Color->new("#FFFFFF"));
+}
+my $fail;
+for (@foo) {
+  Imager::Color::set_internal($_, 128, 128, 128, 128) == $_ or ++$fail;
+  Imager::Color::set_internal($_, 128, 128, 128, 128) == $_ or ++$fail;
+}
+$fail and print "not ";
+print "ok 5\n";
 
 sub test_col {
   my ($c, $r, $g, $b, $a) = @_;