summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2007-12-22 11:15:49 +0000
committerNicholas Clark <nick@ccl4.org>2007-12-22 11:15:49 +0000
commit54cea8cc4e7e8225637e8d1e3b66ab04b99f0aee (patch)
tree78368302d92cfd943b32a460be133893a2257f84
parenta9eee89a8bbc25c967a9cf16cb6eeaf028d96985 (diff)
downloadperl-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.pm31
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);