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);
YES => sub { '&PL_sv_yes' },
NO => sub { '&PL_sv_no' },
'' => sub { '&PL_sv_yes' },
+ SV => sub {"SvREFCNT_inc($_[0])"},
);
%type_to_C_value =
%type_is_a_problem =
(
+ # The documentation says *mortal SV*, but we now need a non-mortal copy.
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;
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);
}
}
${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;
die "Can't find generator code for type $type"
unless defined $generator;
- printf $xs_fh <<"EOBOOT", $name, &$generator(&$type_to_value($value));
- ${c_subname}_add_symbol($athx symbol_table, "%s",
- $namelen, %s);
+ print $xs_fh <<"EOBOOT";
+ {
+ $type_temporary{$type} temp;
+EOBOOT
+ print $xs_fh " $item->{pre}\n" if $item->{pre};
+ # 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
+ print $xs_fh " $item->{post}\n" if $item->{post};
+ print $xs_fh " }\n";
print $xs_fh $self->macro_to_endif($macro);
}