dslinux/user/perl/ext/Devel/PPPort Changes HACKERS MANIFEST MANIFEST.SKIP META.yml Makefile.PL PPPort.pm PPPort.xs PPPort_pm.PL PPPort_xs.PL README TODO apicheck_c.PL mktests.PL module2.c module3.c ppport_h.PL soak typemap
cayenne
dslinux_cayenne at user.in-berlin.de
Mon Dec 4 17:59:15 CET 2006
Update of /cvsroot/dslinux/dslinux/user/perl/ext/Devel/PPPort
In directory antilope:/tmp/cvs-serv17422/ext/Devel/PPPort
Added Files:
Changes HACKERS MANIFEST MANIFEST.SKIP META.yml Makefile.PL
PPPort.pm PPPort.xs PPPort_pm.PL PPPort_xs.PL README TODO
apicheck_c.PL mktests.PL module2.c module3.c ppport_h.PL soak
typemap
Log Message:
Adding fresh perl source to HEAD to branch from
--- NEW FILE: MANIFEST ---
apicheck_c.PL
Changes
devel/buildperl.pl
devel/mkapidoc.sh
devel/mktodo
devel/mktodo.pl
devel/scanprov
HACKERS
Makefile.PL
MANIFEST
MANIFEST.SKIP
META.yml
mktests.PL
module2.c
module3.c
parts/apicheck.pl
parts/apidoc.fnc
parts/base/5004000
parts/base/5004010
parts/base/5004020
parts/base/5004030
parts/base/5004040
parts/base/5004050
parts/base/5005000
parts/base/5005010
parts/base/5005020
parts/base/5005030
parts/base/5005040
parts/base/5006000
parts/base/5006001
parts/base/5006002
parts/base/5007000
parts/base/5007001
parts/base/5007002
parts/base/5007003
parts/base/5008000
parts/base/5008001
parts/base/5008002
parts/base/5008003
parts/base/5008004
parts/base/5008005
parts/base/5008006
parts/base/5009000
parts/base/5009001
parts/base/5009002
parts/embed.fnc
parts/inc/call
parts/inc/cop
parts/inc/exception
parts/inc/format
parts/inc/grok
parts/inc/limits
parts/inc/magic
parts/inc/misc
parts/inc/mPUSH
parts/inc/MY_CXT
parts/inc/newCONSTSUB
parts/inc/newRV
parts/inc/ppphbin
parts/inc/ppphdoc
parts/inc/ppphtest
parts/inc/sv_xpvf
parts/inc/SvPV
parts/inc/threads
parts/inc/uv
parts/inc/version
parts/ppptools.pl
parts/todo/5004000
parts/todo/5004010
parts/todo/5004020
parts/todo/5004030
parts/todo/5004040
parts/todo/5004050
parts/todo/5005000
parts/todo/5005010
parts/todo/5005020
parts/todo/5005030
parts/todo/5005040
parts/todo/5006000
parts/todo/5006001
parts/todo/5006002
parts/todo/5007000
parts/todo/5007001
parts/todo/5007002
parts/todo/5007003
parts/todo/5008000
parts/todo/5008001
parts/todo/5008002
parts/todo/5008003
parts/todo/5008004
parts/todo/5008005
parts/todo/5008006
parts/todo/5009000
parts/todo/5009001
parts/todo/5009002
PPPort.pm
PPPort.xs
ppport_h.PL
PPPort_pm.PL
PPPort_xs.PL
README
soak
t/call.t
t/cop.t
t/exception.t
t/grok.t
t/limits.t
t/magic.t
t/misc.t
t/mPUSH.t
t/MY_CXT.t
t/newCONSTSUB.t
t/newRV.t
t/ppphtest.t
t/sv_xpvf.t
t/SvPV.t
t/testutil.pl
t/threads.t
t/uv.t
TODO
typemap
--- NEW FILE: HACKERS ---
=head1 NAME
HACKERS - Devel::PPPort internals for hackers
=head1 SYNOPSIS
So you probably want to hack C<Devel::PPPort>?
Well, here's some information to get you started with what's
lying around in this distribution.
=head1 DESCRIPTION
=head2 How to build 98 versions of Perl
C<Devel::PPPort> supports Perl versions between 5.003 and bleadperl.
To guarantee this support, I need some of these versions on my
machine. I currently have 98 different Perl version/configuration
combinations installed on my laptop.
As many of the old Perl distributions need patching to compile
cleanly on newer systems (and because building 98 Perls by hand
just isn't fun), I wrote a tool to build all the different
versions and configurations. You can find it in F<devel/buildperl.pl>.
It can currently build the following Perl releases:
5.003
5.004 - 5.004_05
5.005 - 5.005_04
5.6.x
5.7.x
5.8.x
5.9.x
=head2 Fully automatic API checks
Knowing which parts of the API are not backwards compatible and
probably need C<Devel::PPPort> support is another problem that's
not easy to deal with manually. If you run
perl Makefile.PL --with-apicheck
a C file is generated by F<parts/apicheck.pl> that is compiled
and linked with C<Devel::PPPort>. This C file has the purpose of
using each of the public API functions/macros once.
The required information is derived from C<parts/embed.fnc> (just
a copy of bleadperl's C<embed.fnc>) and C<parts/apidoc.fnc> (which
is generated by F<devel/mkapidoc.sh> and simply collects the rest
of the apidoc entries spread over the Perl source code).
The generated C file C<apicheck.c> is currently about 500k in size
and takes quite a while to compile.
Usually, C<apicheck.c> won't compile with older perls. And even if
it compiles, there's still a good chance of the dynamic linker
failing at C<make test> time. But that's on purpose!
We can use these failures to find changes in the API automatically.
The two Perl scripts F<devel/mktodo> and F<devel/mktodo.pl>
repeatedly run C<Devel::PPPort> with the apicheck code through
all different versions of perl. Scanning the output of the compiler
and the dynamic linker for errors, the files in F<parts/todo/> are
generated. These files list all parts of the public API that don't
work with less than a certain version of Perl.
This information is in turn used by F<parts/apicheck.pl> to mask
API calls in the generated C file for these versions, so the
process can be stopped by the time F<apicheck.c> compiles cleanly
and the dynamic linker is happy. (Actually, this process generates
false positives, so each API call is checked once more afterwards.)
Running C<devel/mktodo> takes a couple of hours.
When running C<devel/mktodo> with the C<--base> option, it will
generate the I<baseline> todo files by disabling all functionality
provided by C<Devel::PPPort>. These are required for implementing
the C<--compat-version> option of the C<ppport.h> script. The
baseline todo files hold the information about which version of
Perl lacks a certain part of the API.
However, only the documented public API can be checked this way.
And since C<Devel::PPPort> provides more macros, these would not be
affected by C<--compat-version>. It's the job of F<devel/scanprov>
to figure out the baseline information for all remaining provided
macros by scanning the include files in the F<CORE> directory of
various Perl versions.
It's not very often that one has to regenerate the baseline and
todo files, and the process hasn't been automated yet, but it's
basically only the following steps:
=over 4
=item *
You need a whole bunch of different Perls. The more, the better.
You can use F<devel/buildperl.pl> to build them. I keep my perls
in F</tmp/perl>, so most of the tools take this as a default.
=item *
Remove all existing todo files in the F<parts/base> and
F<parts/todo> directories.
=item *
Update the API information. Copy the latest F<embed.fnc> file from
bleadperl to the F<parts> directory and run F<devel/mkapidoc.sh> to
collect the remaining information in F<parts/apidoc.fnc>.
=item *
Build the new baseline by running
perl devel/mktodo --base
in the root directory of the distribution. When it's finished,
move all files from the F<parts/todo> directory to F<parts/base>.
=item *
Build the new todo files by running
perl devel/mktodo
in the root directory of the distribution.
=item *
Finally, add the remaining baseline information by running
perl Makefile.PL && make
perl devel/scanprov write
=back
=head2 Implementation
Residing in F<parts/inc/> is the "heart" of C<Devel::PPPort>. Each
of the files implements a part of the supported API, along with
hints, dependency information, XS code and tests.
The files are in a POD-like format that is parsed using the
functions in F<parts/ppptools.pl>.
The scripts F<PPPort_pm.PL>, F<PPPort_xs.PL> and F<mktests.PL> all
use the information in F<parts/inc/> to generate the main module
F<PPPort.pm>, the XS code in F<PPPort.xs> and various test files
in F<t/>.
All of these files could be generated on the fly while building
C<Devel::PPPort>, but not having the tests in C<t/> and not having
F<PPPort.xs> will confuse Configure and TEST/harness in the core.
Not having F<PPPort.pm> will be bad for viewing the docs on
C<search.cpan.org>. So unfortunately, it's unavoidable to put
some redundancy into the package.
=head2 Adding stuff to Devel::PPPort
First, check if the code you plan to add fits into one of the
existing files in F<parts/inc/>. If not, just start a new one and
remember to include it from within F<PPPort_pm.PL>.
Each file holds all relevant data for implementing a certain part
of the API:
=over 2
=item *
A list of the provided API in the C<=provides> section.
=item *
The implementation to add to F<ppport.h> in the C<=implementation>
section.
=item *
The code required to add to PPPort.xs for testing the implementation.
This code goes into the C<=xshead>, C<=xsinit>, C<=xsmisc>, C<=xsboot>
and C<=xsubs> section. Have a look at the template in F<PPPort_xs.PL>
to see where the code ends up.
=item *
The tests in the C<=tests> section. Remember not to use any fancy
modules or syntax elements, as the test code should be able to run
with Perl 5.003, which, for example, doesn't support C<my> in
C<for>-loops:
for my $x (1, 2, 3) { } # won't work
You can use C<ok()> to report success or failure.
=back
It's usually the best approach to just copy an existing file and
use it as a template.
=head2 Testing
To automatically test C<Devel::PPPort> with lots of different Perl
versions, you can use the F<soak> script. Just pass it a list of
all Perl binaries you want to test.
=head2 Special Makefile targets
You can use
make regen
to regenerate all of the autogenerated files. To get rid of all
generated files (except for F<parts/todo/*> and F<parts/base/*>),
use
make purge_all
That's it.
=head1 COPYRIGHT
Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
Version 2.x, Copyright (C) 2001, Paul Marquess.
Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
See L<ppport.h>.
=cut
--- NEW FILE: Makefile.PL ---
################################################################################
#
# Makefile.PL -- generate Makefile
#
################################################################################
#
# $Revision: 1.1 $
# $Author: dslinux_cayenne $
# $Date: 2006-12-04 16:59:11 $
#
################################################################################
#
# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
# Version 2.x, Copyright (C) 2001, Paul Marquess.
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
use ExtUtils::MakeMaker;
require 5.003;
unless ($ENV{'PERL_CORE'}) {
$ENV{'PERL_CORE'} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV;
}
if ($ENV{'PERL_CORE'}) {
# Pods will be built by installman.
@coreopts = ( MAN3PODS => {} );
}
else {
# Devel::PPPort is in the core since 5.7.3
@coreopts = ( INSTALLDIRS => ($] >= 5.007003 ? 'perl' : 'site') );
}
@ARGV = map { /^--with-(.*)/ && ++$opt{$1} ? () : $_ } @ARGV;
%PL_FILES = ( 'ppport_h.PL' => 'ppport.h' ),
@C_FILES = qw{ module2.c module3.c };
@clean = qw{ $(H_FILES) PPPort.c };
if ($opt{'apicheck'}) {
$PL_FILES{'apicheck_c.PL'} = 'apicheck.c';
push @C_FILES, qw{ apicheck.c };
push @clean, qw{ apicheck.c };
}
WriteMakefile(
NAME => 'Devel::PPPort',
VERSION_FROM => 'PPPort_pm.PL',
PL_FILES => \%PL_FILES,
PM => { 'PPPort.pm' => '$(INST_LIBDIR)/PPPort.pm' },
C => \@C_FILES,
H => [ qw(ppport.h) ],
OBJECT => '$(BASEEXT)$(OBJ_EXT) $(O_FILES)',
XSPROTOARG => '-noprototypes',
clean => { FILES => "@clean" },
depend => { '$(OBJECT)' => '$(H_FILES)' },
@coreopts,
);
sub MY::postamble {
package MY;
my $post = shift->SUPER::postamble(@_);
$post .= <<'POSTAMBLE';
purge_all: realclean
@$(RM_F) PPPort.pm PPPort.xs t/*.t
regen:
$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) PPPort_pm.PL
$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) PPPort_xs.PL
$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) mktests.PL
$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) ppport_h.PL
POSTAMBLE
return $post;
}
--- NEW FILE: soak ---
#!/usr/bin/perl -w
################################################################################
#
# soak -- Test Perl modules with multiple Perl releases.
#
# Original Author: Paul Marquess
#
################################################################################
#
# $Revision: 1.1 $
# $Author: dslinux_cayenne $
# $Date: 2006-12-04 16:59:13 $
#
################################################################################
#
# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
# Version 2.x, Copyright (C) 2001, Paul Marquess.
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
require 5.006001;
use strict;
use warnings;
use ExtUtils::MakeMaker;
use Getopt::Long;
use Pod::Usage;
use List::Util qw(max);
use Config;
my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.06_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
$| = 1;
my $verbose = 0;
my $MAKE = $Config{make} || 'make';
my %OPT = (
verbose => 0,
make => $Config{make} || 'make',
);
GetOptions(\%OPT, qw(verbose make=s mmargs=s@)) or pod2usage(2);
$OPT{mmargs} = [''] unless exists $OPT{mmargs};
my @GoodPerls = @ARGV ? @ARGV : FindPerls();
my $maxlen = max(map length, @GoodPerls) + 3;
my $mmalen = max(map length, @{$OPT{mmargs}});
$maxlen += $mmalen+3 if $mmalen > 0;
# run each through the test harness
my(@good, @bad, $total);
# prime the pump, so the first "make realclean" will work.
runit("$^X Makefile.PL") && runit("$MAKE realclean")
or die "Cannot run $^X Makefile.PL && $MAKE realclean\n";
for my $perl (@GoodPerls) {
for my $mm (@{$OPT{mmargs}}) {
my $config = $mm =~ /\S+/ ? " ($mm)" : '';
my $prefix = $verbose ? "$perl$config -- " : '';
print "Testing $perl$config " . ('.' x ($maxlen - length($perl.$config)));
my $ok = runit("$perl Makefile.PL $mm") &&
# runit("$perl Makefile.PL --with-apicheck") &&
runit("$MAKE test");
$total++;
if ($ok) {
push @good, [$perl, $mm];
print "${prefix}ok\n";
}
else {
push @bad, [$perl, $mm];
print "${prefix}not ok\n";
}
runit("$MAKE realclean");
}
}
if ($verbose && @bad) {
print "\nFailed with:\n", map " $_\n", @bad;
}
print "\nPassed with ", scalar @good, " of $total versions/configurations.\n\n";
exit scalar @bad;
sub runit
{
# TODO -- portability alert!!
my $cmd = shift;
print "\n Running [$cmd]\n" if $verbose;
my $output = `$cmd 2>&1`;
$output = "\n" unless defined $output;
$output =~ s/^/ /gm;
print "\n Output\n$output\n" if $verbose || $?;
if ($?) {
warn " Running '$cmd' failed: $?\n";
return 0;
}
return 1;
}
sub FindPerls
{
# TODO -- need to decide how far back we go.
# TODO -- get list of user releases prior to 5.004
# TODO -- does not work on Windows (at least)
# find versions of Perl that are available
my @PerlBinaries = qw(
5.000
5.001
5.002
5.003
5.004 5.00401 5.00402 5.00403 5.00404 5.00405
5.005 5.00501 5.00502 5.00503 5.00504
5.6.0 5.6.1 5.6.2
5.7.0 5.7.1 5.7.2 5.7.3
5.8.0 5.8.1 5.8.2 5.8.3 5.8.4 5.8.5 5.8.6
5.9.0 5.9.1
);
print "Searching for Perl binaries...\n";
my $mm = MM->new( { NAME => 'dummy' });
my @path = $mm->path;
my @GoodPerls;
# find_perl will send a warning to STDOUT if it can't find
# the requested perl, so need to temporarily silence STDOUT.
tie *STDOUT, 'NoSTDOUT';
for my $perl (@PerlBinaries) {
if (my $abs = $mm->find_perl($perl, ["perl$perl"], \@path, 0)) {
push @GoodPerls, $abs;
}
}
untie *STDOUT;
print "\nFound:\n", (map " $_\n", @GoodPerls), "\n";
return @GoodPerls;
}
package NoSTDOUT;
use Tie::Handle;
our @ISA = qw(Tie::Handle);
sub TIEHANDLE { bless \(my $s = ''), shift }
sub PRINT {}
sub WRITE {}
__END__
=head1 NAME
soak - Test Perl modules with multiple Perl releases
=head1 SYNOPSIS
soak [options] [perl ...]
--make=program override name of make program ($Config{make})
--mmargs=options pass options to Makefile.PL (multiple --mmargs possible)
--verbose be verbose
=head1 COPYRIGHT
Version 3.x, Copyright (c) 2004-2005, Marcus Holland-Moritz.
Version 2.x, Copyright (C) 2001, Paul Marquess.
Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
See L<Devel::PPPort>.
=cut
--- NEW FILE: module3.c ---
/*******************************************************************************
*
* Perl/Pollution/Portability
*
********************************************************************************
*
* $Revision: 1.1 $
* $Author: dslinux_cayenne $
* $Date: 2006-12-04 16:59:13 $
*
********************************************************************************
*
* Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
* Version 2.x, Copyright (C) 2001, Paul Marquess.
* Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
*
* This program is free software; you can redistribute it and/or
* modify it under the same terms as Perl itself.
*
*******************************************************************************/
#include "EXTERN.h"
#include "perl.h"
#define NO_XSLOCKS
#include "XSUB.h"
#include "ppport.h"
static void throws_exception(int throw_e)
{
if (throw_e)
croak("boo\n");
}
int exception(int throw_e)
{
dTHR;
dXCPT;
SV *caught = get_sv("Devel::PPPort::exception_caught", 0);
XCPT_TRY_START {
throws_exception(throw_e);
} XCPT_TRY_END
XCPT_CATCH
{
sv_setiv(caught, 1);
XCPT_RETHROW;
}
sv_setiv(caught, 0);
return 42;
}
void call_newCONSTSUB_3(void)
{
newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_3", newSViv(3));
}
--- NEW FILE: mktests.PL ---
################################################################################
#
# mktests.PL -- generate test files for Devel::PPPort
#
################################################################################
#
# $Revision: 1.1 $
# $Author: dslinux_cayenne $
# $Date: 2006-12-04 16:59:11 $
#
################################################################################
#
# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
# Version 2.x, Copyright (C) 2001, Paul Marquess.
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
use strict;
$^W = 1;
require "parts/ppptools.pl";
my $template = do { local $/; <DATA> };
my $file;
for $file (glob 'parts/inc/*') {
my($testfile) = $file =~ /(\w+)$/;
$testfile = "t/$testfile.t";
my $spec = parse_partspec($file);
my $plan = 0;
if (exists $spec->{tests}) {
exists $spec->{OPTIONS}{tests} &&
exists $spec->{OPTIONS}{tests}{plan}
or die "No plan for tests in $file\n";
print "generating $testfile\n";
my $tmpl = $template;
$tmpl =~ s/__SOURCE__/$file/mg;
$tmpl =~ s/__PLAN__/$spec->{OPTIONS}{tests}{plan}/mg;
$tmpl =~ s/^__TESTS__$/$spec->{tests}/mg;
open FH, ">$testfile" or die "$testfile: $!\n";
print FH $tmpl;
close FH;
}
}
exit 0;
__DATA__
################################################################################
#
# !!!!! Do NOT edit this file directly! !!!!!
#
# Edit mktests.PL and/or __SOURCE__ instead.
#
################################################################################
BEGIN {
if ($ENV{'PERL_CORE'}) {
chdir 't' if -d 't';
@INC = ('../lib', '../ext/Devel/PPPort/t') if -d '../lib' && -d '../ext';
require Config; import Config;
use vars '%Config';
if (" $Config{'extensions'} " !~ m[ Devel/PPPort ]) {
print "1..0 # Skip -- Perl configured without Devel::PPPort module\n";
exit 0;
}
}
else {
unshift @INC, 't';
}
eval "use Test";
if ($@) {
require 'testutil.pl';
print "1..__PLAN__\n";
}
else {
plan(tests => __PLAN__);
}
}
use Devel::PPPort;
use strict;
$^W = 1;
__TESTS__
--- NEW FILE: META.yml ---
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Devel-PPPort
version: 3.06_01
version_from: PPPort_pm.PL
installdirs: perl
requires:
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.17
--- NEW FILE: PPPort_pm.PL ---
################################################################################
#
# PPPort_pm.PL -- generate PPPort.pm
#
################################################################################
#
# $Revision: 1.1 $
# $Author: dslinux_cayenne $
# $Date: 2006-12-04 16:59:11 $
#
################################################################################
#
# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
# Version 2.x, Copyright (C) 2001, Paul Marquess.
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
use strict;
$^W = 1;
require "parts/ppptools.pl";
my $INCLUDE = 'parts/inc';
my $DPPP = 'DPPP_';
my %embed = map { ( $_->{name} => $_ ) }
parse_embed(qw(parts/embed.fnc parts/apidoc.fnc));
my(%provides, %prototypes, %explicit);
my $data = do { local $/; <DATA> };
$data =~ s{^\%(include)\s+(\w+)((?:[^\S\r\n]+.*?)?)\s*$}
{eval "$1('$2', $3)" or die $@}gem;
$data = expand($data);
my @api = sort { lc $a cmp lc $b } keys %provides;
$data =~ s{^(.*)__PROVIDED_API__(\s*?)^}
{join '', map "$1$_\n", @api}gem;
{
my $len = 0;
for (keys %explicit) {
length > $len and $len = length;
}
my $format = sprintf '%%-%ds %%-%ds %%s', $len+2, $len+5;
$len = 3*$len + 23;
$data =~ s/^(.*)__EXPLICIT_API__(\s*?)^/
sprintf("$1$format\n", 'Function', 'Static Request', 'Global Request') .
$1 . '-'x$len . "\n" .
join('', map { sprintf "$1$format\n", "$_()", "NEED_$_", "NEED_${_}_GLOBAL" }
sort keys %explicit)
/gem;
}
my %raw_base = %{&parse_todo('parts/base')};
my %raw_todo = %{&parse_todo('parts/todo')};
my %todo;
for (keys %raw_todo) {
push @{$todo{$raw_todo{$_}}}, $_;
}
# check consistency
for (@api) {
if (exists $raw_todo{$_}) {
if ($raw_base{$_} eq $raw_todo{$_}) {
warn "$INCLUDE/$provides{$_} provides $_, which is still marked "
. "todo for " . format_version($raw_todo{$_}) . "\n";
}
else {
check(2, "$_ was ported back to " . format_version($raw_todo{$_}) .
" (baseline revision: " . format_version($raw_base{$_}) . ").");
}
}
}
my @perl_api;
for (keys %provides) {
next if exists $embed{$_};
push @perl_api, $_;
check(2, "No API definition for provided element $_ found.");
}
push @perl_api, keys %embed;
for (@perl_api) {
if (exists $provides{$_} && !exists $raw_base{$_}) {
check(2, "Mmmh, $_ doesn't seem to need backporting.");
}
my $line = "$_|" . (exists $provides{$_} && exists $raw_base{$_} ? $raw_base{$_} : '') . '|';
$line .= ($raw_todo{$_} || '') . '|';
$line .= 'p' if exists $provides{$_};
if (exists $embed{$_}) {
my $e = $embed{$_};
if (exists $e->{flags}{p}) {
my $args = $e->{args};
$line .= 'v' if @$args && $args->[-1][0] eq '...';
}
$line .= 'n' if exists $e->{flags}{n};
}
$_ = $line;
}
$data =~ s/^([\t ]*)__PERL_API__(\s*?)$/
join "\n", map "$1$_", sort @perl_api
/gem;
my @todo;
for (reverse sort keys %todo) {
my $ver = format_version($_);
my $todo = "=item perl $ver\n\n";
for (sort @{$todo{$_}}) {
$todo .= " $_\n";
}
push @todo, $todo;
}
$data =~ s{^__UNSUPPORTED_API__(\s*?)^}
{join "\n", @todo}gem;
$data =~ s{__MIN_PERL__}{5.003}g;
$data =~ s{__MAX_PERL__}{5.9.3}g;
open FH, ">PPPort.pm" or die "PPPort.pm: $!\n";
print FH $data;
close FH;
exit 0;
sub include
{
my($file, $opt) = @_;
print "including $file\n";
my $data = parse_partspec("$INCLUDE/$file");
for (@{$data->{provides}}) {
if (exists $provides{$_}) {
if ($provides{$_} ne $file) {
warn "$file: $_ already provided by $provides{$_}\n";
}
}
else {
$provides{$_} = $file;
}
}
for (keys %{$data->{prototypes}}) {
$prototypes{$_} = $data->{prototypes}{$_};
$data->{implementation} =~ s/^$_(?=\s*\()/$DPPP(my_$_)/mg;
}
my $out = $data->{implementation};
if (exists $opt->{indent}) {
$out =~ s/^/$opt->{indent}/gm;
}
return $out;
}
sub expand
{
my $code = shift;
$code =~ s{^(\s*#\s*(?:el)?if\s+)(.*)$}{$1.expand_pp_expressions($2)}gem;
$code =~ s{^\s*
__UNDEFINED__
\s+
(
( \w+ )
(?: \( [^)]* \) )?
)
[^\r\n\S]*
(
(?:[^\r\n\\]|\\[^\r\n])*
(?:
\\
(?:\r\n|[\r\n])
(?:[^\r\n\\]|\\[^\r\n])*
)*
)
\s*$}
{expand_undefined($2, $1, $3)}gemx;
return $code;
}
sub expand_undefined
{
my($macro, $withargs, $def) = @_;
my $rv = "#ifndef $macro\n# define ";
if (defined $def && $def =~ /\S/) {
$rv .= sprintf "%-30s %s", $withargs, $def;
}
else {
$rv .= $withargs;
}
$rv .= "\n#endif\n";
return $rv;
}
sub expand_pp_expressions
{
my $pp = shift;
$pp =~ s/\{([^\}]+)\}/expand_pp_expr($1)/ge;
return $pp;
}
sub expand_pp_expr
{
my $expr = shift;
if ($expr =~ /^\s*need\s*(\w+)\s*$/i) {
my $func = $1;
my $e = $embed{$func} or die "unknown API function '$func' in NEED\n";
my $proto = make_prototype($e);
if (exists $prototypes{$func}) {
if (compare_prototypes($proto, $prototypes{$func})) {
check(1, "differing prototypes for $func:\n API: $proto\n PPP: $prototypes{$func}");
$proto = $prototypes{$func};
}
}
else {
warn "found no prototype for $func\n";;
}
$explicit{$func} = 1;
$proto =~ s/\b$func(?=\s*\()/$DPPP(my_$func)/;
my $embed = make_embed($e);
return "defined(NEED_$func)\n"
. "static $proto;\n"
. "static\n"
. "#else\n"
. "extern $proto;\n"
. "#endif\n"
. "\n"
. "$embed\n"
. "\n"
. "#if defined(NEED_$func) || defined(NEED_${func}_GLOBAL)";
}
die "cannot expand preprocessor expression '$expr'\n";
}
sub make_embed
{
my $f = shift;
my $n = $f->{name};
my $a = do { my $x = 'a'; join ',', map { $x++ } 1 .. @{$f->{args}} };
if ($f->{flags}{n}) {
if ($f->{flags}{p}) {
return "#define $n $DPPP(my_$n)\n" .
"#define Perl_$n $DPPP(my_$n)";
}
else {
return "#define $n $DPPP(my_$n)";
}
}
else {
my $undef = <<UNDEF;
#ifdef $n
# undef $n
#endif
UNDEF
if ($f->{flags}{p}) {
if ($f->{flags}{f}) {
return "#define Perl_$n $DPPP(my_$n)";
}
else {
return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)\n" .
"#define Perl_$n $DPPP(my_$n)";
}
}
else {
return $undef . "#define $n($a) $DPPP(my_$n)(aTHX_ $a)";
}
}
}
sub check
{
my $level = shift;
if (exists $ENV{DPPP_CHECK_LEVEL} and $ENV{DPPP_CHECK_LEVEL} >= $level) {
print STDERR @_, "\n";
}
}
__DATA__
################################################################################
#
# !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
#
################################################################################
#
# Perl/Pollution/Portability
#
################################################################################
#
# $Revision: 1.1 $
# $Author: dslinux_cayenne $
# $Date: 2006-12-04 16:59:11 $
#
################################################################################
#
# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
# Version 2.x, Copyright (C) 2001, Paul Marquess.
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
=head1 NAME
Devel::PPPort - Perl/Pollution/Portability
=head1 SYNOPSIS
Devel::PPPort::WriteFile(); # defaults to ./ppport.h
Devel::PPPort::WriteFile('someheader.h');
=head1 DESCRIPTION
Perl's API has changed over time, gaining new features, new functions,
increasing its flexibility, and reducing the impact on the C namespace
environment (reduced pollution). The header file written by this module,
typically F<ppport.h>, attempts to bring some of the newer Perl API
features to older versions of Perl, so that you can worry less about
keeping track of old releases, but users can still reap the benefit.
C<Devel::PPPort> contains a single function, called C<WriteFile>. Its
only purpose is to write the F<ppport.h> C header file. This file
contains a series of macros and, if explicitly requested, functions that
allow XS modules to be built using older versions of Perl. Currently,
Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported.
This module is used by C<h2xs> to write the file F<ppport.h>.
=head2 Why use ppport.h?
You should use F<ppport.h> in modern code so that your code will work
with the widest range of Perl interpreters possible, without significant
additional work.
You should attempt older code to fully use F<ppport.h>, because the
reduced pollution of newer Perl versions is an important thing. It's so
important that the old polluting ways of original Perl modules will not be
supported very far into the future, and your module will almost certainly
break! By adapting to it now, you'll gain compatibility and a sense of
having done the electronic ecology some good.
=head2 How to use ppport.h
Don't direct the users of your module to download C<Devel::PPPort>.
They are most probably no XS writers. Also, don't make F<ppport.h>
optional. Rather, just take the most recent copy of F<ppport.h> that
you can find (e.g. by generating it with the latest C<Devel::PPPort>
release from CPAN), copy it into your project, adjust your project to
use it, and distribute the header along with your module.
=head2 Running ppport.h
But F<ppport.h> is more than just a C header. It's also a Perl script
that can check your source code. It will suggest hints and portability
notes, and can even make suggestions on how to change your code. You
can run it like any other Perl program:
perl ppport.h [options] [files]
It also has embedded documentation, so you can use
perldoc ppport.h
to find out more about how to use it.
=head1 FUNCTIONS
=head2 WriteFile
C<WriteFile> takes one optional argument. When called with one
argument, it expects to be passed a filename. When called with
no arguments, it defaults to the filename F<ppport.h>.
The function returns a true value if the file was written successfully.
Otherwise it returns a false value.
=head1 COMPATIBILITY
F<ppport.h> supports Perl versions from __MIN_PERL__ to __MAX_PERL__
in threaded and non-threaded configurations.
=head2 Provided Perl compatibility API
The header file written by this module, typically F<ppport.h>, provides
access to the following elements of the Perl API that is not available
in older Perl releases:
__PROVIDED_API__
=head2 Perl API not supported by ppport.h
There is still a big part of the API not supported by F<ppport.h>.
Either because it doesn't make sense to back-port that part of the API,
or simply because it hasn't been implemented yet. Patches welcome!
Here's a list of the currently unsupported API, and also the version of
Perl below which it is unsupported:
=over 4
__UNSUPPORTED_API__
=back
=head1 BUGS
If you find any bugs, C<Devel::PPPort> doesn't seem to build on your
system or any of its tests fail, please use the CPAN Request Tracker
at L<http://rt.cpan.org/> to create a ticket for the module.
=head1 AUTHORS
=over 2
=item *
Version 1.x of Devel::PPPort was written by Kenneth Albanowski.
=item *
Version 2.x was ported to the Perl core by Paul Marquess.
=item *
Version 3.x was ported back to CPAN by Marcus Holland-Moritz.
=back
=head1 COPYRIGHT
Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
Version 2.x, Copyright (C) 2001, Paul Marquess.
Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 SEE ALSO
See L<h2xs>, L<ppport.h>.
=cut
package Devel::PPPort;
require DynaLoader;
use strict;
use vars qw($VERSION @ISA $data);
$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.06_01 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
@ISA = qw(DynaLoader);
bootstrap Devel::PPPort;
sub _init_data
{
$data = do { local $/; <DATA> };
my $now = localtime;
my $pkg = 'Devel::PPPort';
$data =~ s/__PERL_VERSION__/$]/g;
$data =~ s/__VERSION__/$VERSION/g;
$data =~ s/__DATE__/$now/g;
$data =~ s/__PKG__/$pkg/g;
$data =~ s/^\|>//gm;
}
sub WriteFile
{
my $file = shift || 'ppport.h';
defined $data or _init_data();
my $copy = $data;
$copy =~ s/\bppport\.h\b/$file/g;
open F, ">$file" or return undef;
print F $copy;
close F;
return 1;
}
1;
__DATA__
#if 0
<<'SKIP';
#endif
/*
----------------------------------------------------------------------
ppport.h -- Perl/Pollution/Portability Version __VERSION__
Automatically created by __PKG__ running under
perl __PERL_VERSION__ on __DATE__.
Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
includes in parts/inc/ instead.
Use 'perldoc ppport.h' to view the documentation below.
----------------------------------------------------------------------
SKIP
%include ppphdoc { indent => '|>' }
%include ppphbin
__DATA__
*/
#ifndef _P_P_PORTABILITY_H_
#define _P_P_PORTABILITY_H_
#ifndef DPPP_NAMESPACE
# define DPPP_NAMESPACE DPPP_
#endif
#define DPPP_CAT2(x,y) CAT2(x,y)
#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
%include version
%include limits
%include uv
%include misc
%include threads
%include mPUSH
%include call
%include newRV
%include newCONSTSUB
%include MY_CXT
%include format
%include SvPV
%include sv_xpvf
%include magic
%include cop
%include grok
%include exception
#endif /* _P_P_PORTABILITY_H_ */
/* End of File ppport.h */
--- NEW FILE: apicheck_c.PL ---
################################################################################
#
# apicheck_c.PL -- generate apicheck.c
#
################################################################################
#
# $Revision: 1.1 $
# $Author: dslinux_cayenne $
# $Date: 2006-12-04 16:59:11 $
#
################################################################################
#
# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
# Version 2.x, Copyright (C) 2001, Paul Marquess.
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
$out = 'apicheck.c';
print "creating $out\n";
system $^X, 'parts/apicheck.pl', $out
and die "couldn't create $out\n";
--- NEW FILE: Changes ---
3.06_01 - 2005-06-25
* fix --compat-version argument checking
* filter files passed on the command line by default
to make sure 'perl ppport.h *' does something useful
* add --nofilter option to override the filtering
* testsuite now hopefully supports MacOS Classic
* check definedness of PERL_UNUSED_DECL
* update API info
3.06 - 2005-02-02
* fix cpan #11327: make fails with syntax error
* fix XCPT_* macros
3.05 - 2005-01-31
* fix a test for SvPV_nolen
* add more examples to tht documentation
* improve wording baseline information
* added support for the following API
dXCPT
dXSTARG
XCPT_CATCH
XCPT_RETHROW
XCPT_TRY_END
XCPT_TRY_START
3.04 - 2004-12-29
* fix a hint for sv_pvn_force
* fix VMS problem with unquoted command line arguments
not preserving case (perl change #23367)
* add --api-info switch for ppport.h
3.03 - 2004-09-08
* MY_CXT_CLONE was broken
3.02 - 2004-09-08
* added support for the following API:
END_EXTERN_C
EXTERN_C
MY_CXT_CLONE
PERL_GCC_BRACE_GROUPS_FORBIDDEN
START_EXTERN_C
STMT_END
STMT_START
3.01 - 2004-08-23
* patchlevel.h tweak
3.00_03 - 2004-08-20
* make sure the @INC path is kept up-to-date when changing
directories while running in the core test suite
3.00_02 - 2004-08-19
* remove PPPort.pm and PPPort.xs dependencies from Makefile.PL,
as they can be rebuilt with a "make regen" when neccessary
3.00_01 - 2004-08-17
* fixed problems with $^X in t/ppphtest.t when building in
the core on OpenBSD
* fixed a "duplicate dependencies" bug that could lead to
global NEED_'s where static NEED_'s are sufficient
* added support for the following API:
PL_DBsingle
PL_DBsub
PL_debstash
PL_diehook
PL_errgv
PL_no_modify
PL_perl_destruct_level
PL_ppaddr
PL_stack_sp
PL_sv_arenaroot
PL_tainted
PL_tainting
PUSHu
sv_catpvf_mg
sv_catpvf_mg_nocontext
sv_setpvf_mg
sv_setpvf_mg_nocontext
sv_vcatpvf
sv_vcatpvf_mg
sv_vsetpvf
sv_vsetpvf_mg
vnewSVpvf
XPUSHu
3.00 - 2004-08-16
* added support for dAX and dITEMS, which got lost while
working on the 3.00 internals
2.99_07 - 2004-08-13
* improve/check documentation
* add tests for CopFILE and CopSTASHPV
* add file headers
* some code cleanups
2.99_06 - 2004-08-11
* --compat-version now considers all macros/functions
provided by Devel::PPPort, not only the documented API
* fixed: PL_rsfp was PL_rsfpv
* turn __PPPORT_NAME__ back to ppport.h, because the former
looks ugly on search.cpan.org
2.99_05 - 2004-08-10
* --compat-version now also hides compatibility warnings for
unsupported API calls
2.99_04 - 2004-08-10
* added code to check for correct INSTALLDIRS
* added --compat-version option to ppport.h script to only
check for compatibility with at least the given Perl version
* some small adjustments
2.99_03 - 2004-08-09
* remove useless dependency from Makefile.PL (spotted by
Craig A. Berry)
* added checking for and replacement of C++ comments as
well as --cplusplus option to suppress it to ppport.h
script
* added more diagnostic output to ppport.h script
* added a hint for gv_stashpvn
* fixed the thread tests (spotted by Craig A. Berry)
* added more tests
* renamed and documented DPPP_NAMESPACE
* renamed some files
2.99_02 - 2004-08-08
* second beta
* feature complete for 3.00
* implemented missing functionality for ppport.h script:
- can now perform global (i.e. multi-file) NEED_ checks
- checks source for missing aTHX arguments
- checks source for unsupported API calls
- can now lists provided and unsupported API
- can use Text::Diff on platforms without diff utility
- can use custom diff utility / options
- can write one patch against the module
- can write single copies with changes applied
* updated the documentation for Devel::PPPort and ppport.h
* added lots of tests for the ppport.h script
* merged tests for call_* eval_* from XS::APItest
* added HACKERS file to document internals
* now includes PPPort.pm, so you can read the full docs
using search.cpan.org
2.99_01 - 2004-08-07
* first beta towards 3.00
* complete rework of internals
* autogenerated API-checks
* autogenerated .pm, .xs and .t files
* ppport.h changes:
- no static/global functions without explicit NEED_
- can now be run without -x
- now shows hints and dependencies
- now has POD documentation, so perldoc ppport.h works
- now has options
- now uses File::Find when available
* tested with multi-threaded (ithreads and 5.005-threads) perls
from 5.005 and single-threaded perls from 5.003 up to 5.9.x
* added support for the following API:
CopFILE
CopFILEAV
CopFILEGV
CopFILEGV_set
CopFILE_set
CopFILESV
CopSTASH
CopSTASH_eq
CopSTASHPV
CopSTASHPV_set
CopSTASH_set
CopyD
dUNDERBAR
IN_PERL_COMPILETIME
IV_MAX
IV_MIN
IVTYPE
memEQ
memNE
MoveD
mPUSHi
mPUSHn
mPUSHp
mPUSHu
mXPUSHi
mXPUSHn
mXPUSHp
mXPUSHu
newCONSTSUB
newSVuv
PERL_INT_MAX
PERL_INT_MIN
PERL_LONG_MAX
PERL_LONG_MIN
PERL_QUAD_MAX
PERL_QUAD_MIN
PERL_SHORT_MAX
PERL_SHORT_MIN
PERL_UCHAR_MAX
PERL_UCHAR_MIN
PERL_UINT_MAX
PERL_UINT_MIN
PERL_ULONG_MAX
PERL_ULONG_MIN
PERL_UQUAD_MAX
PERL_UQUAD_MIN
PERL_USHORT_MAX
PERL_USHORT_MIN
PL_hexdigit
PL_rsfp
Poison
PUSHmortal
sv_2pvbyte
sv_2pvbyte_nolen
sv_2pv_nolen
sv_2uv
sv_catpv_mg
sv_catpvn_mg
sv_catpvn_nomg
sv_catsv_mg
sv_catsv_nomg
SvGETMAGIC
SvIV_nomg
SvPV_force_nomg
sv_pvn
sv_pvn_force
sv_pvn_nomg
SvPV_nomg
sv_setiv_mg
sv_setnv_mg
sv_setpv_mg
sv_setpvn_mg
sv_setsv_mg
sv_setsv_nomg
sv_setuv
sv_setuv_mg
sv_usepvn_mg
sv_uv
SvUV
SvUV_nomg
SvUVx
SvUVX
SvUVXx
UNDERBAR
UV_MAX
UV_MIN
UVTYPE
XPUSHmortal
XSRETURN_UV
XST_mUV
ZeroD
2.008 - 20th October 2003
* eval_(pv|sv) added
* PERL_MAGIC_* added
2.007 - 18th September 2003
* small fix in grok_numeric_radix: variable was used uninitialized
2.006 - 8th September 2003
* call_(pv|sv|method|argv) added
* still compiler-warnings for grok_??? and 5.6.x, fixed
2.005 - 2nd September 2003
* Some tweaks to grok_(hex|oct|bin) to make compiler warnings
go away for older perls
* grok_number and grok_numeric_radix added
2.004 - 22th August 2003
* Added grok_(hex|oct|bin) and related constants
2.003 - 8th May 2003
* Added get_av, get_cv, get_hv and get_sv
2.002 - 2nd December 2001
* More portability issues in Makefile.PL addresed.
* Merged the Harness sub-module into Devel::PPPort
* More documentation in PPPort.pm
2.001
* Some portability issues in Makefile.PL addresed.
2.000
* Initial port to the perl core.
1.007
* Original version of the module by Kenneth Albanowski.
--- NEW FILE: ppport_h.PL ---
################################################################################
#
# ppport_h.PL -- generate ppport.h
#
################################################################################
#
# $Revision: 1.1 $
# $Author: dslinux_cayenne $
# $Date: 2006-12-04 16:59:13 $
#
################################################################################
#
# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
# Version 2.x, Copyright (C) 2001, Paul Marquess.
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
package Devel::PPPort;
sub bootstrap {};
require "PPPort.pm";
rename 'ppport.h', 'ppport.old' if -f 'ppport.h';
unlink "ppport.old" if WriteFile("ppport.h") && -f 'ppport.h';
--- NEW FILE: MANIFEST.SKIP ---
^Makefile$
~$
\.old(?:\..*)?$
\.swp$
\.o$
\.bs$
\.bak$
\.orig$
\.cache\.cm$
^blib
^pm_to_blib
^backup
^parts/todo-
^parts/base-
^ppport\.h$
^PPPort\.c$
Devel-PPPort.*\.tar\.gz$
--- NEW FILE: README ---
------------------------------------------------------
Devel::PPPort - Perl/Pollution/Portability Version 3
------------------------------------------------------
CONTENTS
1. DESCRIPTION
2. INSTALLATION
3. DOCUMENTATION
4. BUGS
5. COPYRIGHT
--------------
1. DESCRIPTION
--------------
Perl's API has changed over time, gaining new features, new functions,
increasing its flexibility, and reducing the impact on the C namespace
environment (reduced pollution). The header file written by this module,
typically F<ppport.h>, attempts to bring some of the newer Perl API
features to older versions of Perl, so that you can worry less about
keeping track of old releases, but users can still reap the benefit.
---------------
2. INSTALLATION
---------------
Installation of the Devel::PPPort module follows the standard Perl Way
and should not be harder than:
perl Makefile.PL
make
make test
make install
Note that you may need to become superuser to 'make install'.
If you're building the module under Windows, you may need to use a
different make program, such as 'nmake', instead of 'make'.
----------------
3. DOCUMENTATION
----------------
To see the documentation, use the perldoc command:
perldoc Devel::PPPort
You can also visit CPAN Search and see the documentation online as
pretty nice HTML. This is also where you will find the most recent
version of this module:
http://search.cpan.org/~mhx/Devel-PPPort/
-------
4. BUGS
-------
If you find any bugs, Devel::PPPort doesn't seem to build on your
system or any of its tests fail, please use the CPAN Request Tracker
http://rt.cpan.org/
to create a ticket for the module.
------------
5. COPYRIGHT
------------
Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
Version 2.x, Copyright (C) 2001, Paul Marquess.
Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
--- NEW FILE: PPPort.pm ---
################################################################################
#
# !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!!
#
################################################################################
#
# Perl/Pollution/Portability
#
################################################################################
#
# $Revision: 1.1 $
# $Author: dslinux_cayenne $
# $Date: 2006-12-04 16:59:11 $
#
################################################################################
#
# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
# Version 2.x, Copyright (C) 2001, Paul Marquess.
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
[...5853 lines suppressed...]
#ifdef NO_XSLOCKS
# ifdef dJMPENV
# define dXCPT dJMPENV; int rEtV = 0
# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
# define XCPT_TRY_END JMPENV_POP;
# define XCPT_CATCH if (rEtV != 0)
# define XCPT_RETHROW JMPENV_JUMP(rEtV)
# else
# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
# define XCPT_CATCH if (rEtV != 0)
# define XCPT_RETHROW Siglongjmp(top_env, rEtV)
# endif
#endif
#endif /* _P_P_PORTABILITY_H_ */
/* End of File ppport.h */
--- NEW FILE: module2.c ---
/*******************************************************************************
*
* Perl/Pollution/Portability
*
********************************************************************************
*
* $Revision: 1.1 $
* $Author: dslinux_cayenne $
* $Date: 2006-12-04 16:59:13 $
*
********************************************************************************
*
* Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
* Version 2.x, Copyright (C) 2001, Paul Marquess.
* Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
*
* This program is free software; you can redistribute it and/or
* modify it under the same terms as Perl itself.
*
*******************************************************************************/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifndef PATCHLEVEL
#include "patchlevel.h"
#endif
#define NEED_newCONSTSUB_GLOBAL
#include "ppport.h"
void call_newCONSTSUB_2(void)
{
newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_2", newSViv(2));
}
--- NEW FILE: PPPort_xs.PL ---
################################################################################
#
# PPPort_xs.PL -- generate PPPort.xs
#
################################################################################
#
# $Revision: 1.1 $
# $Author: dslinux_cayenne $
# $Date: 2006-12-04 16:59:11 $
#
################################################################################
#
# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
# Version 2.x, Copyright (C) 2001, Paul Marquess.
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
use strict;
$^W = 1;
require "parts/ppptools.pl";
my %SECTION = (
xshead => { code => '', header => "/* ---- from __FILE__ ---- */" },
xsinit => { code => '', header => "/* ---- from __FILE__ ---- */" },
xsmisc => { code => '', header => "/* ---- from __FILE__ ---- */" },
xsboot => { code => '', header => "/* ---- from __FILE__ ---- */", indent => "\t" },
xsubs => { code => '', header => "##".('-' x 70)."\n## XSUBs from __FILE__\n##".('-' x 70)."\n" },
);
if (exists $ENV{PERL_NO_GET_CONTEXT} && $ENV{PERL_NO_GET_CONTEXT}) {
$SECTION{xshead}{code} .= <<END;
#define PERL_NO_GET_CONTEXT
END
}
my $file;
my $sec;
for $file (glob 'parts/inc/*') {
my $spec = parse_partspec($file);
my $msg = 0;
for $sec (keys %SECTION) {
if (exists $spec->{$sec}) {
$msg++ or print "adding XS code from $file\n";
if (exists $SECTION{$sec}{header}) {
my $header = $SECTION{$sec}{header};
$header =~ s/__FILE__/$file/g;
$SECTION{$sec}{code} .= $header . "\n";
}
$SECTION{$sec}{code} .= $spec->{$sec} . "\n";
}
}
}
my $data = do { local $/; <DATA> };
for $sec (keys %SECTION) {
my $code = $SECTION{$sec}{code};
if (exists $SECTION{$sec}{indent}) {
$code =~ s/^/$SECTION{$sec}{indent}/gm;
}
$code =~ s/[\r\n]+$//;
$data =~ s/^__\U$sec\E__$/$code/m;
}
open FH, ">PPPort.xs" or die "PPPort.xs: $!\n";
print FH $data;
close FH;
exit 0;
__DATA__
/*******************************************************************************
*
* !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
*
********************************************************************************
*
* Perl/Pollution/Portability
*
********************************************************************************
*
* $Revision: 1.1 $
* $Author: dslinux_cayenne $
* $Date: 2006-12-04 16:59:11 $
*
********************************************************************************
*
* Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
* Version 2.x, Copyright (C) 2001, Paul Marquess.
* Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
*
* This program is free software; you can redistribute it and/or
* modify it under the same terms as Perl itself.
*
*******************************************************************************/
/* ========== BEGIN XSHEAD ================================================== */
__XSHEAD__
/* =========== END XSHEAD =================================================== */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
/* ========== BEGIN XSINIT ================================================== */
__XSINIT__
/* =========== END XSINIT =================================================== */
#include "ppport.h"
/* ========== BEGIN XSMISC ================================================== */
__XSMISC__
/* =========== END XSMISC =================================================== */
MODULE = Devel::PPPort PACKAGE = Devel::PPPort
BOOT:
__XSBOOT__
__XSUBS__
--- NEW FILE: TODO ---
TODO:
* improve apicheck (things like utf8_mg_pos_init() are
not currently checked)
* more documentation, more tests
* Resolve dependencies in Makefile.PL and remind of
running 'make regen'
--- NEW FILE: typemap ---
################################################################################
#
# typemap -- XS type mappings not present in early perls
#
################################################################################
#
# $Revision: 1.1 $
# $Author: dslinux_cayenne $
# $Date: 2006-12-04 16:59:13 $
#
################################################################################
#
# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
# Version 2.x, Copyright (C) 2001, Paul Marquess.
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
################################################################################
UV T_UV
NV T_NV
INPUT
T_UV
$var = ($type)SvUV($arg)
T_NV
$var = ($type)SvNV($arg)
OUTPUT
T_UV
sv_setuv($arg, (UV)$var);
T_NV
sv_setnv($arg, (NV)$var);
--- NEW FILE: PPPort.xs ---
/*******************************************************************************
*
* !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!!
*
********************************************************************************
*
* Perl/Pollution/Portability
*
********************************************************************************
*
* $Revision: 1.1 $
* $Author: dslinux_cayenne $
* $Date: 2006-12-04 16:59:11 $
*
********************************************************************************
*
* Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
* Version 2.x, Copyright (C) 2001, Paul Marquess.
* Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
*
* This program is free software; you can redistribute it and/or
* modify it under the same terms as Perl itself.
*
*******************************************************************************/
/* ========== BEGIN XSHEAD ================================================== */
/* =========== END XSHEAD =================================================== */
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
/* ========== BEGIN XSINIT ================================================== */
/* ---- from parts/inc/call ---- */
#define NEED_eval_pv
/* ---- from parts/inc/grok ---- */
#define NEED_grok_number
#define NEED_grok_numeric_radix
#define NEED_grok_bin
#define NEED_grok_hex
#define NEED_grok_oct
/* ---- from parts/inc/newCONSTSUB ---- */
#define NEED_newCONSTSUB
/* ---- from parts/inc/newRV ---- */
#define NEED_newRV_noinc
/* ---- from parts/inc/sv_xpvf ---- */
#define NEED_vnewSVpvf
#define NEED_sv_catpvf_mg
#define NEED_sv_catpvf_mg_nocontext
#define NEED_sv_setpvf_mg
#define NEED_sv_setpvf_mg_nocontext
/* ---- from parts/inc/SvPV ---- */
#define NEED_sv_2pv_nolen
#define NEED_sv_2pvbyte
/* =========== END XSINIT =================================================== */
#include "ppport.h"
/* ========== BEGIN XSMISC ================================================== */
/* ---- from parts/inc/exception ---- */
/* defined in module3.c */
int exception(int throw_e);
/* ---- from parts/inc/misc ---- */
XS(XS_Devel__PPPort_dXSTARG); /* prototype */
XS(XS_Devel__PPPort_dXSTARG)
{
dXSARGS;
dXSTARG;
IV iv;
SP -= items;
iv = SvIV(ST(0)) + 1;
PUSHi(iv);
XSRETURN(1);
}
/* ---- from parts/inc/MY_CXT ---- */
#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION
typedef struct {
/* Put Global Data in here */
int dummy;
} my_cxt_t;
START_MY_CXT
/* ---- from parts/inc/newCONSTSUB ---- */
void call_newCONSTSUB_1(void)
{
#ifdef PERL_NO_GET_CONTEXT
dTHX;
#endif
newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1));
}
extern void call_newCONSTSUB_2(void);
extern void call_newCONSTSUB_3(void);
/* ---- from parts/inc/sv_xpvf ---- */
static SV * test_vnewSVpvf(pTHX_ const char *pat, ...)
{
SV *sv;
va_list args;
va_start(args, pat);
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
sv = vnewSVpvf(pat, &args);
#else
sv = newSVpv(pat, 0);
#endif
va_end(args);
return sv;
}
static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
sv_vcatpvf(sv, pat, &args);
#else
sv_catpv(sv, pat);
#endif
va_end(args);
}
static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...)
{
va_list args;
va_start(args, pat);
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
sv_vsetpvf(sv, pat, &args);
#else
sv_setpv(sv, pat);
#endif
va_end(args);
}
/* =========== END XSMISC =================================================== */
MODULE = Devel::PPPort PACKAGE = Devel::PPPort
BOOT:
/* ---- from parts/inc/misc ---- */
newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file);
/* ---- from parts/inc/MY_CXT ---- */
{
MY_CXT_INIT;
/* If any of the fields in the my_cxt_t struct need
* to be initialised, do it here.
*/
MY_CXT.dummy = 42;
}
##----------------------------------------------------------------------
## XSUBs from parts/inc/call
##----------------------------------------------------------------------
I32
G_SCALAR()
CODE:
RETVAL = G_SCALAR;
OUTPUT:
RETVAL
I32
G_ARRAY()
CODE:
RETVAL = G_ARRAY;
OUTPUT:
RETVAL
I32
G_DISCARD()
CODE:
RETVAL = G_DISCARD;
OUTPUT:
RETVAL
void
eval_sv(sv, flags)
SV* sv
I32 flags
PREINIT:
I32 i;
PPCODE:
PUTBACK;
i = eval_sv(sv, flags);
SPAGAIN;
EXTEND(SP, 1);
PUSHs(sv_2mortal(newSViv(i)));
void
eval_pv(p, croak_on_error)
char* p
I32 croak_on_error
PPCODE:
PUTBACK;
EXTEND(SP, 1);
PUSHs(eval_pv(p, croak_on_error));
void
call_sv(sv, flags, ...)
SV* sv
I32 flags
PREINIT:
I32 i;
PPCODE:
for (i=0; i<items-2; i++)
ST(i) = ST(i+2); /* pop first two args */
PUSHMARK(SP);
SP += items - 2;
PUTBACK;
i = call_sv(sv, flags);
SPAGAIN;
EXTEND(SP, 1);
PUSHs(sv_2mortal(newSViv(i)));
void
call_pv(subname, flags, ...)
char* subname
I32 flags
PREINIT:
I32 i;
PPCODE:
for (i=0; i<items-2; i++)
ST(i) = ST(i+2); /* pop first two args */
PUSHMARK(SP);
SP += items - 2;
PUTBACK;
i = call_pv(subname, flags);
SPAGAIN;
EXTEND(SP, 1);
PUSHs(sv_2mortal(newSViv(i)));
void
call_argv(subname, flags, ...)
char* subname
I32 flags
PREINIT:
I32 i;
char *args[8];
PPCODE:
if (items > 8) /* play safe */
XSRETURN_UNDEF;
for (i=2; i<items; i++)
args[i-2] = SvPV_nolen(ST(i));
args[items-2] = NULL;
PUTBACK;
i = call_argv(subname, flags, args);
SPAGAIN;
EXTEND(SP, 1);
PUSHs(sv_2mortal(newSViv(i)));
void
call_method(methname, flags, ...)
char* methname
I32 flags
PREINIT:
I32 i;
PPCODE:
for (i=0; i<items-2; i++)
ST(i) = ST(i+2); /* pop first two args */
PUSHMARK(SP);
SP += items - 2;
PUTBACK;
i = call_method(methname, flags);
SPAGAIN;
EXTEND(SP, 1);
PUSHs(sv_2mortal(newSViv(i)));
##----------------------------------------------------------------------
## XSUBs from parts/inc/cop
##----------------------------------------------------------------------
char *
CopSTASHPV()
CODE:
RETVAL = CopSTASHPV(PL_curcop);
OUTPUT:
RETVAL
char *
CopFILE()
CODE:
RETVAL = CopFILE(PL_curcop);
OUTPUT:
RETVAL
##----------------------------------------------------------------------
## XSUBs from parts/inc/exception
##----------------------------------------------------------------------
int
exception(throw_e)
int throw_e
OUTPUT:
RETVAL
##----------------------------------------------------------------------
## XSUBs from parts/inc/grok
##----------------------------------------------------------------------
UV
grok_number(string)
SV *string
PREINIT:
const char *pv;
STRLEN len;
CODE:
pv = SvPV(string, len);
if (!grok_number(pv, len, &RETVAL))
XSRETURN_UNDEF;
OUTPUT:
RETVAL
UV
grok_bin(string)
SV *string
PREINIT:
char *pv;
I32 flags;
STRLEN len;
CODE:
pv = SvPV(string, len);
RETVAL = grok_bin(pv, &len, &flags, NULL);
OUTPUT:
RETVAL
UV
grok_hex(string)
SV *string
PREINIT:
char *pv;
I32 flags;
STRLEN len;
CODE:
pv = SvPV(string, len);
RETVAL = grok_hex(pv, &len, &flags, NULL);
OUTPUT:
RETVAL
UV
grok_oct(string)
SV *string
PREINIT:
char *pv;
I32 flags;
STRLEN len;
CODE:
pv = SvPV(string, len);
RETVAL = grok_oct(pv, &len, &flags, NULL);
OUTPUT:
RETVAL
UV
Perl_grok_number(string)
SV *string
PREINIT:
const char *pv;
STRLEN len;
CODE:
pv = SvPV(string, len);
if (!Perl_grok_number(aTHX_ pv, len, &RETVAL))
XSRETURN_UNDEF;
OUTPUT:
RETVAL
UV
Perl_grok_bin(string)
SV *string
PREINIT:
char *pv;
I32 flags;
STRLEN len;
CODE:
pv = SvPV(string, len);
RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL);
OUTPUT:
RETVAL
UV
Perl_grok_hex(string)
SV *string
PREINIT:
char *pv;
I32 flags;
STRLEN len;
CODE:
pv = SvPV(string, len);
RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL);
OUTPUT:
RETVAL
UV
Perl_grok_oct(string)
SV *string
PREINIT:
char *pv;
I32 flags;
STRLEN len;
CODE:
pv = SvPV(string, len);
RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL);
OUTPUT:
RETVAL
##----------------------------------------------------------------------
## XSUBs from parts/inc/limits
##----------------------------------------------------------------------
IV
iv_size()
CODE:
RETVAL = IVSIZE == sizeof(IV);
OUTPUT:
RETVAL
IV
uv_size()
CODE:
RETVAL = UVSIZE == sizeof(UV);
OUTPUT:
RETVAL
IV
iv_type()
CODE:
RETVAL = sizeof(IVTYPE) == sizeof(IV);
OUTPUT:
RETVAL
IV
uv_type()
CODE:
RETVAL = sizeof(UVTYPE) == sizeof(UV);
OUTPUT:
RETVAL
##----------------------------------------------------------------------
## XSUBs from parts/inc/magic
##----------------------------------------------------------------------
void
sv_catpv_mg(sv, string)
SV *sv;
char *string;
CODE:
sv_catpv_mg(sv, string);
void
sv_catpvn_mg(sv, sv2)
SV *sv;
SV *sv2;
PREINIT:
char *str;
STRLEN len;
CODE:
str = SvPV(sv2, len);
sv_catpvn_mg(sv, str, len);
void
sv_catsv_mg(sv, sv2)
SV *sv;
SV *sv2;
CODE:
sv_catsv_mg(sv, sv2);
void
sv_setiv_mg(sv, iv)
SV *sv;
IV iv;
CODE:
sv_setiv_mg(sv, iv);
void
sv_setnv_mg(sv, nv)
SV *sv;
NV nv;
CODE:
sv_setnv_mg(sv, nv);
void
sv_setpv_mg(sv, pv)
SV *sv;
char *pv;
CODE:
sv_setpv_mg(sv, pv);
void
sv_setpvn_mg(sv, sv2)
SV *sv;
SV *sv2;
PREINIT:
char *str;
STRLEN len;
CODE:
str = SvPV(sv2, len);
sv_setpvn_mg(sv, str, len);
void
sv_setsv_mg(sv, sv2)
SV *sv;
SV *sv2;
CODE:
sv_setsv_mg(sv, sv2);
void
sv_setuv_mg(sv, uv)
SV *sv;
UV uv;
CODE:
sv_setuv_mg(sv, uv);
void
sv_usepvn_mg(sv, sv2)
SV *sv;
SV *sv2;
PREINIT:
char *str, *copy;
STRLEN len;
CODE:
str = SvPV(sv2, len);
New(42, copy, len+1, char);
Copy(str, copy, len+1, char);
sv_usepvn_mg(sv, copy, len);
##----------------------------------------------------------------------
## XSUBs from parts/inc/misc
##----------------------------------------------------------------------
int
gv_stashpvn(name, create)
char *name
I32 create
CODE:
RETVAL = gv_stashpvn(name, strlen(name), create) != NULL;
OUTPUT:
RETVAL
int
get_sv(name, create)
char *name
I32 create
CODE:
RETVAL = get_sv(name, create) != NULL;
OUTPUT:
RETVAL
int
get_av(name, create)
char *name
I32 create
CODE:
RETVAL = get_av(name, create) != NULL;
OUTPUT:
RETVAL
int
get_hv(name, create)
char *name
I32 create
CODE:
RETVAL = get_hv(name, create) != NULL;
OUTPUT:
RETVAL
int
get_cv(name, create)
char *name
I32 create
CODE:
RETVAL = get_cv(name, create) != NULL;
OUTPUT:
RETVAL
void
newSVpvn()
PPCODE:
XPUSHs(newSVpvn("test", 4));
XPUSHs(newSVpvn("test", 2));
XPUSHs(newSVpvn("test", 0));
XPUSHs(newSVpvn(NULL, 2));
XPUSHs(newSVpvn(NULL, 0));
XSRETURN(5);
SV *
PL_sv_undef()
CODE:
RETVAL = newSVsv(&PL_sv_undef);
OUTPUT:
RETVAL
SV *
PL_sv_yes()
CODE:
RETVAL = newSVsv(&PL_sv_yes);
OUTPUT:
RETVAL
SV *
PL_sv_no()
CODE:
RETVAL = newSVsv(&PL_sv_no);
OUTPUT:
RETVAL
int
PL_na(string)
char *string
CODE:
PL_na = strlen(string);
RETVAL = PL_na;
OUTPUT:
RETVAL
SV*
boolSV(value)
int value
CODE:
RETVAL = newSVsv(boolSV(value));
OUTPUT:
RETVAL
SV*
DEFSV()
CODE:
RETVAL = newSVsv(DEFSV);
OUTPUT:
RETVAL
int
ERRSV()
CODE:
RETVAL = SvTRUE(ERRSV);
OUTPUT:
RETVAL
SV*
UNDERBAR()
CODE:
{
dUNDERBAR;
RETVAL = newSVsv(UNDERBAR);
}
OUTPUT:
RETVAL
##----------------------------------------------------------------------
## XSUBs from parts/inc/mPUSH
##----------------------------------------------------------------------
void
mPUSHp()
PPCODE:
EXTEND(SP, 3);
mPUSHp("one", 3);
mPUSHp("two", 3);
mPUSHp("three", 5);
XSRETURN(3);
void
mPUSHn()
PPCODE:
EXTEND(SP, 3);
mPUSHn(0.5);
mPUSHn(-0.25);
mPUSHn(0.125);
XSRETURN(3);
void
mPUSHi()
PPCODE:
EXTEND(SP, 3);
mPUSHi(-1);
mPUSHi(2);
mPUSHi(-3);
XSRETURN(3);
void
mPUSHu()
PPCODE:
EXTEND(SP, 3);
mPUSHu(1);
mPUSHu(2);
mPUSHu(3);
XSRETURN(3);
void
mXPUSHp()
PPCODE:
mXPUSHp("one", 3);
mXPUSHp("two", 3);
mXPUSHp("three", 5);
XSRETURN(3);
void
mXPUSHn()
PPCODE:
mXPUSHn(0.5);
mXPUSHn(-0.25);
mXPUSHn(0.125);
XSRETURN(3);
void
mXPUSHi()
PPCODE:
mXPUSHi(-1);
mXPUSHi(2);
mXPUSHi(-3);
XSRETURN(3);
void
mXPUSHu()
PPCODE:
mXPUSHu(1);
mXPUSHu(2);
mXPUSHu(3);
XSRETURN(3);
##----------------------------------------------------------------------
## XSUBs from parts/inc/MY_CXT
##----------------------------------------------------------------------
int
MY_CXT_1()
CODE:
dMY_CXT;
RETVAL = MY_CXT.dummy == 42;
++MY_CXT.dummy;
OUTPUT:
RETVAL
int
MY_CXT_2()
CODE:
dMY_CXT;
RETVAL = MY_CXT.dummy == 43;
OUTPUT:
RETVAL
int
MY_CXT_CLONE()
CODE:
MY_CXT_CLONE;
RETVAL = 42;
OUTPUT:
RETVAL
##----------------------------------------------------------------------
## XSUBs from parts/inc/newCONSTSUB
##----------------------------------------------------------------------
void
call_newCONSTSUB_1()
void
call_newCONSTSUB_2()
void
call_newCONSTSUB_3()
##----------------------------------------------------------------------
## XSUBs from parts/inc/newRV
##----------------------------------------------------------------------
U32
newRV_inc_REFCNT()
PREINIT:
SV *sv, *rv;
CODE:
sv = newSViv(42);
rv = newRV_inc(sv);
SvREFCNT_dec(sv);
RETVAL = SvREFCNT(sv);
sv_2mortal(rv);
OUTPUT:
RETVAL
U32
newRV_noinc_REFCNT()
PREINIT:
SV *sv, *rv;
CODE:
sv = newSViv(42);
rv = newRV_noinc(sv);
RETVAL = SvREFCNT(sv);
sv_2mortal(rv);
OUTPUT:
RETVAL
##----------------------------------------------------------------------
## XSUBs from parts/inc/sv_xpvf
##----------------------------------------------------------------------
SV *
vnewSVpvf()
CODE:
RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42);
OUTPUT:
RETVAL
SV *
sv_vcatpvf(sv)
SV *sv
CODE:
RETVAL = newSVsv(sv);
test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
OUTPUT:
RETVAL
SV *
sv_vsetpvf(sv)
SV *sv
CODE:
RETVAL = newSVsv(sv);
test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42);
OUTPUT:
RETVAL
void
sv_catpvf_mg(sv)
SV *sv
CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
sv_catpvf_mg(sv, "%s-%d", "Perl", 42);
#endif
void
Perl_sv_catpvf_mg(sv)
SV *sv
CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43);
#endif
void
sv_catpvf_mg_nocontext(sv)
SV *sv
CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
#ifdef PERL_IMPLICIT_CONTEXT
sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44);
#else
sv_catpvf_mg(sv, "%s-%d", "-Perl", 44);
#endif
#endif
void
sv_setpvf_mg(sv)
SV *sv
CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
sv_setpvf_mg(sv, "%s-%d", "mhx", 42);
#endif
void
Perl_sv_setpvf_mg(sv)
SV *sv
CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43);
#endif
void
sv_setpvf_mg_nocontext(sv)
SV *sv
CODE:
#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0)))
#ifdef PERL_IMPLICIT_CONTEXT
sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44);
#else
sv_setpvf_mg(sv, "%s-%d", "bar", 44);
#endif
#endif
##----------------------------------------------------------------------
## XSUBs from parts/inc/SvPV
##----------------------------------------------------------------------
IV
SvPVbyte(sv)
SV *sv
PREINIT:
STRLEN len;
const char *str;
CODE:
str = SvPVbyte(sv, len);
RETVAL = strEQ(str, "mhx") ? len : -1;
OUTPUT:
RETVAL
IV
SvPV_nolen(sv)
SV *sv
PREINIT:
const char *str;
CODE:
str = SvPV_nolen(sv);
RETVAL = strEQ(str, "mhx") ? 42 : 0;
OUTPUT:
RETVAL
##----------------------------------------------------------------------
## XSUBs from parts/inc/threads
##----------------------------------------------------------------------
IV
no_THX_arg(sv)
SV *sv
CODE:
RETVAL = 1 + sv_2iv(sv);
OUTPUT:
RETVAL
void
with_THX_arg(error)
char *error
PPCODE:
Perl_croak(aTHX_ "%s", error);
##----------------------------------------------------------------------
## XSUBs from parts/inc/uv
##----------------------------------------------------------------------
SV *
sv_setuv(uv)
UV uv
CODE:
RETVAL = newSViv(1);
sv_setuv(RETVAL, uv);
OUTPUT:
RETVAL
SV *
newSVuv(uv)
UV uv
CODE:
RETVAL = newSVuv(uv);
OUTPUT:
RETVAL
UV
sv_2uv(sv)
SV *sv
CODE:
RETVAL = sv_2uv(sv);
OUTPUT:
RETVAL
UV
SvUVx(sv)
SV *sv
CODE:
sv--;
RETVAL = SvUVx(++sv);
OUTPUT:
RETVAL
void
XSRETURN_UV()
PPCODE:
XSRETURN_UV(42);
void
PUSHu()
PREINIT:
dTARG;
PPCODE:
TARG = sv_newmortal();
EXTEND(SP, 1);
PUSHu(42);
XSRETURN(1);
void
XPUSHu()
PREINIT:
dTARG;
PPCODE:
TARG = sv_newmortal();
XPUSHu(43);
XSRETURN(1);
More information about the dslinux-commit
mailing list