diff options
author | Nicholas Clark <nick@ccl4.org> | 2007-12-22 11:15:49 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2007-12-22 11:15:49 +0000 |
commit | 54cea8cc4e7e8225637e8d1e3b66ab04b99f0aee (patch) | |
tree | 78368302d92cfd943b32a460be133893a2257f84 | |
parent | a9eee89a8bbc25c967a9cf16cb6eeaf028d96985 (diff) | |
download | perl-54cea8cc4e7e8225637e8d1e3b66ab04b99f0aee.tar.gz |
Integrate:
[ 32509]
For 5.8.8 and earlier, always call newCONSTSUB(), as the interpreter
doesn't support proxy constant subroutines. For all 5.8.x add a cast
to (char *) for the second argument to newCONSTSUB().
p4raw-link: @32509 on //depot/maint-5.8/perl: e60da08bc525b4d06d02281a467ff7e0ecd8c763
p4raw-id: //depot/perl@32698
p4raw-integrated: from //depot/maint-5.8/perl@32693 'copy in'
lib/ExtUtils/Constant/ProxySubs.pm (@32393..)
-rw-r--r-- | lib/ExtUtils/Constant/ProxySubs.pm | 31 |
1 files changed, 28 insertions, 3 deletions
diff --git a/lib/ExtUtils/Constant/ProxySubs.pm b/lib/ExtUtils/Constant/ProxySubs.pm index af8c458b63..1de3f80ad3 100644 --- a/lib/ExtUtils/Constant/ProxySubs.pm +++ b/lib/ExtUtils/Constant/ProxySubs.pm @@ -9,7 +9,7 @@ require ExtUtils::Constant::XS; use ExtUtils::Constant::Utils qw(C_stringify); use ExtUtils::Constant::XS qw(%XS_TypeSet); -$VERSION = '0.05'; +$VERSION = '0.06'; @ISA = 'ExtUtils::Constant::XS'; %type_to_struct = @@ -197,9 +197,19 @@ sub WriteConstants { my $athx = $self->C_constant_prefix_param(); my $symbol_table = C_stringify($package) . '::'; + my $can_do_pcs = $] >= 5.009; + my $cast_CONSTSUB = $] < 5.010 ? '(char *)' : ''; + print $c_fh $self->header(), <<"EOADD"; static void ${c_subname}_add_symbol($pthx HV *hash, const char *name, I32 namelen, SV *value) { +EOADD + if (!$can_do_pcs) { + print $c_fh <<'EO_NOPCS'; + if (namelen == namelen) { +EO_NOPCS + } else { + print $c_fh <<"EO_PCS"; SV **sv = hv_fetch(hash, name, namelen, TRUE); if (!sv) { Perl_croak($athx "Couldn't add key '%s' to %%$package_sprintf_safe\::", @@ -207,13 +217,27 @@ ${c_subname}_add_symbol($pthx HV *hash, const char *name, I32 namelen, SV *value } if (SvOK(*sv) || SvTYPE(*sv) == SVt_PVGV) { /* Someone has been here before us - have to make a real sub. */ - newCONSTSUB(hash, name, value); +EO_PCS + } + # This piece of code is common to both + print $c_fh <<"EOADD"; + newCONSTSUB(hash, ${cast_CONSTSUB}name, value); +EOADD + if ($can_do_pcs) { + print $c_fh <<'EO_PCS'; } else { SvUPGRADE(*sv, SVt_RV); SvRV_set(*sv, value); SvROK_on(*sv); SvREADONLY_on(value); } +EO_PCS + } else { + print $c_fh <<'EO_NOPCS'; + } +EO_NOPCS + } + print $c_fh <<'EOADD'; } EOADD @@ -411,7 +435,8 @@ EXPLODE /* It turns out to be incredibly hard to deal with all the corner cases of sub foo (); and reporting errors correctly, so lets cheat a bit. Start with a constant subroutine */ - CV *cv = newCONSTSUB(symbol_table, value_for_notfound->name, + CV *cv = newCONSTSUB(symbol_table, + ${cast_CONSTSUB}value_for_notfound->name, &PL_sv_yes); /* and then turn it into a non constant declaration only. */ SvREFCNT_dec(CvXSUBANY(cv).any_ptr); |