fix SV type probing to not break pre perl 5.12

diff --git a/Changes b/Changes
index 42cafa0865bfe73c14dce1615aba977ed9cb217d..ef3ef4916c0c7d9ef26b6b9c656e25ff164a4b63 100644 (file)
--- a/Changes
+++ b/Changes
@@ -6,6 +6,9 @@ Imager release history.  Older releases can be found in Changes.old
 
  - GIF: avoid a double-free when do_write() fails.
 
+ - fix SV type probing to work on perl before 5.12.
+   https://rt.cpan.org/Ticket/Display.html?id=96761
+
 Imager 0.99 - 25 Jun 2014
 ===========
 

diff --git a/Imager.xs b/Imager.xs
index 15750a251d9e6ed297117605c90d5eeadbc53c8e..eaf756e5ea4241c7861cd7a377403cfdf708cc5a 100644 (file)
--- a/Imager.xs
+++ b/Imager.xs
@@ -454,9 +454,44 @@ static void io_destroyer(void *p) {
 static bool
 im_SvREFSCALAR(SV *sv) {
   svtype type = SvTYPE(sv);
-  return type == SVt_PV || type == SVt_PVIV || type == SVt_PVNV
-      || type == SVt_PVMG || type == SVt_IV || type == SVt_NV
-      || type == SVt_PVLV || type == SVt_REGEXP;
+
+  switch (type) {
+  case SVt_PV:
+  case SVt_PVIV:
+  case SVt_PVNV:
+  case SVt_PVMG:
+  case SVt_IV:
+  case SVt_NV:
+  case SVt_PVLV:
+#if PERL_VERSION > 10
+  case SVt_REGEXP:
+#endif
+    return 1;
+
+  default:
+    return 0;
+  }
+}
+
+static const char *
+describe_sv(SV *sv) {
+  if (SvOK(sv)) {
+    if (SvROK(sv)) {
+      svtype type = SvTYPE(SvRV(sv));
+      switch (type) {
+      case SVt_PVCV: return "CV";
+      case SVt_PVGV: return "GV";
+      case SVt_PVLV: return "LV";
+      default: return "some reference";
+      }
+    }
+    else {
+      return "non-reference scalar";
+    }
+  }
+  else {
+    return "undef";
+  }
 }
 
 static i_io_glue_t *
@@ -468,11 +503,11 @@ do_io_new_buffer(pTHX_ SV *data_sv) {
 
   SvGETMAGIC(data_sv);
   if (SvROK(data_sv)) {
-    if (im_SvREFSCALAR(data_sv)) {
+    if (im_SvREFSCALAR(SvRV(data_sv))) {
       sv = SvRV(data_sv);
     }
     else {
-      i_push_error(0, "data is not a scalar or a reference to scalar");
+      i_push_errorf(0, "data is not a scalar or a reference to scalar");
       return NULL;
     }
   }
@@ -488,27 +523,6 @@ do_io_new_buffer(pTHX_ SV *data_sv) {
   return io_new_buffer(data_copy, length, free_buffer, data_copy);
 }
 
-static const char *
-describe_sv(SV *sv) {
-  if (SvOK(sv)) {
-    if (SvROK(sv)) {
-      svtype type = SvTYPE(SvRV(sv));
-      switch (type) {
-      case SVt_PVCV: return "CV";
-      case SVt_PVGV: return "GV";
-      case SVt_PVLV: return "LV";
-      default: return "some reference";
-      }
-    }
-    else {
-      return "non-reference scalar";
-    }
-  }
-  else {
-    return "undef";
-  }
-}
-
 static i_io_glue_t *
 do_io_new_cb(pTHX_ SV *writecb, SV *readcb, SV *seekcb, SV *closecb) {
   struct cbdata *cbd;

diff --git a/t/200-file/010-iolayer.t b/t/200-file/010-iolayer.t
index bc77159dfdb93cc45e7d4865969dda6c66c40554..079e691f2077a446ecedcead9671064fadc67b57 100644 (file)
--- a/t/200-file/010-iolayer.t
+++ b/t/200-file/010-iolayer.t
@@ -1,6 +1,6 @@
 #!perl -w
 use strict;
-use Test::More tests => 275;
+use Test::More tests => 287;
 use Imager::Test qw(is_image);
 # for SEEK_SET etc, Fcntl doesn't provide these in 5.005_03
 use IO::Seekable;
@@ -893,12 +893,49 @@ SKIP:
 { # pass buffer by reference
   my $data = "This is a test";
   my $data2 = $data;
-  my $io = Imager::IO->new_buffer(\$data2);
+  my $io = Imager::IO->new_buffer(\$data2)
+    or diag "Can't create from SV REF:", Imager->_error_as_msg;
   undef $data2;
   my $tmp = $io->read2(1000);
   is($tmp, $data, "buffer io created by reference");
 }
 
+{
+  my @buffer_tests =
+    (
+     [ 1000, "IV" ],
+     [ 1000.1, "NV" ],
+     [ qr/abcd/, "regexp",
+       $> >= 5.012 && "Can't use regexps as a buffer before 5.14" ],
+    );
+  for my $test (@buffer_tests) {
+    my ($val, $note, $skip) = @$test;
+  SKIP:
+    {
+      $skip and skip $skip, 4;
+    SKIP:
+      {
+       my $temp = $val;
+       my $io = Imager::IO->new_buffer(\$temp);
+       ok($io, "$note/ref: open_buffer")
+         or skip "couldn't open", 1;
+       my $read = $io->read2(1000);
+       is($read, "$val", "$note/ref: read result");
+      }
+
+    SKIP:
+      {
+       my $temp = $val;
+       my $io = Imager::IO->new_buffer($temp);
+       ok($io, "$note: open_buffer")
+         or skip "couldn't open", 1;
+       my $read = $io->read2(1000);
+       is($read, "$val", "$note: read result");
+      }
+    }
+  }
+}
+
 Imager->close_log;
 
 unless ($ENV{IMAGER_KEEP_FILES}) {