Permalink
Browse files

0.61: fix old symbols on Dynalib.xs for >5.12: na, errgv

  • Loading branch information...
1 parent feb5e6d commit 7edc3117c7a274cacf3d0c188146a0aaa89923c7 Reini Urban committed Dec 21, 2010
Showing with 43 additions and 29 deletions.
  1. +2 −1 Changes
  2. +5 −5 DynaLib.xs
  3. +8 −6 Makefile.PL
  4. +3 −3 lib/C/DynaLib.pm
  5. +6 −5 lib/C/DynaLib/Parse.pm
  6. +19 −9 lib/C/DynaLib/Struct.pm
View
@@ -15,7 +15,8 @@ Revision history for Perl extension C::DynaLib
added dl_unload_file as used by dlopen/win32 platforms
(most fortunately)
fix msvc6 activeperl 5.10 against malloc/free/realloc defines
- fix C::DynaLib::Struct::Parse
+ work on C::DynaLib::Struct::Parse
+ fix old symbols on Dynalib.xs for >5.12: na, errgv
0.60 2010-04-20 23:55:12 rurban
Improve library search and windows resolution:
View
@@ -146,7 +146,7 @@ cb_call_sub(index, first, ap)
#endif
static char *first_msg = "Can't use '%c' as first argument type in callback";
- config = (cb_entry *) SvPV(*av_fetch(cb_av_config, index, 0), na);
+ config = (cb_entry *) SvPV(*av_fetch(cb_av_config, index, 0), PL_na);
ENTER;
SAVETMPS;
PUSHMARK(sp);
@@ -287,7 +287,7 @@ cb_call_sub(index, first, ap)
}
PUTBACK;
- if (in_eval) {
+ if (PL_in_eval) {
/*
* XXX The whole issue of G_KEEPERR and `eval's is very confusing
* to me. For example, we should be able to tell whether or not we
@@ -300,12 +300,12 @@ cb_call_sub(index, first, ap)
*
* It can also produce weirdness when used with Carp::confess.
*/
- SvPV(GvSV(errgv), old_err_len);
+ SvPV(GvSV(PL_errgv), old_err_len);
nret = perl_call_sv(config->coderef, G_SCALAR | G_EVAL | G_KEEPERR);
SPAGAIN;
- SvPV(GvSV(errgv), new_err_len);
+ SvPV(GvSV(PL_errgv), new_err_len);
if (new_err_len > old_err_len) {
- char *msg = SvPV(GvSV(errgv),na);
+ char *msg = SvPV(GvSV(PL_errgv), PL_na);
static char prefix[] = "\t(in cleanup) "; /* from pp_ctl.c */
if (old_err_len == 0 && strnEQ(msg, prefix, (sizeof prefix) - 1)) {
View
@@ -90,8 +90,8 @@ unless (@convention) {
$object .= " alpha-cc.o";
}
'alpha'} ],
- [ 'win32', sub {('cdecl','stdcall')} ],
- [ '^cygwin', sub {my $CDECL_ADJUST = -32; ('cdecl','stdcall')} ],
+ [ 'win32', sub {'stdcall'} ],
+ #[ '^cygwin', sub {my $CDECL_ADJUST = -32; ('cdecl','stdcall')} ],
[ '', sub { () } ],
)
{ @convention = &{$_->[1]}, last if $archname =~ /$_->[0]/i }
@@ -322,7 +322,8 @@ sub guess_cdecl_h {
$self->{how_to_compile} =~ s/testtest/testreverse/g;
$self->{how_to_run} =~ s/testtest/testreverse/g;
my $defines;
- for $defines ("-DINCLUDE_ALLOCA", "", "-DINCLUDE_MALLOC") {
+ for ("-DINCLUDE_ALLOCA", "", "-DINCLUDE_MALLOC") {
+ $defines = $_;
my $cmd = $self->{how_to_compile};
$defines .= " -g" if $is_gcc;
$defines .= " -DVERBOSE" if $Verbose;
@@ -392,20 +393,21 @@ sub make_postamble {
@convention = ('cdecl');
}
if ($reverse or $is_win32) {
- push @convention, 'stdcall';
+ push @convention, 'stdcall' unless grep /^stdcall$/, @convention;
print "Using conventions: @convention\n";
}
}
} elsif (@convention) {
print "Can't figure out this system. I'll have to guess.\n"
if $Verbose;
guess_cdecl_h($self);
- if ($do_reverse) {
+ if ($do_reverse and !grep /^stdcall$/, @convention) {
push @convention, 'stdcall';
print "Using conventions: @convention\n";
}
elsif ($is_win32) {
- push @convention, 'stdcall', 'hack30';
+ push @convention, 'stdcall' unless grep /^stdcall$/, @convention;
+ push @convention, 'hack30' unless grep /^hack30$/, @convention;
print "Using conventions: @convention\n";
}
} else {
View
@@ -235,9 +235,9 @@ sub Parse {
$filter = shift;
}
require C::DynaLib::Parse;
- C::DynaLib::Parse->import qw(declare_func declare_struct
- pack_types process_struct process_func);
- my $node = GCC_prepare($code, $cc);
+ C::DynaLib::Parse->import (qw(declare_func declare_struct
+ pack_types process_struct process_func));
+ my $node = C::DynaLib::Parse::GCC_prepare($code, $cc);
while ($node) {
if ($node->isa('GCC::Node::function_decl')
and ($filter ? $node->name->identifier =~ /$filter/
View
@@ -1,12 +1,13 @@
package C::DynaLib::Parse;
# common functions for function and struct parsers.
-# GCC::TranslationUnit (required) and Convert::Binary::C (optional)
+# Using GCC::TranslationUnit (required, but does not work yet)
+# and Convert::Binary::C (optional).
# Reini Urban 2010
use strict;
use vars qw(@ISA @EXPORT_OK);
-use Exporter 'import';
+use Exporter;# 'import';
@ISA = qw(Exporter);
@EXPORT_OK = qw(pack_types process_struct process_func
declare_func declare_struct
@@ -37,7 +38,7 @@ sub GCC {
sub GCC_prepare { # decl, [gcc]
# XXX looks like file => c or c++
my $code = shift;
- my $cc = shift || 'gcc';
+ my $cc = shift || 'gcc'; # || gcc-xml
my $tmp = File::Temp->new( TEMPLATE => "tmpXXXXX",
SUFFIX => '.c' );
my $tmpname = $tmp->filename;
@@ -57,7 +58,7 @@ sub GCC_prepare { # decl, [gcc]
# on records and pointers we might need to create handy accessors per FFI.
sub type_name {
my $type = shift;
- print $type->qual ? $type->qual." " : "";
+ #warn $type->qual ? $type->qual." " : "";
if ($type->name and $type->name->can('name')) {
return $type->name->name->identifier;
} elsif (ref $type eq 'GCC::Node::pointer_type') {
@@ -66,7 +67,7 @@ sub type_name {
my $struct = ref($node->name) =~ /type_decl/
? $node->name->name->identifier : $node->name->identifier;
# mark struct $name to be dumped later, with decl and fields
- push @post, $node unless $records{$struct};
+ push @C::DynaLib::Parse::post, $node unless $records{$struct};
# prevent from recursive declarations
$records{$struct}++;
return $node->code . " $struct " . $type->thingy . type_name($node);
View
@@ -1,8 +1,11 @@
package C::DynaLib::Struct;
require 5.002;
use C::DynaLib;
-use C::DynaLib::Parse qw(pack_types declare_func declare_struct
- process_struct process_func);
+BEGIN {
+ if ($] > 5.008) {
+ require C::DynaLib::Parse;
+ }
+}
=head1 NAME
@@ -107,6 +110,13 @@ L<Convert::Binary::C>, L<perlfunc(1)> (for C<pack>), L<perlref(1)>, L<perltie(1)
use strict qw (vars subs);
use subs qw(Define Parse);
+if ($] > 5.008) {
+ *C::DynaLib::Struct::pack_types = *C::DynaLib::Parse::pack_types;
+ *C::DynaLib::Struct::declare_func = *C::DynaLib::Parse::declare_func;
+ *C::DynaLib::Struct::declare_struct = *C::DynaLib::Parse::declare_struct;
+ *C::DynaLib::Struct::process_func = *C::DynaLib::Parse::process_func;
+ *C::DynaLib::Struct::process_struct = *C::DynaLib::Parse::process_struct;
+}
package C::DynaLib::Struct::Imp;
@@ -235,9 +245,9 @@ sub Parse {
for (0..@{$s->{declarations}}) {
my $d = $s->{declarations}->[$_];
if ($d and $d->{declarators}[0]->{declarator}
- and substr($d->{declarators}[0]->{declarator},0,1) eq '*')
+ and substr($d->{declarators}[0]->{declarator},0,1) eq '*')
{
- $s->{declarations}->[$_]->{declarators}[0]->{declarator} =
+ $s->{declarations}->[$_]->{declarators}[0]->{declarator} =
substr($d->{declarators}[0]->{declarator},1);
$s->{declarations}->[$_]->{type} .= "*";
}
@@ -248,22 +258,22 @@ sub Parse {
\@members);
}
} else {
- # use GCC::TranslationUnit
- my $node = GCC_prepare($definition);
+ # XXX use GCC::TranslationUnit (does not work yet)
+ my $node = C::DynaLib::Parse::GCC_prepare($definition);
while ($node) {
if ($node->isa('GCC::Node::function_decl')) {
- declare_func process_func($node);
+ declare_func(process_func($node));
}
if ($node->isa('GCC::Node::record_type')) {
- declare_struct process_struct($node);
+ declare_struct(process_struct($node));
}
} continue {
$node = $node->chain;
}
POST:
while ($node = shift @C::DynaLib::Parse::post) {
if ($node->isa('GCC::Node::record_type')) {
- declare_struct process_struct($node);
+ declare_struct(process_struct($node));
}
}
}

0 comments on commit 7edc311

Please sign in to comment.