split Imager's typemap into internal, public and old perl bugfixes
authorTony Cook <tony@develop-help.com>
Fri, 17 Feb 2012 12:27:31 +0000 (23:27 +1100)
committerTony Cook <tony@develop-help.com>
Fri, 17 Feb 2012 12:27:31 +0000 (23:27 +1100)
Split as follows:

typemap.local - handle types specific to Imager.xs
typemap - types that Imager's API publishes
typemap.oldperl - fix broken typemap entries in old perl

typemap.oldperl only fixes issues I've run into with perl.

MANIFEST
Makefile.PL
typemap
typemap.local [new file with mode: 0644]
typemap.oldperl [new file with mode: 0644]

index b3d91da..b33c65b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -469,6 +469,8 @@ TIFF/TIFF.xs
 trans2.c
 transform.perl                 Shell interface to Imager::Transform
 typemap
+typemap.local                  typemap for Imager.xs specific definitions
+typemap.oldperl                        typemap for older versions of perl
 W32/fontfiles/ExistenceTest.ttf
 W32/imw32.h
 W32/lib/Imager/Font/Win32.pm
index 1c4b32c..b9ce176 100644 (file)
@@ -167,6 +167,11 @@ my @objs = qw(Imager.o draw.o polygon.o image.o io.o iolayer.o
               bmp.o tga.o color.o fills.o imgdouble.o limits.o hlines.o
               imext.o scale.o rubthru.o render.o paste.o compose.o flip.o);
 
+my @typemaps = qw(typemap.local typemap);
+if ($] < 5.008) {
+    unshift @typemaps, "typemap.oldperl";
+}
+
 my %opts=
   (
    'NAME'         => 'Imager',
@@ -182,6 +187,7 @@ my %opts=
     'Test::More' => 0.47,
     'Scalar::Util' => 1.00,
    },
+   TYPEMAPS       => \@typemaps,
   );
 
 if ($coverage) {
diff --git a/typemap b/typemap
index 56e8cc7..ad3a028 100644 (file)
--- a/typemap
+++ b/typemap
@@ -5,7 +5,6 @@ Imager::ImgRaw          T_IMAGER_IMAGE
 Imager::Font::TT       T_PTROBJ
 Imager::IO              T_PTROBJ
 Imager::FillHandle      T_PTROBJ
-Imager::Internal::Hlines T_PTROBJ
 const char *           T_PV
 float                  T_FLOAT
 float*                 T_ARRAY
@@ -25,29 +24,12 @@ Imager__IO              T_PTROBJ_INV
 # mostly intended for non-Imager-core use
 Imager                  T_IMAGER_FULL_IMAGE
 
-off_t                  T_OFF_T
-
-# STRLEN isn't in the default typemap in older perls
-STRLEN                 T_UV
-
-# internal types used in Imager.xs
-i_channel_list         T_IM_CHANNEL_LIST
-i_sample_list          T_IM_SAMPLE_LIST
-i_fsample_list         T_IM_FSAMPLE_LIST
-
 #############################################################################
 INPUT
 T_PTR_NULL
        if (SvOK($arg)) $var = INT2PTR($type,SvIV($arg));
        else $var = NULL
 
-# the pre-5.8.0 T_AVREF input map was fixed in 5.8.0
-T_AVREF
-        if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
-            $var = (AV*)SvRV($arg);
-        else
-            Perl_croak(aTHX_ \"$var is not an array reference\")
-
 # handles Imager objects rather than just raw objects
 T_IMAGER_IMAGE
         if (sv_derived_from($arg, \"Imager::ImgRaw\")) {
@@ -94,93 +76,6 @@ T_PTROBJ_INV
         else
             croak(\"$var is not of type ${(my $ntt=$ntype)=~s/__/::/g;\$ntt}\");
 
-T_OFF_T
-  $var = i_sv_off_t(aTHX_ $arg);
-
-T_IM_CHANNEL_LIST
-        SvGETMAGIC($arg);
-       if (SvOK($arg)) {
-         AV *channels_av;
-         int i;
-         if (!SvROK($arg) || SvTYPE(SvRV($arg)) != SVt_PVAV) {
-           croak(\"$var is not an array ref\");
-         }
-         channels_av = (AV *)SvRV($arg);
-         $var.count = av_len(channels_av) + 1;
-         if ($var.count < 1) {
-           croak(\"$pname: no channels provided\");
-         }
-         $var.channels = malloc_temp(aTHX_ sizeof(int) * $var.count);
-         for (i = 0; i < $var.count; ++i) {
-           SV **entry = av_fetch(channels_av, i, 0);
-           $var.channels[i] = entry ? SvIV(*entry) : 0;
-         }
-        }
-       else {
-         /* assumes we have an image */
-         $var.count = im->channels;
-         $var.channels = NULL;
-       }
-
-T_IM_SAMPLE_LIST
-       SvGETMAGIC($arg);
-       if (!SvOK($arg))
-         croak(\"$var must be a scalar or an arrayref\");
-       if (SvROK($arg)) {
-         i_img_dim i;
-         AV *av;
-         i_sample_t *s;
-         if (SvTYPE(SvRV($arg)) != SVt_PVAV)
-           croak(\"$var must be a scalar or an arrayref\");
-         av = (AV *)SvRV($arg);
-          $var.count = av_len(av) + 1;
-          if ($var.count < 1)
-           croak(\"$pname: no samples provided in $var\");
-         s = malloc_temp(aTHX_ sizeof(i_sample_t) * $var.count);
-         for (i = 0; i < $var.count; ++i) {
-           SV **entry = av_fetch(av, i, 0);
-           s[i] = entry ? SvIV(*entry) : 0;
-         }
-          $var.samples = s;
-       }
-       else {
-         /* non-magic would be preferable here */
-         $var.samples = (const i_sample_t *)SvPVbyte($arg, $var.count);
-         if ($var.count == 0)
-           croak(\"$pname: no samples provided in $var\");
-       }
-
-T_IM_FSAMPLE_LIST
-       SvGETMAGIC($arg);
-       if (!SvOK($arg))
-         croak(\"$var must be a scalar or an arrayref\");
-       if (SvROK($arg)) {
-         i_img_dim i;
-         AV *av;
-         i_fsample_t *s;
-         if (SvTYPE(SvRV($arg)) != SVt_PVAV)
-           croak(\"$var must be a scalar or an arrayref\");
-         av = (AV *)SvRV($arg);
-          $var.count = av_len(av) + 1;
-          if ($var.count < 1)
-           croak(\"$pname: no samples provided in $var\");
-         s = malloc_temp(aTHX_ sizeof(i_fsample_t) * $var.count);
-         for (i = 0; i < $var.count; ++i) {
-           SV **entry = av_fetch(av, i, 0);
-           s[i] = entry ? SvNV(*entry) : 0;
-         }
-          $var.samples = s;
-       }
-       else {
-         /* non-magic would be preferable here */
-         $var.samples = (const i_fsample_t *)SvPVbyte($arg, $var.count);
-         if ($var.count % sizeof(double))
-           croak(\"$pname: $var doesn't not contain a integer number of samples\");
-          $var.count /= sizeof(double);
-         if ($var.count == 0)
-           croak(\"$pname: no samples provided in $var\");
-       }
-
 #############################################################################
 OUTPUT
 T_IV_U
@@ -212,5 +107,3 @@ T_IMAGER_FULL_IMAGE
         else {
           $arg = &PL_sv_undef;
         }
-T_OFF_T
-       $arg = i_new_sv_off_t(aTHX_ $var);
diff --git a/typemap.local b/typemap.local
new file mode 100644 (file)
index 0000000..6ad73ff
--- /dev/null
@@ -0,0 +1,107 @@
+# definitions we don't want to make visible to the world
+# because they're intended for use specifically by Imager.xs
+
+# internal types used in Imager.xs
+i_channel_list         T_IM_CHANNEL_LIST
+i_sample_list          T_IM_SAMPLE_LIST
+i_fsample_list         T_IM_FSAMPLE_LIST
+
+off_t                  T_OFF_T
+
+Imager::Internal::Hlines T_PTROBJ
+
+#############################################################################
+INPUT
+
+T_OFF_T
+  $var = i_sv_off_t(aTHX_ $arg);
+
+T_IM_CHANNEL_LIST
+        SvGETMAGIC($arg);
+       if (SvOK($arg)) {
+         AV *channels_av;
+         int i;
+         if (!SvROK($arg) || SvTYPE(SvRV($arg)) != SVt_PVAV) {
+           croak(\"$var is not an array ref\");
+         }
+         channels_av = (AV *)SvRV($arg);
+         $var.count = av_len(channels_av) + 1;
+         if ($var.count < 1) {
+           croak(\"$pname: no channels provided\");
+         }
+         $var.channels = malloc_temp(aTHX_ sizeof(int) * $var.count);
+         for (i = 0; i < $var.count; ++i) {
+           SV **entry = av_fetch(channels_av, i, 0);
+           $var.channels[i] = entry ? SvIV(*entry) : 0;
+         }
+        }
+       else {
+         /* assumes we have an image */
+         $var.count = im->channels;
+         $var.channels = NULL;
+       }
+
+T_IM_SAMPLE_LIST
+       SvGETMAGIC($arg);
+       if (!SvOK($arg))
+         croak(\"$var must be a scalar or an arrayref\");
+       if (SvROK($arg)) {
+         i_img_dim i;
+         AV *av;
+         i_sample_t *s;
+         if (SvTYPE(SvRV($arg)) != SVt_PVAV)
+           croak(\"$var must be a scalar or an arrayref\");
+         av = (AV *)SvRV($arg);
+          $var.count = av_len(av) + 1;
+          if ($var.count < 1)
+           croak(\"$pname: no samples provided in $var\");
+         s = malloc_temp(aTHX_ sizeof(i_sample_t) * $var.count);
+         for (i = 0; i < $var.count; ++i) {
+           SV **entry = av_fetch(av, i, 0);
+           s[i] = entry ? SvIV(*entry) : 0;
+         }
+          $var.samples = s;
+       }
+       else {
+         /* non-magic would be preferable here */
+         $var.samples = (const i_sample_t *)SvPVbyte($arg, $var.count);
+         if ($var.count == 0)
+           croak(\"$pname: no samples provided in $var\");
+       }
+
+T_IM_FSAMPLE_LIST
+       SvGETMAGIC($arg);
+       if (!SvOK($arg))
+         croak(\"$var must be a scalar or an arrayref\");
+       if (SvROK($arg)) {
+         i_img_dim i;
+         AV *av;
+         i_fsample_t *s;
+         if (SvTYPE(SvRV($arg)) != SVt_PVAV)
+           croak(\"$var must be a scalar or an arrayref\");
+         av = (AV *)SvRV($arg);
+          $var.count = av_len(av) + 1;
+          if ($var.count < 1)
+           croak(\"$pname: no samples provided in $var\");
+         s = malloc_temp(aTHX_ sizeof(i_fsample_t) * $var.count);
+         for (i = 0; i < $var.count; ++i) {
+           SV **entry = av_fetch(av, i, 0);
+           s[i] = entry ? SvNV(*entry) : 0;
+         }
+          $var.samples = s;
+       }
+       else {
+         /* non-magic would be preferable here */
+         $var.samples = (const i_fsample_t *)SvPVbyte($arg, $var.count);
+         if ($var.count % sizeof(double))
+           croak(\"$pname: $var doesn't not contain a integer number of samples\");
+          $var.count /= sizeof(double);
+         if ($var.count == 0)
+           croak(\"$pname: no samples provided in $var\");
+       }
+
+#############################################################################
+OUTPUT
+
+T_OFF_T
+       $arg = i_new_sv_off_t(aTHX_ $var);
diff --git a/typemap.oldperl b/typemap.oldperl
new file mode 100644 (file)
index 0000000..f7ad323
--- /dev/null
@@ -0,0 +1,28 @@
+# typemaps for perl before 5.8
+# STRLEN isn't in the default typemap in older perls
+STRLEN                 T_UV
+
+#############################################################################
+INPUT
+# the pre-5.8.0 T_AVREF input map was fixed in 5.8.0
+T_AVREF
+       STMT_START {
+           SV *const xsub_tmp_sv = $arg;
+           SvGETMAGIC(xsub_tmp_sv);
+            if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv))==SVt_PVAV)
+               $var = (AV*)SvRV(xsub_tmp_sv);
+            else
+               Perl_croak(aTHX_ \"$var is not an array reference\");
+       } STMT_END
+
+# the pre-5.8.0 T_HVREF input map was fixed in 5.8.0
+T_HVREF
+       STMT_START {
+           SV *const xsub_tmp_sv = $arg;
+           SvGETMAGIC(xsub_tmp_sv);
+            if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv))==SVt_PVHV)
+                $var = (HV*)SvRV(xsub_tmp_sv);
+            else
+               Perl_croak(aTHX_ \"$var is not a hash reference\");
+       } STMT_END
+