Need to be more careful with the symbol table manipulation - if there

[p5sagit/p5-mst-13.2.git] / lib / ExtUtils / Constant / ProxySubs.pm

diff --git a/lib/ExtUtils/Constant/ProxySubs.pm b/lib/ExtUtils/Constant/ProxySubs.pm
index 116e2dc..b69c14e 100644 (file)
--- a/lib/ExtUtils/Constant/ProxySubs.pm
+++ b/lib/ExtUtils/Constant/ProxySubs.pm
@@ -2,7 +2,8 @@ package ExtUtils::Constant::ProxySubs;
 
 use strict;
 use vars qw($VERSION @ISA %type_to_struct %type_from_struct %type_to_sv
-           %type_to_C_value %type_is_a_problem %type_num_args);
+           %type_to_C_value %type_is_a_problem %type_num_args
+           %type_temporary);
 use Carp;
 require ExtUtils::Constant::XS;
 use ExtUtils::Constant::Utils qw(C_stringify);
@@ -60,6 +61,9 @@ sub type_to_C_value {
      SV => 1,
      );
 
+$type_temporary{SV} = 'SV *';
+$type_temporary{$_} = $_ foreach qw(IV UV NV);
+     
 while (my ($type, $value) = each %XS_TypeSet) {
     $type_num_args{$type}
        = defined $value ? ref $value ? scalar @$value : 1 : 0;
@@ -170,10 +174,17 @@ sub WriteConstants {
 
     print $c_fh $self->header(), <<"EOADD";
 void ${c_subname}_add_symbol($pthx HV *hash, const char *name, I32 namelen, SV *value) {
-    SV *rv = newRV_noinc(value);
-    if (!hv_store(hash, name, namelen, rv, TRUE)) {
-       SvREFCNT_dec(rv);
-       Perl_croak($athx "Couldn't add key '%s' to %%%s::", name, "$package");
+    SV **sv = hv_fetch(hash, name, namelen, TRUE);
+    if (!sv) {
+        Perl_croak($athx "Couldn't add key '%s' to %%%s::", name, "$package");
+    }
+    if (SvOK(*sv) || SvTYPE(*sv) == SVt_PVGV) {
+       /* Someone has been here before us - have to make a real sub.  */
+       newCONSTSUB(hash, name, value);
+    } else {
+       SvUPGRADE(*sv, SVt_RV);
+       SvRV_set(*sv, value);
+       SvROK_on(*sv);
     }
 }
 
@@ -256,7 +267,7 @@ EOBOOT
        ${c_subname}_missing = newHV();
        while (value_for_notfound->name) {
            if (!hv_store(${c_subname}_missing, value_for_notfound->name,
-                         value_for_notfound->namelen, &PL_sv_yes, TRUE))
+                         value_for_notfound->namelen, &PL_sv_yes, 0))
                Perl_croak($athx "Couldn't add key '%s' to missing_hash",
                           value_for_notfound->name);
            ++value_for_notfound;
@@ -280,9 +291,16 @@ EOBOOT
        die "Can't find generator code for type $type"
            unless defined $generator;
 
-       print $xs_fh "        {\n";
+       print $xs_fh <<"EOBOOT";
+        {
+           $type_temporary{$type} temp;
+EOBOOT
        print $xs_fh "        $item->{pre}\n" if $item->{pre};
-       printf $xs_fh <<"EOBOOT", $name, &$generator(&$type_to_value($value));
+       # We need to use a temporary value because some really troublesome
+       # items use C pre processor directives in their values, and in turn
+       # these don't fit nicely in the macro-ised generator functions
+       printf $xs_fh <<"EOBOOT", &$type_to_value($value), $name, &$generator('temp');
+           temp = %s;
            ${c_subname}_add_symbol($athx symbol_table, "%s",
                                    $namelen, %s);
 EOBOOT