the scale() method now warns if scalled in a void context

diff --git a/Changes b/Changes
index 94a1c730b8b6ac4d7e5a57bab6671f8a1c36302a..2c74f1a99bb819969fef34b5100c662be979fb56 100644 (file)
--- a/Changes
+++ b/Changes
@@ -751,6 +751,8 @@ Revision history for Perl extension Imager.
          Imager.pm
        - change the list of documents in Imager.pm to move the document 
          names out of the =item lines so we can make them into links
+       - the scale() method now produces a warning when called in
+         void context.
 
 =================================================================
 

diff --git a/Imager.pm b/Imager.pm
index 3e0b434f1917d1db2b01c355c3468fcf301e8bfa..f5930f807560a0f15f58f05777f57b66b235bdba 100644 (file)
--- a/Imager.pm
+++ b/Imager.pm
@@ -1522,6 +1522,11 @@ sub scale {
   my $img = Imager->new();
   my $tmp = Imager->new();
 
+  unless (defined wantarray) {
+    warn "scale() called in void context - scale() returns the scaled image";
+    return;
+  }
+
   unless ($self->{IMG}) { $self->{ERRSTR}='empty input image'; return undef; }
 
   if ($opts{xpixels} and $opts{ypixels} and $opts{'type'}) {

diff --git a/t/t40scale.t b/t/t40scale.t
index 11bb61d1a3625114d698f7d61bcd706ac7aca319..8cf34651d62db7b37c3f4c790ba4608d2d05b40e 100644 (file)
--- a/t/t40scale.t
+++ b/t/t40scale.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..6\n"; }
+BEGIN { $| = 1; print "1..7\n"; }
 END {print "not ok 1\n" unless $loaded;}
 
 use Imager qw(:all);
@@ -33,4 +33,16 @@ print "ok 5\n";
 $scaleimg->write(file=>'testout/t40scale2.ppm',type=>'pnm') or print "failed: ",$scaleimg->{ERRSTR},"\n";
 print "ok 6\n";
 
+# check for a warning when scale() is called in void context
+my $warning;
+local $SIG{__WARN__} = 
+  sub { 
+    $warning = "@_";
+    my $printed = $warning;
+    $printed =~ s/\n$//;
+    $printed =~ s/\n/\n\#/g; 
+    print "# ",$printed, "\n";
+  };
+$img->scale(scalefactor=>0.25);
+print $warning =~ /void/ ? "ok 7\n" : "not ok 7\n";