729 lines
23 KiB
Diff
729 lines
23 KiB
Diff
|
From 9e7a7caf4d42a74235accb7a397b5313ecbbbc94 Mon Sep 17 00:00:00 2001
|
||
|
From: Jitka Plesnikova <jplesnik@redhat.com>
|
||
|
Date: Thu, 6 May 2021 07:58:11 +0200
|
||
|
Subject: [PATCH] Upgrade to 3.43
|
||
|
|
||
|
---
|
||
|
lib/ExtUtils/ParseXS.pm | 10 ++-
|
||
|
lib/ExtUtils/ParseXS/Constants.pm | 2 +-
|
||
|
lib/ExtUtils/ParseXS/CountLines.pm | 2 +-
|
||
|
lib/ExtUtils/ParseXS/Eval.pm | 2 +-
|
||
|
lib/ExtUtils/ParseXS/Utilities.pm | 2 +-
|
||
|
lib/ExtUtils/Typemaps.pm | 2 +-
|
||
|
lib/ExtUtils/Typemaps/Cmd.pm | 2 +-
|
||
|
lib/ExtUtils/Typemaps/InputMap.pm | 2 +-
|
||
|
lib/ExtUtils/Typemaps/OutputMap.pm | 2 +-
|
||
|
lib/ExtUtils/Typemaps/Type.pm | 2 +-
|
||
|
lib/perlxs.pod | 40 +++++++--
|
||
|
lib/perlxstut.pod | 126 +++++++++++++++++------------
|
||
|
t/001-basic.t | 29 +++++--
|
||
|
t/002-more.t | 3 +-
|
||
|
t/003-usage.t | 3 +-
|
||
|
t/XSBroken.xs | 26 ++++++
|
||
|
16 files changed, 171 insertions(+), 84 deletions(-)
|
||
|
create mode 100644 t/XSBroken.xs
|
||
|
|
||
|
diff --git a/lib/ExtUtils/ParseXS.pm b/lib/ExtUtils/ParseXS.pm
|
||
|
index fba7f4d..d2205ac 100644
|
||
|
--- a/lib/ExtUtils/ParseXS.pm
|
||
|
+++ b/lib/ExtUtils/ParseXS.pm
|
||
|
@@ -11,7 +11,7 @@ use Symbol;
|
||
|
|
||
|
our $VERSION;
|
||
|
BEGIN {
|
||
|
- $VERSION = '3.40';
|
||
|
+ $VERSION = '3.43';
|
||
|
require ExtUtils::ParseXS::Constants; ExtUtils::ParseXS::Constants->VERSION($VERSION);
|
||
|
require ExtUtils::ParseXS::CountLines; ExtUtils::ParseXS::CountLines->VERSION($VERSION);
|
||
|
require ExtUtils::ParseXS::Utilities; ExtUtils::ParseXS::Utilities->VERSION($VERSION);
|
||
|
@@ -42,6 +42,7 @@ use ExtUtils::ParseXS::Utilities qw(
|
||
|
our @EXPORT_OK = qw(
|
||
|
process_file
|
||
|
report_error_count
|
||
|
+ errors
|
||
|
);
|
||
|
|
||
|
##############################
|
||
|
@@ -911,7 +912,7 @@ EOF
|
||
|
#-Wall: if there is no $self->{Full_func_name} there are no xsubs in this .xs
|
||
|
#so 'file' is unused
|
||
|
print Q(<<"EOF") if $self->{Full_func_name};
|
||
|
-##if (PERL_REVISION == 5 && PERL_VERSION < 9)
|
||
|
+##if PERL_VERSION_LE(5, 8, 999) /* PERL_VERSION_LT is 5.33+ */
|
||
|
# char* file = __FILE__;
|
||
|
##else
|
||
|
# const char* file = __FILE__;
|
||
|
@@ -954,7 +955,7 @@ EOF
|
||
|
|
||
|
print Q(<<"EOF") if ($self->{Overload});
|
||
|
# /* register the overloading (type 'A') magic */
|
||
|
-##if (PERL_REVISION == 5 && PERL_VERSION < 9)
|
||
|
+##if PERL_VERSION_LE(5, 8, 999) /* PERL_VERSION_LT is 5.33+ */
|
||
|
# PL_amagic_generation++;
|
||
|
##endif
|
||
|
# /* The magic for overload gets a GV* via gv_fetchmeth as */
|
||
|
@@ -1012,6 +1013,7 @@ sub report_error_count {
|
||
|
return $Singleton->{errors}||0;
|
||
|
}
|
||
|
}
|
||
|
+*errors = \&report_error_count;
|
||
|
|
||
|
# Input: ($self, $_, @{ $self->{line} }) == unparsed input.
|
||
|
# Output: ($_, @{ $self->{line} }) == (rest of line, following lines).
|
||
|
@@ -1904,7 +1906,7 @@ sub generate_init {
|
||
|
|
||
|
my $inputmap = $typemaps->get_inputmap(xstype => $xstype);
|
||
|
if (not defined $inputmap) {
|
||
|
- $self->blurt("Error: No INPUT definition for type '$type', typekind '" . $type->xstype . "' found");
|
||
|
+ $self->blurt("Error: No INPUT definition for type '$type', typekind '$xstype' found");
|
||
|
return;
|
||
|
}
|
||
|
|
||
|
diff --git a/lib/ExtUtils/ParseXS/Constants.pm b/lib/ExtUtils/ParseXS/Constants.pm
|
||
|
index 2c392e3..d7668c4 100644
|
||
|
--- a/lib/ExtUtils/ParseXS/Constants.pm
|
||
|
+++ b/lib/ExtUtils/ParseXS/Constants.pm
|
||
|
@@ -3,7 +3,7 @@ use strict;
|
||
|
use warnings;
|
||
|
use Symbol;
|
||
|
|
||
|
-our $VERSION = '3.40';
|
||
|
+our $VERSION = '3.43';
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
diff --git a/lib/ExtUtils/ParseXS/CountLines.pm b/lib/ExtUtils/ParseXS/CountLines.pm
|
||
|
index a9258f9..c592621 100644
|
||
|
--- a/lib/ExtUtils/ParseXS/CountLines.pm
|
||
|
+++ b/lib/ExtUtils/ParseXS/CountLines.pm
|
||
|
@@ -1,7 +1,7 @@
|
||
|
package ExtUtils::ParseXS::CountLines;
|
||
|
use strict;
|
||
|
|
||
|
-our $VERSION = '3.40';
|
||
|
+our $VERSION = '3.43';
|
||
|
|
||
|
our $SECTION_END_MARKER;
|
||
|
|
||
|
diff --git a/lib/ExtUtils/ParseXS/Eval.pm b/lib/ExtUtils/ParseXS/Eval.pm
|
||
|
index 840bac7..c509531 100644
|
||
|
--- a/lib/ExtUtils/ParseXS/Eval.pm
|
||
|
+++ b/lib/ExtUtils/ParseXS/Eval.pm
|
||
|
@@ -2,7 +2,7 @@ package ExtUtils::ParseXS::Eval;
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
|
||
|
-our $VERSION = '3.40';
|
||
|
+our $VERSION = '3.43';
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
diff --git a/lib/ExtUtils/ParseXS/Utilities.pm b/lib/ExtUtils/ParseXS/Utilities.pm
|
||
|
index 58f3856..6cc8a0e 100644
|
||
|
--- a/lib/ExtUtils/ParseXS/Utilities.pm
|
||
|
+++ b/lib/ExtUtils/ParseXS/Utilities.pm
|
||
|
@@ -5,7 +5,7 @@ use Exporter;
|
||
|
use File::Spec;
|
||
|
use ExtUtils::ParseXS::Constants ();
|
||
|
|
||
|
-our $VERSION = '3.40';
|
||
|
+our $VERSION = '3.43';
|
||
|
|
||
|
our (@ISA, @EXPORT_OK);
|
||
|
@ISA = qw(Exporter);
|
||
|
diff --git a/lib/ExtUtils/Typemaps.pm b/lib/ExtUtils/Typemaps.pm
|
||
|
index a762322..62a2b1b 100644
|
||
|
--- a/lib/ExtUtils/Typemaps.pm
|
||
|
+++ b/lib/ExtUtils/Typemaps.pm
|
||
|
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps;
|
||
|
use 5.006001;
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
-our $VERSION = '3.38';
|
||
|
+our $VERSION = '3.43';
|
||
|
|
||
|
require ExtUtils::ParseXS;
|
||
|
require ExtUtils::ParseXS::Constants;
|
||
|
diff --git a/lib/ExtUtils/Typemaps/Cmd.pm b/lib/ExtUtils/Typemaps/Cmd.pm
|
||
|
index 3c33f54..5bddcc0 100644
|
||
|
--- a/lib/ExtUtils/Typemaps/Cmd.pm
|
||
|
+++ b/lib/ExtUtils/Typemaps/Cmd.pm
|
||
|
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::Cmd;
|
||
|
use 5.006001;
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
-our $VERSION = '3.38';
|
||
|
+our $VERSION = '3.43';
|
||
|
|
||
|
use ExtUtils::Typemaps;
|
||
|
|
||
|
diff --git a/lib/ExtUtils/Typemaps/InputMap.pm b/lib/ExtUtils/Typemaps/InputMap.pm
|
||
|
index bf19df1..fd2efc8 100644
|
||
|
--- a/lib/ExtUtils/Typemaps/InputMap.pm
|
||
|
+++ b/lib/ExtUtils/Typemaps/InputMap.pm
|
||
|
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::InputMap;
|
||
|
use 5.006001;
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
-our $VERSION = '3.38';
|
||
|
+our $VERSION = '3.43';
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
diff --git a/lib/ExtUtils/Typemaps/OutputMap.pm b/lib/ExtUtils/Typemaps/OutputMap.pm
|
||
|
index 90adb48..d4210c5 100644
|
||
|
--- a/lib/ExtUtils/Typemaps/OutputMap.pm
|
||
|
+++ b/lib/ExtUtils/Typemaps/OutputMap.pm
|
||
|
@@ -2,7 +2,7 @@ package ExtUtils::Typemaps::OutputMap;
|
||
|
use 5.006001;
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
-our $VERSION = '3.38';
|
||
|
+our $VERSION = '3.43';
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
diff --git a/lib/ExtUtils/Typemaps/Type.pm b/lib/ExtUtils/Typemaps/Type.pm
|
||
|
index 01bd51d..36d5753 100644
|
||
|
--- a/lib/ExtUtils/Typemaps/Type.pm
|
||
|
+++ b/lib/ExtUtils/Typemaps/Type.pm
|
||
|
@@ -4,7 +4,7 @@ use strict;
|
||
|
use warnings;
|
||
|
require ExtUtils::Typemaps;
|
||
|
|
||
|
-our $VERSION = '3.38';
|
||
|
+our $VERSION = '3.43';
|
||
|
|
||
|
=head1 NAME
|
||
|
|
||
|
diff --git a/lib/perlxs.pod b/lib/perlxs.pod
|
||
|
index 1419ee0..5aa215b 100644
|
||
|
--- a/lib/perlxs.pod
|
||
|
+++ b/lib/perlxs.pod
|
||
|
@@ -79,6 +79,11 @@ Note: For some extensions, Dave Beazley's SWIG system may provide a
|
||
|
significantly more convenient mechanism for creating the extension
|
||
|
glue code. See L<http://www.swig.org/> for more information.
|
||
|
|
||
|
+For simple bindings to C libraries as well as other machine code libraries,
|
||
|
+consider instead using the much simpler
|
||
|
+L<libffi|http://sourceware.org/libffi/> interface via CPAN modules like
|
||
|
+L<FFI::Platypus> or L<FFI::Raw>.
|
||
|
+
|
||
|
=head2 On The Road
|
||
|
|
||
|
Many of the examples which follow will concentrate on creating an interface
|
||
|
@@ -598,7 +603,7 @@ and C<$type> can be used as in typemaps.
|
||
|
|
||
|
bool_t
|
||
|
rpcb_gettime(host,timep)
|
||
|
- char *host = (char *)SvPV_nolen($arg);
|
||
|
+ char *host = (char *)SvPVbyte_nolen($arg);
|
||
|
time_t &timep = 0;
|
||
|
OUTPUT:
|
||
|
timep
|
||
|
@@ -625,7 +630,7 @@ Here's a truly obscure example:
|
||
|
bool_t
|
||
|
rpcb_gettime(host,timep)
|
||
|
time_t &timep; /* \$v{timep}=@{[$v{timep}=$arg]} */
|
||
|
- char *host + SvOK($v{timep}) ? SvPV_nolen($arg) : NULL;
|
||
|
+ char *host + SvOK($v{timep}) ? SvPVbyte_nolen($arg) : NULL;
|
||
|
OUTPUT:
|
||
|
timep
|
||
|
|
||
|
@@ -988,7 +993,7 @@ The XS code, with ellipsis, follows.
|
||
|
char *host = "localhost";
|
||
|
CODE:
|
||
|
if( items > 1 )
|
||
|
- host = (char *)SvPV_nolen(ST(1));
|
||
|
+ host = (char *)SvPVbyte_nolen(ST(1));
|
||
|
RETVAL = rpcb_gettime( host, &timep );
|
||
|
OUTPUT:
|
||
|
timep
|
||
|
@@ -1289,7 +1294,7 @@ prototypes.
|
||
|
char *host = "localhost";
|
||
|
CODE:
|
||
|
if( items > 1 )
|
||
|
- host = (char *)SvPV_nolen(ST(1));
|
||
|
+ host = (char *)SvPVbyte_nolen(ST(1));
|
||
|
RETVAL = rpcb_gettime( host, &timep );
|
||
|
OUTPUT:
|
||
|
timep
|
||
|
@@ -1743,8 +1748,8 @@ example.
|
||
|
if( sv_isobject($arg) && (SvTYPE(SvRV($arg)) == SVt_PVMG) )
|
||
|
$var = ($type)SvIV((SV*)SvRV( $arg ));
|
||
|
else{
|
||
|
- warn("${Package}::$func_name() -- " .
|
||
|
- "$var is not a blessed SV reference");
|
||
|
+ warn(\"${Package}::$func_name() -- \"
|
||
|
+ \"$var is not a blessed SV reference\");
|
||
|
XSRETURN_UNDEF;
|
||
|
}
|
||
|
|
||
|
@@ -1980,6 +1985,8 @@ all the data that needs to be interpreter-local.
|
||
|
Always place the START_MY_CXT macro directly after the declaration
|
||
|
of C<my_cxt_t>.
|
||
|
|
||
|
+=for apidoc Amnh||START_MY_CXT
|
||
|
+
|
||
|
=item MY_CXT_INIT
|
||
|
|
||
|
The MY_CXT_INIT macro initializes storage for the C<my_cxt_t> struct.
|
||
|
@@ -1989,11 +1996,15 @@ are maintaining multiple interpreters, it should be called once in each
|
||
|
interpreter instance, except for interpreters cloned from existing ones.
|
||
|
(But see L</MY_CXT_CLONE> below.)
|
||
|
|
||
|
+=for apidoc Amnh||MY_CXT_INIT
|
||
|
+
|
||
|
=item dMY_CXT
|
||
|
|
||
|
Use the dMY_CXT macro (a declaration) in all the functions that access
|
||
|
MY_CXT.
|
||
|
|
||
|
+=for apidoc Amnh||dMY_CXT
|
||
|
+
|
||
|
=item MY_CXT
|
||
|
|
||
|
Use the MY_CXT macro to access members of the C<my_cxt_t> struct. For
|
||
|
@@ -2014,6 +2025,14 @@ C<dMY_CXT> may be quite expensive to calculate, and to avoid the overhead
|
||
|
of invoking it in each function it is possible to pass the declaration
|
||
|
onto other functions using the C<aMY_CXT>/C<pMY_CXT> macros, eg
|
||
|
|
||
|
+=for apidoc Amnh||_aMY_CXT
|
||
|
+=for apidoc Amnh||aMY_CXT
|
||
|
+=for apidoc Amnh||aMY_CXT_
|
||
|
+=for apidoc Amnh||_pMY_CXT
|
||
|
+=for apidoc Amnh||pMY_CXT
|
||
|
+=for apidoc Amnh||pMY_CXT_
|
||
|
+=for apidoc Amnh||MY_CXT
|
||
|
+
|
||
|
void sub1() {
|
||
|
dMY_CXT;
|
||
|
MY_CXT.index = 1;
|
||
|
@@ -2036,6 +2055,8 @@ my_cxt_t structure. Calling C<MY_CXT_CLONE> (typically via the package's
|
||
|
C<CLONE()> function), causes a byte-for-byte copy of the structure to be
|
||
|
taken, and any future dMY_CXT will cause the copy to be accessed instead.
|
||
|
|
||
|
+=for apidoc Amnh||MY_CXT_CLONE
|
||
|
+
|
||
|
=item MY_CXT_INIT_INTERP(my_perl)
|
||
|
|
||
|
=item dMY_CXT_INTERP(my_perl)
|
||
|
@@ -2082,7 +2103,8 @@ File C<RPC.xs>: Interface to some ONC+ RPC bind library functions.
|
||
|
#include "perl.h"
|
||
|
#include "XSUB.h"
|
||
|
|
||
|
- #include <rpc/rpc.h>
|
||
|
+ /* Note: On glibc 2.13 and earlier, this needs be <rpc/rpc.h> */
|
||
|
+ #include <tirpc/rpc.h>
|
||
|
|
||
|
typedef struct netconfig Netconfig;
|
||
|
|
||
|
@@ -2142,6 +2164,8 @@ File C<rpctest.pl>: Perl test program for the RPC extension.
|
||
|
print "time = $a\n";
|
||
|
print "netconf = $netconf\n";
|
||
|
|
||
|
+In Makefile.PL add -ltirpc and -I/usr/include/tirpc.
|
||
|
+
|
||
|
=head1 CAVEATS
|
||
|
|
||
|
XS code has full access to system calls including C library functions.
|
||
|
@@ -2252,7 +2276,7 @@ per-thread locales. Perl makes this transparent to perl-space code. It
|
||
|
continues to use C<POSIX::setlocale()>, and the interpreter translates
|
||
|
that into the per-thread functions.
|
||
|
|
||
|
-All other locale-senstive functions automatically use the per-thread
|
||
|
+All other locale-sensitive functions automatically use the per-thread
|
||
|
locale, if that is turned on, and failing that, the global locale. Thus
|
||
|
calls to C<setlocale> are ineffective on POSIX systems for the current
|
||
|
thread if that thread is using a per-thread locale. If perl is compiled
|
||
|
diff --git a/lib/perlxstut.pod b/lib/perlxstut.pod
|
||
|
index ef154ad..fcafa58 100644
|
||
|
--- a/lib/perlxstut.pod
|
||
|
+++ b/lib/perlxstut.pod
|
||
|
@@ -115,14 +115,15 @@ Mytest directory.
|
||
|
The file Makefile.PL should look something like this:
|
||
|
|
||
|
use ExtUtils::MakeMaker;
|
||
|
+
|
||
|
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||
|
# the contents of the Makefile that is written.
|
||
|
WriteMakefile(
|
||
|
- NAME => 'Mytest',
|
||
|
- VERSION_FROM => 'Mytest.pm', # finds $VERSION
|
||
|
- LIBS => [''], # e.g., '-lm'
|
||
|
- DEFINE => '', # e.g., '-DHAVE_SOMETHING'
|
||
|
- INC => '', # e.g., '-I/usr/include/other'
|
||
|
+ NAME => 'Mytest',
|
||
|
+ VERSION_FROM => 'Mytest.pm', # finds $VERSION
|
||
|
+ LIBS => [''], # e.g., '-lm'
|
||
|
+ DEFINE => '', # e.g., '-DHAVE_SOMETHING'
|
||
|
+ INC => '-I', # e.g., '-I. -I/usr/include/other'
|
||
|
);
|
||
|
|
||
|
The file Mytest.pm should start with something like this:
|
||
|
@@ -276,9 +277,9 @@ when the test is correct, "not ok" when it is not.
|
||
|
# so read its man page ( perldoc Test::More ) for help writing this
|
||
|
# test script.
|
||
|
|
||
|
- is(&Mytest::is_even(0), 1);
|
||
|
- is(&Mytest::is_even(1), 0);
|
||
|
- is(&Mytest::is_even(2), 1);
|
||
|
+ is( Mytest::is_even(0), 1 );
|
||
|
+ is( Mytest::is_even(1), 0 );
|
||
|
+ is( Mytest::is_even(2), 1 );
|
||
|
|
||
|
We will be calling the test script through the command "C<make test>". You
|
||
|
should see output that looks something like this:
|
||
|
@@ -390,16 +391,32 @@ Add the following to the end of Mytest.xs:
|
||
|
|
||
|
Edit the Makefile.PL file so that the corresponding line looks like this:
|
||
|
|
||
|
- 'LIBS' => ['-lm'], # e.g., '-lm'
|
||
|
+ LIBS => ['-lm'], # e.g., '-lm'
|
||
|
|
||
|
Generate the Makefile and run make. Change the test number in Mytest.t to
|
||
|
"9" and add the following tests:
|
||
|
|
||
|
- $i = -1.5; &Mytest::round($i); is( $i, -2.0 );
|
||
|
- $i = -1.1; &Mytest::round($i); is( $i, -1.0 );
|
||
|
- $i = 0.0; &Mytest::round($i); is( $i, 0.0 );
|
||
|
- $i = 0.5; &Mytest::round($i); is( $i, 1.0 );
|
||
|
- $i = 1.2; &Mytest::round($i); is( $i, 1.0 );
|
||
|
+ my $i;
|
||
|
+
|
||
|
+ $i = -1.5;
|
||
|
+ Mytest::round($i);
|
||
|
+ is( $i, -2.0, 'Rounding -1.5 to -2.0' );
|
||
|
+
|
||
|
+ $i = -1.1;
|
||
|
+ Mytest::round($i);
|
||
|
+ is( $i, -1.0, 'Rounding -1.1 to -1.0' );
|
||
|
+
|
||
|
+ $i = 0.0;
|
||
|
+ Mytest::round($i);
|
||
|
+ is( $i, 0.0, 'Rounding 0.0 to 0.0' );
|
||
|
+
|
||
|
+ $i = 0.5;
|
||
|
+ Mytest::round($i);
|
||
|
+ is( $i, 1.0, 'Rounding 0.5 to 1.0' );
|
||
|
+
|
||
|
+ $i = 1.2;
|
||
|
+ Mytest::round($i);
|
||
|
+ is( $i, 1.0, 'Rounding 1.2 to 1.0' );
|
||
|
|
||
|
Running "C<make test>" should now print out that all nine tests are okay.
|
||
|
|
||
|
@@ -407,7 +424,7 @@ Notice that in these new test cases, the argument passed to round was a
|
||
|
scalar variable. You might be wondering if you can round a constant or
|
||
|
literal. To see what happens, temporarily add the following line to Mytest.t:
|
||
|
|
||
|
- &Mytest::round(3);
|
||
|
+ Mytest::round(3);
|
||
|
|
||
|
Run "C<make test>" and notice that Perl dies with a fatal error. Perl won't
|
||
|
let you change the value of constants!
|
||
|
@@ -534,7 +551,7 @@ In the mylib directory, create a file mylib.h that looks like this:
|
||
|
Also create a file mylib.c that looks like this:
|
||
|
|
||
|
#include <stdlib.h>
|
||
|
- #include "./mylib.h"
|
||
|
+ #include "mylib.h"
|
||
|
|
||
|
double
|
||
|
foo(int a, long b, const char *c)
|
||
|
@@ -547,9 +564,9 @@ And finally create a file Makefile.PL that looks like this:
|
||
|
use ExtUtils::MakeMaker;
|
||
|
$Verbose = 1;
|
||
|
WriteMakefile(
|
||
|
- NAME => 'Mytest2::mylib',
|
||
|
- SKIP => [qw(all static static_lib dynamic dynamic_lib)],
|
||
|
- clean => {'FILES' => 'libmylib$(LIB_EXT)'},
|
||
|
+ NAME => 'Mytest2::mylib',
|
||
|
+ SKIP => [qw(all static static_lib dynamic dynamic_lib)],
|
||
|
+ clean => {'FILES' => 'libmylib$(LIB_EXT)'},
|
||
|
);
|
||
|
|
||
|
|
||
|
@@ -576,7 +593,7 @@ on Win32 systems.
|
||
|
We will now create the main top-level Mytest2 files. Change to the directory
|
||
|
above Mytest2 and run the following command:
|
||
|
|
||
|
- % h2xs -O -n Mytest2 ./Mytest2/mylib/mylib.h
|
||
|
+ % h2xs -O -n Mytest2 Mytest2/mylib/mylib.h
|
||
|
|
||
|
This will print out a warning about overwriting Mytest2, but that's okay.
|
||
|
Our files are stored in Mytest2/mylib, and will be untouched.
|
||
|
@@ -587,12 +604,12 @@ will be generating a library in it. Let's add the argument MYEXTLIB to
|
||
|
the WriteMakefile call so that it looks like this:
|
||
|
|
||
|
WriteMakefile(
|
||
|
- 'NAME' => 'Mytest2',
|
||
|
- 'VERSION_FROM' => 'Mytest2.pm', # finds $VERSION
|
||
|
- 'LIBS' => [''], # e.g., '-lm'
|
||
|
- 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
|
||
|
- 'INC' => '', # e.g., '-I/usr/include/other'
|
||
|
- 'MYEXTLIB' => 'mylib/libmylib$(LIB_EXT)',
|
||
|
+ NAME => 'Mytest2',
|
||
|
+ VERSION_FROM => 'Mytest2.pm', # finds $VERSION
|
||
|
+ LIBS => [''], # e.g., '-lm'
|
||
|
+ DEFINE => '', # e.g., '-DHAVE_SOMETHING'
|
||
|
+ INC => '', # e.g., '-I/usr/include/other'
|
||
|
+ MYEXTLIB => 'mylib/libmylib$(LIB_EXT)',
|
||
|
);
|
||
|
|
||
|
and then at the end add a subroutine (which will override the pre-existing
|
||
|
@@ -606,9 +623,7 @@ with "cd"!
|
||
|
';
|
||
|
}
|
||
|
|
||
|
-Let's also fix the MANIFEST file so that it accurately reflects the contents
|
||
|
-of our extension. The single line that says "mylib" should be replaced by
|
||
|
-the following three lines:
|
||
|
+Let's also fix the MANIFEST file by appending the following three lines:
|
||
|
|
||
|
mylib/Makefile.PL
|
||
|
mylib/mylib.c
|
||
|
@@ -642,12 +657,12 @@ Now run perl on the top-level Makefile.PL. Notice that it also created a
|
||
|
Makefile in the mylib directory. Run make and watch that it does cd into
|
||
|
the mylib directory and run make in there as well.
|
||
|
|
||
|
-Now edit the Mytest2.t script and change the number of tests to "4",
|
||
|
+Now edit the Mytest2.t script and change the number of tests to "5",
|
||
|
and add the following lines to the end of the script:
|
||
|
|
||
|
- is( &Mytest2::foo(1, 2, "Hello, world!"), 7 );
|
||
|
- is( &Mytest2::foo(1, 2, "0.0"), 7 );
|
||
|
- ok( abs(&Mytest2::foo(0, 0, "-3.4") - 0.6) <= 0.01 );
|
||
|
+ is( Mytest2::foo( 1, 2, "Hello, world!" ), 7 );
|
||
|
+ is( Mytest2::foo( 1, 2, "0.0" ), 7 );
|
||
|
+ ok( abs( Mytest2::foo( 0, 0, "-3.4" ) - 0.6 ) <= 0.01 );
|
||
|
|
||
|
(When dealing with floating-point comparisons, it is best to not check for
|
||
|
equality, but rather that the difference between the expected and actual
|
||
|
@@ -707,7 +722,7 @@ commands to build it.
|
||
|
|
||
|
=head2 Anatomy of .xs file
|
||
|
|
||
|
-The .xs file of L<"EXAMPLE 4"> contained some new elements. To understand
|
||
|
+The .xs file of L</EXAMPLE 4> contained some new elements. To understand
|
||
|
the meaning of these elements, pay attention to the line which reads
|
||
|
|
||
|
MODULE = Mytest2 PACKAGE = Mytest2
|
||
|
@@ -737,7 +752,7 @@ somewhat of an exception rather than the rule.
|
||
|
|
||
|
=head2 Getting the fat out of XSUBs
|
||
|
|
||
|
-In L<"EXAMPLE 4"> the second part of .xs file contained the following
|
||
|
+In L</EXAMPLE 4> the second part of .xs file contained the following
|
||
|
description of an XSUB:
|
||
|
|
||
|
double
|
||
|
@@ -1017,9 +1032,12 @@ after the include of "XSUB.h":
|
||
|
Also add the following code segment to Mytest.t while incrementing the "9"
|
||
|
tests to "11":
|
||
|
|
||
|
- @a = &Mytest::statfs("/blech");
|
||
|
+ my @a;
|
||
|
+
|
||
|
+ @a = Mytest::statfs("/blech");
|
||
|
ok( scalar(@a) == 1 && $a[0] == 2 );
|
||
|
- @a = &Mytest::statfs("/");
|
||
|
+
|
||
|
+ @a = Mytest::statfs("/");
|
||
|
is( scalar(@a), 7 );
|
||
|
|
||
|
=head2 New Things in this Example
|
||
|
@@ -1125,7 +1143,8 @@ Mytest.xs:
|
||
|
for (n = 0; n <= numpaths; n++) {
|
||
|
HV * rh;
|
||
|
STRLEN l;
|
||
|
- char * fn = SvPV(*av_fetch((AV *)SvRV(paths), n, 0), l);
|
||
|
+ SV * path = *av_fetch((AV *)SvRV(paths), n, 0);
|
||
|
+ char * fn = SvPVbyte(path, l);
|
||
|
|
||
|
i = statfs(fn, &buf);
|
||
|
if (i != 0) {
|
||
|
@@ -1152,7 +1171,7 @@ Mytest.xs:
|
||
|
And add the following code to Mytest.t, while incrementing the "11"
|
||
|
tests to "13":
|
||
|
|
||
|
- $results = Mytest::multi_statfs([ '/', '/blech' ]);
|
||
|
+ my $results = Mytest::multi_statfs([ '/', '/blech' ]);
|
||
|
ok( ref $results->[0] );
|
||
|
ok( ! ref $results->[1] );
|
||
|
|
||
|
@@ -1246,21 +1265,24 @@ typeglobs and stuff. Well, it isn't.
|
||
|
Suppose that for some strange reason we need a wrapper around the
|
||
|
standard C library function C<fputs()>. This is all we need:
|
||
|
|
||
|
- #define PERLIO_NOT_STDIO 0
|
||
|
- #define PERL_NO_GET_CONTEXT
|
||
|
- #include "EXTERN.h"
|
||
|
- #include "perl.h"
|
||
|
- #include "XSUB.h"
|
||
|
+ #define PERLIO_NOT_STDIO 0 /* For co-existence with stdio only */
|
||
|
+ #define PERL_NO_GET_CONTEXT /* This is more efficient */
|
||
|
+ #include "EXTERN.h"
|
||
|
+ #include "perl.h"
|
||
|
+ #include "XSUB.h"
|
||
|
|
||
|
- #include <stdio.h>
|
||
|
+ #include <stdio.h>
|
||
|
|
||
|
- int
|
||
|
- fputs(s, stream)
|
||
|
- char * s
|
||
|
- FILE * stream
|
||
|
+ int
|
||
|
+ fputs(s, stream)
|
||
|
+ char * s
|
||
|
+ FILE * stream
|
||
|
|
||
|
The real work is done in the standard typemap.
|
||
|
|
||
|
+For more details, see
|
||
|
+L<perlapio/"Co-existence with stdio">.
|
||
|
+
|
||
|
B<But> you lose all the fine stuff done by the perlio layers. This
|
||
|
calls the stdio function C<fputs()>, which knows nothing about them.
|
||
|
|
||
|
@@ -1382,7 +1404,7 @@ Some systems may have installed Perl version 5 as "perl5".
|
||
|
=head1 See also
|
||
|
|
||
|
For more information, consult L<perlguts>, L<perlapi>, L<perlxs>, L<perlmod>,
|
||
|
-and L<perlpod>.
|
||
|
+L<perlapio>, and L<perlpod>
|
||
|
|
||
|
=head1 Author
|
||
|
|
||
|
@@ -1396,6 +1418,8 @@ by Nick Ing-Simmons.
|
||
|
|
||
|
Changes for h2xs as of Perl 5.8.x by Renee Baecker
|
||
|
|
||
|
+This document is now maintained as part of Perl itself.
|
||
|
+
|
||
|
=head2 Last Changed
|
||
|
|
||
|
-2012-01-20
|
||
|
+2020-10-05
|
||
|
diff --git a/t/001-basic.t b/t/001-basic.t
|
||
|
index 04ba981..6651809 100644
|
||
|
--- a/t/001-basic.t
|
||
|
+++ b/t/001-basic.t
|
||
|
@@ -1,10 +1,12 @@
|
||
|
#!/usr/bin/perl
|
||
|
|
||
|
use strict;
|
||
|
-use Test::More tests => 17;
|
||
|
+use Test::More tests => 18;
|
||
|
use Config;
|
||
|
use DynaLoader;
|
||
|
use ExtUtils::CBuilder;
|
||
|
+use lib (-d 't' ? File::Spec->catdir(qw(t lib)) : 'lib');
|
||
|
+use PrimitiveCapture;
|
||
|
|
||
|
my ($source_file, $obj_file, $lib_file);
|
||
|
|
||
|
@@ -15,13 +17,14 @@ push @INC, '.';
|
||
|
|
||
|
use Carp; $SIG{__WARN__} = \&Carp::cluck;
|
||
|
|
||
|
-# Some trickery for Android. If we leave @INC as-is, it'll have '.' in it.
|
||
|
-# Later on, the 'require XSTest' end up in DynaLoader looking for
|
||
|
-# ./PL_XSTest.so, but unless our current directory happens to be in
|
||
|
-# LD_LIBRARY_PATH, Android's linker will never find the file, and the test
|
||
|
-# will fail. Instead, if we have all absolute paths, it'll just work.
|
||
|
-@INC = map { File::Spec->rel2abs($_) } @INC
|
||
|
- if $^O =~ /android/;
|
||
|
+# The linker on some platforms doesn't like loading libraries using relative
|
||
|
+# paths. Android won't find relative paths, and system perl on macOS will
|
||
|
+# refuse to load relative paths. The path that DynaLoader uses to load the
|
||
|
+# .so or .bundle file is based on the @INC path that the library is loaded
|
||
|
+# from. The XSTest module we're using for testing is in the current directory,
|
||
|
+# so we need an absolute path in @INC rather than '.'. Just convert all of the
|
||
|
+# paths to absolute for simplicity.
|
||
|
+@INC = map { File::Spec->rel2abs($_) } @INC;
|
||
|
|
||
|
#########################
|
||
|
|
||
|
@@ -177,6 +180,16 @@ unless ($ENV{PERL_NO_CLEANUP}) {
|
||
|
}
|
||
|
#####################################################################
|
||
|
|
||
|
+{ # third block: broken typemap
|
||
|
+my $pxs = ExtUtils::ParseXS->new;
|
||
|
+tie *FH, 'Foo';
|
||
|
+my $stderr = PrimitiveCapture::capture_stderr(sub {
|
||
|
+ $pxs->process_file(filename => 'XSBroken.xs', output => \*FH);
|
||
|
+});
|
||
|
+like $stderr, '/No INPUT definition/', "Exercise typemap error";
|
||
|
+}
|
||
|
+#####################################################################
|
||
|
+
|
||
|
sub Foo::TIEHANDLE { bless {}, 'Foo' }
|
||
|
sub Foo::PRINT { shift->{buf} .= join '', @_ }
|
||
|
sub Foo::content { shift->{buf} }
|
||
|
diff --git a/t/002-more.t b/t/002-more.t
|
||
|
index e982290..3ea89c2 100644
|
||
|
--- a/t/002-more.t
|
||
|
+++ b/t/002-more.t
|
||
|
@@ -22,8 +22,7 @@ push @INC, '.';
|
||
|
use Carp; $SIG{__WARN__} = \&Carp::cluck;
|
||
|
|
||
|
# See the comments about this in 001-basics.t
|
||
|
-@INC = map { File::Spec->rel2abs($_) } @INC
|
||
|
- if $^O =~ /android/;
|
||
|
+@INC = map { File::Spec->rel2abs($_) } @INC;
|
||
|
|
||
|
#########################
|
||
|
|
||
|
diff --git a/t/003-usage.t b/t/003-usage.t
|
||
|
index 00dfe0b..52b9903 100644
|
||
|
--- a/t/003-usage.t
|
||
|
+++ b/t/003-usage.t
|
||
|
@@ -23,8 +23,7 @@ push @INC, '.';
|
||
|
use Carp; $SIG{__WARN__} = \&Carp::cluck;
|
||
|
|
||
|
# See the comments about this in 001-basics.t
|
||
|
-@INC = map { File::Spec->rel2abs($_) } @INC
|
||
|
- if $^O =~ /android/;
|
||
|
+@INC = map { File::Spec->rel2abs($_) } @INC;
|
||
|
|
||
|
#########################
|
||
|
|
||
|
diff --git a/t/XSBroken.xs b/t/XSBroken.xs
|
||
|
new file mode 100644
|
||
|
index 0000000..7913838
|
||
|
--- /dev/null
|
||
|
+++ b/t/XSBroken.xs
|
||
|
@@ -0,0 +1,26 @@
|
||
|
+#include "EXTERN.h"
|
||
|
+#include "perl.h"
|
||
|
+#include "XSUB.h"
|
||
|
+
|
||
|
+typedef IV MyType3;
|
||
|
+
|
||
|
+MODULE = XSBroken PACKAGE = XSBroken
|
||
|
+
|
||
|
+PROTOTYPES: ENABLE
|
||
|
+
|
||
|
+
|
||
|
+TYPEMAP: <<'END'
|
||
|
+MyType3 T_BAAR
|
||
|
+
|
||
|
+OUTPUT
|
||
|
+T_BAAR
|
||
|
+ sv_setiv($arg, (IV)$var);
|
||
|
+END
|
||
|
+
|
||
|
+MyType3
|
||
|
+typemaptest3(foo)
|
||
|
+ MyType3 foo
|
||
|
+ CODE:
|
||
|
+ RETVAL = foo;
|
||
|
+ OUTPUT:
|
||
|
+ RETVAL
|
||
|
--
|
||
|
2.30.2
|
||
|
|