Skip to content
Browse files

split Imager's typemap into internal, public and old perl bugfixes

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.
  • Loading branch information...
1 parent 5b9d88f commit d63caaff0641d5db5817b842658a894b27881cc7 @tonycoz committed Feb 17, 2012
Showing with 143 additions and 107 deletions.
  1. +2 −0 MANIFEST
  2. +6 −0 Makefile.PL
  3. +0 −107 typemap
  4. +107 −0 typemap.local
  5. +28 −0 typemap.oldperl
View
2 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
View
6 Makefile.PL
@@ -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) {
View
107 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);
View
107 typemap.local
@@ -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);
View
28 typemap.oldperl
@@ -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
+

0 comments on commit d63caaf

Please sign in to comment.
Something went wrong with that request. Please try again.