[PATCH] ref types in typemap cannot deal with magical variables

[p5pRT]

Migrated from rt.perl.org#72684 (status was 'resolved')

Searchable as RT72684$

[p5pRT]

From @nwc10

----- Forwarded message from Goro Fuji <g.psy.va@​gmail.com> -----

Envelope-to​: nick@​ccl4.org
Delivery-date​: Wed, 10 Feb 2010 09​:48​:11 +0000
Mailing-List​: contact perl5-porters-help@​perl.org; run by ezmlm
Delivered-To​: mailing list perl5-porters@​perl.org
Delivered-To​: perl5-porters@​perl.org
Date​: Wed, 10 Feb 2010 18​:47​:15 +0900
Subject​: [PATCH] ref types in typemap cannot deal with magical variables
From​: Goro Fuji <g.psy.va@​gmail.com>
To​: perl5-porters@​perl.org

Hi,

Ref types in typemap, namely SVREF, AVREF, HVREF and CVREF, cannot
deal with magical variables (tipically tied variables).
The problem is that type mapping code for refs must call SvGETMAGIC
for $arg so that SvROK access the true SvFLAGS.

I have fixed the problem and written tests for it. Please review the
code on my github account.

http​://github.com/gfx/perl/tree/bugfix/ref-and-gmagic
(the commit is http​://github.com/gfx/perl/commit/dc3262cf0d4faf76616b645506fa66bc80acaa81)

Regards,
--
Goro Fuji (gfx)

----- End forwarded message -----

--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@​@​ -240,6 +240,10 @​@​

STATIC MGVTBL rmagical_b = { 0 };

+
+typedef SV* SVREF;
+
+
#include "const-c.inc"

MODULE = XS​::APItest​:Hash PACKAGE = XS​::APItest​::Hash
@​@​ -936,4 +940,33 @​@​
my_exit(int exitcode)
  PPCODE​:
  my_exit(exitcode);
+
+SV*
+take_svref(SVREF sv)
+CODE​:
+ RETVAL = newRV_inc(sv);
+OUTPUT​:
+ RETVAL
+
+SV*
+take_avref(AV* av)
+CODE​:
+ RETVAL = newRV_inc((SV*)av);
+OUTPUT​:
+ RETVAL
+
+SV*
+take_hvref(HV* hv)
+CODE​:
+ RETVAL = newRV_inc((SV*)hv);
+OUTPUT​:
+ RETVAL
+
+
+SV*
+take_cvref(CV* cv)
+CODE​:
+ RETVAL = newRV_inc((SV*)cv);
+OUTPUT​:
+ RETVAL
--- /dev/null
+++ b/ext/XS-APItest/t/refs.t
@​@​ -1 +1,35 @​@​
+#!perl
+
+use strict;
+use warnings;
+
+use Test​::More tests => 8;
+
+use Tie​::Scalar;
+
+use_ok('XS​::APItest');
+
+my $a;
+my $sr = \$a;
+my $ar = [];
+my $hr = {};
+my $cr = sub{};
+
+is XS​::APItest​::take_svref($sr), $sr;
+is XS​::APItest​::take_avref($ar), $ar;
+is XS​::APItest​::take_hvref($hr), $hr;
+is XS​::APItest​::take_cvref($cr), $cr;
+
+my $obj = tie my $ref, 'Tie​::StdScalar';
+${$obj} = $sr;
+is XS​::APItest​::take_svref($sr), $sr;
+
+${$obj} = $ar;
+is XS​::APItest​::take_avref($ar), $ar;
+
+${$obj} = $hr;
+is XS​::APItest​::take_hvref($hr), $hr;
+
+${$obj} = $cr;
+is XS​::APItest​::take_cvref($cr), $cr;
--- a/lib/ExtUtils/typemap
+++ b/lib/ExtUtils/typemap
@​@​ -58,33 +58,57 @​@​
T_SV
  $var = $arg
T_SVREF
- if (SvROK($arg))
- $var = (SV*)SvRV($arg);
- else
- Perl_croak(aTHX_ \"%s​: %s is not a reference\",
- ${$ALIAS?\q[GvNAME(CvGV(cv))]​:\qq[\"$pname\"]},
- \"$var\")
+ STMT_START {
+ SV* const xsub_tmp_sv = $arg;
+ SvGETMAGIC(xsub_tmp_sv);
+ if (SvROK(xsub_tmp_sv)){
+ $var = SvRV(xsub_tmp_sv);
+ }
+ else{
+ Perl_croak(aTHX_ \"%s​: %s is not a reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]​:\qq[\"$pname\"]},
+ \"$var\");
+ }
+ } STMT_END
T_AVREF
- if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVAV)
- $var = (AV*)SvRV($arg);
- else
- Perl_croak(aTHX_ \"%s​: %s is not an array reference\",
- ${$ALIAS?\q[GvNAME(CvGV(cv))]​:\qq[\"$pname\"]},
- \"$var\")
+ 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_ \"%s​: %s is not an ARRAY reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]​:\qq[\"$pname\"]},
+ \"$var\");
+ }
+ } STMT_END
T_HVREF
- if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV)
- $var = (HV*)SvRV($arg);
- else
- Perl_croak(aTHX_ \"%s​: %s is not a hash reference\",
- ${$ALIAS?\q[GvNAME(CvGV(cv))]​:\qq[\"$pname\"]},
- \"$var\")
+ 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 = (AV*)SvRV(xsub_tmp_sv);
+ }
+ else{
+ Perl_croak(aTHX_ \"%s​: %s is not a HASH reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]​:\qq[\"$pname\"]},
+ \"$var\");
+ }
+ } STMT_END
T_CVREF
- if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVCV)
- $var = (CV*)SvRV($arg);
- else
- Perl_croak(aTHX_ \"%s​: %s is not a code reference\",
- ${$ALIAS?\q[GvNAME(CvGV(cv))]​:\qq[\"$pname\"]},
- \"$var\")
+ STMT_START {
+ SV* const xsub_tmp_sv = $arg;
+ SvGETMAGIC(xsub_tmp_sv);
+ if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVCV){
+ $var = (AV*)SvRV(xsub_tmp_sv);
+ }
+ else{
+ Perl_croak(aTHX_ \"%s​: %s is not a CODE reference\",
+ ${$ALIAS?\q[GvNAME(CvGV(cv))]​:\qq[\"$pname\"]},
+ \"$var\");
+ }
+ } STMT_END
T_SYSRET
  $var NOT IMPLEMENTED
T_UV

[p5pRT]

From @cpansprout

On Wed Feb 10 02​:01​:22 2010, nicholas wrote​:

----- Forwarded message from Goro Fuji <g.psy.va@​gmail.com> -----

Envelope-to​: nick@​ccl4.org
Delivery-date​: Wed, 10 Feb 2010 09​:48​:11 +0000
Mailing-List​: contact perl5-porters-help@​perl.org; run by ezmlm
Delivered-To​: mailing list perl5-porters@​perl.org
Delivered-To​: perl5-porters@​perl.org
Date​: Wed, 10 Feb 2010 18​:47​:15 +0900
Subject​: [PATCH] ref types in typemap cannot deal with magical
variables
From​: Goro Fuji <g.psy.va@​gmail.com>
To​: perl5-porters@​perl.org

Hi,

Ref types in typemap, namely SVREF, AVREF, HVREF and CVREF, cannot
deal with magical variables (tipically tied variables).
The problem is that type mapping code for refs must call SvGETMAGIC
for $arg so that SvROK access the true SvFLAGS.

I have fixed the problem and written tests for it. Please review the
code on my github account.

http​://github.com/gfx/perl/tree/bugfix/ref-and-gmagic
(the commit is

http​://github.com/gfx/perl/commit/dc3262cf0d4faf76616b645506fa66bc80acaa81)

I have just committed that as 88b5a87. Thank you.

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

@cpansprout - Status changed from 'open' to 'resolved'