Skip Menu |
Report information
Id: 72684
Status: resolved
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: nicholas <nick [at] ccl4.org>
Cc:
AdminCc:

Operating System: (no value)
PatchStatus: HasPatch
Severity: low
Type: Patch
Perl Version: (no value)
Fixed In: (no value)



Subject: [PATCH] ref types in typemap cannot deal with magical variables
Date: Wed, 10 Feb 2010 09:59:38 +0000
To: perlbug [...] perl.org
From: Nicholas Clark <nick [...] ccl4.org>
Download (untitled) / with headers
text/plain 4.5k
----- 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) Show quoted text
----- 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
RT-Send-CC: g.psy.va [...] gmail.com, perl5-porters [...] perl.org
On Wed Feb 10 02:01:22 2010, nicholas wrote: Show quoted text
> ----- 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 88b5a879. Thank you.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org