diff options
Diffstat (limited to 'dist/Devel-PPPort')
369 files changed, 22477 insertions, 0 deletions
diff --git a/dist/Devel-PPPort/.gitignore b/dist/Devel-PPPort/.gitignore new file mode 100644 index 0000000000..032b772d08 --- /dev/null +++ b/dist/Devel-PPPort/.gitignore @@ -0,0 +1,5 @@ +/PPPort.pm +#ignored in /ext +#/ppport.h +/module*.c +/RealPPPort.xs diff --git a/dist/Devel-PPPort/HACKERS b/dist/Devel-PPPort/HACKERS new file mode 100644 index 0000000000..c5fe0ed47c --- /dev/null +++ b/dist/Devel-PPPort/HACKERS @@ -0,0 +1,325 @@ +=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 366 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 366 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 366 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 + 5.1x.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>), 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) and +C<parts/ppport.fnc> (which lists all API provided purely by +Devel::PPPort). +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 may generate +false positives, so by default each API call is checked once more +afterwards.) + +Running C<devel/mktodo> takes about an hour, depending of course +on the machine you're running it on. If you run it with +the C<--nocheck> option, it won't recheck the API calls that failed +in the compilation stage and it'll take significantly less time. +Running with C<--nocheck> should usually be safe. + +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. + +The whole process isn't platform independent. It has currently been +tested only under Linux, and it definitely requires at least C<gcc> and +the C<nm> utility. + +It's not very often that one has to regenerate the baseline and todo +files. If you have to, you can either run F<devel/regenerate> or just +execute the following steps by hand: + +=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 * + +You also need a freshly built bleadperl that is in the path under +exactly this name. (The name of the executable is currently hardcoded +in F<devel/mktodo> and F<devel/scanprov>.) + +=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 --mode=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<RealPPPort.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/> will confuse +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 at the bottom +of 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 with 5.003 + +You can use C<ok()> to report success or failure: + + ok($got == 42); + ok($got, $expected); + +Regular expressions are not supported as the second argument to C<ok>, +because older perls do not support the C<qr> operator. + +=back + +It's usually the best approach to just copy an existing file and +use it as a template. + +=head2 Implementation Hints + +In the C<=implementation> section, you can use + + __UNDEFINED__ macro some definition + +instead of + + #ifndef macro + # define macro some definition + #endif + +The macro can have optional arguments and the definition can even +span multiple lines, like in + + __UNDEFINED__ SvMAGIC_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ + (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END + +This usually makes the code more compact and readable. And you +only have to add C<__UNDEFINED__> to the C<=provided> section. + +Version checking can be tricky if you want to do it correct. +You can use + + #if { VERSION < 5.9.3 } + +instead of + + #if ((PERL_VERSION < 9) || (PERL_VERSION == 9 && PERL_SUBVERSION < 3)) + +The version number can be either of the new form C<5.x.x> or of the older +form C<5.00x_yy>. Both are translated into the correct preprocessor +statements. It is also possible to combine this with other statements: + + #if { VERSION >= 5.004 } && !defined(sv_vcatpvf) + /* a */ + #elif { VERSION < 5.004_63 } && { VERSION != 5.004_05 } + /* b */ + #endif + +This not only works in the C<=implementation> section, but also in +the C<=xsubs>, C<=xsinit>, C<=xsmisc>, C<=xshead> and C<=xsboot> sections. + +=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. + +=head2 Submitting Patches + +If you've added some functionality to C<Devel::PPPort>, please +consider submitting a patch with your work to GitHub here: +L<https://github.com/mhx/Devel-PPPort/issues/>, or by sending a +Pull Request. + +When submitting patches, please only add the relevant changes +and don't include the differences of the generated files. You +can use the C<purge_all> target to delete all autogenerated +files. + +=head2 Integrating into the Perl core + +When integrating this module into the Perl core, be sure to +remove the following files from the distribution. They are +either not needed or generated on the fly when building this +module in the core: + + MANIFEST + META.yml + PPPort.pm + +=head1 COPYRIGHT + +Version 3.x, Copyright (C) 2004-2013, 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> and L<devel/regenerate>. + +=cut diff --git a/dist/Devel-PPPort/Makefile.PL b/dist/Devel-PPPort/Makefile.PL new file mode 100644 index 0000000000..25e352e641 --- /dev/null +++ b/dist/Devel-PPPort/Makefile.PL @@ -0,0 +1,154 @@ +################################################################################ +# +# Makefile.PL -- generate Makefile +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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.003; + +use strict; +use ExtUtils::MakeMaker; + +use vars '%opt'; # needs to be global, and we can't use 'our' + +unless ($ENV{'PERL_CORE'}) { + $ENV{'PERL_CORE'} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV; +} + +@ARGV = map { /^--with-(apicheck)$/ && ++$opt{$1} ? () : $_ } @ARGV; + +WriteMakefile( + NAME => 'Devel::PPPort', + VERSION_FROM => 'PPPort_pm.PL', + PM => { 'PPPort.pm' => '$(INST_LIBDIR)/PPPort.pm' }, + H => [ qw(ppport.h) ], + OBJECT => 'RealPPPort$(OBJ_EXT) $(O_FILES)', + XSPROTOARG => '-noprototypes', + CONFIGURE => \&configure, + META_MERGE => { + 'meta-spec' => { + version => 2, + }, + resources => { + bugtracker => { + web => 'https://github.com/mhx/Devel-PPPort/issues/', + }, + repository => { + type => 'git', + url => 'git://github.com/mhx/Devel-PPPort.git', + web => 'https://github.com/mhx/Devel-PPPort/', + }, + }, + }, +); + +sub configure +{ + my @clean = qw{ $(H_FILES) RealPPPort.xs RealPPPort.c }; + my %depend = ('$(OBJECT)' => '$(H_FILES)'); + my @C_FILES = qw{ module2.c module3.c }, + my %PL_FILES = ( + 'ppport_h.PL' => 'ppport.h', + 'PPPort_pm.PL' => 'PPPort.pm', + 'PPPort_xs.PL' => 'RealPPPort.xs', + ); + my @moreopts; + + if (eval $ExtUtils::MakeMaker::VERSION >= 6) { + push @moreopts, AUTHOR => 'Marcus Holland-Moritz <mhx@cpan.org>'; + if (-f 'PPPort.pm') { + push @moreopts, ABSTRACT_FROM => 'PPPort.pm'; + } + } + + if (eval $ExtUtils::MakeMaker::VERSION >= 6.30_01) { + print "Setting license tag...\n"; + push @moreopts, LICENSE => 'perl'; + } + + if ($ENV{'PERL_CORE'}) { + # Pods will be built by installman. + push @clean, 'PPPort.pm'; + } + else { + # Devel::PPPort is in the core since 5.7.3 + # 5.11.0+ has site before perl + push @moreopts, INSTALLDIRS => ( + ($] >= 5.007003 and $] < 5.011) + ? 'perl' + : 'site' + ); + } + + if ($opt{'apicheck'}) { + $PL_FILES{'apicheck_c.PL'} = 'apicheck.c'; + push @C_FILES, qw{ apicheck.c }; + push @clean, qw{ apicheck.c apicheck.i }; + $depend{'apicheck.i'} = 'ppport.h'; + } + + return { + C => \@C_FILES, + XS => { 'RealPPPort.xs' => 'RealPPPort.c' }, + PL_FILES => \%PL_FILES, + depend => \%depend, + clean => { FILES => "@clean" }, + @moreopts, + }; +} + +sub MY::postamble +{ + package MY; + my $post = shift->SUPER::postamble(@_); + $post .= <<'POSTAMBLE'; + +purge_all: realclean + @$(RM_F) PPPort.pm t/*.t + +regen_pm: + $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) PPPort_pm.PL + +regen_xs: + $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) PPPort_xs.PL + +regen_tests: + $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) mktests.PL + +regen_h: + $(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) ppport_h.PL + +regen: regen_pm regen_xs regen_tests regen_h + +POSTAMBLE + return $post; +} + +sub MY::c_o +{ + package MY; + my $co = shift->SUPER::c_o(@_); + + if ($::opt{'apicheck'} && $co !~ /^\.c\.i:/m) { + print "Adding custom rule for preprocessed apicheck file...\n"; + + $co .= <<'CO' + +.SUFFIXES: .i + +.c.i: + $(CCCMD) -E -I$(PERL_INC) $(DEFINE) $*.c > $*.i +CO + } + + return $co; +} diff --git a/dist/Devel-PPPort/PPPort.xs b/dist/Devel-PPPort/PPPort.xs new file mode 100644 index 0000000000..2586824ebb --- /dev/null +++ b/dist/Devel-PPPort/PPPort.xs @@ -0,0 +1,3 @@ +This is just a dummy file to let Configure know that Devel::PPPort +is an XS module. The real XS code is autogenerated from PPPort_xs.PL +when this module is built and will go to RealPPPort.xs. diff --git a/dist/Devel-PPPort/PPPort_pm.PL b/dist/Devel-PPPort/PPPort_pm.PL new file mode 100644 index 0000000000..1f4e95710a --- /dev/null +++ b/dist/Devel-PPPort/PPPort_pm.PL @@ -0,0 +1,679 @@ +################################################################################ +# +# PPPort_pm.PL -- generate PPPort.pm +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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 parts/ppport.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 or $a cmp $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 / Variable', 'Static Request', 'Global Request') . + $1 . '-'x$len . "\n" . + join('', map { sprintf "$1$format\n", $explicit{$_} eq 'var' ? $_ : "$_()", "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{$_} and exists $raw_base{$_}) { + 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 /^Perl_(.*)/ && exists $embed{$1}; + 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.20}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; + $code =~ s{^([^\S\r\n]*)__NEED_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$} + {expand_need_var($1, $3, $2, $4)}gem; + $code =~ s{^([^\S\r\n]*)__NEED_DUMMY_VAR__\s+(.*?)\s+(\w+)(?:\s*=\s*([^;]+?))?\s*;\s*$} + {expand_need_dummy_var($1, $3, $2, $4)}gem; + return $code; +} + +sub expand_need_var +{ + my($indent, $var, $type, $init) = @_; + + $explicit{$var} = 'var'; + + my $myvar = "$DPPP(my_$var)"; + $init = defined $init ? " = $init" : ""; + + my $code = <<ENDCODE; +#if defined(NEED_$var) +static $type $myvar$init; +#elif defined(NEED_${var}_GLOBAL) +$type $myvar$init; +#else +extern $type $myvar; +#endif +#define $var $myvar +ENDCODE + + $code =~ s/^/$indent/mg; + + return $code; +} + +sub expand_need_dummy_var +{ + my($indent, $var, $type, $init) = @_; + + $explicit{$var} = 'var'; + + my $myvar = "$DPPP(dummy_$var)"; + $init = defined $init ? " = $init" : ""; + + my $code = <<ENDCODE; +#if defined(NEED_$var) +static $type $myvar$init; +#elif defined(NEED_${var}_GLOBAL) +$type $myvar$init; +#else +extern $type $myvar; +#endif +ENDCODE + + $code =~ s/^/$indent/mg; + + 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} = 'func'; + + $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}} }; + my $lastarg = ${$f->{args}}[-1]; + + 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)"; + } + elsif (@$lastarg && $lastarg->[0] =~ /\.\.\./) { + return $undef . "#define $n $DPPP(my_$n)\n" . + "#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. !!!!! +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by PPPort_pm.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ +# +# Perl/Pollution/Portability +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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'); + + # Same as above but retrieve contents rather than write file + my $contents = Devel::PPPort::GetFileContents(); + my $contents = Devel::PPPort::GetFileContents('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 two functions, C<WriteFile> and C<GetFileContents>. +C<WriteFile>'s 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. + +C<GetFileContents> can be used to retrieve the file contents rather than +writing it out. + +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. + +=head2 GetFileContents + +C<GetFileContents> behaves like C<WriteFile> above, but returns the contents +of the would-be file rather than writing it out. + +=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 file an issue here: +L<https://github.com/mhx/Devel-PPPort/issues/> + +=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. + +=item * + +Versions >= 3.22 are maintained with support from Matthew Horsfall (alh). + +=back + +=head1 COPYRIGHT + +Version 3.x, Copyright (C) 2004-2013, 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; + +use strict; +use vars qw($VERSION $data); + +$VERSION = '3.36'; + +sub _init_data +{ + $data = do { local $/; <DATA> }; + my $pkg = 'Devel::PPPort'; + $data =~ s/__PERL_VERSION__/$]/g; + $data =~ s/__VERSION__/$VERSION/g; + $data =~ s/__PKG__/$pkg/g; + $data =~ s/^\|>//gm; +} + +sub GetFileContents { + my $file = shift || 'ppport.h'; + defined $data or _init_data(); + my $copy = $data; + $copy =~ s/\bppport\.h\b/$file/g; + + return $copy; +} + +sub WriteFile +{ + my $file = shift || 'ppport.h'; + my $data = GetFileContents($file); + open F, ">$file" or return undef; + print F $data; + 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__. + + 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 threads + +%include limits + +%include uv + +%include memory + +%include misc + +%include variables + +%include mPUSH + +%include call + +%include newRV + +%include newCONSTSUB + +%include MY_CXT + +%include format + +%include SvREFCNT + +%include newSV_type + +%include newSVpv + +%include SvPV + +%include Sv_set + +%include sv_xpvf + +%include shared_pv + +%include HvNAME + +%include gv + +%include warn + +%include pvs + +%include magic + +%include cop + +%include grok + +%include snprintf + +%include sprintf + +%include exception + +%include strlfuncs + +%include pv_tools + +#endif /* _P_P_PORTABILITY_H_ */ + +/* End of File ppport.h */ diff --git a/dist/Devel-PPPort/PPPort_xs.PL b/dist/Devel-PPPort/PPPort_xs.PL new file mode 100644 index 0000000000..d00cffa81b --- /dev/null +++ b/dist/Devel-PPPort/PPPort_xs.PL @@ -0,0 +1,128 @@ +################################################################################ +# +# PPPort_xs.PL -- generate RealPPPort.xs +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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 => "/* ---- code from __FILE__ ---- */" }, + xsinit => { code => '', header => "/* ---- code from __FILE__ ---- */" }, + xsmisc => { code => '', header => "/* ---- code from __FILE__ ---- */" }, + xsboot => { code => '', header => "/* ---- code from __FILE__ ---- */", indent => "\t" }, + xsubs => { code => '', header => <<ENDHEADER }, +##---------------------------------------------------------------------- +## XSUBs for testing the implementation in __FILE__ +##---------------------------------------------------------------------- +ENDHEADER +); + +if (not exists $ENV{PERL_NO_GET_CONTEXT} or $ENV{PERL_NO_GET_CONTEXT}) { +$SECTION{xshead}{code} .= <<END; +#define PERL_NO_GET_CONTEXT +END +} + +my $file; +my $sec; + +for $file (all_files_in_dir('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, ">RealPPPort.xs" or die "RealPPPort.xs: $!\n"; +print FH $data; +close FH; + +exit 0; + +__DATA__ +/******************************************************************************* +* +* !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!! +* +* This file was automatically generated from the definition files in the +* parts/inc/ subdirectory by PPPort_xs.PL. To learn more about how all this +* works, please read the F<HACKERS> file that came with this distribution. +* +******************************************************************************** +* +* Perl/Pollution/Portability +* +******************************************************************************** +* +* Version 3.x, Copyright (C) 2004-2013, 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__ diff --git a/dist/Devel-PPPort/apicheck_c.PL b/dist/Devel-PPPort/apicheck_c.PL new file mode 100644 index 0000000000..c9ff8a416d --- /dev/null +++ b/dist/Devel-PPPort/apicheck_c.PL @@ -0,0 +1,22 @@ +################################################################################ +# +# apicheck_c.PL -- generate apicheck.c +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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; + +my $out = 'apicheck.c'; +my @api = map { /^--api=(\w+)$/ ? ($1) : () } @ARGV; +print "creating $out", (@api ? " (@api)" : ''), "\n"; +system $^X, 'parts/apicheck.pl', @api, $out + and die "couldn't create $out\n"; diff --git a/dist/Devel-PPPort/devel/buildperl.pl b/dist/Devel-PPPort/devel/buildperl.pl new file mode 100644 index 0000000000..916ed8f03d --- /dev/null +++ b/dist/Devel-PPPort/devel/buildperl.pl @@ -0,0 +1,601 @@ +#!/usr/bin/perl -w +################################################################################ +# +# buildperl.pl -- build various versions of perl automatically +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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; +use Getopt::Long; +use Pod::Usage; +use File::Find; +use File::Path; +use Data::Dumper; +use IO::File; +use Cwd; + +# TODO: - extra arguments to Configure + +# +# --test-archives=1 check if archives can be read +# --test-archives=2 like 1, but also extract archives +# --test-archives=3 like 2, but also apply patches +# + +my %opt = ( + prefix => '/tmp/perl/install/<config>/<perl>', + build => '/tmp/perl/build/<config>', + source => '/tmp/perl/source', + force => 0, + test => 0, + install => 1, + oneshot => 0, + configure => 0, + 'test-archives' => 0, +); + +my %config = ( + default => { + config_args => '-des', + }, + thread => { + config_args => '-des -Dusethreads', + masked_versions => [ qr/^5\.00[01234]/ ], + }, + thread5005 => { + config_args => '-des -Duse5005threads', + masked_versions => [ qr/^5\.00[012345]|^5\.(9|\d\d)|^5\.8\.9/ ], + }, + debug => { + config_args => '-des -Doptimize=-g', + }, +); + +my @patch = ( + { + perl => [ + qr/^5\.00[01234]/, + qw/ + 5.005 + 5.005_01 + 5.005_02 + 5.005_03 + /, + ], + subs => [ + [ \&patch_db, 1 ], + ], + }, + { + perl => [ + qw/ + 5.6.0 + 5.6.1 + 5.7.0 + 5.7.1 + 5.7.2 + 5.7.3 + 5.8.0 + /, + ], + subs => [ + [ \&patch_db, 3 ], + ], + }, + { + perl => [ + qr/^5\.004_0[1234]$/, + ], + subs => [ + [ \&patch_doio ], + ], + }, + { + perl => [ + qw/ + 5.005 + 5.005_01 + 5.005_02 + /, + ], + subs => [ + [ \&patch_sysv, old_format => 1 ], + ], + }, + { + perl => [ + qw/ + 5.005_03 + 5.005_04 + /, + qr/^5\.6\.[0-2]$/, + qr/^5\.7\.[0-3]$/, + qr/^5\.8\.[0-8]$/, + qr/^5\.9\.[0-5]$/ + ], + subs => [ + [ \&patch_sysv ], + ], + }, + { + perl => [ + qr/^5\.004_05$/, + qr/^5\.005(?:_0[1-4])?$/, + qr/^5\.6\.[01]$/, + ], + subs => [ + [ \&patch_configure ], + [ \&patch_makedepend_lc ], + ], + }, + { + perl => [ + '5.8.0', + ], + subs => [ + [ \&patch_makedepend_lc ], + ], + }, +); + +my(%perl, @perls); + +GetOptions(\%opt, qw( + config=s@ + prefix=s + build=s + source=s + perl=s@ + force + test + install! + test-archives=i + patch! + oneshot +)) or pod2usage(2); + +my %current; + +if ($opt{patch} || $opt{oneshot}) { + @{$opt{perl}} == 1 or die "Exactly one --perl must be given with --patch or --oneshot\n"; + my $perl = $opt{perl}[0]; + patch_source($perl) if !exists $opt{patch} || $opt{patch}; + if (exists $opt{oneshot}) { + eval { require String::ShellQuote }; + die "--oneshot requires String::ShellQuote to be installed\n" if $@; + %current = (config => 'oneshot', version => $perl); + $config{oneshot} = { config_args => String::ShellQuote::shell_quote(@ARGV) }; + build_and_install($perl{$perl}); + } + exit 0; +} + +if (exists $opt{config}) { + for my $cfg (@{$opt{config}}) { + exists $config{$cfg} or die "Unknown configuration: $cfg\n"; + } +} +else { + $opt{config} = [sort keys %config]; +} + +find(sub { + /^(perl-?(5\..*))\.tar\.(gz|bz2|lzma)$/ or return; + $perl{$1} = { version => $2, source => $File::Find::name, compress => $3 }; +}, $opt{source}); + +if (exists $opt{perl}) { + for my $perl (@{$opt{perl}}) { + my $p = $perl; + exists $perl{$p} or $p = "perl$perl"; + exists $perl{$p} or $p = "perl-$perl"; + exists $perl{$p} or die "Cannot find perl: $perl\n"; + push @perls, $p; + } +} +else { + @perls = sort keys %perl; +} + +if ($opt{'test-archives'}) { + my $test = 'test'; + my $cwd = cwd; + -d $test or mkpath($test); + chdir $test or die "chdir $test: $!\n"; + for my $perl (@perls) { + eval { + my $d = extract_source($perl{$perl}); + if ($opt{'test-archives'} > 2) { + my $cwd2 = cwd; + chdir $d or die "chdir $d: $!\n"; + patch_source($perl{$perl}{version}); + chdir $cwd2 or die "chdir $cwd2:$!\n" + } + rmtree($d) if -e $d; + }; + warn $@ if $@; + } + chdir $cwd or die "chdir $cwd: $!\n"; + print STDERR "cleaning up\n"; + rmtree($test); + exit 0; +} + +for my $cfg (@{$opt{config}}) { + for my $perl (@perls) { + my $config = $config{$cfg}; + %current = (config => $cfg, perl => $perl, version => $perl{$perl}{version}); + + if (is($config->{masked_versions}, $current{version})) { + print STDERR "skipping $perl for configuration $cfg (masked)\n"; + next; + } + + if (-d expand($opt{prefix}) and !$opt{force}) { + print STDERR "skipping $perl for configuration $cfg (already installed)\n"; + next; + } + + my $cwd = cwd; + + my $build = expand($opt{build}); + -d $build or mkpath($build); + chdir $build or die "chdir $build: $!\n"; + + print STDERR "building $perl with configuration $cfg\n"; + buildperl($perl, $config); + + chdir $cwd or die "chdir $cwd: $!\n"; + } +} + +sub expand +{ + my $in = shift; + $in =~ s/(<(\w+)>)/exists $current{$2} ? $current{$2} : $1/eg; + return $in; +} + +sub is +{ + my($s1, $s2) = @_; + + defined $s1 != defined $s2 and return 0; + + ref $s2 and ($s1, $s2) = ($s2, $s1); + + if (ref $s1) { + if (ref $s1 eq 'ARRAY') { + is($_, $s2) and return 1 for @$s1; + return 0; + } + return $s2 =~ $s1; + } + + return $s1 eq $s2; +} + +sub buildperl +{ + my($perl, $cfg) = @_; + + my $d = extract_source($perl{$perl}); + chdir $d or die "chdir $d: $!\n"; + + patch_source($perl{$perl}{version}); + + build_and_install($perl{$perl}); +} + +sub extract_source +{ + eval { require Archive::Tar }; + die "Archive processing requires Archive::Tar to be installed\n" if $@; + + my $perl = shift; + + my $what = $opt{'test-archives'} ? 'test' : 'read'; + print "${what}ing $perl->{source}\n"; + + my $target; + + for my $f (Archive::Tar->list_archive($perl->{source})) { + my($t) = $f =~ /^([^\\\/]+)/ or die "ooops, should always match...\n"; + die "refusing to extract $perl->{source}, as it would not extract to a single directory\n" + if defined $target and $target ne $t; + $target = $t; + } + + if ($opt{'test-archives'} == 0 || $opt{'test-archives'} > 1) { + if (-d $target) { + print "removing old build directory $target\n"; + rmtree($target); + } + + print "extracting $perl->{source}\n"; + + Archive::Tar->extract_archive($perl->{source}) + or die "extract failed: " . Archive::Tar->error() . "\n"; + + -d $target or die "oooops, $target not found\n"; + } + + return $target; +} + +sub patch_source +{ + my $version = shift; + + for my $p (@patch) { + if (is($p->{perl}, $version)) { + for my $s (@{$p->{subs}}) { + my($sub, @args) = @$s; + $sub->(@args); + } + } + } +} + +sub build_and_install +{ + my $perl = shift; + my $prefix = expand($opt{prefix}); + + run_or_die(q{sed -i -e "s:\\*/\\*) finc=\\"-I\\`echo \\$file | sed 's#/\\[^/\\]\\*\\$##\\`\\" ;;:*/*) finc=\\"-I\\`echo \\$file | sed 's#/[^/]\\*\\$##'\\`\\" ;;:" makedepend.SH}); + + print "building perl $perl->{version} ($current{config})\n"; + + run_or_die("./Configure $config{$current{config}}{config_args} -Dusedevel -Uinstallusrbinperl -Dprefix=$prefix"); + if (-f "x2p/makefile") { + run_or_die("sed -i -e '/^.*<builtin>/d' -e '/^.*<built-in>/d' -e '/^.*<command line>/d' -e '/^.*<command-line>/d' makefile x2p/makefile"); + } + run_or_die("make all"); + run("make test") if $opt{test}; + if ($opt{install}) { + run_or_die("make install"); + } + else { + print "\n*** NOT INSTALLING PERL ***\n\n"; + } +} + +sub patch_db +{ + my $ver = shift; + print "patching ext/DB_File/DB_File.xs\n"; + run_or_die("sed -i -e 's/<db.h>/<db$ver\\/db.h>/' ext/DB_File/DB_File.xs"); +} + +sub patch_doio +{ + patch(<<'END'); +--- doio.c.org 2004-06-07 23:14:45.000000000 +0200 ++++ doio.c 2003-11-04 08:03:03.000000000 +0100 +@@ -75,6 +75,16 @@ + # endif + #endif + ++#if _SEM_SEMUN_UNDEFINED ++union semun ++{ ++ int val; ++ struct semid_ds *buf; ++ unsigned short int *array; ++ struct seminfo *__buf; ++}; ++#endif ++ + bool + do_open(gv,name,len,as_raw,rawmode,rawperm,supplied_fp) + GV *gv; +END +} + +sub patch_sysv +{ + my %opt = @_; + + # check if patching is required + return if $^O ne 'linux' or -f '/usr/include/asm/page.h'; + + if ($opt{old_format}) { + patch(<<'END'); +--- ext/IPC/SysV/SysV.xs.org 1998-07-20 10:20:07.000000000 +0200 ++++ ext/IPC/SysV/SysV.xs 2007-08-12 10:51:06.000000000 +0200 +@@ -3,9 +3,6 @@ + #include "XSUB.h" + + #include <sys/types.h> +-#ifdef __linux__ +-#include <asm/page.h> +-#endif + #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) + #include <sys/ipc.h> + #ifdef HAS_MSG +END + } + else { + patch(<<'END'); +--- ext/IPC/SysV/SysV.xs.org 2007-08-11 00:12:46.000000000 +0200 ++++ ext/IPC/SysV/SysV.xs 2007-08-11 00:10:51.000000000 +0200 +@@ -3,9 +3,6 @@ + #include "XSUB.h" + + #include <sys/types.h> +-#ifdef __linux__ +-# include <asm/page.h> +-#endif + #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) + #ifndef HAS_SEM + # include <sys/ipc.h> +END + } +} + +sub patch_configure +{ + patch(<<'END'); +--- Configure ++++ Configure +@@ -3380,6 +3380,18 @@ + test "X$gfpthkeep" != Xy && gfpth="" + EOSC + ++# gcc 3.1 complains about adding -Idirectories that it already knows about, ++# so we will take those off from locincpth. ++case "$gccversion" in ++3*) ++ echo "main(){}">try.c ++ for incdir in `$cc -v -c try.c 2>&1 | \ ++ sed '1,/^#include <\.\.\.>/d;/^End of search list/,$d;s/^ //'` ; do ++ locincpth=`echo $locincpth | sed s!$incdir!!` ++ done ++ $rm -f try try.* ++esac ++ + : What should the include directory be ? + echo " " + $echo $n "Hmm... $c" +END +} + +sub patch_makedepend_lc +{ + patch(<<'END'); +--- makedepend.SH ++++ makedepend.SH +@@ -58,6 +58,10 @@ case $PERL_CONFIG_SH in + ;; + esac + ++# Avoid localized gcc/cc messages ++LC_ALL=C ++export LC_ALL ++ + # We need .. when we are in the x2p directory if we are using the + # cppstdin wrapper script. + # Put .. and . first so that we pick up the present cppstdin, not +END +} + +sub patch +{ + my($patch) = @_; + print "patching $_\n" for $patch =~ /^\+{3}\s+(\S+)/gm; + my $diff = 'tmp.diff'; + write_or_die($diff, $patch); + run_or_die("patch -s -p0 <$diff"); + unlink $diff or die "unlink $diff: $!\n"; +} + +sub write_or_die +{ + my($file, $data) = @_; + my $fh = new IO::File ">$file" or die "$file: $!\n"; + $fh->print($data); +} + +sub run_or_die +{ + # print "[running @_]\n"; + system "@_" and die "@_: $?\n"; +} + +sub run +{ + # print "[running @_]\n"; + system "@_" and warn "@_: $?\n"; +} + +__END__ + +=head1 NAME + +buildperl.pl - build/install perl distributions + +=head1 SYNOPSIS + + perl buildperl.pl [options] + + --help show this help + + --source=directory directory containing source tarballs + [default: /tmp/perl/source] + + --build=directory directory used for building perls [EXPAND] + [default: /tmp/perl/build/<config>] + + --prefix=directory use this installation prefix [EXPAND] + [default: /tmp/perl/install/<config>/<perl>] + + --config=configuration build this configuration [MULTI] + [default: all possible configurations] + + --perl=version build this version of perl [MULTI] + [default: all possible versions] + + --force rebuild and install already installed versions + + --test run test suite after building + + --noinstall don't install after building + + --patch only patch the perl source in the current directory + + --oneshot build from the perl source in the current directory + (extra arguments are passed to Configure) + + options tagged with [MULTI] can be given multiple times + + options tagged with [EXPAND] expand the following items + + <perl> versioned perl directory (e.g. 'perl-5.6.1') + <version> perl version (e.g. '5.6.1') + <config> name of the configuration (e.g. 'default') + +=head1 EXAMPLES + +The following examples assume that your Perl source tarballs are +in F</tmp/perl/source>. If they are somewhere else, use the C<--source> +option to specify a different source directory. + +To build a default configuration of perl5.004_05 and install it +to F</opt/perl5.004_05>, you would say: + + buildperl.pl --prefix='/opt/<perl>' --perl=5.004_05 --config=default + +To build debugging configurations of all perls in the source directory +and install them to F</opt>, use: + + buildperl.pl --prefix='/opt/<perl>' --config=debug + +To build all configurations for perl-5.8.5 and perl-5.8.6, test them +and don't install them, run: + + buildperl.pl --perl=5.8.5 --perl=5.8.6 --test --noinstall + +To build and install a single version of perl with special configuration +options, use: + + buildperl.pl --perl=5.6.0 --prefix=/opt/p560ld --oneshot -- -des -Duselongdouble + +=head1 COPYRIGHT + +Copyright (c) 2004-2013, Marcus Holland-Moritz. + +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> and L<HACKERS>. diff --git a/dist/Devel-PPPort/devel/devtools.pl b/dist/Devel-PPPort/devel/devtools.pl new file mode 100644 index 0000000000..465c3cca25 --- /dev/null +++ b/dist/Devel-PPPort/devel/devtools.pl @@ -0,0 +1,123 @@ +################################################################################ +# +# devtools.pl -- various utility functions +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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 IO::File; + +eval "use Term::ANSIColor"; +$@ and eval "sub colored { pop; @_ }"; + +my @argvcopy = @ARGV; + +sub verbose +{ + if ($opt{verbose}) { + my @out = @_; + s/^(.*)/colored("($0) ", 'bold blue').colored($1, 'blue')/eg for @out; + print STDERR @out; + } +} + +sub ddverbose +{ + return $opt{verbose} ? ('--verbose') : (); +} + +sub runtool +{ + my $opt = ref $_[0] ? shift @_ : {}; + my($prog, @args) = @_; + my $sysstr = join ' ', map { "'$_'" } $prog, @args; + $sysstr .= " >$opt->{'out'}" if exists $opt->{'out'}; + $sysstr .= " 2>$opt->{'err'}" if exists $opt->{'err'}; + verbose("running $sysstr\n"); + my $rv = system $sysstr; + verbose("$prog => exit code $rv\n"); + return not $rv; +} + +sub runperl +{ + my $opt = ref $_[0] ? shift @_ : {}; + runtool($opt, $^X, @_); +} + +sub run +{ + my $prog = shift; + my @args = @_; + + runtool({ 'out' => 'tmp.out', 'err' => 'tmp.err' }, $prog, @args); + + my $out = IO::File->new("tmp.out") or die "tmp.out: $!\n"; + my $err = IO::File->new("tmp.err") or die "tmp.err: $!\n"; + + my %rval = ( + status => $? >> 8, + stdout => [<$out>], + stderr => [<$err>], + didnotrun => 0, + ); + + unlink "tmp.out", "tmp.err"; + + $? & 128 and $rval{core} = 1; + $? & 127 and $rval{signal} = $? & 127; + + return \%rval; +} + +sub ident_str +{ + return "$^X $0 @argvcopy"; +} + +sub identify +{ + verbose(ident_str() . "\n"); +} + +sub ask($) +{ + my $q = shift; + my $a; + local $| = 1; + print "\n$q [y/n] "; + do { $a = <>; } while ($a !~ /^\s*([yn])\s*$/i); + return lc $1 eq 'y'; +} + +sub quit_now +{ + print "\nSorry, cannot continue.\n\n"; + exit 1; +} + +sub ask_or_quit +{ + quit_now unless &ask; +} + +sub eta +{ + my($start, $i, $n) = @_; + return "--:--:--" if $i < 3; + my $elapsed = tv_interval($start); + my $h = int($elapsed*($n-$i)/$i); + my $s = $h % 60; $h /= 60; + my $m = $h % 60; $h /= 60; + return sprintf "%02d:%02d:%02d", $h, $m, $s; +} + +1; diff --git a/dist/Devel-PPPort/devel/mkapidoc.sh b/dist/Devel-PPPort/devel/mkapidoc.sh new file mode 100644 index 0000000000..ff96ccc6a6 --- /dev/null +++ b/dist/Devel-PPPort/devel/mkapidoc.sh @@ -0,0 +1,81 @@ +#!/bin/bash +################################################################################ +# +# mkapidoc.sh -- generate apidoc.fnc from scanning the Perl source +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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. +# +################################################################################ + +function isperlroot +{ + [ -f "$1/embed.fnc" ] && [ -f "$1/perl.h" ] +} + +function usage +{ + echo "USAGE: $0 [perlroot] [output-file] [embed.fnc]" + exit 0 +} + +if [ -z "$1" ]; then + if isperlroot "../../.."; then + PERLROOT=../../.. + else + PERLROOT=. + fi +else + PERLROOT=$1 +fi + +if [ -z "$2" ]; then + if [ -f "parts/apidoc.fnc" ]; then + OUTPUT="parts/apidoc.fnc" + else + usage + fi +else + OUTPUT=$2 +fi + +if [ -z "$3" ]; then + if [ -f "parts/embed.fnc" ]; then + EMBED="parts/embed.fnc" + else + usage + fi +else + EMBED=$3 +fi + +if isperlroot $PERLROOT; then + cat >$OUTPUT <<EOF +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +: +: !!!! Do NOT edit this file directly! -- Edit devel/mkapidoc.sh instead. !!!! +: +: This file was automatically generated from the API documentation scattered +: all over the Perl source code. To learn more about how all this works, +: please read the F<HACKERS> file that came with this distribution. +: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +: +: This file lists all API functions/macros that are documented in the Perl +: source code, but are not contained in F<embed.fnc>. +: + +EOF + grep -hr '^=for apidoc' $PERLROOT | sed -e 's/=for apidoc //' | grep '|' | sort | uniq \ + | perl -e'$f=pop;open(F,$f)||die"$f:$!";while(<F>){(split/\|/)[2]=~/(\w+)/;$h{$1}++} + while(<>){s/[ \t]+$//;(split/\|/)[2]=~/(\w+)/;$h{$1}||print}' $EMBED >>$OUTPUT +else + usage +fi diff --git a/dist/Devel-PPPort/devel/mktodo b/dist/Devel-PPPort/devel/mktodo new file mode 100644 index 0000000000..2eb9ea3043 --- /dev/null +++ b/dist/Devel-PPPort/devel/mktodo @@ -0,0 +1,58 @@ +#!/usr/bin/perl -w +################################################################################ +# +# mktodo -- generate baseline and todo files by running mktodo.pl +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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; +use Getopt::Long; + +require './devel/devtools.pl'; + +our %opt = ( + base => 0, + check => 1, + verbose => 0, + install => '/tmp/perl/install/default', + blead => 'bleadperl-debug', +); + +GetOptions(\%opt, qw( base check! verbose install=s blead=s blead-version=s )) or die; + +identify(); + +my $outdir = 'parts/todo'; + +my @perls = sort { $b->{version} <=> $a->{version} } + map { { version => `$_ -e 'printf "%.6f", \$]'`, path => $_ } } + ($opt{blead}, grep !/-RC\d+/, glob "$opt{install}/*/bin/perl5.*"); + +if (exists $opt{'blead-version'}) { + $perls[0]{version} = $opt{'blead-version'}; +} + +for (1 .. $#perls) { + $perls[$_]{todo} = $perls[$_-1]{version}; +} + +shift @perls; + +for (@perls) { + my $todo = do { my $v = $_->{todo}; $v =~ s/\D+//g; $v }; + -e "$outdir/$todo" and next; + my @args = ('--perl', $_->{path}, '--todo', "$outdir/$todo", '--version', "$_->{todo}"); + push @args, '--base' if $opt{base}; + push @args, '--verbose' if $opt{verbose}; + push @args, '--nocheck' unless $opt{check}; + runperl('devel/mktodo.pl', @args) or die "error running mktodo.pl [$!] [$?]\n"; +} diff --git a/dist/Devel-PPPort/devel/mktodo.pl b/dist/Devel-PPPort/devel/mktodo.pl new file mode 100644 index 0000000000..c479eab5d1 --- /dev/null +++ b/dist/Devel-PPPort/devel/mktodo.pl @@ -0,0 +1,374 @@ +#!/usr/bin/perl -w +################################################################################ +# +# mktodo.pl -- generate baseline and todo files +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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; +use Getopt::Long; +use Data::Dumper; +use IO::File; +use IO::Select; +use Config; +use Time::HiRes qw( gettimeofday tv_interval ); + +require './devel/devtools.pl'; + +our %opt = ( + debug => 0, + base => 0, + verbose => 0, + check => 1, + shlib => 'blib/arch/auto/Devel/PPPort/PPPort.so', +); + +GetOptions(\%opt, qw( + perl=s todo=s version=s shlib=s debug base verbose check! + )) or die; + +identify(); + +print "\n", ident_str(), "\n\n"; + +my $fullperl = `which $opt{perl}`; +chomp $fullperl; + +$ENV{SKIP_SLOW_TESTS} = 1; + +regen_all(); + +my %stdsym = map { ($_ => 1) } qw ( + strlen + snprintf + strcmp + memcpy + strncmp + memmove + memcmp + tolower + exit + memset + vsnprintf + siglongjmp + sprintf +); + +my %sym; +for (`$Config{nm} $fullperl`) { + chomp; + /\s+T\s+(\w+)\s*$/ and $sym{$1}++; +} +keys %sym >= 50 or die "less than 50 symbols found in $fullperl\n"; + +my %all = %{load_todo($opt{todo}, $opt{version})}; +my @recheck; + +my $symmap = get_apicheck_symbol_map(); + +for (;;) { + my $retry = 1; + my $trynm = 1; + regen_apicheck(); + +retry: + my(@new, @tmp, %seen); + + my $r = run(qw(make)); + $r->{didnotrun} and die "couldn't run make: $!\n"; + + for my $l (@{$r->{stderr}}) { + if ($l =~ /_DPPP_test_(\w+)/) { + if (!$seen{$1}++) { + my @s = grep { exists $sym{$_} } $1, "Perl_$1", "perl_$1"; + if (@s) { + push @tmp, [$1, "E (@s)"]; + } + else { + push @new, [$1, "E"]; + } + } + } + } + + if ($r->{status} == 0) { + my @u; + my @usym; + + if ($trynm) { + @u = eval { find_undefined_symbols($fullperl, $opt{shlib}) }; + warn "warning: $@" if $@; + $trynm = 0; + } + + unless (@u) { + $r = run(qw(make test)); + $r->{didnotrun} and die "couldn't run make test: $!\n"; + $r->{status} == 0 and last; + + for my $l (@{$r->{stderr}}) { + if ($l =~ /undefined symbol: (\w+)/) { + push @u, $1; + } + } + } + + for my $u (@u) { + for my $m (keys %{$symmap->{$u}}) { + if (!$seen{$m}++) { + my $pl = $m; + $pl =~ s/^[Pp]erl_//; + my @s = grep { exists $sym{$_} } $pl, "Perl_$pl", "perl_$pl"; + push @new, [$m, @s ? "U (@s)" : "U"]; + } + } + } + } + + @new = grep !$all{$_->[0]}, @new; + + unless (@new) { + @new = grep !$all{$_->[0]}, @tmp; + } + + unless (@new) { + if ($retry > 0) { + $retry--; + regen_all(); + goto retry; + } + print Dumper($r); + die "no new TODO symbols found..."; + } + + # don't recheck undefined symbols reported by the dynamic linker + push @recheck, map { $_->[0] } grep { $_->[1] !~ /^U/ } @new; + + for (@new) { + sym('new', @$_); + $all{$_->[0]} = $_->[1]; + } + + write_todo($opt{todo}, $opt{version}, \%all); +} + +if ($opt{check}) { + my $ifmt = '%' . length(scalar @recheck) . 'd'; + my $t0 = [gettimeofday]; + + RECHECK: for my $i (0 .. $#recheck) { + my $sym = $recheck[$i]; + my $cur = delete $all{$sym}; + + sym('chk', $sym, $cur, sprintf(" [$ifmt/$ifmt, ETA %s]", + $i + 1, scalar @recheck, eta($t0, $i, scalar @recheck))); + + write_todo($opt{todo}, $opt{version}, \%all); + + if ($cur eq "E (Perl_$sym)") { + # we can try a shortcut here + regen_apicheck($sym); + + my $r = run(qw(make test)); + + if (!$r->{didnotrun} && $r->{status} == 0) { + sym('del', $sym, $cur); + next RECHECK; + } + } + + # run the full test + regen_all(); + + my $r = run(qw(make test)); + + $r->{didnotrun} and die "couldn't run make test: $!\n"; + + if ($r->{status} == 0) { + sym('del', $sym, $cur); + } + else { + $all{$sym} = $cur; + } + } +} + +write_todo($opt{todo}, $opt{version}, \%all); + +run(qw(make realclean)); + +exit 0; + +sub sym +{ + my($what, $sym, $reason, $extra) = @_; + $extra ||= ''; + my %col = ( + 'new' => 'bold red', + 'chk' => 'bold magenta', + 'del' => 'bold green', + ); + $what = colored("$what symbol", $col{$what}); + + printf "[%s] %s %-30s # %s%s\n", + $opt{version}, $what, $sym, $reason, $extra; +} + +sub regen_all +{ + my @mf_arg = ('--with-apicheck', 'OPTIMIZE=-O0 -w'); + push @mf_arg, qw( DEFINE=-DDPPP_APICHECK_NO_PPPORT_H ) if $opt{base}; + + # just to be sure + run(qw(make realclean)); + run($fullperl, "Makefile.PL", @mf_arg)->{status} == 0 + or die "cannot run Makefile.PL: $!\n"; +} + +sub regen_apicheck +{ + unlink qw(apicheck.c apicheck.o); + runtool({ out => '/dev/null' }, $fullperl, 'apicheck_c.PL', map { "--api=$_" } @_) + or die "cannot regenerate apicheck.c\n"; +} + +sub load_todo +{ + my($file, $expver) = @_; + + if (-e $file) { + my $f = new IO::File $file or die "cannot open $file: $!\n"; + my $ver = <$f>; + chomp $ver; + if ($ver eq $expver) { + my %sym; + while (<$f>) { + chomp; + /^(\w+)\s+#\s+(.*)/ or goto nuke_file; + exists $sym{$1} and goto nuke_file; + $sym{$1} = $2; + } + return \%sym; + } + +nuke_file: + undef $f; + unlink $file or die "cannot remove $file: $!\n"; + } + + return {}; +} + +sub write_todo +{ + my($file, $ver, $sym) = @_; + my $f; + + $f = new IO::File ">$file" or die "cannot open $file: $!\n"; + $f->print("$ver\n"); + + for (sort keys %$sym) { + $f->print(sprintf "%-30s # %s\n", $_, $sym->{$_}); + } +} + +sub find_undefined_symbols +{ + my($perl, $shlib) = @_; + + my $ps = read_sym(file => $perl, options => [qw( --defined-only )]); + my $ls = read_sym(file => $shlib, options => [qw( --undefined-only )]); + + my @undefined; + + for my $sym (keys %$ls) { + unless (exists $ps->{$sym}) { + if ($sym !~ /\@/ and $sym !~ /^_/) { + push @undefined, $sym unless $stdsym{$sym}; + } + } + } + + return @undefined; +} + +sub read_sym +{ + my %opt = ( options => [], @_ ); + + my $r = run($Config{nm}, @{$opt{options}}, $opt{file}); + + if ($r->{didnotrun} or $r->{status}) { + die "cannot run $Config{nm}"; + } + + my %sym; + + for (@{$r->{stdout}}) { + chomp; + my($adr, $fmt, $sym) = /^\s*([[:xdigit:]]+)?\s+([ABCDGINRSTUVW?-])\s+(\S+)\s*$/i + or die "cannot parse $Config{nm} output:\n[$_]\n"; + $sym{$sym} = { format => $fmt }; + $sym{$sym}{address} = $adr if defined $adr; + } + + return \%sym; +} + +sub get_apicheck_symbol_map +{ + my $r; + + while (1) { + $r = run(qw(make apicheck.i)); + + last unless $r->{didnotrun} or $r->{status}; + + my %sym = map { /error: macro "(\w+)" (?:requires|passed) \d+ argument/ ? ($1 => 'A') : () } + @{$r->{stderr}}; + + if (keys %sym) { + for my $s (sort keys %sym) { + sym('new', $s, $sym{$s}); + $all{$s} = $sym{$s}; + } + write_todo($opt{todo}, $opt{version}, \%all); + regen_apicheck(); + } + else { + die "cannot run make apicheck.i ($r->{didnotrun} / $r->{status}):\n". + join('', @{$r->{stdout}})."\n---\n".join('', @{$r->{stderr}}); + } + } + + my $fh = IO::File->new('apicheck.i') + or die "cannot open apicheck.i: $!"; + + local $_; + my %symmap; + my $cur; + + while (<$fh>) { + next if /^#/; + if (defined $cur) { + for my $sym (/\b([A-Za-z_]\w+)\b/g) { + $symmap{$sym}{$cur}++; + } + undef $cur if /^}$/; + } + else { + /_DPPP_test_(\w+)/ and $cur = $1; + } + } + + return \%symmap; +} diff --git a/dist/Devel-PPPort/devel/regenerate b/dist/Devel-PPPort/devel/regenerate new file mode 100644 index 0000000000..bc1742d938 --- /dev/null +++ b/dist/Devel-PPPort/devel/regenerate @@ -0,0 +1,160 @@ +#!/usr/bin/perl -w +################################################################################ +# +# regenerate -- regenerate baseline and todo files +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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; +use File::Path; +use File::Copy; +use Getopt::Long; +use Pod::Usage; + +require './devel/devtools.pl'; + +our %opt = ( + check => 1, + verbose => 0, +); + +GetOptions(\%opt, qw( check! verbose install=s blead=s blead-version=s )) or die pod2usage(); + +identify(); + +unless (-e 'parts/embed.fnc' and -e 'parts/apidoc.fnc') { + print "\nOooops, $0 must be run from the Devel::PPPort root directory.\n"; + quit_now(); +} + +ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?"); + +my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo ); + +my(@notwr, @wr); +for my $f (map @$_, values %files) { + push @{-w $f ? \@wr : \@notwr}, $f; +} + +if (@notwr) { + if (@wr) { + print "\nThe following files are not writable:\n\n"; + print " $_\n" for @notwr; + print "\nAre you sure you have checked out these files?\n"; + } + else { + print "\nAll baseline / todo file are not writable.\n"; + ask_or_quit("Do you want to try to check out these files?"); + unless (runtool("wco", "-l", "-t", "locked by $0", @notwr)) { + print "\nSomething went wrong while checking out the files.\n"; + quit_now(); + } + } +} + +for my $dir (qw( base todo )) { + my $cur = "parts/$dir"; + my $old = "$cur-old"; + if (-e $old) { + ask_or_quit("Do you want me to remove the old $old directory?"); + rmtree($old); + } + mkdir $old; + print "\nBacking up $cur in $old.\n"; + for my $src (@{$files{$dir}}) { + my $dst = $src; + $dst =~ s/\Q$cur/$old/ or die "Ooops!"; + move($src, $dst) or die "Moving $src to $dst failed: $!\n"; + } +} + +my @perlargs; +push @perlargs, "--install=$opt{install}" if exists $opt{install}; +push @perlargs, "--blead=$opt{blead}" if exists $opt{blead}; + +my $T0 = time; +my @args = ddverbose(); +push @args, '--nocheck' unless $opt{check}; +push @args, "--blead-version=$opt{'blead-version'}" if exists $opt{'blead-version'}; +push @args, @perlargs; + +print "\nBuilding baseline files...\n\n"; + +unless (runperl('devel/mktodo', '--base', @args)) { + print "\nSomething went wrong while building the baseline files.\n"; + quit_now(); +} + +print "\nMoving baseline files...\n\n"; + +for my $src (glob 'parts/todo/5*') { + my $dst = $src; + $dst =~ s/todo/base/ or die "Ooops!"; + move($src, $dst) or die "Moving $src to $dst failed: $!\n"; +} + +print "\nBuilding todo files...\n\n"; + +unless (runperl('devel/mktodo', @args)) { + print "\nSomething went wrong while building the baseline files.\n"; + quit_now(); +} + +print "\nAdding remaining baseline info...\n\n"; + +unless (runperl('Makefile.PL') and + runtool('make') and + runperl('devel/scanprov', '--mode=write', @perlargs)) { + print "\nSomething went wrong while adding the baseline info.\n"; + quit_now(); +} + +my($wall, $usr, $sys, $cusr, $csys) = (time - $T0, times); +my $cpu = sprintf "%.2f", $usr + $sys + $cusr + $csys; +$usr = sprintf "%.2f", $usr + $cusr; +$sys = sprintf "%.2f", $sys + $csys; + +print <<END; + +API info regenerated successfully. + +Finished in $wall wallclock secs ($usr usr + $sys sys = $cpu CPU) + +Don't forget to check in the files in parts/base and parts/todo. + +END + +__END__ + +=head1 NAME + +regenerate - Automatically regeneate Devel::PPPort's API information + +=head1 SYNOPSIS + + regenerate [options] + + --nocheck don't recheck symbols that caused an error + --verbose show verbose output + +=head1 COPYRIGHT + +Copyright (c) 2006-2013, Marcus Holland-Moritz. + +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> and L<HACKERS>. + +=cut diff --git a/dist/Devel-PPPort/devel/scanprov b/dist/Devel-PPPort/devel/scanprov new file mode 100644 index 0000000000..804524cb4a --- /dev/null +++ b/dist/Devel-PPPort/devel/scanprov @@ -0,0 +1,78 @@ +#!/usr/bin/perl -w +################################################################################ +# +# scanprov -- scan Perl headers for provided macros +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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; +use Getopt::Long; + +require './parts/ppptools.pl'; + +our %opt = ( + mode => 'check', + install => '/tmp/perl/install/default', + blead => 'bleadperl', +); + +GetOptions(\%opt, qw( install=s mode=s blead=s )) or die; + +my $write = $opt{mode} eq 'write'; + +my %embed = map { ( $_->{name} => 1 ) } + parse_embed(qw(parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc )); + +my @provided = grep { !exists $embed{$_} } + map { /^(\w+)/ ? $1 : () } + `$^X ppport.h --list-provided`; + +my @perls = sort { $b->{version} <=> $a->{version} } + map { { version => `$_ -e 'printf "%.6f", \$]'`, path => $_ } } + ($opt{blead}, glob "$opt{install}/*/bin/perl5.*"); + +for (1 .. $#perls) { + $perls[$_]{todo} = $perls[$_-1]{version}; +} + +shift @perls; + +my %v; + +for my $p (@perls) { + print "checking perl $p->{version}...\n"; + my $archlib = `$p->{path} -MConfig -l -e 'print \$Config{archlib}'`; + chomp $archlib; + local @ARGV = glob "$archlib/CORE/*.h"; + my %sym; + while (<>) { $sym{$_}++ for /(\w+)/g; } + @provided = map { $sym{$_} or $v{$p->{todo}}{$_}++; $sym{$_} ? $_ : () } @provided; +} + +my $out = 'parts/base'; +my $todo = parse_todo($out); + +for my $v (keys %v) { + my @new = sort grep { !exists $todo->{$_} } keys %{$v{$v}}; + @new or next; + my $file = $v; + $file =~ s/\.//g; + $file = "$out/$file"; + -e $file or die "non-existent: $file\n"; + print "-- $file --\n"; + $write and (open F, ">>$file" or die "$file: $!\n"); + for (@new) { + print "adding $_\n"; + $write and printf F "%-30s # added by $0\n", $_; + } + $write and close F; +} diff --git a/dist/Devel-PPPort/mktests.PL b/dist/Devel-PPPort/mktests.PL new file mode 100644 index 0000000000..02c9110463 --- /dev/null +++ b/dist/Devel-PPPort/mktests.PL @@ -0,0 +1,110 @@ +################################################################################ +# +# mktests.PL -- generate test files for Devel::PPPort +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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> }; + +generate_tests(); + +sub generate_tests +{ + my @tests; + my $file; + + for $file (all_files_in_dir('parts/inc')) { + my($testfile) = $file =~ /(\w+)\.?$/; # VMS has a trailing dot + $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; + + push @tests, $testfile; + } + } + + return @tests; +} + +__DATA__ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or __SOURCE__ instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (__PLAN__) { + load(); + plan(tests => __PLAN__); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +__TESTS__ diff --git a/dist/Devel-PPPort/module2.c b/dist/Devel-PPPort/module2.c new file mode 100644 index 0000000000..a9a6f2aa44 --- /dev/null +++ b/dist/Devel-PPPort/module2.c @@ -0,0 +1,54 @@ +/******************************************************************************* +* +* Perl/Pollution/Portability +* +******************************************************************************** +* +* Version 3.x, Copyright (C) 2004-2013, 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 +#define NEED_PL_signals_GLOBAL +#define NEED_PL_parser +#define DPPP_PL_parser_NO_DUMMY +#include "ppport.h" + +void call_newCONSTSUB_2(void) +{ + newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_2", newSViv(2)); +} + +U32 get_PL_signals_2(void) +{ + return PL_signals; +} + +int no_dummy_parser_vars(int check) +{ + if (check == 0 || PL_parser) + { + line_t volatile my_copline; + line_t volatile *my_p_copline; + my_copline = PL_copline; + my_p_copline = &PL_copline; + PL_copline = my_copline; + PL_copline = *my_p_copline; + return 1; + } + + return 0; +} diff --git a/dist/Devel-PPPort/module3.c b/dist/Devel-PPPort/module3.c new file mode 100644 index 0000000000..417490e012 --- /dev/null +++ b/dist/Devel-PPPort/module3.c @@ -0,0 +1,71 @@ +/******************************************************************************* +* +* Perl/Pollution/Portability +* +******************************************************************************** +* +* Version 3.x, Copyright (C) 2004-2013, 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 NEED_PL_parser +#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)); +} + +U32 get_PL_signals_3(void) +{ + return PL_signals; +} + +int dummy_parser_warning(void) +{ + char * volatile my_bufptr; + char * volatile *my_p_bufptr; + my_bufptr = PL_bufptr; + my_p_bufptr = &PL_bufptr; + PL_bufptr = my_bufptr; + PL_bufptr = *my_p_bufptr; + return &PL_bufptr != NULL; +} diff --git a/dist/Devel-PPPort/parts/apicheck.pl b/dist/Devel-PPPort/parts/apicheck.pl new file mode 100644 index 0000000000..69d85027fd --- /dev/null +++ b/dist/Devel-PPPort/parts/apicheck.pl @@ -0,0 +1,326 @@ +#!/usr/bin/perl -w +################################################################################ +# +# apicheck.pl -- generate C source for automated API check +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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; +require './parts/ppptools.pl'; + +if (@ARGV) { + my $file = pop @ARGV; + open OUT, ">$file" or die "$file: $!\n"; +} +else { + *OUT = \*STDOUT; +} + +my @f = parse_embed(qw( parts/embed.fnc parts/apidoc.fnc parts/ppport.fnc )); + +my %todo = %{&parse_todo}; + +my %tmap = ( + void => 'int', +); + +my %amap = ( + SP => 'SP', + type => 'int', + cast => 'int', +); + +my %void = ( + void => 1, + Free_t => 1, + Signal_t => 1, +); + +my %castvoid = ( + map { ($_ => 1) } qw( + Nullav + Nullcv + Nullhv + Nullch + Nullsv + HEf_SVKEY + SP + MARK + SVt_PV + SVt_IV + SVt_NV + SVt_PVMG + SVt_PVAV + SVt_PVHV + SVt_PVCV + SvUOK + G_SCALAR + G_ARRAY + G_VOID + G_DISCARD + G_EVAL + G_NOARGS + XS_VERSION + ), +); + +my %ignorerv = ( + map { ($_ => 1) } qw( + newCONSTSUB + ), +); + +my %stack = ( + ORIGMARK => ['dORIGMARK;'], + POPpx => ['STRLEN n_a;'], + POPpbytex => ['STRLEN n_a;'], + PUSHp => ['dTARG;'], + PUSHn => ['dTARG;'], + PUSHi => ['dTARG;'], + PUSHu => ['dTARG;'], + XPUSHp => ['dTARG;'], + XPUSHn => ['dTARG;'], + XPUSHi => ['dTARG;'], + XPUSHu => ['dTARG;'], + UNDERBAR => ['dUNDERBAR;'], + XCPT_TRY_START => ['dXCPT;'], + XCPT_TRY_END => ['dXCPT;'], + XCPT_CATCH => ['dXCPT;'], + XCPT_RETHROW => ['dXCPT;'], +); + +my %ignore = ( + map { ($_ => 1) } qw( + svtype + items + ix + dXSI32 + XS + CLASS + THIS + RETVAL + StructCopy + ), +); + +print OUT <<HEAD; +/* + * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + * This file is built by $0. + * Any changes made here will be lost! + */ + +#include "EXTERN.h" +#include "perl.h" + +#define NO_XSLOCKS +#include "XSUB.h" + +#ifdef DPPP_APICHECK_NO_PPPORT_H + +/* This is just to avoid too many baseline failures with perls < 5.6.0 */ + +#ifndef dTHX +# define dTHX extern int Perl___notused +#endif + +#else + +#define NEED_PL_signals +#define NEED_PL_parser +#define NEED_caller_cx +#define NEED_eval_pv +#define NEED_grok_bin +#define NEED_grok_hex +#define NEED_grok_number +#define NEED_grok_numeric_radix +#define NEED_grok_oct +#define NEED_gv_fetchpvn_flags +#define NEED_load_module +#define NEED_mg_findext +#define NEED_my_snprintf +#define NEED_my_sprintf +#define NEED_my_strlcat +#define NEED_my_strlcpy +#define NEED_newCONSTSUB +#define NEED_newRV_noinc +#define NEED_newSV_type +#define NEED_newSVpvn_flags +#define NEED_newSVpvn_share +#define NEED_pv_display +#define NEED_pv_escape +#define NEED_pv_pretty +#define NEED_sv_2pv_flags +#define NEED_sv_2pvbyte +#define NEED_sv_catpvf_mg +#define NEED_sv_catpvf_mg_nocontext +#define NEED_sv_pvn_force_flags +#define NEED_sv_setpvf_mg +#define NEED_sv_setpvf_mg_nocontext +#define NEED_sv_unmagicext +#define NEED_SvRX +#define NEED_vload_module +#define NEED_vnewSVpvf +#define NEED_warner + +#include "ppport.h" + +#endif + +static int VARarg1; +static char *VARarg2; +static double VARarg3; + +#if defined(PERL_BCDVERSION) && (PERL_BCDVERSION < 0x5009005) +/* needed to make PL_parser apicheck work */ +typedef void yy_parser; +#endif + +HEAD + +if (@ARGV) { + my %want = map { ($_ => 0) } @ARGV; + @f = grep { exists $want{$_->{name}} } @f; + for (@f) { $want{$_->{name}}++ } + for (keys %want) { + die "nothing found for '$_'\n" unless $want{$_}; + } +} + +my $f; +for $f (@f) { + $ignore{$f->{name}} and next; + $f->{flags}{A} or next; # only public API members + + $ignore{$f->{name}} = 1; # ignore duplicates + + my $Perl_ = $f->{flags}{p} ? 'Perl_' : ''; + + my $stack = ''; + my @arg; + my $aTHX = ''; + + my $i = 1; + my $ca; + my $varargs = 0; + for $ca (@{$f->{args}}) { + my $a = $ca->[0]; + if ($a eq '...') { + $varargs = 1; + push @arg, qw(VARarg1 VARarg2 VARarg3); + last; + } + my($n, $p, $d) = $a =~ /^ (\w+(?:\s+\w+)*)\s* # type name => $n + (\**) # pointer => $p + (?:\s*const\s*)? # const + ((?:\[[^\]]*\])*) # dimension => $d + $/x + or die "$0 - cannot parse argument: [$a]\n"; + if (exists $amap{$n}) { + push @arg, $amap{$n}; + next; + } + $n = $tmap{$n} || $n; + if ($n eq 'const char' and $p eq '*' and !$f->{flags}{f}) { + push @arg, '"foo"'; + } + else { + my $v = 'arg' . $i++; + push @arg, $v; + $stack .= " static $n $p$v$d;\n"; + } + } + + unless ($f->{flags}{n} || $f->{flags}{'m'}) { + $stack = " dTHX;\n$stack"; + $aTHX = @arg ? 'aTHX_ ' : 'aTHX'; + } + + if ($stack{$f->{name}}) { + my $s = ''; + for (@{$stack{$f->{name}}}) { + $s .= " $_\n"; + } + $stack = "$s$stack"; + } + + my $args = join ', ', @arg; + my $rvt = $f->{ret} || 'void'; + my $ret; + if ($void{$rvt}) { + $ret = $castvoid{$f->{name}} ? '(void) ' : ''; + } + else { + $stack .= " $rvt rval;\n"; + $ret = $ignorerv{$f->{name}} ? '(void) ' : "rval = "; + } + my $aTHX_args = "$aTHX$args"; + + if (!$f->{flags}{'m'} or $f->{flags}{'b'} or @arg > 0) { + $args = "($args)"; + $aTHX_args = "($aTHX_args)"; + } + + print OUT <<HEAD; +/****************************************************************************** +* +* $f->{name} +* +******************************************************************************/ + +HEAD + + if ($todo{$f->{name}}) { + my($ver,$sub) = $todo{$f->{name}} =~ /^5\.(\d{3})(\d{3})$/ or die; + for ($ver, $sub) { + s/^0+(\d)/$1/ + } + if ($ver < 6 && $sub > 0) { + $sub =~ s/0$// or die; + } + print OUT "#if PERL_VERSION > $ver || (PERL_VERSION == $ver && PERL_SUBVERSION >= $sub) /* TODO */\n"; + } + + my $final = $varargs + ? "$Perl_$f->{name}$aTHX_args" + : "$f->{name}$args"; + + $f->{cond} and print OUT "#if $f->{cond}\n"; + + print OUT <<END; +void _DPPP_test_$f->{name} (void) +{ + dXSARGS; +$stack + { +#ifdef $f->{name} + $ret$f->{name}$args; +#endif + } + + { +#ifdef $f->{name} + $ret$final; +#else + $ret$Perl_$f->{name}$aTHX_args; +#endif + } +} +END + + $f->{cond} and print OUT "#endif\n"; + $todo{$f->{name}} and print OUT "#endif\n"; + + print OUT "\n"; +} + +@ARGV and close OUT; diff --git a/dist/Devel-PPPort/parts/apidoc.fnc b/dist/Devel-PPPort/parts/apidoc.fnc new file mode 100644 index 0000000000..fe153541b2 --- /dev/null +++ b/dist/Devel-PPPort/parts/apidoc.fnc @@ -0,0 +1,485 @@ +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +: +: !!!! Do NOT edit this file directly! -- Edit devel/mkapidoc.sh instead. !!!! +: +: This file was automatically generated from the API documentation scattered +: all over the Perl source code. To learn more about how all this works, +: please read the F<HACKERS> file that came with this distribution. +: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +: +: This file lists all API functions/macros that are documented in the Perl +: source code, but are not contained in F<embed.fnc>. +: + +AmUx|Perl_keyword_plugin_t|PL_keyword_plugin +AmU|Perl_check_t *|PL_check +AmU|yy_parser *|PL_parser +AmU||G_ARRAY +AmU||G_DISCARD +AmU||G_EVAL +AmU||G_NOARGS +AmU||G_SCALAR +AmU||G_VOID +AmU||HEf_SVKEY +AmU||MARK +AmU||Nullav +AmU||Nullch +AmU||Nullcv +AmU||Nullhv +AmU||Nullsv +AmU||ORIGMARK +AmU||SP +AmU||SVt_INVLIST +AmU||SVt_IV +AmU||SVt_NULL +AmU||SVt_NV +AmU||SVt_PV +AmU||SVt_PVAV +AmU||SVt_PVCV +AmU||SVt_PVFM +AmU||SVt_PVGV +AmU||SVt_PVHV +AmU||SVt_PVIO +AmU||SVt_PVIV +AmU||SVt_PVLV +AmU||SVt_PVMG +AmU||SVt_PVNV +AmU||SVt_REGEXP +AmU||UNDERBAR +AmU||XCPT_CATCH +AmU||XCPT_TRY_END +AmU||XCPT_TRY_START +AmU||XS +AmU||XS_EXTERNAL +AmU||XS_INTERNAL +AmU||XS_VERSION +AmU||newXSproto|char* name|XSUBADDR_t f|char* filename|const char *proto +AmU||svtype +Ama|SV*|newSVpvs_flags|const char* s|U32 flags +Ama|SV*|newSVpvs_share|const char* s +Ama|SV*|newSVpvs|const char* s +Ama|char*|savepvs|const char* s +Ama|char*|savesharedpvs|const char* s +Amn|(whatever)|RETVAL +Amn|(whatever)|THIS +Amn|HV*|PL_modglobal +Amn|I32|ax +Amn|I32|items +Amn|I32|ix +Amn|IV|POPi +Amn|NV|POPn +Amn|Perl_ophook_t|PL_opfreehook +Amn|STRLEN|PL_na +Amn|SV*|POPs +Amn|SV|PL_sv_no +Amn|SV|PL_sv_undef +Amn|SV|PL_sv_yes +Amn|U32|GIMME +Amn|U32|GIMME_V +Amn|UV|POPu +Amn|char*|CLASS +Amn|char*|POPp +Amn|char*|POPpbytex +Amn|char*|POPpx +Amn|long|POPl +Amn|long|POPul +Amn|peep_t|PL_peepp +Amn|peep_t|PL_rpeepp +Amn|void|DECLARATION_FOR_LC_NUMERIC_MANIPULATION +Ams||ENTER +Ams||FREETMPS +Ams||LEAVE +Ams||MULTICALL +Ams||POP_MULTICALL +Ams||PUSH_MULTICALL +Ams||PUTBACK +Ams||SAVETMPS +Ams||SPAGAIN +Ams||XCPT_RETHROW +Ams||XSRETURN_EMPTY +Ams||XSRETURN_NO +Ams||XSRETURN_UNDEF +Ams||XSRETURN_YES +Ams||XS_APIVERSION_BOOTCHECK +Ams||XS_VERSION_BOOTCHECK +Ams||dAX +Ams||dAXMARK +Ams||dITEMS +Ams||dMARK +Ams||dMULTICALL +Ams||dORIGMARK +Ams||dSP +Ams||dUNDERBAR +Ams||dXCPT +Ams||dXSARGS +Ams||dXSI32 +AmxU|PAD *|PL_comppad +AmxU|PADNAMELIST *|PL_comppad_name +AmxU|SV **|PL_curpad +AmxU|SV *|PL_parser-E<gt>linestr +AmxU|char *|PL_parser-E<gt>bufend +AmxU|char *|PL_parser-E<gt>bufptr +AmxU|char *|PL_parser-E<gt>linestart +Amx|COPHH *|cophh_copy|COPHH *cophh +Amx|COPHH *|cophh_delete_pvn|COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|U32 flags +Amx|COPHH *|cophh_delete_pvs|const COPHH *cophh|const char *key|U32 flags +Amx|COPHH *|cophh_delete_pv|const COPHH *cophh|const char *key|U32 hash|U32 flags +Amx|COPHH *|cophh_delete_sv|const COPHH *cophh|SV *key|U32 hash|U32 flags +Amx|COPHH *|cophh_new_empty +Amx|COPHH *|cophh_store_pvn|COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|SV *value|U32 flags +Amx|COPHH *|cophh_store_pvs|const COPHH *cophh|const char *key|SV *value|U32 flags +Amx|COPHH *|cophh_store_pv|const COPHH *cophh|const char *key|U32 hash|SV *value|U32 flags +Amx|COPHH *|cophh_store_sv|const COPHH *cophh|SV *key|U32 hash|SV *value|U32 flags +Amx|HV *|cophh_2hv|const COPHH *cophh|U32 flags +Amx|PAD **|PadlistARRAY|PADLIST padlist +Amx|PADLIST *|CvPADLIST|CV *cv +Amx|PADNAME **|PadlistNAMESARRAY|PADLIST padlist +Amx|PADNAME **|PadnamelistARRAY|PADNAMELIST pnl +Amx|PADNAMELIST *|PadlistNAMES|PADLIST padlist +Amx|SSize_t|PadMAX|PAD pad +Amx|SSize_t|PadlistMAX|PADLIST padlist +Amx|SSize_t|PadlistNAMESMAX|PADLIST padlist +Amx|SSize_t|PadnameREFCNT|PADNAME pn +Amx|SSize_t|PadnamelistMAX|PADNAMELIST pnl +Amx|SSize_t|PadnamelistREFCNT|PADNAMELIST pnl +Amx|STRLEN|PadnameLEN|PADNAME pn +Amx|SV **|PadARRAY|PAD pad +Amx|SV *|PadnameSV|PADNAME pn +Amx|SV *|cophh_fetch_pvn|const COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|U32 flags +Amx|SV *|cophh_fetch_pvs|const COPHH *cophh|const char *key|U32 flags +Amx|SV *|cophh_fetch_pv|const COPHH *cophh|const char *key|U32 hash|U32 flags +Amx|SV *|cophh_fetch_sv|const COPHH *cophh|SV *key|U32 hash|U32 flags +Amx|SV*|newSVpadname|PADNAME *pn +Amx|U32|PadlistREFCNT|PADLIST padlist +Amx|bool|PadnameUTF8|PADNAME pn +Amx|char *|PadnamePV|PADNAME pn +Amx|void|BhkDISABLE|BHK *hk|which +Amx|void|BhkENABLE|BHK *hk|which +Amx|void|BhkENTRY_set|BHK *hk|which|void *ptr +Amx|void|PadnameREFCNT_dec|PADNAME pn +Amx|void|PadnamelistREFCNT_dec|PADNAMELIST pnl +Amx|void|cophh_free|COPHH *cophh +Amx|void|lex_stuff_pvs|const char *pv|U32 flags +Am|AV*|GvAV|GV* gv +Am|CV*|GvCV|GV* gv +Am|HV *|cop_hints_2hv|const COP *cop|U32 flags +Am|HV*|CvSTASH|CV* cv +Am|HV*|GvHV|GV* gv +Am|HV*|SvSTASH|SV* sv +Am|HV*|gv_stashpvs|const char* name|I32 create +Am|IV|SvIVX|SV* sv +Am|IV|SvIV_nomg|SV* sv +Am|IV|SvIVx|SV* sv +Am|IV|SvIV|SV* sv +Am|NV|SvNVX|SV* sv +Am|NV|SvNV_nomg|SV* sv +Am|NV|SvNVx|SV* sv +Am|NV|SvNV|SV* sv +Am|OP*|LINKLIST|OP *o +Am|OP*|OpSIBLING|OP *o +Am|PADOFFSET|pad_add_name_pvs|const char *name|U32 flags|HV *typestash|HV *ourstash +Am|PADOFFSET|pad_findmy_pvs|const char *name|U32 flags +Am|REGEXP *|SvRX|SV *sv +Am|STRLEN|HeKLEN|HE* he +Am|STRLEN|HvENAMELEN|HV *stash +Am|STRLEN|HvNAMELEN|HV *stash +Am|STRLEN|SvCUR|SV* sv +Am|STRLEN|SvLEN|SV* sv +Am|STRLEN|UTF8SKIP|char* s +Am|STRLEN|UVCHR_SKIP|UV cp +Am|STRLEN|isUTF8_CHAR|const U8 *s|const U8 *e +Am|SV *|boolSV|bool b +Am|SV *|cop_hints_fetch_pvn|const COP *cop|const char *keypv|STRLEN keylen|U32 hash|U32 flags +Am|SV *|cop_hints_fetch_pvs|const COP *cop|const char *key|U32 flags +Am|SV *|cop_hints_fetch_pv|const COP *cop|const char *key|U32 hash|U32 flags +Am|SV *|cop_hints_fetch_sv|const COP *cop|SV *key|U32 hash|U32 flags +Am|SV *|sv_setref_pvs|const char* s +Am|SV**|hv_fetchs|HV* tb|const char* key|I32 lval +Am|SV**|hv_stores|HV* tb|const char* key|NULLOK SV* val +Am|SV*|GvSV|GV* gv +Am|SV*|HeSVKEY_force|HE* he +Am|SV*|HeSVKEY_set|HE* he|SV* sv +Am|SV*|HeSVKEY|HE* he +Am|SV*|HeVAL|HE* he +Am|SV*|ST|int ix +Am|SV*|SvREFCNT_inc_NN|SV* sv +Am|SV*|SvREFCNT_inc_simple_NN|SV* sv +Am|SV*|SvREFCNT_inc_simple|SV* sv +Am|SV*|SvREFCNT_inc|SV* sv +Am|SV*|SvRV|SV* sv +Am|SV*|newRV_inc|SV* sv +Am|SV*|newSVpvn_utf8|NULLOK const char* s|STRLEN len|U32 utf8 +Am|U32|HeHASH|HE* he +Am|U32|HeUTF8|HE* he +Am|U32|OP_CLASS|OP *o +Am|U32|SvGAMAGIC|SV* sv +Am|U32|SvIOKp|SV* sv +Am|U32|SvIOK|SV* sv +Am|U32|SvIsCOW|SV* sv +Am|U32|SvNIOKp|SV* sv +Am|U32|SvNIOK|SV* sv +Am|U32|SvNOKp|SV* sv +Am|U32|SvNOK|SV* sv +Am|U32|SvOK|SV* sv +Am|U32|SvOOK|SV* sv +Am|U32|SvPOKp|SV* sv +Am|U32|SvPOK|SV* sv +Am|U32|SvREFCNT|SV* sv +Am|U32|SvROK|SV* sv +Am|U32|SvUTF8|SV* sv +Am|U32|XopFLAGS|XOP *xop +Am|U8|READ_XDIGIT|char str* +Am|U8|toFOLD|U8 ch +Am|U8|toLOWER_L1|U8 ch +Am|U8|toLOWER_LC|U8 ch +Am|U8|toLOWER|U8 ch +Am|U8|toTITLE|U8 ch +Am|U8|toUPPER|U8 ch +Am|UV|SvUVX|SV* sv +Am|UV|SvUV_nomg|SV* sv +Am|UV|SvUVx|SV* sv +Am|UV|SvUV|SV* sv +Am|UV|toFOLD_utf8|U8* p|U8* s|STRLEN* lenp +Am|UV|toFOLD_uvchr|UV cp|U8* s|STRLEN* lenp +Am|UV|toLOWER_utf8|U8* p|U8* s|STRLEN* lenp +Am|UV|toLOWER_uvchr|UV cp|U8* s|STRLEN* lenp +Am|UV|toTITLE_utf8|U8* p|U8* s|STRLEN* lenp +Am|UV|toTITLE_uvchr|UV cp|U8* s|STRLEN* lenp +Am|UV|toUPPER_utf8|U8* p|U8* s|STRLEN* lenp +Am|UV|toUPPER_uvchr|UV cp|U8* s|STRLEN* lenp +Am|bool|DO_UTF8|SV* sv +Am|bool|OP_TYPE_IS_OR_WAS|OP *o|Optype type +Am|bool|OP_TYPE_IS|OP *o|Optype type +Am|bool|OpHAS_SIBLING|OP *o +Am|bool|SvIOK_UV|SV* sv +Am|bool|SvIOK_notUV|SV* sv +Am|bool|SvIsCOW_shared_hash|SV* sv +Am|bool|SvRXOK|SV* sv +Am|bool|SvTAINTED|SV* sv +Am|bool|SvTRUE_nomg|SV* sv +Am|bool|SvTRUE|SV* sv +Am|bool|SvUOK|SV* sv +Am|bool|SvVOK|SV* sv +Am|bool|isALPHANUMERIC|char ch +Am|bool|isALPHA|char ch +Am|bool|isASCII|char ch +Am|bool|isBLANK|char ch +Am|bool|isCNTRL|char ch +Am|bool|isDIGIT|char ch +Am|bool|isGRAPH|char ch +Am|bool|isIDCONT|char ch +Am|bool|isIDFIRST|char ch +Am|bool|isLOWER|char ch +Am|bool|isOCTAL|char ch +Am|bool|isPRINT|char ch +Am|bool|isPSXSPC|char ch +Am|bool|isPUNCT|char ch +Am|bool|isSPACE|char ch +Am|bool|isUPPER|char ch +Am|bool|isWORDCHAR|char ch +Am|bool|isXDIGIT|char ch +Am|bool|memEQ|char* s1|char* s2|STRLEN len +Am|bool|memNE|char* s1|char* s2|STRLEN len +Am|bool|strEQ|char* s1|char* s2 +Am|bool|strGE|char* s1|char* s2 +Am|bool|strGT|char* s1|char* s2 +Am|bool|strLE|char* s1|char* s2 +Am|bool|strLT|char* s1|char* s2 +Am|bool|strNE|char* s1|char* s2 +Am|bool|strnEQ|char* s1|char* s2|STRLEN len +Am|bool|strnNE|char* s1|char* s2|STRLEN len +Am|char *|SvGROW|SV* sv|STRLEN len +Am|char*|HePV|HE* he|STRLEN len +Am|char*|HvENAME|HV* stash +Am|char*|HvNAME|HV* stash +Am|char*|SvEND|SV* sv +Am|char*|SvPVX|SV* sv +Am|char*|SvPV_force_nomg|SV* sv|STRLEN len +Am|char*|SvPV_force|SV* sv|STRLEN len +Am|char*|SvPV_nolen|SV* sv +Am|char*|SvPV_nomg_nolen|SV* sv +Am|char*|SvPV_nomg|SV* sv|STRLEN len +Am|char*|SvPVbyte_force|SV* sv|STRLEN len +Am|char*|SvPVbyte_nolen|SV* sv +Am|char*|SvPVbytex_force|SV* sv|STRLEN len +Am|char*|SvPVbytex|SV* sv|STRLEN len +Am|char*|SvPVbyte|SV* sv|STRLEN len +Am|char*|SvPVutf8_force|SV* sv|STRLEN len +Am|char*|SvPVutf8_nolen|SV* sv +Am|char*|SvPVutf8x_force|SV* sv|STRLEN len +Am|char*|SvPVutf8x|SV* sv|STRLEN len +Am|char*|SvPVutf8|SV* sv|STRLEN len +Am|char*|SvPVx|SV* sv|STRLEN len +Am|char*|SvPV|SV* sv|STRLEN len +Am|const char *|OP_DESC|OP *o +Am|const char *|OP_NAME|OP *o +Am|int|AvFILL|AV* av +Am|svtype|SvTYPE|SV* sv +Am|unsigned char|HvENAMEUTF8|HV *stash +Am|unsigned char|HvNAMEUTF8|HV *stash +Am|void *|CopyD|void* src|void* dest|int nitems|type +Am|void *|MoveD|void* src|void* dest|int nitems|type +Am|void *|ZeroD|void* dest|int nitems|type +Am|void*|HeKEY|HE* he +Am|void|Copy|void* src|void* dest|int nitems|type +Am|void|EXTEND|SP|SSize_t nitems +Am|void|Move|void* src|void* dest|int nitems|type +Am|void|Newxc|void* ptr|int nitems|type|cast +Am|void|Newxz|void* ptr|int nitems|type +Am|void|Newx|void* ptr|int nitems|type +Am|void|OpLASTSIB_set|OP *o|OP *parent +Am|void|OpMAYBESIB_set|OP *o|OP *sib|OP *parent +Am|void|OpMORESIB_set|OP *o|OP *sib +Am|void|PERL_SYS_INIT3|int *argc|char*** argv|char*** env +Am|void|PERL_SYS_INIT|int *argc|char*** argv +Am|void|PERL_SYS_TERM| +Am|void|PUSHMARK|SP +Am|void|PUSHi|IV iv +Am|void|PUSHmortal +Am|void|PUSHn|NV nv +Am|void|PUSHp|char* str|STRLEN len +Am|void|PUSHs|SV* sv +Am|void|PUSHu|UV uv +Am|void|PoisonFree|void* dest|int nitems|type +Am|void|PoisonNew|void* dest|int nitems|type +Am|void|PoisonWith|void* dest|int nitems|type|U8 byte +Am|void|Poison|void* dest|int nitems|type +Am|void|RESTORE_LC_NUMERIC +Am|void|Renewc|void* ptr|int nitems|type|cast +Am|void|Renew|void* ptr|int nitems|type +Am|void|STORE_LC_NUMERIC_FORCE_TO_UNDERLYING +Am|void|STORE_LC_NUMERIC_SET_TO_NEEDED +Am|void|Safefree|void* ptr +Am|void|StructCopy|type *src|type *dest|type +Am|void|SvCUR_set|SV* sv|STRLEN len +Am|void|SvGETMAGIC|SV* sv +Am|void|SvIOK_off|SV* sv +Am|void|SvIOK_only_UV|SV* sv +Am|void|SvIOK_only|SV* sv +Am|void|SvIOK_on|SV* sv +Am|void|SvIV_set|SV* sv|IV val +Am|void|SvLEN_set|SV* sv|STRLEN len +Am|void|SvLOCK|SV* sv +Am|void|SvMAGIC_set|SV* sv|MAGIC* val +Am|void|SvNIOK_off|SV* sv +Am|void|SvNOK_off|SV* sv +Am|void|SvNOK_only|SV* sv +Am|void|SvNOK_on|SV* sv +Am|void|SvNV_set|SV* sv|NV val +Am|void|SvOOK_offset|NN SV*sv|STRLEN len +Am|void|SvPOK_off|SV* sv +Am|void|SvPOK_only_UTF8|SV* sv +Am|void|SvPOK_only|SV* sv +Am|void|SvPOK_on|SV* sv +Am|void|SvPV_set|SV* sv|char* val +Am|void|SvREFCNT_dec_NN|SV* sv +Am|void|SvREFCNT_dec|SV* sv +Am|void|SvREFCNT_inc_simple_void_NN|SV* sv +Am|void|SvREFCNT_inc_simple_void|SV* sv +Am|void|SvREFCNT_inc_void_NN|SV* sv +Am|void|SvREFCNT_inc_void|SV* sv +Am|void|SvROK_off|SV* sv +Am|void|SvROK_on|SV* sv +Am|void|SvRV_set|SV* sv|SV* val +Am|void|SvSETMAGIC|SV* sv +Am|void|SvSHARE|SV* sv +Am|void|SvSTASH_set|SV* sv|HV* val +Am|void|SvSetMagicSV_nosteal|SV* dsv|SV* ssv +Am|void|SvSetMagicSV|SV* dsv|SV* ssv +Am|void|SvSetSV_nosteal|SV* dsv|SV* ssv +Am|void|SvSetSV|SV* dsv|SV* ssv +Am|void|SvTAINTED_off|SV* sv +Am|void|SvTAINTED_on|SV* sv +Am|void|SvTAINT|SV* sv +Am|void|SvUNLOCK|SV* sv +Am|void|SvUPGRADE|SV* sv|svtype type +Am|void|SvUTF8_off|SV *sv +Am|void|SvUTF8_on|SV *sv +Am|void|SvUV_set|SV* sv|UV val +Am|void|XPUSHi|IV iv +Am|void|XPUSHmortal +Am|void|XPUSHn|NV nv +Am|void|XPUSHp|char* str|STRLEN len +Am|void|XPUSHs|SV* sv +Am|void|XPUSHu|UV uv +Am|void|XSRETURN_IV|IV iv +Am|void|XSRETURN_NV|NV nv +Am|void|XSRETURN_PV|char* str +Am|void|XSRETURN_UV|IV uv +Am|void|XSRETURN|int nitems +Am|void|XST_mIV|int pos|IV iv +Am|void|XST_mNO|int pos +Am|void|XST_mNV|int pos|NV nv +Am|void|XST_mPV|int pos|char* str +Am|void|XST_mUNDEF|int pos +Am|void|XST_mYES|int pos +Am|void|XopDISABLE|XOP *xop|which +Am|void|XopENABLE|XOP *xop|which +Am|void|XopENTRY_set|XOP *xop|which|value +Am|void|Zero|void* dest|int nitems|type +Am|void|mPUSHi|IV iv +Am|void|mPUSHn|NV nv +Am|void|mPUSHp|char* str|STRLEN len +Am|void|mPUSHs|SV* sv +Am|void|mPUSHu|UV uv +Am|void|mXPUSHi|IV iv +Am|void|mXPUSHn|NV nv +Am|void|mXPUSHp|char* str|STRLEN len +Am|void|mXPUSHs|SV* sv +Am|void|mXPUSHu|UV uv +Am|void|sv_catpv_nomg|SV* sv|const char* ptr +Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len +Am|void|sv_catpvs_flags|SV* sv|const char* s|I32 flags +Am|void|sv_catpvs_mg|SV* sv|const char* s +Am|void|sv_catpvs_nomg|SV* sv|const char* s +Am|void|sv_catpvs|SV* sv|const char* s +Am|void|sv_catsv_nomg|SV* dsv|SV* ssv +Am|void|sv_setpvs_mg|SV* sv|const char* s +Am|void|sv_setpvs|SV* sv|const char* s +Am|void|sv_setsv_nomg|SV* dsv|SV* ssv +Am||XopENTRYCUSTOM|const OP *o|which +Am||XopENTRY|XOP *xop|which +mU||LVRET +mn|GV *|PL_DBsub +mn|GV*|PL_last_in_gv +mn|GV*|PL_ofsgv +mn|SV *|PL_DBsingle +mn|SV *|PL_DBtrace +mn|SV*|PL_rs +mn|bool|PL_dowarn +ms||djSP +mx|U32|BhkFLAGS|BHK *hk +mx|void *|BhkENTRY|BHK *hk|which +mx|void|CALL_BLOCK_HOOKS|which|arg +m|HV *|PAD_COMPNAME_OURSTASH|PADOFFSET po +m|HV *|PAD_COMPNAME_TYPE|PADOFFSET po +m|HV *|PadnameOURSTASH +m|HV *|PadnameTYPE|PADNAME pn +m|STRLEN|PAD_COMPNAME_GEN_set|PADOFFSET po|int gen +m|STRLEN|PAD_COMPNAME_GEN|PADOFFSET po +m|SV *|CX_CURPAD_SV|struct context|PADOFFSET po +m|SV *|PAD_BASE_SV |PADLIST padlist|PADOFFSET po +m|SV *|PAD_SETSV |PADOFFSET po|SV* sv +m|SV *|PAD_SV |PADOFFSET po +m|SV *|PAD_SVl |PADOFFSET po +m|SV *|refcounted_he_fetch_pvs|const struct refcounted_he *chain|const char *key|U32 flags +m|U32|PAD_COMPNAME_FLAGS|PADOFFSET po +m|U32|SvTHINKFIRST|SV *sv +m|bool|CvWEAKOUTSIDE|CV *cv +m|bool|PadnameIsOUR|PADNAME pn +m|bool|PadnameIsSTATE|PADNAME pn +m|bool|PadnameOUTER|PADNAME pn +m|char *|PAD_COMPNAME_PV|PADOFFSET po +m|struct refcounted_he *|refcounted_he_new_pvs|struct refcounted_he *parent|const char *key|SV *value|U32 flags +m|void|CX_CURPAD_SAVE|struct context +m|void|PAD_CLONE_VARS|PerlInterpreter *proto_perl|CLONE_PARAMS* param +m|void|PAD_RESTORE_LOCAL|PAD *opad +m|void|PAD_SAVE_LOCAL|PAD *opad|PAD *npad +m|void|PAD_SAVE_SETNULLPAD +m|void|PAD_SET_CUR |PADLIST padlist|I32 n +m|void|PAD_SET_CUR_NOSAVE |PADLIST padlist|I32 n +m|void|SAVECLEARSV |SV **svp +m|void|SAVECOMPPAD +m|void|SAVEPADSV |PADOFFSET po diff --git a/dist/Devel-PPPort/parts/base/5003070 b/dist/Devel-PPPort/parts/base/5003070 new file mode 100644 index 0000000000..722f52f91f --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5003070 @@ -0,0 +1,42 @@ +5.003070 +HEf_SVKEY # E +HeHASH # U +HeKEY # U +HeKLEN # U +HeSVKEY # U +HeSVKEY_force # U +HeVAL # U +cv_const_sv # U +do_open # E (Perl_do_open) +gv_efullname3 # U +gv_fullname3 # U +gv_stashpvn # E +hv_delete_ent # U +hv_exists_ent # U +hv_fetch_ent # U +hv_iterkeysv # E +hv_ksplit # E +hv_store_ent # U +my_pclose # E (Perl_my_pclose) +my_popen # E (Perl_my_popen) +sv_gets # E (Perl_sv_gets) +unsharepvn # E +PERL_HASH # added by devel/scanprov +PERL_INT_MAX # added by devel/scanprov +PERL_INT_MIN # added by devel/scanprov +PERL_LONG_MAX # added by devel/scanprov +PERL_LONG_MIN # added by devel/scanprov +PERL_QUAD_MAX # added by devel/scanprov +PERL_QUAD_MIN # added by devel/scanprov +PERL_SHORT_MAX # added by devel/scanprov +PERL_SHORT_MIN # added by devel/scanprov +PERL_UCHAR_MAX # added by devel/scanprov +PERL_UCHAR_MIN # added by devel/scanprov +PERL_UINT_MAX # added by devel/scanprov +PERL_UINT_MIN # added by devel/scanprov +PERL_ULONG_MAX # added by devel/scanprov +PERL_ULONG_MIN # added by devel/scanprov +PERL_UQUAD_MAX # added by devel/scanprov +PERL_UQUAD_MIN # added by devel/scanprov +PERL_USHORT_MAX # added by devel/scanprov +PERL_USHORT_MIN # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5004000 b/dist/Devel-PPPort/parts/base/5004000 new file mode 100644 index 0000000000..38b77a1530 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5004000 @@ -0,0 +1,52 @@ +5.004000 +GIMME_V # E +G_VOID # E +HePV # A +HeSVKEY_set # U +POPu # E +PUSHu # U +SvSetMagicSV # U +SvSetMagicSV_nosteal # U +SvSetSV_nosteal # U +SvTAINTED # U +SvTAINTED_off # U +SvTAINTED_on # U +SvUV # U +SvUVX # U +SvUVx # U +XPUSHu # U +block_end # E (Perl_block_end) +block_gimme # E +block_start # E (Perl_block_start) +boolSV # U +call_list # E +delimcpy # U +gv_autoload4 # U +gv_fetchmethod_autoload # E +hv_delayfree_ent # E +hv_free_ent # E +ibcmp_locale # U +intro_my # E +isPRINT # U +memEQ # U +memNE # U +my_failure_exit # E +newRV_inc # U +newRV_noinc # E +rsignal # E +rsignal_state # E +save_I16 # E +save_gp # E +share_hek # E +start_subparse # E (Perl_start_subparse) +sv_2uv # U +sv_cmp_locale # E +sv_derived_from # E +sv_setuv # E +sv_taint # U +sv_tainted # E +sv_untaint # E +sv_vcatpvfn # E +sv_vsetpvfn # E +toLOWER_LC # U +SvUVXx # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5004010 b/dist/Devel-PPPort/parts/base/5004010 new file mode 100644 index 0000000000..8c29866603 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5004010 @@ -0,0 +1 @@ +5.004010 diff --git a/dist/Devel-PPPort/parts/base/5004020 b/dist/Devel-PPPort/parts/base/5004020 new file mode 100644 index 0000000000..4b43fdf8e4 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5004020 @@ -0,0 +1 @@ +5.004020 diff --git a/dist/Devel-PPPort/parts/base/5004030 b/dist/Devel-PPPort/parts/base/5004030 new file mode 100644 index 0000000000..e45facbb1f --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5004030 @@ -0,0 +1 @@ +5.004030 diff --git a/dist/Devel-PPPort/parts/base/5004040 b/dist/Devel-PPPort/parts/base/5004040 new file mode 100644 index 0000000000..69ccd5d62c --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5004040 @@ -0,0 +1 @@ +5.004040 diff --git a/dist/Devel-PPPort/parts/base/5004050 b/dist/Devel-PPPort/parts/base/5004050 new file mode 100644 index 0000000000..daf95d5f00 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5004050 @@ -0,0 +1,42 @@ +5.004050 +PL_na # E +PL_sv_no # E +PL_sv_undef # E +PL_sv_yes # E +SvGETMAGIC # U +do_binmode # E +my_bcopy # U +newCONSTSUB # E +newSVpvn # E +save_aelem # U +save_helem # U +sv_catpv_mg # E +sv_catpvn_mg # U +sv_catsv_mg # U +sv_setiv_mg # E +sv_setpv_mg # E +sv_setpvn_mg # E +sv_setsv_mg # E +sv_setuv_mg # E +sv_usepvn_mg # U +AvFILLp # added by devel/scanprov +DEFSV # added by devel/scanprov +ERRSV # added by devel/scanprov +PL_compiling # added by devel/scanprov +PL_curcop # added by devel/scanprov +PL_curstash # added by devel/scanprov +PL_debstash # added by devel/scanprov +PL_defgv # added by devel/scanprov +PL_diehook # added by devel/scanprov +PL_dirty # added by devel/scanprov +PL_errgv # added by devel/scanprov +PL_perl_destruct_level # added by devel/scanprov +PL_perldb # added by devel/scanprov +PL_stack_base # added by devel/scanprov +PL_stack_sp # added by devel/scanprov +PL_stdingv # added by devel/scanprov +PL_sv_arenaroot # added by devel/scanprov +PL_tainted # added by devel/scanprov +PL_tainting # added by devel/scanprov +SAVE_DEFSV # added by devel/scanprov +dTHR # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5005000 b/dist/Devel-PPPort/parts/base/5005000 new file mode 100644 index 0000000000..070a690e90 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5005000 @@ -0,0 +1,38 @@ +5.005000 +PL_curpad # E +PL_modglobal # E +cx_dump # U +debop # U +debprofdump # U +fbm_compile # E (Perl_fbm_compile) +fbm_instr # E (Perl_fbm_instr) +get_op_descs # E +get_op_names # E +init_stacks # E +mg_length # E +mg_size # E +newHVhv # E +new_stackinfo # E +regdump # U +regexec_flags # E +regnext # E (Perl_regnext) +runops_debug # E +runops_standard # E +save_iv # E (save_iv) +save_op # U +sv_iv # E +sv_peek # U +sv_pvn # E +sv_true # E +sv_uv # E +CPERLscope # added by devel/scanprov +END_EXTERN_C # added by devel/scanprov +EXTERN_C # added by devel/scanprov +NOOP # added by devel/scanprov +PL_DBsignal # added by devel/scanprov +PL_Sv # added by devel/scanprov +PL_hexdigit # added by devel/scanprov +PL_hints # added by devel/scanprov +PL_laststatval # added by devel/scanprov +PL_statcache # added by devel/scanprov +START_EXTERN_C # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5005010 b/dist/Devel-PPPort/parts/base/5005010 new file mode 100644 index 0000000000..deebff5bf8 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5005010 @@ -0,0 +1 @@ +5.005010 diff --git a/dist/Devel-PPPort/parts/base/5005020 b/dist/Devel-PPPort/parts/base/5005020 new file mode 100644 index 0000000000..d19ff2ae09 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5005020 @@ -0,0 +1 @@ +5.005020 diff --git a/dist/Devel-PPPort/parts/base/5005030 b/dist/Devel-PPPort/parts/base/5005030 new file mode 100644 index 0000000000..f268c751da --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5005030 @@ -0,0 +1,4 @@ +5.005030 +POPpx # E +get_vtbl # E +save_generic_svref # E diff --git a/dist/Devel-PPPort/parts/base/5005040 b/dist/Devel-PPPort/parts/base/5005040 new file mode 100644 index 0000000000..8a165c2033 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5005040 @@ -0,0 +1 @@ +5.005040 diff --git a/dist/Devel-PPPort/parts/base/5006000 b/dist/Devel-PPPort/parts/base/5006000 new file mode 100644 index 0000000000..6cf8275d7e --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5006000 @@ -0,0 +1,293 @@ +5.006000 +DO_UTF8 # U +PERL_SYS_INIT3 # U +POPn # E +POPul # E +PUSHn # E +SvIOK_UV # U +SvIOK_notUV # U +SvIOK_only_UV # U +SvNV # E +SvNVX # E +SvNV_set # E +SvNVx # E +SvPOK_only_UTF8 # U +SvPV_nolen # U +SvPVbyte # U +SvPVbyte_nolen # U +SvPVbytex # U +SvPVbytex_force # U +SvPVutf8 # U +SvPVutf8_force # U +SvPVutf8_nolen # U +SvPVutf8x # U +SvPVutf8x_force # U +SvUTF8 # U +SvUTF8_off # U +SvUTF8_on # U +UTF8SKIP # U +XPUSHn # E +XSRETURN_NV # E +XST_mNV # E +av_delete # E +av_exists # E +call_argv # E (perl_call_argv) +call_atexit # E +call_method # E (perl_call_method) +call_pv # E (perl_call_pv) +call_sv # E (perl_call_sv) +cast_i32 # E (cast_i32) +cast_iv # E (cast_iv) +cast_ulong # E +cast_uv # E (cast_uv) +croak # E (Perl_croak) +die # E (Perl_die) +do_gv_dump # E +do_gvgv_dump # E +do_hv_dump # E +do_magic_dump # E +do_op_dump # E +do_open9 # E +do_pmop_dump # E +do_sv_dump # E +dump_all # U +dump_eval # U +dump_form # U +dump_indent # E +dump_packsubs # U +dump_sub # U +dump_vindent # E +eval_pv # E (perl_eval_pv) +eval_sv # E (perl_eval_sv) +form # E (Perl_form) +get_av # E (perl_get_av) +get_context # U +get_cv # E (perl_get_cv) +get_hv # E (perl_get_hv) +get_ppaddr # E +get_sv # E (perl_get_sv) +gv_dump # E +init_i18nl10n # E (perl_init_i18nl10n) +init_i18nl14n # E (perl_init_i18nl14n) +isASCII # U +isCNTRL # U +isGRAPH # U +isPUNCT # U +isXDIGIT # U +is_uni_alnum # E +is_uni_alnum_lc # E +is_uni_alpha # E +is_uni_alpha_lc # E +is_uni_ascii # E +is_uni_ascii_lc # E +is_uni_cntrl # E +is_uni_cntrl_lc # E +is_uni_digit # E +is_uni_digit_lc # E +is_uni_graph # E +is_uni_graph_lc # E +is_uni_idfirst # E +is_uni_idfirst_lc # E +is_uni_lower # E +is_uni_lower_lc # E +is_uni_print # E +is_uni_print_lc # E +is_uni_punct # E +is_uni_punct_lc # E +is_uni_space # E +is_uni_space_lc # E +is_uni_upper # E +is_uni_upper_lc # E +is_uni_xdigit # E +is_uni_xdigit_lc # E +is_utf8_alnum # E +is_utf8_alpha # E +is_utf8_ascii # E +is_utf8_char # U +is_utf8_cntrl # E +is_utf8_digit # E +is_utf8_graph # E +is_utf8_idfirst # E +is_utf8_lower # E +is_utf8_mark # E +is_utf8_print # E +is_utf8_punct # E +is_utf8_space # E +is_utf8_upper # E +is_utf8_xdigit # E +load_module # E +magic_dump # E +mess # E (Perl_mess) +my_atof # E +my_fflush_all # E +newANONATTRSUB # E +newATTRSUB # U +newSVnv # E (Perl_newSVnv) +newSVpvf # E (Perl_newSVpvf) +newSVuv # E +newXS # E (Perl_newXS) +newXSproto # E +new_collate # E (perl_new_collate) +new_ctype # E (perl_new_ctype) +new_numeric # E (perl_new_numeric) +op_dump # E +perl_parse # E (perl_parse) +pmop_dump # E +pv_display # E +re_intuit_string # E +reginitcolors # E +require_pv # E (perl_require_pv) +safesyscalloc # U +safesysfree # U +safesysmalloc # U +safesysrealloc # U +save_I8 # E +save_alloc # E +save_destructor # E (Perl_save_destructor) +save_destructor_x # E +save_re_context # E +save_vptr # E +scan_bin # E +scan_hex # E (Perl_scan_hex) +scan_oct # E (Perl_scan_oct) +set_context # U +set_numeric_local # E (perl_set_numeric_local) +set_numeric_radix # E +set_numeric_standard # E (perl_set_numeric_standard) +str_to_version # E +sv_2pv_nolen # U +sv_2pvbyte # E +sv_2pvbyte_nolen # U +sv_2pvutf8 # E +sv_2pvutf8_nolen # U +sv_catpvf # E (Perl_sv_catpvf) +sv_catpvf_mg # E (Perl_sv_catpvf_mg) +sv_force_normal # U +sv_len_utf8 # E +sv_nv # E (Perl_sv_nv) +sv_pos_b2u # E +sv_pos_u2b # E +sv_pv # U +sv_pvbyte # U +sv_pvbyten # E +sv_pvbyten_force # E +sv_pvutf8 # U +sv_pvutf8n # E +sv_pvutf8n_force # E +sv_rvweaken # E +sv_setnv # E (Perl_sv_setnv) +sv_setnv_mg # E (Perl_sv_setnv_mg) +sv_setpvf # E (Perl_sv_setpvf) +sv_setpvf_mg # E (Perl_sv_setpvf_mg) +sv_setref_nv # E (Perl_sv_setref_nv) +sv_utf8_decode # E +sv_utf8_downgrade # E +sv_utf8_encode # E +sv_vcatpvf # E +sv_vcatpvf_mg # E +sv_vsetpvf # E +sv_vsetpvf_mg # E +swash_init # E +to_uni_lower_lc # E +to_uni_title_lc # E +to_uni_upper_lc # E +utf8_distance # E +utf8_hop # U +vcroak # E +vform # E +vload_module # E +vmess # E +vnewSVpvf # E +vwarn # E +vwarner # E +warn # E (Perl_warn) +warner # E +CopFILE # added by devel/scanprov +CopFILEAV # added by devel/scanprov +CopFILEGV # added by devel/scanprov +CopFILEGV_set # added by devel/scanprov +CopFILESV # added by devel/scanprov +CopFILE_set # added by devel/scanprov +CopSTASH # added by devel/scanprov +CopSTASHPV # added by devel/scanprov +CopSTASHPV_set # added by devel/scanprov +CopSTASH_eq # added by devel/scanprov +CopSTASH_set # added by devel/scanprov +INT2PTR # added by devel/scanprov +IVSIZE # added by devel/scanprov +IVTYPE # added by devel/scanprov +IVdf # added by devel/scanprov +NUM2PTR # added by devel/scanprov +NVTYPE # added by devel/scanprov +PERL_REVISION # added by devel/scanprov +PERL_SUBVERSION # added by devel/scanprov +PERL_VERSION # added by devel/scanprov +PL_no_modify # added by devel/scanprov +PL_ppaddr # added by devel/scanprov +PTR2IV # added by devel/scanprov +PTR2NV # added by devel/scanprov +PTR2UV # added by devel/scanprov +PTRV # added by devel/scanprov +SVf # added by devel/scanprov +SVf_UTF8 # added by devel/scanprov +UVSIZE # added by devel/scanprov +UVTYPE # added by devel/scanprov +UVof # added by devel/scanprov +UVuf # added by devel/scanprov +UVxf # added by devel/scanprov +WARN_ALL # added by devel/scanprov +WARN_AMBIGUOUS # added by devel/scanprov +WARN_BAREWORD # added by devel/scanprov +WARN_CLOSED # added by devel/scanprov +WARN_CLOSURE # added by devel/scanprov +WARN_DEBUGGING # added by devel/scanprov +WARN_DEPRECATED # added by devel/scanprov +WARN_DIGIT # added by devel/scanprov +WARN_EXEC # added by devel/scanprov +WARN_EXITING # added by devel/scanprov +WARN_GLOB # added by devel/scanprov +WARN_INPLACE # added by devel/scanprov +WARN_INTERNAL # added by devel/scanprov +WARN_IO # added by devel/scanprov +WARN_MALLOC # added by devel/scanprov +WARN_MISC # added by devel/scanprov +WARN_NEWLINE # added by devel/scanprov +WARN_NUMERIC # added by devel/scanprov +WARN_ONCE # added by devel/scanprov +WARN_OVERFLOW # added by devel/scanprov +WARN_PACK # added by devel/scanprov +WARN_PARENTHESIS # added by devel/scanprov +WARN_PIPE # added by devel/scanprov +WARN_PORTABLE # added by devel/scanprov +WARN_PRECEDENCE # added by devel/scanprov +WARN_PRINTF # added by devel/scanprov +WARN_PROTOTYPE # added by devel/scanprov +WARN_QW # added by devel/scanprov +WARN_RECURSION # added by devel/scanprov +WARN_REDEFINE # added by devel/scanprov +WARN_REGEXP # added by devel/scanprov +WARN_RESERVED # added by devel/scanprov +WARN_SEMICOLON # added by devel/scanprov +WARN_SEVERE # added by devel/scanprov +WARN_SIGNAL # added by devel/scanprov +WARN_SUBSTR # added by devel/scanprov +WARN_SYNTAX # added by devel/scanprov +WARN_TAINT # added by devel/scanprov +WARN_UNINITIALIZED # added by devel/scanprov +WARN_UNOPENED # added by devel/scanprov +WARN_UNPACK # added by devel/scanprov +WARN_UNTIE # added by devel/scanprov +WARN_UTF8 # added by devel/scanprov +WARN_VOID # added by devel/scanprov +XSprePUSH # added by devel/scanprov +aTHX # added by devel/scanprov +aTHX_ # added by devel/scanprov +ckWARN # added by devel/scanprov +dNOOP # added by devel/scanprov +dTHX # added by devel/scanprov +dTHXa # added by devel/scanprov +dTHXoa # added by devel/scanprov +dXSTARG # added by devel/scanprov +isALNUMC # added by devel/scanprov +pTHX # added by devel/scanprov +pTHX_ # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5006001 b/dist/Devel-PPPort/parts/base/5006001 new file mode 100644 index 0000000000..b3626c0b55 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5006001 @@ -0,0 +1,17 @@ +5.006001 +SvGAMAGIC # U +apply_attrs_string # U +bytes_to_utf8 # U +gv_efullname4 # U +gv_fullname4 # U +isBLANK # U +isPSXSPC # U +is_utf8_string # U +save_generic_pvref # U +utf16_to_utf8 # E (Perl_utf16_to_utf8) +utf16_to_utf8_reversed # E (Perl_utf16_to_utf8_reversed) +utf8_to_bytes # U +G_METHOD # added by devel/scanprov +NVef # added by devel/scanprov +NVff # added by devel/scanprov +NVgf # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5006002 b/dist/Devel-PPPort/parts/base/5006002 new file mode 100644 index 0000000000..dfe09ce2c5 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5006002 @@ -0,0 +1 @@ +5.006002 diff --git a/dist/Devel-PPPort/parts/base/5007000 b/dist/Devel-PPPort/parts/base/5007000 new file mode 100644 index 0000000000..49d08465db --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5007000 @@ -0,0 +1 @@ +5.007000 diff --git a/dist/Devel-PPPort/parts/base/5007001 b/dist/Devel-PPPort/parts/base/5007001 new file mode 100644 index 0000000000..3de815ec8d --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5007001 @@ -0,0 +1,28 @@ +5.007001 +ASCII_TO_NEED # U +NATIVE_TO_NEED # U +POPpbytex # E +SvUOK # U +bytes_from_utf8 # U +despatch_signals # U +do_openn # U +gv_handler # U +is_lvalue_sub # U +my_popen_list # U +newSVpvn_share # U +save_mortalizesv # U +scan_num # E (Perl_scan_num) +sv_force_normal_flags # U +sv_setref_uv # U +sv_unref_flags # U +sv_utf8_upgrade # E (Perl_sv_utf8_upgrade) +utf8_length # U +utf8_to_uvchr # U +utf8_to_uvuni # U +utf8n_to_uvchr # U +utf8n_to_uvuni # U +uvchr_to_utf8 # U +uvuni_to_utf8 # U +PTR2ul # added by devel/scanprov +SV_IMMEDIATE_UNREF # added by devel/scanprov +UVXf # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5007002 b/dist/Devel-PPPort/parts/base/5007002 new file mode 100644 index 0000000000..393fcf1f6b --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5007002 @@ -0,0 +1,72 @@ +5.007002 +SvPV_force_nomg # U +SvPV_nomg # U +calloc # U +dAX # E +dITEMS # E +getcwd_sv # U +grok_number # U +grok_numeric_radix # U +init_tm # U +malloc # U +mfree # U +mini_mktime # U +my_atof2 # U +my_strftime # U +op_null # U +realloc # U +sv_2pv_flags # U +sv_catpvn_flags # U +sv_catpvn_nomg # U +sv_catsv_flags # U +sv_catsv_nomg # U +sv_pvn_force_flags # U +sv_setsv_flags # U +sv_setsv_nomg # U +sv_utf8_upgrade_flags # U +sv_utf8_upgrade_nomg # U +swash_fetch # E (Perl_swash_fetch) +GROK_NUMERIC_RADIX # added by devel/scanprov +IN_LOCALE # added by devel/scanprov +IN_LOCALE_COMPILETIME # added by devel/scanprov +IN_LOCALE_RUNTIME # added by devel/scanprov +IS_NUMBER_GREATER_THAN_UV_MAX # added by devel/scanprov +IS_NUMBER_INFINITY # added by devel/scanprov +IS_NUMBER_IN_UV # added by devel/scanprov +IS_NUMBER_NEG # added by devel/scanprov +IS_NUMBER_NOT_INT # added by devel/scanprov +PERL_MAGIC_arylen # added by devel/scanprov +PERL_MAGIC_backref # added by devel/scanprov +PERL_MAGIC_bm # added by devel/scanprov +PERL_MAGIC_collxfrm # added by devel/scanprov +PERL_MAGIC_dbfile # added by devel/scanprov +PERL_MAGIC_dbline # added by devel/scanprov +PERL_MAGIC_defelem # added by devel/scanprov +PERL_MAGIC_env # added by devel/scanprov +PERL_MAGIC_envelem # added by devel/scanprov +PERL_MAGIC_ext # added by devel/scanprov +PERL_MAGIC_fm # added by devel/scanprov +PERL_MAGIC_isa # added by devel/scanprov +PERL_MAGIC_isaelem # added by devel/scanprov +PERL_MAGIC_nkeys # added by devel/scanprov +PERL_MAGIC_overload_table # added by devel/scanprov +PERL_MAGIC_pos # added by devel/scanprov +PERL_MAGIC_qr # added by devel/scanprov +PERL_MAGIC_regdata # added by devel/scanprov +PERL_MAGIC_regdatum # added by devel/scanprov +PERL_MAGIC_regex_global # added by devel/scanprov +PERL_MAGIC_sig # added by devel/scanprov +PERL_MAGIC_sigelem # added by devel/scanprov +PERL_MAGIC_substr # added by devel/scanprov +PERL_MAGIC_sv # added by devel/scanprov +PERL_MAGIC_taint # added by devel/scanprov +PERL_MAGIC_tied # added by devel/scanprov +PERL_MAGIC_tiedelem # added by devel/scanprov +PERL_MAGIC_tiedscalar # added by devel/scanprov +PERL_MAGIC_uvar # added by devel/scanprov +PERL_MAGIC_vec # added by devel/scanprov +PERL_UNUSED_DECL # added by devel/scanprov +PERL_UNUSED_VAR # added by devel/scanprov +SV_GMAGIC # added by devel/scanprov +SvPV_flags # added by devel/scanprov +SvPV_force_flags # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5007003 b/dist/Devel-PPPort/parts/base/5007003 new file mode 100644 index 0000000000..127a118dae --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5007003 @@ -0,0 +1,83 @@ +5.007003 +OP_DESC # U +OP_NAME # U +PL_peepp # E +PerlIO_clearerr # U (PerlIO_clearerr) +PerlIO_close # U (PerlIO_close) +PerlIO_eof # U (PerlIO_eof) +PerlIO_error # U (PerlIO_error) +PerlIO_fileno # U (PerlIO_fileno) +PerlIO_fill # U (PerlIO_fill) +PerlIO_flush # U (PerlIO_flush) +PerlIO_get_base # U (PerlIO_get_base) +PerlIO_get_bufsiz # U (PerlIO_get_bufsiz) +PerlIO_get_cnt # U (PerlIO_get_cnt) +PerlIO_get_ptr # U (PerlIO_get_ptr) +PerlIO_read # U (PerlIO_read) +PerlIO_seek # U (PerlIO_seek) +PerlIO_set_cnt # U (PerlIO_set_cnt) +PerlIO_set_ptrcnt # U (PerlIO_set_ptrcnt) +PerlIO_setlinebuf # U (PerlIO_setlinebuf) +PerlIO_stderr # U (PerlIO_stderr) +PerlIO_stdin # U (PerlIO_stdin) +PerlIO_stdout # U (PerlIO_stdout) +PerlIO_tell # U (PerlIO_tell) +PerlIO_unread # U (PerlIO_unread) +PerlIO_write # U (PerlIO_write) +SvLOCK # U +SvSHARE # U +SvUNLOCK # U +atfork_lock # U +atfork_unlock # U +custom_op_desc # U +custom_op_name # U +deb # U +debstack # U +debstackptrs # U +grok_bin # U +grok_hex # U +grok_oct # U +gv_fetchmeth_autoload # U +ibcmp_utf8 # U +my_fork # U +my_socketpair # U +pack_cat # U +perl_destruct # E (perl_destruct) +pv_uni_display # U +save_shared_pvref # U +savesharedpv # U +sortsv # U +sv_magicext # U +sv_nolocking # U +sv_nosharing # U +sv_pvn_nomg # U +sv_recode_to_utf8 # U +sv_uni_display # U +to_uni_fold # U +to_uni_lower # E (Perl_to_uni_lower) +to_uni_title # E (Perl_to_uni_title) +to_uni_upper # E (Perl_to_uni_upper) +to_utf8_case # U +unpack_str # U +uvchr_to_utf8_flags # U +uvuni_to_utf8_flags # U +vdeb # U +IS_NUMBER_NAN # added by devel/scanprov +MY_CXT # added by devel/scanprov +MY_CXT_INIT # added by devel/scanprov +PERL_MAGIC_shared # added by devel/scanprov +PERL_MAGIC_shared_scalar # added by devel/scanprov +PERL_MAGIC_uvar_elem # added by devel/scanprov +PERL_SCAN_ALLOW_UNDERSCORES # added by devel/scanprov +PERL_SCAN_DISALLOW_PREFIX # added by devel/scanprov +PERL_SCAN_GREATER_THAN_UV_MAX # added by devel/scanprov +START_MY_CXT # added by devel/scanprov +_aMY_CXT # added by devel/scanprov +_pMY_CXT # added by devel/scanprov +aMY_CXT # added by devel/scanprov +aMY_CXT_ # added by devel/scanprov +dMY_CXT # added by devel/scanprov +dMY_CXT_SV # added by devel/scanprov +pMY_CXT # added by devel/scanprov +pMY_CXT_ # added by devel/scanprov +packWARN # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5008000 b/dist/Devel-PPPort/parts/base/5008000 new file mode 100644 index 0000000000..8af2dfae4d --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5008000 @@ -0,0 +1,8 @@ +5.008000 +Poison # E +hv_iternext_flags # U +hv_store_flags # U +is_utf8_idcont # U +nothreadhook # U +WARN_LAYER # added by devel/scanprov +WARN_THREADS # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5008001 b/dist/Devel-PPPort/parts/base/5008001 new file mode 100644 index 0000000000..93df2b486e --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5008001 @@ -0,0 +1,31 @@ +5.008001 +CvPADLIST # E +PL_comppad # E +SvVOK # U +XSRETURN_UV # U +doing_taint # U +find_runcv # U +is_utf8_string_loc # U +packlist # U +pad_add_anon # U +pad_new # E +pad_tidy # E +save_bool # U +savestack_grow_cnt # U +seed # U +sv_cat_decode # U +sv_setpviv # U +sv_setpviv_mg # U +unpackstring # U +C_ARRAY_LENGTH # added by devel/scanprov +IN_PERL_COMPILETIME # added by devel/scanprov +PERL_ABS # added by devel/scanprov +PERL_GCC_BRACE_GROUPS_FORBIDDEN # added by devel/scanprov +PERL_MAGIC_utf8 # added by devel/scanprov +PERL_MAGIC_vstring # added by devel/scanprov +PERL_SCAN_SILENT_ILLDIGIT # added by devel/scanprov +PERL_SIGNALS_UNSAFE_FLAG # added by devel/scanprov +PL_signals # added by devel/scanprov +SV_COW_DROP_PV # added by devel/scanprov +SV_UTF8_NO_ENCODING # added by devel/scanprov +XST_mUV # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5008002 b/dist/Devel-PPPort/parts/base/5008002 new file mode 100644 index 0000000000..63aac525fe --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5008002 @@ -0,0 +1 @@ +5.008002 diff --git a/dist/Devel-PPPort/parts/base/5008003 b/dist/Devel-PPPort/parts/base/5008003 new file mode 100644 index 0000000000..50c6ce1aa1 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5008003 @@ -0,0 +1,3 @@ +5.008003 +SvIsCOW # U +SvIsCOW_shared_hash # U diff --git a/dist/Devel-PPPort/parts/base/5008004 b/dist/Devel-PPPort/parts/base/5008004 new file mode 100644 index 0000000000..bb7bcdf66a --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5008004 @@ -0,0 +1 @@ +5.008004 diff --git a/dist/Devel-PPPort/parts/base/5008005 b/dist/Devel-PPPort/parts/base/5008005 new file mode 100644 index 0000000000..7bd2029f4b --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5008005 @@ -0,0 +1 @@ +5.008005 diff --git a/dist/Devel-PPPort/parts/base/5008006 b/dist/Devel-PPPort/parts/base/5008006 new file mode 100644 index 0000000000..ba5cad07ed --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5008006 @@ -0,0 +1 @@ +5.008006 diff --git a/dist/Devel-PPPort/parts/base/5008007 b/dist/Devel-PPPort/parts/base/5008007 new file mode 100644 index 0000000000..7d656f0b9e --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5008007 @@ -0,0 +1 @@ +5.008007 diff --git a/dist/Devel-PPPort/parts/base/5008008 b/dist/Devel-PPPort/parts/base/5008008 new file mode 100644 index 0000000000..f17b19ff4b --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5008008 @@ -0,0 +1 @@ +5.008008 diff --git a/dist/Devel-PPPort/parts/base/5008009 b/dist/Devel-PPPort/parts/base/5008009 new file mode 100644 index 0000000000..129e018f45 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5008009 @@ -0,0 +1 @@ +5.008009 diff --git a/dist/Devel-PPPort/parts/base/5009000 b/dist/Devel-PPPort/parts/base/5009000 new file mode 100644 index 0000000000..28bc85958e --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5009000 @@ -0,0 +1,6 @@ +5.009000 +new_version # U +save_set_svflags # U +vcmp # U +vnumify # U +vstringify # U diff --git a/dist/Devel-PPPort/parts/base/5009001 b/dist/Devel-PPPort/parts/base/5009001 new file mode 100644 index 0000000000..0666184e1d --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5009001 @@ -0,0 +1,8 @@ +5.009001 +SvIV_nomg # U +SvUV_nomg # U +hv_clear_placeholders # U +hv_scalar # U +scan_version # E (Perl_scan_version) +sv_2iv_flags # U +sv_2uv_flags # U diff --git a/dist/Devel-PPPort/parts/base/5009002 b/dist/Devel-PPPort/parts/base/5009002 new file mode 100644 index 0000000000..65d7de9072 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5009002 @@ -0,0 +1,32 @@ +5.009002 +CopyD # E +MoveD # E +PUSHmortal # E +SvPVbyte_force # U +UNDERBAR # E +XCPT_CATCH # E +XCPT_RETHROW # E +XCPT_TRY_END # E +XCPT_TRY_START # E +XPUSHmortal # E +ZeroD # E +dUNDERBAR # E +dXCPT # E +find_rundefsvoffset # U +gv_fetchpvn_flags # U +gv_fetchsv # U +mPUSHi # U +mPUSHn # U +mPUSHp # U +mPUSHu # U +mXPUSHi # U +mXPUSHn # U +mXPUSHp # U +mXPUSHu # U +op_refcnt_lock # U +op_refcnt_unlock # U +savesvpv # U +vnormal # U +MY_CXT_CLONE # added by devel/scanprov +SV_NOSTEAL # added by devel/scanprov +UTF8_MAXBYTES # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5009003 b/dist/Devel-PPPort/parts/base/5009003 new file mode 100644 index 0000000000..8b69a99fdd --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5009003 @@ -0,0 +1,66 @@ +5.009003 +Newx # E +Newxc # E +Newxz # E +PL_check # E +SvMAGIC_set # U +SvRV_set # U +SvSTASH_set # U +SvUV_set # U +av_arylen_p # U +ckwarn # U +ckwarn_d # U +csighandler # E (Perl_csighandler) +dAXMARK # E +dMULTICALL # E +doref # U +gv_const_sv # U +gv_stashpvs # U +hv_eiter_p # U +hv_eiter_set # U +hv_fetchs # U +hv_name_set # U +hv_placeholders_get # U +hv_placeholders_set # U +hv_riter_p # U +hv_riter_set # U +is_utf8_string_loclen # U +my_sprintf # U +newGIVENOP # U +newSVhek # U +newSVpvs # U +newSVpvs_share # U +newWHENOP # U +pad_compname_type # U +savepvs # U +sortsv_flags # U +sv_catpvs # U +vverify # U +HvNAMELEN_get # added by devel/scanprov +HvNAME_get # added by devel/scanprov +PERLIO_FUNCS_CAST # added by devel/scanprov +PERLIO_FUNCS_DECL # added by devel/scanprov +PERL_UNUSED_ARG # added by devel/scanprov +PTR2nat # added by devel/scanprov +STR_WITH_LEN # added by devel/scanprov +SV_CONST_RETURN # added by devel/scanprov +SV_MUTABLE_RETURN # added by devel/scanprov +SV_SMAGIC # added by devel/scanprov +SvPVX_const # added by devel/scanprov +SvPVX_mutable # added by devel/scanprov +SvPV_const # added by devel/scanprov +SvPV_flags_const # added by devel/scanprov +SvPV_flags_const_nolen # added by devel/scanprov +SvPV_flags_mutable # added by devel/scanprov +SvPV_force_flags_mutable # added by devel/scanprov +SvPV_force_flags_nolen # added by devel/scanprov +SvPV_force_mutable # added by devel/scanprov +SvPV_force_nolen # added by devel/scanprov +SvPV_force_nomg_nolen # added by devel/scanprov +SvPV_mutable # added by devel/scanprov +SvPV_nolen_const # added by devel/scanprov +SvPV_nomg_const # added by devel/scanprov +SvPV_nomg_const_nolen # added by devel/scanprov +SvPV_renew # added by devel/scanprov +SvSHARED_HASH # added by devel/scanprov +dVAR # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5009004 b/dist/Devel-PPPort/parts/base/5009004 new file mode 100644 index 0000000000..5a2f6b8ba7 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5009004 @@ -0,0 +1,42 @@ +5.009004 +PerlIO_context_layers # U +PoisonFree # E +PoisonNew # E +PoisonWith # E +SvREFCNT_inc_NN # U +SvREFCNT_inc_simple # U +SvREFCNT_inc_simple_NN # U +SvREFCNT_inc_simple_void # U +SvREFCNT_inc_simple_void_NN # U +SvREFCNT_inc_void # U +SvREFCNT_inc_void_NN # U +gv_name_set # U +hv_copy_hints_hv # U +hv_stores # U +my_snprintf # U +my_strlcat # U +my_strlcpy # U +my_vsnprintf # U +newXS_flags # U +pv_escape # U +pv_pretty # U +regclass_swash # E (Perl_regclass_swash) +sv_does # U +sv_setpvs # U +sv_usepvn_flags # U +PERL_PV_ESCAPE_ALL # added by devel/scanprov +PERL_PV_ESCAPE_FIRSTCHAR # added by devel/scanprov +PERL_PV_ESCAPE_NOBACKSLASH # added by devel/scanprov +PERL_PV_ESCAPE_NOCLEAR # added by devel/scanprov +PERL_PV_ESCAPE_QUOTE # added by devel/scanprov +PERL_PV_ESCAPE_UNI # added by devel/scanprov +PERL_PV_ESCAPE_UNI_DETECT # added by devel/scanprov +PERL_PV_PRETTY_DUMP # added by devel/scanprov +PERL_PV_PRETTY_LTGT # added by devel/scanprov +PERL_PV_PRETTY_QUOTE # added by devel/scanprov +PERL_PV_PRETTY_REGPROP # added by devel/scanprov +PERL_UNUSED_CONTEXT # added by devel/scanprov +PERL_USE_GCC_BRACE_GROUPS # added by devel/scanprov +SV_HAS_TRAILING_NUL # added by devel/scanprov +SvVSTRING_mg # added by devel/scanprov +gv_fetchpvs # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5009005 b/dist/Devel-PPPort/parts/base/5009005 new file mode 100644 index 0000000000..8ddae03de6 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5009005 @@ -0,0 +1,37 @@ +5.009005 +PL_parser # E +Perl_signbit # U +SvRX # U +SvRXOK # U +av_create_and_push # U +av_create_and_unshift_one # U +get_cvn_flags # U +gv_fetchfile_flags # U +lex_start # E (Perl_lex_start) +mro_get_linear_isa # U +mro_method_changed_in # U +my_dirfd # U +newSV_type # U +pregcomp # E (Perl_pregcomp) +ptr_table_clear # U +ptr_table_fetch # U +ptr_table_free # U +ptr_table_new # U +ptr_table_split # U +ptr_table_store # U +re_compile # U +reg_named_buff_all # U +reg_named_buff_exists # U +reg_named_buff_fetch # U +reg_named_buff_firstkey # U +reg_named_buff_nextkey # U +reg_named_buff_scalar # U +regfree_internal # U +savesharedpvn # U +scan_vstring # E (Perl_scan_vstring) +upg_version # E (Perl_upg_version) +PERL_PV_ESCAPE_RE # added by devel/scanprov +SV_COW_SHARED_HASH_KEYS # added by devel/scanprov +SVfARG # added by devel/scanprov +memEQs # added by devel/scanprov +memNEs # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5010000 b/dist/Devel-PPPort/parts/base/5010000 new file mode 100644 index 0000000000..922e614159 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5010000 @@ -0,0 +1,10 @@ +5.010000 +hv_common # U +hv_common_key_len # U +sv_destroyable # U +sys_init # U +sys_init3 # U +sys_term # U +PERL_PV_PRETTY_ELLIPSES # added by devel/scanprov +PERL_PV_PRETTY_NOCLEAR # added by devel/scanprov +XSPROTO # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5010001 b/dist/Devel-PPPort/parts/base/5010001 new file mode 100644 index 0000000000..61012f7d58 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5010001 @@ -0,0 +1,22 @@ +5.010001 +HeUTF8 # U +croak_xs_usage # U +mPUSHs # U +mXPUSHs # U +mro_get_from_name # U +mro_get_private_data # U +mro_register # U +mro_set_mro # U +mro_set_private_data # U +newSVpvn_flags # U +newSVpvn_utf8 # U +newSVpvs_flags # U +save_hints # U +save_padsv_and_mortalize # U +save_pushi32ptr # U +save_pushptr # U +save_pushptrptr # U +sv_insert_flags # U +DEFSV_set # added by devel/scanprov +MUTABLE_PTR # added by devel/scanprov +MUTABLE_SV # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5011000 b/dist/Devel-PPPort/parts/base/5011000 new file mode 100644 index 0000000000..1f499d99e0 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5011000 @@ -0,0 +1,15 @@ +5.011000 +Gv_AMupdate # E (Perl_Gv_AMupdate) +PL_opfreehook # E +SVt_REGEXP # E +SvOOK_offset # U +av_iter_p # U +gv_add_by_type # U +is_ascii_string # U +pregfree2 # U +save_adelete # U +save_aelem_flags # U +save_hdelete # U +save_helem_flags # U +sv_utf8_upgrade_flags_grow # U +get_cvs # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5011001 b/dist/Devel-PPPort/parts/base/5011001 new file mode 100644 index 0000000000..f42409363b --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5011001 @@ -0,0 +1,6 @@ +5.011001 +ck_warner # U +ck_warner_d # U +is_utf8_perl_space # U +is_utf8_perl_word # U +is_utf8_posix_digit # U diff --git a/dist/Devel-PPPort/parts/base/5011002 b/dist/Devel-PPPort/parts/base/5011002 new file mode 100644 index 0000000000..df12d99fd6 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5011002 @@ -0,0 +1,13 @@ +5.011002 +PL_keyword_plugin # E +lex_bufutf8 # U +lex_discard_to # U +lex_grow_linestr # U +lex_next_chunk # U +lex_peek_unichar # U +lex_read_space # U +lex_read_to # U +lex_read_unichar # U +lex_stuff_pvn # U +lex_stuff_sv # U +lex_unstuff # U diff --git a/dist/Devel-PPPort/parts/base/5011003 b/dist/Devel-PPPort/parts/base/5011003 new file mode 100644 index 0000000000..3fd94ca1b6 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5011003 @@ -0,0 +1 @@ +5.011003 diff --git a/dist/Devel-PPPort/parts/base/5011004 b/dist/Devel-PPPort/parts/base/5011004 new file mode 100644 index 0000000000..86c1fce4f2 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5011004 @@ -0,0 +1,2 @@ +5.011004 +prescan_version # U diff --git a/dist/Devel-PPPort/parts/base/5011005 b/dist/Devel-PPPort/parts/base/5011005 new file mode 100644 index 0000000000..d9b0d6a4c9 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5011005 @@ -0,0 +1,2 @@ +5.011005 +sv_pos_u2b_flags # U diff --git a/dist/Devel-PPPort/parts/base/5012000 b/dist/Devel-PPPort/parts/base/5012000 new file mode 100644 index 0000000000..82cbce2d6d --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5012000 @@ -0,0 +1 @@ +5.012000 diff --git a/dist/Devel-PPPort/parts/base/5012001 b/dist/Devel-PPPort/parts/base/5012001 new file mode 100644 index 0000000000..90dc03fdf3 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5012001 @@ -0,0 +1 @@ +5.012001 diff --git a/dist/Devel-PPPort/parts/base/5012002 b/dist/Devel-PPPort/parts/base/5012002 new file mode 100644 index 0000000000..8ab87f08d8 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5012002 @@ -0,0 +1 @@ +5.012002 diff --git a/dist/Devel-PPPort/parts/base/5012003 b/dist/Devel-PPPort/parts/base/5012003 new file mode 100644 index 0000000000..f2abab4c17 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5012003 @@ -0,0 +1 @@ +5.012003 diff --git a/dist/Devel-PPPort/parts/base/5012004 b/dist/Devel-PPPort/parts/base/5012004 new file mode 100644 index 0000000000..e7319cd566 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5012004 @@ -0,0 +1 @@ +5.012004 diff --git a/dist/Devel-PPPort/parts/base/5012005 b/dist/Devel-PPPort/parts/base/5012005 new file mode 100644 index 0000000000..5af01305ef --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5012005 @@ -0,0 +1 @@ +5.012005 diff --git a/dist/Devel-PPPort/parts/base/5013000 b/dist/Devel-PPPort/parts/base/5013000 new file mode 100644 index 0000000000..8a31cc7f3e --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5013000 @@ -0,0 +1,2 @@ +5.013000 +cBOOL # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5013001 b/dist/Devel-PPPort/parts/base/5013001 new file mode 100644 index 0000000000..679bf3c35e --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5013001 @@ -0,0 +1,6 @@ +5.013001 +croak_sv # U +die_sv # U +mess_sv # U +sv_2nv_flags # U +warn_sv # U diff --git a/dist/Devel-PPPort/parts/base/5013002 b/dist/Devel-PPPort/parts/base/5013002 new file mode 100644 index 0000000000..5058d1e404 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5013002 @@ -0,0 +1,10 @@ +5.013002 +SvNV_nomg # U +find_rundefsv # U +foldEQ # U +foldEQ_locale # U +foldEQ_utf8 # U +hv_fill # U +sv_dec_nomg # U +sv_inc_nomg # U +C_ARRAY_END # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5013003 b/dist/Devel-PPPort/parts/base/5013003 new file mode 100644 index 0000000000..5e04f03c8a --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5013003 @@ -0,0 +1,3 @@ +5.013003 +blockhook_register # E +croak_no_modify # U diff --git a/dist/Devel-PPPort/parts/base/5013004 b/dist/Devel-PPPort/parts/base/5013004 new file mode 100644 index 0000000000..8aac89eb8d --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5013004 @@ -0,0 +1 @@ +5.013004 diff --git a/dist/Devel-PPPort/parts/base/5013005 b/dist/Devel-PPPort/parts/base/5013005 new file mode 100644 index 0000000000..88c7c7b80b --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5013005 @@ -0,0 +1,6 @@ +5.013005 +PL_rpeepp # E +caller_cx # U +isOCTAL # U +lex_stuff_pvs # U +parse_fullstmt # U diff --git a/dist/Devel-PPPort/parts/base/5013006 b/dist/Devel-PPPort/parts/base/5013006 new file mode 100644 index 0000000000..d145f36839 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5013006 @@ -0,0 +1,32 @@ +5.013006 +LINKLIST # U +SvTRUE_nomg # U +ck_entersub_args_list # U +ck_entersub_args_proto # U +ck_entersub_args_proto_or_list # U +cv_get_call_checker # E +cv_set_call_checker # E +isWORDCHAR # U +lex_stuff_pv # U +mg_free_type # U +newSVpv_share # U +op_append_elem # U +op_append_list # U +op_contextualize # U +op_linklist # U +op_prepend_elem # U +parse_stmtseq # U +rv2cv_op_cv # U +savesharedpvs # U +savesharedsvpv # U +sv_2bool_flags # U +sv_catpv_flags # U +sv_catpv_nomg # U +sv_catpvs_flags # U +sv_catpvs_mg # U +sv_catpvs_nomg # U +sv_cmp_flags # U +sv_cmp_locale_flags # U +sv_collxfrm_flags # U +sv_eq_flags # U +sv_setpvs_mg # U diff --git a/dist/Devel-PPPort/parts/base/5013007 b/dist/Devel-PPPort/parts/base/5013007 new file mode 100644 index 0000000000..79a9a5f44a --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5013007 @@ -0,0 +1,36 @@ +5.013007 +HvENAME # U +OP_CLASS # U +SvPV_nomg_nolen # U +XopFLAGS # E +amagic_deref_call # U +bytes_cmp_utf8 # U +cop_hints_2hv # A +cop_hints_fetch_pv # U +cop_hints_fetch_pvn # U +cop_hints_fetch_pvs # U +cop_hints_fetch_sv # U +cophh_2hv # E +cophh_copy # E +cophh_delete_pv # E +cophh_delete_pvn # E +cophh_delete_pvs # E +cophh_delete_sv # E +cophh_fetch_pv # E +cophh_fetch_pvn # E +cophh_fetch_pvs # E +cophh_fetch_sv # E +cophh_free # E +cophh_store_pv # E +cophh_store_pvn # E +cophh_store_pvs # E +cophh_store_sv # E +custom_op_register # E +custom_op_xop # E +newFOROP # A +newWHILEOP # A +op_lvalue # U +op_scope # U +parse_barestmt # U +parse_block # U +parse_label # U diff --git a/dist/Devel-PPPort/parts/base/5013008 b/dist/Devel-PPPort/parts/base/5013008 new file mode 100644 index 0000000000..5c315d671b --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5013008 @@ -0,0 +1,8 @@ +5.013008 +foldEQ_latin1 # U +mg_findext # U +parse_arithexpr # U +parse_fullexpr # U +parse_listexpr # U +parse_termexpr # U +sv_unmagicext # U diff --git a/dist/Devel-PPPort/parts/base/5013009 b/dist/Devel-PPPort/parts/base/5013009 new file mode 100644 index 0000000000..51160ae344 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5013009 @@ -0,0 +1 @@ +5.013009 diff --git a/dist/Devel-PPPort/parts/base/5013010 b/dist/Devel-PPPort/parts/base/5013010 new file mode 100644 index 0000000000..d7f4365bfb --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5013010 @@ -0,0 +1,4 @@ +5.013010 +foldEQ_utf8_flags # U +is_utf8_xidcont # U +is_utf8_xidfirst # U diff --git a/dist/Devel-PPPort/parts/base/5013011 b/dist/Devel-PPPort/parts/base/5013011 new file mode 100644 index 0000000000..a33715f749 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5013011 @@ -0,0 +1 @@ +5.013011 diff --git a/dist/Devel-PPPort/parts/base/5014000 b/dist/Devel-PPPort/parts/base/5014000 new file mode 100644 index 0000000000..3f837ef4d0 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5014000 @@ -0,0 +1,2 @@ +5.014000 +_to_uni_fold_flags # U diff --git a/dist/Devel-PPPort/parts/base/5014001 b/dist/Devel-PPPort/parts/base/5014001 new file mode 100644 index 0000000000..098fb03c9f --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5014001 @@ -0,0 +1 @@ +5.014001 diff --git a/dist/Devel-PPPort/parts/base/5014002 b/dist/Devel-PPPort/parts/base/5014002 new file mode 100644 index 0000000000..f280bd0f4f --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5014002 @@ -0,0 +1 @@ +5.014002 diff --git a/dist/Devel-PPPort/parts/base/5014003 b/dist/Devel-PPPort/parts/base/5014003 new file mode 100644 index 0000000000..333e50d1db --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5014003 @@ -0,0 +1 @@ +5.014003 diff --git a/dist/Devel-PPPort/parts/base/5014004 b/dist/Devel-PPPort/parts/base/5014004 new file mode 100644 index 0000000000..1618e365ea --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5014004 @@ -0,0 +1 @@ +5.014004 diff --git a/dist/Devel-PPPort/parts/base/5015000 b/dist/Devel-PPPort/parts/base/5015000 new file mode 100644 index 0000000000..d8c6546d72 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5015000 @@ -0,0 +1 @@ +5.015000 diff --git a/dist/Devel-PPPort/parts/base/5015001 b/dist/Devel-PPPort/parts/base/5015001 new file mode 100644 index 0000000000..144926b124 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5015001 @@ -0,0 +1,11 @@ +5.015001 +cop_fetch_label # U +cop_store_label # U +pad_add_name_pv # U +pad_add_name_pvn # U +pad_add_name_pvs # U +pad_add_name_sv # U +pad_findmy_pv # U +pad_findmy_pvn # U +pad_findmy_pvs # U +pad_findmy_sv # U diff --git a/dist/Devel-PPPort/parts/base/5015002 b/dist/Devel-PPPort/parts/base/5015002 new file mode 100644 index 0000000000..06741283d1 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5015002 @@ -0,0 +1 @@ +5.015002 diff --git a/dist/Devel-PPPort/parts/base/5015003 b/dist/Devel-PPPort/parts/base/5015003 new file mode 100644 index 0000000000..7f33df7128 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5015003 @@ -0,0 +1 @@ +5.015003 diff --git a/dist/Devel-PPPort/parts/base/5015004 b/dist/Devel-PPPort/parts/base/5015004 new file mode 100644 index 0000000000..516327e650 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5015004 @@ -0,0 +1,32 @@ +5.015004 +HvENAMELEN # U +HvENAMEUTF8 # U +HvNAMELEN # U +HvNAMEUTF8 # U +gv_autoload_pv # U +gv_autoload_pvn # U +gv_autoload_sv # U +gv_fetchmeth_pv # U +gv_fetchmeth_pv_autoload # U +gv_fetchmeth_pvn # U +gv_fetchmeth_pvn_autoload # U +gv_fetchmeth_sv # U +gv_fetchmeth_sv_autoload # U +gv_fetchmethod_pv_flags # U +gv_fetchmethod_pvn_flags # U +gv_fetchmethod_sv_flags # U +gv_init_pv # U +gv_init_pvn # U +gv_init_sv # U +newGVgen_flags # U +sv_derived_from_pv # U +sv_derived_from_pvn # U +sv_derived_from_sv # U +sv_does_pv # U +sv_does_pvn # U +sv_does_sv # U +sv_ref # U +whichsig_pv # U +whichsig_pvn # U +whichsig_sv # U +WIDEST_UTYPE # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5015005 b/dist/Devel-PPPort/parts/base/5015005 new file mode 100644 index 0000000000..1908a935e3 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5015005 @@ -0,0 +1 @@ +5.015005 diff --git a/dist/Devel-PPPort/parts/base/5015006 b/dist/Devel-PPPort/parts/base/5015006 new file mode 100644 index 0000000000..4fb3c7c590 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5015006 @@ -0,0 +1,2 @@ +5.015006 +newCONSTSUB_flags # A diff --git a/dist/Devel-PPPort/parts/base/5015007 b/dist/Devel-PPPort/parts/base/5015007 new file mode 100644 index 0000000000..ce9078968a --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5015007 @@ -0,0 +1,8 @@ +5.015007 +toLOWER_utf8 # U +toTITLE_utf8 # U +toUPPER_utf8 # U +to_utf8_fold # U +to_utf8_lower # U +to_utf8_title # U +to_utf8_upper # U diff --git a/dist/Devel-PPPort/parts/base/5015008 b/dist/Devel-PPPort/parts/base/5015008 new file mode 100644 index 0000000000..14c640388c --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5015008 @@ -0,0 +1,3 @@ +5.015008 +is_utf8_char_buf # U +wrap_op_checker # U diff --git a/dist/Devel-PPPort/parts/base/5015009 b/dist/Devel-PPPort/parts/base/5015009 new file mode 100644 index 0000000000..30537f0445 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5015009 @@ -0,0 +1,5 @@ +5.015009 +utf8_to_uvchr_buf # U +utf8_to_uvuni_buf # U +valid_utf8_to_uvchr # U +valid_utf8_to_uvuni # U diff --git a/dist/Devel-PPPort/parts/base/5016000 b/dist/Devel-PPPort/parts/base/5016000 new file mode 100644 index 0000000000..3bd46b7362 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5016000 @@ -0,0 +1 @@ +5.016000 diff --git a/dist/Devel-PPPort/parts/base/5016001 b/dist/Devel-PPPort/parts/base/5016001 new file mode 100644 index 0000000000..5e2b46c776 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5016001 @@ -0,0 +1 @@ +5.016001 diff --git a/dist/Devel-PPPort/parts/base/5016002 b/dist/Devel-PPPort/parts/base/5016002 new file mode 100644 index 0000000000..dfd939f684 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5016002 @@ -0,0 +1 @@ +5.016002 diff --git a/dist/Devel-PPPort/parts/base/5016003 b/dist/Devel-PPPort/parts/base/5016003 new file mode 100644 index 0000000000..88e54eb950 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5016003 @@ -0,0 +1 @@ +5.016003 diff --git a/dist/Devel-PPPort/parts/base/5017000 b/dist/Devel-PPPort/parts/base/5017000 new file mode 100644 index 0000000000..bf56b9a68a --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5017000 @@ -0,0 +1 @@ +5.017000 diff --git a/dist/Devel-PPPort/parts/base/5017001 b/dist/Devel-PPPort/parts/base/5017001 new file mode 100644 index 0000000000..6c9994352a --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5017001 @@ -0,0 +1 @@ +5.017001 diff --git a/dist/Devel-PPPort/parts/base/5017002 b/dist/Devel-PPPort/parts/base/5017002 new file mode 100644 index 0000000000..fd825e14bc --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5017002 @@ -0,0 +1,7 @@ +5.017002 +is_uni_blank # U +is_uni_blank_lc # U +is_utf8_blank # U +sv_copypv_flags # U +sv_copypv_nomg # U +sv_vcatpvfn_flags # U diff --git a/dist/Devel-PPPort/parts/base/5017003 b/dist/Devel-PPPort/parts/base/5017003 new file mode 100644 index 0000000000..5022764547 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5017003 @@ -0,0 +1 @@ +5.017003 diff --git a/dist/Devel-PPPort/parts/base/5017004 b/dist/Devel-PPPort/parts/base/5017004 new file mode 100644 index 0000000000..0202125888 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5017004 @@ -0,0 +1,5 @@ +5.017004 +PL_comppad_name # E +PadlistREFCNT # U +newMYSUB # E (Perl_newMYSUB) +newSVpadname # E diff --git a/dist/Devel-PPPort/parts/base/5017005 b/dist/Devel-PPPort/parts/base/5017005 new file mode 100644 index 0000000000..31dfb1c383 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5017005 @@ -0,0 +1 @@ +5.017005 diff --git a/dist/Devel-PPPort/parts/base/5017006 b/dist/Devel-PPPort/parts/base/5017006 new file mode 100644 index 0000000000..0bb2486239 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5017006 @@ -0,0 +1,2 @@ +5.017006 +READ_XDIGIT # U diff --git a/dist/Devel-PPPort/parts/base/5017007 b/dist/Devel-PPPort/parts/base/5017007 new file mode 100644 index 0000000000..c95c23505f --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5017007 @@ -0,0 +1,7 @@ +5.017007 +SvREFCNT_dec_NN # U +_is_uni_perl_idstart # U +_is_utf8_perl_idstart # U +is_uni_alnumc # U +is_uni_alnumc_lc # U +is_utf8_alnumc # U diff --git a/dist/Devel-PPPort/parts/base/5017008 b/dist/Devel-PPPort/parts/base/5017008 new file mode 100644 index 0000000000..9228a1506d --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5017008 @@ -0,0 +1,8 @@ +5.017008 +_is_uni_FOO # U +_is_uni_perl_idcont # U +_is_utf8_FOO # U +_is_utf8_mark # U +_is_utf8_perl_idcont # U +isALPHANUMERIC # U +isIDCONT # U diff --git a/dist/Devel-PPPort/parts/base/5017009 b/dist/Devel-PPPort/parts/base/5017009 new file mode 100644 index 0000000000..fd72827040 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5017009 @@ -0,0 +1,3 @@ +5.017009 +av_tindex # U +av_top_index # U diff --git a/dist/Devel-PPPort/parts/base/5017010 b/dist/Devel-PPPort/parts/base/5017010 new file mode 100644 index 0000000000..fed2762e9b --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5017010 @@ -0,0 +1 @@ +5.017010 diff --git a/dist/Devel-PPPort/parts/base/5017011 b/dist/Devel-PPPort/parts/base/5017011 new file mode 100644 index 0000000000..5fcf051681 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5017011 @@ -0,0 +1 @@ +5.017011 diff --git a/dist/Devel-PPPort/parts/base/5018000 b/dist/Devel-PPPort/parts/base/5018000 new file mode 100644 index 0000000000..17729d0b74 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5018000 @@ -0,0 +1,2 @@ +5.018000 +hv_rand_set # U diff --git a/dist/Devel-PPPort/parts/base/5018001 b/dist/Devel-PPPort/parts/base/5018001 new file mode 100644 index 0000000000..5d4bb8f500 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5018001 @@ -0,0 +1 @@ +5.018001 diff --git a/dist/Devel-PPPort/parts/base/5018002 b/dist/Devel-PPPort/parts/base/5018002 new file mode 100644 index 0000000000..17291bcf13 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5018002 @@ -0,0 +1 @@ +5.018002 diff --git a/dist/Devel-PPPort/parts/base/5018003 b/dist/Devel-PPPort/parts/base/5018003 new file mode 100644 index 0000000000..4d40f26283 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5018003 @@ -0,0 +1 @@ +5.018003 diff --git a/dist/Devel-PPPort/parts/base/5018004 b/dist/Devel-PPPort/parts/base/5018004 new file mode 100644 index 0000000000..f137cc2ad7 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5018004 @@ -0,0 +1 @@ +5.018004 diff --git a/dist/Devel-PPPort/parts/base/5019000 b/dist/Devel-PPPort/parts/base/5019000 new file mode 100644 index 0000000000..a6e8e03493 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5019000 @@ -0,0 +1 @@ +5.019000 diff --git a/dist/Devel-PPPort/parts/base/5019001 b/dist/Devel-PPPort/parts/base/5019001 new file mode 100644 index 0000000000..803ad9abff --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5019001 @@ -0,0 +1,6 @@ +5.019001 +re_intuit_start # A +toFOLD # U +toFOLD_utf8 # U +toLOWER_L1 # U +toTITLE # U diff --git a/dist/Devel-PPPort/parts/base/5019002 b/dist/Devel-PPPort/parts/base/5019002 new file mode 100644 index 0000000000..5af71fbeae --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5019002 @@ -0,0 +1,2 @@ +5.019002 +SVt_INVLIST # E diff --git a/dist/Devel-PPPort/parts/base/5019003 b/dist/Devel-PPPort/parts/base/5019003 new file mode 100644 index 0000000000..488ef60b2f --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5019003 @@ -0,0 +1,3 @@ +5.019003 +croak_memory_wrap # U (Perl_croak_memory_wrap) +sv_pos_b2u_flags # U diff --git a/dist/Devel-PPPort/parts/base/5019004 b/dist/Devel-PPPort/parts/base/5019004 new file mode 100644 index 0000000000..1aa2023c9f --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5019004 @@ -0,0 +1,4 @@ +5.019004 +append_utf8_from_native_byte # U +is_safe_syscall # U +uvoffuni_to_utf8_flags # U diff --git a/dist/Devel-PPPort/parts/base/5019005 b/dist/Devel-PPPort/parts/base/5019005 new file mode 100644 index 0000000000..69dcd69aef --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5019005 @@ -0,0 +1 @@ +5.019005 diff --git a/dist/Devel-PPPort/parts/base/5019006 b/dist/Devel-PPPort/parts/base/5019006 new file mode 100644 index 0000000000..f14fb0c0c4 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5019006 @@ -0,0 +1 @@ +5.019006 diff --git a/dist/Devel-PPPort/parts/base/5019007 b/dist/Devel-PPPort/parts/base/5019007 new file mode 100644 index 0000000000..c34055ea2a --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5019007 @@ -0,0 +1,2 @@ +5.019007 +OP_TYPE_IS # U diff --git a/dist/Devel-PPPort/parts/base/5019008 b/dist/Devel-PPPort/parts/base/5019008 new file mode 100644 index 0000000000..8fe2e2f1de --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5019008 @@ -0,0 +1 @@ +5.019008 diff --git a/dist/Devel-PPPort/parts/base/5019009 b/dist/Devel-PPPort/parts/base/5019009 new file mode 100644 index 0000000000..7706f723a0 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5019009 @@ -0,0 +1,5 @@ +5.019009 +_to_utf8_fold_flags # A +_to_utf8_lower_flags # A +_to_utf8_title_flags # A +_to_utf8_upper_flags # A diff --git a/dist/Devel-PPPort/parts/base/5019010 b/dist/Devel-PPPort/parts/base/5019010 new file mode 100644 index 0000000000..8bdae66ddb --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5019010 @@ -0,0 +1,2 @@ +5.019010 +OP_TYPE_IS_OR_WAS # U diff --git a/dist/Devel-PPPort/parts/base/5019011 b/dist/Devel-PPPort/parts/base/5019011 new file mode 100644 index 0000000000..2436c20fa6 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5019011 @@ -0,0 +1 @@ +5.019011 diff --git a/dist/Devel-PPPort/parts/base/5020000 b/dist/Devel-PPPort/parts/base/5020000 new file mode 100644 index 0000000000..0c90925944 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5020000 @@ -0,0 +1 @@ +5.020000 diff --git a/dist/Devel-PPPort/parts/base/5020001 b/dist/Devel-PPPort/parts/base/5020001 new file mode 100644 index 0000000000..1448fe7920 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5020001 @@ -0,0 +1 @@ +5.020001 diff --git a/dist/Devel-PPPort/parts/base/5020002 b/dist/Devel-PPPort/parts/base/5020002 new file mode 100644 index 0000000000..e31c0d0f49 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5020002 @@ -0,0 +1 @@ +5.020002 diff --git a/dist/Devel-PPPort/parts/base/5020003 b/dist/Devel-PPPort/parts/base/5020003 new file mode 100644 index 0000000000..89ec61981a --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5020003 @@ -0,0 +1 @@ +5.020003 diff --git a/dist/Devel-PPPort/parts/base/5021000 b/dist/Devel-PPPort/parts/base/5021000 new file mode 100644 index 0000000000..b3138ab9c5 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5021000 @@ -0,0 +1 @@ +5.021000 diff --git a/dist/Devel-PPPort/parts/base/5021001 b/dist/Devel-PPPort/parts/base/5021001 new file mode 100644 index 0000000000..353fedabfc --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5021001 @@ -0,0 +1,13 @@ +5.021001 +_is_in_locale_category # U +_is_utf8_char_slow # U +_is_utf8_idcont # U +_is_utf8_idstart # U +_is_utf8_xidcont # U +_is_utf8_xidstart # U +isALNUM_lazy # U +isIDFIRST_lazy # U +isUTF8_CHAR # U +markstack_grow # E (Perl_markstack_grow) +my_strerror # U +PERL_UNUSED_RESULT # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/base/5021002 b/dist/Devel-PPPort/parts/base/5021002 new file mode 100644 index 0000000000..abe5ac1246 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5021002 @@ -0,0 +1,3 @@ +5.021002 +grok_number_flags # U +op_sibling_splice # U diff --git a/dist/Devel-PPPort/parts/base/5021004 b/dist/Devel-PPPort/parts/base/5021004 new file mode 100644 index 0000000000..3a62526e13 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5021004 @@ -0,0 +1,5 @@ +5.021004 +cv_set_call_checker_flags # U +grok_infnan # U +isinfnan # U +sync_locale # U diff --git a/dist/Devel-PPPort/parts/base/5021005 b/dist/Devel-PPPort/parts/base/5021005 new file mode 100644 index 0000000000..2a02ad28b6 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5021005 @@ -0,0 +1,4 @@ +5.021005 +cv_name # A +newMETHOP # U +newMETHOP_named # U diff --git a/dist/Devel-PPPort/parts/base/5021006 b/dist/Devel-PPPort/parts/base/5021006 new file mode 100644 index 0000000000..fbefd16d47 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5021006 @@ -0,0 +1,3 @@ +5.021006 +newDEFSVOP # U +op_convert_list # U diff --git a/dist/Devel-PPPort/parts/base/5021007 b/dist/Devel-PPPort/parts/base/5021007 new file mode 100644 index 0000000000..bcaa19ca5f --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5021007 @@ -0,0 +1,11 @@ +5.021007 +OpHAS_SIBLING # U +OpSIBLING # U +PadnameUTF8 # E +is_invariant_string # U +newPADNAMELIST # U +newPADNAMEouter # U +newPADNAMEpvn # U +newUNOP_AUX # E +padnamelist_fetch # U +padnamelist_store # U diff --git a/dist/Devel-PPPort/parts/base/5021008 b/dist/Devel-PPPort/parts/base/5021008 new file mode 100644 index 0000000000..ccba00cb34 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5021008 @@ -0,0 +1,2 @@ +5.021008 +sv_get_backrefs # U diff --git a/dist/Devel-PPPort/parts/base/5021009 b/dist/Devel-PPPort/parts/base/5021009 new file mode 100644 index 0000000000..7397722a25 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5021009 @@ -0,0 +1 @@ +5.021009 diff --git a/dist/Devel-PPPort/parts/base/5021010 b/dist/Devel-PPPort/parts/base/5021010 new file mode 100644 index 0000000000..821a8fb629 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5021010 @@ -0,0 +1,2 @@ +5.021010 +DECLARATION_FOR_LC_NUMERIC_MANIPULATION # E diff --git a/dist/Devel-PPPort/parts/base/5021011 b/dist/Devel-PPPort/parts/base/5021011 new file mode 100644 index 0000000000..6d0f3baa4f --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5021011 @@ -0,0 +1,4 @@ +5.021011 +OpLASTSIB_set # U +OpMAYBESIB_set # U +OpMORESIB_set # U diff --git a/dist/Devel-PPPort/parts/base/5022000 b/dist/Devel-PPPort/parts/base/5022000 new file mode 100644 index 0000000000..aca319e5cd --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5022000 @@ -0,0 +1,2 @@ +5.022000 +UVCHR_SKIP # U diff --git a/dist/Devel-PPPort/parts/base/5022001 b/dist/Devel-PPPort/parts/base/5022001 new file mode 100644 index 0000000000..28befba2cd --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5022001 @@ -0,0 +1 @@ +5.022001 diff --git a/dist/Devel-PPPort/parts/base/5023000 b/dist/Devel-PPPort/parts/base/5023000 new file mode 100644 index 0000000000..e461a32669 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5023000 @@ -0,0 +1 @@ +5.023000 diff --git a/dist/Devel-PPPort/parts/base/5023001 b/dist/Devel-PPPort/parts/base/5023001 new file mode 100644 index 0000000000..ea44212d3c --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5023001 @@ -0,0 +1 @@ +5.023001 diff --git a/dist/Devel-PPPort/parts/base/5023002 b/dist/Devel-PPPort/parts/base/5023002 new file mode 100644 index 0000000000..2060466c2a --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5023002 @@ -0,0 +1 @@ +5.023002 diff --git a/dist/Devel-PPPort/parts/base/5023003 b/dist/Devel-PPPort/parts/base/5023003 new file mode 100644 index 0000000000..4b19a2410a --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5023003 @@ -0,0 +1 @@ +5.023003 diff --git a/dist/Devel-PPPort/parts/base/5023004 b/dist/Devel-PPPort/parts/base/5023004 new file mode 100644 index 0000000000..ce60a67e7a --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5023004 @@ -0,0 +1 @@ +5.023004 diff --git a/dist/Devel-PPPort/parts/base/5023005 b/dist/Devel-PPPort/parts/base/5023005 new file mode 100644 index 0000000000..1b8818c372 --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5023005 @@ -0,0 +1 @@ +5.023005 diff --git a/dist/Devel-PPPort/parts/base/5023006 b/dist/Devel-PPPort/parts/base/5023006 new file mode 100644 index 0000000000..f6c59949af --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5023006 @@ -0,0 +1 @@ +5.023006 diff --git a/dist/Devel-PPPort/parts/base/5023007 b/dist/Devel-PPPort/parts/base/5023007 new file mode 100644 index 0000000000..fb7c55335d --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5023007 @@ -0,0 +1 @@ +5.023007 diff --git a/dist/Devel-PPPort/parts/base/5023008 b/dist/Devel-PPPort/parts/base/5023008 new file mode 100644 index 0000000000..ed2ef6d2eb --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5023008 @@ -0,0 +1,22 @@ +5.023008 +clear_defarray # U +cx_popblock # U +cx_popeval # U +cx_popformat # U +cx_popgiven # U +cx_poploop # U +cx_popsub # U +cx_popsub_args # U +cx_popsub_common # U +cx_popwhen # U +cx_pushblock # U +cx_pusheval # U +cx_pushformat # U +cx_pushgiven # U +cx_pushloop_for # U +cx_pushloop_plain # U +cx_pushsub # U +cx_pushwhen # U +cx_topblock # U +leave_adjust_stacks # U +savetmps # U diff --git a/dist/Devel-PPPort/parts/base/5023009 b/dist/Devel-PPPort/parts/base/5023009 new file mode 100644 index 0000000000..336b09a3ee --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5023009 @@ -0,0 +1,5 @@ +5.023009 +toFOLD_uvchr # U +toLOWER_uvchr # U +toTITLE_uvchr # U +toUPPER_uvchr # U diff --git a/dist/Devel-PPPort/parts/base/5024000 b/dist/Devel-PPPort/parts/base/5024000 new file mode 100644 index 0000000000..32870f99ce --- /dev/null +++ b/dist/Devel-PPPort/parts/base/5024000 @@ -0,0 +1,68 @@ +5.024000 +BhkDISABLE # E +BhkENABLE # E +BhkENTRY_set # E +MULTICALL # E +PERL_SYS_TERM # E +POP_MULTICALL # E +PUSH_MULTICALL # E +PadARRAY # E +PadMAX # E +PadlistARRAY # E +PadlistMAX # E +PadlistNAMES # E +PadlistNAMESARRAY # E +PadlistNAMESMAX # E +PadnameLEN # E +PadnamePV # E +PadnameREFCNT # E +PadnameREFCNT_dec # E +PadnameSV # E +PadnamelistARRAY # E +PadnamelistMAX # E +PadnamelistREFCNT # E +PadnamelistREFCNT_dec # E +RESTORE_LC_NUMERIC # E +STORE_LC_NUMERIC_FORCE_TO_UNDERLYING # E +STORE_LC_NUMERIC_SET_TO_NEEDED # E +XS_APIVERSION_BOOTCHECK # E +XS_EXTERNAL # E +XS_INTERNAL # E +XS_VERSION_BOOTCHECK # E +XopDISABLE # E +XopENABLE # E +XopENTRY # E +XopENTRYCUSTOM # E +XopENTRY_set # E +cophh_new_empty # E +my_lstat # U (Perl_my_lstat) +my_stat # U (Perl_my_stat) +reentrant_free # U +reentrant_init # U +reentrant_retry # U +reentrant_size # U +ref # U (Perl_ref) +sv_magic_portable # U +sv_setref_pvs # A +PERL_BCDVERSION # added by devel/scanprov +PERL_MAGIC_glob # added by devel/scanprov +PERL_MAGIC_mutex # added by devel/scanprov +PERL_MAGIC_overload # added by devel/scanprov +PERL_MAGIC_overload_elem # added by devel/scanprov +PL_bufend # added by devel/scanprov +PL_bufptr # added by devel/scanprov +PL_copline # added by devel/scanprov +PL_error_count # added by devel/scanprov +PL_expect # added by devel/scanprov +PL_in_my # added by devel/scanprov +PL_in_my_stash # added by devel/scanprov +PL_lex_state # added by devel/scanprov +PL_lex_stuff # added by devel/scanprov +PL_linestr # added by devel/scanprov +PL_rsfp # added by devel/scanprov +PL_rsfp_filters # added by devel/scanprov +PL_tokenbuf # added by devel/scanprov +WARN_ASSERTIONS # added by devel/scanprov +aTHXR # added by devel/scanprov +aTHXR_ # added by devel/scanprov +dTHXR # added by devel/scanprov diff --git a/dist/Devel-PPPort/parts/embed.fnc b/dist/Devel-PPPort/parts/embed.fnc new file mode 100644 index 0000000000..1f347c2b83 --- /dev/null +++ b/dist/Devel-PPPort/parts/embed.fnc @@ -0,0 +1,2956 @@ +: BEGIN{die "You meant to run regen/embed.pl"} # Stop early if fed to perl. +: +: This file is processed by regen/embed.pl and autodoc.pl +: +: Lines are of the form: +: flags|return_type|function_name|arg1|arg2|...|argN +: +: A line may be continued on another by ending it with a backslash. +: Leading and trailing whitespace will be ignored in each component. +: +: flags are single letters with following meanings: +: +: A Available fully everywhere (usually part of the public API): +: +: add entry to the list of exported symbols (unless x or m); +: any doc entry goes in perlapi.pod rather than perlintern.pod. If no +: documentation is furnished for this function, and M is also +: specified, the function is not listed as part of the public API. +: If M isn't specified, and no documentation is furnished, the +: function is listed in perlapi as existing and being undocumented +: makes '#define foo Perl_foo' scope not just for PERL_CORE/PERL_EXT +: +: If the function is only exported for use in a public +: macro, see X. +: +: a Allocates memory a la malloc/calloc. Also implies "R": +: +: proto.h: add __attribute__malloc__ +: +: b Binary backward compatibility; has an exported Perl_ implementation +: but function is also normally a macro (i.e. has the "m" flag as well). +: Backcompat functions ("b") can be anywhere, but if they are also +: macros ("m") then they have no proto.h entries so must either be in +: mathoms.c to get marked EXTERN_C (and skipped for -DNO_MATHOMS builds) +: or else will require special attention to ensure they are marked +: EXTERN_C (and then won't be automatically skipped for -DNO_MATHOMS +: builds). +: +: add entry to the list of exported symbols; +: don't define PERL_ARGS_ASSERT_FOO +: +: D Function is deprecated: +: +: proto.h: add __attribute__deprecated__ +: +: d Function has documentation (somewhere) in the source: +: +: enables 'no docs for foo" warning in autodoc.pl +: +: E Visible to extensions included in the Perl core: +: +: in embed.h, change "#ifdef PERL_CORE" +: into "#if defined(PERL_CORE) || defined(PERL_EXT)" +: +: To be usable from dynamically loaded extensions, either: +: 1) must be static to its containing file ("i" or "s" flag); or +: 2) be combined with the "X" flag. +: +: f Function takes a format string. If the function name /strftime/ +: then its assumed to take a strftime-style format string as 1st arg; +: otherwise it's assumed to be a printf style format string, varargs +: (hence any entry that would otherwise go in embed.h is suppressed): +: +: proto.h: add __attribute__format__ (or ...null_ok__) +: +: i Static inline: function in source code has a S_ prefix: +: +: proto.h: function is declared as S_foo rather than foo, +: PERL_STATIC_INLINE is added to declaration; +: embed.h: "#define foo S_foo" entries added +: +: M May change: +: +: any doc entry is marked that function may change. Also used to +: suppress making a doc entry if it would just be a placeholder. +: +: m Implemented as a macro: +: +: suppress proto.h entry (actually, not suppressed, but commented out) +: suppress entry in the list of exported symbols +: suppress embed.h entry +: +: n Has no implicit interpreter/thread context argument: +: +: suppress the pTHX part of "foo(pTHX...)" in proto.h; +: In the PERL_IMPLICIT_SYS branch of embed.h, generates +: "#define foo Perl_foo", rather than +: "#define foo(a,b,c) Perl_foo(aTHX_ a,b,c) +: +: O Has a perl_ compatibility macro. +: +: The really OLD name for API funcs +: +: o Has no Perl_foo or S_foo compatibility macro: +: +: embed.h: suppress "#define foo Perl_foo" +: +: P Pure function: no effects except the return value; +: return value depends only on params and/or globals: +: +: proto.h: add __attribute__pure__ +: +: p Function in source code has a Perl_ prefix: +: +: proto.h: function is declared as Perl_foo rather than foo +: embed.h: "#define foo Perl_foo" entries added +: +: R Return value must not be ignored (also implied by 'a' flag): +: +: proto.h: add __attribute__warn_unused_result__ +: +: r Function never returns: +: +: proto.h: add __attribute__noreturn__ +: +: s Static function: function in source code has a S_ prefix: +: +: proto.h: function is declared as S_foo rather than foo, +: STATIC is added to declaration; +: embed.h: "#define foo S_foo" entries added +: +: U Suppress usage example in autogenerated documentation +: +: (currently no effect) +: +: X Explicitly exported: +: +: add entry to the list of exported symbols, unless x or m +: +: This is often used for private functions that are used by public +: macros. In those cases the macros must use the long form of the +: name (Perl_blah(aTHX_ ...)). +: +: x Not exported +: +: suppress entry in the list of exported symbols +: +: (see also L<perlguts/Internal Functions> for those flags.) +: +: Pointer parameters that must not be passed NULLs should be prefixed with NN. +: +: Pointer parameters that may be NULL should be prefixed with NULLOK. This has +: no effect on output yet. It's a notation for the maintainers to know "I have +: defined whether NULL is OK or not" rather than having neither NULL or NULLOK, +: which is ambiguous. +: +: Individual flags may be separated by whitespace. + +#if defined(PERL_IMPLICIT_SYS) +Ano |PerlInterpreter*|perl_alloc_using \ + |NN struct IPerlMem *ipM \ + |NN struct IPerlMem *ipMS \ + |NN struct IPerlMem *ipMP \ + |NN struct IPerlEnv *ipE \ + |NN struct IPerlStdIO *ipStd \ + |NN struct IPerlLIO *ipLIO \ + |NN struct IPerlDir *ipD \ + |NN struct IPerlSock *ipS \ + |NN struct IPerlProc *ipP +#endif +Anod |PerlInterpreter* |perl_alloc +Anod |void |perl_construct |NN PerlInterpreter *my_perl +Anod |int |perl_destruct |NN PerlInterpreter *my_perl +Anod |void |perl_free |NN PerlInterpreter *my_perl +Anod |int |perl_run |NN PerlInterpreter *my_perl +Anod |int |perl_parse |NN PerlInterpreter *my_perl|XSINIT_t xsinit \ + |int argc|NULLOK char** argv|NULLOK char** env +AnpR |bool |doing_taint |int argc|NULLOK char** argv|NULLOK char** env +#if defined(USE_ITHREADS) +Anod |PerlInterpreter*|perl_clone|NN PerlInterpreter *proto_perl|UV flags +# if defined(PERL_IMPLICIT_SYS) +Ano |PerlInterpreter*|perl_clone_using \ + |NN PerlInterpreter *proto_perl \ + |UV flags \ + |NN struct IPerlMem* ipM \ + |NN struct IPerlMem* ipMS \ + |NN struct IPerlMem* ipMP \ + |NN struct IPerlEnv* ipE \ + |NN struct IPerlStdIO* ipStd \ + |NN struct IPerlLIO* ipLIO \ + |NN struct IPerlDir* ipD \ + |NN struct IPerlSock* ipS \ + |NN struct IPerlProc* ipP +# endif +#endif + +Aanop |Malloc_t|malloc |MEM_SIZE nbytes +Aanop |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size +Aanop |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes +Anop |Free_t |mfree |Malloc_t where +#if defined(MYMALLOC) +npR |MEM_SIZE|malloced_size |NN void *p +npR |MEM_SIZE|malloc_good_size |size_t nbytes +#endif +#if defined(PERL_IN_MALLOC_C) +sn |int |adjust_size_and_find_bucket |NN size_t *nbytes_p +#endif + +AnpR |void* |get_context +Anp |void |set_context |NN void *t + +XEop |bool |try_amagic_bin |int method|int flags +XEop |bool |try_amagic_un |int method|int flags +Ap |SV* |amagic_call |NN SV* left|NN SV* right|int method|int dir +Ap |SV * |amagic_deref_call|NN SV *ref|int method +p |bool |amagic_is_enabled|int method +Ap |int |Gv_AMupdate |NN HV* stash|bool destructing +ApR |CV* |gv_handler |NULLOK HV* stash|I32 id +Apd |OP* |op_append_elem |I32 optype|NULLOK OP* first|NULLOK OP* last +Apd |OP* |op_append_list |I32 optype|NULLOK OP* first|NULLOK OP* last +Apd |OP* |op_linklist |NN OP *o +Apd |OP* |op_prepend_elem|I32 optype|NULLOK OP* first|NULLOK OP* last +: FIXME - this is only called by pp_chown. They should be merged. +p |I32 |apply |I32 type|NN SV** mark|NN SV** sp +ApM |void |apply_attrs_string|NN const char *stashpv|NN CV *cv|NN const char *attrstr|STRLEN len +Apd |void |av_clear |NN AV *av +Apd |SV* |av_delete |NN AV *av|SSize_t key|I32 flags +ApdR |bool |av_exists |NN AV *av|SSize_t key +Apd |void |av_extend |NN AV *av|SSize_t key +p |void |av_extend_guts |NULLOK AV *av|SSize_t key \ + |NN SSize_t *maxp \ + |NN SV ***allocp|NN SV ***arrayp +ApdR |SV** |av_fetch |NN AV *av|SSize_t key|I32 lval +Apd |void |av_fill |NN AV *av|SSize_t fill +ApdR |SSize_t|av_len |NN AV *av +ApdR |AV* |av_make |SSize_t size|NN SV **strp +Apd |SV* |av_pop |NN AV *av +ApdoxM |void |av_create_and_push|NN AV **const avp|NN SV *const val +Apd |void |av_push |NN AV *av|NN SV *val +: Used in scope.c, and by Data::Alias +EXp |void |av_reify |NN AV *av +ApdR |SV* |av_shift |NN AV *av +Apd |SV** |av_store |NN AV *av|SSize_t key|NULLOK SV *val +#ifndef PERL_NO_INLINE_FUNCTIONS +AidR |SSize_t|av_top_index |NN AV *av +#endif +AmpdR |SSize_t|av_tindex |NN AV *av +Apd |void |av_undef |NN AV *av +ApdoxM |SV** |av_create_and_unshift_one|NN AV **const avp|NN SV *const val +Apd |void |av_unshift |NN AV *av|SSize_t num +Apo |SV** |av_arylen_p |NN AV *av +Apo |IV* |av_iter_p |NN AV *av +#if defined(PERL_IN_AV_C) +s |MAGIC* |get_aux_mg |NN AV *av +#endif +: Used in perly.y +pR |OP* |bind_match |I32 type|NN OP *left|NN OP *right +: Used in perly.y +ApdR |OP* |block_end |I32 floor|NULLOK OP* seq +ApR |U8 |block_gimme +: Used in perly.y +ApdR |int |block_start |int full +Aodp |void |blockhook_register |NN BHK *hk +: Used in perl.c +p |void |boot_core_UNIVERSAL +: Used in perl.c +p |void |boot_core_PerlIO +Ap |void |call_list |I32 oldscope|NN AV *paramList +Apd |const PERL_CONTEXT * |caller_cx|I32 level \ + |NULLOK const PERL_CONTEXT **dbcxp +: Used in several source files +pR |bool |cando |Mode_t mode|bool effective|NN const Stat_t* statbufp +ApRn |U32 |cast_ulong |NV f +ApRn |I32 |cast_i32 |NV f +ApRn |IV |cast_iv |NV f +ApRn |UV |cast_uv |NV f +#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) +ApR |I32 |my_chsize |int fd|Off_t length +#endif +p |const COP*|closest_cop |NN const COP *cop|NULLOK const OP *o \ + |NULLOK const OP *curop|bool opnext +: Used in perly.y +ApdR |OP* |op_convert_list |I32 optype|I32 flags|NULLOK OP* o +: Used in op.c and perl.c +pM |void |create_eval_scope|NULLOK OP *retop|U32 flags +Aprd |void |croak_sv |NN SV *baseex +: croak()'s first parm can be NULL. Otherwise, mod_perl breaks. +Afprd |void |croak |NULLOK const char* pat|... +Aprd |void |vcroak |NULLOK const char* pat|NULLOK va_list* args +Anprd |void |croak_no_modify +Anprd |void |croak_xs_usage |NN const CV *const cv \ + |NN const char *const params +npr |void |croak_no_mem +nprX |void |croak_popstack +fnprx |void |noperl_die|NN const char* pat|... +#if defined(WIN32) +norx |void |win32_croak_not_implemented|NN const char * fname +#endif +#if defined(PERL_IMPLICIT_CONTEXT) +Afnrp |void |croak_nocontext|NULLOK const char* pat|... +Afnrp |OP* |die_nocontext |NULLOK const char* pat|... +Afnp |void |deb_nocontext |NN const char* pat|... +Afnp |char* |form_nocontext |NN const char* pat|... +Anp |void |load_module_nocontext|U32 flags|NN SV* name|NULLOK SV* ver|... +Afnp |SV* |mess_nocontext |NN const char* pat|... +Afnp |void |warn_nocontext |NN const char* pat|... +Afnp |void |warner_nocontext|U32 err|NN const char* pat|... +Afnp |SV* |newSVpvf_nocontext|NN const char *const pat|... +Afnp |void |sv_catpvf_nocontext|NN SV *const sv|NN const char *const pat|... +Afnp |void |sv_setpvf_nocontext|NN SV *const sv|NN const char *const pat|... +Afnp |void |sv_catpvf_mg_nocontext|NN SV *const sv|NN const char *const pat|... +Afnp |void |sv_setpvf_mg_nocontext|NN SV *const sv|NN const char *const pat|... +Afnp |int |fprintf_nocontext|NN PerlIO *stream|NN const char *format|... +Afnp |int |printf_nocontext|NN const char *format|... +#endif +: Used in pp.c +p |SV * |core_prototype |NULLOK SV *sv|NN const char *name \ + |const int code|NULLOK int * const opnum +: Used in gv.c +p |OP * |coresub_op |NN SV *const coreargssv|const int code \ + |const int opnum +: Used in sv.c +EMXp |void |cv_ckproto_len_flags |NN const CV* cv|NULLOK const GV* gv\ + |NULLOK const char* p|const STRLEN len \ + |const U32 flags +: Used in pp.c and pp_sys.c +ApdR |SV* |gv_const_sv |NN GV* gv +ApdRn |SV* |cv_const_sv |NULLOK const CV *const cv +pRn |SV* |cv_const_sv_or_av|NULLOK const CV *const cv +Apd |SV * |cv_name |NN CV *cv|NULLOK SV *sv|U32 flags +Apd |void |cv_undef |NN CV* cv +p |void |cv_undef_flags |NN CV* cv|U32 flags +p |void |cv_forget_slab |NULLOK CV *cv +Ap |void |cx_dump |NN PERL_CONTEXT* cx +Ap |SV* |filter_add |NULLOK filter_t funcp|NULLOK SV* datasv +Ap |void |filter_del |NN filter_t funcp +ApR |I32 |filter_read |int idx|NN SV *buf_sv|int maxlen +ApPR |char** |get_op_descs +ApPR |char** |get_op_names +: FIXME discussion on p5p +pPR |const char* |get_no_modify +: FIXME discussion on p5p +pPR |U32* |get_opargs +ApPR |PPADDR_t*|get_ppaddr +: Used by CXINC, which appears to be in widespread use +ApR |I32 |cxinc +Afp |void |deb |NN const char* pat|... +Ap |void |vdeb |NN const char* pat|NULLOK va_list* args +Ap |void |debprofdump +EXp |SV* |multideref_stringify |NN const OP* o|NULLOK CV *cv +Ap |I32 |debop |NN const OP* o +Ap |I32 |debstack +Ap |I32 |debstackptrs +pR |SV * |defelem_target |NN SV *sv|NULLOK MAGIC *mg +Anp |char* |delimcpy |NN char* to|NN const char* toend|NN const char* from \ + |NN const char* fromend|int delim|NN I32* retlen +: Used in op.c, perl.c +pM |void |delete_eval_scope +Aprd |OP* |die_sv |NN SV *baseex +Afrpd |OP* |die |NULLOK const char* pat|... +: Used in util.c +pr |void |die_unwind |NN SV* msv +Ap |void |dounwind |I32 cxix +: FIXME +pmb |bool|do_aexec |NULLOK SV* really|NN SV** mark|NN SV** sp +: Used in pp_sys.c +p |bool|do_aexec5 |NULLOK SV* really|NN SV** mark|NN SV** sp|int fd|int do_report +Ap |int |do_binmode |NN PerlIO *fp|int iotype|int mode +: Used in pp.c +Ap |bool |do_close |NULLOK GV* gv|bool not_implicit +: Defined in doio.c, used only in pp_sys.c +p |bool |do_eof |NN GV* gv + +#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION +pm |bool|do_exec |NN const char* cmd +#else +p |bool|do_exec |NN const char* cmd +#endif + +#if defined(WIN32) || defined(__SYMBIAN32__) || defined(VMS) +Ap |int |do_aspawn |NULLOK SV* really|NN SV** mark|NN SV** sp +Ap |int |do_spawn |NN char* cmd +Ap |int |do_spawn_nowait|NN char* cmd +#endif +#if !defined(WIN32) +p |bool|do_exec3 |NN const char *incmd|int fd|int do_report +#endif +p |void |do_execfree +#if defined(PERL_IN_DOIO_C) +s |void |exec_failed |NN const char *cmd|int fd|int do_report +#endif +#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) +: Defined in doio.c, used only in pp_sys.c +p |I32 |do_ipcctl |I32 optype|NN SV** mark|NN SV** sp +: Defined in doio.c, used only in pp_sys.c +p |I32 |do_ipcget |I32 optype|NN SV** mark|NN SV** sp +: Defined in doio.c, used only in pp_sys.c +p |I32 |do_msgrcv |NN SV** mark|NN SV** sp +: Defined in doio.c, used only in pp_sys.c +p |I32 |do_msgsnd |NN SV** mark|NN SV** sp +: Defined in doio.c, used only in pp_sys.c +p |I32 |do_semop |NN SV** mark|NN SV** sp +: Defined in doio.c, used only in pp_sys.c +p |I32 |do_shmio |I32 optype|NN SV** mark|NN SV** sp +#endif +Ap |void |do_join |NN SV *sv|NN SV *delim|NN SV **mark|NN SV **sp +: Used in pp.c and pp_hot.c, prototype generated by regen/opcode.pl +: p |OP* |do_kv +: used in pp.c, pp_hot.c +pR |I32 |do_ncmp |NN SV *const left|NN SV *const right +Apmb |bool |do_open |NN GV* gv|NN const char* name|I32 len|int as_raw \ + |int rawmode|int rawperm|NULLOK PerlIO* supplied_fp +Ap |bool |do_open9 |NN GV *gv|NN const char *name|I32 len|int as_raw \ + |int rawmode|int rawperm|NULLOK PerlIO *supplied_fp \ + |NN SV *svs|I32 num +#if defined(PERL_IN_DOIO_C) +s |IO * |openn_setup |NN GV *gv|NN char *mode|NN PerlIO **saveifp \ + |NN PerlIO **saveofp|NN int *savefd \ + |NN char *savetype +s |bool |openn_cleanup |NN GV *gv|NN IO *io|NULLOK PerlIO *fp \ + |NN char *mode|NN const char *oname \ + |NULLOK PerlIO *saveifp|NULLOK PerlIO *saveofp \ + |int savefd|char savetype|int writing \ + |bool was_fdopen|NULLOK const char *type +#endif +Ap |bool |do_openn |NN GV *gv|NN const char *oname|I32 len \ + |int as_raw|int rawmode|int rawperm \ + |NULLOK PerlIO *supplied_fp|NULLOK SV **svp \ + |I32 num +Mp |bool |do_open_raw |NN GV *gv|NN const char *oname|STRLEN len \ + |int rawmode|int rawperm +Mp |bool |do_open6 |NN GV *gv|NN const char *oname|STRLEN len \ + |NULLOK PerlIO *supplied_fp|NULLOK SV **svp \ + |U32 num +: Used in pp_hot.c and pp_sys.c +p |bool |do_print |NULLOK SV* sv|NN PerlIO* fp +: Used in pp_sys.c +pR |OP* |do_readline +: Defined in doio.c, used only in pp_sys.c +p |bool |do_seek |NULLOK GV* gv|Off_t pos|int whence +Ap |void |do_sprintf |NN SV* sv|I32 len|NN SV** sarg +: Defined in doio.c, used only in pp_sys.c +p |Off_t |do_sysseek |NN GV* gv|Off_t pos|int whence +: Defined in doio.c, used only in pp_sys.c +pR |Off_t |do_tell |NN GV* gv +: Defined in doop.c, used only in pp.c +p |I32 |do_trans |NN SV* sv +: Used in my.c and pp.c +p |UV |do_vecget |NN SV* sv|SSize_t offset|int size +: Defined in doop.c, used only in mg.c (with /* XXX slurp this routine */) +p |void |do_vecset |NN SV* sv +: Defined in doop.c, used only in pp.c +p |void |do_vop |I32 optype|NN SV* sv|NN SV* left|NN SV* right +: Used in perly.y +p |OP* |dofile |NN OP* term|I32 force_builtin +ApR |U8 |dowantarray +Ap |void |dump_all +p |void |dump_all_perl |bool justperl +Ap |void |dump_eval +Ap |void |dump_form |NN const GV* gv +Ap |void |gv_dump |NULLOK GV* gv +Ap |void |op_dump |NN const OP *o +Ap |void |pmop_dump |NULLOK PMOP* pm +Ap |void |dump_packsubs |NN const HV* stash +p |void |dump_packsubs_perl |NN const HV* stash|bool justperl +Ap |void |dump_sub |NN const GV* gv +p |void |dump_sub_perl |NN const GV* gv|bool justperl +Apd |void |fbm_compile |NN SV* sv|U32 flags +ApdR |char* |fbm_instr |NN unsigned char* big|NN unsigned char* bigend \ + |NN SV* littlestr|U32 flags +p |CV * |find_lexical_cv|PADOFFSET off +pR |OP * |parse_subsignature +: Defined in util.c, used only in perl.c +p |char* |find_script |NN const char *scriptname|bool dosearch \ + |NULLOK const char *const *const search_ext|I32 flags +#if defined(PERL_IN_OP_C) +s |OP* |force_list |NULLOK OP* arg|bool nullit +i |OP* |op_integerize |NN OP *o +i |OP* |op_std_init |NN OP *o +#if defined(USE_ITHREADS) +i |void |op_relocate_sv |NN SV** svp|NN PADOFFSET* targp +#endif +i |OP* |newMETHOP_internal |I32 type|I32 flags|NULLOK OP* dynamic_meth \ + |NULLOK SV* const_meth +: FIXME +s |OP* |fold_constants |NN OP *o +#endif +Afpd |char* |form |NN const char* pat|... +Ap |char* |vform |NN const char* pat|NULLOK va_list* args +Ap |void |free_tmps +#if defined(PERL_IN_OP_C) +s |OP* |gen_constant_list|NULLOK OP* o +#endif +#if !defined(HAS_GETENV_LEN) +: Used in hv.c +p |char* |getenv_len |NN const char *env_elem|NN unsigned long *len +#endif +: Used in pp_ctl.c and pp_hot.c +pox |void |get_db_sub |NULLOK SV **svp|NN CV *cv +Ap |void |gp_free |NULLOK GV* gv +Ap |GP* |gp_ref |NULLOK GP* gp +Ap |GV* |gv_add_by_type |NULLOK GV *gv|svtype type +Apmb |GV* |gv_AVadd |NULLOK GV *gv +Apmb |GV* |gv_HVadd |NULLOK GV *gv +Apmb |GV* |gv_IOadd |NULLOK GV* gv +AmR |GV* |gv_autoload4 |NULLOK HV* stash|NN const char* name \ + |STRLEN len|I32 method +ApR |GV* |gv_autoload_sv |NULLOK HV* stash|NN SV* namesv|U32 flags +ApR |GV* |gv_autoload_pv |NULLOK HV* stash|NN const char* namepv \ + |U32 flags +ApR |GV* |gv_autoload_pvn |NULLOK HV* stash|NN const char* name \ + |STRLEN len|U32 flags +Ap |void |gv_check |NN HV* stash +Ap |void |gv_efullname |NN SV* sv|NN const GV* gv +Apmb |void |gv_efullname3 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix +Ap |void |gv_efullname4 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain +Ap |GV* |gv_fetchfile |NN const char* name +Ap |GV* |gv_fetchfile_flags|NN const char *const name|const STRLEN len\ + |const U32 flags +Amd |GV* |gv_fetchmeth |NULLOK HV* stash|NN const char* name \ + |STRLEN len|I32 level +Apd |GV* |gv_fetchmeth_sv |NULLOK HV* stash|NN SV* namesv|I32 level|U32 flags +Apd |GV* |gv_fetchmeth_pv |NULLOK HV* stash|NN const char* name \ + |I32 level|U32 flags +Apd |GV* |gv_fetchmeth_pvn |NULLOK HV* stash|NN const char* name \ + |STRLEN len|I32 level|U32 flags +Amd |GV* |gv_fetchmeth_autoload |NULLOK HV* stash \ + |NN const char* name|STRLEN len \ + |I32 level +Apd |GV* |gv_fetchmeth_sv_autoload |NULLOK HV* stash|NN SV* namesv|I32 level|U32 flags +Apd |GV* |gv_fetchmeth_pv_autoload |NULLOK HV* stash|NN const char* name \ + |I32 level|U32 flags +Apd |GV* |gv_fetchmeth_pvn_autoload |NULLOK HV* stash|NN const char* name \ + |STRLEN len|I32 level|U32 flags +Apdmb |GV* |gv_fetchmethod |NN HV* stash|NN const char* name +Apd |GV* |gv_fetchmethod_autoload|NN HV* stash|NN const char* name \ + |I32 autoload +ApM |GV* |gv_fetchmethod_sv_flags|NN HV* stash|NN SV* namesv|U32 flags +ApM |GV* |gv_fetchmethod_pv_flags|NN HV* stash|NN const char* name \ + |U32 flags +ApM |GV* |gv_fetchmethod_pvn_flags|NN HV* stash|NN const char* name \ + |const STRLEN len|U32 flags +Ap |GV* |gv_fetchpv |NN const char *nambeg|I32 add|const svtype sv_type +Ap |void |gv_fullname |NN SV* sv|NN const GV* gv +Apmb |void |gv_fullname3 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix +Ap |void |gv_fullname4 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain +: Used in scope.c +pMox |GP * |newGP |NN GV *const gv +pX |void |cvgv_set |NN CV* cv|NULLOK GV* gv +poX |GV * |cvgv_from_hek |NN CV* cv +pX |void |cvstash_set |NN CV* cv|NULLOK HV* stash +Amd |void |gv_init |NN GV* gv|NULLOK HV* stash \ + |NN const char* name|STRLEN len|int multi +Ap |void |gv_init_sv |NN GV* gv|NULLOK HV* stash|NN SV* namesv|U32 flags +Ap |void |gv_init_pv |NN GV* gv|NULLOK HV* stash|NN const char* name \ + |U32 flags +Ap |void |gv_init_pvn |NN GV* gv|NULLOK HV* stash|NN const char* name \ + |STRLEN len|U32 flags +Ap |void |gv_name_set |NN GV* gv|NN const char *name|U32 len|U32 flags +px |GV * |gv_override |NN const char * const name \ + |const STRLEN len +XMpd |void |gv_try_downgrade|NN GV* gv +p |void |gv_setref |NN SV *const dstr|NN SV *const sstr +Apd |HV* |gv_stashpv |NN const char* name|I32 flags +Apd |HV* |gv_stashpvn |NN const char* name|U32 namelen|I32 flags +#if defined(PERL_IN_GV_C) +i |HV* |gv_stashpvn_internal |NN const char* name|U32 namelen|I32 flags +i |HV* |gv_stashsvpvn_cached |NULLOK SV *namesv|NULLOK const char* name|U32 namelen|I32 flags +i |GV* |gv_fetchmeth_internal |NULLOK HV* stash|NULLOK SV* meth|NULLOK const char* name \ + |STRLEN len|I32 level|U32 flags +#endif +Apd |HV* |gv_stashsv |NN SV* sv|I32 flags +Apd |void |hv_clear |NULLOK HV *hv +: used in SAVEHINTS() and op.c +ApdR |HV * |hv_copy_hints_hv|NULLOK HV *const ohv +Ap |void |hv_delayfree_ent|NN HV *hv|NULLOK HE *entry +Abmd |SV* |hv_delete |NULLOK HV *hv|NN const char *key|I32 klen \ + |I32 flags +Abmd |SV* |hv_delete_ent |NULLOK HV *hv|NN SV *keysv|I32 flags|U32 hash +AbmdR |bool |hv_exists |NULLOK HV *hv|NN const char *key|I32 klen +AbmdR |bool |hv_exists_ent |NULLOK HV *hv|NN SV *keysv|U32 hash +Abmd |SV** |hv_fetch |NULLOK HV *hv|NN const char *key|I32 klen \ + |I32 lval +Abmd |HE* |hv_fetch_ent |NULLOK HV *hv|NN SV *keysv|I32 lval|U32 hash +Ap |void* |hv_common |NULLOK HV *hv|NULLOK SV *keysv \ + |NULLOK const char* key|STRLEN klen|int flags \ + |int action|NULLOK SV *val|U32 hash +Ap |void* |hv_common_key_len|NULLOK HV *hv|NN const char *key \ + |I32 klen_i32|const int action|NULLOK SV *val \ + |const U32 hash +Apod |STRLEN |hv_fill |NN HV *const hv +Ap |void |hv_free_ent |NN HV *hv|NULLOK HE *entry +Apd |I32 |hv_iterinit |NN HV *hv +ApdR |char* |hv_iterkey |NN HE* entry|NN I32* retlen +ApdR |SV* |hv_iterkeysv |NN HE* entry +ApdRbm |HE* |hv_iternext |NN HV *hv +ApdR |SV* |hv_iternextsv |NN HV *hv|NN char **key|NN I32 *retlen +ApMdR |HE* |hv_iternext_flags|NN HV *hv|I32 flags +ApdR |SV* |hv_iterval |NN HV *hv|NN HE *entry +Ap |void |hv_ksplit |NN HV *hv|IV newmax +Apdbm |void |hv_magic |NN HV *hv|NULLOK GV *gv|int how +#if defined(PERL_IN_HV_C) +s |SV * |refcounted_he_value |NN const struct refcounted_he *he +#endif +Xpd |HV * |refcounted_he_chain_2hv|NULLOK const struct refcounted_he *c|U32 flags +Xpd |SV * |refcounted_he_fetch_pvn|NULLOK const struct refcounted_he *chain \ + |NN const char *keypv|STRLEN keylen|U32 hash|U32 flags +Xpd |SV * |refcounted_he_fetch_pv|NULLOK const struct refcounted_he *chain \ + |NN const char *key|U32 hash|U32 flags +Xpd |SV * |refcounted_he_fetch_sv|NULLOK const struct refcounted_he *chain \ + |NN SV *key|U32 hash|U32 flags +Xpd |struct refcounted_he *|refcounted_he_new_pvn \ + |NULLOK struct refcounted_he *parent \ + |NN const char *keypv|STRLEN keylen \ + |U32 hash|NULLOK SV *value|U32 flags +Xpd |struct refcounted_he *|refcounted_he_new_pv \ + |NULLOK struct refcounted_he *parent \ + |NN const char *key \ + |U32 hash|NULLOK SV *value|U32 flags +Xpd |struct refcounted_he *|refcounted_he_new_sv \ + |NULLOK struct refcounted_he *parent \ + |NN SV *key \ + |U32 hash|NULLOK SV *value|U32 flags +Xpd |void |refcounted_he_free|NULLOK struct refcounted_he *he +Xpd |struct refcounted_he *|refcounted_he_inc|NULLOK struct refcounted_he *he +Abmd |SV** |hv_store |NULLOK HV *hv|NULLOK const char *key \ + |I32 klen|NULLOK SV *val|U32 hash +Abmd |HE* |hv_store_ent |NULLOK HV *hv|NULLOK SV *key|NULLOK SV *val\ + |U32 hash +AbmM |SV** |hv_store_flags |NULLOK HV *hv|NULLOK const char *key \ + |I32 klen|NULLOK SV *val|U32 hash|int flags +Amd |void |hv_undef |NULLOK HV *hv +poX |void |hv_undef_flags |NULLOK HV *hv|U32 flags +Am |I32 |ibcmp |NN const char* a|NN const char* b|I32 len +AnpP |I32 |foldEQ |NN const char* a|NN const char* b|I32 len +Am |I32 |ibcmp_locale |NN const char* a|NN const char* b|I32 len +AnpP |I32 |foldEQ_locale |NN const char* a|NN const char* b|I32 len +Am |I32 |ibcmp_utf8 |NN const char *s1|NULLOK char **pe1|UV l1 \ + |bool u1|NN const char *s2|NULLOK char **pe2 \ + |UV l2|bool u2 +Amd |I32 |foldEQ_utf8 |NN const char *s1|NULLOK char **pe1|UV l1 \ + |bool u1|NN const char *s2|NULLOK char **pe2 \ + |UV l2|bool u2 +AMp |I32 |foldEQ_utf8_flags |NN const char *s1|NULLOK char **pe1|UV l1 \ + |bool u1|NN const char *s2|NULLOK char **pe2 \ + |UV l2|bool u2|U32 flags +AnpP |I32 |foldEQ_latin1 |NN const char* a|NN const char* b|I32 len +#if defined(PERL_IN_DOIO_C) +sR |bool |ingroup |Gid_t testgid|bool effective +#endif +: Used in toke.c +p |void |init_argv_symbols|int argc|NN char **argv +: Used in pp_ctl.c +po |void |init_dbargs +: Used in mg.c +p |void |init_debugger +Ap |void |init_stacks +Ap |void |init_tm |NN struct tm *ptm +: Used in perly.y +AnpPR |char* |instr |NN const char* big|NN const char* little +: Used in sv.c +p |bool |io_close |NN IO* io|NULLOK GV *gv \ + |bool not_implicit|bool warn_on_fail +: Used in perly.y +pR |OP* |invert |NULLOK OP* cmd +ApR |I32 |is_lvalue_sub +: Used in cop.h +XopR |I32 |was_lvalue_sub +#ifndef PERL_NO_INLINE_FUNCTIONS +AiMRn |STRLEN |_is_utf8_char_slow|NN const U8 *s|NN const U8 *e +#endif +ADMpPR |U32 |to_uni_upper_lc|U32 c +ADMpPR |U32 |to_uni_title_lc|U32 c +ADMpPR |U32 |to_uni_lower_lc|U32 c +ADMpPR |bool |is_uni_alnum |UV c +ADMpPR |bool |is_uni_alnumc |UV c +ADMpPR |bool |is_uni_idfirst |UV c +ADMpPR |bool |is_uni_alpha |UV c +ADMpPR |bool |is_uni_ascii |UV c +ADMpPR |bool |is_uni_blank |UV c +ADMpPR |bool |is_uni_space |UV c +ADMpPR |bool |is_uni_cntrl |UV c +ADMpPR |bool |is_uni_graph |UV c +ADMpPR |bool |is_uni_digit |UV c +ADMpPR |bool |is_uni_upper |UV c +ADMpPR |bool |is_uni_lower |UV c +ADMpPR |bool |is_uni_print |UV c +ADMpPR |bool |is_uni_punct |UV c +ADMpPR |bool |is_uni_xdigit |UV c +AMp |UV |to_uni_upper |UV c|NN U8 *p|NN STRLEN *lenp +AMp |UV |to_uni_title |UV c|NN U8 *p|NN STRLEN *lenp +ADMpPR |bool |isIDFIRST_lazy |NN const char* p +ADMpPR |bool |isALNUM_lazy |NN const char* p +#ifdef PERL_IN_UTF8_C +snR |U8 |to_lower_latin1|const U8 c|NULLOK U8 *p|NULLOK STRLEN *lenp +#endif +#if defined(PERL_IN_UTF8_C) || defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) +EXp |UV |_to_fold_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const unsigned int flags +#endif +#if defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C) +p |UV |_to_upper_title_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const char S_or_s +#endif +AMp |UV |to_uni_lower |UV c|NN U8 *p|NN STRLEN *lenp +AMmp |UV |to_uni_fold |UV c|NN U8 *p|NN STRLEN *lenp +AMp |UV |_to_uni_fold_flags|UV c|NN U8 *p|NN STRLEN *lenp|U8 flags +ADMpPR |bool |is_uni_alnum_lc|UV c +ADMpPR |bool |is_uni_alnumc_lc|UV c +ADMpPR |bool |is_uni_idfirst_lc|UV c +AMpR |bool |_is_uni_perl_idcont|UV c +AMpR |bool |_is_uni_perl_idstart|UV c +ADMpPR |bool |is_uni_alpha_lc|UV c +ADMpPR |bool |is_uni_ascii_lc|UV c +ADMpPR |bool |is_uni_space_lc|UV c +ADMpPR |bool |is_uni_blank_lc|UV c +ADMpPR |bool |is_uni_cntrl_lc|UV c +ADMpPR |bool |is_uni_graph_lc|UV c +ADMpPR |bool |is_uni_digit_lc|UV c +ADMpPR |bool |is_uni_upper_lc|UV c +ADMpPR |bool |is_uni_lower_lc|UV c +ADMpPR |bool |is_uni_print_lc|UV c +ADMpPR |bool |is_uni_punct_lc|UV c +ADMpPR |bool |is_uni_xdigit_lc|UV c +AnpdR |bool |is_invariant_string|NN const U8 *s|STRLEN len +AmpdR |bool |is_ascii_string|NN const U8 *s|STRLEN len +AnpdD |STRLEN |is_utf8_char |NN const U8 *s +Abmnpd |STRLEN |is_utf8_char_buf|NN const U8 *buf|NN const U8 *buf_end +Anpd |bool |is_utf8_string |NN const U8 *s|STRLEN len +Anpdmb |bool |is_utf8_string_loc|NN const U8 *s|STRLEN len|NULLOK const U8 **ep +Anpd |bool |is_utf8_string_loclen|NN const U8 *s|STRLEN len|NULLOK const U8 **ep|NULLOK STRLEN *el +AMpR |bool |_is_uni_FOO|const U8 classnum|const UV c +AMpR |bool |_is_utf8_FOO|const U8 classnum|NN const U8 *p +ADMpR |bool |is_utf8_alnum |NN const U8 *p +ADMpR |bool |is_utf8_alnumc |NN const U8 *p +ADMpR |bool |is_utf8_idfirst|NN const U8 *p +ADMpR |bool |is_utf8_xidfirst|NN const U8 *p +AMpR |bool |_is_utf8_idcont|NN const U8 *p +AMpR |bool |_is_utf8_idstart|NN const U8 *p +AMpR |bool |_is_utf8_xidcont|NN const U8 *p +AMpR |bool |_is_utf8_xidstart|NN const U8 *p +AMpR |bool |_is_utf8_perl_idcont|NN const U8 *p +AMpR |bool |_is_utf8_perl_idstart|NN const U8 *p +ADMpR |bool |is_utf8_idcont |NN const U8 *p +ADMpR |bool |is_utf8_xidcont |NN const U8 *p +ADMpR |bool |is_utf8_alpha |NN const U8 *p +ADMpR |bool |is_utf8_ascii |NN const U8 *p +ADMpR |bool |is_utf8_blank |NN const U8 *p +ADMpR |bool |is_utf8_space |NN const U8 *p +ADMpR |bool |is_utf8_perl_space |NN const U8 *p +ADMpR |bool |is_utf8_perl_word |NN const U8 *p +ADMpR |bool |is_utf8_cntrl |NN const U8 *p +ADMpR |bool |is_utf8_digit |NN const U8 *p +ADMpR |bool |is_utf8_posix_digit |NN const U8 *p +ADMpR |bool |is_utf8_graph |NN const U8 *p +ADMpR |bool |is_utf8_upper |NN const U8 *p +ADMpR |bool |is_utf8_lower |NN const U8 *p +ADMpR |bool |is_utf8_print |NN const U8 *p +ADMpR |bool |is_utf8_punct |NN const U8 *p +ADMpR |bool |is_utf8_xdigit |NN const U8 *p +AMpR |bool |_is_utf8_mark |NN const U8 *p +ADMpR |bool |is_utf8_mark |NN const U8 *p +: Used in perly.y +p |OP* |jmaybe |NN OP *o +: Used in pp.c +pP |I32 |keyword |NN const char *name|I32 len|bool all_keywords +#if defined(PERL_IN_OP_C) +s |void |inplace_aassign |NN OP* o +#endif +Ap |void |leave_scope |I32 base +: Public lexer API +AMpd |void |lex_start |NULLOK SV* line|NULLOK PerlIO *rsfp|U32 flags +AMpd |bool |lex_bufutf8 +AMpd |char* |lex_grow_linestr|STRLEN len +AMpd |void |lex_stuff_pvn |NN const char* pv|STRLEN len|U32 flags +AMpd |void |lex_stuff_pv |NN const char* pv|U32 flags +AMpd |void |lex_stuff_sv |NN SV* sv|U32 flags +AMpd |void |lex_unstuff |NN char* ptr +AMpd |void |lex_read_to |NN char* ptr +AMpd |void |lex_discard_to |NN char* ptr +AMpd |bool |lex_next_chunk |U32 flags +AMpd |I32 |lex_peek_unichar|U32 flags +AMpd |I32 |lex_read_unichar|U32 flags +AMpd |void |lex_read_space |U32 flags +: Public parser API +AMpd |OP* |parse_arithexpr|U32 flags +AMpd |OP* |parse_termexpr |U32 flags +AMpd |OP* |parse_listexpr |U32 flags +AMpd |OP* |parse_fullexpr |U32 flags +AMpd |OP* |parse_block |U32 flags +AMpd |OP* |parse_barestmt |U32 flags +AMpd |SV* |parse_label |U32 flags +AMpd |OP* |parse_fullstmt |U32 flags +AMpd |OP* |parse_stmtseq |U32 flags +: Used in various files +Apd |void |op_null |NN OP* o +: FIXME. Used by Data::Alias +EXp |void |op_clear |NN OP* o +Ap |void |op_refcnt_lock +Ap |void |op_refcnt_unlock +Apdn |OP* |op_sibling_splice|NULLOK OP *parent|NULLOK OP *start \ + |int del_count|NULLOK OP* insert +#ifdef PERL_OP_PARENT +Apdn |OP* |op_parent|NN OP *o +#endif +#if defined(PERL_IN_OP_C) +s |OP* |listkids |NULLOK OP* o +#endif +p |OP* |list |NULLOK OP* o +Apd |void |load_module|U32 flags|NN SV* name|NULLOK SV* ver|... +Ap |void |vload_module|U32 flags|NN SV* name|NULLOK SV* ver|NULLOK va_list* args +: Used in perly.y +p |OP* |localize |NN OP *o|I32 lex +ApdR |I32 |looks_like_number|NN SV *const sv +Apd |UV |grok_bin |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_DQUOTE_C) +EMpRX |bool |grok_bslash_x |NN char** s|NN UV* uv \ + |NN const char** error_msg \ + |const bool output_warning \ + |const bool strict \ + |const bool silence_non_portable \ + |const bool utf8 +EMpRX |char |grok_bslash_c |const char source|const bool output_warning +EMpRX |bool |grok_bslash_o |NN char** s|NN UV* uv \ + |NN const char** error_msg \ + |const bool output_warning \ + |const bool strict \ + |const bool silence_non_portable \ + |const bool utf8 +EMiR |char*|form_short_octal_warning|NN const char * const s \ + |const STRLEN len +EiPRn |I32 |regcurly |NN const char *s +#endif +Apd |UV |grok_hex |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result +Apd |int |grok_infnan |NN const char** sp|NN const char *send +Apd |int |grok_number |NN const char *pv|STRLEN len|NULLOK UV *valuep +Apd |int |grok_number_flags|NN const char *pv|STRLEN len|NULLOK UV *valuep|U32 flags +ApdR |bool |grok_numeric_radix|NN const char **sp|NN const char *send +Apd |UV |grok_oct |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result +EXpn |bool |grok_atoUV |NN const char* pv|NN UV* valptr|NULLOK const char** endptr +: These are all indirectly referenced by globals.c. This is somewhat annoying. +p |int |magic_clearenv |NN SV* sv|NN MAGIC* mg +p |int |magic_clear_all_env|NN SV* sv|NN MAGIC* mg +dp |int |magic_clearhint|NN SV* sv|NN MAGIC* mg +dp |int |magic_clearhints|NN SV* sv|NN MAGIC* mg +p |int |magic_clearisa |NULLOK SV* sv|NN MAGIC* mg +p |int |magic_clearpack|NN SV* sv|NN MAGIC* mg +p |int |magic_clearsig |NN SV* sv|NN MAGIC* mg +p |int |magic_copycallchecker|NN SV* sv|NN MAGIC *mg|NN SV *nsv \ + |NULLOK const char *name|I32 namlen +p |int |magic_existspack|NN SV* sv|NN const MAGIC* mg +p |int |magic_freeovrld|NN SV* sv|NN MAGIC* mg +p |int |magic_get |NN SV* sv|NN MAGIC* mg +p |int |magic_getarylen|NN SV* sv|NN const MAGIC* mg +p |int |magic_getdefelem|NN SV* sv|NN MAGIC* mg +p |int |magic_getdebugvar|NN SV* sv|NN MAGIC* mg +p |int |magic_getnkeys |NN SV* sv|NN MAGIC* mg +p |int |magic_getpack |NN SV* sv|NN MAGIC* mg +p |int |magic_getpos |NN SV* sv|NN MAGIC* mg +p |int |magic_getsig |NN SV* sv|NN MAGIC* mg +p |int |magic_getsubstr|NN SV* sv|NN MAGIC* mg +p |int |magic_gettaint |NN SV* sv|NN MAGIC* mg +p |int |magic_getuvar |NN SV* sv|NN MAGIC* mg +p |int |magic_getvec |NN SV* sv|NN MAGIC* mg +p |int |magic_nextpack |NN SV *sv|NN MAGIC *mg|NN SV *key +p |U32 |magic_regdata_cnt|NN SV* sv|NN MAGIC* mg +p |int |magic_regdatum_get|NN SV* sv|NN MAGIC* mg +:removing noreturn to silence a warning for this function resulted in no +:change to the interpreter DLL image under VS 2003 -O1 -GL 32 bits only because +:this is used in a magic vtable, do not use this on conventionally called funcs +#ifdef _MSC_VER +p |int |magic_regdatum_set|NN SV* sv|NN MAGIC* mg +#else +pr |int |magic_regdatum_set|NN SV* sv|NN MAGIC* mg +#endif +p |int |magic_set |NN SV* sv|NN MAGIC* mg +p |int |magic_setarylen|NN SV* sv|NN MAGIC* mg +p |int |magic_cleararylen_p|NN SV* sv|NN MAGIC* mg +p |int |magic_freearylen_p|NN SV* sv|NN MAGIC* mg +p |int |magic_setdbline|NN SV* sv|NN MAGIC* mg +p |int |magic_setdebugvar|NN SV* sv|NN MAGIC* mg +p |int |magic_setdefelem|NN SV* sv|NN MAGIC* mg +p |int |magic_setenv |NN SV* sv|NN MAGIC* mg +dp |int |magic_sethint |NN SV* sv|NN MAGIC* mg +p |int |magic_setisa |NN SV* sv|NN MAGIC* mg +p |int |magic_setlvref |NN SV* sv|NN MAGIC* mg +p |int |magic_setmglob |NN SV* sv|NN MAGIC* mg +p |int |magic_setnkeys |NN SV* sv|NN MAGIC* mg +p |int |magic_setpack |NN SV* sv|NN MAGIC* mg +p |int |magic_setpos |NN SV* sv|NN MAGIC* mg +p |int |magic_setregexp|NN SV* sv|NN MAGIC* mg +p |int |magic_setsig |NULLOK SV* sv|NN MAGIC* mg +p |int |magic_setsubstr|NN SV* sv|NN MAGIC* mg +p |int |magic_settaint |NN SV* sv|NN MAGIC* mg +p |int |magic_setuvar |NN SV* sv|NN MAGIC* mg +p |int |magic_setvec |NN SV* sv|NN MAGIC* mg +p |int |magic_setutf8 |NN SV* sv|NN MAGIC* mg +p |int |magic_set_all_env|NN SV* sv|NN MAGIC* mg +p |U32 |magic_sizepack |NN SV* sv|NN MAGIC* mg +p |int |magic_wipepack |NN SV* sv|NN MAGIC* mg +pod |SV* |magic_methcall |NN SV *sv|NN const MAGIC *mg \ + |NN SV *meth|U32 flags \ + |U32 argc|... +Ap |I32 * |markstack_grow +#if defined(USE_LOCALE_COLLATE) +p |int |magic_setcollxfrm|NN SV* sv|NN MAGIC* mg +: Defined in locale.c, used only in sv.c +p |char* |mem_collxfrm |NN const char* s|STRLEN len|NN STRLEN* xlen +#endif +Afpd |SV* |mess |NN const char* pat|... +Apd |SV* |mess_sv |NN SV* basemsg|bool consume +Apd |SV* |vmess |NN const char* pat|NULLOK va_list* args +: FIXME - either make it public, or stop exporting it. (Data::Alias uses this) +: Used in gv.c, op.c, toke.c +EXp |void |qerror |NN SV* err +Apd |void |sortsv |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp +Apd |void |sortsv_flags |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t cmp|U32 flags +Apd |int |mg_clear |NN SV* sv +Apd |int |mg_copy |NN SV *sv|NN SV *nsv|NULLOK const char *key \ + |I32 klen +: Defined in mg.c, used only in scope.c +pd |void |mg_localize |NN SV* sv|NN SV* nsv|bool setmagic +ApdRn |MAGIC* |mg_find |NULLOK const SV* sv|int type +ApdRn |MAGIC* |mg_findext |NULLOK const SV* sv|int type|NULLOK const MGVTBL *vtbl +: exported for re.pm +EXpR |MAGIC* |mg_find_mglob |NN SV* sv +Apd |int |mg_free |NN SV* sv +Apd |void |mg_free_type |NN SV* sv|int how +Apd |int |mg_get |NN SV* sv +ApdD |U32 |mg_length |NN SV* sv +Apdn |void |mg_magical |NN SV* sv +Apd |int |mg_set |NN SV* sv +Ap |I32 |mg_size |NN SV* sv +Apn |void |mini_mktime |NN struct tm *ptm +AMmd |OP* |op_lvalue |NULLOK OP* o|I32 type +poX |OP* |op_lvalue_flags|NULLOK OP* o|I32 type|U32 flags +p |void |finalize_optree |NN OP* o +#if defined(PERL_IN_OP_C) +s |void |finalize_op |NN OP* o +s |void |move_proto_attr|NN OP **proto|NN OP **attrs|NN const GV *name +#endif +: Used in op.c and pp_sys.c +p |int |mode_from_discipline|NULLOK const char* s|STRLEN len +Ap |const char* |moreswitches |NN const char* s +Ap |NV |my_atof |NN const char *s +#if !defined(HAS_MEMCPY) || (!defined(HAS_MEMMOVE) && !defined(HAS_SAFE_MEMCPY)) +Anp |void* |my_bcopy |NN const void* vfrom|NN void* vto|size_t len +#endif +#if !defined(HAS_BZERO) && !defined(HAS_MEMSET) +Anp |void* |my_bzero |NN void* vloc|size_t len +#endif +Apr |void |my_exit |U32 status +Apr |void |my_failure_exit +Ap |I32 |my_fflush_all +Anp |Pid_t |my_fork +Anp |void |atfork_lock +Anp |void |atfork_unlock +Apmb |I32 |my_lstat +pX |I32 |my_lstat_flags |NULLOK const U32 flags +#if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) +AnpP |int |my_memcmp |NN const void* vs1|NN const void* vs2|size_t len +#endif +#if !defined(HAS_MEMSET) +Anp |void* |my_memset |NN void* vloc|int ch|size_t len +#endif +#if !defined(PERL_IMPLICIT_SYS) +Ap |I32 |my_pclose |NULLOK PerlIO* ptr +Ap |PerlIO*|my_popen |NN const char* cmd|NN const char* mode +#endif +Ap |PerlIO*|my_popen_list |NN const char* mode|int n|NN SV ** args +Ap |void |my_setenv |NULLOK const char* nam|NULLOK const char* val +Apmb |I32 |my_stat +pX |I32 |my_stat_flags |NULLOK const U32 flags +Afp |char * |my_strftime |NN const char *fmt|int sec|int min|int hour|int mday|int mon|int year|int wday|int yday|int isdst +: Used in pp_ctl.c +p |void |my_unexec +ADMnoPR |UV |NATIVE_TO_NEED |const UV enc|const UV ch +ADMnoPR |UV |ASCII_TO_NEED |const UV enc|const UV ch +Apa |OP* |newANONLIST |NULLOK OP* o +Apa |OP* |newANONHASH |NULLOK OP* o +Ap |OP* |newANONSUB |I32 floor|NULLOK OP* proto|NULLOK OP* block +Apda |OP* |newASSIGNOP |I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right +Apda |OP* |newCONDOP |I32 flags|NN OP* first|NULLOK OP* trueop|NULLOK OP* falseop +Apd |CV* |newCONSTSUB |NULLOK HV* stash|NULLOK const char* name|NULLOK SV* sv +Apd |CV* |newCONSTSUB_flags|NULLOK HV* stash \ + |NULLOK const char* name|STRLEN len \ + |U32 flags|NULLOK SV* sv +Ap |void |newFORM |I32 floor|NULLOK OP* o|NULLOK OP* block +Apda |OP* |newFOROP |I32 flags|NULLOK OP* sv|NN OP* expr|NULLOK OP* block|NULLOK OP* cont +Apda |OP* |newGIVENOP |NN OP* cond|NN OP* block|PADOFFSET defsv_off +Apda |OP* |newLOGOP |I32 optype|I32 flags|NN OP *first|NN OP *other +Apda |OP* |newLOOPEX |I32 type|NN OP* label +Apda |OP* |newLOOPOP |I32 flags|I32 debuggable|NULLOK OP* expr|NULLOK OP* block +Apda |OP* |newNULLLIST +Apda |OP* |newOP |I32 optype|I32 flags +Ap |void |newPROG |NN OP* o +Apda |OP* |newRANGE |I32 flags|NN OP* left|NN OP* right +Apda |OP* |newSLICEOP |I32 flags|NULLOK OP* subscript|NULLOK OP* listop +Apda |OP* |newSTATEOP |I32 flags|NULLOK char* label|NULLOK OP* o +Abm |CV* |newSUB |I32 floor|NULLOK OP* o|NULLOK OP* proto \ + |NULLOK OP* block +p |CV * |newXS_len_flags|NULLOK const char *name|STRLEN len \ + |NN XSUBADDR_t subaddr\ + |NULLOK const char *const filename \ + |NULLOK const char *const proto \ + |NULLOK SV **const_svp|U32 flags +pX |CV * |newXS_deffile |NN const char *name|NN XSUBADDR_t subaddr +ApM |CV * |newXS_flags |NULLOK const char *name|NN XSUBADDR_t subaddr\ + |NN const char *const filename \ + |NULLOK const char *const proto|U32 flags +Apd |CV* |newXS |NULLOK const char *name|NN XSUBADDR_t subaddr\ + |NN const char *filename +AmdbR |AV* |newAV +Apa |OP* |newAVREF |NN OP* o +Apda |OP* |newBINOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last +Apa |OP* |newCVREF |I32 flags|NULLOK OP* o +Apda |OP* |newGVOP |I32 type|I32 flags|NN GV* gv +Am |GV* |newGVgen |NN const char* pack +Apa |GV* |newGVgen_flags |NN const char* pack|U32 flags +Apa |OP* |newGVREF |I32 type|NULLOK OP* o +ApaR |OP* |newHVREF |NN OP* o +AmdbR |HV* |newHV +ApaR |HV* |newHVhv |NULLOK HV *hv +Apabm |IO* |newIO +Apda |OP* |newLISTOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last +AMpdan |PADNAME *|newPADNAMEouter|NN PADNAME *outer +AMpdan |PADNAME *|newPADNAMEpvn|NN const char *s|STRLEN len +AMpdan |PADNAMELIST *|newPADNAMELIST|size_t max +#ifdef USE_ITHREADS +Apda |OP* |newPADOP |I32 type|I32 flags|NN SV* sv +#endif +Apda |OP* |newPMOP |I32 type|I32 flags +Apda |OP* |newPVOP |I32 type|I32 flags|NULLOK char* pv +Apa |SV* |newRV |NN SV *const sv +Apda |SV* |newRV_noinc |NN SV *const tmpRef +Apda |SV* |newSV |const STRLEN len +Apa |OP* |newSVREF |NN OP* o +Apda |OP* |newSVOP |I32 type|I32 flags|NN SV* sv +ApdR |OP* |newDEFSVOP +pa |SV* |newSVavdefelem |NN AV *av|SSize_t ix|bool extendible +Apda |SV* |newSViv |const IV i +Apda |SV* |newSVuv |const UV u +Apda |SV* |newSVnv |const NV n +Apda |SV* |newSVpv |NULLOK const char *const s|const STRLEN len +Apda |SV* |newSVpvn |NULLOK const char *const s|const STRLEN len +Apda |SV* |newSVpvn_flags |NULLOK const char *const s|const STRLEN len|const U32 flags +Apda |SV* |newSVhek |NULLOK const HEK *const hek +Apda |SV* |newSVpvn_share |NULLOK const char* s|I32 len|U32 hash +Apda |SV* |newSVpv_share |NULLOK const char* s|U32 hash +Afpda |SV* |newSVpvf |NN const char *const pat|... +Apa |SV* |vnewSVpvf |NN const char *const pat|NULLOK va_list *const args +Apd |SV* |newSVrv |NN SV *const rv|NULLOK const char *const classname +Apda |SV* |newSVsv |NULLOK SV *const old +Apda |SV* |newSV_type |const svtype type +Apda |OP* |newUNOP |I32 type|I32 flags|NULLOK OP* first +Apda |OP* |newUNOP_AUX |I32 type|I32 flags|NULLOK OP* first \ + |NULLOK UNOP_AUX_item *aux +Apda |OP* |newWHENOP |NULLOK OP* cond|NN OP* block +Apda |OP* |newWHILEOP |I32 flags|I32 debuggable|NULLOK LOOP* loop \ + |NULLOK OP* expr|NULLOK OP* block|NULLOK OP* cont \ + |I32 has_my +Apda |OP* |newMETHOP |I32 type|I32 flags|NN OP* dynamic_meth +Apda |OP* |newMETHOP_named|I32 type|I32 flags|NN SV* const_meth +Apd |CV* |rv2cv_op_cv |NN OP *cvop|U32 flags +Apd |OP* |ck_entersub_args_list|NN OP *entersubop +Apd |OP* |ck_entersub_args_proto|NN OP *entersubop|NN GV *namegv|NN SV *protosv +Apd |OP* |ck_entersub_args_proto_or_list|NN OP *entersubop|NN GV *namegv|NN SV *protosv +po |OP* |ck_entersub_args_core|NN OP *entersubop|NN GV *namegv \ + |NN SV *protosv +Apd |void |cv_get_call_checker|NN CV *cv|NN Perl_call_checker *ckfun_p|NN SV **ckobj_p +Apd |void |cv_set_call_checker|NN CV *cv|NN Perl_call_checker ckfun|NN SV *ckobj +Apd |void |cv_set_call_checker_flags|NN CV *cv \ + |NN Perl_call_checker ckfun \ + |NN SV *ckobj|U32 flags +Apd |void |wrap_op_checker|Optype opcode|NN Perl_check_t new_checker|NN Perl_check_t *old_checker_p +Apa |PERL_SI*|new_stackinfo|I32 stitems|I32 cxitems +Ap |char* |scan_vstring |NN const char *s|NN const char *const e \ + |NN SV *sv +Apd |const char* |scan_version |NN const char *s|NN SV *rv|bool qv +Apd |const char* |prescan_version |NN const char *s\ + |bool strict|NULLOK const char** errstr|NULLOK bool *sqv\ + |NULLOK int *ssaw_decimal|NULLOK int *swidth|NULLOK bool *salpha +Apd |SV* |new_version |NN SV *ver +Apd |SV* |upg_version |NN SV *ver|bool qv +Apd |SV* |vverify |NN SV *vs +Apd |SV* |vnumify |NN SV *vs +Apd |SV* |vnormal |NN SV *vs +Apd |SV* |vstringify |NN SV *vs +Apd |int |vcmp |NN SV *lhv|NN SV *rhv +: Used in pp_hot.c and pp_sys.c +p |PerlIO*|nextargv |NN GV* gv|bool nomagicopen +AnpP |char* |ninstr |NN const char* big|NN const char* bigend \ + |NN const char* little|NN const char* lend +Apd |void |op_free |NULLOK OP* arg +Mp |OP* |op_unscope |NULLOK OP* o +#ifdef PERL_CORE +p |void |opslab_free |NN OPSLAB *slab +p |void |opslab_free_nopad|NN OPSLAB *slab +p |void |opslab_force_free|NN OPSLAB *slab +#endif +: Used in perly.y +p |void |package |NN OP* o +: Used in perly.y +p |void |package_version|NN OP* v +: Used in toke.c and perly.y +p |PADOFFSET|allocmy |NN const char *const name|const STRLEN len\ + |const U32 flags +#ifdef USE_ITHREADS +AMp |PADOFFSET|alloccopstash|NN HV *hv +#endif +: Used in perly.y +pR |OP* |oopsAV |NN OP* o +: Used in perly.y +pR |OP* |oopsHV |NN OP* o + +: peephole optimiser +p |void |peep |NULLOK OP* o +p |void |rpeep |NULLOK OP* o +: Defined in doio.c, used only in pp_hot.c +dopM |PerlIO*|start_glob |NN SV *tmpglob|NN IO *io + +Ap |void |reentrant_size +Ap |void |reentrant_init +Ap |void |reentrant_free +Anp |void* |reentrant_retry|NN const char *f|... + +: "Very" special - can't use the O flag for this one: +: (The rename from perl_atexit to Perl_call_atexit was in 864dbfa3ca8032ef) +Ap |void |call_atexit |ATEXIT_t fn|NULLOK void *ptr +ApdO |I32 |call_argv |NN const char* sub_name|I32 flags|NN char** argv +ApdO |I32 |call_method |NN const char* methname|I32 flags +ApdO |I32 |call_pv |NN const char* sub_name|I32 flags +ApdO |I32 |call_sv |NN SV* sv|VOL I32 flags +Ap |void |despatch_signals +Ap |OP * |doref |NN OP *o|I32 type|bool set_op_ref +ApdO |SV* |eval_pv |NN const char* p|I32 croak_on_error +ApdO |I32 |eval_sv |NN SV* sv|I32 flags +ApdO |SV* |get_sv |NN const char *name|I32 flags +ApdO |AV* |get_av |NN const char *name|I32 flags +ApdO |HV* |get_hv |NN const char *name|I32 flags +ApdO |CV* |get_cv |NN const char* name|I32 flags +Apd |CV* |get_cvn_flags |NN const char* name|STRLEN len|I32 flags +#ifdef WIN32 +ApPM |char* |my_setlocale |int category|NULLOK const char* locale +#else +AmPM |char* |my_setlocale |int category|NULLOK const char* locale +#endif +ApOM |int |init_i18nl10n |int printwarn +ApOM |int |init_i18nl14n |int printwarn +ApM |char* |my_strerror |const int errnum +ApOM |void |new_collate |NULLOK const char* newcoll +ApOM |void |new_ctype |NN const char* newctype +EXpMn |void |_warn_problematic_locale +ApOM |void |new_numeric |NULLOK const char* newcoll +Ap |void |set_numeric_local +Ap |void |set_numeric_radix +Ap |void |set_numeric_standard +ApM |bool |_is_in_locale_category|const bool compiling|const int category +Apd |void |sync_locale +ApdO |void |require_pv |NN const char* pv +Apd |void |pack_cat |NN SV *cat|NN const char *pat|NN const char *patend \ + |NN SV **beglist|NN SV **endlist|NN SV ***next_in_list|U32 flags +Apd |void |packlist |NN SV *cat|NN const char *pat|NN const char *patend|NN SV **beglist|NN SV **endlist +#if defined(PERL_USES_PL_PIDSTATUS) && defined(PERL_IN_UTIL_C) +s |void |pidgone |Pid_t pid|int status +#endif +: Used in perly.y +p |OP* |pmruntime |NN OP *o|NN OP *expr|NULLOK OP *repl \ + |bool isreg|I32 floor +#if defined(PERL_IN_OP_C) +s |OP* |pmtrans |NN OP* o|NN OP* expr|NN OP* repl +#endif +Ap |void |pop_scope +Ap |void |push_scope +Amb |OP* |ref |NULLOK OP* o|I32 type +#if defined(PERL_IN_OP_C) +s |OP* |refkids |NULLOK OP* o|I32 type +#endif +Ap |void |regdump |NN const regexp* r +ApM |SV* |regclass_swash |NULLOK const regexp *prog \ + |NN const struct regnode *node|bool doinit \ + |NULLOK SV **listsvp|NULLOK SV **altsvp +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_PERL_C) || defined(PERL_IN_UTF8_C) +AMpR |SV* |_new_invlist_C_array|NN const UV* const list +EXMp |bool |_invlistEQ |NN SV* const a|NN SV* const b|const bool complement_b +#endif +Ap |I32 |pregexec |NN REGEXP * const prog|NN char* stringarg \ + |NN char* strend|NN char* strbeg \ + |SSize_t minend |NN SV* screamer|U32 nosave +Ap |void |pregfree |NULLOK REGEXP* r +Ap |void |pregfree2 |NN REGEXP *rx +: FIXME - is anything in re using this now? +EXp |REGEXP*|reg_temp_copy |NULLOK REGEXP* ret_x|NN REGEXP* rx +Ap |void |regfree_internal|NN REGEXP *const rx +#if defined(USE_ITHREADS) +Ap |void* |regdupe_internal|NN REGEXP * const r|NN CLONE_PARAMS* param +#endif +EXp |regexp_engine const *|current_re_engine +Ap |REGEXP*|pregcomp |NN SV * const pattern|const U32 flags +p |REGEXP*|re_op_compile |NULLOK SV ** const patternp \ + |int pat_count|NULLOK OP *expr \ + |NN const regexp_engine* eng \ + |NULLOK REGEXP *old_re \ + |NULLOK bool *is_bare_re \ + |U32 rx_flags|U32 pm_flags +Ap |REGEXP*|re_compile |NN SV * const pattern|U32 orig_rx_flags +Ap |char* |re_intuit_start|NN REGEXP * const rx \ + |NULLOK SV* sv \ + |NN const char* const strbeg \ + |NN char* strpos \ + |NN char* strend \ + |const U32 flags \ + |NULLOK re_scream_pos_data *data +Ap |SV* |re_intuit_string|NN REGEXP *const r +Ap |I32 |regexec_flags |NN REGEXP *const rx|NN char *stringarg \ + |NN char *strend|NN char *strbeg \ + |SSize_t minend|NN SV *sv \ + |NULLOK void *data|U32 flags +ApR |regnode*|regnext |NULLOK regnode* p +EXp |SV*|reg_named_buff |NN REGEXP * const rx|NULLOK SV * const key \ + |NULLOK SV * const value|const U32 flags +EXp |SV*|reg_named_buff_iter |NN REGEXP * const rx|NULLOK const SV * const lastkey \ + |const U32 flags +Ap |SV*|reg_named_buff_fetch |NN REGEXP * const rx|NN SV * const namesv|const U32 flags +Ap |bool|reg_named_buff_exists |NN REGEXP * const rx|NN SV * const key|const U32 flags +Ap |SV*|reg_named_buff_firstkey |NN REGEXP * const rx|const U32 flags +Ap |SV*|reg_named_buff_nextkey |NN REGEXP * const rx|const U32 flags +Ap |SV*|reg_named_buff_scalar |NN REGEXP * const rx|const U32 flags +Ap |SV*|reg_named_buff_all |NN REGEXP * const rx|const U32 flags + +: FIXME - is anything in re using this now? +EXp |void|reg_numbered_buff_fetch|NN REGEXP * const rx|const I32 paren|NULLOK SV * const sv +: FIXME - is anything in re using this now? +EXp |void|reg_numbered_buff_store|NN REGEXP * const rx|const I32 paren|NULLOK SV const * const value +: FIXME - is anything in re using this now? +EXp |I32|reg_numbered_buff_length|NN REGEXP * const rx|NN const SV * const sv|const I32 paren + +: FIXME - is anything in re using this now? +EXp |SV*|reg_qr_package|NN REGEXP * const rx + +Anp |void |repeatcpy |NN char* to|NN const char* from|I32 len|IV count +AnpP |char* |rninstr |NN const char* big|NN const char* bigend \ + |NN const char* little|NN const char* lend +Ap |Sighandler_t|rsignal |int i|Sighandler_t t +: Used in pp_sys.c +p |int |rsignal_restore|int i|NULLOK Sigsave_t* t +: Used in pp_sys.c +p |int |rsignal_save |int i|Sighandler_t t1|NN Sigsave_t* save +Ap |Sighandler_t|rsignal_state|int i +#if defined(PERL_IN_PP_CTL_C) +s |void |rxres_free |NN void** rsp +s |void |rxres_restore |NN void **rsp|NN REGEXP *rx +#endif +: Used in pp_hot.c +p |void |rxres_save |NN void **rsp|NN REGEXP *rx +#if !defined(HAS_RENAME) +: Used in pp_sys.c +p |I32 |same_dirent |NN const char* a|NN const char* b +#endif +Apda |char* |savepv |NULLOK const char* pv +Apda |char* |savepvn |NULLOK const char* pv|I32 len +Apda |char* |savesharedpv |NULLOK const char* pv + +: NULLOK only to suppress a compiler warning +Apda |char* |savesharedpvn |NULLOK const char *const pv \ + |const STRLEN len +Apda |char* |savesharedsvpv |NN SV *sv +Apda |char* |savesvpv |NN SV* sv +Ap |void |savestack_grow +Ap |void |savestack_grow_cnt |I32 need +Amp |void |save_aelem |NN AV* av|SSize_t idx|NN SV **sptr +Ap |void |save_aelem_flags|NN AV* av|SSize_t idx|NN SV **sptr \ + |const U32 flags +Ap |I32 |save_alloc |I32 size|I32 pad +Ap |void |save_aptr |NN AV** aptr +Ap |AV* |save_ary |NN GV* gv +Ap |void |save_bool |NN bool* boolp +Ap |void |save_clearsv |NN SV** svp +Ap |void |save_delete |NN HV *hv|NN char *key|I32 klen +Ap |void |save_hdelete |NN HV *hv|NN SV *keysv +Ap |void |save_adelete |NN AV *av|SSize_t key +Ap |void |save_destructor|DESTRUCTORFUNC_NOCONTEXT_t f|NN void* p +Ap |void |save_destructor_x|DESTRUCTORFUNC_t f|NULLOK void* p +Apmb |void |save_freesv |NULLOK SV* sv +: Used in SAVEFREOP(), used in op.c, pp_ctl.c +Apmb |void |save_freeop |NULLOK OP* o +Apmb |void |save_freepv |NULLOK char* pv +Ap |void |save_generic_svref|NN SV** sptr +Ap |void |save_generic_pvref|NN char** str +Ap |void |save_shared_pvref|NN char** str +Adp |void |save_gp |NN GV* gv|I32 empty +Ap |HV* |save_hash |NN GV* gv +Ap |void |save_hints +Amp |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr +Ap |void |save_helem_flags|NN HV *hv|NN SV *key|NN SV **sptr|const U32 flags +Ap |void |save_hptr |NN HV** hptr +Ap |void |save_I16 |NN I16* intp +Ap |void |save_I32 |NN I32* intp +Ap |void |save_I8 |NN I8* bytep +Ap |void |save_int |NN int* intp +Ap |void |save_item |NN SV* item +Ap |void |save_iv |NN IV *ivp +Ap |void |save_list |NN SV** sarg|I32 maxsarg +Ap |void |save_long |NN long* longp +Apmb |void |save_mortalizesv|NN SV* sv +Ap |void |save_nogv |NN GV* gv +: Used in SAVEFREOP(), used in gv.c, op.c, perl.c, pp_ctl.c, pp_sort.c +Apmb |void |save_op +Ap |SV* |save_scalar |NN GV* gv +Ap |void |save_pptr |NN char** pptr +Ap |void |save_vptr |NN void *ptr +Ap |void |save_re_context +Ap |void |save_padsv_and_mortalize|PADOFFSET off +Ap |void |save_sptr |NN SV** sptr +Xp |void |save_strlen |NN STRLEN* ptr +Ap |SV* |save_svref |NN SV** sptr +AMpo |void |savetmps +Ap |void |save_pushptr |NULLOK void *const ptr|const int type +Ap |void |save_pushi32ptr|const I32 i|NULLOK void *const ptr|const int type +: Used by SAVESWITCHSTACK() in pp.c +Ap |void |save_pushptrptr|NULLOK void *const ptr1 \ + |NULLOK void *const ptr2|const int type +#if defined(PERL_IN_SCOPE_C) +s |void |save_pushptri32ptr|NULLOK void *const ptr1|const I32 i \ + |NULLOK void *const ptr2|const int type +#endif +: Used in perly.y +p |OP* |sawparens |NULLOK OP* o +Apd |OP* |op_contextualize|NN OP* o|I32 context +: Used in perly.y +p |OP* |scalar |NULLOK OP* o +#if defined(PERL_IN_OP_C) +s |OP* |scalarkids |NULLOK OP* o +s |OP* |scalarseq |NULLOK OP* o +#endif +: Used in pp_ctl.c +p |OP* |scalarvoid |NN OP* o +Apd |NV |scan_bin |NN const char* start|STRLEN len|NN STRLEN* retlen +Apd |NV |scan_hex |NN const char* start|STRLEN len|NN STRLEN* retlen +Ap |char* |scan_num |NN const char* s|NN YYSTYPE *lvalp +Apd |NV |scan_oct |NN const char* start|STRLEN len|NN STRLEN* retlen +AMpd |OP* |op_scope |NULLOK OP* o +: Only used by perl.c/miniperl.c, but defined in caretx.c +px |void |set_caret_X +Apd |void |setdefout |NN GV* gv +Ap |HEK* |share_hek |NN const char* str|I32 len|U32 hash +#if defined(HAS_SIGACTION) && defined(SA_SIGINFO) +: Used in perl.c +np |Signal_t |sighandler |int sig|NULLOK siginfo_t *info|NULLOK void *uap +Anp |Signal_t |csighandler |int sig|NULLOK siginfo_t *info|NULLOK void *uap +#else +np |Signal_t |sighandler |int sig +Anp |Signal_t |csighandler |int sig +#endif +Ap |SV** |stack_grow |NN SV** sp|NN SV** p|SSize_t n +Ap |I32 |start_subparse |I32 is_format|U32 flags +: Used in pp_ctl.c +p |void |sub_crush_depth|NN CV* cv +Amd |bool |sv_2bool |NN SV *const sv +Apd |bool |sv_2bool_flags |NN SV *sv|I32 flags +Apd |CV* |sv_2cv |NULLOK SV* sv|NN HV **const st|NN GV **const gvp \ + |const I32 lref +Apd |IO* |sv_2io |NN SV *const sv +#if defined(PERL_IN_SV_C) +s |bool |glob_2number |NN GV* const gv +#endif +Amb |IV |sv_2iv |NN SV *sv +Apd |IV |sv_2iv_flags |NN SV *const sv|const I32 flags +Apd |SV* |sv_2mortal |NULLOK SV *const sv +Apd |NV |sv_2nv_flags |NN SV *const sv|const I32 flags +: Used in pp.c, pp_hot.c, sv.c +pMd |SV* |sv_2num |NN SV *const sv +Amb |char* |sv_2pv |NN SV *sv|NULLOK STRLEN *lp +Apd |char* |sv_2pv_flags |NN SV *const sv|NULLOK STRLEN *const lp|const I32 flags +Apd |char* |sv_2pvutf8 |NN SV *sv|NULLOK STRLEN *const lp +Apd |char* |sv_2pvbyte |NN SV *sv|NULLOK STRLEN *const lp +Ap |char* |sv_pvn_nomg |NN SV* sv|NULLOK STRLEN* lp +Amb |UV |sv_2uv |NN SV *sv +Apd |UV |sv_2uv_flags |NN SV *const sv|const I32 flags +Apd |IV |sv_iv |NN SV* sv +Apd |UV |sv_uv |NN SV* sv +Apd |NV |sv_nv |NN SV* sv +Apd |char* |sv_pvn |NN SV *sv|NN STRLEN *lp +Apd |char* |sv_pvutf8n |NN SV *sv|NN STRLEN *lp +Apd |char* |sv_pvbyten |NN SV *sv|NN STRLEN *lp +Apd |I32 |sv_true |NULLOK SV *const sv +#if defined(PERL_IN_SV_C) +sd |void |sv_add_arena |NN char *const ptr|const U32 size \ + |const U32 flags +#endif +Apdn |void |sv_backoff |NN SV *const sv +Apd |SV* |sv_bless |NN SV *const sv|NN HV *const stash +#if defined(PERL_DEBUG_READONLY_COW) +p |void |sv_buf_to_ro |NN SV *sv +# if defined(PERL_IN_SV_C) +s |void |sv_buf_to_rw |NN SV *sv +# endif +#endif +Afpd |void |sv_catpvf |NN SV *const sv|NN const char *const pat|... +Apd |void |sv_vcatpvf |NN SV *const sv|NN const char *const pat \ + |NULLOK va_list *const args +Apd |void |sv_catpv |NN SV *const sv|NULLOK const char* ptr +Amdb |void |sv_catpvn |NN SV *dsv|NN const char *sstr|STRLEN len +Amdb |void |sv_catsv |NN SV *dstr|NULLOK SV *sstr +Apd |void |sv_chop |NN SV *const sv|NULLOK const char *const ptr +: Used only in perl.c +pd |I32 |sv_clean_all +: Used only in perl.c +pd |void |sv_clean_objs +Apd |void |sv_clear |NN SV *const orig_sv +#if defined(PERL_IN_SV_C) +s |bool |curse |NN SV * const sv|const bool check_refcnt +#endif +Aopd |I32 |sv_cmp |NULLOK SV *const sv1|NULLOK SV *const sv2 +Apd |I32 |sv_cmp_flags |NULLOK SV *const sv1|NULLOK SV *const sv2 \ + |const U32 flags +Aopd |I32 |sv_cmp_locale |NULLOK SV *const sv1|NULLOK SV *const sv2 +Apd |I32 |sv_cmp_locale_flags |NULLOK SV *const sv1 \ + |NULLOK SV *const sv2|const U32 flags +#if defined(USE_LOCALE_COLLATE) +Amd |char* |sv_collxfrm |NN SV *const sv|NN STRLEN *const nxp +Apd |char* |sv_collxfrm_flags |NN SV *const sv|NN STRLEN *const nxp|I32 const flags +#endif +Apd |int |getcwd_sv |NN SV* sv +Apd |void |sv_dec |NULLOK SV *const sv +Apd |void |sv_dec_nomg |NULLOK SV *const sv +Ap |void |sv_dump |NN SV* sv +ApdR |bool |sv_derived_from|NN SV* sv|NN const char *const name +ApdR |bool |sv_derived_from_sv|NN SV* sv|NN SV *namesv|U32 flags +ApdR |bool |sv_derived_from_pv|NN SV* sv|NN const char *const name|U32 flags +ApdR |bool |sv_derived_from_pvn|NN SV* sv|NN const char *const name \ + |const STRLEN len|U32 flags +ApdR |bool |sv_does |NN SV* sv|NN const char *const name +ApdR |bool |sv_does_sv |NN SV* sv|NN SV* namesv|U32 flags +ApdR |bool |sv_does_pv |NN SV* sv|NN const char *const name|U32 flags +ApdR |bool |sv_does_pvn |NN SV* sv|NN const char *const name|const STRLEN len \ + |U32 flags +Amd |I32 |sv_eq |NULLOK SV* sv1|NULLOK SV* sv2 +Apd |I32 |sv_eq_flags |NULLOK SV* sv1|NULLOK SV* sv2|const U32 flags +Apd |void |sv_free |NULLOK SV *const sv +poMX |void |sv_free2 |NN SV *const sv|const U32 refcnt +: Used only in perl.c +pd |void |sv_free_arenas +Apd |char* |sv_gets |NN SV *const sv|NN PerlIO *const fp|I32 append +Apd |char* |sv_grow |NN SV *const sv|STRLEN newlen +Apd |void |sv_inc |NULLOK SV *const sv +Apd |void |sv_inc_nomg |NULLOK SV *const sv +Amdb |void |sv_insert |NN SV *const bigstr|const STRLEN offset \ + |const STRLEN len|NN const char *const little \ + |const STRLEN littlelen +Apd |void |sv_insert_flags|NN SV *const bigstr|const STRLEN offset|const STRLEN len \ + |NN const char *const little|const STRLEN littlelen|const U32 flags +Apd |int |sv_isa |NULLOK SV* sv|NN const char *const name +Apd |int |sv_isobject |NULLOK SV* sv +Apd |STRLEN |sv_len |NULLOK SV *const sv +Apd |STRLEN |sv_len_utf8 |NULLOK SV *const sv +p |STRLEN |sv_len_utf8_nomg|NN SV *const sv +Apd |void |sv_magic |NN SV *const sv|NULLOK SV *const obj|const int how \ + |NULLOK const char *const name|const I32 namlen +Apd |MAGIC *|sv_magicext |NN SV *const sv|NULLOK SV *const obj|const int how \ + |NULLOK const MGVTBL *const vtbl|NULLOK const char *const name \ + |const I32 namlen +#ifndef PERL_NO_INLINE_FUNCTIONS +Ein |bool |sv_only_taint_gmagic|NN SV *sv +#endif +: exported for re.pm +EXp |MAGIC *|sv_magicext_mglob|NN SV *sv +ApdbamR |SV* |sv_mortalcopy |NULLOK SV *const oldsv +XpaR |SV* |sv_mortalcopy_flags|NULLOK SV *const oldsv|U32 flags +ApdR |SV* |sv_newmortal +Apd |SV* |sv_newref |NULLOK SV *const sv +Ap |char* |sv_peek |NULLOK SV* sv +Apd |void |sv_pos_u2b |NULLOK SV *const sv|NN I32 *const offsetp|NULLOK I32 *const lenp +Apd |STRLEN |sv_pos_u2b_flags|NN SV *const sv|STRLEN uoffset \ + |NULLOK STRLEN *const lenp|U32 flags +Apd |void |sv_pos_b2u |NULLOK SV *const sv|NN I32 *const offsetp +Apd |STRLEN |sv_pos_b2u_flags|NN SV *const sv|STRLEN const offset \ + |U32 flags +Amdb |char* |sv_pvn_force |NN SV* sv|NULLOK STRLEN* lp +Apd |char* |sv_pvutf8n_force|NN SV *const sv|NULLOK STRLEN *const lp +Apd |char* |sv_pvbyten_force|NN SV *const sv|NULLOK STRLEN *const lp +Apd |char* |sv_recode_to_utf8 |NN SV* sv|NN SV *encoding +Apd |bool |sv_cat_decode |NN SV* dsv|NN SV *encoding|NN SV *ssv|NN int *offset \ + |NN char* tstr|int tlen +ApdR |const char* |sv_reftype |NN const SV *const sv|const int ob +Apd |SV* |sv_ref |NULLOK SV *dst|NN const SV *const sv|const int ob +Apd |void |sv_replace |NN SV *const sv|NN SV *const nsv +Apd |void |sv_report_used +Apd |void |sv_reset |NN const char* s|NULLOK HV *const stash +p |void |sv_resetpvn |NULLOK const char* s|STRLEN len \ + |NULLOK HV *const stash +Afpd |void |sv_setpvf |NN SV *const sv|NN const char *const pat|... +Apd |void |sv_vsetpvf |NN SV *const sv|NN const char *const pat|NULLOK va_list *const args +Apd |void |sv_setiv |NN SV *const sv|const IV num +Apdb |void |sv_setpviv |NN SV *const sv|const IV num +Apd |void |sv_setuv |NN SV *const sv|const UV num +Apd |void |sv_setnv |NN SV *const sv|const NV num +Apd |SV* |sv_setref_iv |NN SV *const rv|NULLOK const char *const classname|const IV iv +Apd |SV* |sv_setref_uv |NN SV *const rv|NULLOK const char *const classname|const UV uv +Apd |SV* |sv_setref_nv |NN SV *const rv|NULLOK const char *const classname|const NV nv +Apd |SV* |sv_setref_pv |NN SV *const rv|NULLOK const char *const classname \ + |NULLOK void *const pv +Apd |SV* |sv_setref_pvn |NN SV *const rv|NULLOK const char *const classname \ + |NN const char *const pv|const STRLEN n +Apd |void |sv_setpv |NN SV *const sv|NULLOK const char *const ptr +Apd |void |sv_setpvn |NN SV *const sv|NULLOK const char *const ptr|const STRLEN len +Xp |void |sv_sethek |NN SV *const sv|NULLOK const HEK *const hek +Amdb |void |sv_setsv |NN SV *dstr|NULLOK SV *sstr +Amdb |void |sv_taint |NN SV* sv +ApdR |bool |sv_tainted |NN SV *const sv +Apd |int |sv_unmagic |NN SV *const sv|const int type +Apd |int |sv_unmagicext |NN SV *const sv|const int type|NULLOK MGVTBL *vtbl +Apdmb |void |sv_unref |NN SV* sv +Apd |void |sv_unref_flags |NN SV *const ref|const U32 flags +Apd |void |sv_untaint |NN SV *const sv +Apd |void |sv_upgrade |NN SV *const sv|svtype new_type +Apdmb |void |sv_usepvn |NN SV* sv|NULLOK char* ptr|STRLEN len +Apd |void |sv_usepvn_flags|NN SV *const sv|NULLOK char* ptr|const STRLEN len\ + |const U32 flags +Apd |void |sv_vcatpvfn |NN SV *const sv|NN const char *const pat|const STRLEN patlen \ + |NULLOK va_list *const args|NULLOK SV **const svargs|const I32 svmax \ + |NULLOK bool *const maybe_tainted +Apd |void |sv_vcatpvfn_flags|NN SV *const sv|NN const char *const pat|const STRLEN patlen \ + |NULLOK va_list *const args|NULLOK SV **const svargs|const I32 svmax \ + |NULLOK bool *const maybe_tainted|const U32 flags +Apd |void |sv_vsetpvfn |NN SV *const sv|NN const char *const pat|const STRLEN patlen \ + |NULLOK va_list *const args|NULLOK SV **const svargs \ + |const I32 svmax|NULLOK bool *const maybe_tainted +ApR |NV |str_to_version |NN SV *sv +ApRM |SV* |swash_init |NN const char* pkg|NN const char* name|NN SV* listsv|I32 minbits|I32 none +ApM |UV |swash_fetch |NN SV *swash|NN const U8 *ptr|bool do_utf8 +#ifdef PERL_IN_REGCOMP_C +EiMR |SV* |add_cp_to_invlist |NULLOK SV* invlist|const UV cp +EsM |void |_append_range_to_invlist |NN SV* const invlist|const UV start|const UV end +EiMRn |UV* |_invlist_array_init |NN SV* const invlist|const bool will_have_0 +EsM |void |invlist_extend |NN SV* const invlist|const UV len +EiMRn |UV |invlist_max |NN SV* const invlist +EiM |void |invlist_set_len|NN SV* const invlist|const UV len|const bool offset +EiMRn |bool |invlist_is_iterating|NN SV* const invlist +#ifndef PERL_EXT_RE_BUILD +EsM |void |invlist_replace_list_destroys_src|NN SV *dest|NN SV *src +EiMRn |IV* |get_invlist_previous_index_addr|NN SV* invlist +EiMn |void |invlist_set_previous_index|NN SV* const invlist|const IV index +EiMRn |IV |invlist_previous_index|NN SV* const invlist +EiMn |void |invlist_trim |NN SV* invlist +EiM |void |invlist_clear |NN SV* invlist +#endif +EiMR |SV* |invlist_clone |NN SV* const invlist +EiMRn |STRLEN*|get_invlist_iter_addr |NN SV* invlist +EiMn |void |invlist_iterinit|NN SV* invlist +EsMRn |bool |invlist_iternext|NN SV* invlist|NN UV* start|NN UV* end +EiMn |void |invlist_iterfinish|NN SV* invlist +EiMRn |UV |invlist_highest|NN SV* const invlist +EMRs |SV* |_make_exactf_invlist |NN RExC_state_t *pRExC_state \ + |NN regnode *node +EsMR |SV* |invlist_contents|NN SV* const invlist \ + |const bool traditional_style +#endif +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_UTF8_C) +EXmM |void |_invlist_intersection |NN SV* const a|NN SV* const b|NN SV** i +EXpM |void |_invlist_intersection_maybe_complement_2nd \ + |NULLOK SV* const a|NN SV* const b \ + |const bool complement_b|NN SV** i +EXmM |void |_invlist_union |NULLOK SV* const a|NN SV* const b|NN SV** output +EXpM |void |_invlist_union_maybe_complement_2nd \ + |NULLOK SV* const a|NN SV* const b \ + |const bool complement_b|NN SV** output +EXmM |void |_invlist_subtract|NN SV* const a|NN SV* const b|NN SV** result +EXpM |void |_invlist_invert|NN SV* const invlist +EXMpR |SV* |_new_invlist |IV initial_size +EXMpR |SV* |_swash_to_invlist |NN SV* const swash +EXMpR |SV* |_add_range_to_invlist |NULLOK SV* invlist|const UV start|const UV end +EXMpR |SV* |_setup_canned_invlist|const STRLEN size|const UV element0|NN UV** other_elements_ptr +EXMpn |void |_invlist_populate_swatch |NN SV* const invlist|const UV start|const UV end|NN U8* swatch +#endif +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C) || defined(PERL_IN_TOKE_C) +EXp |SV* |_core_swash_init|NN const char* pkg|NN const char* name \ + |NN SV* listsv|I32 minbits|I32 none \ + |NULLOK SV* invlist|NULLOK U8* const flags_p +#endif +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C) +EiMRn |UV* |invlist_array |NN SV* const invlist +EiMRn |bool* |get_invlist_offset_addr|NN SV* invlist +EiMRn |UV |_invlist_len |NN SV* const invlist +EMiRn |bool |_invlist_contains_cp|NN SV* const invlist|const UV cp +EXpMRn |IV |_invlist_search |NN SV* const invlist|const UV cp +EXMpR |SV* |_get_swash_invlist|NN SV* const swash +EXMpR |HV* |_swash_inversion_hash |NN SV* const swash +#endif +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) +ApM |SV* |_get_regclass_nonbitmap_data \ + |NULLOK const regexp *prog \ + |NN const struct regnode *node \ + |bool doinit \ + |NULLOK SV **listsvp \ + |NULLOK SV **lonly_utf8_locale \ + |NULLOK SV **output_invlist +EXp |void|_load_PL_utf8_foldclosures| +#endif +#if defined(PERL_IN_REGCOMP_C) || defined (PERL_IN_DUMP_C) +EXMp |void |_invlist_dump |NN PerlIO *file|I32 level \ + |NN const char* const indent \ + |NN SV* const invlist +#endif +Ap |void |taint_env +Ap |void |taint_proper |NULLOK const char* f|NN const char *const s +ApdD |UV |to_utf8_case |NN const U8 *p \ + |NN U8* ustrp \ + |NULLOK STRLEN *lenp \ + |NN SV **swashp \ + |NN const char *normal| \ + NULLOK const char *special +#if defined(PERL_IN_UTF8_C) +s |UV |_to_utf8_case |const UV uv1 \ + |NN const U8 *p \ + |NN U8* ustrp \ + |NULLOK STRLEN *lenp \ + |NN SV **swashp \ + |NN const char *normal \ + |NULLOK const char *special +#endif +Abmd |UV |to_utf8_lower |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +AMp |UV |_to_utf8_lower_flags |NN const U8 *p|NN U8* ustrp \ + |NULLOK STRLEN *lenp|bool flags +Abmd |UV |to_utf8_upper |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +AMp |UV |_to_utf8_upper_flags |NN const U8 *p|NN U8* ustrp \ + |NULLOK STRLEN *lenp|bool flags +Abmd |UV |to_utf8_title |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +AMp |UV |_to_utf8_title_flags |NN const U8 *p|NN U8* ustrp \ + |NULLOK STRLEN *lenp|bool flags +Abmd |UV |to_utf8_fold |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +AMp |UV |_to_utf8_fold_flags|NN const U8 *p|NN U8* ustrp \ + |NULLOK STRLEN *lenp|U8 flags +#if defined(PERL_IN_MG_C) || defined(PERL_IN_PP_C) +pn |bool |translate_substr_offsets|STRLEN curlen|IV pos1_iv \ + |bool pos1_is_uv|IV len_iv \ + |bool len_is_uv|NN STRLEN *posp \ + |NN STRLEN *lenp +#endif +#if defined(UNLINK_ALL_VERSIONS) +Ap |I32 |unlnk |NN const char* f +#endif +Apd |I32 |unpack_str |NN const char *pat|NN const char *patend|NN const char *s \ + |NULLOK const char *strbeg|NN const char *strend|NULLOK char **new_s \ + |I32 ocnt|U32 flags +Apd |I32 |unpackstring |NN const char *pat|NN const char *patend|NN const char *s \ + |NN const char *strend|U32 flags +Ap |void |unsharepvn |NULLOK const char* sv|I32 len|U32 hash +: Used in gv.c, hv.c +p |void |unshare_hek |NULLOK HEK* hek +: Used in perly.y +p |void |utilize |int aver|I32 floor|NULLOK OP* version|NN OP* idop|NULLOK OP* arg +Ap |U8* |utf16_to_utf8 |NN U8* p|NN U8 *d|I32 bytelen|NN I32 *newlen +Ap |U8* |utf16_to_utf8_reversed|NN U8* p|NN U8 *d|I32 bytelen|NN I32 *newlen +AdpPR |STRLEN |utf8_length |NN const U8* s|NN const U8 *e +ApdPR |IV |utf8_distance |NN const U8 *a|NN const U8 *b +ApdPRn |U8* |utf8_hop |NN const U8 *s|SSize_t off +ApMd |U8* |utf8_to_bytes |NN U8 *s|NN STRLEN *len +Apd |int |bytes_cmp_utf8 |NN const U8 *b|STRLEN blen|NN const U8 *u \ + |STRLEN ulen +ApMd |U8* |bytes_from_utf8|NN const U8 *s|NN STRLEN *len|NULLOK bool *is_utf8 +ApMd |U8* |bytes_to_utf8 |NN const U8 *s|NN STRLEN *len +ApdD |UV |utf8_to_uvchr |NN const U8 *s|NULLOK STRLEN *retlen +ApdD |UV |utf8_to_uvuni |NN const U8 *s|NULLOK STRLEN *retlen +ApMD |UV |valid_utf8_to_uvuni |NN const U8 *s|NULLOK STRLEN *retlen +Amd |UV |utf8_to_uvchr_buf |NN const U8 *s|NN const U8 *send|NULLOK STRLEN *retlen +ApdD |UV |utf8_to_uvuni_buf |NN const U8 *s|NN const U8 *send|NULLOK STRLEN *retlen +pM |bool |check_utf8_print |NN const U8 *s|const STRLEN len + +Adp |UV |utf8n_to_uvchr |NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags +ApM |UV |valid_utf8_to_uvchr |NN const U8 *s|NULLOK STRLEN *retlen + +Ap |UV |utf8n_to_uvuni|NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags + +Adm |U8* |uvchr_to_utf8 |NN U8 *d|UV uv +Ap |U8* |uvuni_to_utf8 |NN U8 *d|UV uv +Adm |U8* |uvchr_to_utf8_flags |NN U8 *d|UV uv|UV flags +Apd |U8* |uvoffuni_to_utf8_flags |NN U8 *d|UV uv|UV flags +Ap |U8* |uvuni_to_utf8_flags |NN U8 *d|UV uv|UV flags +Apd |char* |pv_uni_display |NN SV *dsv|NN const U8 *spv|STRLEN len|STRLEN pvlim|UV flags +ApdR |char* |sv_uni_display |NN SV *dsv|NN SV *ssv|STRLEN pvlim|UV flags +: Used by Data::Alias +EXp |void |vivify_defelem |NN SV* sv +: Used in pp.c +pR |SV* |vivify_ref |NN SV* sv|U32 to_what +: Used in pp_sys.c +p |I32 |wait4pid |Pid_t pid|NN int* statusp|int flags +: Used in locale.c and perl.c +p |U32 |parse_unicode_opts|NN const char **popt +Ap |U32 |seed +Xpno |double |drand48_r |NN perl_drand48_t *random_state +Xpno |void |drand48_init_r |NN perl_drand48_t *random_state|U32 seed +: Only used in perl.c +p |void |get_hash_seed |NN unsigned char * const seed_buffer +: Used in doio.c, pp_hot.c, pp_sys.c +p |void |report_evil_fh |NULLOK const GV *gv +: Used in doio.c, pp_hot.c, pp_sys.c +p |void |report_wrongway_fh|NULLOK const GV *gv|const char have +: Used in mg.c, pp.c, pp_hot.c, regcomp.c +XEpd |void |report_uninit |NULLOK const SV *uninit_sv +#if defined(PERL_IN_OP_C) || defined(PERL_IN_SV_C) +p |void |report_redefined_cv|NN const SV *name \ + |NN const CV *old_cv \ + |NULLOK SV * const *new_const_svp +#endif +Apd |void |warn_sv |NN SV *baseex +Afpd |void |warn |NN const char* pat|... +Apd |void |vwarn |NN const char* pat|NULLOK va_list* args +Afp |void |warner |U32 err|NN const char* pat|... +Afp |void |ck_warner |U32 err|NN const char* pat|... +Afp |void |ck_warner_d |U32 err|NN const char* pat|... +Ap |void |vwarner |U32 err|NN const char* pat|NULLOK va_list* args +#ifdef USE_C_BACKTRACE +pd |Perl_c_backtrace*|get_c_backtrace|int max_depth|int skip +dm |void |free_c_backtrace|NN Perl_c_backtrace* bt +Apd |SV* |get_c_backtrace_dump|int max_depth|int skip +Apd |bool |dump_c_backtrace|NN PerlIO* fp|int max_depth|int skip +#endif +: FIXME +p |void |watch |NN char** addr +Am |I32 |whichsig |NN const char* sig +Ap |I32 |whichsig_sv |NN SV* sigsv +Ap |I32 |whichsig_pv |NN const char* sig +Ap |I32 |whichsig_pvn |NN const char* sig|STRLEN len +#ifndef PERL_NO_INLINE_FUNCTIONS +: used to check for NULs in pathnames and other names +AiR |bool |is_safe_syscall|NN const char *pv|STRLEN len|NN const char *what|NN const char *op_name +#endif +#ifdef PERL_CORE +inR |bool |should_warn_nl|NN const char *pv +#endif +: Used in pp_ctl.c +p |void |write_to_stderr|NN SV* msv +: Used in op.c +p |int |yyerror |NN const char *const s +p |int |yyerror_pv |NN const char *const s|U32 flags +p |int |yyerror_pvn |NN const char *const s|STRLEN len|U32 flags +: Used in perly.y, and by Data::Alias +EXp |int |yylex +p |void |yyunlex +: Used in perl.c, pp_ctl.c +p |int |yyparse |int gramtype +: Only used in scope.c +p |void |parser_free |NN const yy_parser *parser +#ifdef PERL_CORE +p |void |parser_free_nexttoke_ops|NN yy_parser *parser \ + |NN OPSLAB *slab +#endif +#if defined(PERL_IN_TOKE_C) +s |int |yywarn |NN const char *const s|U32 flags +#endif +#if defined(MYMALLOC) +Ap |void |dump_mstats |NN const char* s +Ap |int |get_mstats |NN perl_mstats_t *buf|int buflen|int level +#endif +Anpa |Malloc_t|safesysmalloc |MEM_SIZE nbytes +Anpa |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size +Anpa |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes +Anp |Free_t |safesysfree |Malloc_t where +Asrnx |void |croak_memory_wrap +#if defined(PERL_GLOBAL_STRUCT) +Ap |struct perl_vars *|GetVars +Ap |struct perl_vars*|init_global_struct +Ap |void |free_global_struct|NN struct perl_vars *plvarsp +#endif +Ap |int |runops_standard +Ap |int |runops_debug +Afpd |void |sv_catpvf_mg |NN SV *const sv|NN const char *const pat|... +Apd |void |sv_vcatpvf_mg |NN SV *const sv|NN const char *const pat \ + |NULLOK va_list *const args +Apd |void |sv_catpv_mg |NN SV *const sv|NULLOK const char *const ptr +Apdbm |void |sv_catpvn_mg |NN SV *sv|NN const char *ptr|STRLEN len +Apdbm |void |sv_catsv_mg |NN SV *dsv|NULLOK SV *ssv +Afpd |void |sv_setpvf_mg |NN SV *const sv|NN const char *const pat|... +Apd |void |sv_vsetpvf_mg |NN SV *const sv|NN const char *const pat \ + |NULLOK va_list *const args +Apd |void |sv_setiv_mg |NN SV *const sv|const IV i +Apdb |void |sv_setpviv_mg |NN SV *const sv|const IV iv +Apd |void |sv_setuv_mg |NN SV *const sv|const UV u +Apd |void |sv_setnv_mg |NN SV *const sv|const NV num +Apd |void |sv_setpv_mg |NN SV *const sv|NULLOK const char *const ptr +Apd |void |sv_setpvn_mg |NN SV *const sv|NN const char *const ptr|const STRLEN len +Apd |void |sv_setsv_mg |NN SV *const dstr|NULLOK SV *const sstr +Apdbm |void |sv_usepvn_mg |NN SV *sv|NULLOK char *ptr|STRLEN len +ApR |MGVTBL*|get_vtbl |int vtbl_id +Apd |char* |pv_display |NN SV *dsv|NN const char *pv|STRLEN cur|STRLEN len \ + |STRLEN pvlim +Apd |char* |pv_escape |NULLOK SV *dsv|NN char const * const str\ + |const STRLEN count|const STRLEN max\ + |NULLOK STRLEN * const escaped\ + |const U32 flags +Apd |char* |pv_pretty |NN SV *dsv|NN char const * const str\ + |const STRLEN count|const STRLEN max\ + |NULLOK char const * const start_color\ + |NULLOK char const * const end_color\ + |const U32 flags +Afp |void |dump_indent |I32 level|NN PerlIO *file|NN const char* pat|... +Ap |void |dump_vindent |I32 level|NN PerlIO *file|NN const char* pat \ + |NULLOK va_list *args +Ap |void |do_gv_dump |I32 level|NN PerlIO *file|NN const char *name\ + |NULLOK GV *sv +Ap |void |do_gvgv_dump |I32 level|NN PerlIO *file|NN const char *name\ + |NULLOK GV *sv +Ap |void |do_hv_dump |I32 level|NN PerlIO *file|NN const char *name\ + |NULLOK HV *sv +Ap |void |do_magic_dump |I32 level|NN PerlIO *file|NULLOK const MAGIC *mg|I32 nest \ + |I32 maxnest|bool dumpops|STRLEN pvlim +Ap |void |do_op_dump |I32 level|NN PerlIO *file|NULLOK const OP *o +Ap |void |do_pmop_dump |I32 level|NN PerlIO *file|NULLOK const PMOP *pm +Ap |void |do_sv_dump |I32 level|NN PerlIO *file|NULLOK SV *sv|I32 nest \ + |I32 maxnest|bool dumpops|STRLEN pvlim +Ap |void |magic_dump |NULLOK const MAGIC *mg +Ap |void |reginitcolors +ApdRmb |char* |sv_2pv_nolen |NN SV* sv +ApdRmb |char* |sv_2pvutf8_nolen|NN SV* sv +ApdRmb |char* |sv_2pvbyte_nolen|NN SV* sv +AmdbR |char* |sv_pv |NN SV *sv +AmdbR |char* |sv_pvutf8 |NN SV *sv +AmdbR |char* |sv_pvbyte |NN SV *sv +Amdb |STRLEN |sv_utf8_upgrade|NN SV *sv +Amd |STRLEN |sv_utf8_upgrade_nomg|NN SV *sv +ApdM |bool |sv_utf8_downgrade|NN SV *const sv|const bool fail_ok +Apd |void |sv_utf8_encode |NN SV *const sv +ApdM |bool |sv_utf8_decode |NN SV *const sv +Apdmb |void |sv_force_normal|NN SV *sv +Apd |void |sv_force_normal_flags|NN SV *const sv|const U32 flags +pX |SSize_t|tmps_grow_p |SSize_t ix +Apd |SV* |sv_rvweaken |NN SV *const sv +AnpPMd |SV* |sv_get_backrefs|NN SV *const sv +: This is indirectly referenced by globals.c. This is somewhat annoying. +p |int |magic_killbackrefs|NN SV *sv|NN MAGIC *mg +Ap |OP* |newANONATTRSUB |I32 floor|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block +Am |CV* |newATTRSUB |I32 floor|NULLOK OP *o|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block +pX |CV* |newATTRSUB_x |I32 floor|NULLOK OP *o|NULLOK OP *proto \ + |NULLOK OP *attrs|NULLOK OP *block \ + |bool o_is_gv +Ap |CV * |newMYSUB |I32 floor|NN OP *o|NULLOK OP *proto \ + |NULLOK OP *attrs|NULLOK OP *block +p |CV* |newSTUB |NN GV *gv|bool fake +: Used in perly.y +p |OP * |my_attrs |NN OP *o|NULLOK OP *attrs +#if defined(USE_ITHREADS) +ApR |PERL_CONTEXT*|cx_dup |NULLOK PERL_CONTEXT* cx|I32 ix|I32 max|NN CLONE_PARAMS* param +ApR |PERL_SI*|si_dup |NULLOK PERL_SI* si|NN CLONE_PARAMS* param +Apa |ANY* |ss_dup |NN PerlInterpreter* proto_perl|NN CLONE_PARAMS* param +ApR |void* |any_dup |NULLOK void* v|NN const PerlInterpreter* proto_perl +ApR |HE* |he_dup |NULLOK const HE* e|bool shared|NN CLONE_PARAMS* param +ApR |HEK* |hek_dup |NULLOK HEK* e|NN CLONE_PARAMS* param +Ap |void |re_dup_guts |NN const REGEXP *sstr|NN REGEXP *dstr \ + |NN CLONE_PARAMS* param +Ap |PerlIO*|fp_dup |NULLOK PerlIO *const fp|const char type|NN CLONE_PARAMS *const param +ApR |DIR* |dirp_dup |NULLOK DIR *const dp|NN CLONE_PARAMS *const param +ApR |GP* |gp_dup |NULLOK GP *const gp|NN CLONE_PARAMS *const param +ApR |MAGIC* |mg_dup |NULLOK MAGIC *mg|NN CLONE_PARAMS *const param +#if defined(PERL_IN_SV_C) +s |SV ** |sv_dup_inc_multiple|NN SV *const *source|NN SV **dest \ + |SSize_t items|NN CLONE_PARAMS *const param +sR |SV* |sv_dup_common |NN const SV *const sstr \ + |NN CLONE_PARAMS *const param +#endif +ApR |SV* |sv_dup |NULLOK const SV *const sstr|NN CLONE_PARAMS *const param +ApR |SV* |sv_dup_inc |NULLOK const SV *const sstr \ + |NN CLONE_PARAMS *const param +Ap |void |rvpv_dup |NN SV *const dstr|NN const SV *const sstr|NN CLONE_PARAMS *const param +Ap |yy_parser*|parser_dup |NULLOK const yy_parser *const proto|NN CLONE_PARAMS *const param +#endif +Apa |PTR_TBL_t*|ptr_table_new +ApR |void* |ptr_table_fetch|NN PTR_TBL_t *const tbl|NULLOK const void *const sv +Ap |void |ptr_table_store|NN PTR_TBL_t *const tbl|NULLOK const void *const oldsv \ + |NN void *const newsv +Ap |void |ptr_table_split|NN PTR_TBL_t *const tbl +ApD |void |ptr_table_clear|NULLOK PTR_TBL_t *const tbl +Ap |void |ptr_table_free|NULLOK PTR_TBL_t *const tbl +#if defined(HAVE_INTERP_INTERN) +Ap |void |sys_intern_clear +Ap |void |sys_intern_init +# if defined(USE_ITHREADS) +Ap |void |sys_intern_dup |NN struct interp_intern* src|NN struct interp_intern* dst +# endif +#endif + +AmopP |const XOP * |custom_op_xop |NN const OP *o +ApR |const char * |custom_op_name |NN const OP *o +ApR |const char * |custom_op_desc |NN const OP *o +pRX |XOPRETANY |custom_op_get_field |NN const OP *o|const xop_flags_enum field +Aop |void |custom_op_register |NN Perl_ppaddr_t ppaddr \ + |NN const XOP *xop + +Adp |void |sv_nosharing |NULLOK SV *sv +Adpbm |void |sv_nolocking |NULLOK SV *sv +Adp |bool |sv_destroyable |NULLOK SV *sv +#ifdef NO_MATHOMS +Adpbm |void |sv_nounlocking |NULLOK SV *sv +#else +Adpb |void |sv_nounlocking |NULLOK SV *sv +#endif +Adp |int |nothreadhook +p |void |init_constants + +#if defined(PERL_IN_DOOP_C) +sR |I32 |do_trans_simple |NN SV * const sv +sR |I32 |do_trans_count |NN SV * const sv +sR |I32 |do_trans_complex |NN SV * const sv +sR |I32 |do_trans_simple_utf8 |NN SV * const sv +sR |I32 |do_trans_count_utf8 |NN SV * const sv +sR |I32 |do_trans_complex_utf8 |NN SV * const sv +#endif + +#if defined(PERL_IN_GV_C) +s |void |gv_init_svtype |NN GV *gv|const svtype sv_type +s |void |gv_magicalize_isa |NN GV *gv +s |bool|parse_gv_stash_name|NN HV **stash|NN GV **gv \ + |NN const char **name|NN STRLEN *len \ + |NN const char *nambeg|STRLEN full_len \ + |const U32 is_utf8|const I32 add +s |bool|find_default_stash|NN HV **stash|NN const char *name \ + |STRLEN len|const U32 is_utf8|const I32 add \ + |const svtype sv_type +s |bool|gv_magicalize|NN GV *gv|NN HV *stash|NN const char *name \ + |STRLEN len|bool addmg \ + |const svtype sv_type +s |void|maybe_multimagic_gv|NN GV *gv|NN const char *name|const svtype sv_type +s |bool|gv_is_in_main|NN const char *name|STRLEN len \ + |const U32 is_utf8 +s |HV* |require_tie_mod|NN GV *gv|NN const char *varpv|NN SV* namesv \ + |NN const char *methpv|const U32 flags +#endif + +#if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) +po |SV* |hfree_next_entry |NN HV *hv|NN STRLEN *indexp +#endif + +#if defined(PERL_IN_HV_C) +s |void |hsplit |NN HV *hv|STRLEN const oldsize|STRLEN newsize +s |void |hv_free_entries |NN HV *hv +s |SV* |hv_free_ent_ret|NN HV *hv|NN HE *entry +sa |HE* |new_he +sanR |HEK* |save_hek_flags |NN const char *str|I32 len|U32 hash|int flags +sn |void |hv_magic_check |NN HV *hv|NN bool *needs_copy|NN bool *needs_store +s |void |unshare_hek_or_pvn|NULLOK const HEK* hek|NULLOK const char* str|I32 len|U32 hash +sR |HEK* |share_hek_flags|NN const char *str|I32 len|U32 hash|int flags +rs |void |hv_notallowed |int flags|NN const char *key|I32 klen|NN const char *msg +in |U32|ptr_hash|PTRV u +s |struct xpvhv_aux*|hv_auxinit|NN HV *hv +sn |struct xpvhv_aux*|hv_auxinit_internal|NN struct xpvhv_aux *iter +sM |SV* |hv_delete_common|NULLOK HV *hv|NULLOK SV *keysv \ + |NULLOK const char *key|STRLEN klen|int k_flags|I32 d_flags \ + |U32 hash +sM |void |clear_placeholders |NN HV *hv|U32 items +#endif + +#if defined(PERL_IN_MG_C) +s |void |save_magic_flags|I32 mgs_ix|NN SV *sv|U32 flags +-s |int |magic_methpack |NN SV *sv|NN const MAGIC *mg|NN SV *meth +s |SV* |magic_methcall1|NN SV *sv|NN const MAGIC *mg \ + |NN SV *meth|U32 flags \ + |int n|NULLOK SV *val +s |void |restore_magic |NULLOK const void *p +s |void |unwind_handler_stack|NULLOK const void *p +s |void |fixup_errno_string|NN SV* sv + +#endif + +#if defined(PERL_IN_OP_C) +sRn |bool |is_handle_constructor|NN const OP *o|I32 numargs +sR |I32 |assignment_type|NULLOK const OP *o +s |void |forget_pmop |NN PMOP *const o +s |void |find_and_forget_pmops |NN OP *o +s |void |cop_free |NN COP *cop +s |OP* |modkids |NULLOK OP *o|I32 type +s |OP* |scalarboolean |NN OP *o +sR |OP* |search_const |NN OP *o +sR |OP* |new_logop |I32 type|I32 flags|NN OP **firstp|NN OP **otherp +s |void |simplify_sort |NN OP *o +sRn |bool |scalar_mod_type|NULLOK const OP *o|I32 type +s |OP * |my_kid |NULLOK OP *o|NULLOK OP *attrs|NN OP **imopsp +s |OP * |dup_attrlist |NN OP *o +s |void |apply_attrs |NN HV *stash|NN SV *target|NULLOK OP *attrs +s |void |apply_attrs_my |NN HV *stash|NN OP *target|NULLOK OP *attrs|NN OP **imopsp +s |void |bad_type_pv |I32 n|NN const char *t|NN const OP *o|NN const OP *kid +s |void |bad_type_gv |I32 n|NN GV *gv|NN const OP *kid|NN const char *t +s |void |no_bareword_allowed|NN OP *o +sR |OP* |no_fh_allowed|NN OP *o +sR |OP* |too_few_arguments_pv|NN OP *o|NN const char* name|U32 flags +s |OP* |too_many_arguments_pv|NN OP *o|NN const char* name|U32 flags +s |bool |looks_like_bool|NN const OP* o +s |OP* |newGIVWHENOP |NULLOK OP* cond|NN OP *block \ + |I32 enter_opcode|I32 leave_opcode \ + |PADOFFSET entertarg +s |OP* |ref_array_or_hash|NULLOK OP* cond +s |bool |process_special_blocks |I32 floor \ + |NN const char *const fullname\ + |NN GV *const gv|NN CV *const cv +s |void |clear_special_blocks |NN const char *const fullname\ + |NN GV *const gv|NN CV *const cv +#endif +Xpa |void* |Slab_Alloc |size_t sz +Xp |void |Slab_Free |NN void *op +#if defined(PERL_DEBUG_READONLY_OPS) +# if defined(PERL_CORE) +px |void |Slab_to_ro |NN OPSLAB *slab +px |void |Slab_to_rw |NN OPSLAB *const slab +# endif +: Used in OpREFCNT_inc() in sv.c +poxM |OP * |op_refcnt_inc |NULLOK OP *o +: FIXME - can be static. +poxM |PADOFFSET |op_refcnt_dec |NN OP *o +#endif + +#if defined(PERL_IN_PERL_C) +s |void |find_beginning |NN SV* linestr_sv|NN PerlIO *rsfp +s |void |forbid_setid |const char flag|const bool suidscript +s |void |incpush |NN const char *const dir|STRLEN len \ + |U32 flags +s |SV* |mayberelocate |NN const char *const dir|STRLEN len \ + |U32 flags +s |void |incpush_use_sep|NN const char *p|STRLEN len|U32 flags +s |void |init_interp +s |void |init_ids +s |void |init_main_stash +s |void |init_perllib +s |void |init_postdump_symbols|int argc|NN char **argv|NULLOK char **env +s |void |init_predump_symbols +rs |void |my_exit_jump +s |void |nuke_stacks +s |PerlIO *|open_script |NN const char *scriptname|bool dosearch \ + |NN bool *suidscript +sr |void |usage +#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW +so |void |validate_suid |NN PerlIO *rsfp +#endif +sr |void |minus_v + +s |void* |parse_body |NULLOK char **env|XSINIT_t xsinit +rs |void |run_body |I32 oldscope +# ifndef PERL_IS_MINIPERL +s |SV * |incpush_if_exists|NN AV *const av|NN SV *dir|NN SV *const stem +# endif +#endif + +#if defined(PERL_IN_PP_C) +s |size_t |do_chomp |NN SV *retval|NN SV *sv|bool chomping +s |OP* |do_delete_local +sR |SV* |refto |NN SV* sv +#endif +#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) +: Used in pp_hot.c +pRxo |GV* |softref2xv |NN SV *const sv|NN const char *const what \ + |const svtype type|NN SV ***spp +#endif + +#if defined(PERL_IN_PP_PACK_C) +s |I32 |unpack_rec |NN struct tempsym* symptr|NN const char *s \ + |NN const char *strbeg|NN const char *strend|NULLOK const char **new_s +s |SV ** |pack_rec |NN SV *cat|NN struct tempsym* symptr|NN SV **beglist|NN SV **endlist +s |SV* |mul128 |NN SV *sv|U8 m +s |I32 |measure_struct |NN struct tempsym* symptr +s |bool |next_symbol |NN struct tempsym* symptr +sR |SV* |is_an_int |NN const char *s|STRLEN l +s |int |div128 |NN SV *pnum|NN bool *done +s |const char *|group_end |NN const char *patptr|NN const char *patend \ + |char ender +sR |const char *|get_num |NN const char *patptr|NN I32 *lenptr +ns |bool |need_utf8 |NN const char *pat|NN const char *patend +ns |char |first_symbol |NN const char *pat|NN const char *patend +sR |char * |sv_exp_grow |NN SV *sv|STRLEN needed +snR |char * |my_bytes_to_utf8|NN const U8 *start|STRLEN len|NN char *dest \ + |const bool needs_swap +#endif + +#if defined(PERL_IN_PP_CTL_C) +sR |OP* |docatch |NULLOK OP *o +sR |OP* |dofindlabel |NN OP *o|NN const char *label|STRLEN len \ + |U32 flags|NN OP **opstack|NN OP **oplimit +s |MAGIC *|doparseform |NN SV *sv +snR |bool |num_overflow |NV value|I32 fldsize|I32 frcsize +sR |I32 |dopoptoeval |I32 startingblock +sR |I32 |dopoptogivenfor|I32 startingblock +sR |I32 |dopoptolabel |NN const char *label|STRLEN len|U32 flags +sR |I32 |dopoptoloop |I32 startingblock +sR |I32 |dopoptosub_at |NN const PERL_CONTEXT* cxstk|I32 startingblock +sR |I32 |dopoptowhen |I32 startingblock +s |void |save_lines |NULLOK AV *array|NN SV *sv +s |bool |doeval_compile |U8 gimme \ + |NULLOK CV* outside|U32 seq|NULLOK HV* hh +sR |PerlIO *|check_type_and_open|NN SV *name +#ifndef PERL_DISABLE_PMC +sR |PerlIO *|doopen_pm |NN SV *name +#endif +iRn |bool |path_is_searchable|NN const char *name +sR |I32 |run_user_filter|int idx|NN SV *buf_sv|int maxlen +sR |PMOP* |make_matcher |NN REGEXP* re +sR |bool |matcher_matches_sv|NN PMOP* matcher|NN SV* sv +s |void |destroy_matcher|NN PMOP* matcher +s |OP* |do_smartmatch |NULLOK HV* seen_this \ + |NULLOK HV* seen_other|const bool copied +#endif + +#if defined(PERL_IN_PP_HOT_C) +s |void |do_oddball |NN SV **oddkey|NN SV **firstkey +i |HV* |opmethod_stash |NN SV* meth +#endif + +#if defined(PERL_IN_PP_SORT_C) +s |I32 |sv_ncmp |NN SV *const a|NN SV *const b +s |I32 |sv_i_ncmp |NN SV *const a|NN SV *const b +s |I32 |amagic_ncmp |NN SV *const a|NN SV *const b +s |I32 |amagic_i_ncmp |NN SV *const a|NN SV *const b +s |I32 |amagic_cmp |NN SV *const str1|NN SV *const str2 +# ifdef USE_LOCALE_COLLATE +s |I32 |amagic_cmp_locale|NN SV *const str1|NN SV *const str2 +# endif +s |I32 |sortcv |NN SV *const a|NN SV *const b +s |I32 |sortcv_xsub |NN SV *const a|NN SV *const b +s |I32 |sortcv_stacked |NN SV *const a|NN SV *const b +s |void |qsortsvu |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t compare +#endif + +#if defined(PERL_IN_PP_SYS_C) +s |OP* |doform |NN CV *cv|NN GV *gv|NULLOK OP *retop +# if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) +sR |int |dooneliner |NN const char *cmd|NN const char *filename +# endif +s |SV * |space_join_names_mortal|NN char *const *array +#endif +p |OP * |tied_method|NN SV *methname|NN SV **sp \ + |NN SV *const sv|NN const MAGIC *const mg \ + |const U32 flags|U32 argc|... + +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) +Ep |void |regprop |NULLOK const regexp *prog|NN SV* sv|NN const regnode* o|NULLOK const regmatch_info *reginfo \ + |NULLOK const RExC_state_t *pRExC_state +Ep |int |re_printf |NN const char *fmt|... +#endif +#if defined(PERL_IN_REGCOMP_C) +Es |regnode*|reg |NN RExC_state_t *pRExC_state \ + |I32 paren|NN I32 *flagp|U32 depth +Es |regnode*|regnode_guts |NN RExC_state_t *pRExC_state \ + |const U8 op \ + |const STRLEN extra_len \ + |NN const char* const name +Es |regnode*|reganode |NN RExC_state_t *pRExC_state|U8 op \ + |U32 arg +Es |regnode*|reg2Lanode |NN RExC_state_t *pRExC_state \ + |const U8 op \ + |const U32 arg1 \ + |const I32 arg2 +Es |regnode*|regatom |NN RExC_state_t *pRExC_state \ + |NN I32 *flagp|U32 depth +Es |regnode*|regbranch |NN RExC_state_t *pRExC_state \ + |NN I32 *flagp|I32 first|U32 depth +Es |void |set_ANYOF_arg |NN RExC_state_t* const pRExC_state \ + |NN regnode* const node \ + |NULLOK SV* const cp_list \ + |NULLOK SV* const runtime_defns \ + |NULLOK SV* const only_utf8_locale_list \ + |NULLOK SV* const swash \ + |const bool has_user_defined_property +Es |void |output_or_return_posix_warnings \ + |NN RExC_state_t *pRExC_state \ + |NN AV* posix_warnings \ + |NULLOK AV** return_posix_warnings +Es |AV* |add_multi_match|NULLOK AV* multi_char_matches \ + |NN SV* multi_string \ + |const STRLEN cp_count +Es |regnode*|regclass |NN RExC_state_t *pRExC_state \ + |NN I32 *flagp|U32 depth|const bool stop_at_1 \ + |bool allow_multi_fold \ + |const bool silence_non_portable \ + |const bool strict \ + |bool optimizable \ + |NULLOK SV** ret_invlist \ + |NULLOK AV** return_posix_warnings +Es |void|add_above_Latin1_folds|NN RExC_state_t *pRExC_state|const U8 cp \ + |NN SV** invlist +Ei |regnode*|handle_named_backref|NN RExC_state_t *pRExC_state \ + |NN I32 *flagp \ + |NN char * parse_start \ + |char ch +EsnP |unsigned int|regex_set_precedence|const U8 my_operator +Es |regnode*|handle_regex_sets|NN RExC_state_t *pRExC_state \ + |NULLOK SV ** return_invlist \ + |NN I32 *flagp|U32 depth \ + |NN char * const oregcomp_parse +Es |void|parse_lparen_question_flags|NN RExC_state_t *pRExC_state +Es |regnode*|reg_node |NN RExC_state_t *pRExC_state|U8 op +Es |UV |reg_recode |const U8 value|NN SV **encp +Es |regnode*|regpiece |NN RExC_state_t *pRExC_state \ + |NN I32 *flagp|U32 depth +Es |bool |grok_bslash_N |NN RExC_state_t *pRExC_state \ + |NULLOK regnode** nodep \ + |NULLOK UV *code_point_p \ + |NULLOK int* cp_count \ + |NN I32 *flagp \ + |const bool strict \ + |const U32 depth +Es |void |reginsert |NN RExC_state_t *pRExC_state \ + |U8 op|NN regnode *opnd|U32 depth +Es |void |regtail |NN RExC_state_t * pRExC_state \ + |NN const regnode * const p \ + |NN const regnode * const val \ + |const U32 depth +Es |SV * |reg_scan_name |NN RExC_state_t *pRExC_state \ + |U32 flags +Es |U32 |join_exact |NN RExC_state_t *pRExC_state \ + |NN regnode *scan|NN UV *min_subtract \ + |NN bool *unfolded_multi_char \ + |U32 flags|NULLOK regnode *val|U32 depth +Ei |void |alloc_maybe_populate_EXACT|NN RExC_state_t *pRExC_state \ + |NN regnode *node|NN I32 *flagp|STRLEN len \ + |UV code_point|bool downgradable +Ein |U8 |compute_EXACTish|NN RExC_state_t *pRExC_state +Es |void |nextchar |NN RExC_state_t *pRExC_state +Es |void |skip_to_be_ignored_text|NN RExC_state_t *pRExC_state \ + |NN char ** p \ + |const bool force_to_xmod +Ein |char * |reg_skipcomment|NN RExC_state_t *pRExC_state|NN char * p +Es |void |scan_commit |NN const RExC_state_t *pRExC_state \ + |NN struct scan_data_t *data \ + |NN SSize_t *minlenp \ + |int is_inf +Es |void |populate_ANYOF_from_invlist|NN regnode *node|NN SV** invlist_ptr +Es |void |ssc_anything |NN regnode_ssc *ssc +EsRn |int |ssc_is_anything|NN const regnode_ssc *ssc +Es |void |ssc_init |NN const RExC_state_t *pRExC_state \ + |NN regnode_ssc *ssc +EsRn |int |ssc_is_cp_posixl_init|NN const RExC_state_t *pRExC_state \ + |NN const regnode_ssc *ssc +Es |void |ssc_and |NN const RExC_state_t *pRExC_state \ + |NN regnode_ssc *ssc \ + |NN const regnode_charclass *and_with +Es |void |ssc_or |NN const RExC_state_t *pRExC_state \ + |NN regnode_ssc *ssc \ + |NN const regnode_charclass *or_with +Es |SV* |get_ANYOF_cp_list_for_ssc \ + |NN const RExC_state_t *pRExC_state \ + |NN const regnode_charclass* const node +Ei |void |ssc_intersection|NN regnode_ssc *ssc \ + |NN SV* const invlist|const bool invert_2nd +Ei |void |ssc_union |NN regnode_ssc *ssc \ + |NN SV* const invlist|const bool invert_2nd +Ei |void |ssc_add_range |NN regnode_ssc *ssc \ + |UV const start|UV const end +Ei |void |ssc_cp_and |NN regnode_ssc *ssc \ + |UV const cp +Ein |void |ssc_clear_locale|NN regnode_ssc *ssc +Ens |bool |is_ssc_worth_it|NN const RExC_state_t * pRExC_state \ + |NN const regnode_ssc * ssc +Es |void |ssc_finalize |NN RExC_state_t *pRExC_state \ + |NN regnode_ssc *ssc +Es |SSize_t|study_chunk |NN RExC_state_t *pRExC_state \ + |NN regnode **scanp|NN SSize_t *minlenp \ + |NN SSize_t *deltap|NN regnode *last \ + |NULLOK struct scan_data_t *data \ + |I32 stopparen|U32 recursed_depth \ + |NULLOK regnode_ssc *and_withp \ + |U32 flags|U32 depth +EsRn |U32 |add_data |NN RExC_state_t* const pRExC_state \ + |NN const char* const s|const U32 n +rs |void |re_croak2 |bool utf8|NN const char* pat1|NN const char* pat2|... +Es |int |handle_possible_posix \ + |NN RExC_state_t *pRExC_state \ + |NN const char* const s \ + |NULLOK char ** updated_parse_ptr \ + |NULLOK AV** posix_warnings \ + |const bool check_only +Es |I32 |make_trie |NN RExC_state_t *pRExC_state \ + |NN regnode *startbranch|NN regnode *first \ + |NN regnode *last|NN regnode *tail \ + |U32 word_count|U32 flags|U32 depth +Es |regnode *|construct_ahocorasick_from_trie|NN RExC_state_t *pRExC_state \ + |NN regnode *source|U32 depth +EnPs |const char *|cntrl_to_mnemonic|const U8 c +EnPs |int |edit_distance |NN const UV *src \ + |NN const UV *tgt \ + |const STRLEN x \ + |const STRLEN y \ + |const SSize_t maxDistance +# ifdef DEBUGGING +Ep |int |re_indentf |NN const char *fmt|U32 depth|... +Es |void |regdump_intflags|NULLOK const char *lead| const U32 flags +Es |void |regdump_extflags|NULLOK const char *lead| const U32 flags +Es |const regnode*|dumpuntil|NN const regexp *r|NN const regnode *start \ + |NN const regnode *node \ + |NULLOK const regnode *last \ + |NULLOK const regnode *plast \ + |NN SV* sv|I32 indent|U32 depth +Es |void |put_code_point |NN SV* sv|UV c +Es |bool |put_charclass_bitmap_innards|NN SV* sv \ + |NN char* bitmap \ + |NULLOK SV* nonbitmap_invlist \ + |NULLOK SV* only_utf8_locale_invlist\ + |NULLOK const regnode * const node +Es |SV* |put_charclass_bitmap_innards_common \ + |NN SV* invlist \ + |NULLOK SV* posixes \ + |NULLOK SV* only_utf8 \ + |NULLOK SV* not_utf8 \ + |NULLOK SV* only_utf8_locale \ + |const bool invert +Es |void |put_charclass_bitmap_innards_invlist \ + |NN SV *sv \ + |NN SV* invlist +Es |void |put_range |NN SV* sv|UV start|const UV end \ + |const bool allow_literals +Es |void |dump_trie |NN const struct _reg_trie_data *trie\ + |NULLOK HV* widecharmap|NN AV *revcharmap\ + |U32 depth +Es |void |dump_trie_interim_list|NN const struct _reg_trie_data *trie\ + |NULLOK HV* widecharmap|NN AV *revcharmap\ + |U32 next_alloc|U32 depth +Es |void |dump_trie_interim_table|NN const struct _reg_trie_data *trie\ + |NULLOK HV* widecharmap|NN AV *revcharmap\ + |U32 next_alloc|U32 depth +Es |U8 |regtail_study |NN RExC_state_t *pRExC_state \ + |NN regnode *p|NN const regnode *val|U32 depth +# endif +#endif + +#if defined(PERL_IN_REGEXEC_C) +ERs |bool |isFOO_lc |const U8 classnum|const U8 character +ERs |bool |isFOO_utf8_lc |const U8 classnum|NN const U8* character +ERs |SSize_t|regmatch |NN regmatch_info *reginfo|NN char *startpos|NN regnode *prog +ERs |I32 |regrepeat |NN regexp *prog|NN char **startposp \ + |NN const regnode *p \ + |NN regmatch_info *const reginfo \ + |I32 max \ + |int depth +ERs |bool |regtry |NN regmatch_info *reginfo|NN char **startposp +ERs |bool |reginclass |NULLOK regexp * const prog \ + |NN const regnode * const n \ + |NN const U8 * const p \ + |NN const U8 * const p_end \ + |bool const utf8_target +Es |CHECKPOINT|regcppush |NN const regexp *rex|I32 parenfloor\ + |U32 maxopenparen +Es |void |regcppop |NN regexp *rex\ + |NN U32 *maxopenparen_p +ERsn |U8* |reghop3 |NN U8 *s|SSize_t off|NN const U8 *lim +ERsn |U8* |reghop4 |NN U8 *s|SSize_t off|NN const U8 *llim \ + |NN const U8 *rlim +ERsn |U8* |reghopmaybe3 |NN U8 *s|SSize_t off|NN const U8 *lim +ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c \ + |NN char *s|NN const char *strend \ + |NULLOK regmatch_info *reginfo +Es |void |to_utf8_substr |NN regexp * prog +Es |bool |to_byte_substr |NN regexp * prog +ERsn |I32 |reg_check_named_buff_matched |NN const regexp *rex \ + |NN const regnode *scan +EinR |bool |isGCB |const GCB_enum before|const GCB_enum after +EsR |bool |isLB |LB_enum before \ + |LB_enum after \ + |NN const U8 * const strbeg \ + |NN const U8 * const curpos \ + |NN const U8 * const strend \ + |const bool utf8_target +EsR |LB_enum|advance_one_LB |NN U8 ** curpos \ + |NN const U8 * const strend \ + |const bool utf8_target +EsR |LB_enum|backup_one_LB |NN const U8 * const strbeg \ + |NN U8 ** curpos \ + |const bool utf8_target +EsR |bool |isSB |SB_enum before \ + |SB_enum after \ + |NN const U8 * const strbeg \ + |NN const U8 * const curpos \ + |NN const U8 * const strend \ + |const bool utf8_target +EsR |SB_enum|advance_one_SB |NN U8 ** curpos \ + |NN const U8 * const strend \ + |const bool utf8_target +EsR |SB_enum|backup_one_SB |NN const U8 * const strbeg \ + |NN U8 ** curpos \ + |const bool utf8_target +EsR |bool |isWB |WB_enum previous \ + |WB_enum before \ + |WB_enum after \ + |NN const U8 * const strbeg \ + |NN const U8 * const curpos \ + |NN const U8 * const strend \ + |const bool utf8_target +EsR |WB_enum|advance_one_WB |NN U8 ** curpos \ + |NN const U8 * const strend \ + |const bool utf8_target \ + |const bool skip_Extend_Format +EsR |WB_enum|backup_one_WB |NN WB_enum * previous \ + |NN const U8 * const strbeg \ + |NN U8 ** curpos \ + |const bool utf8_target +# ifdef DEBUGGING +Es |void |dump_exec_pos |NN const char *locinput|NN const regnode *scan|NN const char *loc_regeol\ + |NN const char *loc_bostr|NN const char *loc_reg_starttry|const bool do_utf8|const U32 depth +Es |void |debug_start_match|NN const REGEXP *prog|const bool do_utf8\ + |NN const char *start|NN const char *end\ + |NN const char *blurb + +Ep |int |re_exec_indentf |NN const char *fmt|U32 depth|... +# endif +#endif + +#if defined(PERL_IN_DUMP_C) +s |CV* |deb_curcv |I32 ix +s |void |debprof |NN const OP *o +s |UV |sequence_num |NULLOK const OP *o +s |SV* |pm_description |NN const PMOP *pm +#endif + +#if defined(PERL_IN_SCOPE_C) +s |SV* |save_scalar_at |NN SV **sptr|const U32 flags +#endif + +#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_IN_OP_C) +: Used in gv.c +po |void |sv_add_backref |NN SV *const tsv|NN SV *const sv +#endif + +#if defined(PERL_IN_HV_C) || defined(PERL_IN_MG_C) || defined(PERL_IN_SV_C) +: Used in hv.c and mg.c +poM |void |sv_kill_backrefs |NN SV *const sv|NULLOK AV *const av +#endif + +#if defined(PERL_IN_SV_C) || defined (PERL_IN_OP_C) +pR |SV * |varname |NULLOK const GV *const gv|const char gvtype \ + |PADOFFSET targ|NULLOK const SV *const keyname \ + |I32 aindex|int subscript_type +#endif + +pX |void |sv_del_backref |NN SV *const tsv|NN SV *const sv +#if defined(PERL_IN_SV_C) +nsR |char * |uiv_2buf |NN char *const buf|const IV iv|UV uv|const int is_uv|NN char **const peob +i |void |sv_unglob |NN SV *const sv|U32 flags +s |const char *|sv_display |NN SV *const sv|NN char *tmpbuf|STRLEN tmpbuf_size +s |void |not_a_number |NN SV *const sv +s |void |not_incrementable |NN SV *const sv +s |I32 |visit |NN SVFUNC_t f|const U32 flags|const U32 mask +# ifdef DEBUGGING +s |void |del_sv |NN SV *p +# endif +# if !defined(NV_PRESERVES_UV) +# ifdef DEBUGGING +s |int |sv_2iuv_non_preserve |NN SV *const sv|I32 numtype +# else +s |int |sv_2iuv_non_preserve |NN SV *const sv +# endif +# endif +sR |I32 |expect_number |NN char **const pattern +sn |STRLEN |sv_pos_u2b_forwards|NN const U8 *const start \ + |NN const U8 *const send|NN STRLEN *const uoffset \ + |NN bool *const at_end +sn |STRLEN |sv_pos_u2b_midway|NN const U8 *const start \ + |NN const U8 *send|STRLEN uoffset|const STRLEN uend +s |STRLEN |sv_pos_u2b_cached|NN SV *const sv|NN MAGIC **const mgp \ + |NN const U8 *const start|NN const U8 *const send \ + |STRLEN uoffset|STRLEN uoffset0|STRLEN boffset0 +s |void |utf8_mg_len_cache_update|NN SV *const sv|NN MAGIC **const mgp \ + |const STRLEN ulen +s |void |utf8_mg_pos_cache_update|NN SV *const sv|NN MAGIC **const mgp \ + |const STRLEN byte|const STRLEN utf8|const STRLEN blen +s |STRLEN |sv_pos_b2u_midway|NN const U8 *const s|NN const U8 *const target \ + |NN const U8 *end|STRLEN endu +s |void |assert_uft8_cache_coherent|NN const char *const func \ + |STRLEN from_cache|STRLEN real|NN SV *const sv +sn |char * |F0convert |NV nv|NN char *const endbuf|NN STRLEN *const len +s |SV * |more_sv +s |bool |sv_2iuv_common |NN SV *const sv +s |void |glob_assign_glob|NN SV *const dstr|NN SV *const sstr \ + |const int dtype +sRn |PTR_TBL_ENT_t *|ptr_table_find|NN PTR_TBL_t *const tbl|NULLOK const void *const sv +s |void |anonymise_cv_maybe |NN GV *gv|NN CV *cv +#endif + +: Used in sv.c and hv.c +po |void * |more_bodies |const svtype sv_type|const size_t body_size \ + |const size_t arena_size + +#if defined(PERL_IN_TOKE_C) +s |void |check_uni +s |void |force_next |I32 type +s |char* |force_version |NN char *s|int guessing +s |char* |force_strict_version |NN char *s +s |char* |force_word |NN char *start|int token|int check_keyword \ + |int allow_pack +s |SV* |tokeq |NN SV *sv +sR |char* |scan_const |NN char *start +iR |SV* |get_and_check_backslash_N_name|NN const char* s \ + |NN const char* const e +sR |char* |scan_formline |NN char *s +sR |char* |scan_heredoc |NN char *s +s |char* |scan_ident |NN char *s|NN char *dest \ + |STRLEN destlen|I32 ck_uni +sR |char* |scan_inputsymbol|NN char *start +sR |char* |scan_pat |NN char *start|I32 type +sR |char* |scan_str |NN char *start|int keep_quoted \ + |int keep_delims|int re_reparse \ + |NULLOK char **delimp +sR |char* |scan_subst |NN char *start +sR |char* |scan_trans |NN char *start +s |char* |scan_word |NN char *s|NN char *dest|STRLEN destlen \ + |int allow_package|NN STRLEN *slp +s |void |update_debugger_info|NULLOK SV *orig_sv \ + |NULLOK const char *const buf|STRLEN len +sR |char* |skipspace_flags|NN char *s|U32 flags +sR |char* |swallow_bom |NN U8 *s +#ifndef PERL_NO_UTF16_FILTER +s |I32 |utf16_textfilter|int idx|NN SV *sv|int maxlen +s |U8* |add_utf16_textfilter|NN U8 *const s|bool reversed +#endif +s |void |checkcomma |NN const char *s|NN const char *name \ + |NN const char *what +s |void |force_ident |NN const char *s|int kind +s |void |force_ident_maybe_lex|char pit +s |void |incline |NN const char *s +s |int |intuit_method |NN char *s|NULLOK SV *ioname|NULLOK CV *cv +s |int |intuit_more |NN char *s +s |I32 |lop |I32 f|int x|NN char *s +rs |void |missingterm |NULLOK char *s +s |void |no_op |NN const char *const what|NULLOK char *s +s |int |pending_ident +sR |I32 |sublex_done +sR |I32 |sublex_push +sR |I32 |sublex_start +sR |char * |filter_gets |NN SV *sv|STRLEN append +sR |HV * |find_in_my_stash|NN const char *pkgname|STRLEN len +sR |char * |tokenize_use |int is_use|NN char *s +so |SV* |new_constant |NULLOK const char *s|STRLEN len \ + |NN const char *key|STRLEN keylen|NN SV *sv \ + |NULLOK SV *pv|NULLOK const char *type \ + |STRLEN typelen +s |int |deprecate_commaless_var_list +s |int |ao |int toketype +s |void|parse_ident|NN char **s|NN char **d \ + |NN char * const e|int allow_package \ + |bool is_utf8 +# if defined(PERL_CR_FILTER) +s |I32 |cr_textfilter |int idx|NULLOK SV *sv|int maxlen +s |void |strip_return |NN SV *sv +# endif +# if defined(DEBUGGING) +s |int |tokereport |I32 rv|NN const YYSTYPE* lvalp +sf |void |printbuf |NN const char *const fmt|NN const char *const s +# endif +#endif +EXMp |bool |validate_proto |NN SV *name|NULLOK SV *proto|bool warn + +#if defined(PERL_IN_UNIVERSAL_C) +s |bool |isa_lookup |NN HV *stash|NN const char * const name \ + |STRLEN len|U32 flags +#endif + +#if defined(USE_LOCALE) && defined(PERL_IN_LOCALE_C) +s |char* |stdize_locale |NN char* locs +#endif + +#if defined(USE_LOCALE) \ + && (defined(PERL_IN_LOCALE_C) || defined (PERL_EXT_POSIX)) +ApM |bool |_is_cur_LC_category_utf8|int category +# ifdef DEBUGGING +AMnPpR |char * |_setlocale_debug_string|const int category \ + |NULLOK const char* const locale \ + |NULLOK const char* const retval +# endif +#endif + + +#if defined(PERL_IN_UTIL_C) +s |SV* |mess_alloc +s |SV * |with_queued_errors|NN SV *ex +s |bool |invoke_exception_hook|NULLOK SV *ex|bool warn +#if defined(PERL_MEM_LOG) && !defined(PERL_MEM_LOG_NOIMPL) +sn |void |mem_log_common |enum mem_log_type mlt|const UV n|const UV typesize \ + |NN const char *type_name|NULLOK const SV *sv \ + |Malloc_t oldalloc|Malloc_t newalloc \ + |NN const char *filename|const int linenumber \ + |NN const char *funcname +#endif +#endif + +#if defined(PERL_MEM_LOG) +pn |Malloc_t |mem_log_alloc |const UV nconst|UV typesize|NN const char *type_name|Malloc_t newalloc|NN const char *filename|const int linenumber|NN const char *funcname +pn |Malloc_t |mem_log_realloc |const UV n|const UV typesize|NN const char *type_name|Malloc_t oldalloc|Malloc_t newalloc|NN const char *filename|const int linenumber|NN const char *funcname +pn |Malloc_t |mem_log_free |Malloc_t oldalloc|NN const char *filename|const int linenumber|NN const char *funcname +#endif + +#if defined(PERL_IN_NUMERIC_C) +#ifndef USE_QUADMATH +sn |NV|mulexp10 |NV value|I32 exponent +#endif +#endif + +#if defined(PERL_IN_UTF8_C) +sRM |UV |check_locale_boundary_crossing \ + |NN const U8* const p \ + |const UV result \ + |NN U8* const ustrp \ + |NN STRLEN *lenp +iR |bool |is_utf8_common |NN const U8 *const p|NN SV **swash|NN const char * const swashname|NULLOK SV* const invlist +sR |SV* |swatch_get |NN SV* swash|UV start|UV span +sRM |U8* |swash_scan_list_line|NN U8* l|NN U8* const lend|NN UV* min \ + |NN UV* max|NN UV* val|const bool wants_value \ + |NN const U8* const typestr +#endif + +#ifndef PERL_NO_INLINE_FUNCTIONS +AiMn |void |append_utf8_from_native_byte|const U8 byte|NN U8** dest +#endif + +Apd |void |sv_setsv_flags |NN SV *dstr|NULLOK SV *sstr|const I32 flags +Apd |void |sv_catpvn_flags|NN SV *const dstr|NN const char *sstr|const STRLEN len \ + |const I32 flags +Apd |void |sv_catpv_flags |NN SV *dstr|NN const char *sstr \ + |const I32 flags +Apd |void |sv_catsv_flags |NN SV *const dsv|NULLOK SV *const ssv|const I32 flags +Apmd |STRLEN |sv_utf8_upgrade_flags|NN SV *const sv|const I32 flags +Ap |STRLEN |sv_utf8_upgrade_flags_grow|NN SV *const sv|const I32 flags|STRLEN extra +Apd |char* |sv_pvn_force_flags|NN SV *const sv|NULLOK STRLEN *const lp|const I32 flags +pmb |void |sv_copypv |NN SV *const dsv|NN SV *const ssv +Apmd |void |sv_copypv_nomg |NN SV *const dsv|NN SV *const ssv +Apd |void |sv_copypv_flags |NN SV *const dsv|NN SV *const ssv|const I32 flags +Ap |char* |my_atof2 |NN const char *s|NN NV* value +Apn |int |my_socketpair |int family|int type|int protocol|int fd[2] +Apn |int |my_dirfd |NULLOK DIR* dir +#ifdef PERL_ANY_COW +: Used in pp_hot.c and regexec.c +pMXE |SV* |sv_setsv_cow |NULLOK SV* dstr|NN SV* sstr +#endif + +Aop |const char *|PerlIO_context_layers|NULLOK const char *mode + +#if defined(USE_PERLIO) +Ap |int |PerlIO_close |NULLOK PerlIO *f +Ap |int |PerlIO_fill |NULLOK PerlIO *f +Ap |int |PerlIO_fileno |NULLOK PerlIO *f +Ap |int |PerlIO_eof |NULLOK PerlIO *f +Ap |int |PerlIO_error |NULLOK PerlIO *f +Ap |int |PerlIO_flush |NULLOK PerlIO *f +Ap |void |PerlIO_clearerr |NULLOK PerlIO *f +Ap |void |PerlIO_set_cnt |NULLOK PerlIO *f|SSize_t cnt +Ap |void |PerlIO_set_ptrcnt |NULLOK PerlIO *f|NULLOK STDCHAR *ptr \ + |SSize_t cnt +Ap |void |PerlIO_setlinebuf |NULLOK PerlIO *f +Ap |SSize_t|PerlIO_read |NULLOK PerlIO *f|NN void *vbuf \ + |Size_t count +Ap |SSize_t|PerlIO_write |NULLOK PerlIO *f|NN const void *vbuf \ + |Size_t count +Ap |SSize_t|PerlIO_unread |NULLOK PerlIO *f|NN const void *vbuf \ + |Size_t count +Ap |Off_t |PerlIO_tell |NULLOK PerlIO *f +Ap |int |PerlIO_seek |NULLOK PerlIO *f|Off_t offset|int whence +Xp |void |PerlIO_save_errno |NULLOK PerlIO *f +Xp |void |PerlIO_restore_errno |NULLOK PerlIO *f + +Ap |STDCHAR *|PerlIO_get_base |NULLOK PerlIO *f +Ap |STDCHAR *|PerlIO_get_ptr |NULLOK PerlIO *f +ApR |SSize_t |PerlIO_get_bufsiz |NULLOK PerlIO *f +ApR |SSize_t |PerlIO_get_cnt |NULLOK PerlIO *f + +ApR |PerlIO *|PerlIO_stdin +ApR |PerlIO *|PerlIO_stdout +ApR |PerlIO *|PerlIO_stderr +#endif /* USE_PERLIO */ + +: Only used in dump.c +p |void |deb_stack_all +#if defined(PERL_IN_DEB_C) +s |void |deb_stack_n |NN SV** stack_base|I32 stack_min \ + |I32 stack_max|I32 mark_min|I32 mark_max +#endif + +: pad API +Apda |PADLIST*|pad_new |int flags +#ifdef DEBUGGING +pnX |void|set_padlist| NN CV * cv | NULLOK PADLIST * padlist +#endif +#if defined(PERL_IN_PAD_C) +s |PADOFFSET|pad_alloc_name|NN PADNAME *name|U32 flags \ + |NULLOK HV *typestash|NULLOK HV *ourstash +#endif +Apd |PADOFFSET|pad_add_name_pvn|NN const char *namepv|STRLEN namelen\ + |U32 flags|NULLOK HV *typestash\ + |NULLOK HV *ourstash +Apd |PADOFFSET|pad_add_name_pv|NN const char *name\ + |const U32 flags|NULLOK HV *typestash\ + |NULLOK HV *ourstash +Apd |PADOFFSET|pad_add_name_sv|NN SV *name\ + |U32 flags|NULLOK HV *typestash\ + |NULLOK HV *ourstash +AMpd |PADOFFSET|pad_alloc |I32 optype|U32 tmptype +Apd |PADOFFSET|pad_add_anon |NN CV* func|I32 optype +p |void |pad_add_weakref|NN CV* func +#if defined(PERL_IN_PAD_C) +sd |void |pad_check_dup |NN PADNAME *name|U32 flags \ + |NULLOK const HV *ourstash +#endif +Apd |PADOFFSET|pad_findmy_pvn|NN const char* namepv|STRLEN namelen|U32 flags +Apd |PADOFFSET|pad_findmy_pv|NN const char* name|U32 flags +Apd |PADOFFSET|pad_findmy_sv|NN SV* name|U32 flags +ApdD |PADOFFSET|find_rundefsvoffset | +Apd |SV* |find_rundefsv | +#if defined(PERL_IN_PAD_C) +sd |PADOFFSET|pad_findlex |NN const char *namepv|STRLEN namelen|U32 flags \ + |NN const CV* cv|U32 seq|int warn \ + |NULLOK SV** out_capture \ + |NN PADNAME** out_name|NN int *out_flags +#endif +#ifdef DEBUGGING +Apd |SV* |pad_sv |PADOFFSET po +Apd |void |pad_setsv |PADOFFSET po|NN SV* sv +#endif +pd |void |pad_block_start|int full +Apd |U32 |intro_my +pd |OP * |pad_leavemy +pd |void |pad_swipe |PADOFFSET po|bool refadjust +#if defined(PERL_IN_PAD_C) +sd |void |pad_reset +#endif +AMpd |void |pad_tidy |padtidy_type type +pd |void |pad_free |PADOFFSET po +pd |void |do_dump_pad |I32 level|NN PerlIO *file|NULLOK PADLIST *padlist|int full +#if defined(PERL_IN_PAD_C) +# if defined(DEBUGGING) +sd |void |cv_dump |NN const CV *cv|NN const char *title +# endif +#endif +Apd |CV* |cv_clone |NN CV* proto +p |CV* |cv_clone_into |NN CV* proto|NN CV *target +pd |void |pad_fixup_inner_anons|NN PADLIST *padlist|NN CV *old_cv|NN CV *new_cv +pdX |void |pad_push |NN PADLIST *padlist|int depth +ApbdR |HV* |pad_compname_type|const PADOFFSET po +AMpdRn |PADNAME *|padnamelist_fetch|NN PADNAMELIST *pnl|SSize_t key +Xop |void |padnamelist_free|NN PADNAMELIST *pnl +AMpd |PADNAME **|padnamelist_store|NN PADNAMELIST *pnl|SSize_t key \ + |NULLOK PADNAME *val +Xop |void |padname_free |NN PADNAME *pn +#if defined(USE_ITHREADS) +pdR |PADNAME *|padname_dup |NN PADNAME *src|NN CLONE_PARAMS *param +pR |PADNAMELIST *|padnamelist_dup|NN PADNAMELIST *srcpad \ + |NN CLONE_PARAMS *param +pdR |PADLIST *|padlist_dup |NN PADLIST *srcpad \ + |NN CLONE_PARAMS *param +#endif +p |PAD ** |padlist_store |NN PADLIST *padlist|I32 key \ + |NULLOK PAD *val + +ApdR |CV* |find_runcv |NULLOK U32 *db_seqp +pR |CV* |find_runcv_where|U8 cond|IV arg \ + |NULLOK U32 *db_seqp +: Only used in perl.c +p |void |free_tied_hv_pool +#if defined(DEBUGGING) +: Used in mg.c +pR |int |get_debug_opts |NN const char **s|bool givehelp +#endif +Ap |void |save_set_svflags|NN SV *sv|U32 mask|U32 val +#ifdef DEBUGGING +Apod |void |hv_assert |NN HV *hv +#endif + +ApdR |SV* |hv_scalar |NN HV *hv +ApoR |I32* |hv_riter_p |NN HV *hv +ApoR |HE** |hv_eiter_p |NN HV *hv +Apo |void |hv_riter_set |NN HV *hv|I32 riter +Apo |void |hv_eiter_set |NN HV *hv|NULLOK HE *eiter +Ap |void |hv_rand_set |NN HV *hv|U32 new_xhv_rand +Ap |void |hv_name_set |NN HV *hv|NULLOK const char *name|U32 len|U32 flags +p |void |hv_ename_add |NN HV *hv|NN const char *name|U32 len \ + |U32 flags +p |void |hv_ename_delete|NN HV *hv|NN const char *name|U32 len \ + |U32 flags +: Used in dump.c and hv.c +poM |AV** |hv_backreferences_p |NN HV *hv +#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_SCOPE_C) +poM |void |hv_kill_backrefs |NN HV *hv +#endif +Apd |void |hv_clear_placeholders |NN HV *hv +XpoR |SSize_t*|hv_placeholders_p |NN HV *hv +ApoR |I32 |hv_placeholders_get |NN const HV *hv +Apo |void |hv_placeholders_set |NN HV *hv|I32 ph + +: This is indirectly referenced by globals.c. This is somewhat annoying. +p |SV* |magic_scalarpack|NN HV *hv|NN MAGIC *mg + +#if defined(PERL_IN_SV_C) +s |SV * |find_hash_subscript|NULLOK const HV *const hv \ + |NN const SV *const val +s |I32 |find_array_subscript|NULLOK const AV *const av \ + |NN const SV *const val +sMd |SV* |find_uninit_var|NULLOK const OP *const obase \ + |NULLOK const SV *const uninit_sv|bool match \ + |NN const char **desc_p +#endif + +Ap |GV* |gv_fetchpvn_flags|NN const char* name|STRLEN len|I32 flags|const svtype sv_type +Ap |GV* |gv_fetchsv|NN SV *name|I32 flags|const svtype sv_type + +#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP +: Used in sv.c +p |void |dump_sv_child |NN SV *sv +#endif + +#ifdef PERL_DONT_CREATE_GVSV +Apbm |GV* |gv_SVadd |NULLOK GV *gv +#endif +#if defined(PERL_IN_UTIL_C) +s |bool |ckwarn_common |U32 w +#endif +Apo |bool |ckwarn |U32 w +Apo |bool |ckwarn_d |U32 w +: FIXME - exported for ByteLoader - public or private? +XEopMa |STRLEN *|new_warnings_bitfield|NULLOK STRLEN *buffer \ + |NN const char *const bits|STRLEN size + +#ifndef SPRINTF_RETURNS_STRLEN +Apnod |int |my_sprintf |NN char *buffer|NN const char *pat|... +#endif + +Apnodf |int |my_snprintf |NN char *buffer|const Size_t len|NN const char *format|... +Apnod |int |my_vsnprintf |NN char *buffer|const Size_t len|NN const char *format|va_list ap +#ifdef USE_QUADMATH +Apnd |const char* |quadmath_format_single|NN const char* format +Apnd |bool|quadmath_format_needed|NN const char* format +#endif + +: Used in mg.c, sv.c +px |void |my_clearenv + +#ifdef PERL_IMPLICIT_CONTEXT +#ifdef PERL_GLOBAL_STRUCT_PRIVATE +Apo |void* |my_cxt_init |NN const char *my_cxt_key|size_t size +Apo |int |my_cxt_index |NN const char *my_cxt_key +#else +Apo |void* |my_cxt_init |NN int *index|size_t size +#endif +#endif +#if defined(PERL_IN_UTIL_C) +so |void |xs_version_bootcheck|U32 items|U32 ax|NN const char *xs_p \ + |STRLEN xs_len +#endif +Xpon |I32 |xs_handshake |const U32 key|NN void * v_my_perl\ + |NN const char * file| ... +Xp |void |xs_boot_epilog |const I32 ax +#ifndef HAS_STRLCAT +Apnod |Size_t |my_strlcat |NULLOK char *dst|NULLOK const char *src|Size_t size +#endif + +#ifndef HAS_STRLCPY +Apnod |Size_t |my_strlcpy |NULLOK char *dst|NULLOK const char *src|Size_t size +#endif + +Apdn |bool |isinfnan |NV nv +p |bool |isinfnansv |NN SV *sv + +#if !defined(HAS_SIGNBIT) +AMdnoP |int |Perl_signbit |NV f +#endif + +: Used by B +XEMop |void |emulate_cop_io |NN const COP *const c|NN SV *const sv +: Used by SvRX and SvRXOK +XEMop |REGEXP *|get_re_arg|NULLOK SV *sv + +Aop |SV* |mro_get_private_data|NN struct mro_meta *const smeta \ + |NN const struct mro_alg *const which +Aop |SV* |mro_set_private_data|NN struct mro_meta *const smeta \ + |NN const struct mro_alg *const which \ + |NN SV *const data +Aop |const struct mro_alg *|mro_get_from_name|NN SV *name +Aop |void |mro_register |NN const struct mro_alg *mro +Aop |void |mro_set_mro |NN struct mro_meta *const meta \ + |NN SV *const name +: Used in HvMROMETA(), which is public. +Xpo |struct mro_meta* |mro_meta_init |NN HV* stash +#if defined(USE_ITHREADS) +: Only used in sv.c +p |struct mro_meta* |mro_meta_dup |NN struct mro_meta* smeta|NN CLONE_PARAMS* param +#endif +Apd |AV* |mro_get_linear_isa|NN HV* stash +#if defined(PERL_IN_MRO_C) +sd |AV* |mro_get_linear_isa_dfs|NN HV* stash|U32 level +s |void |mro_clean_isarev|NN HV * const isa \ + |NN const char * const name \ + |const STRLEN len \ + |NULLOK HV * const exceptions \ + |U32 hash|U32 flags +s |void |mro_gather_and_rename|NN HV * const stashes \ + |NN HV * const seen_stashes \ + |NULLOK HV *stash \ + |NULLOK HV *oldstash \ + |NN SV *namesv +#endif +: Used in hv.c, mg.c, pp.c, sv.c +pd |void |mro_isa_changed_in|NN HV* stash +Apd |void |mro_method_changed_in |NN HV* stash +pdx |void |mro_package_moved |NULLOK HV * const stash|NULLOK HV * const oldstash|NN const GV * const gv|U32 flags +: Only used in perl.c +p |void |boot_core_mro +Apon |void |sys_init |NN int* argc|NN char*** argv +Apon |void |sys_init3 |NN int* argc|NN char*** argv|NN char*** env +Apon |void |sys_term +ApoM |const char *|cop_fetch_label|NN COP *const cop \ + |NULLOK STRLEN *len|NULLOK U32 *flags +: Only used in op.c and the perl compiler +ApoM |void|cop_store_label \ + |NN COP *const cop|NN const char *label|STRLEN len|U32 flags + +xpo |int |keyword_plugin_standard|NN char* keyword_ptr|STRLEN keyword_len|NN OP** op_ptr + +#if defined(USE_ITHREADS) +# if defined(PERL_IN_SV_C) +s |void |unreferenced_to_tmp_stack|NN AV *const unreferenced +# endif +Aanop |CLONE_PARAMS *|clone_params_new|NN PerlInterpreter *const from \ + |NN PerlInterpreter *const to +Anop |void |clone_params_del|NN CLONE_PARAMS *param +#endif + +: Used in perl.c and toke.c +op |void |populate_isa |NN const char *name|STRLEN len|... + +: Used in keywords.c and toke.c +Xop |bool |feature_is_enabled|NN const char *const name \ + |STRLEN namelen + +: Some static inline functions need predeclaration because they are used +: inside other static inline functions. +#if defined(PERL_CORE) || defined (PERL_EXT) +Ei |STRLEN |sv_or_pv_pos_u2b|NN SV *sv|NN const char *pv|STRLEN pos \ + |NULLOK STRLEN *lenp +#endif + +EMpPX |SV* |_get_encoding +Ap |void |clear_defarray |NN AV* av|bool abandon + +ApM |void |leave_adjust_stacks|NN SV **from_sp|NN SV **to_sp \ + |U8 gimme|int filter + +#ifndef PERL_NO_INLINE_FUNCTIONS +AiM |PERL_CONTEXT * |cx_pushblock|U8 type|U8 gimme|NN SV** sp|I32 saveix +AiM |void |cx_popblock|NN PERL_CONTEXT *cx +AiM |void |cx_topblock|NN PERL_CONTEXT *cx +AiM |void |cx_pushsub |NN PERL_CONTEXT *cx|NN CV *cv \ + |NULLOK OP *retop|bool hasargs +AiM |void |cx_popsub_common|NN PERL_CONTEXT *cx +AiM |void |cx_popsub_args |NN PERL_CONTEXT *cx +AiM |void |cx_popsub |NN PERL_CONTEXT *cx +AiM |void |cx_pushformat |NN PERL_CONTEXT *cx|NN CV *cv \ + |NULLOK OP *retop|NULLOK GV *gv +AiM |void |cx_popformat |NN PERL_CONTEXT *cx +AiM |void |cx_pusheval |NN PERL_CONTEXT *cx \ + |NULLOK OP *retop|NULLOK SV *namesv +AiM |void |cx_popeval |NN PERL_CONTEXT *cx +AiM |void |cx_pushloop_plain|NN PERL_CONTEXT *cx +AiM |void |cx_pushloop_for |NN PERL_CONTEXT *cx \ + |NN void *itervarp|NULLOK SV *itersave +AiM |void |cx_poploop |NN PERL_CONTEXT *cx +AiM |void |cx_pushwhen |NN PERL_CONTEXT *cx +AiM |void |cx_popwhen |NN PERL_CONTEXT *cx +AiM |void |cx_pushgiven |NN PERL_CONTEXT *cx|NULLOK SV *orig_defsv +AiM |void |cx_popgiven |NN PERL_CONTEXT *cx +#endif + +#ifdef USE_DTRACE +XEop |void |dtrace_probe_call |NN CV *cv|bool is_call +XEop |void |dtrace_probe_load |NN const char *name|bool is_loading +XEop |void |dtrace_probe_op |NN const OP *op +XEop |void |dtrace_probe_phase|enum perl_phase phase +#endif + +: ex: set ts=8 sts=4 sw=4 noet: diff --git a/dist/Devel-PPPort/parts/inc/HvNAME b/dist/Devel-PPPort/parts/inc/HvNAME new file mode 100644 index 0000000000..9b8602bd7e --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/HvNAME @@ -0,0 +1,38 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +__UNDEFINED__ + +=implementation + +__UNDEFINED__ HvNAME_get(hv) HvNAME(hv) + +__UNDEFINED__ HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0) + +=xsubs + +char* +HvNAME_get(hv) + HV *hv + +int +HvNAMELEN_get(hv) + HV *hv + +=tests plan => 4 + +ok(Devel::PPPort::HvNAME_get(\%Devel::PPPort::), 'Devel::PPPort'); +ok(Devel::PPPort::HvNAME_get({}), undef); + +ok(Devel::PPPort::HvNAMELEN_get(\%Devel::PPPort::), length('Devel::PPPort')); +ok(Devel::PPPort::HvNAMELEN_get({}), 0); diff --git a/dist/Devel-PPPort/parts/inc/MY_CXT b/dist/Devel-PPPort/parts/inc/MY_CXT new file mode 100644 index 0000000000..efd8ca1430 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/MY_CXT @@ -0,0 +1,185 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +START_MY_CXT +dMY_CXT_SV +dMY_CXT +MY_CXT_INIT +MY_CXT_CLONE +MY_CXT +pMY_CXT +pMY_CXT_ +_pMY_CXT +aMY_CXT +aMY_CXT_ +_aMY_CXT + +=implementation + +/* + * Boilerplate macros for initializing and accessing interpreter-local + * data from C. All statics in extensions should be reworked to use + * this, if you want to make the extension thread-safe. See ext/re/re.xs + * for an example of the use of these macros. + * + * Code that uses these macros is responsible for the following: + * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts" + * 2. Declare a typedef named my_cxt_t that is a structure that contains + * all the data that needs to be interpreter-local. + * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. + * 4. Use the MY_CXT_INIT macro such that it is called exactly once + * (typically put in the BOOT: section). + * 5. Use the members of the my_cxt_t structure everywhere as + * MY_CXT.member. + * 6. Use the dMY_CXT macro (a declaration) in all the functions that + * access MY_CXT. + */ + +#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \ + defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT) + +#ifndef START_MY_CXT + +/* This must appear in all extensions that define a my_cxt_t structure, + * right after the definition (i.e. at file scope). The non-threads + * case below uses it to declare the data as static. */ +#define START_MY_CXT + +#if { VERSION < 5.004_68 } +/* Fetches the SV that keeps the per-interpreter data. */ +#define dMY_CXT_SV \ + SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE) +#else /* >= perl5.004_68 */ +#define dMY_CXT_SV \ + SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ + sizeof(MY_CXT_KEY)-1, TRUE) +#endif /* < perl5.004_68 */ + +/* This declaration should be used within all functions that use the + * interpreter-local data. */ +#define dMY_CXT \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv)) + +/* Creates and zeroes the per-interpreter data. + * (We allocate my_cxtp in a Perl SV so that it will be released when + * the interpreter goes away.) */ +#define MY_CXT_INIT \ + dMY_CXT_SV; \ + /* newSV() allocates one more than needed */ \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ + Zero(my_cxtp, 1, my_cxt_t); \ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) + +/* This macro must be used to access members of the my_cxt_t structure. + * e.g. MYCXT.some_data */ +#define MY_CXT (*my_cxtp) + +/* Judicious use of these macros can reduce the number of times dMY_CXT + * is used. Use is similar to pTHX, aTHX etc. */ +#define pMY_CXT my_cxt_t *my_cxtp +#define pMY_CXT_ pMY_CXT, +#define _pMY_CXT ,pMY_CXT +#define aMY_CXT my_cxtp +#define aMY_CXT_ aMY_CXT, +#define _aMY_CXT ,aMY_CXT + +#endif /* START_MY_CXT */ + +#ifndef MY_CXT_CLONE +/* Clones the per-interpreter data. */ +#define MY_CXT_CLONE \ + dMY_CXT_SV; \ + my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ + Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ + sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) +#endif + +#else /* single interpreter */ + +#ifndef START_MY_CXT + +#define START_MY_CXT static my_cxt_t my_cxt; +#define dMY_CXT_SV dNOOP +#define dMY_CXT dNOOP +#define MY_CXT_INIT NOOP +#define MY_CXT my_cxt + +#define pMY_CXT void +#define pMY_CXT_ +#define _pMY_CXT +#define aMY_CXT +#define aMY_CXT_ +#define _aMY_CXT + +#endif /* START_MY_CXT */ + +#ifndef MY_CXT_CLONE +#define MY_CXT_CLONE NOOP +#endif + +#endif + +=xsmisc + +#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION + +typedef struct { + /* Put Global Data in here */ + int dummy; +} my_cxt_t; + +START_MY_CXT + +=xsboot + +{ + 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 + +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 + +=tests plan => 3 + +ok(&Devel::PPPort::MY_CXT_1()); +ok(&Devel::PPPort::MY_CXT_2()); +ok(&Devel::PPPort::MY_CXT_CLONE()); diff --git a/dist/Devel-PPPort/parts/inc/SvPV b/dist/Devel-PPPort/parts/inc/SvPV new file mode 100644 index 0000000000..e99bfa01e0 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/SvPV @@ -0,0 +1,535 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +__UNDEFINED__ +SvPVbyte +sv_2pvbyte +sv_2pv_flags +sv_pvn_force_flags + +=dontwarn + +NEED_sv_2pv_flags +NEED_sv_2pv_flags_GLOBAL +DPPP_SVPV_NOLEN_LP_ARG + +=implementation + +/* Backwards compatibility stuff... :-( */ +#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen) +# define NEED_sv_2pv_flags +#endif +#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL) +# define NEED_sv_2pv_flags_GLOBAL +#endif + +/* Hint: sv_2pv_nolen + * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen(). + */ + +__UNDEFINED__ sv_2pv_nolen(sv) SvPV_nolen(sv) + +#ifdef SvPVbyte + +/* Hint: SvPVbyte + * Does not work in perl-5.6.1, ppport.h implements a version + * borrowed from perl-5.7.3. + */ + +#if { VERSION < 5.7.0 } + +#if { NEED sv_2pvbyte } + +char * +sv_2pvbyte(pTHX_ SV *sv, STRLEN *lp) +{ + sv_utf8_downgrade(sv,0); + return SvPV(sv,*lp); +} + +#endif + +/* Hint: sv_2pvbyte + * Use the SvPVbyte() macro instead of sv_2pvbyte(). + */ + +#undef SvPVbyte + +#define SvPVbyte(sv, lp) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) + +#endif + +#else + +# define SvPVbyte SvPV +# define sv_2pvbyte sv_2pv + +#endif + +__UNDEFINED__ sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv) + +/* Hint: sv_pvn + * Always use the SvPV() macro instead of sv_pvn(). + */ + +/* Hint: sv_pvn_force + * Always use the SvPV_force() macro instead of sv_pvn_force(). + */ + +/* If these are undefined, they're not handled by the core anyway */ +__UNDEFINED__ SV_IMMEDIATE_UNREF 0 +__UNDEFINED__ SV_GMAGIC 0 +__UNDEFINED__ SV_COW_DROP_PV 0 +__UNDEFINED__ SV_UTF8_NO_ENCODING 0 +__UNDEFINED__ SV_NOSTEAL 0 +__UNDEFINED__ SV_CONST_RETURN 0 +__UNDEFINED__ SV_MUTABLE_RETURN 0 +__UNDEFINED__ SV_SMAGIC 0 +__UNDEFINED__ SV_HAS_TRAILING_NUL 0 +__UNDEFINED__ SV_COW_SHARED_HASH_KEYS 0 + +#if { VERSION < 5.7.2 } + +#if { NEED sv_2pv_flags } + +char * +sv_2pv_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) +{ + STRLEN n_a = (STRLEN) flags; + return sv_2pv(sv, lp ? lp : &n_a); +} + +#endif + +#if { NEED sv_pvn_force_flags } + +char * +sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags) +{ + STRLEN n_a = (STRLEN) flags; + return sv_pvn_force(sv, lp ? lp : &n_a); +} + +#endif + +#endif + +#if { VERSION < 5.8.8 } || ( { VERSION >= 5.9.0 } && { VERSION < 5.9.3 } ) +# define DPPP_SVPV_NOLEN_LP_ARG &PL_na +#else +# define DPPP_SVPV_NOLEN_LP_ARG 0 +#endif + +__UNDEFINED__ SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC) +__UNDEFINED__ SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC) + +__UNDEFINED__ SvPV_flags(sv, lp, flags) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags)) + +__UNDEFINED__ SvPV_flags_const(sv, lp, flags) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \ + (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN)) + +__UNDEFINED__ SvPV_flags_const_nolen(sv, flags) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? SvPVX_const(sv) : \ + (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN)) + +__UNDEFINED__ SvPV_flags_mutable(sv, lp, flags) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \ + sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) + +__UNDEFINED__ SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC) +__UNDEFINED__ SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC) +__UNDEFINED__ SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC) +__UNDEFINED__ SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0) +__UNDEFINED__ SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0) + +__UNDEFINED__ SvPV_force_flags(sv, lp, flags) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags)) + +__UNDEFINED__ SvPV_force_flags_nolen(sv, flags) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ + ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags)) + +__UNDEFINED__ SvPV_force_flags_mutable(sv, lp, flags) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \ + ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \ + : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) + +__UNDEFINED__ SvPV_nolen(sv) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC)) + +__UNDEFINED__ SvPV_nolen_const(sv) \ + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN)) + +__UNDEFINED__ SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0) +__UNDEFINED__ SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0) +__UNDEFINED__ SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0) +__UNDEFINED__ SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0)) + +__UNDEFINED__ SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \ + SvPV_set((sv), (char *) saferealloc( \ + (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \ + } STMT_END + +=xsinit + +#define NEED_sv_2pv_flags +#define NEED_sv_pvn_force_flags +#define NEED_sv_2pvbyte + +=xsubs + +IV +SvPVbyte(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPVbyte(sv, len); + RETVAL = strEQ(str, "mhx") ? (IV) len : (IV) -1; + OUTPUT: + RETVAL + +IV +SvPV_nolen(sv) + SV *sv + PREINIT: + char *str; + CODE: + str = SvPV_nolen(sv); + RETVAL = strEQ(str, "mhx") ? 42 : 0; + OUTPUT: + RETVAL + +IV +SvPV_const(sv) + SV *sv + PREINIT: + const char *str; + STRLEN len; + CODE: + str = SvPV_const(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 40 : 0); + OUTPUT: + RETVAL + +IV +SvPV_mutable(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_mutable(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 41 : 0); + OUTPUT: + RETVAL + +IV +SvPV_flags(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_flags(sv, len, SV_GMAGIC); + RETVAL = len + (strEQ(str, "mhx") ? 42 : 0); + OUTPUT: + RETVAL + +IV +SvPV_flags_const(sv) + SV *sv + PREINIT: + const char *str; + STRLEN len; + CODE: + str = SvPV_flags_const(sv, len, SV_GMAGIC); + RETVAL = len + (strEQ(str, "mhx") ? 43 : 0); + OUTPUT: + RETVAL + +IV +SvPV_flags_const_nolen(sv) + SV *sv + PREINIT: + const char *str; + CODE: + str = SvPV_flags_const_nolen(sv, SV_GMAGIC); + RETVAL = strEQ(str, "mhx") ? 47 : 0; + OUTPUT: + RETVAL + +IV +SvPV_flags_mutable(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_flags_mutable(sv, len, SV_GMAGIC); + RETVAL = len + (strEQ(str, "mhx") ? 45 : 0); + OUTPUT: + RETVAL + +IV +SvPV_force(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_force(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 46 : 0); + OUTPUT: + RETVAL + +IV +SvPV_force_nolen(sv) + SV *sv + PREINIT: + char *str; + CODE: + str = SvPV_force_nolen(sv); + RETVAL = strEQ(str, "mhx") ? 50 : 0; + OUTPUT: + RETVAL + +IV +SvPV_force_mutable(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_force_mutable(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 48 : 0); + OUTPUT: + RETVAL + +IV +SvPV_force_nomg(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_force_nomg(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 49 : 0); + OUTPUT: + RETVAL + +IV +SvPV_force_nomg_nolen(sv) + SV *sv + PREINIT: + char *str; + CODE: + str = SvPV_force_nomg_nolen(sv); + RETVAL = strEQ(str, "mhx") ? 53 : 0; + OUTPUT: + RETVAL + +IV +SvPV_force_flags(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_force_flags(sv, len, SV_GMAGIC); + RETVAL = len + (strEQ(str, "mhx") ? 51 : 0); + OUTPUT: + RETVAL + +IV +SvPV_force_flags_nolen(sv) + SV *sv + PREINIT: + char *str; + CODE: + str = SvPV_force_flags_nolen(sv, SV_GMAGIC); + RETVAL = strEQ(str, "mhx") ? 55 : 0; + OUTPUT: + RETVAL + +IV +SvPV_force_flags_mutable(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_force_flags_mutable(sv, len, SV_GMAGIC); + RETVAL = len + (strEQ(str, "mhx") ? 53 : 0); + OUTPUT: + RETVAL + +IV +SvPV_nolen_const(sv) + SV *sv + PREINIT: + const char *str; + CODE: + str = SvPV_nolen_const(sv); + RETVAL = strEQ(str, "mhx") ? 57 : 0; + OUTPUT: + RETVAL + +IV +SvPV_nomg(sv) + SV *sv + PREINIT: + char *str; + STRLEN len; + CODE: + str = SvPV_nomg(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 55 : 0); + OUTPUT: + RETVAL + +IV +SvPV_nomg_const(sv) + SV *sv + PREINIT: + const char *str; + STRLEN len; + CODE: + str = SvPV_nomg_const(sv, len); + RETVAL = len + (strEQ(str, "mhx") ? 56 : 0); + OUTPUT: + RETVAL + +IV +SvPV_nomg_const_nolen(sv) + SV *sv + PREINIT: + const char *str; + CODE: + str = SvPV_nomg_const_nolen(sv); + RETVAL = strEQ(str, "mhx") ? 60 : 0; + OUTPUT: + RETVAL + +IV +SvPV_nomg_nolen(sv) + SV *sv + PREINIT: + char *str; + CODE: + str = SvPV_nomg_nolen(sv); + RETVAL = strEQ(str, "mhx") ? 61 : 0; + OUTPUT: + RETVAL + +void +SvPV_renew(sv, nlen, insv) + SV *sv + STRLEN nlen + SV *insv + PREINIT: + STRLEN slen; + const char *str; + PPCODE: + str = SvPV_const(insv, slen); + XPUSHs(sv); + mXPUSHi(SvLEN(sv)); + SvPV_renew(sv, nlen); + Copy(str, SvPVX(sv), slen + 1, char); + SvCUR_set(sv, slen); + mXPUSHi(SvLEN(sv)); + + +=tests plan => 49 + +my $mhx = "mhx"; + +ok(&Devel::PPPort::SvPVbyte($mhx), 3); + +my $i = 42; + +ok(&Devel::PPPort::SvPV_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_mutable($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags_const($mhx), $i++); + +ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++); +ok(&Devel::PPPort::SvPV_force($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_mutable($mhx), $i++); + +ok(&Devel::PPPort::SvPV_force_nomg($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++); + +ok(&Devel::PPPort::SvPV_nolen_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), $i++); + +$mhx = 42; ok(&Devel::PPPort::SvPV_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_const($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_mutable($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_mutable($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_mutable($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_nolen_const($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), 0); + +my $str = ""; +&Devel::PPPort::SvPV_force($str); +my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80); +ok($str, "x"x80); +ok($s2, "x"x80); +ok($before < 81); +ok($after, 81); + +$str = "x"x400; +&Devel::PPPort::SvPV_force($str); +($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40); +ok($str, "x"x40); +ok($s2, "x"x40); +ok($before > 41); +ok($after, 41); diff --git a/dist/Devel-PPPort/parts/inc/SvREFCNT b/dist/Devel-PPPort/parts/inc/SvREFCNT new file mode 100644 index 0000000000..422aa58ac8 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/SvREFCNT @@ -0,0 +1,123 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +SvREFCNT_inc +SvREFCNT_inc_simple +SvREFCNT_inc_NN +SvREFCNT_inc_void +__UNDEFINED__ + +=implementation + +#ifndef SvREFCNT_inc +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc(sv) \ + ({ \ + SV * const _sv = (SV*)(sv); \ + if (_sv) \ + (SvREFCNT(_sv))++; \ + _sv; \ + }) +# else +# define SvREFCNT_inc(sv) \ + ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL) +# endif +#endif + +#ifndef SvREFCNT_inc_simple +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc_simple(sv) \ + ({ \ + if (sv) \ + (SvREFCNT(sv))++; \ + (SV *)(sv); \ + }) +# else +# define SvREFCNT_inc_simple(sv) \ + ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL) +# endif +#endif + +#ifndef SvREFCNT_inc_NN +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc_NN(sv) \ + ({ \ + SV * const _sv = (SV*)(sv); \ + SvREFCNT(_sv)++; \ + _sv; \ + }) +# else +# define SvREFCNT_inc_NN(sv) \ + (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv) +# endif +#endif + +#ifndef SvREFCNT_inc_void +# ifdef PERL_USE_GCC_BRACE_GROUPS +# define SvREFCNT_inc_void(sv) \ + ({ \ + SV * const _sv = (SV*)(sv); \ + if (_sv) \ + (void)(SvREFCNT(_sv)++); \ + }) +# else +# define SvREFCNT_inc_void(sv) \ + (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0) +# endif +#endif + +__UNDEFINED__ SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END +__UNDEFINED__ SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv)) +__UNDEFINED__ SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) +__UNDEFINED__ SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) + +=xsubs + +void +SvREFCNT() + PREINIT: + SV *sv, *svr; + PPCODE: + sv = newSV(0); + mXPUSHi(SvREFCNT(sv) == 1); + svr = SvREFCNT_inc(sv); + mXPUSHi(sv == svr); + mXPUSHi(SvREFCNT(sv) == 2); + svr = SvREFCNT_inc_simple(sv); + mXPUSHi(sv == svr); + mXPUSHi(SvREFCNT(sv) == 3); + svr = SvREFCNT_inc_NN(sv); + mXPUSHi(sv == svr); + mXPUSHi(SvREFCNT(sv) == 4); + svr = SvREFCNT_inc_simple_NN(sv); + mXPUSHi(sv == svr); + mXPUSHi(SvREFCNT(sv) == 5); + SvREFCNT_inc_void(sv); + mXPUSHi(SvREFCNT(sv) == 6); + SvREFCNT_inc_simple_void(sv); + mXPUSHi(SvREFCNT(sv) == 7); + SvREFCNT_inc_void_NN(sv); + mXPUSHi(SvREFCNT(sv) == 8); + SvREFCNT_inc_simple_void_NN(sv); + mXPUSHi(SvREFCNT(sv) == 9); + while (SvREFCNT(sv) > 1) + SvREFCNT_dec(sv); + mXPUSHi(SvREFCNT(sv) == 1); + SvREFCNT_dec(sv); + XSRETURN(14); + +=tests plan => 14 + +for (Devel::PPPort::SvREFCNT()) { + ok(defined $_ and $_); +} diff --git a/dist/Devel-PPPort/parts/inc/Sv_set b/dist/Devel-PPPort/parts/inc/Sv_set new file mode 100644 index 0000000000..30452aee66 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/Sv_set @@ -0,0 +1,118 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +__UNDEFINED__ + +=implementation + +__UNDEFINED__ SvMAGIC_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ + (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END + +#if { VERSION < 5.9.3 } + +__UNDEFINED__ SvPVX_const(sv) ((const char*) (0 + SvPVX(sv))) +__UNDEFINED__ SvPVX_mutable(sv) (0 + SvPVX(sv)) + +__UNDEFINED__ SvRV_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ + (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END + +#else + +__UNDEFINED__ SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) +__UNDEFINED__ SvPVX_mutable(sv) ((sv)->sv_u.svu_pv) + +__UNDEFINED__ SvRV_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_RV); \ + ((sv)->sv_u.svu_rv = (val)); } STMT_END + +#endif + +__UNDEFINED__ SvSTASH_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ + (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END + +#if { VERSION < 5.004 } + +__UNDEFINED__ SvUV_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ + (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END + +#else + +__UNDEFINED__ SvUV_set(sv, val) \ + STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \ + (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END + +#endif + +=xsubs + +IV +TestSvUV_set(sv, val) + SV *sv + UV val + CODE: + SvUV_set(sv, val); + RETVAL = SvUVX(sv) == val ? 42 : -1; + OUTPUT: + RETVAL + +IV +TestSvPVX_const(sv) + SV *sv + CODE: + RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1; + OUTPUT: + RETVAL + +IV +TestSvPVX_mutable(sv) + SV *sv + CODE: + RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1; + OUTPUT: + RETVAL + +void +TestSvSTASH_set(sv, name) + SV *sv + char *name + CODE: + sv = SvRV(sv); + SvREFCNT_dec(SvSTASH(sv)); + SvSTASH_set(sv, (HV*) SvREFCNT_inc(gv_stashpv(name, 0))); + +=tests plan => 5 + +my $foo = 5; +ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42); +ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43); +ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44); + +my $bar = []; + +bless $bar, 'foo'; +ok($bar->x(), 'foobar'); + +Devel::PPPort::TestSvSTASH_set($bar, 'bar'); +ok($bar->x(), 'hacker'); + +package foo; + +sub x { 'foobar' } + +package bar; + +sub x { 'hacker' } diff --git a/dist/Devel-PPPort/parts/inc/call b/dist/Devel-PPPort/parts/inc/call new file mode 100644 index 0000000000..7d8e4d37e5 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/call @@ -0,0 +1,364 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +eval_pv +eval_sv +call_sv +call_pv +call_argv +call_method +load_module +vload_module +G_METHOD + +=implementation + +/* Replace: 1 */ +__UNDEFINED__ call_sv perl_call_sv +__UNDEFINED__ call_pv perl_call_pv +__UNDEFINED__ call_argv perl_call_argv +__UNDEFINED__ call_method perl_call_method + +__UNDEFINED__ eval_sv perl_eval_sv +/* Replace: 0 */ + +__UNDEFINED__ PERL_LOADMOD_DENY 0x1 +__UNDEFINED__ PERL_LOADMOD_NOIMPORT 0x2 +__UNDEFINED__ PERL_LOADMOD_IMPORT_OPS 0x4 + +#ifndef G_METHOD +# define G_METHOD 64 +# ifdef call_sv +# undef call_sv +# endif +# if { VERSION < 5.6.0 } +# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \ + (flags) & ~G_METHOD) : perl_call_sv(sv, flags)) +# else +# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \ + (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags)) +# endif +#endif + +/* Replace perl_eval_pv with eval_pv */ + +#ifndef eval_pv +#if { NEED eval_pv } + +SV* +eval_pv(char *p, I32 croak_on_error) +{ + dSP; + SV* sv = newSVpv(p, 0); + + PUSHMARK(sp); + eval_sv(sv, G_SCALAR); + SvREFCNT_dec(sv); + + SPAGAIN; + sv = POPs; + PUTBACK; + + if (croak_on_error && SvTRUE(GvSV(errgv))) + croak(SvPVx(GvSV(errgv), na)); + + return sv; +} + +#endif +#endif + +#ifndef vload_module +#if { NEED vload_module } + +void +vload_module(U32 flags, SV *name, SV *ver, va_list *args) +{ + dTHR; + dVAR; + OP *veop, *imop; + + OP * const modname = newSVOP(OP_CONST, 0, name); + /* 5.005 has a somewhat hacky force_normal that doesn't croak on + SvREADONLY() if PL_compling is true. Current perls take care in + ck_require() to correctly turn off SvREADONLY before calling + force_normal_flags(). This seems a better fix than fudging PL_compling + */ + SvREADONLY_off(((SVOP*)modname)->op_sv); + modname->op_private |= OPpCONST_BARE; + if (ver) { + veop = newSVOP(OP_CONST, 0, ver); + } + else + veop = NULL; + if (flags & PERL_LOADMOD_NOIMPORT) { + imop = sawparens(newNULLLIST()); + } + else if (flags & PERL_LOADMOD_IMPORT_OPS) { + imop = va_arg(*args, OP*); + } + else { + SV *sv; + imop = NULL; + sv = va_arg(*args, SV*); + while (sv) { + imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv)); + sv = va_arg(*args, SV*); + } + } + { + const line_t ocopline = PL_copline; + COP * const ocurcop = PL_curcop; + const int oexpect = PL_expect; + +#if { VERSION >= 5.004 } + utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0), + veop, modname, imop); +#elif { VERSION > 5.003 } + utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(), + veop, modname, imop); +#else + utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(), + modname, imop); +#endif + PL_expect = oexpect; + PL_copline = ocopline; + PL_curcop = ocurcop; + } +} + +#endif +#endif + +#ifndef load_module +#if { NEED load_module } + +void +load_module(U32 flags, SV *name, SV *ver, ...) +{ + va_list args; + va_start(args, ver); + vload_module(flags, name, ver, &args); + va_end(args); +} + +#endif +#endif + +=xsinit + +#define NEED_eval_pv +#define NEED_load_module +#define NEED_vload_module + +=xsubs + +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); + mPUSHi(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); + mPUSHi(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); + mPUSHi(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); + mPUSHi(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); + mPUSHi(i); + +void +call_sv_G_METHOD(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 | G_METHOD); + SPAGAIN; + EXTEND(SP, 1); + mPUSHi(i); + +void +load_module(flags, name, version, ...) + U32 flags + SV *name + SV *version + CODE: + /* Both SV parameters are donated to the ops built inside + load_module, so we need to bump the refcounts. */ + Perl_load_module(aTHX_ flags, SvREFCNT_inc_simple(name), + SvREFCNT_inc_simple(version), NULL); + +=tests plan => 52 + +sub eq_array +{ + my($a, $b) = @_; + join(':', @$a) eq join(':', @$b); +} + +sub f +{ + shift; + unshift @_, 'b'; + pop @_; + @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; +} + +my $obj = bless [], 'Foo'; + +sub Foo::meth +{ + return 'bad_self' unless @_ && ref $_[0] && ref($_[0]) eq 'Foo'; + shift; + shift; + unshift @_, 'b'; + pop @_; + @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; +} + +my $test; + +for $test ( + # flags args expected description + [ &Devel::PPPort::G_SCALAR, [ ], [ qw(y 1) ], '0 args, G_SCALAR' ], + [ &Devel::PPPort::G_SCALAR, [ qw(a p q) ], [ qw(y 1) ], '3 args, G_SCALAR' ], + [ &Devel::PPPort::G_ARRAY, [ ], [ qw(x 1) ], '0 args, G_ARRAY' ], + [ &Devel::PPPort::G_ARRAY, [ qw(a p q) ], [ qw(b p x 3) ], '3 args, G_ARRAY' ], + [ &Devel::PPPort::G_DISCARD, [ ], [ qw(0) ], '0 args, G_DISCARD' ], + [ &Devel::PPPort::G_DISCARD, [ qw(a p q) ], [ qw(0) ], '3 args, G_DISCARD' ], +) +{ + my ($flags, $args, $expected, $description) = @$test; + print "# --- $description ---\n"; + ok(eq_array( [ &Devel::PPPort::call_sv(\&f, $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_sv(*f, $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_sv('f', $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_pv('f', $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_argv('f', $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::eval_sv("f(qw(@$args))", $flags) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_method('meth', $flags, $obj, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_sv_G_METHOD('meth', $flags, $obj, @$args) ], $expected)); +}; + +ok(&Devel::PPPort::eval_pv('f()', 0), 'y'); +ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y'); + +ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet"); +Devel::PPPort::load_module(0, "less", undef); +ok(defined $::{'less::'}, 1, "Have now loaded less"); diff --git a/dist/Devel-PPPort/parts/inc/cop b/dist/Devel-PPPort/parts/inc/cop new file mode 100644 index 0000000000..355a2e1aad --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/cop @@ -0,0 +1,231 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +caller_cx +__UNDEFINED__ + +=implementation + +#ifdef USE_ITHREADS + +__UNDEFINED__ CopFILE(c) ((c)->cop_file) +__UNDEFINED__ CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv) +__UNDEFINED__ CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) +__UNDEFINED__ CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) +__UNDEFINED__ CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) +__UNDEFINED__ CopSTASHPV(c) ((c)->cop_stashpv) +__UNDEFINED__ CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) +__UNDEFINED__ CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) +__UNDEFINED__ CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) +__UNDEFINED__ CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \ + || (CopSTASHPV(c) && HvNAME(hv) \ + && strEQ(CopSTASHPV(c), HvNAME(hv))))) + +#else + +__UNDEFINED__ CopFILEGV(c) ((c)->cop_filegv) +__UNDEFINED__ CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) +__UNDEFINED__ CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) +__UNDEFINED__ CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) +__UNDEFINED__ CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) +__UNDEFINED__ CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) +__UNDEFINED__ CopSTASH(c) ((c)->cop_stash) +__UNDEFINED__ CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) +__UNDEFINED__ CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) +__UNDEFINED__ CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) +__UNDEFINED__ CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) + +#endif /* USE_ITHREADS */ + +#if { VERSION >= 5.6.0 } +#ifndef caller_cx + +# if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL) +static I32 +DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) +{ + I32 i; + + for (i = startingblock; i >= 0; i--) { + register const PERL_CONTEXT * const cx = &cxstk[i]; + switch (CxTYPE(cx)) { + default: + continue; + case CXt_EVAL: + case CXt_SUB: + case CXt_FORMAT: + return i; + } + } + return i; +} +# endif + +# if { NEED caller_cx } + +const PERL_CONTEXT * +caller_cx(pTHX_ I32 count, const PERL_CONTEXT **dbcxp) +{ + register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix); + register const PERL_CONTEXT *cx; + register const PERL_CONTEXT *ccstack = cxstack; + const PERL_SI *top_si = PL_curstackinfo; + + for (;;) { + /* we may be in a higher stacklevel, so dig down deeper */ + while (cxix < 0 && top_si->si_type != PERLSI_MAIN) { + top_si = top_si->si_prev; + ccstack = top_si->si_cxstack; + cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix); + } + if (cxix < 0) + return NULL; + /* caller() should not report the automatic calls to &DB::sub */ + if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 && + ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub)) + count++; + if (!count--) + break; + cxix = DPPP_dopoptosub_at(ccstack, cxix - 1); + } + + cx = &ccstack[cxix]; + if (dbcxp) *dbcxp = cx; + + if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { + const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1); + /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the + field below is defined for any cx. */ + /* caller() should not report the automatic calls to &DB::sub */ + if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) + cx = &ccstack[dbcxix]; + } + + return cx; +} + +# endif +#endif /* caller_cx */ +#endif /* 5.6.0 */ + +=xsinit + +#define NEED_caller_cx + +=xsubs + +char * +CopSTASHPV() + CODE: + RETVAL = CopSTASHPV(PL_curcop); + OUTPUT: + RETVAL + +char * +CopFILE() + CODE: + RETVAL = CopFILE(PL_curcop); + OUTPUT: + RETVAL + +#if { VERSION >= 5.6.0 } + +void +caller_cx(level) + I32 level + PREINIT: + const PERL_CONTEXT *cx, *dbcx; + const char *pv; + const GV *gv; + PPCODE: + cx = caller_cx(level, &dbcx); + if (!cx) XSRETURN_EMPTY; + + EXTEND(SP, 4); + + pv = CopSTASHPV(cx->blk_oldcop); + ST(0) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef; + gv = CvGV(cx->blk_sub.cv); + ST(1) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef; + + pv = CopSTASHPV(dbcx->blk_oldcop); + ST(2) = pv ? sv_2mortal(newSVpv(pv, 0)) : &PL_sv_undef; + gv = CvGV(dbcx->blk_sub.cv); + ST(3) = isGV(gv) ? sv_2mortal(newSVpv(GvNAME(gv), 0)) : &PL_sv_undef; + + XSRETURN(4); + +#endif /* 5.6.0 */ + +=tests plan => 28 + +my $package; +{ + package MyPackage; + $package = &Devel::PPPort::CopSTASHPV(); +} +print "# $package\n"; +ok($package, "MyPackage"); + +my $file = &Devel::PPPort::CopFILE(); +print "# $file\n"; +ok($file =~ /cop/i); + +BEGIN { + if ($] < 5.006000) { + # Skip + for (1..28) { + ok(1, 1); + } + exit; + } +} + +BEGIN { + package DB; + no strict "refs"; + local $^P = 1; + sub sub { &$DB::sub } +} + +{ package One; sub one { Devel::PPPort::caller_cx($_[0]) } } +{ + package Two; + sub two { One::one(@_) } + sub dbtwo { + BEGIN { $^P = 1 } + One::one(@_); + BEGIN { $^P = 0 } + } +} + +for ( + # This is rather confusing. The package is the package the call is + # made *from*, the sub name is the sub the call is made *to*. When + # DB::sub is involved the first call is to DB::sub from the calling + # package, the second is to the real sub from package DB. + [\&One::one, 0, qw/main one main one/], + [\&One::one, 2, ], + [\&Two::two, 0, qw/Two one Two one/], + [\&Two::two, 1, qw/main two main two/], + [\&Two::dbtwo, 0, qw/Two sub DB one/], + [\&Two::dbtwo, 1, qw/main dbtwo main dbtwo/], +) { + my ($sub, $arg, @want) = @$_; + my @got = $sub->($arg); + ok(@got, @want); + for (0..$#want) { + ok($got[$_], $want[$_]); + } +} + diff --git a/dist/Devel-PPPort/parts/inc/exception b/dist/Devel-PPPort/parts/inc/exception new file mode 100644 index 0000000000..8dd21cc70f --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/exception @@ -0,0 +1,68 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +dXCPT +XCPT_TRY_START +XCPT_TRY_END +XCPT_CATCH +XCPT_RETHROW + +=implementation + +#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 + +=xsmisc + +/* defined in module3.c */ +int exception(int throw_e); + +=xsubs + +int +exception(throw_e) + int throw_e + OUTPUT: + RETVAL + +=tests plan => 7 + +my $rv; + +$Devel::PPPort::exception_caught = undef; + +$rv = eval { &Devel::PPPort::exception(0) }; +ok($@, ''); +ok(defined $rv); +ok($rv, 42); +ok($Devel::PPPort::exception_caught, 0); + +$Devel::PPPort::exception_caught = undef; + +$rv = eval { &Devel::PPPort::exception(1) }; +ok($@, "boo\n"); +ok(not defined $rv); +ok($Devel::PPPort::exception_caught, 1); diff --git a/dist/Devel-PPPort/parts/inc/format b/dist/Devel-PPPort/parts/inc/format new file mode 100644 index 0000000000..03c632d3ba --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/format @@ -0,0 +1,63 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +/^#\s*define\s+(\w+)/ + +=implementation + +#ifndef IVdf +# if IVSIZE == LONGSIZE +# define IVdf "ld" +# define UVuf "lu" +# define UVof "lo" +# define UVxf "lx" +# define UVXf "lX" +# elif IVSIZE == INTSIZE +# define IVdf "d" +# define UVuf "u" +# define UVof "o" +# define UVxf "x" +# define UVXf "X" +# else +# error "cannot define IV/UV formats" +# endif +#endif + +#ifndef NVef +# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ + defined(PERL_PRIfldbl) && { VERSION != 5.6.0 } + /* Not very likely, but let's try anyway. */ +# define NVef PERL_PRIeldbl +# define NVff PERL_PRIfldbl +# define NVgf PERL_PRIgldbl +# else +# define NVef "e" +# define NVff "f" +# define NVgf "g" +# endif +#endif + +=xsubs + +void +croak_NVgf(num) + NV num + PPCODE: + Perl_croak(aTHX_ "%.20" NVgf "\n", num); + +=tests plan => 1 + +my $num = 1.12345678901234567890; + +eval { Devel::PPPort::croak_NVgf($num) }; +ok($@ =~ /^1.1234567890/); diff --git a/dist/Devel-PPPort/parts/inc/grok b/dist/Devel-PPPort/parts/inc/grok new file mode 100644 index 0000000000..9ca6627f1a --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/grok @@ -0,0 +1,670 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +grok_hex +grok_oct +grok_bin +grok_numeric_radix +grok_number +__UNDEFINED__ + +=implementation + +__UNDEFINED__ IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) +__UNDEFINED__ IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) +__UNDEFINED__ IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) +__UNDEFINED__ IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) + +__UNDEFINED__ IS_NUMBER_IN_UV 0x01 +__UNDEFINED__ IS_NUMBER_GREATER_THAN_UV_MAX 0x02 +__UNDEFINED__ IS_NUMBER_NOT_INT 0x04 +__UNDEFINED__ IS_NUMBER_NEG 0x08 +__UNDEFINED__ IS_NUMBER_INFINITY 0x10 +__UNDEFINED__ IS_NUMBER_NAN 0x20 + +__UNDEFINED__ GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) + +__UNDEFINED__ PERL_SCAN_GREATER_THAN_UV_MAX 0x02 +__UNDEFINED__ PERL_SCAN_SILENT_ILLDIGIT 0x04 +__UNDEFINED__ PERL_SCAN_ALLOW_UNDERSCORES 0x01 +__UNDEFINED__ PERL_SCAN_DISALLOW_PREFIX 0x02 + +#ifndef grok_numeric_radix +#if { NEED grok_numeric_radix } +bool +grok_numeric_radix(pTHX_ const char **sp, const char *send) +{ +#ifdef USE_LOCALE_NUMERIC +#ifdef PL_numeric_radix_sv + if (PL_numeric_radix_sv && IN_LOCALE) { + STRLEN len; + char* radix = SvPV(PL_numeric_radix_sv, len); + if (*sp + len <= send && memEQ(*sp, radix, len)) { + *sp += len; + return TRUE; + } + } +#else + /* older perls don't have PL_numeric_radix_sv so the radix + * must manually be requested from locale.h + */ +#include <locale.h> + dTHR; /* needed for older threaded perls */ + struct lconv *lc = localeconv(); + char *radix = lc->decimal_point; + if (radix && IN_LOCALE) { + STRLEN len = strlen(radix); + if (*sp + len <= send && memEQ(*sp, radix, len)) { + *sp += len; + return TRUE; + } + } +#endif +#endif /* USE_LOCALE_NUMERIC */ + /* always try "." if numeric radix didn't match because + * we may have data from different locales mixed */ + if (*sp < send && **sp == '.') { + ++*sp; + return TRUE; + } + return FALSE; +} +#endif +#endif + +#ifndef grok_number +#if { NEED grok_number } +int +grok_number(pTHX_ const char *pv, STRLEN len, UV *valuep) +{ + const char *s = pv; + const char *send = pv + len; + const UV max_div_10 = UV_MAX / 10; + const char max_mod_10 = UV_MAX % 10; + int numtype = 0; + int sawinf = 0; + int sawnan = 0; + + while (s < send && isSPACE(*s)) + s++; + if (s == send) { + return 0; + } else if (*s == '-') { + s++; + numtype = IS_NUMBER_NEG; + } + else if (*s == '+') + s++; + + if (s == send) + return 0; + + /* next must be digit or the radix separator or beginning of infinity */ + if (isDIGIT(*s)) { + /* UVs are at least 32 bits, so the first 9 decimal digits cannot + overflow. */ + UV value = *s - '0'; + /* This construction seems to be more optimiser friendly. + (without it gcc does the isDIGIT test and the *s - '0' separately) + With it gcc on arm is managing 6 instructions (6 cycles) per digit. + In theory the optimiser could deduce how far to unroll the loop + before checking for overflow. */ + if (++s < send) { + int digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + digit = *s - '0'; + if (digit >= 0 && digit <= 9) { + value = value * 10 + digit; + if (++s < send) { + /* Now got 9 digits, so need to check + each time for overflow. */ + digit = *s - '0'; + while (digit >= 0 && digit <= 9 + && (value < max_div_10 + || (value == max_div_10 + && digit <= max_mod_10))) { + value = value * 10 + digit; + if (++s < send) + digit = *s - '0'; + else + break; + } + if (digit >= 0 && digit <= 9 + && (s < send)) { + /* value overflowed. + skip the remaining digits, don't + worry about setting *valuep. */ + do { + s++; + } while (s < send && isDIGIT(*s)); + numtype |= + IS_NUMBER_GREATER_THAN_UV_MAX; + goto skip_value; + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + } + numtype |= IS_NUMBER_IN_UV; + if (valuep) + *valuep = value; + + skip_value: + if (GROK_NUMERIC_RADIX(&s, send)) { + numtype |= IS_NUMBER_NOT_INT; + while (s < send && isDIGIT(*s)) /* optional digits after the radix */ + s++; + } + } + else if (GROK_NUMERIC_RADIX(&s, send)) { + numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */ + /* no digits before the radix means we need digits after it */ + if (s < send && isDIGIT(*s)) { + do { + s++; + } while (s < send && isDIGIT(*s)); + if (valuep) { + /* integer approximation is valid - it's 0. */ + *valuep = 0; + } + } + else + return 0; + } else if (*s == 'I' || *s == 'i') { + s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; + s++; if (s == send || (*s != 'F' && *s != 'f')) return 0; + s++; if (s < send && (*s == 'I' || *s == 'i')) { + s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; + s++; if (s == send || (*s != 'I' && *s != 'i')) return 0; + s++; if (s == send || (*s != 'T' && *s != 't')) return 0; + s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0; + s++; + } + sawinf = 1; + } else if (*s == 'N' || *s == 'n') { + /* XXX TODO: There are signaling NaNs and quiet NaNs. */ + s++; if (s == send || (*s != 'A' && *s != 'a')) return 0; + s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; + s++; + sawnan = 1; + } else + return 0; + + if (sawinf) { + numtype &= IS_NUMBER_NEG; /* Keep track of sign */ + numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; + } else if (sawnan) { + numtype &= IS_NUMBER_NEG; /* Keep track of sign */ + numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; + } else if (s < send) { + /* we can have an optional exponent part */ + if (*s == 'e' || *s == 'E') { + /* The only flag we keep is sign. Blow away any "it's UV" */ + numtype &= IS_NUMBER_NEG; + numtype |= IS_NUMBER_NOT_INT; + s++; + if (s < send && (*s == '-' || *s == '+')) + s++; + if (s < send && isDIGIT(*s)) { + do { + s++; + } while (s < send && isDIGIT(*s)); + } + else + return 0; + } + } + while (s < send && isSPACE(*s)) + s++; + if (s >= send) + return numtype; + if (len == 10 && memEQ(pv, "0 but true", 10)) { + if (valuep) + *valuep = 0; + return IS_NUMBER_IN_UV; + } + return 0; +} +#endif +#endif + +/* + * The grok_* routines have been modified to use warn() instead of + * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit, + * which is why the stack variable has been renamed to 'xdigit'. + */ + +#ifndef grok_bin +#if { NEED grok_bin } +UV +grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) +{ + const char *s = start; + STRLEN len = *len_p; + UV value = 0; + NV value_nv = 0; + + const UV max_div_2 = UV_MAX / 2; + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; + bool overflowed = FALSE; + + if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { + /* strip off leading b or 0b. + for compatibility silently suffer "b" and "0b" as valid binary + numbers. */ + if (len >= 1) { + if (s[0] == 'b') { + s++; + len--; + } + else if (len >= 2 && s[0] == '0' && s[1] == 'b') { + s+=2; + len-=2; + } + } + } + + for (; len-- && *s; s++) { + char bit = *s; + if (bit == '0' || bit == '1') { + /* Write it in this wonky order with a goto to attempt to get the + compiler to make the common case integer-only loop pretty tight. + With gcc seems to be much straighter code than old scan_bin. */ + redo: + if (!overflowed) { + if (value <= max_div_2) { + value = (value << 1) | (bit - '0'); + continue; + } + /* Bah. We're just overflowed. */ + warn("Integer overflow in binary number"); + overflowed = TRUE; + value_nv = (NV) value; + } + value_nv *= 2.0; + /* If an NV has not enough bits in its mantissa to + * represent a UV this summing of small low-order numbers + * is a waste of time (because the NV cannot preserve + * the low-order bits anyway): we could just remember when + * did we overflow and in the end just multiply value_nv by the + * right amount. */ + value_nv += (NV)(bit - '0'); + continue; + } + if (bit == '_' && len && allow_underscores && (bit = s[1]) + && (bit == '0' || bit == '1')) + { + --len; + ++s; + goto redo; + } + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + warn("Illegal binary digit '%c' ignored", *s); + break; + } + + if ( ( overflowed && value_nv > 4294967295.0) +#if UVSIZE > 4 + || (!overflowed && value > 0xffffffff ) +#endif + ) { + warn("Binary number > 0b11111111111111111111111111111111 non-portable"); + } + *len_p = s - start; + if (!overflowed) { + *flags = 0; + return value; + } + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; + if (result) + *result = value_nv; + return UV_MAX; +} +#endif +#endif + +#ifndef grok_hex +#if { NEED grok_hex } +UV +grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) +{ + const char *s = start; + STRLEN len = *len_p; + UV value = 0; + NV value_nv = 0; + + const UV max_div_16 = UV_MAX / 16; + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; + bool overflowed = FALSE; + const char *xdigit; + + if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { + /* strip off leading x or 0x. + for compatibility silently suffer "x" and "0x" as valid hex numbers. + */ + if (len >= 1) { + if (s[0] == 'x') { + s++; + len--; + } + else if (len >= 2 && s[0] == '0' && s[1] == 'x') { + s+=2; + len-=2; + } + } + } + + for (; len-- && *s; s++) { + xdigit = strchr((char *) PL_hexdigit, *s); + if (xdigit) { + /* Write it in this wonky order with a goto to attempt to get the + compiler to make the common case integer-only loop pretty tight. + With gcc seems to be much straighter code than old scan_hex. */ + redo: + if (!overflowed) { + if (value <= max_div_16) { + value = (value << 4) | ((xdigit - PL_hexdigit) & 15); + continue; + } + warn("Integer overflow in hexadecimal number"); + overflowed = TRUE; + value_nv = (NV) value; + } + value_nv *= 16.0; + /* If an NV has not enough bits in its mantissa to + * represent a UV this summing of small low-order numbers + * is a waste of time (because the NV cannot preserve + * the low-order bits anyway): we could just remember when + * did we overflow and in the end just multiply value_nv by the + * right amount of 16-tuples. */ + value_nv += (NV)((xdigit - PL_hexdigit) & 15); + continue; + } + if (*s == '_' && len && allow_underscores && s[1] + && (xdigit = strchr((char *) PL_hexdigit, s[1]))) + { + --len; + ++s; + goto redo; + } + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + warn("Illegal hexadecimal digit '%c' ignored", *s); + break; + } + + if ( ( overflowed && value_nv > 4294967295.0) +#if UVSIZE > 4 + || (!overflowed && value > 0xffffffff ) +#endif + ) { + warn("Hexadecimal number > 0xffffffff non-portable"); + } + *len_p = s - start; + if (!overflowed) { + *flags = 0; + return value; + } + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; + if (result) + *result = value_nv; + return UV_MAX; +} +#endif +#endif + +#ifndef grok_oct +#if { NEED grok_oct } +UV +grok_oct(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) +{ + const char *s = start; + STRLEN len = *len_p; + UV value = 0; + NV value_nv = 0; + + const UV max_div_8 = UV_MAX / 8; + bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; + bool overflowed = FALSE; + + for (; len-- && *s; s++) { + /* gcc 2.95 optimiser not smart enough to figure that this subtraction + out front allows slicker code. */ + int digit = *s - '0'; + if (digit >= 0 && digit <= 7) { + /* Write it in this wonky order with a goto to attempt to get the + compiler to make the common case integer-only loop pretty tight. + */ + redo: + if (!overflowed) { + if (value <= max_div_8) { + value = (value << 3) | digit; + continue; + } + /* Bah. We're just overflowed. */ + warn("Integer overflow in octal number"); + overflowed = TRUE; + value_nv = (NV) value; + } + value_nv *= 8.0; + /* If an NV has not enough bits in its mantissa to + * represent a UV this summing of small low-order numbers + * is a waste of time (because the NV cannot preserve + * the low-order bits anyway): we could just remember when + * did we overflow and in the end just multiply value_nv by the + * right amount of 8-tuples. */ + value_nv += (NV)digit; + continue; + } + if (digit == ('_' - '0') && len && allow_underscores + && (digit = s[1] - '0') && (digit >= 0 && digit <= 7)) + { + --len; + ++s; + goto redo; + } + /* Allow \octal to work the DWIM way (that is, stop scanning + * as soon as non-octal characters are seen, complain only iff + * someone seems to want to use the digits eight and nine). */ + if (digit == 8 || digit == 9) { + if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) + warn("Illegal octal digit '%c' ignored", *s); + } + break; + } + + if ( ( overflowed && value_nv > 4294967295.0) +#if UVSIZE > 4 + || (!overflowed && value > 0xffffffff ) +#endif + ) { + warn("Octal number > 037777777777 non-portable"); + } + *len_p = s - start; + if (!overflowed) { + *flags = 0; + return value; + } + *flags = PERL_SCAN_GREATER_THAN_UV_MAX; + if (result) + *result = value_nv; + return UV_MAX; +} +#endif +#endif + +=xsinit + +#define NEED_grok_number +#define NEED_grok_numeric_radix +#define NEED_grok_bin +#define NEED_grok_hex +#define NEED_grok_oct + +=xsubs + +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 = 0; + 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 = 0; + 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 = 0; + 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 = 0; + 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 = 0; + 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 = 0; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +=tests plan => 10 + +ok(&Devel::PPPort::grok_number("42"), 42); +ok(!defined(&Devel::PPPort::grok_number("A"))); +ok(&Devel::PPPort::grok_bin("10000001"), 129); +ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef); +ok(&Devel::PPPort::grok_oct("377"), 255); + +ok(&Devel::PPPort::Perl_grok_number("42"), 42); +ok(!defined(&Devel::PPPort::Perl_grok_number("A"))); +ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129); +ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef); +ok(&Devel::PPPort::Perl_grok_oct("377"), 255); diff --git a/dist/Devel-PPPort/parts/inc/gv b/dist/Devel-PPPort/parts/inc/gv new file mode 100644 index 0000000000..d2f526f416 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/gv @@ -0,0 +1,141 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +gv_fetchpvn_flags + +=implementation + +#ifndef gv_fetchpvn_flags +#if { NEED gv_fetchpvn_flags } + +GV* +gv_fetchpvn_flags(pTHX_ const char* name, STRLEN len, int flags, int types) { + char *namepv = savepvn(name, len); + GV* stash = gv_fetchpv(namepv, TRUE, SVt_PVHV); + Safefree(namepv); + return stash; +} + +#endif +#endif + +__UNDEFINED__ GvSVn(gv) GvSV(gv) +__UNDEFINED__ isGV_with_GP(gv) isGV(gv) +__UNDEFINED__ gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt) + +__UNDEFINED__ get_cvn_flags(name, namelen, flags) get_cv(name, flags) +__UNDEFINED__ gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE) + +=xsinit + +#define NEED_gv_fetchpvn_flags + +=xsubs + +int +GvSVn() + PREINIT: + GV* gv; + CODE: + RETVAL = 0; + gv = gv_fetchpvs("Devel::PPPort::GvTest", GV_ADDMULTI, SVt_PVGV); + if (GvSVn(gv) != NULL) + { + RETVAL++; + } + OUTPUT: + RETVAL + +int +isGV_with_GP() + PREINIT: + GV* gv; + CODE: + RETVAL = 0; + gv = gv_fetchpvs("Devel::PPPort::GvTest", GV_ADDMULTI, SVt_PVGV); + if (isGV_with_GP(gv)) + { + RETVAL++; + } + if (!isGV(&PL_sv_undef)) + { + RETVAL++; + } + OUTPUT: + RETVAL + +int +get_cvn_flags() + PREINIT: + CV* xv; + CODE: + RETVAL = 0; + xv = get_cvn_flags("Devel::PPPort::foobar", sizeof("Devel::PPPort::foobar")-1, 0); + if(xv == NULL) RETVAL++; + xv = get_cvn_flags("Devel::PPPort::foobar", sizeof("Devel::PPPort::foobar")-1, GV_ADDMULTI); + if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++; + xv = get_cvn_flags("Devel::PPPort::get_cvn_flags", sizeof("Devel::PPPort::get_cvn_flags")-1, 0); + if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++; + OUTPUT: + RETVAL + +SV* +gv_fetchpvn_flags() + CODE: +#if { VERSION < 5.9.2 } || { VERSION > 5.9.3 } /* 5.9.2 and 5.9.3 ignore the length param */ + RETVAL = newRV_inc((SV*)gv_fetchpvn_flags("Devel::PPPort::VERSIONFAKE", sizeof("Devel::PPPort::VERSIONFAKE")-5, 0, SVt_PV)); +#else + RETVAL = newRV_inc((SV*)gv_fetchpvn_flags("Devel::PPPort::VERSION", 0, 0, SVt_PV)); +#endif + OUTPUT: + RETVAL + +SV* +gv_fetchsv(name) + SV *name + CODE: + RETVAL = newRV_inc((SV*)gv_fetchsv(name, 0, SVt_PV)); + OUTPUT: + RETVAL + +void +gv_init_type(namesv, multi, flags) + SV* namesv + int multi + I32 flags + PREINIT: + HV *defstash = gv_stashpv("main", 0); + STRLEN len; + const char * const name = SvPV_const(namesv, len); + GV *gv = *(GV**)hv_fetch(defstash, name, len, TRUE); + PPCODE: + if (SvTYPE(gv) == SVt_PVGV) + Perl_croak(aTHX_ "GV is already a PVGV"); + if (multi) flags |= GV_ADDMULTI; + gv_init_pvn(gv, defstash, name, len, flags); + XPUSHs( gv ? (SV*)gv : &PL_sv_undef); + +=tests plan => 7 + +ok(Devel::PPPort::GvSVn(), 1); + +ok(Devel::PPPort::isGV_with_GP(), 2); + +ok(Devel::PPPort::get_cvn_flags(), 3); + +ok(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION); + +ok(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION); + +ok(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check"); +ok($::{sanity_check}); diff --git a/dist/Devel-PPPort/parts/inc/limits b/dist/Devel-PPPort/parts/inc/limits new file mode 100644 index 0000000000..778383d9a0 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/limits @@ -0,0 +1,326 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +PERL_UCHAR_MIN +PERL_UCHAR_MAX +PERL_USHORT_MIN +PERL_USHORT_MAX +PERL_SHORT_MAX +PERL_SHORT_MIN +PERL_UINT_MAX +PERL_UINT_MIN +PERL_INT_MAX +PERL_INT_MIN +PERL_ULONG_MAX +PERL_ULONG_MIN +PERL_LONG_MAX +PERL_LONG_MIN +PERL_UQUAD_MAX +PERL_UQUAD_MIN +PERL_QUAD_MAX +PERL_QUAD_MIN +IVSIZE +UVSIZE +IVTYPE +UVTYPE + +=implementation + +#ifdef I_LIMITS +# include <limits.h> +#endif + +#ifndef PERL_UCHAR_MIN +# define PERL_UCHAR_MIN ((unsigned char)0) +#endif + +#ifndef PERL_UCHAR_MAX +# ifdef UCHAR_MAX +# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) +# else +# ifdef MAXUCHAR +# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) +# else +# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) +# endif +# endif +#endif + +#ifndef PERL_USHORT_MIN +# define PERL_USHORT_MIN ((unsigned short)0) +#endif + +#ifndef PERL_USHORT_MAX +# ifdef USHORT_MAX +# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) +# else +# ifdef MAXUSHORT +# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) +# else +# ifdef USHRT_MAX +# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) +# else +# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) +# endif +# endif +# endif +#endif + +#ifndef PERL_SHORT_MAX +# ifdef SHORT_MAX +# define PERL_SHORT_MAX ((short)SHORT_MAX) +# else +# ifdef MAXSHORT /* Often used in <values.h> */ +# define PERL_SHORT_MAX ((short)MAXSHORT) +# else +# ifdef SHRT_MAX +# define PERL_SHORT_MAX ((short)SHRT_MAX) +# else +# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) +# endif +# endif +# endif +#endif + +#ifndef PERL_SHORT_MIN +# ifdef SHORT_MIN +# define PERL_SHORT_MIN ((short)SHORT_MIN) +# else +# ifdef MINSHORT +# define PERL_SHORT_MIN ((short)MINSHORT) +# else +# ifdef SHRT_MIN +# define PERL_SHORT_MIN ((short)SHRT_MIN) +# else +# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) +# endif +# endif +# endif +#endif + +#ifndef PERL_UINT_MAX +# ifdef UINT_MAX +# define PERL_UINT_MAX ((unsigned int)UINT_MAX) +# else +# ifdef MAXUINT +# define PERL_UINT_MAX ((unsigned int)MAXUINT) +# else +# define PERL_UINT_MAX (~(unsigned int)0) +# endif +# endif +#endif + +#ifndef PERL_UINT_MIN +# define PERL_UINT_MIN ((unsigned int)0) +#endif + +#ifndef PERL_INT_MAX +# ifdef INT_MAX +# define PERL_INT_MAX ((int)INT_MAX) +# else +# ifdef MAXINT /* Often used in <values.h> */ +# define PERL_INT_MAX ((int)MAXINT) +# else +# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) +# endif +# endif +#endif + +#ifndef PERL_INT_MIN +# ifdef INT_MIN +# define PERL_INT_MIN ((int)INT_MIN) +# else +# ifdef MININT +# define PERL_INT_MIN ((int)MININT) +# else +# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) +# endif +# endif +#endif + +#ifndef PERL_ULONG_MAX +# ifdef ULONG_MAX +# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) +# else +# ifdef MAXULONG +# define PERL_ULONG_MAX ((unsigned long)MAXULONG) +# else +# define PERL_ULONG_MAX (~(unsigned long)0) +# endif +# endif +#endif + +#ifndef PERL_ULONG_MIN +# define PERL_ULONG_MIN ((unsigned long)0L) +#endif + +#ifndef PERL_LONG_MAX +# ifdef LONG_MAX +# define PERL_LONG_MAX ((long)LONG_MAX) +# else +# ifdef MAXLONG +# define PERL_LONG_MAX ((long)MAXLONG) +# else +# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1)) +# endif +# endif +#endif + +#ifndef PERL_LONG_MIN +# ifdef LONG_MIN +# define PERL_LONG_MIN ((long)LONG_MIN) +# else +# ifdef MINLONG +# define PERL_LONG_MIN ((long)MINLONG) +# else +# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) +# endif +# endif +#endif + +#if defined(HAS_QUAD) && (defined(convex) || defined(uts)) +# ifndef PERL_UQUAD_MAX +# ifdef ULONGLONG_MAX +# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX) +# else +# ifdef MAXULONGLONG +# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG) +# else +# define PERL_UQUAD_MAX (~(unsigned long long)0) +# endif +# endif +# endif + +# ifndef PERL_UQUAD_MIN +# define PERL_UQUAD_MIN ((unsigned long long)0L) +# endif + +# ifndef PERL_QUAD_MAX +# ifdef LONGLONG_MAX +# define PERL_QUAD_MAX ((long long)LONGLONG_MAX) +# else +# ifdef MAXLONGLONG +# define PERL_QUAD_MAX ((long long)MAXLONGLONG) +# else +# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1)) +# endif +# endif +# endif + +# ifndef PERL_QUAD_MIN +# ifdef LONGLONG_MIN +# define PERL_QUAD_MIN ((long long)LONGLONG_MIN) +# else +# ifdef MINLONGLONG +# define PERL_QUAD_MIN ((long long)MINLONGLONG) +# else +# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) +# endif +# endif +# endif +#endif + +/* This is based on code from 5.003 perl.h */ +#ifdef HAS_QUAD +# ifdef cray + __UNDEFINED__ IVTYPE int + __UNDEFINED__ IV_MIN PERL_INT_MIN + __UNDEFINED__ IV_MAX PERL_INT_MAX + __UNDEFINED__ UV_MIN PERL_UINT_MIN + __UNDEFINED__ UV_MAX PERL_UINT_MAX +# ifdef INTSIZE + __UNDEFINED__ IVSIZE INTSIZE +# endif +# else +# if defined(convex) || defined(uts) + __UNDEFINED__ IVTYPE long long + __UNDEFINED__ IV_MIN PERL_QUAD_MIN + __UNDEFINED__ IV_MAX PERL_QUAD_MAX + __UNDEFINED__ UV_MIN PERL_UQUAD_MIN + __UNDEFINED__ UV_MAX PERL_UQUAD_MAX +# ifdef LONGLONGSIZE + __UNDEFINED__ IVSIZE LONGLONGSIZE +# endif +# else + __UNDEFINED__ IVTYPE long + __UNDEFINED__ IV_MIN PERL_LONG_MIN + __UNDEFINED__ IV_MAX PERL_LONG_MAX + __UNDEFINED__ UV_MIN PERL_ULONG_MIN + __UNDEFINED__ UV_MAX PERL_ULONG_MAX +# ifdef LONGSIZE + __UNDEFINED__ IVSIZE LONGSIZE +# endif +# endif +# endif + __UNDEFINED__ IVSIZE 8 + __UNDEFINED__ LONGSIZE 8 + __UNDEFINED__ PERL_QUAD_MIN IV_MIN + __UNDEFINED__ PERL_QUAD_MAX IV_MAX + __UNDEFINED__ PERL_UQUAD_MIN UV_MIN + __UNDEFINED__ PERL_UQUAD_MAX UV_MAX +#else + __UNDEFINED__ IVTYPE long + __UNDEFINED__ LONGSIZE 4 + __UNDEFINED__ IV_MIN PERL_LONG_MIN + __UNDEFINED__ IV_MAX PERL_LONG_MAX + __UNDEFINED__ UV_MIN PERL_ULONG_MIN + __UNDEFINED__ UV_MAX PERL_ULONG_MAX +#endif + +#ifndef IVSIZE +# ifdef LONGSIZE +# define IVSIZE LONGSIZE +# else +# define IVSIZE 4 /* A bold guess, but the best we can make. */ +# endif +#endif + +__UNDEFINED__ UVTYPE unsigned IVTYPE +__UNDEFINED__ UVSIZE IVSIZE + +=xsubs + +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 + +=tests plan => 4 + +ok(&Devel::PPPort::iv_size()); +ok(&Devel::PPPort::uv_size()); +ok(&Devel::PPPort::iv_type()); +ok(&Devel::PPPort::uv_type()); diff --git a/dist/Devel-PPPort/parts/inc/mPUSH b/dist/Devel-PPPort/parts/inc/mPUSH new file mode 100644 index 0000000000..a17972c708 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/mPUSH @@ -0,0 +1,131 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +__UNDEFINED__ + +=implementation + +__UNDEFINED__ mPUSHs(s) PUSHs(sv_2mortal(s)) +__UNDEFINED__ PUSHmortal PUSHs(sv_newmortal()) +__UNDEFINED__ mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l)) +__UNDEFINED__ mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n)) +__UNDEFINED__ mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i)) +__UNDEFINED__ mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u)) + +__UNDEFINED__ mXPUSHs(s) XPUSHs(sv_2mortal(s)) +__UNDEFINED__ XPUSHmortal XPUSHs(sv_newmortal()) +__UNDEFINED__ mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END +__UNDEFINED__ mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END +__UNDEFINED__ mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END +__UNDEFINED__ mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END + +=xsubs + +void +mPUSHs() + PPCODE: + EXTEND(SP, 3); + mPUSHs(newSVpv("foo", 0)); + mPUSHs(newSVpv("bar13", 3)); + mPUSHs(newSViv(42)); + XSRETURN(3); + +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 +mXPUSHs() + PPCODE: + mXPUSHs(newSVpv("foo", 0)); + mXPUSHs(newSVpv("bar13", 3)); + mXPUSHs(newSViv(42)); + 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); + +=tests plan => 10 + +ok(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42"); +ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three"); +ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125"); +ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3"); +ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3"); + +ok(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42"); +ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three"); +ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125"); +ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3"); +ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3"); diff --git a/dist/Devel-PPPort/parts/inc/magic b/dist/Devel-PPPort/parts/inc/magic new file mode 100644 index 0000000000..bf43a9ccdc --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/magic @@ -0,0 +1,613 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +mg_findext +sv_unmagicext + +__UNDEFINED__ +/sv_\w+_mg/ +sv_magic_portable +MUTABLE_PTR +MUTABLE_SV + +=implementation + +__UNDEFINED__ SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END + +/* Some random bits for sv_unmagicext. These should probably be pulled in for + real and organized at some point */ + +__UNDEFINED__ HEf_SVKEY -2 + +#ifndef MUTABLE_PTR +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +# define MUTABLE_PTR(p) ({ void *_p = (p); _p; }) +#else +# define MUTABLE_PTR(p) ((void *) (p)) +#endif +#endif + +__UNDEFINED__ MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p)) + +/* end of random bits */ + +__UNDEFINED__ PERL_MAGIC_sv '\0' +__UNDEFINED__ PERL_MAGIC_overload 'A' +__UNDEFINED__ PERL_MAGIC_overload_elem 'a' +__UNDEFINED__ PERL_MAGIC_overload_table 'c' +__UNDEFINED__ PERL_MAGIC_bm 'B' +__UNDEFINED__ PERL_MAGIC_regdata 'D' +__UNDEFINED__ PERL_MAGIC_regdatum 'd' +__UNDEFINED__ PERL_MAGIC_env 'E' +__UNDEFINED__ PERL_MAGIC_envelem 'e' +__UNDEFINED__ PERL_MAGIC_fm 'f' +__UNDEFINED__ PERL_MAGIC_regex_global 'g' +__UNDEFINED__ PERL_MAGIC_isa 'I' +__UNDEFINED__ PERL_MAGIC_isaelem 'i' +__UNDEFINED__ PERL_MAGIC_nkeys 'k' +__UNDEFINED__ PERL_MAGIC_dbfile 'L' +__UNDEFINED__ PERL_MAGIC_dbline 'l' +__UNDEFINED__ PERL_MAGIC_mutex 'm' +__UNDEFINED__ PERL_MAGIC_shared 'N' +__UNDEFINED__ PERL_MAGIC_shared_scalar 'n' +__UNDEFINED__ PERL_MAGIC_collxfrm 'o' +__UNDEFINED__ PERL_MAGIC_tied 'P' +__UNDEFINED__ PERL_MAGIC_tiedelem 'p' +__UNDEFINED__ PERL_MAGIC_tiedscalar 'q' +__UNDEFINED__ PERL_MAGIC_qr 'r' +__UNDEFINED__ PERL_MAGIC_sig 'S' +__UNDEFINED__ PERL_MAGIC_sigelem 's' +__UNDEFINED__ PERL_MAGIC_taint 't' +__UNDEFINED__ PERL_MAGIC_uvar 'U' +__UNDEFINED__ PERL_MAGIC_uvar_elem 'u' +__UNDEFINED__ PERL_MAGIC_vstring 'V' +__UNDEFINED__ PERL_MAGIC_vec 'v' +__UNDEFINED__ PERL_MAGIC_utf8 'w' +__UNDEFINED__ PERL_MAGIC_substr 'x' +__UNDEFINED__ PERL_MAGIC_defelem 'y' +__UNDEFINED__ PERL_MAGIC_glob '*' +__UNDEFINED__ PERL_MAGIC_arylen '#' +__UNDEFINED__ PERL_MAGIC_pos '.' +__UNDEFINED__ PERL_MAGIC_backref '<' +__UNDEFINED__ PERL_MAGIC_ext '~' + +/* That's the best we can do... */ +__UNDEFINED__ sv_catpvn_nomg sv_catpvn +__UNDEFINED__ sv_catsv_nomg sv_catsv +__UNDEFINED__ sv_setsv_nomg sv_setsv +__UNDEFINED__ sv_pvn_nomg sv_pvn +__UNDEFINED__ SvIV_nomg SvIV +__UNDEFINED__ SvUV_nomg SvUV + +#ifndef sv_catpv_mg +# define sv_catpv_mg(sv, ptr) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_catpv(TeMpSv,ptr); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_catpvn_mg +# define sv_catpvn_mg(sv, ptr, len) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_catpvn(TeMpSv,ptr,len); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_catsv_mg +# define sv_catsv_mg(dsv, ssv) \ + STMT_START { \ + SV *TeMpSv = dsv; \ + sv_catsv(TeMpSv,ssv); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setiv_mg +# define sv_setiv_mg(sv, i) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setiv(TeMpSv,i); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setnv_mg +# define sv_setnv_mg(sv, num) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setnv(TeMpSv,num); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setpv_mg +# define sv_setpv_mg(sv, ptr) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setpv(TeMpSv,ptr); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setpvn_mg +# define sv_setpvn_mg(sv, ptr, len) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setpvn(TeMpSv,ptr,len); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setsv_mg +# define sv_setsv_mg(dsv, ssv) \ + STMT_START { \ + SV *TeMpSv = dsv; \ + sv_setsv(TeMpSv,ssv); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_setuv_mg +# define sv_setuv_mg(sv, i) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_setuv(TeMpSv,i); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +#ifndef sv_usepvn_mg +# define sv_usepvn_mg(sv, ptr, len) \ + STMT_START { \ + SV *TeMpSv = sv; \ + sv_usepvn(TeMpSv,ptr,len); \ + SvSETMAGIC(TeMpSv); \ + } STMT_END +#endif + +__UNDEFINED__ SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL) + +/* Hint: sv_magic_portable + * This is a compatibility function that is only available with + * Devel::PPPort. It is NOT in the perl core. + * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when + * it is being passed a name pointer with namlen == 0. In that + * case, perl 5.8.0 and later store the pointer, not a copy of it. + * The compatibility can be provided back to perl 5.004. With + * earlier versions, the code will not compile. + */ + +#if { VERSION < 5.004 } + + /* code that uses sv_magic_portable will not compile */ + +#elif { VERSION < 5.8.0 } + +# define sv_magic_portable(sv, obj, how, name, namlen) \ + STMT_START { \ + SV *SvMp_sv = (sv); \ + char *SvMp_name = (char *) (name); \ + I32 SvMp_namlen = (namlen); \ + if (SvMp_name && SvMp_namlen == 0) \ + { \ + MAGIC *mg; \ + sv_magic(SvMp_sv, obj, how, 0, 0); \ + mg = SvMAGIC(SvMp_sv); \ + mg->mg_len = -42; /* XXX: this is the tricky part */ \ + mg->mg_ptr = SvMp_name; \ + } \ + else \ + { \ + sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \ + } \ + } STMT_END + +#else + +# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e) + +#endif + +#if !defined(mg_findext) +#if { NEED mg_findext } + +MAGIC * +mg_findext(SV * sv, int type, const MGVTBL *vtbl) { + if (sv) { + MAGIC *mg; + +#ifdef AvPAD_NAMELIST + assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv))); +#endif + + for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) { + if (mg->mg_type == type && mg->mg_virtual == vtbl) + return mg; + } + } + + return NULL; +} + +#endif +#endif + +#if !defined(sv_unmagicext) +#if { NEED sv_unmagicext } + +int +sv_unmagicext(pTHX_ SV *const sv, const int type, MGVTBL *vtbl) +{ + MAGIC* mg; + MAGIC** mgp; + + if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv)) + return 0; + mgp = &(SvMAGIC(sv)); + for (mg = *mgp; mg; mg = *mgp) { + const MGVTBL* const virt = mg->mg_virtual; + if (mg->mg_type == type && virt == vtbl) { + *mgp = mg->mg_moremagic; + if (virt && virt->svt_free) + virt->svt_free(aTHX_ sv, mg); + if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) { + if (mg->mg_len > 0) + Safefree(mg->mg_ptr); + else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */ + SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr)); + else if (mg->mg_type == PERL_MAGIC_utf8) + Safefree(mg->mg_ptr); + } + if (mg->mg_flags & MGf_REFCOUNTED) + SvREFCNT_dec(mg->mg_obj); + Safefree(mg); + } + else + mgp = &mg->mg_moremagic; + } + if (SvMAGIC(sv)) { + if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */ + mg_magical(sv); /* else fix the flags now */ + } + else { + SvMAGICAL_off(sv); + SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + } + return 0; +} + +#endif +#endif + +=xsinit + +#define NEED_mg_findext +#define NEED_sv_unmagicext + +#ifndef STATIC +#define STATIC static +#endif + +STATIC MGVTBL null_mg_vtbl = { + NULL, /* get */ + NULL, /* set */ + NULL, /* len */ + NULL, /* clear */ + NULL, /* free */ +#if MGf_COPY + NULL, /* copy */ +#endif /* MGf_COPY */ +#if MGf_DUP + NULL, /* dup */ +#endif /* MGf_DUP */ +#if MGf_LOCAL + NULL, /* local */ +#endif /* MGf_LOCAL */ +}; + +STATIC MGVTBL other_mg_vtbl = { + NULL, /* get */ + NULL, /* set */ + NULL, /* len */ + NULL, /* clear */ + NULL, /* free */ +#if MGf_COPY + NULL, /* copy */ +#endif /* MGf_COPY */ +#if MGf_DUP + NULL, /* dup */ +#endif /* MGf_DUP */ +#if MGf_LOCAL + NULL, /* local */ +#endif /* MGf_LOCAL */ +}; + +=xsubs + +SV * +new_with_other_mg(package, ...) + SV *package + PREINIT: + HV *self; + HV *stash; + SV *self_ref; + const char *data = "hello\0"; + MAGIC *mg; + CODE: + self = newHV(); + stash = gv_stashpv(SvPV_nolen(package), 0); + + self_ref = newRV_noinc((SV*)self); + + sv_magic((SV*)self, NULL, PERL_MAGIC_ext, data, strlen(data)); + mg = mg_find((SV*)self, PERL_MAGIC_ext); + if (mg) + mg->mg_virtual = &other_mg_vtbl; + else + croak("No mg!"); + + RETVAL = sv_bless(self_ref, stash); + OUTPUT: + RETVAL + +SV * +new_with_mg(package, ...) + SV *package + PREINIT: + HV *self; + HV *stash; + SV *self_ref; + const char *data = "hello\0"; + MAGIC *mg; + CODE: + self = newHV(); + stash = gv_stashpv(SvPV_nolen(package), 0); + + self_ref = newRV_noinc((SV*)self); + + sv_magic((SV*)self, NULL, PERL_MAGIC_ext, data, strlen(data)); + mg = mg_find((SV*)self, PERL_MAGIC_ext); + if (mg) + mg->mg_virtual = &null_mg_vtbl; + else + croak("No mg!"); + + RETVAL = sv_bless(self_ref, stash); + OUTPUT: + RETVAL + +void +remove_null_magic(self) + SV *self + PREINIT: + HV *obj; + PPCODE: + obj = (HV*) SvRV(self); + + sv_unmagicext((SV*)obj, PERL_MAGIC_ext, &null_mg_vtbl); + +void +remove_other_magic(self) + SV *self + PREINIT: + HV *obj; + PPCODE: + obj = (HV*) SvRV(self); + + sv_unmagicext((SV*)obj, PERL_MAGIC_ext, &other_mg_vtbl); + +void +as_string(self) + SV *self + PREINIT: + HV *obj; + MAGIC *mg; + PPCODE: + obj = (HV*) SvRV(self); + + if ((mg = mg_findext((SV*)obj, PERL_MAGIC_ext, &null_mg_vtbl))) { + XPUSHs(sv_2mortal(newSVpv(mg->mg_ptr, strlen(mg->mg_ptr)))); + } else { + XPUSHs(sv_2mortal(newSVpvs("Sorry, your princess is in another castle."))); + } + +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); + +int +SvVSTRING_mg(sv) + SV *sv; + CODE: + RETVAL = SvVSTRING_mg(sv) != NULL; + OUTPUT: + RETVAL + +int +sv_magic_portable(sv) + SV *sv + PREINIT: + MAGIC *mg; + const char *foo = "foo"; + CODE: +#if { VERSION >= 5.004 } + sv_magic_portable(sv, 0, '~', foo, 0); + mg = mg_find(sv, '~'); + if (!mg) + croak("No mg!"); + + RETVAL = mg->mg_ptr == foo; +#else + sv_magic(sv, 0, '~', (char *) foo, strlen(foo)); + mg = mg_find(sv, '~'); + RETVAL = strEQ(mg->mg_ptr, foo); +#endif + sv_unmagic(sv, '~'); + OUTPUT: + RETVAL + +=tests plan => 23 + +# Find proper magic +ok(my $obj1 = Devel::PPPort->new_with_mg()); +ok(Devel::PPPort::as_string($obj1), 'hello'); + +# Find with no magic +my $obj = bless {}, 'Fake::Class'; +ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle."); + +# Find with other magic (not the magic we are looking for) +ok($obj = Devel::PPPort->new_with_other_mg()); +ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle."); + +# Okay, attempt to remove magic that isn't there +Devel::PPPort::remove_other_magic($obj1); +ok(Devel::PPPort::as_string($obj1), 'hello'); + +# Remove magic that IS there +Devel::PPPort::remove_null_magic($obj1); +ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle."); + +# Removing when no magic present +Devel::PPPort::remove_null_magic($obj1); +ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle."); + +use Tie::Hash; +my %h; +tie %h, 'Tie::StdHash'; +$h{foo} = 'foo'; +$h{bar} = ''; + +&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar'); +ok($h{foo}, 'foobar'); + +&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz'); +ok($h{bar}, 'baz'); + +&Devel::PPPort::sv_catsv_mg($h{foo}, '42'); +ok($h{foo}, 'foobar42'); + +&Devel::PPPort::sv_setiv_mg($h{bar}, 42); +ok($h{bar}, 42); + +&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159); +ok(abs($h{PI} - 3.14159) < 0.01); + +&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx'); +ok($h{mhx}, 'mhx'); + +&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus'); +ok($h{mhx}, 'Marcus'); + +&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV'); +ok($h{sv}, 'SV'); + +&Devel::PPPort::sv_setuv_mg($h{sv}, 4711); +ok($h{sv}, 4711); + +&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl'); +ok($h{sv}, 'Perl'); + +# v1 is treated as a bareword in older perls... +my $ver = do { local $SIG{'__WARN__'} = sub {}; eval qq[v1.2.0] }; +ok($] < 5.009 || $@ eq ''); +ok($] < 5.009 || Devel::PPPort::SvVSTRING_mg($ver)); +ok(!Devel::PPPort::SvVSTRING_mg(4711)); + +my $foo = 'bar'; +ok(Devel::PPPort::sv_magic_portable($foo)); +ok($foo eq 'bar'); diff --git a/dist/Devel-PPPort/parts/inc/memory b/dist/Devel-PPPort/parts/inc/memory new file mode 100644 index 0000000000..9a5425e39e --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/memory @@ -0,0 +1,85 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +__UNDEFINED__ + +=implementation + +#ifdef HAS_MEMCMP +__UNDEFINED__ memNE(s1,s2,l) (memcmp(s1,s2,l)) +__UNDEFINED__ memEQ(s1,s2,l) (!memcmp(s1,s2,l)) +#else +__UNDEFINED__ memNE(s1,s2,l) (bcmp(s1,s2,l)) +__UNDEFINED__ memEQ(s1,s2,l) (!bcmp(s1,s2,l)) +#endif + +__UNDEFINED__ memEQs(s1, l, s2) \ + (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1))) +__UNDEFINED__ memNEs(s1, l, s2) !memEQs(s1, l, s2) + +__UNDEFINED__ MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) +__UNDEFINED__ CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) +#ifdef HAS_MEMSET +__UNDEFINED__ ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) +#else +__UNDEFINED__ ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d) +#endif + +__UNDEFINED__ PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)) +__UNDEFINED__ PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) +__UNDEFINED__ PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) +__UNDEFINED__ Poison(d,n,t) PoisonFree(d,n,t) + +__UNDEFINED__ Newx(v,n,t) New(0,v,n,t) +__UNDEFINED__ Newxc(v,n,t,c) Newc(0,v,n,t,c) +__UNDEFINED__ Newxz(v,n,t) Newz(0,v,n,t) + +=xsubs + +int +checkmem() + PREINIT: + char *p; + + CODE: + RETVAL = 0; + Newx(p, 6, char); + CopyD("Hello", p, 6, char); + if (memEQ(p, "Hello", 6)) + RETVAL++; + ZeroD(p, 6, char); + if (memEQ(p, "\0\0\0\0\0\0", 6)) + RETVAL++; + if (memEQs(p, 6, "\0\0\0\0\0\0")) + RETVAL++; + Poison(p, 6, char); + if (memNE(p, "\0\0\0\0\0\0", 6)) + RETVAL++; + if (memNEs(p, 6, "\0\0\0\0\0\0")) + RETVAL++; + Safefree(p); + + Newxz(p, 6, char); + if (memEQ(p, "\0\0\0\0\0\0", 6)) + RETVAL++; + Safefree(p); + + Newxc(p, 3, short, char); + Safefree(p); + + OUTPUT: + RETVAL + +=tests plan => 1 + +ok(Devel::PPPort::checkmem(), 6); diff --git a/dist/Devel-PPPort/parts/inc/misc b/dist/Devel-PPPort/parts/inc/misc new file mode 100644 index 0000000000..181311e5c0 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/misc @@ -0,0 +1,787 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +__UNDEFINED__ +PERL_UNUSED_DECL +PERL_UNUSED_ARG +PERL_UNUSED_VAR +PERL_UNUSED_CONTEXT +PERL_UNUSED_RESULT +PERL_GCC_BRACE_GROUPS_FORBIDDEN +PERL_USE_GCC_BRACE_GROUPS +PERLIO_FUNCS_DECL +PERLIO_FUNCS_CAST +NVTYPE +INT2PTR +PTRV +NUM2PTR +PERL_HASH +PTR2IV +PTR2UV +PTR2NV +PTR2ul +START_EXTERN_C +END_EXTERN_C +EXTERN_C +STMT_START +STMT_END +UTF8_MAXBYTES +WIDEST_UTYPE +XSRETURN +HeUTF8 +C_ARRAY_LENGTH +C_ARRAY_END +SvRX +SvRXOK +PERL_MAGIC_qr +cBOOL +OpHAS_SIBLING +OpSIBLING +OpMORESIB_set +OpLASTSIB_set +OpMAYBESIB_set + +=implementation + +__UNDEFINED__ PERL_MAGIC_qr 'r' + +__UNDEFINED__ cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0) +__UNDEFINED__ OpHAS_SIBLING(o) (cBOOL((o)->op_sibling)) +__UNDEFINED__ OpSIBLING(o) (0 + (o)->op_sibling) +__UNDEFINED__ OpMORESIB_set(o, sib) ((o)->op_sibling = (sib)) +__UNDEFINED__ OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL) +__UNDEFINED__ OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib)) + +#ifndef SvRX +#if { NEED SvRX } + +void * +SvRX(pTHX_ SV *rv) +{ + if (SvROK(rv)) { + SV *sv = SvRV(rv); + if (SvMAGICAL(sv)) { + MAGIC *mg = mg_find(sv, PERL_MAGIC_qr); + if (mg && mg->mg_obj) { + return mg->mg_obj; + } + } + } + return 0; +} +#endif +#endif + +__UNDEFINED__ SvRXOK(sv) (!!SvRX(sv)) + +#ifndef PERL_UNUSED_DECL +# ifdef HASATTRIBUTE +# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) +# define PERL_UNUSED_DECL +# else +# define PERL_UNUSED_DECL __attribute__((unused)) +# endif +# else +# define PERL_UNUSED_DECL +# endif +#endif + +#ifndef PERL_UNUSED_ARG +# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */ +# include <note.h> +# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) +# else +# define PERL_UNUSED_ARG(x) ((void)x) +# endif +#endif + +#ifndef PERL_UNUSED_VAR +# define PERL_UNUSED_VAR(x) ((void)x) +#endif + +#ifndef PERL_UNUSED_CONTEXT +# ifdef USE_ITHREADS +# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) +# else +# define PERL_UNUSED_CONTEXT +# endif +#endif + +#ifndef PERL_UNUSED_RESULT +# if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT) +# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END +# else +# define PERL_UNUSED_RESULT(v) ((void)(v)) +# endif +#endif + +__UNDEFINED__ NOOP /*EMPTY*/(void)0 +__UNDEFINED__ dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL + +#ifndef NVTYPE +# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) +# define NVTYPE long double +# else +# define NVTYPE double +# endif +typedef NVTYPE NV; +#endif + +#ifndef INT2PTR +# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) +# define PTRV UV +# define INT2PTR(any,d) (any)(d) +# else +# if PTRSIZE == LONGSIZE +# define PTRV unsigned long +# else +# define PTRV unsigned +# endif +# define INT2PTR(any,d) (any)(PTRV)(d) +# endif +#endif + +#ifndef PTR2ul +# if PTRSIZE == LONGSIZE +# define PTR2ul(p) (unsigned long)(p) +# else +# define PTR2ul(p) INT2PTR(unsigned long,p) +# endif +#endif + +__UNDEFINED__ PTR2nat(p) (PTRV)(p) +__UNDEFINED__ NUM2PTR(any,d) (any)PTR2nat(d) +__UNDEFINED__ PTR2IV(p) INT2PTR(IV,p) +__UNDEFINED__ PTR2UV(p) INT2PTR(UV,p) +__UNDEFINED__ PTR2NV(p) NUM2PTR(NV,p) + +#undef START_EXTERN_C +#undef END_EXTERN_C +#undef EXTERN_C +#ifdef __cplusplus +# define START_EXTERN_C extern "C" { +# define END_EXTERN_C } +# define EXTERN_C extern "C" +#else +# define START_EXTERN_C +# define END_EXTERN_C +# define EXTERN_C extern +#endif + +#if defined(PERL_GCC_PEDANTIC) +# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN +# define PERL_GCC_BRACE_GROUPS_FORBIDDEN +# endif +#endif + +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) +# ifndef PERL_USE_GCC_BRACE_GROUPS +# define PERL_USE_GCC_BRACE_GROUPS +# endif +#endif + +#undef STMT_START +#undef STMT_END +#ifdef PERL_USE_GCC_BRACE_GROUPS +# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ +# define STMT_END ) +#else +# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) +# define STMT_START if (1) +# define STMT_END else (void)0 +# else +# define STMT_START do +# define STMT_END while (0) +# endif +#endif + +__UNDEFINED__ boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) + +/* DEFSV appears first in 5.004_56 */ +__UNDEFINED__ DEFSV GvSV(PL_defgv) +__UNDEFINED__ SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) +__UNDEFINED__ DEFSV_set(sv) (DEFSV = (sv)) + +/* Older perls (<=5.003) lack AvFILLp */ +__UNDEFINED__ AvFILLp AvFILL + +__UNDEFINED__ ERRSV get_sv("@",FALSE) + +/* Hint: gv_stashpvn + * This function's backport doesn't support the length parameter, but + * rather ignores it. Portability can only be ensured if the length + * parameter is used for speed reasons, but the length can always be + * correctly computed from the string argument. + */ + +__UNDEFINED__ gv_stashpvn(str,len,create) gv_stashpv(str,create) + +/* Replace: 1 */ +__UNDEFINED__ get_cv perl_get_cv +__UNDEFINED__ get_sv perl_get_sv +__UNDEFINED__ get_av perl_get_av +__UNDEFINED__ get_hv perl_get_hv +/* Replace: 0 */ + +__UNDEFINED__ dUNDERBAR dNOOP +__UNDEFINED__ UNDERBAR DEFSV + +__UNDEFINED__ dAX I32 ax = MARK - PL_stack_base + 1 +__UNDEFINED__ dITEMS I32 items = SP - MARK + +__UNDEFINED__ dXSTARG SV * targ = sv_newmortal() + +__UNDEFINED__ dAXMARK I32 ax = POPMARK; \ + register SV ** const mark = PL_stack_base + ax++ + + +__UNDEFINED__ XSprePUSH (sp = PL_stack_base + ax - 1) + +#if { VERSION < 5.005 } +# undef XSRETURN +# define XSRETURN(off) \ + STMT_START { \ + PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ + return; \ + } STMT_END +#endif + +__UNDEFINED__ XSPROTO(name) void name(pTHX_ CV* cv) +__UNDEFINED__ SVfARG(p) ((void*)(p)) + +__UNDEFINED__ PERL_ABS(x) ((x) < 0 ? -(x) : (x)) + +__UNDEFINED__ dVAR dNOOP + +__UNDEFINED__ SVf "_" + +__UNDEFINED__ UTF8_MAXBYTES UTF8_MAXLEN + +__UNDEFINED__ CPERLscope(x) x + +__UNDEFINED__ PERL_HASH(hash,str,len) \ + STMT_START { \ + const char *s_PeRlHaSh = str; \ + I32 i_PeRlHaSh = len; \ + U32 hash_PeRlHaSh = 0; \ + while (i_PeRlHaSh--) \ + hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \ + (hash) = hash_PeRlHaSh; \ + } STMT_END + +#ifndef PERLIO_FUNCS_DECL +# ifdef PERLIO_FUNCS_CONST +# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs +# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs) +# else +# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs +# define PERLIO_FUNCS_CAST(funcs) (funcs) +# endif +#endif + +/* provide these typedefs for older perls */ +#if { VERSION < 5.9.3 } + +# ifdef ARGSproto +typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto); +# else +typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX); +# endif + +typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); + +#endif + +__UNDEFINED__ isPSXSPC(c) (isSPACE(c) || (c) == '\v') +__UNDEFINED__ isBLANK(c) ((c) == ' ' || (c) == '\t') +#ifdef EBCDIC +__UNDEFINED__ isALNUMC(c) isalnum(c) +__UNDEFINED__ isASCII(c) isascii(c) +__UNDEFINED__ isCNTRL(c) iscntrl(c) +__UNDEFINED__ isGRAPH(c) isgraph(c) +__UNDEFINED__ isPRINT(c) isprint(c) +__UNDEFINED__ isPUNCT(c) ispunct(c) +__UNDEFINED__ isXDIGIT(c) isxdigit(c) +#else +# if { VERSION < 5.10.0 } +/* Hint: isPRINT + * The implementation in older perl versions includes all of the + * isSPACE() characters, which is wrong. The version provided by + * Devel::PPPort always overrides a present buggy version. + */ +# undef isPRINT +# endif + +#ifdef HAS_QUAD +# ifdef U64TYPE +# define WIDEST_UTYPE U64TYPE +# else +# define WIDEST_UTYPE Quad_t +# endif +#else +# define WIDEST_UTYPE U32 +#endif + +__UNDEFINED__ isALNUMC(c) (isALPHA(c) || isDIGIT(c)) +__UNDEFINED__ isASCII(c) ((WIDEST_UTYPE) (c) <= 127) +__UNDEFINED__ isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127) +__UNDEFINED__ isGRAPH(c) (isALNUM(c) || isPUNCT(c)) +__UNDEFINED__ isPRINT(c) (((c) >= 32 && (c) < 127)) +__UNDEFINED__ isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126)) +__UNDEFINED__ isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F')) +#endif + +/* Until we figure out how to support this in older perls... */ +#if { VERSION >= 5.8.0 } + +__UNDEFINED__ HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \ + SvUTF8(HeKEY_sv(he)) : \ + (U32)HeKUTF8(he)) + +#endif + +__UNDEFINED__ C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0])) +__UNDEFINED__ C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a)) + +=xsmisc + +typedef XSPROTO(XSPROTO_test_t); +typedef XSPROTO_test_t *XSPROTO_test_t_ptr; + +XS(XS_Devel__PPPort_dXSTARG); /* prototype */ +XS(XS_Devel__PPPort_dXSTARG) +{ + dXSARGS; + dXSTARG; + IV iv; + + PERL_UNUSED_VAR(cv); + SP -= items; + iv = SvIV(ST(0)) + 1; + PUSHi(iv); + XSRETURN(1); +} + +XS(XS_Devel__PPPort_dAXMARK); /* prototype */ +XS(XS_Devel__PPPort_dAXMARK) +{ + dSP; + dAXMARK; + dITEMS; + IV iv; + + PERL_UNUSED_VAR(cv); + SP -= items; + iv = SvIV(ST(0)) - 1; + mPUSHi(iv); + XSRETURN(1); +} + +=xsinit + +#define NEED_SvRX + +=xsboot + +{ + XSPROTO_test_t_ptr p = &XS_Devel__PPPort_dXSTARG; + newXS("Devel::PPPort::dXSTARG", *p, file); +} +newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file); + +=xsubs + +int +OpSIBLING_tests() + PREINIT: + OP *x; + OP *kid; + OP *lastkid; + int count = 0; + int failures = 0; + int i; + CODE: + x = newOP(OP_PUSHMARK, 0); + + /* No siblings yet! */ + if (OpHAS_SIBLING(x) || OpSIBLING(x)) { + failures++; warn("Op should not have had a sib"); + } + + + /* Add 2 siblings */ + kid = x; + + for (i = 0; i < 2; i++) { + OP *newsib = newOP(OP_PUSHMARK, 0); + OpMORESIB_set(kid, newsib); + + kid = OpSIBLING(kid); + lastkid = kid; + } + + /* Should now have a sibling */ + if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) { + failures++; warn("Op should have had a sib after moresib_set"); + } + + /* Count the siblings */ + for (kid = OpSIBLING(x); kid; kid = OpSIBLING(kid)) { + count++; + } + + if (count != 2) { + failures++; warn("Kid had %d sibs, expected 2", count); + } + + if (OpHAS_SIBLING(lastkid) || OpSIBLING(lastkid)) { + failures++; warn("Last kid should not have a sib"); + } + + /* Really sets the parent, and says 'no more siblings' */ + OpLASTSIB_set(x, lastkid); + + if (OpHAS_SIBLING(x) || OpSIBLING(x)) { + failures++; warn("OpLASTSIB_set failed?"); + } + + /* Restore the kid */ + OpMORESIB_set(x, lastkid); + + /* Try to remove it again */ + OpLASTSIB_set(x, NULL); + + if (OpHAS_SIBLING(x) || OpSIBLING(x)) { + failures++; warn("OpLASTSIB_set with NULL failed?"); + } + + /* Try to restore with maybesib_set */ + OpMAYBESIB_set(x, lastkid, NULL); + + if (! OpHAS_SIBLING(x) || ! OpSIBLING(x) ) { + failures++; warn("Op should have had a sib after maybesibset"); + } + + RETVAL = failures; + OUTPUT: + RETVAL + +int +SvRXOK(sv) + SV *sv + CODE: + RETVAL = SvRXOK(sv); + OUTPUT: + RETVAL + +int +ptrtests() + PREINIT: + int var, *p = &var; + + CODE: + RETVAL = 0; + RETVAL += PTR2nat(p) != 0 ? 1 : 0; + RETVAL += PTR2ul(p) != 0UL ? 2 : 0; + RETVAL += PTR2UV(p) != (UV) 0 ? 4 : 0; + RETVAL += PTR2IV(p) != (IV) 0 ? 8 : 0; + RETVAL += PTR2NV(p) != (NV) 0 ? 16 : 0; + RETVAL += p > NUM2PTR(int *, 0) ? 32 : 0; + + OUTPUT: + RETVAL + +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 +xsreturn(two) + int two + PPCODE: + mXPUSHp("test1", 5); + if (two) + mXPUSHp("test2", 5); + if (two) + XSRETURN(2); + else + XSRETURN(1); + +SV* +boolSV(value) + int value + CODE: + RETVAL = newSVsv(boolSV(value)); + OUTPUT: + RETVAL + +SV* +DEFSV() + CODE: + RETVAL = newSVsv(DEFSV); + OUTPUT: + RETVAL + +void +DEFSV_modify() + PPCODE: + XPUSHs(sv_mortalcopy(DEFSV)); + ENTER; + SAVE_DEFSV; + DEFSV_set(newSVpvs("DEFSV")); + XPUSHs(sv_mortalcopy(DEFSV)); + /* Yes, this leaks the above scalar; 5.005 with threads for some reason */ + /* frees it upon LEAVE, thus mortalizing it causes "attempt to free..." */ + /* sv_2mortal(DEFSV); */ + LEAVE; + XPUSHs(sv_mortalcopy(DEFSV)); + XSRETURN(3); + +int +ERRSV() + CODE: + RETVAL = SvTRUE(ERRSV); + OUTPUT: + RETVAL + +SV* +UNDERBAR() + CODE: + { + dUNDERBAR; + RETVAL = newSVsv(UNDERBAR); + } + OUTPUT: + RETVAL + +void +prepush() + CODE: + { + dXSTARG; + XSprePUSH; + PUSHi(42); + XSRETURN(1); + } + +int +PERL_ABS(a) + int a + +void +SVf(x) + SV *x + PPCODE: +#if { VERSION >= 5.004 } + x = sv_2mortal(newSVpvf("[%"SVf"]", SVfARG(x))); +#endif + XPUSHs(x); + XSRETURN(1); + +void +Perl_ppaddr_t(string) + char *string + PREINIT: + Perl_ppaddr_t lower; + PPCODE: + lower = PL_ppaddr[OP_LC]; + mXPUSHs(newSVpv(string, 0)); + PUTBACK; + ENTER; + (void)*(lower)(aTHXR); + SPAGAIN; + LEAVE; + XSRETURN(1); + +#if { VERSION >= 5.8.0 } + +void +check_HeUTF8(utf8_key) + SV *utf8_key; + PREINIT: + HV *hash; + HE *ent; + STRLEN klen; + char *key; + PPCODE: + hash = newHV(); + + key = SvPV(utf8_key, klen); + if (SvUTF8(utf8_key)) klen *= -1; + hv_store(hash, key, klen, newSVpvs("string"), 0); + hv_iterinit(hash); + ent = hv_iternext(hash); + assert(ent); + mXPUSHp((HeUTF8(ent) == 0 ? "norm" : "utf8"), 4); + hv_undef(hash); + + +#endif + +void +check_c_array() + PREINIT: + int x[] = { 10, 11, 12, 13 }; + PPCODE: + mXPUSHi(C_ARRAY_LENGTH(x)); /* 4 */ + mXPUSHi(*(C_ARRAY_END(x)-1)); /* 13 */ + +=tests plan => 48 + +use vars qw($my_sv @my_av %my_hv); + +ok(&Devel::PPPort::boolSV(1)); +ok(!&Devel::PPPort::boolSV(0)); + +$_ = "Fred"; +ok(&Devel::PPPort::DEFSV(), "Fred"); +ok(&Devel::PPPort::UNDERBAR(), "Fred"); + +if ($] >= 5.009002 && $] < 5.023 && $] < 5.023004) { + eval q{ + no warnings "deprecated"; + no if $^V > v5.17.9, warnings => "experimental::lexical_topic"; + my $_ = "Tony"; + ok(&Devel::PPPort::DEFSV(), "Fred"); + ok(&Devel::PPPort::UNDERBAR(), "Tony"); + }; +} +else { + ok(1); + ok(1); +} + +my @r = &Devel::PPPort::DEFSV_modify(); + +ok(@r == 3); +ok($r[0], 'Fred'); +ok($r[1], 'DEFSV'); +ok($r[2], 'Fred'); + +ok(&Devel::PPPort::DEFSV(), "Fred"); + +eval { 1 }; +ok(!&Devel::PPPort::ERRSV()); +eval { cannot_call_this_one() }; +ok(&Devel::PPPort::ERRSV()); + +ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0)); +ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0)); +ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1)); + +$my_sv = 1; +ok(&Devel::PPPort::get_sv('my_sv', 0)); +ok(!&Devel::PPPort::get_sv('not_my_sv', 0)); +ok(&Devel::PPPort::get_sv('not_my_sv', 1)); + +@my_av = (1); +ok(&Devel::PPPort::get_av('my_av', 0)); +ok(!&Devel::PPPort::get_av('not_my_av', 0)); +ok(&Devel::PPPort::get_av('not_my_av', 1)); + +%my_hv = (a=>1); +ok(&Devel::PPPort::get_hv('my_hv', 0)); +ok(!&Devel::PPPort::get_hv('not_my_hv', 0)); +ok(&Devel::PPPort::get_hv('not_my_hv', 1)); + +sub my_cv { 1 }; +ok(&Devel::PPPort::get_cv('my_cv', 0)); +ok(!&Devel::PPPort::get_cv('not_my_cv', 0)); +ok(&Devel::PPPort::get_cv('not_my_cv', 1)); + +ok(Devel::PPPort::dXSTARG(42), 43); +ok(Devel::PPPort::dAXMARK(4711), 4710); + +ok(Devel::PPPort::prepush(), 42); + +ok(join(':', Devel::PPPort::xsreturn(0)), 'test1'); +ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2'); + +ok(Devel::PPPort::PERL_ABS(42), 42); +ok(Devel::PPPort::PERL_ABS(-13), 13); + +ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42'); +ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc'); + +ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo"); + +ok(&Devel::PPPort::ptrtests(), 63); + +ok(&Devel::PPPort::OpSIBLING_tests(), 0); + +if ($] >= 5.009000) { + eval q{ + ok(&Devel::PPPort::check_HeUTF8("hello"), "norm"); + ok(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8"); + }; +} else { + ok(1, 1); + ok(1, 1); +} + +@r = &Devel::PPPort::check_c_array(); +ok($r[0], 4); +ok($r[1], "13"); + +ok(!Devel::PPPort::SvRXOK("")); +ok(!Devel::PPPort::SvRXOK(bless [], "Regexp")); + +if ($] < 5.005) { + skip 'no qr// objects in this perl', 0; + skip 'no qr// objects in this perl', 0; +} else { + my $qr = eval 'qr/./'; + ok(Devel::PPPort::SvRXOK($qr)); + ok(Devel::PPPort::SvRXOK(bless $qr, "Surprise")); +} diff --git a/dist/Devel-PPPort/parts/inc/newCONSTSUB b/dist/Devel-PPPort/parts/inc/newCONSTSUB new file mode 100644 index 0000000000..336a8e00b8 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/newCONSTSUB @@ -0,0 +1,104 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +newCONSTSUB + +=implementation + +/* Hint: newCONSTSUB + * Returns a CV* as of perl-5.7.1. This return value is not supported + * by Devel::PPPort. + */ + +/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */ +#if { VERSION < 5.004_63 } && { VERSION != 5.004_05 } +#if { NEED newCONSTSUB } + +/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */ +/* (There's no PL_parser in perl < 5.005, so this is completely safe) */ +#define D_PPP_PL_copline PL_copline + +void +newCONSTSUB(HV *stash, const char *name, SV *sv) +{ + U32 oldhints = PL_hints; + HV *old_cop_stash = PL_curcop->cop_stash; + HV *old_curstash = PL_curstash; + line_t oldline = PL_curcop->cop_line; + PL_curcop->cop_line = D_PPP_PL_copline; + + PL_hints &= ~HINT_BLOCK_SCOPE; + if (stash) + PL_curstash = PL_curcop->cop_stash = stash; + + newSUB( + +#if { VERSION < 5.003_22 } + start_subparse(), +#elif { VERSION == 5.003_22 } + start_subparse(0), +#else /* 5.003_23 onwards */ + start_subparse(FALSE, 0), +#endif + + newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)), + newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */ + newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) + ); + + PL_hints = oldhints; + PL_curcop->cop_stash = old_cop_stash; + PL_curstash = old_curstash; + PL_curcop->cop_line = oldline; +} +#endif +#endif + +=xsinit + +#define NEED_newCONSTSUB + +=xsmisc + +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); + +=xsubs + +void +call_newCONSTSUB_1() + +void +call_newCONSTSUB_2() + +void +call_newCONSTSUB_3() + +=tests plan => 3 + +&Devel::PPPort::call_newCONSTSUB_1(); +ok(&Devel::PPPort::test_value_1(), 1); + +&Devel::PPPort::call_newCONSTSUB_2(); +ok(&Devel::PPPort::test_value_2(), 2); + +&Devel::PPPort::call_newCONSTSUB_3(); +ok(&Devel::PPPort::test_value_3(), 3); diff --git a/dist/Devel-PPPort/parts/inc/newRV b/dist/Devel-PPPort/parts/inc/newRV new file mode 100644 index 0000000000..6db6dfc54f --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/newRV @@ -0,0 +1,67 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +newRV_inc +newRV_noinc + +=implementation + +__UNDEFINED__ newRV_inc(sv) newRV(sv) /* Replace */ + +#ifndef newRV_noinc +#if { NEED newRV_noinc } +SV * +newRV_noinc(SV *sv) +{ + SV *rv = (SV *)newRV(sv); + SvREFCNT_dec(sv); + return rv; +} +#endif +#endif + +=xsinit + +#define NEED_newRV_noinc + +=xsubs + +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 + +=tests plan => 2 + +ok(&Devel::PPPort::newRV_inc_REFCNT, 1); +ok(&Devel::PPPort::newRV_noinc_REFCNT, 1); diff --git a/dist/Devel-PPPort/parts/inc/newSV_type b/dist/Devel-PPPort/parts/inc/newSV_type new file mode 100644 index 0000000000..039f8010bb --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/newSV_type @@ -0,0 +1,79 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +newSV_type + +=implementation + +#ifndef newSV_type + +#if { NEED newSV_type } + +SV* +newSV_type(pTHX_ svtype const t) +{ + SV* const sv = newSV(0); + sv_upgrade(sv, t); + return sv; +} + +#endif + +#endif + +=xsinit + +#define NEED_newSV_type + +=xsubs + +int +newSV_type() + PREINIT: + SV* sv; + CODE: + RETVAL = 0; + sv = newSV_type(SVt_NULL); + if (SvTYPE(sv) == SVt_NULL) + { + RETVAL++; + } + SvREFCNT_dec(sv); + + sv = newSV_type(SVt_PVIV); + if (SvTYPE(sv) == SVt_PVIV) + { + RETVAL++; + } + SvREFCNT_dec(sv); + + sv = newSV_type(SVt_PVHV); + if (SvTYPE(sv) == SVt_PVHV) + { + RETVAL++; + } + SvREFCNT_dec(sv); + + sv = newSV_type(SVt_PVAV); + if (SvTYPE(sv) == SVt_PVAV) + { + RETVAL++; + } + SvREFCNT_dec(sv); + OUTPUT: + RETVAL + + +=tests plan => 1 + +ok(Devel::PPPort::newSV_type(), 4); diff --git a/dist/Devel-PPPort/parts/inc/newSVpv b/dist/Devel-PPPort/parts/inc/newSVpv new file mode 100644 index 0000000000..513461e514 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/newSVpv @@ -0,0 +1,109 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +__UNDEFINED__ +newSVpvn_flags + +=implementation + +#if { VERSION < 5.6.0 } +# define D_PPP_CONSTPV_ARG(x) ((char *) (x)) +#else +# define D_PPP_CONSTPV_ARG(x) (x) +#endif + +__UNDEFINED__ newSVpvn(data,len) ((data) \ + ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \ + : newSV(0)) + +__UNDEFINED__ newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0) + +__UNDEFINED__ SVf_UTF8 0 + +#ifndef newSVpvn_flags + +#if { NEED newSVpvn_flags } + +SV * +newSVpvn_flags(pTHX_ const char *s, STRLEN len, U32 flags) +{ + SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len); + SvFLAGS(sv) |= (flags & SVf_UTF8); + return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv; +} + +#endif + +#endif + +=xsinit + +#define NEED_newSVpvn_flags + +=xsubs + +void +newSVpvn() + PPCODE: + mXPUSHs(newSVpvn("test", 4)); + mXPUSHs(newSVpvn("test", 2)); + mXPUSHs(newSVpvn("test", 0)); + mXPUSHs(newSVpvn(NULL, 2)); + mXPUSHs(newSVpvn(NULL, 0)); + XSRETURN(5); + +void +newSVpvn_flags() + PPCODE: + XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP)); + XPUSHs(newSVpvn_flags("test", 2, SVs_TEMP)); + XPUSHs(newSVpvn_flags("test", 0, SVs_TEMP)); + XPUSHs(newSVpvn_flags(NULL, 2, SVs_TEMP)); + XPUSHs(newSVpvn_flags(NULL, 0, SVs_TEMP)); + XSRETURN(5); + +void +newSVpvn_utf8() + PPCODE: + XPUSHs(newSVpvn_flags("test", 4, SVs_TEMP|SVf_UTF8)); + XSRETURN(1); + +=tests plan => 15 + +my @s = &Devel::PPPort::newSVpvn(); +ok(@s == 5); +ok($s[0], "test"); +ok($s[1], "te"); +ok($s[2], ""); +ok(!defined($s[3])); +ok(!defined($s[4])); + +@s = &Devel::PPPort::newSVpvn_flags(); +ok(@s == 5); +ok($s[0], "test"); +ok($s[1], "te"); +ok($s[2], ""); +ok(!defined($s[3])); +ok(!defined($s[4])); + +@s = &Devel::PPPort::newSVpvn_utf8(); +ok(@s == 1); +ok($s[0], "test"); + +if ($] >= 5.008001) { + require utf8; + ok(utf8::is_utf8($s[0])); +} +else { + skip("skip: no is_utf8()", 0); +} diff --git a/dist/Devel-PPPort/parts/inc/podtest b/dist/Devel-PPPort/parts/inc/podtest new file mode 100644 index 0000000000..d7255b916f --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/podtest @@ -0,0 +1,45 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=tests plan => 0 + +my @pods = qw( HACKERS PPPort.pm ppport.h soak devel/regenerate devel/buildperl.pl ); + +my $reason = ''; + +if ($ENV{'SKIP_SLOW_TESTS'}) { + $reason = 'SKIP_SLOW_TESTS'; +} +else { + # Try loading Test::Pod + eval q{ + use Test::Pod; + $Test::Pod::VERSION >= 0.95 + or die "Test::Pod version only $Test::Pod::VERSION"; + import Test::Pod tests => scalar @pods; + }; + $reason = 'Test::Pod >= 0.95 required' if $@; +} + +if ($reason) { + load(); + plan(tests => scalar @pods); +} + +for (@pods) { + print "# checking $_\n"; + if ($reason) { + skip("skip: $reason", 0); + } + else { + pod_file_ok($_); + } +} diff --git a/dist/Devel-PPPort/parts/inc/ppphbin b/dist/Devel-PPPort/parts/inc/ppphbin new file mode 100644 index 0000000000..82ebdccb33 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/ppphbin @@ -0,0 +1,822 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +=implementation + +use strict; + +# Disable broken TRIE-optimization +BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 } + +my $VERSION = __VERSION__; + +my %opt = ( + quiet => 0, + diag => 1, + hints => 1, + changes => 1, + cplusplus => 0, + filter => 1, + strip => 0, + version => 0, +); + +my($ppport) = $0 =~ /([\w.]+)$/; +my $LF = '(?:\r\n|[\r\n])'; # line feed +my $HS = "[ \t]"; # horizontal whitespace + +# Never use C comments in this file! +my $ccs = '/'.'*'; +my $cce = '*'.'/'; +my $rccs = quotemeta $ccs; +my $rcce = quotemeta $cce; + +eval { + require Getopt::Long; + Getopt::Long::GetOptions(\%opt, qw( + help quiet diag! filter! hints! changes! cplusplus strip version + patch=s copy=s diff=s compat-version=s + list-provided list-unsupported api-info=s + )) or usage(); +}; + +if ($@ and grep /^-/, @ARGV) { + usage() if "@ARGV" =~ /^--?h(?:elp)?$/; + die "Getopt::Long not found. Please don't use any options.\n"; +} + +if ($opt{version}) { + print "This is $0 $VERSION.\n"; + exit 0; +} + +usage() if $opt{help}; +strip() if $opt{strip}; + +if (exists $opt{'compat-version'}) { + my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) }; + if ($@) { + die "Invalid version number format: '$opt{'compat-version'}'\n"; + } + die "Only Perl 5 is supported\n" if $r != 5; + die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000; + $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s; +} +else { + $opt{'compat-version'} = 5; +} + +my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/ + ? ( $1 => { + ($2 ? ( base => $2 ) : ()), + ($3 ? ( todo => $3 ) : ()), + (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()), + (index($4, 'p') >= 0 ? ( provided => 1 ) : ()), + (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()), + } ) + : die "invalid spec: $_" } qw( +__PERL_API__ +); + +if (exists $opt{'list-unsupported'}) { + my $f; + for $f (sort { lc $a cmp lc $b } keys %API) { + next unless $API{$f}{todo}; + print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n"; + } + exit 0; +} + +# Scan for possible replacement candidates + +my(%replace, %need, %hints, %warnings, %depends); +my $replace = 0; +my($hint, $define, $function); + +sub find_api +{ + my $code = shift; + $code =~ s{ + / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*) + | "[^"\\]*(?:\\.[^"\\]*)*" + | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx; + grep { exists $API{$_} } $code =~ /(\w+)/mg; +} + +while (<DATA>) { + if ($hint) { + my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings; + if (m{^\s*\*\s(.*?)\s*$}) { + for (@{$hint->[1]}) { + $h->{$_} ||= ''; # suppress warning with older perls + $h->{$_} .= "$1\n"; + } + } + else { undef $hint } + } + + $hint = [$1, [split /,?\s+/, $2]] + if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$}; + + if ($define) { + if ($define->[1] =~ /\\$/) { + $define->[1] .= $_; + } + else { + if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) { + my @n = find_api($define->[1]); + push @{$depends{$define->[0]}}, @n if @n + } + undef $define; + } + } + + $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)}; + + if ($function) { + if (/^}/) { + if (exists $API{$function->[0]}) { + my @n = find_api($function->[1]); + push @{$depends{$function->[0]}}, @n if @n + } + undef $function; + } + else { + $function->[1] .= $_; + } + } + + $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)}; + + $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$}; + $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)}; + $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce}; + $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$}; + + if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) { + my @deps = map { s/\s+//g; $_ } split /,/, $3; + my $d; + for $d (map { s/\s+//g; $_ } split /,/, $1) { + push @{$depends{$d}}, @deps; + } + } + + $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)}; +} + +for (values %depends) { + my %s; + $_ = [sort grep !$s{$_}++, @$_]; +} + +if (exists $opt{'api-info'}) { + my $f; + my $count = 0; + my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$"; + for $f (sort { lc $a cmp lc $b } keys %API) { + next unless $f =~ /$match/; + print "\n=== $f ===\n\n"; + my $info = 0; + if ($API{$f}{base} || $API{$f}{todo}) { + my $base = format_version($API{$f}{base} || $API{$f}{todo}); + print "Supported at least starting from perl-$base.\n"; + $info++; + } + if ($API{$f}{provided}) { + my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "__MIN_PERL__"; + print "Support by $ppport provided back to perl-$todo.\n"; + print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f}; + print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f}; + print "\n$hints{$f}" if exists $hints{$f}; + print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f}; + $info++; + } + print "No portability information available.\n" unless $info; + $count++; + } + $count or print "Found no API matching '$opt{'api-info'}'."; + print "\n"; + exit 0; +} + +if (exists $opt{'list-provided'}) { + my $f; + for $f (sort { lc $a cmp lc $b } keys %API) { + next unless $API{$f}{provided}; + my @flags; + push @flags, 'explicit' if exists $need{$f}; + push @flags, 'depend' if exists $depends{$f}; + push @flags, 'hint' if exists $hints{$f}; + push @flags, 'warning' if exists $warnings{$f}; + my $flags = @flags ? ' ['.join(', ', @flags).']' : ''; + print "$f$flags\n"; + } + exit 0; +} + +my @files; +my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc ); +my $srcext = join '|', map { quotemeta $_ } @srcext; + +if (@ARGV) { + my %seen; + for (@ARGV) { + if (-e) { + if (-f) { + push @files, $_ unless $seen{$_}++; + } + else { warn "'$_' is not a file.\n" } + } + else { + my @new = grep { -f } glob $_ + or warn "'$_' does not exist.\n"; + push @files, grep { !$seen{$_}++ } @new; + } + } +} +else { + eval { + require File::Find; + File::Find::find(sub { + $File::Find::name =~ /($srcext)$/i + and push @files, $File::Find::name; + }, '.'); + }; + if ($@) { + @files = map { glob "*$_" } @srcext; + } +} + +if (!@ARGV || $opt{filter}) { + my(@in, @out); + my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files; + for (@files) { + my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i; + push @{ $out ? \@out : \@in }, $_; + } + if (@ARGV && @out) { + warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out); + } + @files = @in; +} + +die "No input files given!\n" unless @files; + +my(%files, %global, %revreplace); +%revreplace = reverse %replace; +my $filename; +my $patch_opened = 0; + +for $filename (@files) { + unless (open IN, "<$filename") { + warn "Unable to read from $filename: $!\n"; + next; + } + + info("Scanning $filename ..."); + + my $c = do { local $/; <IN> }; + close IN; + + my %file = (orig => $c, changes => 0); + + # Temporarily remove C/XS comments and strings from the code + my @ccom; + + $c =~ s{ + ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]* + | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* ) + | ( ^$HS*\#[^\r\n]* + | "[^"\\]*(?:\\.[^"\\]*)*" + | '[^'\\]*(?:\\.[^'\\]*)*' + | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) ) + }{ defined $2 and push @ccom, $2; + defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex; + + $file{ccom} = \@ccom; + $file{code} = $c; + $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m; + + my $func; + + for $func (keys %API) { + my $match = $func; + $match .= "|$revreplace{$func}" if exists $revreplace{$func}; + if ($c =~ /\b(?:Perl_)?($match)\b/) { + $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func}; + $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/; + if (exists $API{$func}{provided}) { + $file{uses_provided}{$func}++; + if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) { + $file{uses}{$func}++; + my @deps = rec_depend($func); + if (@deps) { + $file{uses_deps}{$func} = \@deps; + for (@deps) { + $file{uses}{$_} = 0 unless exists $file{uses}{$_}; + } + } + for ($func, @deps) { + $file{needs}{$_} = 'static' if exists $need{$_}; + } + } + } + if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) { + if ($c =~ /\b$func\b/) { + $file{uses_todo}{$func}++; + } + } + } + } + + while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) { + if (exists $need{$2}) { + $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++; + } + else { warning("Possibly wrong #define $1 in $filename") } + } + + for (qw(uses needs uses_todo needed_global needed_static)) { + for $func (keys %{$file{$_}}) { + push @{$global{$_}{$func}}, $filename; + } + } + + $files{$filename} = \%file; +} + +# Globally resolve NEED_'s +my $need; +for $need (keys %{$global{needs}}) { + if (@{$global{needs}{$need}} > 1) { + my @targets = @{$global{needs}{$need}}; + my @t = grep $files{$_}{needed_global}{$need}, @targets; + @targets = @t if @t; + @t = grep /\.xs$/i, @targets; + @targets = @t if @t; + my $target = shift @targets; + $files{$target}{needs}{$need} = 'global'; + for (@{$global{needs}{$need}}) { + $files{$_}{needs}{$need} = 'extern' if $_ ne $target; + } + } +} + +for $filename (@files) { + exists $files{$filename} or next; + + info("=== Analyzing $filename ==="); + + my %file = %{$files{$filename}}; + my $func; + my $c = $file{code}; + my $warnings = 0; + + for $func (sort keys %{$file{uses_Perl}}) { + if ($API{$func}{varargs}) { + unless ($API{$func}{nothxarg}) { + my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))} + { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge); + if ($changes) { + warning("Doesn't pass interpreter argument aTHX to Perl_$func"); + $file{changes} += $changes; + } + } + } + else { + warning("Uses Perl_$func instead of $func"); + $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*} + {$func$1(}g); + } + } + + for $func (sort keys %{$file{uses_replace}}) { + warning("Uses $func instead of $replace{$func}"); + $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); + } + + for $func (sort keys %{$file{uses_provided}}) { + if ($file{uses}{$func}) { + if (exists $file{uses_deps}{$func}) { + diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}})); + } + else { + diag("Uses $func"); + } + } + $warnings += hint($func); + } + + unless ($opt{quiet}) { + for $func (sort keys %{$file{uses_todo}}) { + print "*** WARNING: Uses $func, which may not be portable below perl ", + format_version($API{$func}{todo}), ", even with '$ppport'\n"; + $warnings++; + } + } + + for $func (sort keys %{$file{needed_static}}) { + my $message = ''; + if (not exists $file{uses}{$func}) { + $message = "No need to define NEED_$func if $func is never used"; + } + elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') { + $message = "No need to define NEED_$func when already needed globally"; + } + if ($message) { + diag($message); + $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg); + } + } + + for $func (sort keys %{$file{needed_global}}) { + my $message = ''; + if (not exists $global{uses}{$func}) { + $message = "No need to define NEED_${func}_GLOBAL if $func is never used"; + } + elsif (exists $file{needs}{$func}) { + if ($file{needs}{$func} eq 'extern') { + $message = "No need to define NEED_${func}_GLOBAL when already needed globally"; + } + elsif ($file{needs}{$func} eq 'static') { + $message = "No need to define NEED_${func}_GLOBAL when only used in this file"; + } + } + if ($message) { + diag($message); + $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg); + } + } + + $file{needs_inc_ppport} = keys %{$file{uses}}; + + if ($file{needs_inc_ppport}) { + my $pp = ''; + + for $func (sort keys %{$file{needs}}) { + my $type = $file{needs}{$func}; + next if $type eq 'extern'; + my $suffix = $type eq 'global' ? '_GLOBAL' : ''; + unless (exists $file{"needed_$type"}{$func}) { + if ($type eq 'global') { + diag("Files [@{$global{needs}{$func}}] need $func, adding global request"); + } + else { + diag("File needs $func, adding static request"); + } + $pp .= "#define NEED_$func$suffix\n"; + } + } + + if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) { + $pp = ''; + $file{changes}++; + } + + unless ($file{has_inc_ppport}) { + diag("Needs to include '$ppport'"); + $pp .= qq(#include "$ppport"\n) + } + + if ($pp) { + $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms) + || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m) + || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m) + || ($c =~ s/^/$pp/); + } + } + else { + if ($file{has_inc_ppport}) { + diag("No need to include '$ppport'"); + $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m); + } + } + + # put back in our C comments + my $ix; + my $cppc = 0; + my @ccom = @{$file{ccom}}; + for $ix (0 .. $#ccom) { + if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) { + $cppc++; + $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/; + } + else { + $c =~ s/$rccs$ix$rcce/$ccom[$ix]/; + } + } + + if ($cppc) { + my $s = $cppc != 1 ? 's' : ''; + warning("Uses $cppc C++ style comment$s, which is not portable"); + } + + my $s = $warnings != 1 ? 's' : ''; + my $warn = $warnings ? " ($warnings warning$s)" : ''; + info("Analysis completed$warn"); + + if ($file{changes}) { + if (exists $opt{copy}) { + my $newfile = "$filename$opt{copy}"; + if (-e $newfile) { + error("'$newfile' already exists, refusing to write copy of '$filename'"); + } + else { + local *F; + if (open F, ">$newfile") { + info("Writing copy of '$filename' with changes to '$newfile'"); + print F $c; + close F; + } + else { + error("Cannot open '$newfile' for writing: $!"); + } + } + } + elsif (exists $opt{patch} || $opt{changes}) { + if (exists $opt{patch}) { + unless ($patch_opened) { + if (open PATCH, ">$opt{patch}") { + $patch_opened = 1; + } + else { + error("Cannot open '$opt{patch}' for writing: $!"); + delete $opt{patch}; + $opt{changes} = 1; + goto fallback; + } + } + mydiff(\*PATCH, $filename, $c); + } + else { +fallback: + info("Suggested changes:"); + mydiff(\*STDOUT, $filename, $c); + } + } + else { + my $s = $file{changes} == 1 ? '' : 's'; + info("$file{changes} potentially required change$s detected"); + } + } + else { + info("Looks good"); + } +} + +close PATCH if $patch_opened; + +exit 0; + +####################################################################### + +sub try_use { eval "use @_;"; return $@ eq '' } + +sub mydiff +{ + local *F = shift; + my($file, $str) = @_; + my $diff; + + if (exists $opt{diff}) { + $diff = run_diff($opt{diff}, $file, $str); + } + + if (!defined $diff and try_use('Text::Diff')) { + $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' }); + $diff = <<HEADER . $diff; +--- $file ++++ $file.patched +HEADER + } + + if (!defined $diff) { + $diff = run_diff('diff -u', $file, $str); + } + + if (!defined $diff) { + $diff = run_diff('diff', $file, $str); + } + + if (!defined $diff) { + error("Cannot generate a diff. Please install Text::Diff or use --copy."); + return; + } + + print F $diff; +} + +sub run_diff +{ + my($prog, $file, $str) = @_; + my $tmp = 'dppptemp'; + my $suf = 'aaa'; + my $diff = ''; + local *F; + + while (-e "$tmp.$suf") { $suf++ } + $tmp = "$tmp.$suf"; + + if (open F, ">$tmp") { + print F $str; + close F; + + if (open F, "$prog $file $tmp |") { + while (<F>) { + s/\Q$tmp\E/$file.patched/; + $diff .= $_; + } + close F; + unlink $tmp; + return $diff; + } + + unlink $tmp; + } + else { + error("Cannot open '$tmp' for writing: $!"); + } + + return undef; +} + +sub rec_depend +{ + my($func, $seen) = @_; + return () unless exists $depends{$func}; + $seen = {%{$seen||{}}}; + return () if $seen->{$func}++; + my %s; + grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}}; +} + +sub parse_version +{ + my $ver = shift; + + if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { + return ($1, $2, $3); + } + elsif ($ver !~ /^\d+\.[\d_]+$/) { + die "cannot parse version '$ver'\n"; + } + + $ver =~ s/_//g; + $ver =~ s/$/000000/; + + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; + + $v = int $v; + $s = int $s; + + if ($r < 5 || ($r == 5 && $v < 6)) { + if ($s % 10) { + die "cannot parse version '$ver'\n"; + } + } + + return ($r, $v, $s); +} + +sub format_version +{ + my $ver = shift; + + $ver =~ s/$/000000/; + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; + + $v = int $v; + $s = int $s; + + if ($r < 5 || ($r == 5 && $v < 6)) { + if ($s % 10) { + die "invalid version '$ver'\n"; + } + $s /= 10; + + $ver = sprintf "%d.%03d", $r, $v; + $s > 0 and $ver .= sprintf "_%02d", $s; + + return $ver; + } + + return sprintf "%d.%d.%d", $r, $v, $s; +} + +sub info +{ + $opt{quiet} and return; + print @_, "\n"; +} + +sub diag +{ + $opt{quiet} and return; + $opt{diag} and print @_, "\n"; +} + +sub warning +{ + $opt{quiet} and return; + print "*** ", @_, "\n"; +} + +sub error +{ + print "*** ERROR: ", @_, "\n"; +} + +my %given_hints; +my %given_warnings; +sub hint +{ + $opt{quiet} and return; + my $func = shift; + my $rv = 0; + if (exists $warnings{$func} && !$given_warnings{$func}++) { + my $warn = $warnings{$func}; + $warn =~ s!^!*** !mg; + print "*** WARNING: $func\n", $warn; + $rv++; + } + if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) { + my $hint = $hints{$func}; + $hint =~ s/^/ /mg; + print " --- hint for $func ---\n", $hint; + } + $rv; +} + +sub usage +{ + my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms; + my %M = ( 'I' => '*' ); + $usage =~ s/^\s*perl\s+\S+/$^X $0/; + $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g; + + print <<ENDUSAGE; + +Usage: $usage + +See perldoc $0 for details. + +ENDUSAGE + + exit 2; +} + +sub strip +{ + my $self = do { local(@ARGV,$/)=($0); <> }; + my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms; + $copy =~ s/^(?=\S+)/ /gms; + $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms; + $self =~ s/^SKIP.*(?=^__DATA__)/SKIP +if (\@ARGV && \$ARGV[0] eq '--unstrip') { + eval { require Devel::PPPort }; + \$@ and die "Cannot require Devel::PPPort, please install.\\n"; + if (eval \$Devel::PPPort::VERSION < $VERSION) { + die "$0 was originally generated with Devel::PPPort $VERSION.\\n" + . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n" + . "Please install a newer version, or --unstrip will not work.\\n"; + } + Devel::PPPort::WriteFile(\$0); + exit 0; +} +print <<END; + +Sorry, but this is a stripped version of \$0. + +To be able to use its original script and doc functionality, +please try to regenerate this file using: + + \$^X \$0 --unstrip + +END +/ms; + my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms; + $c =~ s{ + / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*) + | ( "[^"\\]*(?:\\.[^"\\]*)*" + | '[^'\\]*(?:\\.[^'\\]*)*' ) + | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex; + $c =~ s!\s+$!!mg; + $c =~ s!^$LF!!mg; + $c =~ s!^\s*#\s*!#!mg; + $c =~ s!^\s+!!mg; + + open OUT, ">$0" or die "cannot strip $0: $!\n"; + print OUT "$pl$c\n"; + + exit 0; +} diff --git a/dist/Devel-PPPort/parts/inc/ppphdoc b/dist/Devel-PPPort/parts/inc/ppphdoc new file mode 100644 index 0000000000..2b4d857470 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/ppphdoc @@ -0,0 +1,346 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +=dontwarn + +NEED_function +NEED_function_GLOBAL +NEED_variable +NEED_variable_GLOBAL +DPPP_NAMESPACE + +=implementation + +=pod + +=head1 NAME + +ppport.h - Perl/Pollution/Portability version __VERSION__ + +=head1 SYNOPSIS + + perl ppport.h [options] [source files] + + Searches current directory for files if no [source files] are given + + --help show short help + + --version show version + + --patch=file write one patch file with changes + --copy=suffix write changed copies with suffix + --diff=program use diff program and options + + --compat-version=version provide compatibility with Perl version + --cplusplus accept C++ comments + + --quiet don't output anything except fatal errors + --nodiag don't show diagnostics + --nohints don't show hints + --nochanges don't suggest changes + --nofilter don't filter input files + + --strip strip all script and doc functionality + from ppport.h + + --list-provided list provided API + --list-unsupported list unsupported API + --api-info=name show Perl API portability information + +=head1 COMPATIBILITY + +This version of F<ppport.h> is designed to support operation with Perl +installations back to __MIN_PERL__, and has been tested up to __MAX_PERL__. + +=head1 OPTIONS + +=head2 --help + +Display a brief usage summary. + +=head2 --version + +Display the version of F<ppport.h>. + +=head2 --patch=I<file> + +If this option is given, a single patch file will be created if +any changes are suggested. This requires a working diff program +to be installed on your system. + +=head2 --copy=I<suffix> + +If this option is given, a copy of each file will be saved with +the given suffix that contains the suggested changes. This does +not require any external programs. Note that this does not +automagically add a dot between the original filename and the +suffix. If you want the dot, you have to include it in the option +argument. + +If neither C<--patch> or C<--copy> are given, the default is to +simply print the diffs for each file. This requires either +C<Text::Diff> or a C<diff> program to be installed. + +=head2 --diff=I<program> + +Manually set the diff program and options to use. The default +is to use C<Text::Diff>, when installed, and output unified +context diffs. + +=head2 --compat-version=I<version> + +Tell F<ppport.h> to check for compatibility with the given +Perl version. The default is to check for compatibility with Perl +version __MIN_PERL__. You can use this option to reduce the output +of F<ppport.h> if you intend to be backward compatible only +down to a certain Perl version. + +=head2 --cplusplus + +Usually, F<ppport.h> will detect C++ style comments and +replace them with C style comments for portability reasons. +Using this option instructs F<ppport.h> to leave C++ +comments untouched. + +=head2 --quiet + +Be quiet. Don't print anything except fatal errors. + +=head2 --nodiag + +Don't output any diagnostic messages. Only portability +alerts will be printed. + +=head2 --nohints + +Don't output any hints. Hints often contain useful portability +notes. Warnings will still be displayed. + +=head2 --nochanges + +Don't suggest any changes. Only give diagnostic output and hints +unless these are also deactivated. + +=head2 --nofilter + +Don't filter the list of input files. By default, files not looking +like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped. + +=head2 --strip + +Strip all script and documentation functionality from F<ppport.h>. +This reduces the size of F<ppport.h> dramatically and may be useful +if you want to include F<ppport.h> in smaller modules without +increasing their distribution size too much. + +The stripped F<ppport.h> will have a C<--unstrip> option that allows +you to undo the stripping, but only if an appropriate C<Devel::PPPort> +module is installed. + +=head2 --list-provided + +Lists the API elements for which compatibility is provided by +F<ppport.h>. Also lists if it must be explicitly requested, +if it has dependencies, and if there are hints or warnings for it. + +=head2 --list-unsupported + +Lists the API elements that are known not to be supported by +F<ppport.h> and below which version of Perl they probably +won't be available or work. + +=head2 --api-info=I<name> + +Show portability information for API elements matching I<name>. +If I<name> is surrounded by slashes, it is interpreted as a regular +expression. + +=head1 DESCRIPTION + +In order for a Perl extension (XS) module to be as portable as possible +across differing versions of Perl itself, certain steps need to be taken. + +=over 4 + +=item * + +Including this header is the first major one. This alone will give you +access to a large part of the Perl API that hasn't been available in +earlier Perl releases. Use + + perl ppport.h --list-provided + +to see which API elements are provided by ppport.h. + +=item * + +You should avoid using deprecated parts of the API. For example, using +global Perl variables without the C<PL_> prefix is deprecated. Also, +some API functions used to have a C<perl_> prefix. Using this form is +also deprecated. You can safely use the supported API, as F<ppport.h> +will provide wrappers for older Perl versions. + +=item * + +If you use one of a few functions or variables that were not present in +earlier versions of Perl, and that can't be provided using a macro, you +have to explicitly request support for these functions by adding one or +more C<#define>s in your source code before the inclusion of F<ppport.h>. + +These functions or variables will be marked C<explicit> in the list shown +by C<--list-provided>. + +Depending on whether you module has a single or multiple files that +use such functions or variables, you want either C<static> or global +variants. + +For a C<static> function or variable (used only in a single source +file), use: + + #define NEED_function + #define NEED_variable + +For a global function or variable (used in multiple source files), +use: + + #define NEED_function_GLOBAL + #define NEED_variable_GLOBAL + +Note that you mustn't have more than one global request for the +same function or variable in your project. + + __EXPLICIT_API__ + +To avoid namespace conflicts, you can change the namespace of the +explicitly exported functions / variables using the C<DPPP_NAMESPACE> +macro. Just C<#define> the macro before including C<ppport.h>: + + #define DPPP_NAMESPACE MyOwnNamespace_ + #include "ppport.h" + +The default namespace is C<DPPP_>. + +=back + +The good thing is that most of the above can be checked by running +F<ppport.h> on your source code. See the next section for +details. + +=head1 EXAMPLES + +To verify whether F<ppport.h> is needed for your module, whether you +should make any changes to your code, and whether any special defines +should be used, F<ppport.h> can be run as a Perl script to check your +source code. Simply say: + + perl ppport.h + +The result will usually be a list of patches suggesting changes +that should at least be acceptable, if not necessarily the most +efficient solution, or a fix for all possible problems. + +If you know that your XS module uses features only available in +newer Perl releases, if you're aware that it uses C++ comments, +and if you want all suggestions as a single patch file, you could +use something like this: + + perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff + +If you only want your code to be scanned without any suggestions +for changes, use: + + perl ppport.h --nochanges + +You can specify a different C<diff> program or options, using +the C<--diff> option: + + perl ppport.h --diff='diff -C 10' + +This would output context diffs with 10 lines of context. + +If you want to create patched copies of your files instead, use: + + perl ppport.h --copy=.new + +To display portability information for the C<newSVpvn> function, +use: + + perl ppport.h --api-info=newSVpvn + +Since the argument to C<--api-info> can be a regular expression, +you can use + + perl ppport.h --api-info=/_nomg$/ + +to display portability information for all C<_nomg> functions or + + perl ppport.h --api-info=/./ + +to display information for all known API elements. + +=head1 BUGS + +If this version of F<ppport.h> is causing failure during +the compilation of this module, please check if newer versions +of either this module or C<Devel::PPPort> are available on CPAN +before sending a bug report. + +If F<ppport.h> was generated using the latest version of +C<Devel::PPPort> and is causing failure of this module, please +file a bug report here: L<https://github.com/mhx/Devel-PPPort/issues/> + +Please include the following information: + +=over 4 + +=item 1. + +The complete output from running "perl -V" + +=item 2. + +This file. + +=item 3. + +The name and version of the module you were trying to build. + +=item 4. + +A full log of the build that failed. + +=item 5. + +Any other information that you think could be relevant. + +=back + +For the latest version of this code, please get the C<Devel::PPPort> +module from CPAN. + +=head1 COPYRIGHT + +Version 3.x, Copyright (c) 2004-2013, 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 diff --git a/dist/Devel-PPPort/parts/inc/ppphtest b/dist/Devel-PPPort/parts/inc/ppphtest new file mode 100644 index 0000000000..cef6c40994 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/ppphtest @@ -0,0 +1,908 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=tests plan => 238 + +BEGIN { + if ($ENV{'SKIP_SLOW_TESTS'}) { + for (1 .. 238) { + skip("skip: SKIP_SLOW_TESTS", 0); + } + exit 0; + } +} + +use File::Path qw/rmtree mkpath/; +use Config; + +my $tmp = 'ppptmp'; +my $inc = ''; +my $isVMS = $^O eq 'VMS'; +my $isMAC = $^O eq 'MacOS'; +my $perl = find_perl(); + +rmtree($tmp) if -d $tmp; +mkpath($tmp) or die "mkpath $tmp: $!\n"; +chdir($tmp) or die "chdir $tmp: $!\n"; + +if ($ENV{'PERL_CORE'}) { + if (-d '../../lib') { + if ($isVMS) { + $inc = '"-I../../lib"'; + } + elsif ($isMAC) { + $inc = '-I:::lib'; + } + else { + $inc = '-I../../lib'; + } + unshift @INC, '../../lib'; + } +} +if ($perl =~ m!^\./!) { + $perl = ".$perl"; +} + +END { + chdir('..') if !-d $tmp && -d "../$tmp"; + rmtree($tmp) if -d $tmp; +} + +ok(&Devel::PPPort::WriteFile("ppport.h")); + +# Check GetFileContents() +ok(-e "ppport.h", 1); + +my $data; + +open(F, "<ppport.h") or die "Failed to open ppport.h: $!"; +while(<F>) { + $data .= $_; +} +close(F); + +ok(Devel::PPPort::GetFileContents("ppport.h"), $data); +ok(Devel::PPPort::GetFileContents(), $data); + +sub comment +{ + my $c = shift; + $c =~ s/^/# | /mg; + $c .= "\n" unless $c =~ /[\r\n]$/; + print $c; +} + +sub ppport +{ + my @args = ('ppport.h', @_); + unshift @args, $inc if $inc; + my $run = $perl =~ m/\s/ ? qq("$perl") : $perl; + $run .= ' -MMac::err=unix' if $isMAC; + for (@args) { + $_ = qq("$_") if $isVMS && /^[^"]/; + $run .= " $_"; + } + print "# *** running $run ***\n"; + $run .= ' 2>&1' unless $isMAC; + my @out = `$run`; + my $out = join '', @out; + comment($out); + return wantarray ? @out : $out; +} + +sub matches +{ + my($str, $re, $mod) = @_; + my @n; + eval "\@n = \$str =~ /$re/g$mod;"; + if ($@) { + my $err = $@; + $err =~ s/^/# *** /mg; + print "# *** ERROR ***\n$err\n"; + } + return $@ ? -42 : scalar @n; +} + +sub eq_files +{ + my($f1, $f2) = @_; + return 0 unless -e $f1 && -e $f2; + local *F; + for ($f1, $f2) { + print "# File: $_\n"; + unless (open F, $_) { + print "# couldn't open $_: $!\n"; + return 0; + } + $_ = do { local $/; <F> }; + close F; + comment($_); + } + return $f1 eq $f2; +} + +my @tests; + +for (split /\s*={70,}\s*/, do { local $/; <DATA> }) { + s/^\s+//; s/\s+$//; + my($c, %f); + ($c, @f{m/-{20,}\s+(\S+)\s+-{20,}/g}) = split /\s*-{20,}\s+\S+\s+-{20,}\s*/; + push @tests, { code => $c, files => \%f }; +} + +my $t; +for $t (@tests) { + print "#\n", ('# ', '-'x70, "\n")x3, "#\n"; + my $f; + for $f (keys %{$t->{files}}) { + my @f = split /\//, $f; + if (@f > 1) { + pop @f; + my $path = join '/', @f; + mkpath($path) or die "mkpath('$path'): $!\n"; + } + my $txt = $t->{files}{$f}; + local *F; + open F, ">$f" or die "open $f: $!\n"; + print F "$txt\n"; + close F; + $txt =~ s/^/# | /mg; + print "# *** writing $f ***\n$txt\n"; + } + + my $code = $t->{code}; + $code =~ s/^/# | /mg; + + print "# *** evaluating test code ***\n$code\n"; + + eval $t->{code}; + if ($@) { + my $err = $@; + $err =~ s/^/# *** /mg; + print "# *** ERROR ***\n$err\n"; + } + ok($@, ''); + + for (keys %{$t->{files}}) { + unlink $_ or die "unlink('$_'): $!\n"; + } +} + +sub find_perl +{ + my $perl = $^X; + + return $perl if $isVMS; + + my $exe = $Config{'_exe'} || ''; + + if ($perl =~ /^perl\Q$exe\E$/i) { + $perl = "perl$exe"; + eval "require File::Spec"; + if ($@) { + $perl = "./$perl"; + } else { + $perl = File::Spec->catfile(File::Spec->curdir(), $perl); + } + } + + if ($perl !~ /\Q$exe\E$/i) { + $perl .= $exe; + } + + warn "find_perl: cannot find $perl from $^X" unless -f $perl; + + return $perl; +} + +__DATA__ + +my $o = ppport(qw(--help)); +ok($o =~ /^Usage:.*ppport\.h/m); +ok($o =~ /--help/m); + +$o = ppport(qw(--version)); +ok($o =~ /^This is.*ppport.*\d+\.\d+(?:_?\d+)?\.$/); + +$o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*test\.xs/mi); +ok($o =~ /Analyzing.*test\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok(matches($o, 'Analyzing', 'm'), 1); +ok($o =~ /Uses Perl_newSViv instead of newSViv/); + +$o = ppport(qw(--quiet --nochanges)); +ok($o =~ /^\s*$/); + +---------------------------- test.xs ------------------------------------------ + +Perl_newSViv(); + +=============================================================================== + +# check if C and C++ comments are filtered correctly + +my $o = ppport(qw(--copy=a)); +ok($o =~ /^Scanning.*MyExt\.xs/mi); +ok($o =~ /Analyzing.*MyExt\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Uses grok_bin/m); +ok($o !~ /^Uses newSVpv/m); +ok($o =~ /Uses 1 C\+\+ style comment/m); +ok(eq_files('MyExt.xsa', 'MyExt.ra')); + +# check if C++ are left untouched with --cplusplus + +$o = ppport(qw(--copy=b --cplusplus)); +ok($o =~ /^Scanning.*MyExt\.xs/mi); +ok($o =~ /Analyzing.*MyExt\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Uses grok_bin/m); +ok($o !~ /^Uses newSVpv/m); +ok($o !~ /Uses \d+ C\+\+ style comment/m); +ok(eq_files('MyExt.xsb', 'MyExt.rb')); + +unlink qw(MyExt.xsa MyExt.xsb); + +---------------------------- MyExt.xs ----------------------------------------- + +newSVuv(); + // newSVpv(); + XPUSHs(foo); +/* grok_bin(); */ + +---------------------------- MyExt.ra ----------------------------------------- + +#include "ppport.h" +newSVuv(); + /* newSVpv(); */ + XPUSHs(foo); +/* grok_bin(); */ + +---------------------------- MyExt.rb ----------------------------------------- + +#include "ppport.h" +newSVuv(); + // newSVpv(); + XPUSHs(foo); +/* grok_bin(); */ + +=============================================================================== + +my $o = ppport(qw(--nochanges file1.xs)); +ok($o =~ /^Scanning.*file1\.xs/mi); +ok($o =~ /Analyzing.*file1\.xs/mi); +ok($o !~ /^Scanning.*file2\.xs/mi); +ok($o =~ /^Uses newCONSTSUB/m); +ok($o =~ /^Uses PL_expect/m); +ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o =~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --nohints file1.xs)); +ok($o =~ /^Scanning.*file1\.xs/mi); +ok($o =~ /Analyzing.*file1\.xs/mi); +ok($o !~ /^Scanning.*file2\.xs/mi); +ok($o =~ /^Uses newCONSTSUB/m); +ok($o =~ /^Uses PL_expect/m); +ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o !~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --nohints --nodiag file1.xs)); +ok($o =~ /^Scanning.*file1\.xs/mi); +ok($o =~ /Analyzing.*file1\.xs/mi); +ok($o !~ /^Scanning.*file2\.xs/mi); +ok($o !~ /^Uses newCONSTSUB/m); +ok($o !~ /^Uses PL_expect/m); +ok($o !~ /^Uses SvPV_nolen/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o !~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --quiet file1.xs)); +ok($o =~ /^\s*$/); + +$o = ppport(qw(--nochanges file2.xs)); +ok($o =~ /^Scanning.*file2\.xs/mi); +ok($o =~ /Analyzing.*file2\.xs/mi); +ok($o !~ /^Scanning.*file1\.xs/mi); +ok($o =~ /^Uses mXPUSHp/m); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Looks good/m); +ok($o =~ /^1 potentially required change detected/m); + +$o = ppport(qw(--nochanges --nohints file2.xs)); +ok($o =~ /^Scanning.*file2\.xs/mi); +ok($o =~ /Analyzing.*file2\.xs/mi); +ok($o !~ /^Scanning.*file1\.xs/mi); +ok($o =~ /^Uses mXPUSHp/m); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Looks good/m); +ok($o =~ /^1 potentially required change detected/m); + +$o = ppport(qw(--nochanges --nohints --nodiag file2.xs)); +ok($o =~ /^Scanning.*file2\.xs/mi); +ok($o =~ /Analyzing.*file2\.xs/mi); +ok($o !~ /^Scanning.*file1\.xs/mi); +ok($o !~ /^Uses mXPUSHp/m); +ok($o !~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Looks good/m); +ok($o =~ /^1 potentially required change detected/m); + +$o = ppport(qw(--nochanges --quiet file2.xs)); +ok($o =~ /^\s*$/); + +---------------------------- file1.xs ----------------------------------------- + +#define NEED_newCONSTSUB +#define NEED_sv_2pv_flags +#define NEED_PL_parser +#include "ppport.h" + +newCONSTSUB(); +SvPV_nolen(); +PL_expect = 0; + +---------------------------- file2.xs ----------------------------------------- + +mXPUSHp(foo); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*FooBar\.xs/mi); +ok($o =~ /Analyzing.*FooBar\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok($o !~ /^Looks good/m); +ok($o =~ /^Uses grok_bin/m); + +---------------------------- FooBar.xs ---------------------------------------- + +newSViv(); +XPUSHs(foo); +grok_bin(); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*First\.xs/mi); +ok($o =~ /Analyzing.*First\.xs/mi); +ok($o =~ /^Scanning.*second\.h/mi); +ok($o =~ /Analyzing.*second\.h/mi); +ok($o =~ /^Scanning.*sub.*third\.c/mi); +ok($o =~ /Analyzing.*sub.*third\.c/mi); +ok($o !~ /^Scanning.*foobar/mi); +ok(matches($o, '^Scanning', 'm'), 3); + +---------------------------- First.xs ----------------------------------------- + +one + +---------------------------- foobar.xyz --------------------------------------- + +two + +---------------------------- second.h ----------------------------------------- + +three + +---------------------------- sub/third.c -------------------------------------- + +four + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /Possibly wrong #define NEED_foobar in.*test.xs/i); + +---------------------------- test.xs ------------------------------------------ + +#define NEED_foobar + +=============================================================================== + +# And now some complex "real-world" example + +my $o = ppport(qw(--copy=f)); +for (qw(main.xs mod1.c mod2.c mod3.c mod4.c mod5.c)) { + ok($o =~ /^Scanning.*\Q$_\E/mi); + ok($o =~ /Analyzing.*\Q$_\E/i); +} +ok(matches($o, '^Scanning', 'm'), 6); + +ok(matches($o, '^Writing copy of', 'm'), 5); +ok(!-e "mod5.cf"); + +for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- main.xs ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_newCONSTSUB +#define NEED_grok_hex_GLOBAL +#include "ppport.h" + +newCONSTSUB(); +grok_hex(); +Perl_grok_bin(aTHX_ foo, bar); + +/* some comment */ + +perl_eval_pv(); +grok_bin(); +Perl_grok_bin(bar, sv_no); + +---------------------------- mod1.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_grok_bin_GLOBAL +#define NEED_newCONSTSUB +#include "ppport.h" + +newCONSTSUB(); +grok_bin(); +{ + Perl_croak ("foo"); + Perl_sv_catpvf(); /* I know it's wrong ;-) */ +} + +---------------------------- mod2.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_eval_pv +#include "ppport.h" + +newSViv(); + +/* + eval_pv(); +*/ + +---------------------------- mod3.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +grok_oct(); +eval_pv(); + +---------------------------- mod4.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +START_MY_CXT; + +---------------------------- mod5.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include "ppport.h" +call_pv(); + +---------------------------- main.xsr ----------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_eval_pv_GLOBAL +#define NEED_grok_hex +#define NEED_newCONSTSUB_GLOBAL +#include "ppport.h" + +newCONSTSUB(); +grok_hex(); +grok_bin(foo, bar); + +/* some comment */ + +eval_pv(); +grok_bin(); +grok_bin(bar, PL_sv_no); + +---------------------------- mod1.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_grok_bin_GLOBAL +#include "ppport.h" + +newCONSTSUB(); +grok_bin(); +{ + Perl_croak (aTHX_ "foo"); + Perl_sv_catpvf(aTHX); /* I know it's wrong ;-) */ +} + +---------------------------- mod2.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + + +newSViv(); + +/* + eval_pv(); +*/ + +---------------------------- mod3.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#define NEED_grok_oct +#include "ppport.h" + +grok_oct(); +eval_pv(); + +---------------------------- mod4.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include "ppport.h" + +START_MY_CXT; + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /Uses grok_hex/m); +ok($o !~ /Looks good/m); + +$o = ppport(qw(--nochanges --compat-version=5.8.0)); +ok($o !~ /Uses grok_hex/m); +ok($o =~ /Looks good/m); + +---------------------------- FooBar.xs ---------------------------------------- + +grok_hex(); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); + +$o = ppport(qw(--nochanges --compat-version=5.5.3)); +ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); + +$o = ppport(qw(--nochanges --compat-version=5.005_03)); +ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); + +$o = ppport(qw(--nochanges --compat-version=5.6.0)); +ok($o !~ /Uses SvPVutf8_force/m); + +$o = ppport(qw(--nochanges --compat-version=5.006)); +ok($o !~ /Uses SvPVutf8_force/m); + +$o = ppport(qw(--nochanges --compat-version=5.999.999)); +ok($o !~ /Uses SvPVutf8_force/m); + +$o = ppport(qw(--nochanges --compat-version=6.0.0)); +ok($o =~ /Only Perl 5 is supported/m); + +$o = ppport(qw(--nochanges --compat-version=5.1000.999)); +ok($o =~ /Invalid version number: 5.1000.999/m); + +$o = ppport(qw(--nochanges --compat-version=5.999.1000)); +ok($o =~ /Invalid version number: 5.999.1000/m); + +---------------------------- FooBar.xs ---------------------------------------- + +SvPVutf8_force(); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o !~ /potentially required change/); +ok(matches($o, '^Looks good', 'm'), 2); + +---------------------------- FooBar.xs ---------------------------------------- + +#define NEED_grok_numeric_radix +#define NEED_grok_number +#include "ppport.h" + +GROK_NUMERIC_RADIX(); +grok_number(); + +---------------------------- foo.c -------------------------------------------- + +#include "ppport.h" + +call_pv(); + +=============================================================================== + +# check --api-info option + +my $o = ppport(qw(--api-info=INT2PTR)); +my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; +ok(scalar keys %found, 1); +ok(exists $found{INT2PTR}); +ok(matches($o, '^Supported at least starting from perl-5\.6\.0\.', 'm'), 1); +ok(matches($o, '^Support by .*ppport.* provided back to perl-5\.003\.', 'm'), 1); + +$o = ppport(qw(--api-info=Zero)); +%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; +ok(scalar keys %found, 1); +ok(exists $found{Zero}); +ok(matches($o, '^No portability information available\.', 'm'), 1); + +$o = ppport(qw(--api-info=/Zero/)); +%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; +ok(scalar keys %found, 2); +ok(exists $found{Zero}); +ok(exists $found{ZeroD}); + +=============================================================================== + +# check --list-provided option + +my @o = ppport(qw(--list-provided)); +my %p; +my $fail = 0; +for (@o) { + my($name, $flags) = /^(\w+)(?:\s+\[(\w+(?:,\s+\w+)*)\])?$/ or $fail++; + exists $p{$name} and $fail++; + $p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : ''; +} +ok(@o > 100); +ok($fail, 0); + +ok(exists $p{call_pv}); +ok(not ref $p{call_pv}); + +ok(exists $p{grok_bin}); +ok(ref $p{grok_bin}, 'HASH'); +ok(scalar keys %{$p{grok_bin}}, 2); +ok($p{grok_bin}{explicit}); +ok($p{grok_bin}{depend}); + +ok(exists $p{gv_stashpvn}); +ok(ref $p{gv_stashpvn}, 'HASH'); +ok(scalar keys %{$p{gv_stashpvn}}, 2); +ok($p{gv_stashpvn}{depend}); +ok($p{gv_stashpvn}{hint}); + +ok(exists $p{sv_catpvf_mg}); +ok(ref $p{sv_catpvf_mg}, 'HASH'); +ok(scalar keys %{$p{sv_catpvf_mg}}, 2); +ok($p{sv_catpvf_mg}{explicit}); +ok($p{sv_catpvf_mg}{depend}); + +ok(exists $p{PL_signals}); +ok(ref $p{PL_signals}, 'HASH'); +ok(scalar keys %{$p{PL_signals}}, 1); +ok($p{PL_signals}{explicit}); + +=============================================================================== + +# check --list-unsupported option + +my @o = ppport(qw(--list-unsupported)); +my %p; +my $fail = 0; +for (@o) { + my($name, $ver) = /^(\w+)\s*\.+\s*([\d._]+)$/ or $fail++; + exists $p{$name} and $fail++; + $p{$name} = $ver; +} +ok(@o > 100); +ok($fail, 0); + +ok(exists $p{utf8_distance}); +ok($p{utf8_distance}, '5.6.0'); + +ok(exists $p{save_generic_svref}); +ok($p{save_generic_svref}, '5.005_03'); + +=============================================================================== + +# check --nofilter option + +my $o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*foo\.cpp/mi); +ok($o =~ /Analyzing.*foo\.cpp/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok(matches($o, 'Analyzing', 'm'), 1); + +$o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL)); +ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m); +ok(matches($o, '^\|\s+foo\.o', 'mi'), 1); +ok(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1); +ok($o =~ /^Scanning.*foo\.cpp/mi); +ok($o =~ /Analyzing.*foo\.cpp/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok(matches($o, 'Analyzing', 'm'), 1); + +$o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL)); +ok($o =~ /^Scanning.*foo\.cpp/mi); +ok($o =~ /Analyzing.*foo\.cpp/mi); +ok($o =~ /^Scanning.*foo\.o/mi); +ok($o =~ /Analyzing.*foo\.o/mi); +ok($o =~ /^Scanning.*Makefile/mi); +ok($o =~ /Analyzing.*Makefile/mi); +ok(matches($o, '^Scanning', 'm'), 3); +ok(matches($o, 'Analyzing', 'm'), 3); + +---------------------------- foo.cpp ------------------------------------------ + +newSViv(); + +---------------------------- foo.o -------------------------------------------- + +newSViv(); + +---------------------------- Makefile.PL -------------------------------------- + +newSViv(); + +=============================================================================== + +# check if explicit variables are handled propery + +my $o = ppport(qw(--copy=a)); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o =~ /^Uses PL_signals/m); +ok($o =~ /^File needs PL_signals, adding static request/m); +ok(eq_files('MyExt.xsa', 'MyExt.ra')); + +unlink qw(MyExt.xsa); + +---------------------------- MyExt.xs ----------------------------------------- + +PL_signals = 123; +if (PL_signals == 42) + foo(); + +---------------------------- MyExt.ra ----------------------------------------- + +#define NEED_PL_signals +#include "ppport.h" +PL_signals = 123; +if (PL_signals == 42) + foo(); + +=============================================================================== + +my $o = ppport(qw(--nochanges file.xs)); +ok($o =~ /^Uses PL_copline/m); +ok($o =~ /WARNING: PL_copline/m); +ok($o =~ /^Uses SvUOK/m); +ok($o =~ /WARNING: Uses SvUOK, which may not be portable/m); +ok($o =~ /^Analysis completed \(2 warnings\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --compat-version=5.8.0 file.xs)); +ok($o =~ /^Uses PL_copline/m); +ok($o =~ /WARNING: PL_copline/m); +ok($o !~ /WARNING: Uses SvUOK, which may not be portable/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +---------------------------- file.xs ----------------------------------------- + +#define NEED_PL_parser +#include "ppport.h" +SvUOK +PL_copline + +=============================================================================== + +my $o = ppport(qw(--copy=f)); + +for (qw(file.xs)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- file.xs ----------------------------------------- + +a_string = "sv_undef" +a_char = 'sv_yes' +#define SOMETHING defgv +/* C-comment: sv_tainted */ +# +# This is just a big XS comment using sv_no +# +/* The following, is NOT an XS comment! */ +# define SOMETHING_ELSE defgv + \ + sv_undef + +---------------------------- file.xsr ----------------------------------------- + +#include "ppport.h" +a_string = "sv_undef" +a_char = 'sv_yes' +#define SOMETHING PL_defgv +/* C-comment: sv_tainted */ +# +# This is just a big XS comment using sv_no +# +/* The following, is NOT an XS comment! */ +# define SOMETHING_ELSE PL_defgv + \ + PL_sv_undef + +=============================================================================== + +my $o = ppport(qw(--copy=f)); + +for (qw(file.xs)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- file.xs ----------------------------------------- + +#define NEED_sv_2pv_flags +#define NEED_vnewSVpvf +#define NEED_warner +#include "ppport.h" +Perl_croak_nocontext("foo"); +Perl_croak("bar"); +croak("foo"); +croak_nocontext("foo"); +Perl_warner_nocontext("foo"); +Perl_warner("foo"); +warner_nocontext("foo"); +warner("foo"); + +---------------------------- file.xsr ----------------------------------------- + +#define NEED_sv_2pv_flags +#define NEED_vnewSVpvf +#define NEED_warner +#include "ppport.h" +Perl_croak_nocontext("foo"); +Perl_croak(aTHX_ "bar"); +croak("foo"); +croak_nocontext("foo"); +Perl_warner_nocontext("foo"); +Perl_warner(aTHX_ "foo"); +warner_nocontext("foo"); +warner("foo"); diff --git a/dist/Devel-PPPort/parts/inc/pv_tools b/dist/Devel-PPPort/parts/inc/pv_tools new file mode 100644 index 0000000000..41a4907c6b --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/pv_tools @@ -0,0 +1,274 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +__UNDEFINED__ +pv_escape +pv_pretty +pv_display + +=implementation + +__UNDEFINED__ PERL_PV_ESCAPE_QUOTE 0x0001 +__UNDEFINED__ PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE +__UNDEFINED__ PERL_PV_PRETTY_ELLIPSES 0x0002 +__UNDEFINED__ PERL_PV_PRETTY_LTGT 0x0004 +__UNDEFINED__ PERL_PV_ESCAPE_FIRSTCHAR 0x0008 +__UNDEFINED__ PERL_PV_ESCAPE_UNI 0x0100 +__UNDEFINED__ PERL_PV_ESCAPE_UNI_DETECT 0x0200 +__UNDEFINED__ PERL_PV_ESCAPE_ALL 0x1000 +__UNDEFINED__ PERL_PV_ESCAPE_NOBACKSLASH 0x2000 +__UNDEFINED__ PERL_PV_ESCAPE_NOCLEAR 0x4000 +__UNDEFINED__ PERL_PV_ESCAPE_RE 0x8000 +__UNDEFINED__ PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR + +__UNDEFINED__ PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE +__UNDEFINED__ PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE + +/* Hint: pv_escape + * Note that unicode functionality is only backported to + * those perl versions that support it. For older perl + * versions, the implementation will fall back to bytes. + */ + +#ifndef pv_escape +#if { NEED pv_escape } + +char * +pv_escape(pTHX_ SV *dsv, char const * const str, + const STRLEN count, const STRLEN max, + STRLEN * const escaped, const U32 flags) +{ + const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\'; + const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc; + char octbuf[32] = "%123456789ABCDF"; + STRLEN wrote = 0; + STRLEN chsize = 0; + STRLEN readsize = 1; +#if defined(is_utf8_string) && defined(utf8_to_uvchr) + bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0; +#endif + const char *pv = str; + const char * const end = pv + count; + octbuf[0] = esc; + + if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) + sv_setpvs(dsv, ""); + +#if defined(is_utf8_string) && defined(utf8_to_uvchr) + if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count)) + isuni = 1; +#endif + + for (; pv < end && (!max || wrote < max) ; pv += readsize) { + const UV u = +#if defined(is_utf8_string) && defined(utf8_to_uvchr) + isuni ? utf8_to_uvchr((U8*)pv, &readsize) : +#endif + (U8)*pv; + const U8 c = (U8)u & 0xFF; + + if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) { + if (flags & PERL_PV_ESCAPE_FIRSTCHAR) + chsize = my_snprintf(octbuf, sizeof octbuf, + "%" UVxf, u); + else + chsize = my_snprintf(octbuf, sizeof octbuf, + "%cx{%" UVxf "}", esc, u); + } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) { + chsize = 1; + } else { + if (c == dq || c == esc || !isPRINT(c)) { + chsize = 2; + switch (c) { + case '\\' : /* fallthrough */ + case '%' : if (c == esc) + octbuf[1] = esc; + else + chsize = 1; + break; + case '\v' : octbuf[1] = 'v'; break; + case '\t' : octbuf[1] = 't'; break; + case '\r' : octbuf[1] = 'r'; break; + case '\n' : octbuf[1] = 'n'; break; + case '\f' : octbuf[1] = 'f'; break; + case '"' : if (dq == '"') + octbuf[1] = '"'; + else + chsize = 1; + break; + default: chsize = my_snprintf(octbuf, sizeof octbuf, + pv < end && isDIGIT((U8)*(pv+readsize)) + ? "%c%03o" : "%c%o", esc, c); + } + } else { + chsize = 1; + } + } + if (max && wrote + chsize > max) { + break; + } else if (chsize > 1) { + sv_catpvn(dsv, octbuf, chsize); + wrote += chsize; + } else { + char tmp[2]; + my_snprintf(tmp, sizeof tmp, "%c", c); + sv_catpvn(dsv, tmp, 1); + wrote++; + } + if (flags & PERL_PV_ESCAPE_FIRSTCHAR) + break; + } + if (escaped != NULL) + *escaped= pv - str; + return SvPVX(dsv); +} + +#endif +#endif + +#ifndef pv_pretty +#if { NEED pv_pretty } + +char * +pv_pretty(pTHX_ SV *dsv, char const * const str, const STRLEN count, + const STRLEN max, char const * const start_color, char const * const end_color, + const U32 flags) +{ + const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%'; + STRLEN escaped; + + if (!(flags & PERL_PV_PRETTY_NOCLEAR)) + sv_setpvs(dsv, ""); + + if (dq == '"') + sv_catpvs(dsv, "\""); + else if (flags & PERL_PV_PRETTY_LTGT) + sv_catpvs(dsv, "<"); + + if (start_color != NULL) + sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color)); + + pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR); + + if (end_color != NULL) + sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color)); + + if (dq == '"') + sv_catpvs(dsv, "\""); + else if (flags & PERL_PV_PRETTY_LTGT) + sv_catpvs(dsv, ">"); + + if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count) + sv_catpvs(dsv, "..."); + + return SvPVX(dsv); +} + +#endif +#endif + +#ifndef pv_display +#if { NEED pv_display } + +char * +pv_display(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim) +{ + pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP); + if (len > cur && pv[cur] == '\0') + sv_catpvs(dsv, "\\0"); + return SvPVX(dsv); +} + +#endif +#endif + +=xsinit + +#define NEED_pv_escape +#define NEED_pv_pretty +#define NEED_pv_display + +=xsubs + +void +pv_escape_can_unicode() + PPCODE: +#if defined(is_utf8_string) && defined(utf8_to_uvchr) + XSRETURN_YES; +#else + XSRETURN_NO; +#endif + +void +pv_pretty() + PREINIT: + char *rv; + PPCODE: + EXTEND(SP, 8); + ST(0) = sv_newmortal(); + rv = pv_pretty(ST(0), "foobarbaz", + 9, 40, NULL, NULL, 0); + ST(1) = sv_2mortal(newSVpv(rv, 0)); + ST(2) = sv_newmortal(); + rv = pv_pretty(ST(2), "pv_p\retty\n", + 10, 40, "left", "right", PERL_PV_PRETTY_LTGT); + ST(3) = sv_2mortal(newSVpv(rv, 0)); + ST(4) = sv_newmortal(); + rv = pv_pretty(ST(4), "N\303\275 Batter\303\255", + 12, 20, NULL, NULL, PERL_PV_ESCAPE_UNI_DETECT); + ST(5) = sv_2mortal(newSVpv(rv, 0)); + ST(6) = sv_newmortal(); + rv = pv_pretty(ST(6), "\303\201g\303\246tis Byrjun", + 15, 18, NULL, NULL, PERL_PV_ESCAPE_UNI_DETECT|PERL_PV_PRETTY_ELLIPSES); + ST(7) = sv_2mortal(newSVpv(rv, 0)); + XSRETURN(8); + +void +pv_display() + PREINIT: + char *rv; + PPCODE: + EXTEND(SP, 4); + ST(0) = sv_newmortal(); + rv = pv_display(ST(0), "foob\0rbaz", 9, 10, 20); + ST(1) = sv_2mortal(newSVpv(rv, 0)); + ST(2) = sv_newmortal(); + rv = pv_display(ST(2), "pv_display", 10, 11, 5); + ST(3) = sv_2mortal(newSVpv(rv, 0)); + XSRETURN(4); + +=tests plan => 13 + +my $uni = &Devel::PPPort::pv_escape_can_unicode(); + +# sanity check +ok($uni ? $] >= 5.006 : $] < 5.008); + +my @r; + +@r = &Devel::PPPort::pv_pretty(); +ok($r[0], $r[1]); +ok($r[0], "foobarbaz"); +ok($r[2], $r[3]); +ok($r[2], '<leftpv_p\retty\nright>'); +ok($r[4], $r[5]); +ok($r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303'); +ok($r[6], $r[7]); +ok($r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...'); + +@r = &Devel::PPPort::pv_display(); +ok($r[0], $r[1]); +ok($r[0], '"foob\0rbaz"\0'); +ok($r[2], $r[3]); +ok($r[2] eq '"pv_di"...\0' || + $r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :( diff --git a/dist/Devel-PPPort/parts/inc/pvs b/dist/Devel-PPPort/parts/inc/pvs new file mode 100644 index 0000000000..b1be87b26b --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/pvs @@ -0,0 +1,154 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +__UNDEFINED__ + +=implementation + +/* concatenating with "" ensures that only literal strings are accepted as argument + * note that STR_WITH_LEN() can't be used as argument to macros or functions that + * under some configurations might be macros + */ + +__UNDEFINED__ STR_WITH_LEN(s) (s ""), (sizeof(s)-1) + +__UNDEFINED__ newSVpvs(str) newSVpvn(str "", sizeof(str) - 1) +__UNDEFINED__ newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags) +__UNDEFINED__ newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0) +__UNDEFINED__ sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1) +__UNDEFINED__ sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1) +__UNDEFINED__ hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval) +__UNDEFINED__ hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0) + +__UNDEFINED__ gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt) +__UNDEFINED__ gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags) + +__UNDEFINED__ get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags) + +=xsinit + +#define NEED_newSVpvn_share + +=xsubs + +void +newSVpvs() + PPCODE: + mXPUSHs(newSVpvs("newSVpvs")); + XSRETURN(1); + +void +newSVpvs_flags() + PPCODE: + XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP)); + XSRETURN(1); + +int +newSVpvs_share() + PREINIT: + SV *sv; + U32 hash; + CODE: + RETVAL = 0; + PERL_HASH(hash, "pvs", 3); + sv = newSVpvs_share("pvs"); + RETVAL += strEQ(SvPV_nolen_const(sv), "pvs"); + RETVAL += SvCUR(sv) == 3; + RETVAL += SvSHARED_HASH(sv) == hash; + SvREFCNT_dec(sv); + OUTPUT: + RETVAL + +void +sv_catpvs(sv) + SV *sv + PPCODE: + sv_catpvs(sv, "sv_catpvs"); + +void +sv_setpvs(sv) + SV *sv + PPCODE: + sv_setpvs(sv, "sv_setpvs"); + +void +hv_fetchs(hv) + SV *hv + PREINIT: + SV **s; + PPCODE: + s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0); + XPUSHs(sv_mortalcopy(*s)); + XSRETURN(1); + +void +hv_stores(hv, sv) + SV *hv + SV *sv + PPCODE: + (void) hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc_simple(sv)); + +SV* +gv_fetchpvs() + CODE: + RETVAL = newRV_inc((SV*)gv_fetchpvs("Devel::PPPort::VERSION", 0, SVt_PV)); + OUTPUT: + RETVAL + +SV* +gv_stashpvs() + CODE: + RETVAL = newRV_inc((SV*)gv_stashpvs("Devel::PPPort", 0)); + OUTPUT: + RETVAL + +int +get_cvs() + PREINIT: + CV* xv; + CODE: + RETVAL = 0; + xv = get_cvs("Devel::PPPort::foobar", 0); + if(xv == NULL) RETVAL++; + xv = get_cvs("Devel::PPPort::foobar", GV_ADDMULTI); + if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++; + xv = get_cvs("Devel::PPPort::get_cvs", 0); + if(xv && SvTYPE(xv) == SVt_PVCV) RETVAL++; +OUTPUT: + RETVAL + + +=tests plan => 12 + +my $x = 'foo'; + +ok(Devel::PPPort::newSVpvs(), "newSVpvs"); +ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags"); +ok(Devel::PPPort::newSVpvs_share(), 3); + +Devel::PPPort::sv_catpvs($x); +ok($x, "foosv_catpvs"); + +Devel::PPPort::sv_setpvs($x); +ok($x, "sv_setpvs"); + +my %h = ('hv_fetchs' => 42); +Devel::PPPort::hv_stores(\%h, 4711); +ok(scalar keys %h, 2); +ok(exists $h{'hv_stores'}); +ok($h{'hv_stores'}, 4711); +ok(Devel::PPPort::hv_fetchs(\%h), 42); +ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION); +ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::); + +ok(Devel::PPPort::get_cvs(), 3); diff --git a/dist/Devel-PPPort/parts/inc/shared_pv b/dist/Devel-PPPort/parts/inc/shared_pv new file mode 100644 index 0000000000..921076fd32 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/shared_pv @@ -0,0 +1,90 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +newSVpvn_share +__UNDEFINED__ + +=implementation + +/* Hint: newSVpvn_share + * The SVs created by this function only mimic the behaviour of + * shared PVs without really being shared. Only use if you know + * what you're doing. + */ + +#ifndef newSVpvn_share + +#if { NEED newSVpvn_share } + +SV * +newSVpvn_share(pTHX_ const char *src, I32 len, U32 hash) +{ + SV *sv; + if (len < 0) + len = -len; + if (!hash) + PERL_HASH(hash, (char*) src, len); + sv = newSVpvn((char *) src, len); + sv_upgrade(sv, SVt_PVIV); + SvIVX(sv) = hash; + SvREADONLY_on(sv); + SvPOK_on(sv); + return sv; +} + +#endif + +#endif + +__UNDEFINED__ SvSHARED_HASH(sv) (0 + SvUVX(sv)) + +=xsinit + +#define NEED_newSVpvn_share + +=xsubs + +int +newSVpvn_share() + PREINIT: + const char *s; + SV *sv; + STRLEN len; + U32 hash; + CODE: + RETVAL = 0; + s = "mhx"; + len = 3; + PERL_HASH(hash, (char *) s, len); + sv = newSVpvn_share(s, len, 0); + s = 0; + RETVAL += strEQ(SvPV_nolen_const(sv), "mhx"); + RETVAL += SvCUR(sv) == len; + RETVAL += SvSHARED_HASH(sv) == hash; + SvREFCNT_dec(sv); + s = "foobar"; + len = 6; + PERL_HASH(hash, (char *) s, len); + sv = newSVpvn_share(s, -(I32) len, hash); + s = 0; + RETVAL += strEQ(SvPV_nolen_const(sv), "foobar"); + RETVAL += SvCUR(sv) == len; + RETVAL += SvSHARED_HASH(sv) == hash; + SvREFCNT_dec(sv); + OUTPUT: + RETVAL + + +=tests plan => 1 + +ok(&Devel::PPPort::newSVpvn_share(), 6); diff --git a/dist/Devel-PPPort/parts/inc/snprintf b/dist/Devel-PPPort/parts/inc/snprintf new file mode 100644 index 0000000000..b700d8b8ef --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/snprintf @@ -0,0 +1,63 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +my_snprintf + +=implementation + +#if !defined(my_snprintf) +#if { NEED my_snprintf } + +int +my_snprintf(char *buffer, const Size_t len, const char *format, ...) +{ + dTHX; + int retval; + va_list ap; + va_start(ap, format); +#ifdef HAS_VSNPRINTF + retval = vsnprintf(buffer, len, format, ap); +#else + retval = vsprintf(buffer, format, ap); +#endif + va_end(ap); + if (retval < 0 || (len > 0 && (Size_t)retval >= len)) + Perl_croak(aTHX_ "panic: my_snprintf buffer overflow"); + return retval; +} + +#endif +#endif + +=xsinit + +#define NEED_my_snprintf + +=xsubs + +void +my_snprintf() + PREINIT: + char buf[128]; + int len; + PPCODE: + len = my_snprintf(buf, sizeof buf, "foo%s%d", "bar", 42); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + XSRETURN(2); + +=tests plan => 2 + +my($l, $s) = Devel::PPPort::my_snprintf(); +ok($l, 8); +ok($s, "foobar42"); diff --git a/dist/Devel-PPPort/parts/inc/sprintf b/dist/Devel-PPPort/parts/inc/sprintf new file mode 100644 index 0000000000..8d45411b4a --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/sprintf @@ -0,0 +1,55 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +my_sprintf + +=implementation + +#if !defined(my_sprintf) +#if { NEED my_sprintf } + +int +my_sprintf(char *buffer, const char* pat, ...) +{ + va_list args; + va_start(args, pat); + vsprintf(buffer, pat, args); + va_end(args); + return strlen(buffer); +} + +#endif +#endif + +=xsinit + +#define NEED_my_sprintf + +=xsubs + +void +my_sprintf() + PREINIT: + char buf[128]; + int len; + PPCODE: + len = my_sprintf(buf, "foo%s%d", "bar", 42); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + XSRETURN(2); + +=tests plan => 2 + +my($l, $s) = Devel::PPPort::my_sprintf(); +ok($l, 8); +ok($s, "foobar42"); diff --git a/dist/Devel-PPPort/parts/inc/strlfuncs b/dist/Devel-PPPort/parts/inc/strlfuncs new file mode 100644 index 0000000000..82b5e43541 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/strlfuncs @@ -0,0 +1,107 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +my_strlcat +my_strlcpy + +=implementation + +#if !defined(my_strlcat) +#if { NEED my_strlcat } + +Size_t +my_strlcat(char *dst, const char *src, Size_t size) +{ + Size_t used, length, copy; + + used = strlen(dst); + length = strlen(src); + if (size > 0 && used < size - 1) { + copy = (length >= size - used) ? size - used - 1 : length; + memcpy(dst + used, src, copy); + dst[used + copy] = '\0'; + } + return used + length; +} +#endif +#endif + +#if !defined(my_strlcpy) +#if { NEED my_strlcpy } + +Size_t +my_strlcpy(char *dst, const char *src, Size_t size) +{ + Size_t length, copy; + + length = strlen(src); + if (size > 0) { + copy = (length >= size) ? size - 1 : length; + memcpy(dst, src, copy); + dst[copy] = '\0'; + } + return length; +} + +#endif +#endif + +=xsinit + +#define NEED_my_strlcat +#define NEED_my_strlcpy + +=xsubs + +void +my_strlfunc() + PREINIT: + char buf[8]; + int len; + PPCODE: + len = my_strlcpy(buf, "foo", sizeof(buf)); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + len = my_strlcat(buf, "bar", sizeof(buf)); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + len = my_strlcat(buf, "baz", sizeof(buf)); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + len = my_strlcpy(buf, "1234567890", sizeof(buf)); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + len = my_strlcpy(buf, "1234", sizeof(buf)); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + len = my_strlcat(buf, "567890123456", sizeof(buf)); + mXPUSHi(len); + mXPUSHs(newSVpv(buf, 0)); + XSRETURN(12); + +=tests plan => 13 + +my @e = (3, 'foo', + 6, 'foobar', + 9, 'foobarb', + 10, '1234567', + 4, '1234', + 16, '1234567', + ); +my @r = Devel::PPPort::my_strlfunc(); + +ok(@e == @r); + +for (0 .. $#e) { + ok($r[$_], $e[$_]); +} diff --git a/dist/Devel-PPPort/parts/inc/sv_xpvf b/dist/Devel-PPPort/parts/inc/sv_xpvf new file mode 100644 index 0000000000..3a6c8b0e98 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/sv_xpvf @@ -0,0 +1,313 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +vnewSVpvf +sv_vcatpvf +sv_vsetpvf + +sv_catpvf_mg +sv_catpvf_mg_nocontext +sv_vcatpvf_mg + +sv_setpvf_mg +sv_setpvf_mg_nocontext +sv_vsetpvf_mg + +=implementation + +#if { VERSION >= 5.004 } && !defined(vnewSVpvf) +#if { NEED vnewSVpvf } + +SV * +vnewSVpvf(pTHX_ const char *pat, va_list *args) +{ + register SV *sv = newSV(0); + sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); + return sv; +} + +#endif +#endif + +#if { VERSION >= 5.004 } && !defined(sv_vcatpvf) +# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) +#endif + +#if { VERSION >= 5.004 } && !defined(sv_vsetpvf) +# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) +#endif + +#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg) +#if { NEED sv_catpvf_mg } + +void +sv_catpvf_mg(pTHX_ SV *sv, const char *pat, ...) +{ + va_list args; + va_start(args, pat); + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif +#endif + +#ifdef PERL_IMPLICIT_CONTEXT +#if { VERSION >= 5.004 } && !defined(sv_catpvf_mg_nocontext) +#if { NEED sv_catpvf_mg_nocontext } + +void +sv_catpvf_mg_nocontext(SV *sv, const char *pat, ...) +{ + dTHX; + va_list args; + va_start(args, pat); + sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif +#endif +#endif + +/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */ +#ifndef sv_catpvf_mg +# ifdef PERL_IMPLICIT_CONTEXT +# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext +# else +# define sv_catpvf_mg Perl_sv_catpvf_mg +# endif +#endif + +#if { VERSION >= 5.004 } && !defined(sv_vcatpvf_mg) +# define sv_vcatpvf_mg(sv, pat, args) \ + STMT_START { \ + sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ + SvSETMAGIC(sv); \ + } STMT_END +#endif + +#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg) +#if { NEED sv_setpvf_mg } + +void +sv_setpvf_mg(pTHX_ SV *sv, const char *pat, ...) +{ + va_list args; + va_start(args, pat); + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif +#endif + +#ifdef PERL_IMPLICIT_CONTEXT +#if { VERSION >= 5.004 } && !defined(sv_setpvf_mg_nocontext) +#if { NEED sv_setpvf_mg_nocontext } + +void +sv_setpvf_mg_nocontext(SV *sv, const char *pat, ...) +{ + dTHX; + va_list args; + va_start(args, pat); + sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); + SvSETMAGIC(sv); + va_end(args); +} + +#endif +#endif +#endif + +/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */ +#ifndef sv_setpvf_mg +# ifdef PERL_IMPLICIT_CONTEXT +# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext +# else +# define sv_setpvf_mg Perl_sv_setpvf_mg +# endif +#endif + +#if { VERSION >= 5.004 } && !defined(sv_vsetpvf_mg) +# define sv_vsetpvf_mg(sv, pat, args) \ + STMT_START { \ + sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ + SvSETMAGIC(sv); \ + } STMT_END +#endif + +=xsinit + +#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 + +=xsmisc + +static SV * test_vnewSVpvf(pTHX_ const char *pat, ...) +{ + SV *sv; + va_list args; + va_start(args, pat); +#if { VERSION >= 5.004 } + sv = vnewSVpvf(pat, &args); +#else + sv = newSVpv((char *) 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 { VERSION >= 5.004 } + sv_vcatpvf(sv, pat, &args); +#else + sv_catpv(sv, (char *) pat); +#endif + va_end(args); +} + +static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...) +{ + va_list args; + va_start(args, pat); +#if { VERSION >= 5.004 } + sv_vsetpvf(sv, pat, &args); +#else + sv_setpv(sv, (char *) pat); +#endif + va_end(args); +} + +=xsubs + +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 { VERSION >= 5.004 } + sv_catpvf_mg(sv, "%s-%d", "Perl", 42); +#endif + +void +Perl_sv_catpvf_mg(sv) + SV *sv + CODE: +#if { VERSION >= 5.004 } + Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43); +#endif + +void +sv_catpvf_mg_nocontext(sv) + SV *sv + CODE: +#if { VERSION >= 5.004 } +#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 { VERSION >= 5.004 } + sv_setpvf_mg(sv, "%s-%d", "mhx", 42); +#endif + +void +Perl_sv_setpvf_mg(sv) + SV *sv + CODE: +#if { VERSION >= 5.004 } + Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43); +#endif + +void +sv_setpvf_mg_nocontext(sv) + SV *sv + CODE: +#if { VERSION >= 5.004 } +#ifdef PERL_IMPLICIT_CONTEXT + sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44); +#else + sv_setpvf_mg(sv, "%s-%d", "bar", 44); +#endif +#endif + +=tests plan => 9 + +use Tie::Hash; +my %h; +tie %h, 'Tie::StdHash'; +$h{foo} = 'foo-'; +$h{bar} = ''; + +ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d'); +ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d'); +ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d'); + +&Devel::PPPort::sv_catpvf_mg($h{foo}); +ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-'); + +&Devel::PPPort::Perl_sv_catpvf_mg($h{foo}); +ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-'); + +&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo}); +ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-'); + +&Devel::PPPort::sv_setpvf_mg($h{bar}); +ok($h{bar}, $] >= 5.004 ? 'mhx-42' : ''); + +&Devel::PPPort::Perl_sv_setpvf_mg($h{bar}); +ok($h{bar}, $] >= 5.004 ? 'foo-43' : ''); + +&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar}); +ok($h{bar}, $] >= 5.004 ? 'bar-44' : ''); diff --git a/dist/Devel-PPPort/parts/inc/threads b/dist/Devel-PPPort/parts/inc/threads new file mode 100644 index 0000000000..830fadfb4b --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/threads @@ -0,0 +1,68 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +__UNDEFINED__ +aTHXR +aTHXR_ +dTHXR + +=implementation + +__UNDEFINED__ dTHR dNOOP + +__UNDEFINED__ dTHX dNOOP +__UNDEFINED__ dTHXa(x) dNOOP + +__UNDEFINED__ pTHX void +__UNDEFINED__ pTHX_ +__UNDEFINED__ aTHX +__UNDEFINED__ aTHX_ + +#if { VERSION < 5.6.0 } +# ifdef USE_THREADS +# define aTHXR thr +# define aTHXR_ thr, +# else +# define aTHXR +# define aTHXR_ +# endif +# define dTHXR dTHR +#else +# define aTHXR aTHX +# define aTHXR_ aTHX_ +# define dTHXR dTHX +#endif + +__UNDEFINED__ dTHXoa(x) dTHXa(x) + +=xsubs + +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); + +=tests plan => 2 + +ok(&Devel::PPPort::no_THX_arg("42"), 43); +eval { &Devel::PPPort::with_THX_arg("yes\n"); }; +ok($@ =~ /^yes/); diff --git a/dist/Devel-PPPort/parts/inc/uv b/dist/Devel-PPPort/parts/inc/uv new file mode 100644 index 0000000000..c1831e9c06 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/uv @@ -0,0 +1,122 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +__UNDEFINED__ +SvUOK + +=implementation + +__UNDEFINED__ sv_setuv(sv, uv) \ + STMT_START { \ + UV TeMpUv = uv; \ + if (TeMpUv <= IV_MAX) \ + sv_setiv(sv, TeMpUv); \ + else \ + sv_setnv(sv, (double)TeMpUv); \ + } STMT_END + +__UNDEFINED__ newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) + +__UNDEFINED__ sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) +__UNDEFINED__ SvUVX(sv) ((UV)SvIVX(sv)) +__UNDEFINED__ SvUVXx(sv) SvUVX(sv) +__UNDEFINED__ SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) +__UNDEFINED__ SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) + +/* Hint: sv_uv + * Always use the SvUVx() macro instead of sv_uv(). + */ +__UNDEFINED__ sv_uv(sv) SvUVx(sv) + +#if !defined(SvUOK) && defined(SvIOK_UV) +# define SvUOK(sv) SvIOK_UV(sv) +#endif + +__UNDEFINED__ XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) +__UNDEFINED__ XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END + +__UNDEFINED__ PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END +__UNDEFINED__ XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END + +=xsubs + +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); + +=tests plan => 10 + +ok(&Devel::PPPort::sv_setuv(42), 42); +ok(&Devel::PPPort::newSVuv(123), 123); +ok(&Devel::PPPort::sv_2uv("4711"), 4711); +ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559); +ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559); +ok(&Devel::PPPort::SvUVx(1735928559), 1735928559); +ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef); +ok(&Devel::PPPort::XSRETURN_UV(), 42); +ok(&Devel::PPPort::PUSHu(), 42); +ok(&Devel::PPPort::XPUSHu(), 43); diff --git a/dist/Devel-PPPort/parts/inc/variables b/dist/Devel-PPPort/parts/inc/variables new file mode 100644 index 0000000000..afa53a6833 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/variables @@ -0,0 +1,491 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +PL_ppaddr +PL_no_modify +PL_DBsignal +PL_DBsingle +PL_DBsub +PL_DBtrace +PL_Sv +PL_bufend +PL_bufptr +PL_compiling +PL_copline +PL_curcop +PL_curstash +PL_debstash +PL_defgv +PL_diehook +PL_dirty +PL_dowarn +PL_errgv +PL_error_count +PL_expect +PL_hexdigit +PL_hints +PL_in_my +PL_in_my_stash +PL_laststatval +PL_lex_state +PL_lex_stuff +PL_linestr +PL_na +PL_parser +PL_perl_destruct_level +PL_perldb +PL_rsfp_filters +PL_rsfp +PL_stack_base +PL_stack_sp +PL_statcache +PL_stdingv +PL_sv_arenaroot +PL_sv_no +PL_sv_undef +PL_sv_yes +PL_tainted +PL_tainting +PL_tokenbuf +PL_signals +PERL_SIGNALS_UNSAFE_FLAG + +=implementation + +#ifndef PERL_SIGNALS_UNSAFE_FLAG + +#define PERL_SIGNALS_UNSAFE_FLAG 0x0001 + +#if { VERSION < 5.8.0 } +# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG +#else +# define D_PPP_PERL_SIGNALS_INIT 0 +#endif + +__NEED_VAR__ U32 PL_signals = D_PPP_PERL_SIGNALS_INIT; + +#endif + +/* Hint: PL_ppaddr + * Calling an op via PL_ppaddr requires passing a context argument + * for threaded builds. Since the context argument is different for + * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will + * automatically be defined as the correct argument. + */ + +#if { VERSION <= 5.005_05 } +/* Replace: 1 */ +# define PL_ppaddr ppaddr +# define PL_no_modify no_modify +/* Replace: 0 */ +#endif + +#if { VERSION <= 5.004_05 } +/* Replace: 1 */ +# define PL_DBsignal DBsignal +# define PL_DBsingle DBsingle +# define PL_DBsub DBsub +# define PL_DBtrace DBtrace +# define PL_Sv Sv +# define PL_bufend bufend +# define PL_bufptr bufptr +# define PL_compiling compiling +# define PL_copline copline +# define PL_curcop curcop +# define PL_curstash curstash +# define PL_debstash debstash +# define PL_defgv defgv +# define PL_diehook diehook +# define PL_dirty dirty +# define PL_dowarn dowarn +# define PL_errgv errgv +# define PL_error_count error_count +# define PL_expect expect +# define PL_hexdigit hexdigit +# define PL_hints hints +# define PL_in_my in_my +# define PL_laststatval laststatval +# define PL_lex_state lex_state +# define PL_lex_stuff lex_stuff +# define PL_linestr linestr +# define PL_na na +# define PL_perl_destruct_level perl_destruct_level +# define PL_perldb perldb +# define PL_rsfp_filters rsfp_filters +# define PL_rsfp rsfp +# define PL_stack_base stack_base +# define PL_stack_sp stack_sp +# define PL_statcache statcache +# define PL_stdingv stdingv +# define PL_sv_arenaroot sv_arenaroot +# define PL_sv_no sv_no +# define PL_sv_undef sv_undef +# define PL_sv_yes sv_yes +# define PL_tainted tainted +# define PL_tainting tainting +# define PL_tokenbuf tokenbuf +/* Replace: 0 */ +#endif + +/* Warning: PL_parser + * For perl versions earlier than 5.9.5, this is an always + * non-NULL dummy. Also, it cannot be dereferenced. Don't + * use it if you can avoid is and unless you absolutely know + * what you're doing. + * If you always check that PL_parser is non-NULL, you can + * define DPPP_PL_parser_NO_DUMMY to avoid the creation of + * a dummy parser structure. + */ + +#if { VERSION >= 5.9.5 } +# ifdef DPPP_PL_parser_NO_DUMMY +# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \ + (croak("panic: PL_parser == NULL in %s:%d", \ + __FILE__, __LINE__), (yy_parser *) NULL))->var) +# else +# ifdef DPPP_PL_parser_NO_DUMMY_WARNING +# define D_PPP_parser_dummy_warning(var) +# else +# define D_PPP_parser_dummy_warning(var) \ + warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__), +# endif +# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \ + (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var) +__NEED_DUMMY_VAR__ yy_parser PL_parser; +# endif + +/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */ +/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf + * Do not use this variable unless you know exactly what you're + * doing. It is internal to the perl parser and may change or even + * be removed in the future. As of perl 5.9.5, you have to check + * for (PL_parser != NULL) for this variable to have any effect. + * An always non-NULL PL_parser dummy is provided for earlier + * perl versions. + * If PL_parser is NULL when you try to access this variable, a + * dummy is being accessed instead and a warning is issued unless + * you define DPPP_PL_parser_NO_DUMMY_WARNING. + * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access + * this variable will croak with a panic message. + */ + +# define PL_expect D_PPP_my_PL_parser_var(expect) +# define PL_copline D_PPP_my_PL_parser_var(copline) +# define PL_rsfp D_PPP_my_PL_parser_var(rsfp) +# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters) +# define PL_linestr D_PPP_my_PL_parser_var(linestr) +# define PL_bufptr D_PPP_my_PL_parser_var(bufptr) +# define PL_bufend D_PPP_my_PL_parser_var(bufend) +# define PL_lex_state D_PPP_my_PL_parser_var(lex_state) +# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff) +# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf) +# define PL_in_my D_PPP_my_PL_parser_var(in_my) +# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash) +# define PL_error_count D_PPP_my_PL_parser_var(error_count) + + +#else + +/* ensure that PL_parser != NULL and cannot be dereferenced */ +# define PL_parser ((void *) 1) + +#endif + +=xsinit + +#define NEED_PL_signals +#define NEED_PL_parser +#define DPPP_PL_parser_NO_DUMMY_WARNING + +=xsmisc + +U32 get_PL_signals_1(void) +{ +#ifdef PERL_NO_GET_CONTEXT + dTHX; +#endif + return PL_signals; +} + +extern U32 get_PL_signals_2(void); +extern U32 get_PL_signals_3(void); +int no_dummy_parser_vars(int); +int dummy_parser_warning(void); + +/* No PTRSIZE IN 5.004 and below, so PTR2IV would warn and possibly misbehave */ +#if { VERSION > 5.004 } + #define ppp_TESTVAR(var) STMT_START { mXPUSHi(PTR2IV(&var)); count++; } STMT_END +#else + #define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var); count++; } STMT_END +#endif + +#define ppp_PARSERVAR(type, var) STMT_START { \ + type volatile my_ ## var; \ + type volatile *my_p_ ## var; \ + my_ ## var = var; \ + my_p_ ## var = &var; \ + var = my_ ## var; \ + var = *my_p_ ## var; \ + mXPUSHi(&var != NULL); \ + count++; \ + } STMT_END + +#define ppp_PARSERVAR_dummy STMT_START { \ + mXPUSHi(1); \ + count++; \ + } STMT_END + +#if { VERSION < 5.004 } +# define ppp_rsfp_t FILE * +#else +# define ppp_rsfp_t PerlIO * +#endif + +#if { VERSION < 5.6.0 } +# define ppp_expect_t expectation +#elif { VERSION < 5.9.5 } +# define ppp_expect_t int +#else +# define ppp_expect_t U8 +#endif + +#if { VERSION < 5.9.5 } +# define ppp_lex_state_t U32 +#else +# define ppp_lex_state_t U8 +#endif + +#if { VERSION < 5.6.0 } +# define ppp_in_my_t bool +#elif { VERSION < 5.9.5 } +# define ppp_in_my_t I32 +#else +# define ppp_in_my_t U16 +#endif + +#if { VERSION < 5.9.5 } +# define ppp_error_count_t I32 +#else +# define ppp_error_count_t U8 +#endif + +=xsubs + +int +compare_PL_signals() + CODE: + { + U32 ref = get_PL_signals_1(); + RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3(); + } + OUTPUT: + RETVAL + +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 * +PL_Sv() + CODE: + PL_Sv = newSVpv("mhx", 0); + RETVAL = PL_Sv; + OUTPUT: + RETVAL + +SV * +PL_tokenbuf() + CODE: + RETVAL = newSViv(PL_tokenbuf[0]); + OUTPUT: + RETVAL + +SV * +PL_parser() + CODE: + RETVAL = newSViv(PL_parser != NULL); + OUTPUT: + RETVAL + +SV * +PL_hexdigit() + CODE: + RETVAL = newSVpv((char *) PL_hexdigit, 0); + OUTPUT: + RETVAL + +SV * +PL_hints() + CODE: + RETVAL = newSViv((IV) PL_hints); + OUTPUT: + RETVAL + +void +PL_ppaddr(string) + char *string + PPCODE: + PUSHMARK(SP); + mXPUSHs(newSVpv(string, 0)); + PUTBACK; + ENTER; + (void)*(PL_ppaddr[OP_UC])(aTHXR); + SPAGAIN; + LEAVE; + XSRETURN(1); + +void +other_variables() + PREINIT: + int count = 0; + PPCODE: + ppp_TESTVAR(PL_DBsignal); + ppp_TESTVAR(PL_DBsingle); + ppp_TESTVAR(PL_DBsub); + ppp_TESTVAR(PL_DBtrace); + ppp_TESTVAR(PL_compiling); + ppp_TESTVAR(PL_curcop); + ppp_TESTVAR(PL_curstash); + ppp_TESTVAR(PL_debstash); + ppp_TESTVAR(PL_defgv); + ppp_TESTVAR(PL_diehook); +#if { VERSION >= 5.13.7 } + /* can't get a pointer any longer */ + mXPUSHi(PL_dirty ? 1 : 1); + count++; +#else + ppp_TESTVAR(PL_dirty); +#endif + ppp_TESTVAR(PL_dowarn); + ppp_TESTVAR(PL_errgv); + ppp_TESTVAR(PL_laststatval); + ppp_TESTVAR(PL_no_modify); + ppp_TESTVAR(PL_perl_destruct_level); + ppp_TESTVAR(PL_perldb); + ppp_TESTVAR(PL_stack_base); + ppp_TESTVAR(PL_stack_sp); + ppp_TESTVAR(PL_statcache); + ppp_TESTVAR(PL_stdingv); + ppp_TESTVAR(PL_sv_arenaroot); + ppp_TESTVAR(PL_tainted); + ppp_TESTVAR(PL_tainting); + + ppp_PARSERVAR(ppp_expect_t, PL_expect); + ppp_PARSERVAR(line_t, PL_copline); + ppp_PARSERVAR(ppp_rsfp_t, PL_rsfp); + ppp_PARSERVAR(AV *, PL_rsfp_filters); + ppp_PARSERVAR(SV *, PL_linestr); + ppp_PARSERVAR(char *, PL_bufptr); + ppp_PARSERVAR(char *, PL_bufend); + ppp_PARSERVAR(ppp_lex_state_t, PL_lex_state); + ppp_PARSERVAR(SV *, PL_lex_stuff); + ppp_PARSERVAR(ppp_error_count_t, PL_error_count); + ppp_PARSERVAR(ppp_in_my_t, PL_in_my); +#if { VERSION >= 5.5.0 } + ppp_PARSERVAR(HV*, PL_in_my_stash); +#else + ppp_PARSERVAR_dummy; +#endif + XSRETURN(count); + +int +no_dummy_parser_vars(check) + int check + +int +dummy_parser_warning() + +=tests plan => 52 + +ok(Devel::PPPort::compare_PL_signals()); + +ok(!defined(&Devel::PPPort::PL_sv_undef())); +ok(&Devel::PPPort::PL_sv_yes()); +ok(!&Devel::PPPort::PL_sv_no()); +ok(&Devel::PPPort::PL_na("abcd"), 4); +ok(&Devel::PPPort::PL_Sv(), "mhx"); +ok(defined &Devel::PPPort::PL_tokenbuf()); +ok($] >= 5.009005 || &Devel::PPPort::PL_parser()); +ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/); +ok(defined &Devel::PPPort::PL_hints()); +ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX"); + +for (&Devel::PPPort::other_variables()) { + ok($_ != 0); +} + +{ + my @w; + my $fail = 0; + { + local $SIG{'__WARN__'} = sub { push @w, @_ }; + ok(&Devel::PPPort::dummy_parser_warning()); + } + if ($] >= 5.009005) { + ok(@w >= 0); + for (@w) { + print "# $_"; + unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) { + warn $_; + $fail++; + } + } + } + else { + ok(@w == 0); + } + ok($fail, 0); +} + +ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0)); + +eval { &Devel::PPPort::no_dummy_parser_vars(0) }; + +if ($] < 5.009005) { + ok($@, ''); +} +else { + if ($@) { + print "# $@"; + ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i); + } + else { + ok(1); + } +} diff --git a/dist/Devel-PPPort/parts/inc/version b/dist/Devel-PPPort/parts/inc/version new file mode 100644 index 0000000000..1d5c556af4 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/version @@ -0,0 +1,52 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +PERL_REVISION +PERL_VERSION +PERL_SUBVERSION +PERL_BCDVERSION + +=dontwarn + +PERL_PATCHLEVEL_H_IMPLICIT +_dpppDEC2BCD + +=implementation + +#ifndef PERL_REVISION +# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION)) +# define PERL_PATCHLEVEL_H_IMPLICIT +# include <patchlevel.h> +# endif +# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) +# include <could_not_find_Perl_patchlevel.h> +# endif +# ifndef PERL_REVISION +# define PERL_REVISION (5) + /* Replace: 1 */ +# define PERL_VERSION PATCHLEVEL +# define PERL_SUBVERSION SUBVERSION + /* Replace PERL_PATCHLEVEL with PERL_VERSION */ + /* Replace: 0 */ +# endif +#endif + +#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10)) +#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION)) + +/* It is very unlikely that anyone will try to use this with Perl 6 + (or greater), but who knows. + */ +#if PERL_REVISION != 5 +# error ppport.h only works with Perl version 5 +#endif /* PERL_REVISION != 5 */ diff --git a/dist/Devel-PPPort/parts/inc/warn b/dist/Devel-PPPort/parts/inc/warn new file mode 100644 index 0000000000..8f8f8ff337 --- /dev/null +++ b/dist/Devel-PPPort/parts/inc/warn @@ -0,0 +1,168 @@ +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2013, 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. +## +################################################################################ + +=provides + +__UNDEFINED__ +ckWARN +warner +Perl_warner +Perl_warner_nocontext + +=implementation + +__UNDEFINED__ WARN_ALL 0 +__UNDEFINED__ WARN_CLOSURE 1 +__UNDEFINED__ WARN_DEPRECATED 2 +__UNDEFINED__ WARN_EXITING 3 +__UNDEFINED__ WARN_GLOB 4 +__UNDEFINED__ WARN_IO 5 +__UNDEFINED__ WARN_CLOSED 6 +__UNDEFINED__ WARN_EXEC 7 +__UNDEFINED__ WARN_LAYER 8 +__UNDEFINED__ WARN_NEWLINE 9 +__UNDEFINED__ WARN_PIPE 10 +__UNDEFINED__ WARN_UNOPENED 11 +__UNDEFINED__ WARN_MISC 12 +__UNDEFINED__ WARN_NUMERIC 13 +__UNDEFINED__ WARN_ONCE 14 +__UNDEFINED__ WARN_OVERFLOW 15 +__UNDEFINED__ WARN_PACK 16 +__UNDEFINED__ WARN_PORTABLE 17 +__UNDEFINED__ WARN_RECURSION 18 +__UNDEFINED__ WARN_REDEFINE 19 +__UNDEFINED__ WARN_REGEXP 20 +__UNDEFINED__ WARN_SEVERE 21 +__UNDEFINED__ WARN_DEBUGGING 22 +__UNDEFINED__ WARN_INPLACE 23 +__UNDEFINED__ WARN_INTERNAL 24 +__UNDEFINED__ WARN_MALLOC 25 +__UNDEFINED__ WARN_SIGNAL 26 +__UNDEFINED__ WARN_SUBSTR 27 +__UNDEFINED__ WARN_SYNTAX 28 +__UNDEFINED__ WARN_AMBIGUOUS 29 +__UNDEFINED__ WARN_BAREWORD 30 +__UNDEFINED__ WARN_DIGIT 31 +__UNDEFINED__ WARN_PARENTHESIS 32 +__UNDEFINED__ WARN_PRECEDENCE 33 +__UNDEFINED__ WARN_PRINTF 34 +__UNDEFINED__ WARN_PROTOTYPE 35 +__UNDEFINED__ WARN_QW 36 +__UNDEFINED__ WARN_RESERVED 37 +__UNDEFINED__ WARN_SEMICOLON 38 +__UNDEFINED__ WARN_TAINT 39 +__UNDEFINED__ WARN_THREADS 40 +__UNDEFINED__ WARN_UNINITIALIZED 41 +__UNDEFINED__ WARN_UNPACK 42 +__UNDEFINED__ WARN_UNTIE 43 +__UNDEFINED__ WARN_UTF8 44 +__UNDEFINED__ WARN_VOID 45 +__UNDEFINED__ WARN_ASSERTIONS 46 + +__UNDEFINED__ packWARN(a) (a) + +#ifndef ckWARN +# ifdef G_WARN_ON +# define ckWARN(a) (PL_dowarn & G_WARN_ON) +# else +# define ckWARN(a) PL_dowarn +# endif +#endif + +#if { VERSION >= 5.004 } && !defined(warner) +#if { NEED warner } + +void +warner(U32 err, const char *pat, ...) +{ + SV *sv; + va_list args; + + PERL_UNUSED_ARG(err); + + va_start(args, pat); + sv = vnewSVpvf(pat, &args); + va_end(args); + sv_2mortal(sv); + warn("%s", SvPV_nolen(sv)); +} + +#define warner Perl_warner + +#define Perl_warner_nocontext Perl_warner + +#endif +#endif + +=xsinit + +#define NEED_warner + +=xsubs + +void +warner() + CODE: +#if { VERSION >= 5.004 } + warner(packWARN(WARN_MISC), "warner %s:%d", "bar", 42); +#endif + +void +Perl_warner() + CODE: +#if { VERSION >= 5.004 } + Perl_warner(aTHX_ packWARN(WARN_MISC), "Perl_warner %s:%d", "bar", 42); +#endif + +void +Perl_warner_nocontext() + CODE: +#if { VERSION >= 5.004 } + Perl_warner_nocontext(packWARN(WARN_MISC), "Perl_warner_nocontext %s:%d", "bar", 42); +#endif + +void +ckWARN() + CODE: +#if { VERSION >= 5.004 } + if (ckWARN(WARN_MISC)) + Perl_warner_nocontext(packWARN(WARN_MISC), "ckWARN %s:%d", "bar", 42); +#endif + +=tests plan => 5 + +$^W = 0; + +my $warning; + +$SIG{'__WARN__'} = sub { $warning = $_[0] }; + +$warning = ''; +Devel::PPPort::warner(); +ok($] >= 5.004 ? $warning =~ /^warner bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_warner(); +ok($] >= 5.004 ? $warning =~ /^Perl_warner bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_warner_nocontext(); +ok($] >= 5.004 ? $warning =~ /^Perl_warner_nocontext bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::ckWARN(); +ok($warning, ''); + +$^W = 1; + +$warning = ''; +Devel::PPPort::ckWARN(); +ok($] >= 5.004 ? $warning =~ /^ckWARN bar:42/ : $warning eq ''); diff --git a/dist/Devel-PPPort/parts/ppport.fnc b/dist/Devel-PPPort/parts/ppport.fnc new file mode 100644 index 0000000000..efa648f81e --- /dev/null +++ b/dist/Devel-PPPort/parts/ppport.fnc @@ -0,0 +1,23 @@ +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +: +: Perl/Pollution/Portability +: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +: +: Version 3.x, Copyright (C) 2004-2013, 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. +: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: + +: +: This file lists all API functions/macros that are provided purely +: by Devel::PPPort. It is in the same format as the F<embed.fnc> that +: ships with the Perl source code. +: + +Am |void |sv_magic_portable|NN SV* sv|NULLOK SV* obj|int how|NULLOK const char* name \ + |I32 namlen diff --git a/dist/Devel-PPPort/parts/ppptools.pl b/dist/Devel-PPPort/parts/ppptools.pl new file mode 100644 index 0000000000..62e533909d --- /dev/null +++ b/dist/Devel-PPPort/parts/ppptools.pl @@ -0,0 +1,404 @@ +################################################################################ +# +# ppptools.pl -- various utility functions +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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. +# +################################################################################ + +sub cat_file +{ + eval { require File::Spec }; + return $@ ? join('/', @_) : File::Spec->catfile(@_); +} + +sub all_files_in_dir +{ + my $dir = shift; + local *DIR; + + opendir DIR, $dir or die "cannot open directory $dir: $!\n"; + my @files = grep { !-d && !/^\./ } readdir DIR; # no dirs or hidden files + closedir DIR; + + return map { cat_file($dir, $_) } sort @files; +} + +sub parse_todo +{ + my $dir = shift || 'parts/todo'; + local *TODO; + my %todo; + my $todo; + + for $todo (all_files_in_dir($dir)) { + open TODO, $todo or die "cannot open $todo: $!\n"; + my $perl = <TODO>; + chomp $perl; + while (<TODO>) { + chomp; + s/#.*//; + s/^\s+//; s/\s+$//; + /^\s*$/ and next; + /^\w+$/ or die "invalid identifier: $_\n"; + exists $todo{$_} and die "duplicate identifier: $_ ($todo{$_} <=> $perl)\n"; + $todo{$_} = $perl; + } + close TODO; + } + + return \%todo; +} + +sub expand_version +{ + my($op, $ver) = @_; + my($r, $v, $s) = parse_version($ver); + $r == 5 or die "only Perl revision 5 is supported\n"; + my $bcdver = sprintf "0x%d%03d%03d", $r, $v, $s; + return "(PERL_BCDVERSION $op $bcdver)"; +} + +sub parse_partspec +{ + my $file = shift; + my $section = 'implementation'; + my $vsec = join '|', qw( provides dontwarn implementation + xsubs xsinit xsmisc xshead xsboot tests ); + my(%data, %options); + local *F; + + open F, $file or die "$file: $!\n"; + while (<F>) { + /[ \t]+$/ and warn "$file:$.: warning: trailing whitespace\n"; + if ($section eq 'implementation') { + m!//! && !m!(?:=~|s/).*//! && !m!(?:ht|f)tp(?:s)://! + and warn "$file:$.: warning: potential C++ comment\n"; + } + /^##/ and next; + if (/^=($vsec)(?:\s+(.*))?/) { + $section = $1; + if (defined $2) { + my $opt = $2; + $options{$section} = eval "{ $opt }"; + $@ and die "$file:$.: invalid options ($opt) in section $section: $@\n"; + } + next; + } + push @{$data{$section}}, $_; + } + close F; + + for (keys %data) { + my @v = @{$data{$_}}; + shift @v while @v && $v[0] =~ /^\s*$/; + pop @v while @v && $v[-1] =~ /^\s*$/; + $data{$_} = join '', @v; + } + + unless (exists $data{provides}) { + $data{provides} = ($file =~ /(\w+)\.?$/)[0]; + } + $data{provides} = [$data{provides} =~ /(\S+)/g]; + + if (exists $data{dontwarn}) { + $data{dontwarn} = [$data{dontwarn} =~ /(\S+)/g]; + } + + my @prov; + my %proto; + + if (exists $data{tests} && (!exists $data{implementation} || $data{implementation} !~ /\S/)) { + $data{implementation} = ''; + } + else { + $data{implementation} =~ /\S/ or die "Empty implementation in $file\n"; + + my $p; + + for $p (@{$data{provides}}) { + if ($p =~ m#^/.*/\w*$#) { + my @tmp = eval "\$data{implementation} =~ ${p}gm"; + $@ and die "invalid regex $p in $file\n"; + @tmp or warn "no matches for regex $p in $file\n"; + push @prov, do { my %h; grep !$h{$_}++, @tmp }; + } + elsif ($p eq '__UNDEFINED__') { + my @tmp = $data{implementation} =~ /^\s*__UNDEFINED__[^\r\n\S]+(\w+)/gm; + @tmp or warn "no __UNDEFINED__ macros in $file\n"; + push @prov, @tmp; + } + else { + push @prov, $p; + } + } + + for (@prov) { + if ($data{implementation} !~ /\b\Q$_\E\b/) { + warn "$file claims to provide $_, but doesn't seem to do so\n"; + next; + } + + # scan for prototypes + my($proto) = $data{implementation} =~ / + ( ^ (?:[\w*]|[^\S\r\n])+ + [\r\n]*? + ^ \b$_\b \s* + \( [^{]* \) + ) + \s* \{ + /xm or next; + + $proto =~ s/^\s+//; + $proto =~ s/\s+$//; + $proto =~ s/\s+/ /g; + + exists $proto{$_} and warn "$file: duplicate prototype for $_\n"; + $proto{$_} = $proto; + } + } + + for $section (qw( implementation xsubs xsinit xsmisc xshead xsboot )) { + if (exists $data{$section}) { + $data{$section} =~ s/\{\s*version\s*(<|>|==|!=|>=|<=)\s*([\d._]+)\s*\}/expand_version($1, $2)/gei; + } + } + + $data{provides} = \@prov; + $data{prototypes} = \%proto; + $data{OPTIONS} = \%options; + + my %prov = map { ($_ => 1) } @prov; + my %dontwarn = exists $data{dontwarn} ? map { ($_ => 1) } @{$data{dontwarn}} : (); + my @maybeprov = do { my %h; + grep { + my($nop) = /^Perl_(.*)/; + not exists $prov{$_} || + exists $dontwarn{$_} || + /^D_PPP_/ || + (defined $nop && exists $prov{$nop} ) || + (defined $nop && exists $dontwarn{$nop}) || + $h{$_}++; + } + $data{implementation} =~ /^\s*#\s*define\s+(\w+)/gm }; + + if (@maybeprov) { + warn "$file seems to provide these macros, but doesn't list them:\n " + . join("\n ", @maybeprov) . "\n"; + } + + return \%data; +} + +sub compare_prototypes +{ + my($p1, $p2) = @_; + for ($p1, $p2) { + s/^\s+//; + s/\s+$//; + s/\s+/ /g; + s/(\w)\s(\W)/$1$2/g; + s/(\W)\s(\w)/$1$2/g; + } + return $p1 cmp $p2; +} + +sub ppcond +{ + my $s = shift; + my @c; + my $p; + + for $p (@$s) { + push @c, map "!($_)", @{$p->{pre}}; + defined $p->{cur} and push @c, "($p->{cur})"; + } + + join " && ", @c; +} + +sub trim_arg +{ + my $in = shift; + my $remove = join '|', qw( NN NULLOK VOL ); + + $in eq '...' and return ($in); + + local $_ = $in; + my $id; + + s/[*()]/ /g; + s/\[[^\]]*\]/ /g; + s/\b(?:auto|const|extern|inline|register|static|volatile|restrict)\b//g; + s/\b(?:$remove)\b//; + s/^\s*//; s/\s*$//; + + if( /^\b(?:struct|union|enum)\s+\w+(?:\s+(\w+))?$/ ) { + defined $1 and $id = $1; + } + else { + if( s/\b(?:char|double|float|int|long|short|signed|unsigned|void)\b//g ) { + /^\s*(\w+)\s*$/ and $id = $1; + } + else { + /^\s*\w+\s+(\w+)\s*$/ and $id = $1; + } + } + + $_ = $in; + + defined $id and s/\b$id\b//; + + # these don't matter at all + s/\b(?:auto|extern|inline|register|static|volatile|restrict)\b//g; + s/\b(?:$remove)\b//; + + s/(?=<\*)\s+(?=\*)//g; + s/\s*(\*+)\s*/ $1 /g; + s/^\s*//; s/\s*$//; + s/\s+/ /g; + + return ($_, $id); +} + +sub parse_embed +{ + my @files = @_; + my @func; + my @pps; + my $file; + local *FILE; + + for $file (@files) { + open FILE, $file or die "$file: $!\n"; + my($line, $l); + + while (defined($line = <FILE>)) { + while ($line =~ /\\$/ && defined($l = <FILE>)) { + $line =~ s/\\\s*//; + $line .= $l; + } + next if $line =~ /^\s*:/; + $line =~ s/^\s+|\s+$//gs; + my($dir, $args) = ($line =~ /^\s*#\s*(\w+)(?:\s*(.*?)\s*)?$/); + if (defined $dir and defined $args) { + for ($dir) { + /^ifdef$/ and do { push @pps, { pre => [], cur => "defined($args)" } ; last }; + /^ifndef$/ and do { push @pps, { pre => [], cur => "!defined($args)" } ; last }; + /^if$/ and do { push @pps, { pre => [], cur => $args } ; last }; + /^elif$/ and do { push @{$pps[-1]{pre}}, $pps[-1]{cur}; $pps[-1]{cur} = $args; last }; + /^else$/ and do { push @{$pps[-1]{pre}}, $pps[-1]{cur}; $pps[-1]{cur} = undef; last }; + /^endif$/ and do { pop @pps ; last }; + /^include$/ and last; + /^define$/ and last; + /^undef$/ and last; + warn "unhandled preprocessor directive: $dir\n"; + } + } + else { + my @e = split /\s*\|\s*/, $line; + if( @e >= 3 ) { + my($flags, $ret, $name, @args) = @e; + if ($name =~ /^[^\W\d]\w*$/) { + for (@args) { + $_ = [trim_arg($_)]; + } + ($ret) = trim_arg($ret); + push @func, { + name => $name, + flags => { map { $_, 1 } $flags =~ /./g }, + ret => $ret, + args => \@args, + cond => ppcond(\@pps), + }; + } + elsif ($name =~ /^[^\W\d]\w*-E<gt>[^\W\d]\w*$/) { + # silenty ignore entries of the form + # PL_parser-E<gt>linestr + # which documents a struct entry rather than a function + } + else { + warn "mysterious name [$name] in $file, line $.\n"; + } + } + } + } + + close FILE; + } + + return @func; +} + +sub make_prototype +{ + my $f = shift; + my @args = map { "@$_" } @{$f->{args}}; + my $proto; + my $pTHX_ = exists $f->{flags}{n} ? "" : "pTHX_ "; + $proto = "$f->{ret} $f->{name}" . "($pTHX_" . join(', ', @args) . ')'; + return $proto; +} + +sub format_version +{ + my $ver = shift; + + $ver =~ s/$/000000/; + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; + + $v = int $v; + $s = int $s; + + if ($r < 5 || ($r == 5 && $v < 6)) { + if ($s % 10) { + die "invalid version '$ver'\n"; + } + $s /= 10; + + $ver = sprintf "%d.%03d", $r, $v; + $s > 0 and $ver .= sprintf "_%02d", $s; + + return $ver; + } + + return sprintf "%d.%d.%d", $r, $v, $s; +} + +sub parse_version +{ + my $ver = shift; + + if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { + return ($1, $2, $3); + } + elsif ($ver !~ /^\d+\.[\d_]+$/) { + die "cannot parse version '$ver'\n"; + } + + $ver =~ s/_//g; + $ver =~ s/$/000000/; + + my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; + + $v = int $v; + $s = int $s; + + if ($r < 5 || ($r == 5 && $v < 6)) { + if ($s % 10) { + die "cannot parse version '$ver'\n"; + } + $s /= 10; + } + + return ($r, $v, $s); +} + +1; diff --git a/dist/Devel-PPPort/parts/todo/5003070 b/dist/Devel-PPPort/parts/todo/5003070 new file mode 100644 index 0000000000..df2f847692 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5003070 @@ -0,0 +1,21 @@ +5.003070 +HeHASH # U +HeKEY # U +HeKLEN # U +HeSVKEY # U +HeSVKEY_force # U +HeVAL # U +cv_const_sv # U +do_open # E (Perl_do_open) +gv_efullname3 # U +gv_fullname3 # U +hv_delete_ent # U +hv_exists_ent # U +hv_fetch_ent # U +hv_iterkeysv # U +hv_ksplit # U +hv_store_ent # U +my_pclose # E (Perl_my_pclose) +my_popen # E (Perl_my_popen) +sv_gets # E (Perl_sv_gets) +unsharepvn # U diff --git a/dist/Devel-PPPort/parts/todo/5004000 b/dist/Devel-PPPort/parts/todo/5004000 new file mode 100644 index 0000000000..ec87e88f11 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5004000 @@ -0,0 +1,51 @@ +5.004000 +GIMME_V # E +G_VOID # E +HePV # A +HeSVKEY_set # U +POPu # E +SvSetMagicSV # U +SvSetMagicSV_nosteal # U +SvSetSV_nosteal # U +SvTAINTED # U +SvTAINTED_off # U +SvTAINTED_on # U +block_end # E (Perl_block_end) +block_gimme # U +block_start # E (Perl_block_start) +call_list # U +delimcpy # U +form # U +gv_autoload4 # U +gv_fetchmethod_autoload # U +hv_delayfree_ent # U +hv_free_ent # U +ibcmp_locale # U +intro_my # U +my_failure_exit # U +newSVpvf # U +rsignal # E +rsignal_state # E +save_I16 # U +save_gp # U +share_hek # E +start_subparse # E (Perl_start_subparse) +sv_catpvf # U +sv_catpvf_mg # U +sv_cmp_locale # U +sv_derived_from # U +sv_magic_portable # U +sv_setpvf # U +sv_setpvf_mg # U +sv_taint # U +sv_tainted # U +sv_untaint # U +sv_vcatpvf # U +sv_vcatpvf_mg # U +sv_vcatpvfn # U +sv_vsetpvf # U +sv_vsetpvf_mg # U +sv_vsetpvfn # U +toLOWER_LC # U +vnewSVpvf # U +warner # U diff --git a/dist/Devel-PPPort/parts/todo/5004010 b/dist/Devel-PPPort/parts/todo/5004010 new file mode 100644 index 0000000000..8c29866603 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5004010 @@ -0,0 +1 @@ +5.004010 diff --git a/dist/Devel-PPPort/parts/todo/5004020 b/dist/Devel-PPPort/parts/todo/5004020 new file mode 100644 index 0000000000..4b43fdf8e4 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5004020 @@ -0,0 +1 @@ +5.004020 diff --git a/dist/Devel-PPPort/parts/todo/5004030 b/dist/Devel-PPPort/parts/todo/5004030 new file mode 100644 index 0000000000..e45facbb1f --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5004030 @@ -0,0 +1 @@ +5.004030 diff --git a/dist/Devel-PPPort/parts/todo/5004040 b/dist/Devel-PPPort/parts/todo/5004040 new file mode 100644 index 0000000000..69ccd5d62c --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5004040 @@ -0,0 +1 @@ +5.004040 diff --git a/dist/Devel-PPPort/parts/todo/5004050 b/dist/Devel-PPPort/parts/todo/5004050 new file mode 100644 index 0000000000..0f7a1f73fe --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5004050 @@ -0,0 +1,7 @@ +5.004050 +CopyD # E +MoveD # E +do_binmode # U +my_bcopy # U +save_aelem # U +save_helem # U diff --git a/dist/Devel-PPPort/parts/todo/5005000 b/dist/Devel-PPPort/parts/todo/5005000 new file mode 100644 index 0000000000..e27a06dc8f --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5005000 @@ -0,0 +1,28 @@ +5.005000 +PL_curpad # E +PL_modglobal # E +cx_dump # U +debop # U +debprofdump # U +fbm_compile # E (Perl_fbm_compile) +fbm_instr # E (Perl_fbm_instr) +get_op_descs # U +get_op_names # U +init_stacks # U +mg_length # U +mg_size # U +newHVhv # U +new_stackinfo # E +regdump # U +regexec_flags # U +regnext # E (Perl_regnext) +runops_debug # U +runops_standard # U +save_iv # U (save_iv) +save_op # U +sv_iv # U +sv_nv # U +sv_peek # U +sv_pvn # U +sv_pvn_nomg # U +sv_true # U diff --git a/dist/Devel-PPPort/parts/todo/5005010 b/dist/Devel-PPPort/parts/todo/5005010 new file mode 100644 index 0000000000..deebff5bf8 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5005010 @@ -0,0 +1 @@ +5.005010 diff --git a/dist/Devel-PPPort/parts/todo/5005020 b/dist/Devel-PPPort/parts/todo/5005020 new file mode 100644 index 0000000000..d19ff2ae09 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5005020 @@ -0,0 +1 @@ +5.005020 diff --git a/dist/Devel-PPPort/parts/todo/5005030 b/dist/Devel-PPPort/parts/todo/5005030 new file mode 100644 index 0000000000..885afa0d23 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5005030 @@ -0,0 +1,4 @@ +5.005030 +POPpx # E +get_vtbl # U +save_generic_svref # U diff --git a/dist/Devel-PPPort/parts/todo/5005040 b/dist/Devel-PPPort/parts/todo/5005040 new file mode 100644 index 0000000000..8a165c2033 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5005040 @@ -0,0 +1 @@ +5.005040 diff --git a/dist/Devel-PPPort/parts/todo/5006000 b/dist/Devel-PPPort/parts/todo/5006000 new file mode 100644 index 0000000000..8c8f7df323 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5006000 @@ -0,0 +1,152 @@ +5.006000 +DO_UTF8 # U +PERL_SYS_INIT3 # U +PL_check # E +POPul # E +SvIOK_UV # U +SvIOK_notUV # U +SvIOK_only_UV # U +SvPOK_only_UTF8 # U +SvPVbyte_nolen # U +SvPVbytex # U +SvPVbytex_force # U +SvPVutf8 # U +SvPVutf8_force # U +SvPVutf8_nolen # U +SvPVutf8x # U +SvPVutf8x_force # U +SvUOK # U +SvUTF8 # U +SvUTF8_off # U +SvUTF8_on # U +UTF8SKIP # U +av_delete # U +av_exists # U +call_atexit # E +caller_cx # U +cast_i32 # U (cast_i32) +cast_iv # U (cast_iv) +cast_ulong # U +cast_uv # U (cast_uv) +do_gv_dump # U +do_gvgv_dump # U +do_hv_dump # U +do_magic_dump # U +do_op_dump # U +do_open9 # U +do_pmop_dump # U +do_sv_dump # U +dump_all # U +dump_eval # U +dump_form # U +dump_indent # U +dump_packsubs # U +dump_sub # U +dump_vindent # U +get_context # U +get_ppaddr # E +gv_dump # U +init_i18nl10n # U (perl_init_i18nl10n) +init_i18nl14n # U (perl_init_i18nl14n) +is_uni_alnum # U +is_uni_alnum_lc # U +is_uni_alpha # U +is_uni_alpha_lc # U +is_uni_ascii # U +is_uni_ascii_lc # U +is_uni_cntrl # U +is_uni_cntrl_lc # U +is_uni_digit # U +is_uni_digit_lc # U +is_uni_graph # U +is_uni_graph_lc # U +is_uni_idfirst # U +is_uni_idfirst_lc # U +is_uni_lower # U +is_uni_lower_lc # U +is_uni_print # U +is_uni_print_lc # U +is_uni_punct # U +is_uni_punct_lc # U +is_uni_space # U +is_uni_space_lc # U +is_uni_upper # U +is_uni_upper_lc # U +is_uni_xdigit # U +is_uni_xdigit_lc # U +is_utf8_alnum # U +is_utf8_alpha # U +is_utf8_ascii # U +is_utf8_char # U +is_utf8_cntrl # U +is_utf8_digit # U +is_utf8_graph # U +is_utf8_idfirst # U +is_utf8_lower # U +is_utf8_mark # U +is_utf8_print # U +is_utf8_punct # U +is_utf8_space # U +is_utf8_upper # U +is_utf8_xdigit # U +magic_dump # U +mess # E (Perl_mess) +my_atof # U +my_fflush_all # U +newANONATTRSUB # U +newATTRSUB # U +newXS # E (Perl_newXS) +newXSproto # E +new_collate # U (perl_new_collate) +new_ctype # U (perl_new_ctype) +new_numeric # U (perl_new_numeric) +op_dump # U +perl_parse # E (perl_parse) +pmop_dump # U +re_intuit_string # U +reginitcolors # U +require_pv # U (perl_require_pv) +safesyscalloc # U +safesysfree # U +safesysmalloc # U +safesysrealloc # U +save_I8 # U +save_alloc # U +save_destructor # E (Perl_save_destructor) +save_destructor_x # E +save_re_context # U +save_vptr # U +scan_bin # U +set_context # U +set_numeric_local # U (perl_set_numeric_local) +set_numeric_radix # U +set_numeric_standard # U (perl_set_numeric_standard) +str_to_version # U +sv_2pvutf8 # U +sv_2pvutf8_nolen # U +sv_force_normal # U +sv_len_utf8 # U +sv_pos_b2u # U +sv_pos_u2b # U +sv_pv # U +sv_pvbyte # U +sv_pvbyten # U +sv_pvbyten_force # U +sv_pvutf8 # U +sv_pvutf8n # U +sv_pvutf8n_force # U +sv_rvweaken # U +sv_utf8_decode # U +sv_utf8_downgrade # U +sv_utf8_encode # U +swash_init # U +to_uni_lower_lc # U +to_uni_title_lc # U +to_uni_upper_lc # U +utf8_distance # U +utf8_hop # U +vcroak # U +vform # U +vmess # U +vwarn # U +vwarner # U diff --git a/dist/Devel-PPPort/parts/todo/5006001 b/dist/Devel-PPPort/parts/todo/5006001 new file mode 100644 index 0000000000..3f4ea792ff --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5006001 @@ -0,0 +1,11 @@ +5.006001 +SvGAMAGIC # U +apply_attrs_string # U +bytes_to_utf8 # U +gv_efullname4 # U +gv_fullname4 # U +is_utf8_string # U +save_generic_pvref # U +utf16_to_utf8 # E (Perl_utf16_to_utf8) +utf16_to_utf8_reversed # E (Perl_utf16_to_utf8_reversed) +utf8_to_bytes # U diff --git a/dist/Devel-PPPort/parts/todo/5006002 b/dist/Devel-PPPort/parts/todo/5006002 new file mode 100644 index 0000000000..dfe09ce2c5 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5006002 @@ -0,0 +1 @@ +5.006002 diff --git a/dist/Devel-PPPort/parts/todo/5007000 b/dist/Devel-PPPort/parts/todo/5007000 new file mode 100644 index 0000000000..49d08465db --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5007000 @@ -0,0 +1 @@ +5.007000 diff --git a/dist/Devel-PPPort/parts/todo/5007001 b/dist/Devel-PPPort/parts/todo/5007001 new file mode 100644 index 0000000000..cee6dec845 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5007001 @@ -0,0 +1,23 @@ +5.007001 +ASCII_TO_NEED # U +NATIVE_TO_NEED # U +POPpbytex # E +bytes_from_utf8 # U +despatch_signals # U +do_openn # U +gv_handler # U +is_lvalue_sub # U +my_popen_list # U +save_mortalizesv # U +scan_num # E (Perl_scan_num) +sv_force_normal_flags # U +sv_setref_uv # U +sv_unref_flags # U +sv_utf8_upgrade # E (Perl_sv_utf8_upgrade) +utf8_length # U +utf8_to_uvchr # U +utf8_to_uvuni # U +utf8n_to_uvchr # U +utf8n_to_uvuni # U +uvchr_to_utf8 # U +uvuni_to_utf8 # U diff --git a/dist/Devel-PPPort/parts/todo/5007002 b/dist/Devel-PPPort/parts/todo/5007002 new file mode 100644 index 0000000000..cb28d72bf3 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5007002 @@ -0,0 +1,17 @@ +5.007002 +calloc # U +getcwd_sv # U +init_tm # U +malloc # U +mfree # U +mini_mktime # U +my_atof2 # U +my_strftime # U +op_null # U +realloc # U +sv_catpvn_flags # U +sv_catsv_flags # U +sv_setsv_flags # U +sv_utf8_upgrade_flags # U +sv_utf8_upgrade_nomg # U +swash_fetch # E (Perl_swash_fetch) diff --git a/dist/Devel-PPPort/parts/todo/5007003 b/dist/Devel-PPPort/parts/todo/5007003 new file mode 100644 index 0000000000..c9e1cea6eb --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5007003 @@ -0,0 +1,60 @@ +5.007003 +OP_DESC # U +OP_NAME # U +PL_peepp # E +PerlIO_clearerr # U (PerlIO_clearerr) +PerlIO_close # U (PerlIO_close) +PerlIO_eof # U (PerlIO_eof) +PerlIO_error # U (PerlIO_error) +PerlIO_fileno # U (PerlIO_fileno) +PerlIO_fill # U (PerlIO_fill) +PerlIO_flush # U (PerlIO_flush) +PerlIO_get_base # U (PerlIO_get_base) +PerlIO_get_bufsiz # U (PerlIO_get_bufsiz) +PerlIO_get_cnt # U (PerlIO_get_cnt) +PerlIO_get_ptr # U (PerlIO_get_ptr) +PerlIO_read # U (PerlIO_read) +PerlIO_seek # U (PerlIO_seek) +PerlIO_set_cnt # U (PerlIO_set_cnt) +PerlIO_set_ptrcnt # U (PerlIO_set_ptrcnt) +PerlIO_setlinebuf # U (PerlIO_setlinebuf) +PerlIO_stderr # U (PerlIO_stderr) +PerlIO_stdin # U (PerlIO_stdin) +PerlIO_stdout # U (PerlIO_stdout) +PerlIO_tell # U (PerlIO_tell) +PerlIO_unread # U (PerlIO_unread) +PerlIO_write # U (PerlIO_write) +SvLOCK # U +SvSHARE # U +SvUNLOCK # U +atfork_lock # U +atfork_unlock # U +custom_op_desc # U +custom_op_name # U +deb # U +debstack # U +debstackptrs # U +gv_fetchmeth_autoload # U +ibcmp_utf8 # U +my_fork # U +my_socketpair # U +pack_cat # U +perl_destruct # E (perl_destruct) +pv_uni_display # U +save_shared_pvref # U +savesharedpv # U +sortsv # U +sv_magicext # U +sv_nolocking # U +sv_nosharing # U +sv_recode_to_utf8 # U +sv_uni_display # U +to_uni_fold # U +to_uni_lower # E (Perl_to_uni_lower) +to_uni_title # E (Perl_to_uni_title) +to_uni_upper # E (Perl_to_uni_upper) +to_utf8_case # U +unpack_str # U +uvchr_to_utf8_flags # U +uvuni_to_utf8_flags # U +vdeb # U diff --git a/dist/Devel-PPPort/parts/todo/5008000 b/dist/Devel-PPPort/parts/todo/5008000 new file mode 100644 index 0000000000..3a4d23ec74 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5008000 @@ -0,0 +1,6 @@ +5.008000 +HeUTF8 # U +hv_iternext_flags # U +hv_store_flags # U +is_utf8_idcont # U +nothreadhook # U diff --git a/dist/Devel-PPPort/parts/todo/5008001 b/dist/Devel-PPPort/parts/todo/5008001 new file mode 100644 index 0000000000..adb1eb327c --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5008001 @@ -0,0 +1,18 @@ +5.008001 +CvPADLIST # E +PL_comppad # E +SvVOK # U +doing_taint # U +find_runcv # U +is_utf8_string_loc # U +packlist # U +pad_add_anon # U +pad_new # E +pad_tidy # E +save_bool # U +savestack_grow_cnt # U +seed # U +sv_cat_decode # U +sv_setpviv # U +sv_setpviv_mg # U +unpackstring # U diff --git a/dist/Devel-PPPort/parts/todo/5008002 b/dist/Devel-PPPort/parts/todo/5008002 new file mode 100644 index 0000000000..63aac525fe --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5008002 @@ -0,0 +1 @@ +5.008002 diff --git a/dist/Devel-PPPort/parts/todo/5008003 b/dist/Devel-PPPort/parts/todo/5008003 new file mode 100644 index 0000000000..50c6ce1aa1 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5008003 @@ -0,0 +1,3 @@ +5.008003 +SvIsCOW # U +SvIsCOW_shared_hash # U diff --git a/dist/Devel-PPPort/parts/todo/5008004 b/dist/Devel-PPPort/parts/todo/5008004 new file mode 100644 index 0000000000..bb7bcdf66a --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5008004 @@ -0,0 +1 @@ +5.008004 diff --git a/dist/Devel-PPPort/parts/todo/5008005 b/dist/Devel-PPPort/parts/todo/5008005 new file mode 100644 index 0000000000..7bd2029f4b --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5008005 @@ -0,0 +1 @@ +5.008005 diff --git a/dist/Devel-PPPort/parts/todo/5008006 b/dist/Devel-PPPort/parts/todo/5008006 new file mode 100644 index 0000000000..ba5cad07ed --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5008006 @@ -0,0 +1 @@ +5.008006 diff --git a/dist/Devel-PPPort/parts/todo/5008007 b/dist/Devel-PPPort/parts/todo/5008007 new file mode 100644 index 0000000000..7d656f0b9e --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5008007 @@ -0,0 +1 @@ +5.008007 diff --git a/dist/Devel-PPPort/parts/todo/5008008 b/dist/Devel-PPPort/parts/todo/5008008 new file mode 100644 index 0000000000..f17b19ff4b --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5008008 @@ -0,0 +1 @@ +5.008008 diff --git a/dist/Devel-PPPort/parts/todo/5008009 b/dist/Devel-PPPort/parts/todo/5008009 new file mode 100644 index 0000000000..129e018f45 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5008009 @@ -0,0 +1 @@ +5.008009 diff --git a/dist/Devel-PPPort/parts/todo/5009000 b/dist/Devel-PPPort/parts/todo/5009000 new file mode 100644 index 0000000000..28bc85958e --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5009000 @@ -0,0 +1,6 @@ +5.009000 +new_version # U +save_set_svflags # U +vcmp # U +vnumify # U +vstringify # U diff --git a/dist/Devel-PPPort/parts/todo/5009001 b/dist/Devel-PPPort/parts/todo/5009001 new file mode 100644 index 0000000000..26d2c4c548 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5009001 @@ -0,0 +1,6 @@ +5.009001 +hv_clear_placeholders # U +hv_scalar # U +scan_version # E (Perl_scan_version) +sv_2iv_flags # U +sv_2uv_flags # U diff --git a/dist/Devel-PPPort/parts/todo/5009002 b/dist/Devel-PPPort/parts/todo/5009002 new file mode 100644 index 0000000000..5678492aef --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5009002 @@ -0,0 +1,7 @@ +5.009002 +SvPVbyte_force # U +find_rundefsvoffset # U +op_refcnt_lock # U +op_refcnt_unlock # U +savesvpv # U +vnormal # U diff --git a/dist/Devel-PPPort/parts/todo/5009003 b/dist/Devel-PPPort/parts/todo/5009003 new file mode 100644 index 0000000000..5b9c10ab55 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5009003 @@ -0,0 +1,23 @@ +5.009003 +av_arylen_p # U +ckwarn # U +ckwarn_d # U +csighandler # E (Perl_csighandler) +dMULTICALL # E +doref # U +gv_const_sv # U +hv_eiter_p # U +hv_eiter_set # U +hv_name_set # U +hv_placeholders_get # U +hv_placeholders_set # U +hv_riter_p # U +hv_riter_set # U +is_utf8_string_loclen # U +newGIVENOP # U +newSVhek # U +newWHENOP # U +pad_compname_type # U +savepvs # U +sortsv_flags # U +vverify # U diff --git a/dist/Devel-PPPort/parts/todo/5009004 b/dist/Devel-PPPort/parts/todo/5009004 new file mode 100644 index 0000000000..6295708cd6 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5009004 @@ -0,0 +1,9 @@ +5.009004 +PerlIO_context_layers # U +gv_name_set # U +hv_copy_hints_hv # U +my_vsnprintf # U +newXS_flags # U +regclass_swash # E (Perl_regclass_swash) +sv_does # U +sv_usepvn_flags # U diff --git a/dist/Devel-PPPort/parts/todo/5009005 b/dist/Devel-PPPort/parts/todo/5009005 new file mode 100644 index 0000000000..a8ee73b1c9 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5009005 @@ -0,0 +1,27 @@ +5.009005 +Perl_signbit # U +av_create_and_push # U +av_create_and_unshift_one # U +gv_fetchfile_flags # U +lex_start # E (Perl_lex_start) +mro_get_linear_isa # U +mro_method_changed_in # U +my_dirfd # U +pregcomp # E (Perl_pregcomp) +ptr_table_clear # U +ptr_table_fetch # U +ptr_table_free # U +ptr_table_new # U +ptr_table_split # U +ptr_table_store # U +re_compile # U +reg_named_buff_all # U +reg_named_buff_exists # U +reg_named_buff_fetch # U +reg_named_buff_firstkey # U +reg_named_buff_nextkey # U +reg_named_buff_scalar # U +regfree_internal # U +savesharedpvn # U +scan_vstring # E (Perl_scan_vstring) +upg_version # E (Perl_upg_version) diff --git a/dist/Devel-PPPort/parts/todo/5010000 b/dist/Devel-PPPort/parts/todo/5010000 new file mode 100644 index 0000000000..737f374ef0 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5010000 @@ -0,0 +1,7 @@ +5.010000 +hv_common # U +hv_common_key_len # U +sv_destroyable # U +sys_init # U +sys_init3 # U +sys_term # U diff --git a/dist/Devel-PPPort/parts/todo/5010001 b/dist/Devel-PPPort/parts/todo/5010001 new file mode 100644 index 0000000000..4ec5eee492 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5010001 @@ -0,0 +1,13 @@ +5.010001 +croak_xs_usage # U +mro_get_from_name # U +mro_get_private_data # U +mro_register # U +mro_set_mro # U +mro_set_private_data # U +save_hints # U +save_padsv_and_mortalize # U +save_pushi32ptr # U +save_pushptr # U +save_pushptrptr # U +sv_insert_flags # U diff --git a/dist/Devel-PPPort/parts/todo/5011000 b/dist/Devel-PPPort/parts/todo/5011000 new file mode 100644 index 0000000000..805d8b19ac --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5011000 @@ -0,0 +1,14 @@ +5.011000 +Gv_AMupdate # E (Perl_Gv_AMupdate) +PL_opfreehook # E +SVt_REGEXP # E +SvOOK_offset # U +av_iter_p # U +gv_add_by_type # U +is_ascii_string # U +pregfree2 # U +save_adelete # U +save_aelem_flags # U +save_hdelete # U +save_helem_flags # U +sv_utf8_upgrade_flags_grow # U diff --git a/dist/Devel-PPPort/parts/todo/5011001 b/dist/Devel-PPPort/parts/todo/5011001 new file mode 100644 index 0000000000..f42409363b --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5011001 @@ -0,0 +1,6 @@ +5.011001 +ck_warner # U +ck_warner_d # U +is_utf8_perl_space # U +is_utf8_perl_word # U +is_utf8_posix_digit # U diff --git a/dist/Devel-PPPort/parts/todo/5011002 b/dist/Devel-PPPort/parts/todo/5011002 new file mode 100644 index 0000000000..df12d99fd6 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5011002 @@ -0,0 +1,13 @@ +5.011002 +PL_keyword_plugin # E +lex_bufutf8 # U +lex_discard_to # U +lex_grow_linestr # U +lex_next_chunk # U +lex_peek_unichar # U +lex_read_space # U +lex_read_to # U +lex_read_unichar # U +lex_stuff_pvn # U +lex_stuff_sv # U +lex_unstuff # U diff --git a/dist/Devel-PPPort/parts/todo/5011003 b/dist/Devel-PPPort/parts/todo/5011003 new file mode 100644 index 0000000000..3fd94ca1b6 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5011003 @@ -0,0 +1 @@ +5.011003 diff --git a/dist/Devel-PPPort/parts/todo/5011004 b/dist/Devel-PPPort/parts/todo/5011004 new file mode 100644 index 0000000000..86c1fce4f2 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5011004 @@ -0,0 +1,2 @@ +5.011004 +prescan_version # U diff --git a/dist/Devel-PPPort/parts/todo/5011005 b/dist/Devel-PPPort/parts/todo/5011005 new file mode 100644 index 0000000000..d9b0d6a4c9 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5011005 @@ -0,0 +1,2 @@ +5.011005 +sv_pos_u2b_flags # U diff --git a/dist/Devel-PPPort/parts/todo/5012000 b/dist/Devel-PPPort/parts/todo/5012000 new file mode 100644 index 0000000000..82cbce2d6d --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5012000 @@ -0,0 +1 @@ +5.012000 diff --git a/dist/Devel-PPPort/parts/todo/5012001 b/dist/Devel-PPPort/parts/todo/5012001 new file mode 100644 index 0000000000..90dc03fdf3 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5012001 @@ -0,0 +1 @@ +5.012001 diff --git a/dist/Devel-PPPort/parts/todo/5012002 b/dist/Devel-PPPort/parts/todo/5012002 new file mode 100644 index 0000000000..8ab87f08d8 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5012002 @@ -0,0 +1 @@ +5.012002 diff --git a/dist/Devel-PPPort/parts/todo/5012003 b/dist/Devel-PPPort/parts/todo/5012003 new file mode 100644 index 0000000000..f2abab4c17 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5012003 @@ -0,0 +1 @@ +5.012003 diff --git a/dist/Devel-PPPort/parts/todo/5012004 b/dist/Devel-PPPort/parts/todo/5012004 new file mode 100644 index 0000000000..e7319cd566 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5012004 @@ -0,0 +1 @@ +5.012004 diff --git a/dist/Devel-PPPort/parts/todo/5012005 b/dist/Devel-PPPort/parts/todo/5012005 new file mode 100644 index 0000000000..5af01305ef --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5012005 @@ -0,0 +1 @@ +5.012005 diff --git a/dist/Devel-PPPort/parts/todo/5013000 b/dist/Devel-PPPort/parts/todo/5013000 new file mode 100644 index 0000000000..f2f116d2fa --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5013000 @@ -0,0 +1 @@ +5.013000 diff --git a/dist/Devel-PPPort/parts/todo/5013001 b/dist/Devel-PPPort/parts/todo/5013001 new file mode 100644 index 0000000000..679bf3c35e --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5013001 @@ -0,0 +1,6 @@ +5.013001 +croak_sv # U +die_sv # U +mess_sv # U +sv_2nv_flags # U +warn_sv # U diff --git a/dist/Devel-PPPort/parts/todo/5013002 b/dist/Devel-PPPort/parts/todo/5013002 new file mode 100644 index 0000000000..fa6d99b407 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5013002 @@ -0,0 +1,9 @@ +5.013002 +SvNV_nomg # U +find_rundefsv # U +foldEQ # U +foldEQ_locale # U +foldEQ_utf8 # U +hv_fill # U +sv_dec_nomg # U +sv_inc_nomg # U diff --git a/dist/Devel-PPPort/parts/todo/5013003 b/dist/Devel-PPPort/parts/todo/5013003 new file mode 100644 index 0000000000..5e04f03c8a --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5013003 @@ -0,0 +1,3 @@ +5.013003 +blockhook_register # E +croak_no_modify # U diff --git a/dist/Devel-PPPort/parts/todo/5013004 b/dist/Devel-PPPort/parts/todo/5013004 new file mode 100644 index 0000000000..8aac89eb8d --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5013004 @@ -0,0 +1 @@ +5.013004 diff --git a/dist/Devel-PPPort/parts/todo/5013005 b/dist/Devel-PPPort/parts/todo/5013005 new file mode 100644 index 0000000000..e9cd3e8b5f --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5013005 @@ -0,0 +1,5 @@ +5.013005 +PL_rpeepp # E +isOCTAL # U +lex_stuff_pvs # U +parse_fullstmt # U diff --git a/dist/Devel-PPPort/parts/todo/5013006 b/dist/Devel-PPPort/parts/todo/5013006 new file mode 100644 index 0000000000..d145f36839 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5013006 @@ -0,0 +1,32 @@ +5.013006 +LINKLIST # U +SvTRUE_nomg # U +ck_entersub_args_list # U +ck_entersub_args_proto # U +ck_entersub_args_proto_or_list # U +cv_get_call_checker # E +cv_set_call_checker # E +isWORDCHAR # U +lex_stuff_pv # U +mg_free_type # U +newSVpv_share # U +op_append_elem # U +op_append_list # U +op_contextualize # U +op_linklist # U +op_prepend_elem # U +parse_stmtseq # U +rv2cv_op_cv # U +savesharedpvs # U +savesharedsvpv # U +sv_2bool_flags # U +sv_catpv_flags # U +sv_catpv_nomg # U +sv_catpvs_flags # U +sv_catpvs_mg # U +sv_catpvs_nomg # U +sv_cmp_flags # U +sv_cmp_locale_flags # U +sv_collxfrm_flags # U +sv_eq_flags # U +sv_setpvs_mg # U diff --git a/dist/Devel-PPPort/parts/todo/5013007 b/dist/Devel-PPPort/parts/todo/5013007 new file mode 100644 index 0000000000..c70717f6a5 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5013007 @@ -0,0 +1,35 @@ +5.013007 +HvENAME # U +OP_CLASS # U +XopFLAGS # E +amagic_deref_call # U +bytes_cmp_utf8 # U +cop_hints_2hv # A +cop_hints_fetch_pv # U +cop_hints_fetch_pvn # U +cop_hints_fetch_pvs # U +cop_hints_fetch_sv # U +cophh_2hv # E +cophh_copy # E +cophh_delete_pv # E +cophh_delete_pvn # E +cophh_delete_pvs # E +cophh_delete_sv # E +cophh_fetch_pv # E +cophh_fetch_pvn # E +cophh_fetch_pvs # E +cophh_fetch_sv # E +cophh_free # E +cophh_store_pv # E +cophh_store_pvn # E +cophh_store_pvs # E +cophh_store_sv # E +custom_op_register # E +custom_op_xop # E +newFOROP # A +newWHILEOP # A +op_lvalue # U +op_scope # U +parse_barestmt # U +parse_block # U +parse_label # U diff --git a/dist/Devel-PPPort/parts/todo/5013008 b/dist/Devel-PPPort/parts/todo/5013008 new file mode 100644 index 0000000000..8e95c5d313 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5013008 @@ -0,0 +1,6 @@ +5.013008 +foldEQ_latin1 # U +parse_arithexpr # U +parse_fullexpr # U +parse_listexpr # U +parse_termexpr # U diff --git a/dist/Devel-PPPort/parts/todo/5013009 b/dist/Devel-PPPort/parts/todo/5013009 new file mode 100644 index 0000000000..51160ae344 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5013009 @@ -0,0 +1 @@ +5.013009 diff --git a/dist/Devel-PPPort/parts/todo/5013010 b/dist/Devel-PPPort/parts/todo/5013010 new file mode 100644 index 0000000000..d7f4365bfb --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5013010 @@ -0,0 +1,4 @@ +5.013010 +foldEQ_utf8_flags # U +is_utf8_xidcont # U +is_utf8_xidfirst # U diff --git a/dist/Devel-PPPort/parts/todo/5013011 b/dist/Devel-PPPort/parts/todo/5013011 new file mode 100644 index 0000000000..a33715f749 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5013011 @@ -0,0 +1 @@ +5.013011 diff --git a/dist/Devel-PPPort/parts/todo/5014000 b/dist/Devel-PPPort/parts/todo/5014000 new file mode 100644 index 0000000000..3f837ef4d0 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5014000 @@ -0,0 +1,2 @@ +5.014000 +_to_uni_fold_flags # U diff --git a/dist/Devel-PPPort/parts/todo/5014001 b/dist/Devel-PPPort/parts/todo/5014001 new file mode 100644 index 0000000000..098fb03c9f --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5014001 @@ -0,0 +1 @@ +5.014001 diff --git a/dist/Devel-PPPort/parts/todo/5014002 b/dist/Devel-PPPort/parts/todo/5014002 new file mode 100644 index 0000000000..f280bd0f4f --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5014002 @@ -0,0 +1 @@ +5.014002 diff --git a/dist/Devel-PPPort/parts/todo/5014003 b/dist/Devel-PPPort/parts/todo/5014003 new file mode 100644 index 0000000000..333e50d1db --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5014003 @@ -0,0 +1 @@ +5.014003 diff --git a/dist/Devel-PPPort/parts/todo/5014004 b/dist/Devel-PPPort/parts/todo/5014004 new file mode 100644 index 0000000000..1618e365ea --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5014004 @@ -0,0 +1 @@ +5.014004 diff --git a/dist/Devel-PPPort/parts/todo/5015000 b/dist/Devel-PPPort/parts/todo/5015000 new file mode 100644 index 0000000000..d8c6546d72 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5015000 @@ -0,0 +1 @@ +5.015000 diff --git a/dist/Devel-PPPort/parts/todo/5015001 b/dist/Devel-PPPort/parts/todo/5015001 new file mode 100644 index 0000000000..144926b124 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5015001 @@ -0,0 +1,11 @@ +5.015001 +cop_fetch_label # U +cop_store_label # U +pad_add_name_pv # U +pad_add_name_pvn # U +pad_add_name_pvs # U +pad_add_name_sv # U +pad_findmy_pv # U +pad_findmy_pvn # U +pad_findmy_pvs # U +pad_findmy_sv # U diff --git a/dist/Devel-PPPort/parts/todo/5015002 b/dist/Devel-PPPort/parts/todo/5015002 new file mode 100644 index 0000000000..06741283d1 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5015002 @@ -0,0 +1 @@ +5.015002 diff --git a/dist/Devel-PPPort/parts/todo/5015003 b/dist/Devel-PPPort/parts/todo/5015003 new file mode 100644 index 0000000000..7f33df7128 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5015003 @@ -0,0 +1 @@ +5.015003 diff --git a/dist/Devel-PPPort/parts/todo/5015004 b/dist/Devel-PPPort/parts/todo/5015004 new file mode 100644 index 0000000000..d92eabc673 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5015004 @@ -0,0 +1,30 @@ +5.015004 +HvENAMELEN # U +HvENAMEUTF8 # U +HvNAMELEN # U +HvNAMEUTF8 # U +gv_autoload_pv # U +gv_autoload_pvn # U +gv_autoload_sv # U +gv_fetchmeth_pv # U +gv_fetchmeth_pv_autoload # U +gv_fetchmeth_pvn # U +gv_fetchmeth_pvn_autoload # U +gv_fetchmeth_sv # U +gv_fetchmeth_sv_autoload # U +gv_fetchmethod_pv_flags # U +gv_fetchmethod_pvn_flags # U +gv_fetchmethod_sv_flags # U +gv_init_pv # U +gv_init_sv # U +newGVgen_flags # U +sv_derived_from_pv # U +sv_derived_from_pvn # U +sv_derived_from_sv # U +sv_does_pv # U +sv_does_pvn # U +sv_does_sv # U +sv_ref # U +whichsig_pv # U +whichsig_pvn # U +whichsig_sv # U diff --git a/dist/Devel-PPPort/parts/todo/5015005 b/dist/Devel-PPPort/parts/todo/5015005 new file mode 100644 index 0000000000..1908a935e3 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5015005 @@ -0,0 +1 @@ +5.015005 diff --git a/dist/Devel-PPPort/parts/todo/5015006 b/dist/Devel-PPPort/parts/todo/5015006 new file mode 100644 index 0000000000..4fb3c7c590 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5015006 @@ -0,0 +1,2 @@ +5.015006 +newCONSTSUB_flags # A diff --git a/dist/Devel-PPPort/parts/todo/5015007 b/dist/Devel-PPPort/parts/todo/5015007 new file mode 100644 index 0000000000..ce9078968a --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5015007 @@ -0,0 +1,8 @@ +5.015007 +toLOWER_utf8 # U +toTITLE_utf8 # U +toUPPER_utf8 # U +to_utf8_fold # U +to_utf8_lower # U +to_utf8_title # U +to_utf8_upper # U diff --git a/dist/Devel-PPPort/parts/todo/5015008 b/dist/Devel-PPPort/parts/todo/5015008 new file mode 100644 index 0000000000..14c640388c --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5015008 @@ -0,0 +1,3 @@ +5.015008 +is_utf8_char_buf # U +wrap_op_checker # U diff --git a/dist/Devel-PPPort/parts/todo/5015009 b/dist/Devel-PPPort/parts/todo/5015009 new file mode 100644 index 0000000000..30537f0445 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5015009 @@ -0,0 +1,5 @@ +5.015009 +utf8_to_uvchr_buf # U +utf8_to_uvuni_buf # U +valid_utf8_to_uvchr # U +valid_utf8_to_uvuni # U diff --git a/dist/Devel-PPPort/parts/todo/5016000 b/dist/Devel-PPPort/parts/todo/5016000 new file mode 100644 index 0000000000..3bd46b7362 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5016000 @@ -0,0 +1 @@ +5.016000 diff --git a/dist/Devel-PPPort/parts/todo/5016001 b/dist/Devel-PPPort/parts/todo/5016001 new file mode 100644 index 0000000000..5e2b46c776 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5016001 @@ -0,0 +1 @@ +5.016001 diff --git a/dist/Devel-PPPort/parts/todo/5016002 b/dist/Devel-PPPort/parts/todo/5016002 new file mode 100644 index 0000000000..dfd939f684 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5016002 @@ -0,0 +1 @@ +5.016002 diff --git a/dist/Devel-PPPort/parts/todo/5016003 b/dist/Devel-PPPort/parts/todo/5016003 new file mode 100644 index 0000000000..88e54eb950 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5016003 @@ -0,0 +1 @@ +5.016003 diff --git a/dist/Devel-PPPort/parts/todo/5017000 b/dist/Devel-PPPort/parts/todo/5017000 new file mode 100644 index 0000000000..bf56b9a68a --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5017000 @@ -0,0 +1 @@ +5.017000 diff --git a/dist/Devel-PPPort/parts/todo/5017001 b/dist/Devel-PPPort/parts/todo/5017001 new file mode 100644 index 0000000000..6c9994352a --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5017001 @@ -0,0 +1 @@ +5.017001 diff --git a/dist/Devel-PPPort/parts/todo/5017002 b/dist/Devel-PPPort/parts/todo/5017002 new file mode 100644 index 0000000000..fd825e14bc --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5017002 @@ -0,0 +1,7 @@ +5.017002 +is_uni_blank # U +is_uni_blank_lc # U +is_utf8_blank # U +sv_copypv_flags # U +sv_copypv_nomg # U +sv_vcatpvfn_flags # U diff --git a/dist/Devel-PPPort/parts/todo/5017003 b/dist/Devel-PPPort/parts/todo/5017003 new file mode 100644 index 0000000000..5022764547 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5017003 @@ -0,0 +1 @@ +5.017003 diff --git a/dist/Devel-PPPort/parts/todo/5017004 b/dist/Devel-PPPort/parts/todo/5017004 new file mode 100644 index 0000000000..0202125888 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5017004 @@ -0,0 +1,5 @@ +5.017004 +PL_comppad_name # E +PadlistREFCNT # U +newMYSUB # E (Perl_newMYSUB) +newSVpadname # E diff --git a/dist/Devel-PPPort/parts/todo/5017005 b/dist/Devel-PPPort/parts/todo/5017005 new file mode 100644 index 0000000000..31dfb1c383 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5017005 @@ -0,0 +1 @@ +5.017005 diff --git a/dist/Devel-PPPort/parts/todo/5017006 b/dist/Devel-PPPort/parts/todo/5017006 new file mode 100644 index 0000000000..0bb2486239 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5017006 @@ -0,0 +1,2 @@ +5.017006 +READ_XDIGIT # U diff --git a/dist/Devel-PPPort/parts/todo/5017007 b/dist/Devel-PPPort/parts/todo/5017007 new file mode 100644 index 0000000000..c95c23505f --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5017007 @@ -0,0 +1,7 @@ +5.017007 +SvREFCNT_dec_NN # U +_is_uni_perl_idstart # U +_is_utf8_perl_idstart # U +is_uni_alnumc # U +is_uni_alnumc_lc # U +is_utf8_alnumc # U diff --git a/dist/Devel-PPPort/parts/todo/5017008 b/dist/Devel-PPPort/parts/todo/5017008 new file mode 100644 index 0000000000..9228a1506d --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5017008 @@ -0,0 +1,8 @@ +5.017008 +_is_uni_FOO # U +_is_uni_perl_idcont # U +_is_utf8_FOO # U +_is_utf8_mark # U +_is_utf8_perl_idcont # U +isALPHANUMERIC # U +isIDCONT # U diff --git a/dist/Devel-PPPort/parts/todo/5017009 b/dist/Devel-PPPort/parts/todo/5017009 new file mode 100644 index 0000000000..fd72827040 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5017009 @@ -0,0 +1,3 @@ +5.017009 +av_tindex # U +av_top_index # U diff --git a/dist/Devel-PPPort/parts/todo/5017010 b/dist/Devel-PPPort/parts/todo/5017010 new file mode 100644 index 0000000000..fed2762e9b --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5017010 @@ -0,0 +1 @@ +5.017010 diff --git a/dist/Devel-PPPort/parts/todo/5017011 b/dist/Devel-PPPort/parts/todo/5017011 new file mode 100644 index 0000000000..5fcf051681 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5017011 @@ -0,0 +1 @@ +5.017011 diff --git a/dist/Devel-PPPort/parts/todo/5018000 b/dist/Devel-PPPort/parts/todo/5018000 new file mode 100644 index 0000000000..17729d0b74 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5018000 @@ -0,0 +1,2 @@ +5.018000 +hv_rand_set # U diff --git a/dist/Devel-PPPort/parts/todo/5018001 b/dist/Devel-PPPort/parts/todo/5018001 new file mode 100644 index 0000000000..5d4bb8f500 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5018001 @@ -0,0 +1 @@ +5.018001 diff --git a/dist/Devel-PPPort/parts/todo/5018002 b/dist/Devel-PPPort/parts/todo/5018002 new file mode 100644 index 0000000000..17291bcf13 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5018002 @@ -0,0 +1 @@ +5.018002 diff --git a/dist/Devel-PPPort/parts/todo/5018003 b/dist/Devel-PPPort/parts/todo/5018003 new file mode 100644 index 0000000000..4d40f26283 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5018003 @@ -0,0 +1 @@ +5.018003 diff --git a/dist/Devel-PPPort/parts/todo/5018004 b/dist/Devel-PPPort/parts/todo/5018004 new file mode 100644 index 0000000000..f137cc2ad7 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5018004 @@ -0,0 +1 @@ +5.018004 diff --git a/dist/Devel-PPPort/parts/todo/5019000 b/dist/Devel-PPPort/parts/todo/5019000 new file mode 100644 index 0000000000..a6e8e03493 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5019000 @@ -0,0 +1 @@ +5.019000 diff --git a/dist/Devel-PPPort/parts/todo/5019001 b/dist/Devel-PPPort/parts/todo/5019001 new file mode 100644 index 0000000000..803ad9abff --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5019001 @@ -0,0 +1,6 @@ +5.019001 +re_intuit_start # A +toFOLD # U +toFOLD_utf8 # U +toLOWER_L1 # U +toTITLE # U diff --git a/dist/Devel-PPPort/parts/todo/5019002 b/dist/Devel-PPPort/parts/todo/5019002 new file mode 100644 index 0000000000..5af71fbeae --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5019002 @@ -0,0 +1,2 @@ +5.019002 +SVt_INVLIST # E diff --git a/dist/Devel-PPPort/parts/todo/5019003 b/dist/Devel-PPPort/parts/todo/5019003 new file mode 100644 index 0000000000..488ef60b2f --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5019003 @@ -0,0 +1,3 @@ +5.019003 +croak_memory_wrap # U (Perl_croak_memory_wrap) +sv_pos_b2u_flags # U diff --git a/dist/Devel-PPPort/parts/todo/5019004 b/dist/Devel-PPPort/parts/todo/5019004 new file mode 100644 index 0000000000..1aa2023c9f --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5019004 @@ -0,0 +1,4 @@ +5.019004 +append_utf8_from_native_byte # U +is_safe_syscall # U +uvoffuni_to_utf8_flags # U diff --git a/dist/Devel-PPPort/parts/todo/5019005 b/dist/Devel-PPPort/parts/todo/5019005 new file mode 100644 index 0000000000..69dcd69aef --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5019005 @@ -0,0 +1 @@ +5.019005 diff --git a/dist/Devel-PPPort/parts/todo/5019006 b/dist/Devel-PPPort/parts/todo/5019006 new file mode 100644 index 0000000000..f14fb0c0c4 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5019006 @@ -0,0 +1 @@ +5.019006 diff --git a/dist/Devel-PPPort/parts/todo/5019007 b/dist/Devel-PPPort/parts/todo/5019007 new file mode 100644 index 0000000000..c34055ea2a --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5019007 @@ -0,0 +1,2 @@ +5.019007 +OP_TYPE_IS # U diff --git a/dist/Devel-PPPort/parts/todo/5019008 b/dist/Devel-PPPort/parts/todo/5019008 new file mode 100644 index 0000000000..8fe2e2f1de --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5019008 @@ -0,0 +1 @@ +5.019008 diff --git a/dist/Devel-PPPort/parts/todo/5019009 b/dist/Devel-PPPort/parts/todo/5019009 new file mode 100644 index 0000000000..7706f723a0 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5019009 @@ -0,0 +1,5 @@ +5.019009 +_to_utf8_fold_flags # A +_to_utf8_lower_flags # A +_to_utf8_title_flags # A +_to_utf8_upper_flags # A diff --git a/dist/Devel-PPPort/parts/todo/5019010 b/dist/Devel-PPPort/parts/todo/5019010 new file mode 100644 index 0000000000..8bdae66ddb --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5019010 @@ -0,0 +1,2 @@ +5.019010 +OP_TYPE_IS_OR_WAS # U diff --git a/dist/Devel-PPPort/parts/todo/5019011 b/dist/Devel-PPPort/parts/todo/5019011 new file mode 100644 index 0000000000..2436c20fa6 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5019011 @@ -0,0 +1 @@ +5.019011 diff --git a/dist/Devel-PPPort/parts/todo/5020000 b/dist/Devel-PPPort/parts/todo/5020000 new file mode 100644 index 0000000000..0c90925944 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5020000 @@ -0,0 +1 @@ +5.020000 diff --git a/dist/Devel-PPPort/parts/todo/5020001 b/dist/Devel-PPPort/parts/todo/5020001 new file mode 100644 index 0000000000..1448fe7920 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5020001 @@ -0,0 +1 @@ +5.020001 diff --git a/dist/Devel-PPPort/parts/todo/5020002 b/dist/Devel-PPPort/parts/todo/5020002 new file mode 100644 index 0000000000..e31c0d0f49 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5020002 @@ -0,0 +1 @@ +5.020002 diff --git a/dist/Devel-PPPort/parts/todo/5020003 b/dist/Devel-PPPort/parts/todo/5020003 new file mode 100644 index 0000000000..89ec61981a --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5020003 @@ -0,0 +1 @@ +5.020003 diff --git a/dist/Devel-PPPort/parts/todo/5021000 b/dist/Devel-PPPort/parts/todo/5021000 new file mode 100644 index 0000000000..b3138ab9c5 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5021000 @@ -0,0 +1 @@ +5.021000 diff --git a/dist/Devel-PPPort/parts/todo/5021001 b/dist/Devel-PPPort/parts/todo/5021001 new file mode 100644 index 0000000000..6e66213f6e --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5021001 @@ -0,0 +1,12 @@ +5.021001 +_is_in_locale_category # U +_is_utf8_char_slow # U +_is_utf8_idcont # U +_is_utf8_idstart # U +_is_utf8_xidcont # U +_is_utf8_xidstart # U +isALNUM_lazy # U +isIDFIRST_lazy # U +isUTF8_CHAR # U +markstack_grow # E (Perl_markstack_grow) +my_strerror # U diff --git a/dist/Devel-PPPort/parts/todo/5021002 b/dist/Devel-PPPort/parts/todo/5021002 new file mode 100644 index 0000000000..abe5ac1246 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5021002 @@ -0,0 +1,3 @@ +5.021002 +grok_number_flags # U +op_sibling_splice # U diff --git a/dist/Devel-PPPort/parts/todo/5021004 b/dist/Devel-PPPort/parts/todo/5021004 new file mode 100644 index 0000000000..3a62526e13 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5021004 @@ -0,0 +1,5 @@ +5.021004 +cv_set_call_checker_flags # U +grok_infnan # U +isinfnan # U +sync_locale # U diff --git a/dist/Devel-PPPort/parts/todo/5021005 b/dist/Devel-PPPort/parts/todo/5021005 new file mode 100644 index 0000000000..2a02ad28b6 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5021005 @@ -0,0 +1,4 @@ +5.021005 +cv_name # A +newMETHOP # U +newMETHOP_named # U diff --git a/dist/Devel-PPPort/parts/todo/5021006 b/dist/Devel-PPPort/parts/todo/5021006 new file mode 100644 index 0000000000..fbefd16d47 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5021006 @@ -0,0 +1,3 @@ +5.021006 +newDEFSVOP # U +op_convert_list # U diff --git a/dist/Devel-PPPort/parts/todo/5021007 b/dist/Devel-PPPort/parts/todo/5021007 new file mode 100644 index 0000000000..6b8b9ba707 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5021007 @@ -0,0 +1,9 @@ +5.021007 +PadnameUTF8 # E +is_invariant_string # U +newPADNAMELIST # U +newPADNAMEouter # U +newPADNAMEpvn # U +newUNOP_AUX # E +padnamelist_fetch # U +padnamelist_store # U diff --git a/dist/Devel-PPPort/parts/todo/5021008 b/dist/Devel-PPPort/parts/todo/5021008 new file mode 100644 index 0000000000..ccba00cb34 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5021008 @@ -0,0 +1,2 @@ +5.021008 +sv_get_backrefs # U diff --git a/dist/Devel-PPPort/parts/todo/5021009 b/dist/Devel-PPPort/parts/todo/5021009 new file mode 100644 index 0000000000..7397722a25 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5021009 @@ -0,0 +1 @@ +5.021009 diff --git a/dist/Devel-PPPort/parts/todo/5021010 b/dist/Devel-PPPort/parts/todo/5021010 new file mode 100644 index 0000000000..821a8fb629 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5021010 @@ -0,0 +1,2 @@ +5.021010 +DECLARATION_FOR_LC_NUMERIC_MANIPULATION # E diff --git a/dist/Devel-PPPort/parts/todo/5021011 b/dist/Devel-PPPort/parts/todo/5021011 new file mode 100644 index 0000000000..22e7302154 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5021011 @@ -0,0 +1 @@ +5.021011 diff --git a/dist/Devel-PPPort/parts/todo/5022000 b/dist/Devel-PPPort/parts/todo/5022000 new file mode 100644 index 0000000000..aca319e5cd --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5022000 @@ -0,0 +1,2 @@ +5.022000 +UVCHR_SKIP # U diff --git a/dist/Devel-PPPort/parts/todo/5022001 b/dist/Devel-PPPort/parts/todo/5022001 new file mode 100644 index 0000000000..28befba2cd --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5022001 @@ -0,0 +1 @@ +5.022001 diff --git a/dist/Devel-PPPort/parts/todo/5023000 b/dist/Devel-PPPort/parts/todo/5023000 new file mode 100644 index 0000000000..e461a32669 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5023000 @@ -0,0 +1 @@ +5.023000 diff --git a/dist/Devel-PPPort/parts/todo/5023001 b/dist/Devel-PPPort/parts/todo/5023001 new file mode 100644 index 0000000000..ea44212d3c --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5023001 @@ -0,0 +1 @@ +5.023001 diff --git a/dist/Devel-PPPort/parts/todo/5023002 b/dist/Devel-PPPort/parts/todo/5023002 new file mode 100644 index 0000000000..2060466c2a --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5023002 @@ -0,0 +1 @@ +5.023002 diff --git a/dist/Devel-PPPort/parts/todo/5023003 b/dist/Devel-PPPort/parts/todo/5023003 new file mode 100644 index 0000000000..4b19a2410a --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5023003 @@ -0,0 +1 @@ +5.023003 diff --git a/dist/Devel-PPPort/parts/todo/5023004 b/dist/Devel-PPPort/parts/todo/5023004 new file mode 100644 index 0000000000..ce60a67e7a --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5023004 @@ -0,0 +1 @@ +5.023004 diff --git a/dist/Devel-PPPort/parts/todo/5023005 b/dist/Devel-PPPort/parts/todo/5023005 new file mode 100644 index 0000000000..1b8818c372 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5023005 @@ -0,0 +1 @@ +5.023005 diff --git a/dist/Devel-PPPort/parts/todo/5023006 b/dist/Devel-PPPort/parts/todo/5023006 new file mode 100644 index 0000000000..f6c59949af --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5023006 @@ -0,0 +1 @@ +5.023006 diff --git a/dist/Devel-PPPort/parts/todo/5023007 b/dist/Devel-PPPort/parts/todo/5023007 new file mode 100644 index 0000000000..fb7c55335d --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5023007 @@ -0,0 +1 @@ +5.023007 diff --git a/dist/Devel-PPPort/parts/todo/5023008 b/dist/Devel-PPPort/parts/todo/5023008 new file mode 100644 index 0000000000..ed2ef6d2eb --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5023008 @@ -0,0 +1,22 @@ +5.023008 +clear_defarray # U +cx_popblock # U +cx_popeval # U +cx_popformat # U +cx_popgiven # U +cx_poploop # U +cx_popsub # U +cx_popsub_args # U +cx_popsub_common # U +cx_popwhen # U +cx_pushblock # U +cx_pusheval # U +cx_pushformat # U +cx_pushgiven # U +cx_pushloop_for # U +cx_pushloop_plain # U +cx_pushsub # U +cx_pushwhen # U +cx_topblock # U +leave_adjust_stacks # U +savetmps # U diff --git a/dist/Devel-PPPort/parts/todo/5023009 b/dist/Devel-PPPort/parts/todo/5023009 new file mode 100644 index 0000000000..336b09a3ee --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5023009 @@ -0,0 +1,5 @@ +5.023009 +toFOLD_uvchr # U +toLOWER_uvchr # U +toTITLE_uvchr # U +toUPPER_uvchr # U diff --git a/dist/Devel-PPPort/parts/todo/5024000 b/dist/Devel-PPPort/parts/todo/5024000 new file mode 100644 index 0000000000..6a5e2484a1 --- /dev/null +++ b/dist/Devel-PPPort/parts/todo/5024000 @@ -0,0 +1,45 @@ +5.024000 +BhkDISABLE # E +BhkENABLE # E +BhkENTRY_set # E +MULTICALL # E +PERL_SYS_TERM # E +POP_MULTICALL # E +PUSH_MULTICALL # E +PadARRAY # E +PadMAX # E +PadlistARRAY # E +PadlistMAX # E +PadlistNAMES # E +PadlistNAMESARRAY # E +PadlistNAMESMAX # E +PadnameLEN # E +PadnamePV # E +PadnameREFCNT # E +PadnameREFCNT_dec # E +PadnameSV # E +PadnamelistARRAY # E +PadnamelistMAX # E +PadnamelistREFCNT # E +PadnamelistREFCNT_dec # E +RESTORE_LC_NUMERIC # E +STORE_LC_NUMERIC_FORCE_TO_UNDERLYING # E +STORE_LC_NUMERIC_SET_TO_NEEDED # E +XS_APIVERSION_BOOTCHECK # E +XS_EXTERNAL # E +XS_INTERNAL # E +XS_VERSION_BOOTCHECK # E +XopDISABLE # E +XopENABLE # E +XopENTRY # E +XopENTRYCUSTOM # E +XopENTRY_set # E +cophh_new_empty # E +my_lstat # U (Perl_my_lstat) +my_stat # U (Perl_my_stat) +reentrant_free # U +reentrant_init # U +reentrant_retry # U +reentrant_size # U +ref # U (Perl_ref) +sv_setref_pvs # A diff --git a/dist/Devel-PPPort/ppport_h.PL b/dist/Devel-PPPort/ppport_h.PL new file mode 100644 index 0000000000..b7877b3277 --- /dev/null +++ b/dist/Devel-PPPort/ppport_h.PL @@ -0,0 +1,19 @@ +################################################################################ +# +# ppport_h.PL -- generate ppport.h +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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; +require "./PPPort.pm"; +rename 'ppport.h', 'ppport.old' if -f 'ppport.h'; +unlink "ppport.old" if WriteFile("ppport.h") && -f 'ppport.h'; diff --git a/dist/Devel-PPPort/soak b/dist/Devel-PPPort/soak new file mode 100644 index 0000000000..391cffedf2 --- /dev/null +++ b/dist/Devel-PPPort/soak @@ -0,0 +1,600 @@ +#!/usr/bin/perl -w +################################################################################ +# +# soak -- Test Perl modules with multiple Perl releases. +# +# Original Author: Paul Marquess +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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 File::Find; +use List::Util qw(max); +use Config; + +my $VERSION = '3.36'; + +$| = 1; +my %OPT = ( + verbose => 0, + make => $Config{make} || 'make', + min => '5.000', + color => 1, +); + +GetOptions(\%OPT, qw(verbose make=s min=s mmargs=s@ color!)) or pod2usage(2); + +$OPT{mmargs} = [''] unless exists $OPT{mmargs}; +$OPT{min} = parse_version($OPT{min}) - 1e-10; + +sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) } + +my @GoodPerls = map { $_->[0] } + sort { $a->[1] <=> $b->[1] or $a->[0] cmp $b->[0] } + grep { $_->[1] >= $OPT{min} } + map { [$_ => perl_version($_)] } + @ARGV ? SearchPerls(@ARGV) : FindPerls(); + +unless (@GoodPerls) { + print "Sorry, got no Perl binaries for testing.\n\n"; + exit 0; +} + +my $maxlen = max(map length, @GoodPerls) + 3; +my $mmalen = max(map length, @{$OPT{mmargs}}); +$maxlen += $mmalen+3 if $mmalen > 0; + +my $rep = Soak::Reporter->new( verbose => $OPT{verbose} + , color => $OPT{color} + , width => $maxlen + ); + +$SIG{__WARN__} = sub { $rep->warn(@_) }; +$SIG{__DIE__} = sub { $rep->die(@_) }; + +# prime the pump, so the first "make realclean" will work. +runit("$^X Makefile.PL") && runit("$OPT{make} realclean") + or $rep->die("Cannot run $^X Makefile.PL && $OPT{make} realclean\n"); + +my $tot = @GoodPerls*@{$OPT{mmargs}}; + +$rep->set(tests => $tot); + +$rep->status(sprintf("Testing %d version%s / %d configuration%s (%d combination%s)...\n", + cs(@GoodPerls), cs(@{$OPT{mmargs}}), cs($tot))); + +for my $perl (@GoodPerls) { + for my $mm (@{$OPT{mmargs}}) { + $rep->set(perl => $perl, config => $mm); + + $rep->test; + + my @warn_mfpl; + my @warn_make; + my @warn_test; + + my $ok = runit("$perl Makefile.PL $mm", \@warn_mfpl) && + runit("$OPT{make}", \@warn_make) && + runit("$OPT{make} test", \@warn_test); + + $rep->warnings(['Makefile.PL' => \@warn_mfpl], + ['make' => \@warn_make], + ['make test' => \@warn_test]); + + if ($ok) { + $rep->passed; + } + else { + $rep->failed; + } + + runit("$OPT{make} realclean"); + } +} + +exit $rep->finish; + +sub runit +{ + # TODO -- portability alert!! + + my($cmd, $warn) = @_; + $rep->vsay("\n Running [$cmd]"); + my $output = `$cmd 2>&1`; + $output = "\n" unless defined $output; + $output =~ s/^/ > /gm; + $rep->say("\n Output:\n$output") if $OPT{verbose} || $?; + if ($?) { + $rep->warn(" Running '$cmd' failed: $?\n"); + return 0; + } + push @$warn, $output =~ /(warning: .*)/ig; + 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.8.7 5.8.8 + 5.9.0 5.9.1 5.9.2 5.9.3 + ); + + print "Searching for Perl binaries...\n"; + + # 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'; + + my $mm = MM->new( { NAME => 'dummy' }); + my @path = $mm->path; + my @GoodPerls; + + 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; +} + +sub SearchPerls +{ + my @args = @_; + my @perls; + + for my $arg (@args) { + if (-d $arg) { + my @found; + print "Searching for Perl binaries in '$arg'...\n"; + find({ wanted => sub { + $File::Find::name =~ m!perl5[\w._]+$! + and -f $File::Find::name + and -x $File::Find::name + and perl_version($File::Find::name) + and push @found, $File::Find::name; + }, follow => 1 }, $arg); + printf "Found %d Perl binar%s in '%s'.\n\n", cs(@found, 'y', 'ies'), $arg; + push @perls, @found; + } + else { + push @perls, $arg; + } + } + + return @perls; +} + +sub perl_version +{ + my $perl = shift; + my $ver = `$perl -e 'print \$]' 2>&1`; + return $? == 0 && $ver =~ /^\d+\.\d+/ && $ver >= 5 ? $ver : 0; +} + +sub parse_version +{ + my $ver = shift; + + if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { + return $1 + 1e-3*$2 + 1e-6*$3; + } + elsif ($ver =~ /^\d+\.[\d_]+$/) { + $ver =~ s/_//g; + return $ver; + } + + die "cannot parse version '$ver'\n"; +} + +package NoSTDOUT; + +use Tie::Handle; +our @ISA = qw(Tie::Handle); + +sub TIEHANDLE { bless \(my $s = ''), shift } +sub PRINT {} +sub WRITE {} + +package Soak::Reporter; + +use strict; + +sub cs($;$$) { my $x = shift; my($s, $p) = @_ ? @_ : ('', 's'); ($x, $x == 1 ? $s : $p) } + +sub new +{ + my $class = shift; + bless { + tests => undef, + color => 1, + verbose => 0, + @_, + _cur => 0, + _atbol => 1, + _total => 0, + _good => [], + _bad => [], + }, $class; +} + +sub colored +{ + my $self = shift; + + if ($self->{color}) { + my $c = eval { + require Term::ANSIColor; + Term::ANSIColor::colored(@_); + }; + + if ($@) { + $self->{color} = 0; + } + else { + return $c; + } + } + + return $_[0]; +} + +sub _config +{ + my $self = shift; + return $self->{config} =~ /\S+/ ? " ($self->{config})" : ''; +} + +sub _progress +{ + my $self = shift; + return '' unless defined $self->{tests}; + my $tlen = length $self->{tests}; + my $text = sprintf "[%${tlen}d/%${tlen}d] ", $self->{_cur}, $self->{tests}; + return $self->colored($text, 'bold'); +} + +sub _test +{ + my $self = shift; + return $self->_progress . "Testing " + . $self->colored($self->{perl}, 'blue') + . $self->colored($self->_config, 'green'); +} + +sub _testlen +{ + my $self = shift; + return length("Testing " . $self->{perl} . $self->_config); +} + +sub _dots +{ + my $self = shift; + return '.' x $self->_dotslen; +} + +sub _dotslen +{ + my $self = shift; + return $self->{width} - length($self->{perl} . $self->_config); +} + +sub _sep +{ + my $self = shift; + my $width = shift; + $self->print($self->colored('-'x$width, 'bold'), "\n"); +} + +sub _vsep +{ + goto &_sep if $_[0]->{verbose}; +} + +sub set +{ + my $self = shift; + while (@_) { + my($k, $v) = splice @_, 0, 2; + $self->{$k} = $v; + } +} + +sub test +{ + my $self = shift; + $self->{_cur}++; + $self->_vsep($self->_testlen); + $self->print($self->_test, $self->{verbose} ? "\n" : ' ' . $self->_dots . ' '); + $self->_vsep($self->_testlen); +} + +sub _warnings +{ + my($self, $mode) = @_; + + my $warnings = 0; + my $differ = 0; + + for my $w (@{$self->{_warnings}}) { + if (@{$w->[1]}) { + $warnings += @{$w->[1]}; + $differ++; + } + } + + my $rv = ''; + + if ($warnings) { + if ($mode eq 'summary') { + $rv .= sprintf " (%d warning%s", cs($warnings); + } + else { + $rv .= "\n"; + } + + for my $w (@{$self->{_warnings}}) { + if (@{$w->[1]}) { + if ($mode eq 'detail') { + $rv .= " Warnings during '$w->[0]':\n"; + my $cnt = 1; + for my $msg (@{$w->[1]}) { + $rv .= sprintf " [%d] %s", $cnt++, $msg; + } + $rv .= "\n"; + } + else { + unless ($self->{verbose}) { + $rv .= $differ == 1 ? " during " . $w->[0] + : sprintf(", %d during %s", scalar @{$w->[1]}, $w->[0]); + } + } + } + } + + if ($mode eq 'summary') { + $rv .= ')'; + } + } + + return $rv; +} + +sub _result +{ + my($self, $text, $color) = @_; + my $sum = $self->_warnings('summary'); + my $len = $self->_testlen + $self->_dotslen + length($text) + length($sum) + 2; + + $self->_vsep($len); + $self->print($self->_test, ' ', $self->_dots, ' ') if $self->{verbose} || $self->{_atbol}; + $self->print($self->colored($text, $color)); + $self->print($self->colored($sum, 'red')); + $self->print("\n"); + $self->_vsep($len); + $self->print($self->_warnings('detail')) if $self->{verbose}; + $self->{_total}++; +} + +sub passed +{ + my $self = shift; + $self->_result(@_, 'ok', 'bold green'); + push @{$self->{_good}}, [$self->{perl}, $self->{config}]; +} + +sub failed +{ + my $self = shift; + $self->_result(@_, 'not ok', 'bold red'); + push @{$self->{_bad}}, [$self->{perl}, $self->{config}]; +} + +sub warnings +{ + my $self = shift; + $self->{_warnings} = \@_; +} + +sub _tobol +{ + my $self = shift; + print "\n" unless $self->{_atbol}; + $self->{_atbol} = 1; +} + +sub print +{ + my $self = shift; + my $text = join '', @_; + print $text; + $self->{_atbol} = $text =~ /[\r\n]$/; +} + +sub say +{ + my $self = shift; + $self->_tobol; + $self->print(@_, "\n"); +} + +sub vsay +{ + goto &say if $_[0]->{verbose}; +} + +sub warn +{ + my $self = shift; + $self->say($self->colored(join('', @_), 'red')); +} + +sub die +{ + my $self = shift; + $self->say($self->colored(join('', 'FATAL: ', @_), 'bold red')); + exit -1; +} + +sub status +{ + my($self, $text) = @_; + $self->_tobol; + $self->print($self->colored($text, 'bold'), "\n"); +} + +sub finish +{ + my $self = shift; + + if (@{$self->{_bad}}) { + $self->status("\nFailed with:"); + for my $fail (@{$self->{_bad}}) { + my($perl, $cfg) = @$fail; + $self->set(config => $cfg); + $self->say(" ", $self->colored($perl, 'blue'), $self->colored($self->_config, 'green')); + } + } + + $self->status(sprintf("\nPassed with %d of %d combination%s.\n", + scalar @{$self->{_good}}, cs($self->{_total}))); + + return scalar @{$self->{_bad}}; +} + +__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}) + --min=version use at least this version of perl + --mmargs=options pass options to Makefile.PL (multiple --mmargs + possible) + --verbose be verbose + --nocolor don't use colored output + +=head1 DESCRIPTION + +The F<soak> utility can be used to test Perl modules with +multiple Perl releases or build options. It automates the +task of running F<Makefile.PL> and the modules test suite. + +It is not primarily intended for cross-platform checking, +so don't expect it to work on all platforms. + +=head1 EXAMPLES + +To test your favourite module, just change to its root +directory (where the F<Makefile.PL> is located) and run: + + soak + +This will automatically look for Perl binaries installed +on your system. + +Alternatively, you can explicitly pass F<soak> a list of +Perl binaries: + + soak perl5.8.6 perl5.9.2 + +Last but not least, you can pass it a list of directories +to recursively search for Perl binaries, for example: + + soak /tmp/perl/install /usr/bin + +All of the above examples will run + + perl Makefile.PL + make + make test + +for your module and report success or failure. + +If your F<Makefile.PL> can take arguments, you may also +want to test different configurations for your module. +You can do so with the I<--mmargs> option: + + soak --mmargs=' ' --mmargs='CCFLAGS=-Wextra' --mmargs='enable-debug' + +This will run + + perl Makefile.PL + make + make test + perl Makefile.PL CCFLAGS=-Wextra + make + make test + perl Makefile.PL enable-debug + make + make test + +for each Perl binary. + +If you have a directory full of different Perl binaries, +but your module isn't expected to work with ancient perls, +you can use the I<--min> option to specify the minimum +version a Perl binary must have to be chosen for testing: + + soak --min=5.8.1 + +Usually, the output of F<soak> is rather terse, to give +you a good overview. If you'd like to see more of what's +going on, use the I<--verbose> option: + + soak --verbose + +=head1 COPYRIGHT + +Version 3.x, Copyright (c) 2004-2013, 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 diff --git a/dist/Devel-PPPort/t/HvNAME.t b/dist/Devel-PPPort/t/HvNAME.t new file mode 100644 index 0000000000..f54fac2c89 --- /dev/null +++ b/dist/Devel-PPPort/t/HvNAME.t @@ -0,0 +1,56 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/HvNAME instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (4) { + load(); + plan(tests => 4); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(Devel::PPPort::HvNAME_get(\%Devel::PPPort::), 'Devel::PPPort'); +ok(Devel::PPPort::HvNAME_get({}), undef); + +ok(Devel::PPPort::HvNAMELEN_get(\%Devel::PPPort::), length('Devel::PPPort')); +ok(Devel::PPPort::HvNAMELEN_get({}), 0); + diff --git a/dist/Devel-PPPort/t/MY_CXT.t b/dist/Devel-PPPort/t/MY_CXT.t new file mode 100644 index 0000000000..a94bd386c4 --- /dev/null +++ b/dist/Devel-PPPort/t/MY_CXT.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/MY_CXT instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (3) { + load(); + plan(tests => 3); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::MY_CXT_1()); +ok(&Devel::PPPort::MY_CXT_2()); +ok(&Devel::PPPort::MY_CXT_CLONE()); + diff --git a/dist/Devel-PPPort/t/SvPV.t b/dist/Devel-PPPort/t/SvPV.t new file mode 100644 index 0000000000..392a0ccb0e --- /dev/null +++ b/dist/Devel-PPPort/t/SvPV.t @@ -0,0 +1,120 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/SvPV instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (49) { + load(); + plan(tests => 49); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $mhx = "mhx"; + +ok(&Devel::PPPort::SvPVbyte($mhx), 3); + +my $i = 42; + +ok(&Devel::PPPort::SvPV_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_mutable($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags_const($mhx), $i++); + +ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_flags_mutable($mhx), $i++); +ok(&Devel::PPPort::SvPV_force($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_mutable($mhx), $i++); + +ok(&Devel::PPPort::SvPV_force_nomg($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), $i++); + +ok(&Devel::PPPort::SvPV_nolen_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_const($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), $i++); +ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), $i++); + +$mhx = 42; ok(&Devel::PPPort::SvPV_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_const($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_mutable($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_const_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_flags_mutable($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_mutable($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_nomg_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_force_flags_mutable($mhx), 2); + +$mhx = 42; ok(&Devel::PPPort::SvPV_nolen_const($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const($mhx), 2); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_const_nolen($mhx), 0); +$mhx = 42; ok(&Devel::PPPort::SvPV_nomg_nolen($mhx), 0); + +my $str = ""; +&Devel::PPPort::SvPV_force($str); +my($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 81, "x"x80); +ok($str, "x"x80); +ok($s2, "x"x80); +ok($before < 81); +ok($after, 81); + +$str = "x"x400; +&Devel::PPPort::SvPV_force($str); +($s2, $before, $after) = &Devel::PPPort::SvPV_renew($str, 41, "x"x40); +ok($str, "x"x40); +ok($s2, "x"x40); +ok($before > 41); +ok($after, 41); + diff --git a/dist/Devel-PPPort/t/SvREFCNT.t b/dist/Devel-PPPort/t/SvREFCNT.t new file mode 100644 index 0000000000..0b46a51793 --- /dev/null +++ b/dist/Devel-PPPort/t/SvREFCNT.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/SvREFCNT instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (14) { + load(); + plan(tests => 14); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +for (Devel::PPPort::SvREFCNT()) { + ok(defined $_ and $_); +} + diff --git a/dist/Devel-PPPort/t/Sv_set.t b/dist/Devel-PPPort/t/Sv_set.t new file mode 100644 index 0000000000..77a7a860db --- /dev/null +++ b/dist/Devel-PPPort/t/Sv_set.t @@ -0,0 +1,71 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/Sv_set instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (5) { + load(); + plan(tests => 5); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $foo = 5; +ok(&Devel::PPPort::TestSvUV_set($foo, 12345), 42); +ok(&Devel::PPPort::TestSvPVX_const("mhx"), 43); +ok(&Devel::PPPort::TestSvPVX_mutable("mhx"), 44); + +my $bar = []; + +bless $bar, 'foo'; +ok($bar->x(), 'foobar'); + +Devel::PPPort::TestSvSTASH_set($bar, 'bar'); +ok($bar->x(), 'hacker'); + +package foo; + +sub x { 'foobar' } + +package bar; + +sub x { 'hacker' } + diff --git a/dist/Devel-PPPort/t/call.t b/dist/Devel-PPPort/t/call.t new file mode 100644 index 0000000000..4d3e80e4c8 --- /dev/null +++ b/dist/Devel-PPPort/t/call.t @@ -0,0 +1,107 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/call instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (52) { + load(); + plan(tests => 52); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +sub eq_array +{ + my($a, $b) = @_; + join(':', @$a) eq join(':', @$b); +} + +sub f +{ + shift; + unshift @_, 'b'; + pop @_; + @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; +} + +my $obj = bless [], 'Foo'; + +sub Foo::meth +{ + return 'bad_self' unless @_ && ref $_[0] && ref($_[0]) eq 'Foo'; + shift; + shift; + unshift @_, 'b'; + pop @_; + @_, defined wantarray ? wantarray ? 'x' : 'y' : 'z'; +} + +my $test; + +for $test ( + # flags args expected description + [ &Devel::PPPort::G_SCALAR, [ ], [ qw(y 1) ], '0 args, G_SCALAR' ], + [ &Devel::PPPort::G_SCALAR, [ qw(a p q) ], [ qw(y 1) ], '3 args, G_SCALAR' ], + [ &Devel::PPPort::G_ARRAY, [ ], [ qw(x 1) ], '0 args, G_ARRAY' ], + [ &Devel::PPPort::G_ARRAY, [ qw(a p q) ], [ qw(b p x 3) ], '3 args, G_ARRAY' ], + [ &Devel::PPPort::G_DISCARD, [ ], [ qw(0) ], '0 args, G_DISCARD' ], + [ &Devel::PPPort::G_DISCARD, [ qw(a p q) ], [ qw(0) ], '3 args, G_DISCARD' ], +) +{ + my ($flags, $args, $expected, $description) = @$test; + print "# --- $description ---\n"; + ok(eq_array( [ &Devel::PPPort::call_sv(\&f, $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_sv(*f, $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_sv('f', $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_pv('f', $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_argv('f', $flags, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::eval_sv("f(qw(@$args))", $flags) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_method('meth', $flags, $obj, @$args) ], $expected)); + ok(eq_array( [ &Devel::PPPort::call_sv_G_METHOD('meth', $flags, $obj, @$args) ], $expected)); +}; + +ok(&Devel::PPPort::eval_pv('f()', 0), 'y'); +ok(&Devel::PPPort::eval_pv('f(qw(a b c))', 0), 'y'); + +ok(!defined $::{'less::'}, 1, "Hadn't loaded less yet"); +Devel::PPPort::load_module(0, "less", undef); +ok(defined $::{'less::'}, 1, "Have now loaded less"); + diff --git a/dist/Devel-PPPort/t/cop.t b/dist/Devel-PPPort/t/cop.t new file mode 100644 index 0000000000..1677dee79a --- /dev/null +++ b/dist/Devel-PPPort/t/cop.t @@ -0,0 +1,110 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/cop instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (28) { + load(); + plan(tests => 28); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $package; +{ + package MyPackage; + $package = &Devel::PPPort::CopSTASHPV(); +} +print "# $package\n"; +ok($package, "MyPackage"); + +my $file = &Devel::PPPort::CopFILE(); +print "# $file\n"; +ok($file =~ /cop/i); + +BEGIN { + if ($] < 5.006000) { + # Skip + for (1..28) { + ok(1, 1); + } + exit; + } +} + +BEGIN { + package DB; + no strict "refs"; + local $^P = 1; + sub sub { &$DB::sub } +} + +{ package One; sub one { Devel::PPPort::caller_cx($_[0]) } } +{ + package Two; + sub two { One::one(@_) } + sub dbtwo { + BEGIN { $^P = 1 } + One::one(@_); + BEGIN { $^P = 0 } + } +} + +for ( + # This is rather confusing. The package is the package the call is + # made *from*, the sub name is the sub the call is made *to*. When + # DB::sub is involved the first call is to DB::sub from the calling + # package, the second is to the real sub from package DB. + [\&One::one, 0, qw/main one main one/], + [\&One::one, 2, ], + [\&Two::two, 0, qw/Two one Two one/], + [\&Two::two, 1, qw/main two main two/], + [\&Two::dbtwo, 0, qw/Two sub DB one/], + [\&Two::dbtwo, 1, qw/main dbtwo main dbtwo/], +) { + my ($sub, $arg, @want) = @$_; + my @got = $sub->($arg); + ok(@got, @want); + for (0..$#want) { + ok($got[$_], $want[$_]); + } +} + diff --git a/dist/Devel-PPPort/t/exception.t b/dist/Devel-PPPort/t/exception.t new file mode 100644 index 0000000000..c432df6e69 --- /dev/null +++ b/dist/Devel-PPPort/t/exception.t @@ -0,0 +1,67 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/exception instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (7) { + load(); + plan(tests => 7); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $rv; + +$Devel::PPPort::exception_caught = undef; + +$rv = eval { &Devel::PPPort::exception(0) }; +ok($@, ''); +ok(defined $rv); +ok($rv, 42); +ok($Devel::PPPort::exception_caught, 0); + +$Devel::PPPort::exception_caught = undef; + +$rv = eval { &Devel::PPPort::exception(1) }; +ok($@, "boo\n"); +ok(not defined $rv); +ok($Devel::PPPort::exception_caught, 1); + diff --git a/dist/Devel-PPPort/t/format.t b/dist/Devel-PPPort/t/format.t new file mode 100644 index 0000000000..a25ede533f --- /dev/null +++ b/dist/Devel-PPPort/t/format.t @@ -0,0 +1,55 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/format instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (1) { + load(); + plan(tests => 1); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $num = 1.12345678901234567890; + +eval { Devel::PPPort::croak_NVgf($num) }; +ok($@ =~ /^1.1234567890/); + diff --git a/dist/Devel-PPPort/t/grok.t b/dist/Devel-PPPort/t/grok.t new file mode 100644 index 0000000000..b807ce8ccd --- /dev/null +++ b/dist/Devel-PPPort/t/grok.t @@ -0,0 +1,62 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/grok instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (10) { + load(); + plan(tests => 10); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::grok_number("42"), 42); +ok(!defined(&Devel::PPPort::grok_number("A"))); +ok(&Devel::PPPort::grok_bin("10000001"), 129); +ok(&Devel::PPPort::grok_hex("deadbeef"), 0xdeadbeef); +ok(&Devel::PPPort::grok_oct("377"), 255); + +ok(&Devel::PPPort::Perl_grok_number("42"), 42); +ok(!defined(&Devel::PPPort::Perl_grok_number("A"))); +ok(&Devel::PPPort::Perl_grok_bin("10000001"), 129); +ok(&Devel::PPPort::Perl_grok_hex("deadbeef"), 0xdeadbeef); +ok(&Devel::PPPort::Perl_grok_oct("377"), 255); + diff --git a/dist/Devel-PPPort/t/gv.t b/dist/Devel-PPPort/t/gv.t new file mode 100644 index 0000000000..06dfed1b54 --- /dev/null +++ b/dist/Devel-PPPort/t/gv.t @@ -0,0 +1,63 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/gv instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (7) { + load(); + plan(tests => 7); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(Devel::PPPort::GvSVn(), 1); + +ok(Devel::PPPort::isGV_with_GP(), 2); + +ok(Devel::PPPort::get_cvn_flags(), 3); + +ok(Devel::PPPort::gv_fetchpvn_flags(), \*Devel::PPPort::VERSION); + +ok(Devel::PPPort::gv_fetchsv("Devel::PPPort::VERSION"), \*Devel::PPPort::VERSION); + +ok(Devel::PPPort::gv_init_type("sanity_check", 0, 0), "*main::sanity_check"); +ok($::{sanity_check}); + diff --git a/dist/Devel-PPPort/t/limits.t b/dist/Devel-PPPort/t/limits.t new file mode 100644 index 0000000000..ed1cb2e3ac --- /dev/null +++ b/dist/Devel-PPPort/t/limits.t @@ -0,0 +1,55 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/limits instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (4) { + load(); + plan(tests => 4); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::iv_size()); +ok(&Devel::PPPort::uv_size()); +ok(&Devel::PPPort::iv_type()); +ok(&Devel::PPPort::uv_type()); + diff --git a/dist/Devel-PPPort/t/mPUSH.t b/dist/Devel-PPPort/t/mPUSH.t new file mode 100644 index 0000000000..2f38276828 --- /dev/null +++ b/dist/Devel-PPPort/t/mPUSH.t @@ -0,0 +1,62 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/mPUSH instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (10) { + load(); + plan(tests => 10); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(join(':', &Devel::PPPort::mPUSHs()), "foo:bar:42"); +ok(join(':', &Devel::PPPort::mPUSHp()), "one:two:three"); +ok(join(':', &Devel::PPPort::mPUSHn()), "0.5:-0.25:0.125"); +ok(join(':', &Devel::PPPort::mPUSHi()), "-1:2:-3"); +ok(join(':', &Devel::PPPort::mPUSHu()), "1:2:3"); + +ok(join(':', &Devel::PPPort::mXPUSHs()), "foo:bar:42"); +ok(join(':', &Devel::PPPort::mXPUSHp()), "one:two:three"); +ok(join(':', &Devel::PPPort::mXPUSHn()), "0.5:-0.25:0.125"); +ok(join(':', &Devel::PPPort::mXPUSHi()), "-1:2:-3"); +ok(join(':', &Devel::PPPort::mXPUSHu()), "1:2:3"); + diff --git a/dist/Devel-PPPort/t/magic.t b/dist/Devel-PPPort/t/magic.t new file mode 100644 index 0000000000..f467613f27 --- /dev/null +++ b/dist/Devel-PPPort/t/magic.t @@ -0,0 +1,120 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/magic instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (23) { + load(); + plan(tests => 23); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +# Find proper magic +ok(my $obj1 = Devel::PPPort->new_with_mg()); +ok(Devel::PPPort::as_string($obj1), 'hello'); + +# Find with no magic +my $obj = bless {}, 'Fake::Class'; +ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle."); + +# Find with other magic (not the magic we are looking for) +ok($obj = Devel::PPPort->new_with_other_mg()); +ok(Devel::PPPort::as_string($obj), "Sorry, your princess is in another castle."); + +# Okay, attempt to remove magic that isn't there +Devel::PPPort::remove_other_magic($obj1); +ok(Devel::PPPort::as_string($obj1), 'hello'); + +# Remove magic that IS there +Devel::PPPort::remove_null_magic($obj1); +ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle."); + +# Removing when no magic present +Devel::PPPort::remove_null_magic($obj1); +ok(Devel::PPPort::as_string($obj1), "Sorry, your princess is in another castle."); + +use Tie::Hash; +my %h; +tie %h, 'Tie::StdHash'; +$h{foo} = 'foo'; +$h{bar} = ''; + +&Devel::PPPort::sv_catpv_mg($h{foo}, 'bar'); +ok($h{foo}, 'foobar'); + +&Devel::PPPort::sv_catpvn_mg($h{bar}, 'baz'); +ok($h{bar}, 'baz'); + +&Devel::PPPort::sv_catsv_mg($h{foo}, '42'); +ok($h{foo}, 'foobar42'); + +&Devel::PPPort::sv_setiv_mg($h{bar}, 42); +ok($h{bar}, 42); + +&Devel::PPPort::sv_setnv_mg($h{PI}, 3.14159); +ok(abs($h{PI} - 3.14159) < 0.01); + +&Devel::PPPort::sv_setpv_mg($h{mhx}, 'mhx'); +ok($h{mhx}, 'mhx'); + +&Devel::PPPort::sv_setpvn_mg($h{mhx}, 'Marcus'); +ok($h{mhx}, 'Marcus'); + +&Devel::PPPort::sv_setsv_mg($h{sv}, 'SV'); +ok($h{sv}, 'SV'); + +&Devel::PPPort::sv_setuv_mg($h{sv}, 4711); +ok($h{sv}, 4711); + +&Devel::PPPort::sv_usepvn_mg($h{sv}, 'Perl'); +ok($h{sv}, 'Perl'); + +# v1 is treated as a bareword in older perls... +my $ver = do { local $SIG{'__WARN__'} = sub {}; eval qq[v1.2.0] }; +ok($] < 5.009 || $@ eq ''); +ok($] < 5.009 || Devel::PPPort::SvVSTRING_mg($ver)); +ok(!Devel::PPPort::SvVSTRING_mg(4711)); + +my $foo = 'bar'; +ok(Devel::PPPort::sv_magic_portable($foo)); +ok($foo eq 'bar'); + diff --git a/dist/Devel-PPPort/t/memory.t b/dist/Devel-PPPort/t/memory.t new file mode 100644 index 0000000000..74ecb991bc --- /dev/null +++ b/dist/Devel-PPPort/t/memory.t @@ -0,0 +1,52 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/memory instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (1) { + load(); + plan(tests => 1); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(Devel::PPPort::checkmem(), 6); + diff --git a/dist/Devel-PPPort/t/misc.t b/dist/Devel-PPPort/t/misc.t new file mode 100644 index 0000000000..0c4f027380 --- /dev/null +++ b/dist/Devel-PPPort/t/misc.t @@ -0,0 +1,157 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/misc instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (48) { + load(); + plan(tests => 48); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +use vars qw($my_sv @my_av %my_hv); + +ok(&Devel::PPPort::boolSV(1)); +ok(!&Devel::PPPort::boolSV(0)); + +$_ = "Fred"; +ok(&Devel::PPPort::DEFSV(), "Fred"); +ok(&Devel::PPPort::UNDERBAR(), "Fred"); + +if ($] >= 5.009002 && $] < 5.023 && $] < 5.023004) { + eval q{ + no warnings "deprecated"; + no if $^V > v5.17.9, warnings => "experimental::lexical_topic"; + my $_ = "Tony"; + ok(&Devel::PPPort::DEFSV(), "Fred"); + ok(&Devel::PPPort::UNDERBAR(), "Tony"); + }; +} +else { + ok(1); + ok(1); +} + +my @r = &Devel::PPPort::DEFSV_modify(); + +ok(@r == 3); +ok($r[0], 'Fred'); +ok($r[1], 'DEFSV'); +ok($r[2], 'Fred'); + +ok(&Devel::PPPort::DEFSV(), "Fred"); + +eval { 1 }; +ok(!&Devel::PPPort::ERRSV()); +eval { cannot_call_this_one() }; +ok(&Devel::PPPort::ERRSV()); + +ok(&Devel::PPPort::gv_stashpvn('Devel::PPPort', 0)); +ok(!&Devel::PPPort::gv_stashpvn('does::not::exist', 0)); +ok(&Devel::PPPort::gv_stashpvn('does::not::exist', 1)); + +$my_sv = 1; +ok(&Devel::PPPort::get_sv('my_sv', 0)); +ok(!&Devel::PPPort::get_sv('not_my_sv', 0)); +ok(&Devel::PPPort::get_sv('not_my_sv', 1)); + +@my_av = (1); +ok(&Devel::PPPort::get_av('my_av', 0)); +ok(!&Devel::PPPort::get_av('not_my_av', 0)); +ok(&Devel::PPPort::get_av('not_my_av', 1)); + +%my_hv = (a=>1); +ok(&Devel::PPPort::get_hv('my_hv', 0)); +ok(!&Devel::PPPort::get_hv('not_my_hv', 0)); +ok(&Devel::PPPort::get_hv('not_my_hv', 1)); + +sub my_cv { 1 }; +ok(&Devel::PPPort::get_cv('my_cv', 0)); +ok(!&Devel::PPPort::get_cv('not_my_cv', 0)); +ok(&Devel::PPPort::get_cv('not_my_cv', 1)); + +ok(Devel::PPPort::dXSTARG(42), 43); +ok(Devel::PPPort::dAXMARK(4711), 4710); + +ok(Devel::PPPort::prepush(), 42); + +ok(join(':', Devel::PPPort::xsreturn(0)), 'test1'); +ok(join(':', Devel::PPPort::xsreturn(1)), 'test1:test2'); + +ok(Devel::PPPort::PERL_ABS(42), 42); +ok(Devel::PPPort::PERL_ABS(-13), 13); + +ok(Devel::PPPort::SVf(42), $] >= 5.004 ? '[42]' : '42'); +ok(Devel::PPPort::SVf('abc'), $] >= 5.004 ? '[abc]' : 'abc'); + +ok(&Devel::PPPort::Perl_ppaddr_t("FOO"), "foo"); + +ok(&Devel::PPPort::ptrtests(), 63); + +ok(&Devel::PPPort::OpSIBLING_tests(), 0); + +if ($] >= 5.009000) { + eval q{ + ok(&Devel::PPPort::check_HeUTF8("hello"), "norm"); + ok(&Devel::PPPort::check_HeUTF8("\N{U+263a}"), "utf8"); + }; +} else { + ok(1, 1); + ok(1, 1); +} + +@r = &Devel::PPPort::check_c_array(); +ok($r[0], 4); +ok($r[1], "13"); + +ok(!Devel::PPPort::SvRXOK("")); +ok(!Devel::PPPort::SvRXOK(bless [], "Regexp")); + +if ($] < 5.005) { + skip 'no qr// objects in this perl', 0; + skip 'no qr// objects in this perl', 0; +} else { + my $qr = eval 'qr/./'; + ok(Devel::PPPort::SvRXOK($qr)); + ok(Devel::PPPort::SvRXOK(bless $qr, "Surprise")); +} + diff --git a/dist/Devel-PPPort/t/newCONSTSUB.t b/dist/Devel-PPPort/t/newCONSTSUB.t new file mode 100644 index 0000000000..cb207a4587 --- /dev/null +++ b/dist/Devel-PPPort/t/newCONSTSUB.t @@ -0,0 +1,59 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/newCONSTSUB instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (3) { + load(); + plan(tests => 3); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +&Devel::PPPort::call_newCONSTSUB_1(); +ok(&Devel::PPPort::test_value_1(), 1); + +&Devel::PPPort::call_newCONSTSUB_2(); +ok(&Devel::PPPort::test_value_2(), 2); + +&Devel::PPPort::call_newCONSTSUB_3(); +ok(&Devel::PPPort::test_value_3(), 3); + diff --git a/dist/Devel-PPPort/t/newRV.t b/dist/Devel-PPPort/t/newRV.t new file mode 100644 index 0000000000..731a62b1f6 --- /dev/null +++ b/dist/Devel-PPPort/t/newRV.t @@ -0,0 +1,53 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/newRV instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::newRV_inc_REFCNT, 1); +ok(&Devel::PPPort::newRV_noinc_REFCNT, 1); + diff --git a/dist/Devel-PPPort/t/newSV_type.t b/dist/Devel-PPPort/t/newSV_type.t new file mode 100644 index 0000000000..1b3233e5ce --- /dev/null +++ b/dist/Devel-PPPort/t/newSV_type.t @@ -0,0 +1,52 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/newSV_type instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (1) { + load(); + plan(tests => 1); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(Devel::PPPort::newSV_type(), 4); + diff --git a/dist/Devel-PPPort/t/newSVpv.t b/dist/Devel-PPPort/t/newSVpv.t new file mode 100644 index 0000000000..d14a53fbe8 --- /dev/null +++ b/dist/Devel-PPPort/t/newSVpv.t @@ -0,0 +1,78 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/newSVpv instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (15) { + load(); + plan(tests => 15); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my @s = &Devel::PPPort::newSVpvn(); +ok(@s == 5); +ok($s[0], "test"); +ok($s[1], "te"); +ok($s[2], ""); +ok(!defined($s[3])); +ok(!defined($s[4])); + +@s = &Devel::PPPort::newSVpvn_flags(); +ok(@s == 5); +ok($s[0], "test"); +ok($s[1], "te"); +ok($s[2], ""); +ok(!defined($s[3])); +ok(!defined($s[4])); + +@s = &Devel::PPPort::newSVpvn_utf8(); +ok(@s == 1); +ok($s[0], "test"); + +if ($] >= 5.008001) { + require utf8; + ok(utf8::is_utf8($s[0])); +} +else { + skip("skip: no is_utf8()", 0); +} + diff --git a/dist/Devel-PPPort/t/podtest.t b/dist/Devel-PPPort/t/podtest.t new file mode 100644 index 0000000000..c1a35b20a0 --- /dev/null +++ b/dist/Devel-PPPort/t/podtest.t @@ -0,0 +1,83 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/podtest instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (0) { + load(); + plan(tests => 0); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my @pods = qw( HACKERS PPPort.pm ppport.h soak devel/regenerate devel/buildperl.pl ); + +my $reason = ''; + +if ($ENV{'SKIP_SLOW_TESTS'}) { + $reason = 'SKIP_SLOW_TESTS'; +} +else { + # Try loading Test::Pod + eval q{ + use Test::Pod; + $Test::Pod::VERSION >= 0.95 + or die "Test::Pod version only $Test::Pod::VERSION"; + import Test::Pod tests => scalar @pods; + }; + $reason = 'Test::Pod >= 0.95 required' if $@; +} + +if ($reason) { + load(); + plan(tests => scalar @pods); +} + +for (@pods) { + print "# checking $_\n"; + if ($reason) { + skip("skip: $reason", 0); + } + else { + pod_file_ok($_); + } +} + diff --git a/dist/Devel-PPPort/t/ppphtest.t b/dist/Devel-PPPort/t/ppphtest.t new file mode 100644 index 0000000000..45840f9fc7 --- /dev/null +++ b/dist/Devel-PPPort/t/ppphtest.t @@ -0,0 +1,946 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/ppphtest instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (238) { + load(); + plan(tests => 238); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +BEGIN { + if ($ENV{'SKIP_SLOW_TESTS'}) { + for (1 .. 238) { + skip("skip: SKIP_SLOW_TESTS", 0); + } + exit 0; + } +} + +use File::Path qw/rmtree mkpath/; +use Config; + +my $tmp = 'ppptmp'; +my $inc = ''; +my $isVMS = $^O eq 'VMS'; +my $isMAC = $^O eq 'MacOS'; +my $perl = find_perl(); + +rmtree($tmp) if -d $tmp; +mkpath($tmp) or die "mkpath $tmp: $!\n"; +chdir($tmp) or die "chdir $tmp: $!\n"; + +if ($ENV{'PERL_CORE'}) { + if (-d '../../lib') { + if ($isVMS) { + $inc = '"-I../../lib"'; + } + elsif ($isMAC) { + $inc = '-I:::lib'; + } + else { + $inc = '-I../../lib'; + } + unshift @INC, '../../lib'; + } +} +if ($perl =~ m!^\./!) { + $perl = ".$perl"; +} + +END { + chdir('..') if !-d $tmp && -d "../$tmp"; + rmtree($tmp) if -d $tmp; +} + +ok(&Devel::PPPort::WriteFile("ppport.h")); + +# Check GetFileContents() +ok(-e "ppport.h", 1); + +my $data; + +open(F, "<ppport.h") or die "Failed to open ppport.h: $!"; +while(<F>) { + $data .= $_; +} +close(F); + +ok(Devel::PPPort::GetFileContents("ppport.h"), $data); +ok(Devel::PPPort::GetFileContents(), $data); + +sub comment +{ + my $c = shift; + $c =~ s/^/# | /mg; + $c .= "\n" unless $c =~ /[\r\n]$/; + print $c; +} + +sub ppport +{ + my @args = ('ppport.h', @_); + unshift @args, $inc if $inc; + my $run = $perl =~ m/\s/ ? qq("$perl") : $perl; + $run .= ' -MMac::err=unix' if $isMAC; + for (@args) { + $_ = qq("$_") if $isVMS && /^[^"]/; + $run .= " $_"; + } + print "# *** running $run ***\n"; + $run .= ' 2>&1' unless $isMAC; + my @out = `$run`; + my $out = join '', @out; + comment($out); + return wantarray ? @out : $out; +} + +sub matches +{ + my($str, $re, $mod) = @_; + my @n; + eval "\@n = \$str =~ /$re/g$mod;"; + if ($@) { + my $err = $@; + $err =~ s/^/# *** /mg; + print "# *** ERROR ***\n$err\n"; + } + return $@ ? -42 : scalar @n; +} + +sub eq_files +{ + my($f1, $f2) = @_; + return 0 unless -e $f1 && -e $f2; + local *F; + for ($f1, $f2) { + print "# File: $_\n"; + unless (open F, $_) { + print "# couldn't open $_: $!\n"; + return 0; + } + $_ = do { local $/; <F> }; + close F; + comment($_); + } + return $f1 eq $f2; +} + +my @tests; + +for (split /\s*={70,}\s*/, do { local $/; <DATA> }) { + s/^\s+//; s/\s+$//; + my($c, %f); + ($c, @f{m/-{20,}\s+(\S+)\s+-{20,}/g}) = split /\s*-{20,}\s+\S+\s+-{20,}\s*/; + push @tests, { code => $c, files => \%f }; +} + +my $t; +for $t (@tests) { + print "#\n", ('# ', '-'x70, "\n")x3, "#\n"; + my $f; + for $f (keys %{$t->{files}}) { + my @f = split /\//, $f; + if (@f > 1) { + pop @f; + my $path = join '/', @f; + mkpath($path) or die "mkpath('$path'): $!\n"; + } + my $txt = $t->{files}{$f}; + local *F; + open F, ">$f" or die "open $f: $!\n"; + print F "$txt\n"; + close F; + $txt =~ s/^/# | /mg; + print "# *** writing $f ***\n$txt\n"; + } + + my $code = $t->{code}; + $code =~ s/^/# | /mg; + + print "# *** evaluating test code ***\n$code\n"; + + eval $t->{code}; + if ($@) { + my $err = $@; + $err =~ s/^/# *** /mg; + print "# *** ERROR ***\n$err\n"; + } + ok($@, ''); + + for (keys %{$t->{files}}) { + unlink $_ or die "unlink('$_'): $!\n"; + } +} + +sub find_perl +{ + my $perl = $^X; + + return $perl if $isVMS; + + my $exe = $Config{'_exe'} || ''; + + if ($perl =~ /^perl\Q$exe\E$/i) { + $perl = "perl$exe"; + eval "require File::Spec"; + if ($@) { + $perl = "./$perl"; + } else { + $perl = File::Spec->catfile(File::Spec->curdir(), $perl); + } + } + + if ($perl !~ /\Q$exe\E$/i) { + $perl .= $exe; + } + + warn "find_perl: cannot find $perl from $^X" unless -f $perl; + + return $perl; +} + +__DATA__ + +my $o = ppport(qw(--help)); +ok($o =~ /^Usage:.*ppport\.h/m); +ok($o =~ /--help/m); + +$o = ppport(qw(--version)); +ok($o =~ /^This is.*ppport.*\d+\.\d+(?:_?\d+)?\.$/); + +$o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*test\.xs/mi); +ok($o =~ /Analyzing.*test\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok(matches($o, 'Analyzing', 'm'), 1); +ok($o =~ /Uses Perl_newSViv instead of newSViv/); + +$o = ppport(qw(--quiet --nochanges)); +ok($o =~ /^\s*$/); + +---------------------------- test.xs ------------------------------------------ + +Perl_newSViv(); + +=============================================================================== + +# check if C and C++ comments are filtered correctly + +my $o = ppport(qw(--copy=a)); +ok($o =~ /^Scanning.*MyExt\.xs/mi); +ok($o =~ /Analyzing.*MyExt\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Uses grok_bin/m); +ok($o !~ /^Uses newSVpv/m); +ok($o =~ /Uses 1 C\+\+ style comment/m); +ok(eq_files('MyExt.xsa', 'MyExt.ra')); + +# check if C++ are left untouched with --cplusplus + +$o = ppport(qw(--copy=b --cplusplus)); +ok($o =~ /^Scanning.*MyExt\.xs/mi); +ok($o =~ /Analyzing.*MyExt\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Uses grok_bin/m); +ok($o !~ /^Uses newSVpv/m); +ok($o !~ /Uses \d+ C\+\+ style comment/m); +ok(eq_files('MyExt.xsb', 'MyExt.rb')); + +unlink qw(MyExt.xsa MyExt.xsb); + +---------------------------- MyExt.xs ----------------------------------------- + +newSVuv(); + // newSVpv(); + XPUSHs(foo); +/* grok_bin(); */ + +---------------------------- MyExt.ra ----------------------------------------- + +#include "ppport.h" +newSVuv(); + /* newSVpv(); */ + XPUSHs(foo); +/* grok_bin(); */ + +---------------------------- MyExt.rb ----------------------------------------- + +#include "ppport.h" +newSVuv(); + // newSVpv(); + XPUSHs(foo); +/* grok_bin(); */ + +=============================================================================== + +my $o = ppport(qw(--nochanges file1.xs)); +ok($o =~ /^Scanning.*file1\.xs/mi); +ok($o =~ /Analyzing.*file1\.xs/mi); +ok($o !~ /^Scanning.*file2\.xs/mi); +ok($o =~ /^Uses newCONSTSUB/m); +ok($o =~ /^Uses PL_expect/m); +ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o =~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --nohints file1.xs)); +ok($o =~ /^Scanning.*file1\.xs/mi); +ok($o =~ /Analyzing.*file1\.xs/mi); +ok($o !~ /^Scanning.*file2\.xs/mi); +ok($o =~ /^Uses newCONSTSUB/m); +ok($o =~ /^Uses PL_expect/m); +ok($o =~ /^Uses SvPV_nolen.*depends.*sv_2pv_flags/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o !~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --nohints --nodiag file1.xs)); +ok($o =~ /^Scanning.*file1\.xs/mi); +ok($o =~ /Analyzing.*file1\.xs/mi); +ok($o !~ /^Scanning.*file2\.xs/mi); +ok($o !~ /^Uses newCONSTSUB/m); +ok($o !~ /^Uses PL_expect/m); +ok($o !~ /^Uses SvPV_nolen/m); +ok($o =~ /WARNING: PL_expect/m); +ok($o !~ /hint for newCONSTSUB/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --quiet file1.xs)); +ok($o =~ /^\s*$/); + +$o = ppport(qw(--nochanges file2.xs)); +ok($o =~ /^Scanning.*file2\.xs/mi); +ok($o =~ /Analyzing.*file2\.xs/mi); +ok($o !~ /^Scanning.*file1\.xs/mi); +ok($o =~ /^Uses mXPUSHp/m); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Looks good/m); +ok($o =~ /^1 potentially required change detected/m); + +$o = ppport(qw(--nochanges --nohints file2.xs)); +ok($o =~ /^Scanning.*file2\.xs/mi); +ok($o =~ /Analyzing.*file2\.xs/mi); +ok($o !~ /^Scanning.*file1\.xs/mi); +ok($o =~ /^Uses mXPUSHp/m); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Looks good/m); +ok($o =~ /^1 potentially required change detected/m); + +$o = ppport(qw(--nochanges --nohints --nodiag file2.xs)); +ok($o =~ /^Scanning.*file2\.xs/mi); +ok($o =~ /Analyzing.*file2\.xs/mi); +ok($o !~ /^Scanning.*file1\.xs/mi); +ok($o !~ /^Uses mXPUSHp/m); +ok($o !~ /^Needs to include.*ppport\.h/m); +ok($o !~ /^Looks good/m); +ok($o =~ /^1 potentially required change detected/m); + +$o = ppport(qw(--nochanges --quiet file2.xs)); +ok($o =~ /^\s*$/); + +---------------------------- file1.xs ----------------------------------------- + +#define NEED_newCONSTSUB +#define NEED_sv_2pv_flags +#define NEED_PL_parser +#include "ppport.h" + +newCONSTSUB(); +SvPV_nolen(); +PL_expect = 0; + +---------------------------- file2.xs ----------------------------------------- + +mXPUSHp(foo); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*FooBar\.xs/mi); +ok($o =~ /Analyzing.*FooBar\.xs/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok($o !~ /^Looks good/m); +ok($o =~ /^Uses grok_bin/m); + +---------------------------- FooBar.xs ---------------------------------------- + +newSViv(); +XPUSHs(foo); +grok_bin(); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*First\.xs/mi); +ok($o =~ /Analyzing.*First\.xs/mi); +ok($o =~ /^Scanning.*second\.h/mi); +ok($o =~ /Analyzing.*second\.h/mi); +ok($o =~ /^Scanning.*sub.*third\.c/mi); +ok($o =~ /Analyzing.*sub.*third\.c/mi); +ok($o !~ /^Scanning.*foobar/mi); +ok(matches($o, '^Scanning', 'm'), 3); + +---------------------------- First.xs ----------------------------------------- + +one + +---------------------------- foobar.xyz --------------------------------------- + +two + +---------------------------- second.h ----------------------------------------- + +three + +---------------------------- sub/third.c -------------------------------------- + +four + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /Possibly wrong #define NEED_foobar in.*test.xs/i); + +---------------------------- test.xs ------------------------------------------ + +#define NEED_foobar + +=============================================================================== + +# And now some complex "real-world" example + +my $o = ppport(qw(--copy=f)); +for (qw(main.xs mod1.c mod2.c mod3.c mod4.c mod5.c)) { + ok($o =~ /^Scanning.*\Q$_\E/mi); + ok($o =~ /Analyzing.*\Q$_\E/i); +} +ok(matches($o, '^Scanning', 'm'), 6); + +ok(matches($o, '^Writing copy of', 'm'), 5); +ok(!-e "mod5.cf"); + +for (qw(main.xs mod1.c mod2.c mod3.c mod4.c)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- main.xs ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_newCONSTSUB +#define NEED_grok_hex_GLOBAL +#include "ppport.h" + +newCONSTSUB(); +grok_hex(); +Perl_grok_bin(aTHX_ foo, bar); + +/* some comment */ + +perl_eval_pv(); +grok_bin(); +Perl_grok_bin(bar, sv_no); + +---------------------------- mod1.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_grok_bin_GLOBAL +#define NEED_newCONSTSUB +#include "ppport.h" + +newCONSTSUB(); +grok_bin(); +{ + Perl_croak ("foo"); + Perl_sv_catpvf(); /* I know it's wrong ;-) */ +} + +---------------------------- mod2.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_eval_pv +#include "ppport.h" + +newSViv(); + +/* + eval_pv(); +*/ + +---------------------------- mod3.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +grok_oct(); +eval_pv(); + +---------------------------- mod4.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +START_MY_CXT; + +---------------------------- mod5.c ------------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include "ppport.h" +call_pv(); + +---------------------------- main.xsr ----------------------------------------- + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_eval_pv_GLOBAL +#define NEED_grok_hex +#define NEED_newCONSTSUB_GLOBAL +#include "ppport.h" + +newCONSTSUB(); +grok_hex(); +grok_bin(foo, bar); + +/* some comment */ + +eval_pv(); +grok_bin(); +grok_bin(bar, PL_sv_no); + +---------------------------- mod1.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define NEED_grok_bin_GLOBAL +#include "ppport.h" + +newCONSTSUB(); +grok_bin(); +{ + Perl_croak (aTHX_ "foo"); + Perl_sv_catpvf(aTHX); /* I know it's wrong ;-) */ +} + +---------------------------- mod2.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + + +newSViv(); + +/* + eval_pv(); +*/ + +---------------------------- mod3.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#define NEED_grok_oct +#include "ppport.h" + +grok_oct(); +eval_pv(); + +---------------------------- mod4.cr ------------------------------------------ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include "ppport.h" + +START_MY_CXT; + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /Uses grok_hex/m); +ok($o !~ /Looks good/m); + +$o = ppport(qw(--nochanges --compat-version=5.8.0)); +ok($o !~ /Uses grok_hex/m); +ok($o =~ /Looks good/m); + +---------------------------- FooBar.xs ---------------------------------------- + +grok_hex(); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); + +$o = ppport(qw(--nochanges --compat-version=5.5.3)); +ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); + +$o = ppport(qw(--nochanges --compat-version=5.005_03)); +ok($o =~ /Uses SvPVutf8_force, which may not be portable/m); + +$o = ppport(qw(--nochanges --compat-version=5.6.0)); +ok($o !~ /Uses SvPVutf8_force/m); + +$o = ppport(qw(--nochanges --compat-version=5.006)); +ok($o !~ /Uses SvPVutf8_force/m); + +$o = ppport(qw(--nochanges --compat-version=5.999.999)); +ok($o !~ /Uses SvPVutf8_force/m); + +$o = ppport(qw(--nochanges --compat-version=6.0.0)); +ok($o =~ /Only Perl 5 is supported/m); + +$o = ppport(qw(--nochanges --compat-version=5.1000.999)); +ok($o =~ /Invalid version number: 5.1000.999/m); + +$o = ppport(qw(--nochanges --compat-version=5.999.1000)); +ok($o =~ /Invalid version number: 5.999.1000/m); + +---------------------------- FooBar.xs ---------------------------------------- + +SvPVutf8_force(); + +=============================================================================== + +my $o = ppport(qw(--nochanges)); +ok($o !~ /potentially required change/); +ok(matches($o, '^Looks good', 'm'), 2); + +---------------------------- FooBar.xs ---------------------------------------- + +#define NEED_grok_numeric_radix +#define NEED_grok_number +#include "ppport.h" + +GROK_NUMERIC_RADIX(); +grok_number(); + +---------------------------- foo.c -------------------------------------------- + +#include "ppport.h" + +call_pv(); + +=============================================================================== + +# check --api-info option + +my $o = ppport(qw(--api-info=INT2PTR)); +my %found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; +ok(scalar keys %found, 1); +ok(exists $found{INT2PTR}); +ok(matches($o, '^Supported at least starting from perl-5\.6\.0\.', 'm'), 1); +ok(matches($o, '^Support by .*ppport.* provided back to perl-5\.003\.', 'm'), 1); + +$o = ppport(qw(--api-info=Zero)); +%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; +ok(scalar keys %found, 1); +ok(exists $found{Zero}); +ok(matches($o, '^No portability information available\.', 'm'), 1); + +$o = ppport(qw(--api-info=/Zero/)); +%found = map {($_ => 1)} $o =~ /^===\s+(\w+)\s+===/mg; +ok(scalar keys %found, 2); +ok(exists $found{Zero}); +ok(exists $found{ZeroD}); + +=============================================================================== + +# check --list-provided option + +my @o = ppport(qw(--list-provided)); +my %p; +my $fail = 0; +for (@o) { + my($name, $flags) = /^(\w+)(?:\s+\[(\w+(?:,\s+\w+)*)\])?$/ or $fail++; + exists $p{$name} and $fail++; + $p{$name} = defined $flags ? { map { ($_ => 1) } $flags =~ /(\w+)/g } : ''; +} +ok(@o > 100); +ok($fail, 0); + +ok(exists $p{call_pv}); +ok(not ref $p{call_pv}); + +ok(exists $p{grok_bin}); +ok(ref $p{grok_bin}, 'HASH'); +ok(scalar keys %{$p{grok_bin}}, 2); +ok($p{grok_bin}{explicit}); +ok($p{grok_bin}{depend}); + +ok(exists $p{gv_stashpvn}); +ok(ref $p{gv_stashpvn}, 'HASH'); +ok(scalar keys %{$p{gv_stashpvn}}, 2); +ok($p{gv_stashpvn}{depend}); +ok($p{gv_stashpvn}{hint}); + +ok(exists $p{sv_catpvf_mg}); +ok(ref $p{sv_catpvf_mg}, 'HASH'); +ok(scalar keys %{$p{sv_catpvf_mg}}, 2); +ok($p{sv_catpvf_mg}{explicit}); +ok($p{sv_catpvf_mg}{depend}); + +ok(exists $p{PL_signals}); +ok(ref $p{PL_signals}, 'HASH'); +ok(scalar keys %{$p{PL_signals}}, 1); +ok($p{PL_signals}{explicit}); + +=============================================================================== + +# check --list-unsupported option + +my @o = ppport(qw(--list-unsupported)); +my %p; +my $fail = 0; +for (@o) { + my($name, $ver) = /^(\w+)\s*\.+\s*([\d._]+)$/ or $fail++; + exists $p{$name} and $fail++; + $p{$name} = $ver; +} +ok(@o > 100); +ok($fail, 0); + +ok(exists $p{utf8_distance}); +ok($p{utf8_distance}, '5.6.0'); + +ok(exists $p{save_generic_svref}); +ok($p{save_generic_svref}, '5.005_03'); + +=============================================================================== + +# check --nofilter option + +my $o = ppport(qw(--nochanges)); +ok($o =~ /^Scanning.*foo\.cpp/mi); +ok($o =~ /Analyzing.*foo\.cpp/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok(matches($o, 'Analyzing', 'm'), 1); + +$o = ppport(qw(--nochanges foo.cpp foo.o Makefile.PL)); +ok($o =~ /Skipping the following files \(use --nofilter to avoid this\):/m); +ok(matches($o, '^\|\s+foo\.o', 'mi'), 1); +ok(matches($o, '^\|\s+Makefile\.PL', 'mi'), 1); +ok($o =~ /^Scanning.*foo\.cpp/mi); +ok($o =~ /Analyzing.*foo\.cpp/mi); +ok(matches($o, '^Scanning', 'm'), 1); +ok(matches($o, 'Analyzing', 'm'), 1); + +$o = ppport(qw(--nochanges --nofilter foo.cpp foo.o Makefile.PL)); +ok($o =~ /^Scanning.*foo\.cpp/mi); +ok($o =~ /Analyzing.*foo\.cpp/mi); +ok($o =~ /^Scanning.*foo\.o/mi); +ok($o =~ /Analyzing.*foo\.o/mi); +ok($o =~ /^Scanning.*Makefile/mi); +ok($o =~ /Analyzing.*Makefile/mi); +ok(matches($o, '^Scanning', 'm'), 3); +ok(matches($o, 'Analyzing', 'm'), 3); + +---------------------------- foo.cpp ------------------------------------------ + +newSViv(); + +---------------------------- foo.o -------------------------------------------- + +newSViv(); + +---------------------------- Makefile.PL -------------------------------------- + +newSViv(); + +=============================================================================== + +# check if explicit variables are handled propery + +my $o = ppport(qw(--copy=a)); +ok($o =~ /^Needs to include.*ppport\.h/m); +ok($o =~ /^Uses PL_signals/m); +ok($o =~ /^File needs PL_signals, adding static request/m); +ok(eq_files('MyExt.xsa', 'MyExt.ra')); + +unlink qw(MyExt.xsa); + +---------------------------- MyExt.xs ----------------------------------------- + +PL_signals = 123; +if (PL_signals == 42) + foo(); + +---------------------------- MyExt.ra ----------------------------------------- + +#define NEED_PL_signals +#include "ppport.h" +PL_signals = 123; +if (PL_signals == 42) + foo(); + +=============================================================================== + +my $o = ppport(qw(--nochanges file.xs)); +ok($o =~ /^Uses PL_copline/m); +ok($o =~ /WARNING: PL_copline/m); +ok($o =~ /^Uses SvUOK/m); +ok($o =~ /WARNING: Uses SvUOK, which may not be portable/m); +ok($o =~ /^Analysis completed \(2 warnings\)/m); +ok($o =~ /^Looks good/m); + +$o = ppport(qw(--nochanges --compat-version=5.8.0 file.xs)); +ok($o =~ /^Uses PL_copline/m); +ok($o =~ /WARNING: PL_copline/m); +ok($o !~ /WARNING: Uses SvUOK, which may not be portable/m); +ok($o =~ /^Analysis completed \(1 warning\)/m); +ok($o =~ /^Looks good/m); + +---------------------------- file.xs ----------------------------------------- + +#define NEED_PL_parser +#include "ppport.h" +SvUOK +PL_copline + +=============================================================================== + +my $o = ppport(qw(--copy=f)); + +for (qw(file.xs)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- file.xs ----------------------------------------- + +a_string = "sv_undef" +a_char = 'sv_yes' +#define SOMETHING defgv +/* C-comment: sv_tainted */ +# +# This is just a big XS comment using sv_no +# +/* The following, is NOT an XS comment! */ +# define SOMETHING_ELSE defgv + \ + sv_undef + +---------------------------- file.xsr ----------------------------------------- + +#include "ppport.h" +a_string = "sv_undef" +a_char = 'sv_yes' +#define SOMETHING PL_defgv +/* C-comment: sv_tainted */ +# +# This is just a big XS comment using sv_no +# +/* The following, is NOT an XS comment! */ +# define SOMETHING_ELSE PL_defgv + \ + PL_sv_undef + +=============================================================================== + +my $o = ppport(qw(--copy=f)); + +for (qw(file.xs)) { + ok($o =~ /^Writing copy of.*\Q$_\E.*with changes/mi); + ok(-e "${_}f"); + ok(eq_files("${_}f", "${_}r")); + unlink "${_}f"; +} + +---------------------------- file.xs ----------------------------------------- + +#define NEED_sv_2pv_flags +#define NEED_vnewSVpvf +#define NEED_warner +#include "ppport.h" +Perl_croak_nocontext("foo"); +Perl_croak("bar"); +croak("foo"); +croak_nocontext("foo"); +Perl_warner_nocontext("foo"); +Perl_warner("foo"); +warner_nocontext("foo"); +warner("foo"); + +---------------------------- file.xsr ----------------------------------------- + +#define NEED_sv_2pv_flags +#define NEED_vnewSVpvf +#define NEED_warner +#include "ppport.h" +Perl_croak_nocontext("foo"); +Perl_croak(aTHX_ "bar"); +croak("foo"); +croak_nocontext("foo"); +Perl_warner_nocontext("foo"); +Perl_warner(aTHX_ "foo"); +warner_nocontext("foo"); +warner("foo"); + diff --git a/dist/Devel-PPPort/t/pv_tools.t b/dist/Devel-PPPort/t/pv_tools.t new file mode 100644 index 0000000000..e53beed0a0 --- /dev/null +++ b/dist/Devel-PPPort/t/pv_tools.t @@ -0,0 +1,74 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/pv_tools instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (13) { + load(); + plan(tests => 13); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $uni = &Devel::PPPort::pv_escape_can_unicode(); + +# sanity check +ok($uni ? $] >= 5.006 : $] < 5.008); + +my @r; + +@r = &Devel::PPPort::pv_pretty(); +ok($r[0], $r[1]); +ok($r[0], "foobarbaz"); +ok($r[2], $r[3]); +ok($r[2], '<leftpv_p\retty\nright>'); +ok($r[4], $r[5]); +ok($r[4], $uni ? 'N\375 Batter\355' : 'N\303\275 Batter\303'); +ok($r[6], $r[7]); +ok($r[6], $uni ? '\301g\346tis Byrju...' : '\303\201g\303\246t...'); + +@r = &Devel::PPPort::pv_display(); +ok($r[0], $r[1]); +ok($r[0], '"foob\0rbaz"\0'); +ok($r[2], $r[3]); +ok($r[2] eq '"pv_di"...\0' || + $r[2] eq '"pv_d"...\0'); # some perl implementations are broken... :( + diff --git a/dist/Devel-PPPort/t/pvs.t b/dist/Devel-PPPort/t/pvs.t new file mode 100644 index 0000000000..ff4d3e0586 --- /dev/null +++ b/dist/Devel-PPPort/t/pvs.t @@ -0,0 +1,73 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/pvs instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (12) { + load(); + plan(tests => 12); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my $x = 'foo'; + +ok(Devel::PPPort::newSVpvs(), "newSVpvs"); +ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags"); +ok(Devel::PPPort::newSVpvs_share(), 3); + +Devel::PPPort::sv_catpvs($x); +ok($x, "foosv_catpvs"); + +Devel::PPPort::sv_setpvs($x); +ok($x, "sv_setpvs"); + +my %h = ('hv_fetchs' => 42); +Devel::PPPort::hv_stores(\%h, 4711); +ok(scalar keys %h, 2); +ok(exists $h{'hv_stores'}); +ok($h{'hv_stores'}, 4711); +ok(Devel::PPPort::hv_fetchs(\%h), 42); +ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION); +ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::); + +ok(Devel::PPPort::get_cvs(), 3); + diff --git a/dist/Devel-PPPort/t/shared_pv.t b/dist/Devel-PPPort/t/shared_pv.t new file mode 100644 index 0000000000..eac79c6ca8 --- /dev/null +++ b/dist/Devel-PPPort/t/shared_pv.t @@ -0,0 +1,52 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/shared_pv instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (1) { + load(); + plan(tests => 1); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::newSVpvn_share(), 6); + diff --git a/dist/Devel-PPPort/t/snprintf.t b/dist/Devel-PPPort/t/snprintf.t new file mode 100644 index 0000000000..0b90004d9e --- /dev/null +++ b/dist/Devel-PPPort/t/snprintf.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/snprintf instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my($l, $s) = Devel::PPPort::my_snprintf(); +ok($l, 8); +ok($s, "foobar42"); + diff --git a/dist/Devel-PPPort/t/sprintf.t b/dist/Devel-PPPort/t/sprintf.t new file mode 100644 index 0000000000..8b0d51fc91 --- /dev/null +++ b/dist/Devel-PPPort/t/sprintf.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/sprintf instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my($l, $s) = Devel::PPPort::my_sprintf(); +ok($l, 8); +ok($s, "foobar42"); + diff --git a/dist/Devel-PPPort/t/strlfuncs.t b/dist/Devel-PPPort/t/strlfuncs.t new file mode 100644 index 0000000000..c8175472de --- /dev/null +++ b/dist/Devel-PPPort/t/strlfuncs.t @@ -0,0 +1,65 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/strlfuncs instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (13) { + load(); + plan(tests => 13); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +my @e = (3, 'foo', + 6, 'foobar', + 9, 'foobarb', + 10, '1234567', + 4, '1234', + 16, '1234567', + ); +my @r = Devel::PPPort::my_strlfunc(); + +ok(@e == @r); + +for (0 .. $#e) { + ok($r[$_], $e[$_]); +} + diff --git a/dist/Devel-PPPort/t/sv_xpvf.t b/dist/Devel-PPPort/t/sv_xpvf.t new file mode 100644 index 0000000000..15074317df --- /dev/null +++ b/dist/Devel-PPPort/t/sv_xpvf.t @@ -0,0 +1,78 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/sv_xpvf instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (9) { + load(); + plan(tests => 9); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +use Tie::Hash; +my %h; +tie %h, 'Tie::StdHash'; +$h{foo} = 'foo-'; +$h{bar} = ''; + +ok(&Devel::PPPort::vnewSVpvf(), $] >= 5.004 ? 'Perl-42' : '%s-%d'); +ok(&Devel::PPPort::sv_vcatpvf('1-2-3-'), $] >= 5.004 ? '1-2-3-Perl-42' : '1-2-3-%s-%d'); +ok(&Devel::PPPort::sv_vsetpvf('1-2-3-'), $] >= 5.004 ? 'Perl-42' : '%s-%d'); + +&Devel::PPPort::sv_catpvf_mg($h{foo}); +ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42' : 'foo-'); + +&Devel::PPPort::Perl_sv_catpvf_mg($h{foo}); +ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43' : 'foo-'); + +&Devel::PPPort::sv_catpvf_mg_nocontext($h{foo}); +ok($h{foo}, $] >= 5.004 ? 'foo-Perl-42-Perl-43-Perl-44' : 'foo-'); + +&Devel::PPPort::sv_setpvf_mg($h{bar}); +ok($h{bar}, $] >= 5.004 ? 'mhx-42' : ''); + +&Devel::PPPort::Perl_sv_setpvf_mg($h{bar}); +ok($h{bar}, $] >= 5.004 ? 'foo-43' : ''); + +&Devel::PPPort::sv_setpvf_mg_nocontext($h{bar}); +ok($h{bar}, $] >= 5.004 ? 'bar-44' : ''); + diff --git a/dist/Devel-PPPort/t/testutil.pl b/dist/Devel-PPPort/t/testutil.pl new file mode 100644 index 0000000000..4fc7d667a6 --- /dev/null +++ b/dist/Devel-PPPort/t/testutil.pl @@ -0,0 +1,48 @@ +{ + my $__ntest; + my $__total; + + sub plan { + @_ == 2 or die "usage: plan(tests => count)"; + my $what = shift; + $what eq 'tests' or die "cannot plan anything but tests"; + $__total = shift; + defined $__total && $__total > 0 or die "need a positive number of tests"; + print "1..$__total\n"; + } + + sub skip { + my $reason = shift; + ++$__ntest; + print "ok $__ntest # skip: $reason\n" + } + + sub ok ($;$$) { + local($\,$,); + my $ok = 0; + my $result = shift; + if (@_ == 0) { + $ok = $result; + } else { + $expected = shift; + if (!defined $expected) { + $ok = !defined $result; + } elsif (!defined $result) { + $ok = 0; + } elsif (ref($expected) eq 'Regexp') { + die "using regular expression objects is not backwards compatible"; + } else { + $ok = $result eq $expected; + } + } + ++$__ntest; + if ($ok) { + print "ok $__ntest\n" + } + else { + print "not ok $__ntest\n" + } + } +} + +1; diff --git a/dist/Devel-PPPort/t/threads.t b/dist/Devel-PPPort/t/threads.t new file mode 100644 index 0000000000..a1c8caa5c8 --- /dev/null +++ b/dist/Devel-PPPort/t/threads.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/threads instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (2) { + load(); + plan(tests => 2); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::no_THX_arg("42"), 43); +eval { &Devel::PPPort::with_THX_arg("yes\n"); }; +ok($@ =~ /^yes/); + diff --git a/dist/Devel-PPPort/t/uv.t b/dist/Devel-PPPort/t/uv.t new file mode 100644 index 0000000000..bc123c6bbf --- /dev/null +++ b/dist/Devel-PPPort/t/uv.t @@ -0,0 +1,61 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/uv instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (10) { + load(); + plan(tests => 10); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(&Devel::PPPort::sv_setuv(42), 42); +ok(&Devel::PPPort::newSVuv(123), 123); +ok(&Devel::PPPort::sv_2uv("4711"), 4711); +ok(&Devel::PPPort::sv_2uv("1735928559"), 1735928559); +ok(&Devel::PPPort::SvUVx("1735928559"), 1735928559); +ok(&Devel::PPPort::SvUVx(1735928559), 1735928559); +ok(&Devel::PPPort::SvUVx(0xdeadbeef), 0xdeadbeef); +ok(&Devel::PPPort::XSRETURN_UV(), 42); +ok(&Devel::PPPort::PUSHu(), 42); +ok(&Devel::PPPort::XPUSHu(), 43); + diff --git a/dist/Devel-PPPort/t/variables.t b/dist/Devel-PPPort/t/variables.t new file mode 100644 index 0000000000..ef1ac8b20d --- /dev/null +++ b/dist/Devel-PPPort/t/variables.t @@ -0,0 +1,107 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/variables instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (52) { + load(); + plan(tests => 52); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +ok(Devel::PPPort::compare_PL_signals()); + +ok(!defined(&Devel::PPPort::PL_sv_undef())); +ok(&Devel::PPPort::PL_sv_yes()); +ok(!&Devel::PPPort::PL_sv_no()); +ok(&Devel::PPPort::PL_na("abcd"), 4); +ok(&Devel::PPPort::PL_Sv(), "mhx"); +ok(defined &Devel::PPPort::PL_tokenbuf()); +ok($] >= 5.009005 || &Devel::PPPort::PL_parser()); +ok(&Devel::PPPort::PL_hexdigit() =~ /^[0-9a-zA-Z]+$/); +ok(defined &Devel::PPPort::PL_hints()); +ok(&Devel::PPPort::PL_ppaddr("mhx"), "MHX"); + +for (&Devel::PPPort::other_variables()) { + ok($_ != 0); +} + +{ + my @w; + my $fail = 0; + { + local $SIG{'__WARN__'} = sub { push @w, @_ }; + ok(&Devel::PPPort::dummy_parser_warning()); + } + if ($] >= 5.009005) { + ok(@w >= 0); + for (@w) { + print "# $_"; + unless (/^warning: dummy PL_bufptr used in.*module3.*:\d+/i) { + warn $_; + $fail++; + } + } + } + else { + ok(@w == 0); + } + ok($fail, 0); +} + +ok(&Devel::PPPort::no_dummy_parser_vars(1) >= ($] < 5.009005 ? 1 : 0)); + +eval { &Devel::PPPort::no_dummy_parser_vars(0) }; + +if ($] < 5.009005) { + ok($@, ''); +} +else { + if ($@) { + print "# $@"; + ok($@ =~ /^panic: PL_parser == NULL in.*module2.*:\d+/i); + } + else { + ok(1); + } +} + diff --git a/dist/Devel-PPPort/t/warn.t b/dist/Devel-PPPort/t/warn.t new file mode 100644 index 0000000000..d538055a65 --- /dev/null +++ b/dist/Devel-PPPort/t/warn.t @@ -0,0 +1,78 @@ +################################################################################ +# +# !!!!! Do NOT edit this file directly! !!!!! +# +# Edit mktests.PL and/or parts/inc/warn instead. +# +# This file was automatically generated from the definition files in the +# parts/inc/ subdirectory by mktests.PL. To learn more about how all this +# works, please read the F<HACKERS> file that came with this distribution. +# +################################################################################ + +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'; + } + + sub load { + eval "use Test"; + require 'testutil.pl' if $@; + } + + if (5) { + load(); + plan(tests => 5); + } +} + +use Devel::PPPort; +use strict; +$^W = 1; + +package Devel::PPPort; +use vars '@ISA'; +require DynaLoader; +@ISA = qw(DynaLoader); +bootstrap Devel::PPPort; + +package main; + +$^W = 0; + +my $warning; + +$SIG{'__WARN__'} = sub { $warning = $_[0] }; + +$warning = ''; +Devel::PPPort::warner(); +ok($] >= 5.004 ? $warning =~ /^warner bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_warner(); +ok($] >= 5.004 ? $warning =~ /^Perl_warner bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::Perl_warner_nocontext(); +ok($] >= 5.004 ? $warning =~ /^Perl_warner_nocontext bar:42/ : $warning eq ''); + +$warning = ''; +Devel::PPPort::ckWARN(); +ok($warning, ''); + +$^W = 1; + +$warning = ''; +Devel::PPPort::ckWARN(); +ok($] >= 5.004 ? $warning =~ /^ckWARN bar:42/ : $warning eq ''); + diff --git a/dist/Devel-PPPort/typemap b/dist/Devel-PPPort/typemap new file mode 100644 index 0000000000..68863a3291 --- /dev/null +++ b/dist/Devel-PPPort/typemap @@ -0,0 +1,36 @@ +################################################################################ +# +# typemap -- XS type mappings not present in early perls +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2013, 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 +HV * T_HVREF +STRLEN T_UV + +INPUT +T_UV + $var = ($type)SvUV($arg) +T_NV + $var = ($type)SvNV($arg) +T_HVREF + if (SvROK($arg) && SvTYPE(SvRV($arg))==SVt_PVHV) + $var = (HV*)SvRV($arg); + else + Perl_croak(aTHX_ \"$var is not a hash reference\") + +OUTPUT +T_UV + sv_setuv($arg, (UV)$var); +T_NV + sv_setnv($arg, (NV)$var); |