diff options
| author | Nicholas Clark <nick@ccl4.org> | 2009-09-26 18:36:33 +0100 |
|---|---|---|
| committer | Nicholas Clark <nick@ccl4.org> | 2009-09-26 18:36:33 +0100 |
| commit | b286197009ac308fc656630edad2ba5390660499 (patch) | |
| tree | 6758c3b08a84ffb260bcab5473698652f73049ec /cpan/Devel-PPPort | |
| parent | bd051ffa533cd11a03353dc0bf0c294bc68598f6 (diff) | |
| download | perl-b286197009ac308fc656630edad2ba5390660499.tar.gz | |
Move Devel::PPPort from ext/ to cpan/
Diffstat (limited to 'cpan/Devel-PPPort')
169 files changed, 21169 insertions, 0 deletions
diff --git a/cpan/Devel-PPPort/.gitignore b/cpan/Devel-PPPort/.gitignore new file mode 100644 index 0000000000..032b772d08 --- /dev/null +++ b/cpan/Devel-PPPort/.gitignore @@ -0,0 +1,5 @@ +/PPPort.pm +#ignored in /ext +#/ppport.h +/module*.c +/RealPPPort.xs diff --git a/cpan/Devel-PPPort/Changes b/cpan/Devel-PPPort/Changes new file mode 100644 index 0000000000..fb8ba3a097 --- /dev/null +++ b/cpan/Devel-PPPort/Changes @@ -0,0 +1,759 @@ +3.19 - 2009-06-14 + + * updated base/todo files + +3.18_01 - 2009-06-12 + + * fix CPAN #44614: Please support XSBODY + * fix CPAN #44655: Please support SVfARG + * added support for the following API + gv_fetchpvn_flags + gv_fetchpvs + gv_stashpvs + GvSVn + HvNAME_get + HvNAMELEN_get + isGV_with_GP + newSV_type + PL_error_count + PL_in_my + PL_in_my_stash + SVfARG + XSPROTO + (thanks to Goro Fuji for providing a patch to + implement almost all of these, fixes CPAN #44087) + +3.18 - 2009-06-12 + + * remove MAN3PODS option from Makefile.PL, which is + no longer needed (thanks to Nicholas Clark for + providing a patch) + * adapt mktests.PL for new layout of ext modules in + the core + +3.17 - 2009-03-15 + + * rework PTR macros, fixing PTR2ul for 5.6.1 + (fixes CPAN #39802, thanks to CHOCOLATE for + reporting and providing a patch) + * added support for the following API + PTR2nat + (second part of fix for CPAN #39802) + +3.16 - 2009-01-23 + + * fix DEFSV_set() for threaded 5.005 perls + * add G_METHOD support to call_sv() + +3.15 - 2009-01-18 + + * added support for the following API + DEFSV_set + * fix --unstrip for development versions + +3.14_05 - 2008-10-31 + + * fix stupid bugs in pv_pretty tests (only the + tests were broken, ppport.h was find) + +3.14_04 - 2008-10-30 + + * added support for the following API + isALNUMC [depend] + isASCII + isBLANK + isCNTRL + isGRAPH + isPRINT + isPSXSPC + isPUNCT + isXDIGIT + PERL_PV_ESCAPE_ALL + PERL_PV_ESCAPE_FIRSTCHAR + PERL_PV_ESCAPE_NOBACKSLASH + PERL_PV_ESCAPE_NOCLEAR + PERL_PV_ESCAPE_QUOTE + PERL_PV_ESCAPE_RE + PERL_PV_ESCAPE_UNI + PERL_PV_ESCAPE_UNI_DETECT + PERL_PV_PRETTY_DUMP + PERL_PV_PRETTY_ELLIPSES + PERL_PV_PRETTY_LTGT + PERL_PV_PRETTY_NOCLEAR + PERL_PV_PRETTY_QUOTE + PERL_PV_PRETTY_REGPROP + pv_display + pv_escape + pv_pretty + +3.14_03 - 2008-10-21 + + * fix C++ compilation issue with last release + (spotted by Nicholas Clark) + * added support for the following API + Perl_ppaddr_t + Perl_check_t + CPERLscope + (fixes CPAN #40078) + +3.14_02 - 2008-10-12 + + * added support for the following API + my_sprintf + PL_linestr + PL_bufptr + PL_bufend + PL_lex_state + PL_lex_stuff + PL_tokenbuf + SvPV_renew + (fixes CPAN #39809 and CPAN #39808) + * add read/write support for + PL_expect + PL_copline + PL_rsfp + PL_rsfp_filters + (fixes CPAN #39802) + * sync my_snprintf implementation with bleadperl + +3.14_01 - 2008-07-11 + + * resolve CPAN #37451: add PERLIO_FUNCS_DECL and + PERLIO_FUNCS_CAST + * update API info + +3.14 - 2008-06-01 + + * fix CPAN #36197: filename nit in parse_partspec + (thanks to Craig A. Berry for providing a patch) + +3.13_03 - 2008-05-13 + + * fix CPAN #35835: SvPV_flags_const_nolen segfaults prior + to perl 5.8.8 + +3.13_02 - 2008-04-13 + + * fix NV[efg]f format string macros for perl-5.6.0 built + using -Duselongdouble (thanks to Zefram for figuring this + out and to Jarkko Hietaniemi for keeping me in sync) + * add --patch and --oneshot options to devel/buildperl.pl + +3.13_01 - 2008-01-04 + + * fix dependency detection algorithm for functions + * fix some potential memory leaks in the test suite + * no need to use *_mg functions for mX?PUSH macros + * added support for the following API + mPUSHs + mXPUSHs + newSVpvn_flags + newSVpvn_utf8 + newSVpvs_flags + SVf_UTF8 + * make sure soak works with cromfs + +3.13 - 2007-10-04 + + * fix cpan #29748: ppport.h problems with perl5.005_05 + (spotted by Slaven Rezić) + * fix a compiler warning + +3.12 - 2007-09-22 + + [released without changes] + +3.11_06 - 2007-09-11 + + * fix cpan #29302: Perl_croak_nocontext doesn't need aTHX_ + (spotted by Jerry D. Hedden) + * fix a Win32 VC++ compiler warning (thanks to Steve Hay for + providing a patch) + * don't generate redundant specs for provided Perl_ functions + * fun with const and casts to avoid compiler warnings + * bump max supported version to 5.10.0 + +3.11_05 - 2007-08-20 + + * fix: PERL_HASH() was emitting a warning when passed in a + const char pointer + * fix: sv_magic_portable() was emitting a warning when + passed in a const char pointer + * fix: make sure arguments to sv_magic_portable() are only + evaluated once + +3.11_04 - 2007-08-20 + + * fix: ignore strings and XS comments when scanning and + patching files + * added support for the following API + newSVpvn_share + PERL_HASH + SvSHARED_HASH + * use PERL_BCDREVISION for version checking to save some + bytes in ppport.h + * improve the --strip option + - strip all C comments + - strip most superfluous whitespace + with these changes, the stripped ppport.h is now almost + 30% smaller: + 3.11_03 3.11_04 delta + ------------------------------------------ + uncompressed 87988 62573 -28.9% + gzip'd 17985 12725 -29.2% + +3.11_03 - 2007-08-14 + + * fix an infinite recursion in ppport.h that could be + triggered by circular dependencies + * fix PERL_BCDREVISION, which wasn't BCD but simply + shifted decimal (just in time for 5.10) + * fix detection of macros that are not listed in the + implementation/dontwarn sections + +3.11_02 - 2007-08-13 + + * fix cpan #25372: special case sv_magic(sv, obj, how, name, 0) + * fix cpan #27906: [PATCH] add UTF8_MAXBYTES + (thanks to Steve Peters for providing a patch) + * added support for the following API + sv_2pv_flags + sv_2pvbyte_nolen + SV_CONST_RETURN + SV_COW_DROP_PV + SV_COW_SHARED_HASH_KEYS + SV_GMAGIC + SV_HAS_TRAILING_NUL + SV_IMMEDIATE_UNREF + sv_magic_portable + SV_MUTABLE_RETURN + SV_NOSTEAL + sv_pvn_force_flags + SV_SMAGIC + SV_UTF8_NO_ENCODING + SvPV_const + SvPV_flags + SvPV_flags_const + SvPV_flags_const_nolen + SvPV_flags_mutable + SvPV_force + SvPV_force_flags + SvPV_force_flags_mutable + SvPV_force_flags_nolen + SvPV_force_mutable + SvPV_force_nolen + SvPV_force_nomg_nolen + SvPV_mutable + SvPV_nolen_const + SvPV_nomg_const + SvPV_nomg_const_nolen + SvUOK + UTF8_MAXBYTES + * provide compatibility macros for vanished variables + PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters + * add warnings support to ppport.h + * update ppport.h file searching logic + * add -c.inc and -xs.inc to the list of supported extensions + * document that --copy doesn't include the dot + * improve soak script and devel/buildperl.pl + +3.11_01 - 2007-03-23 + + * added support for the following API + PL_expect + load_module + vload_module + (thanks to Nicholas Clark for providing a patch) + +3.11 - 2007-02-14 + + * happy new year! + +3.10_02 - 2006-12-02 + + * add two missing files + +3.10_01 - 2006-12-02 + + * fix cpan #21239: Signals safe in Perl 5.8.0 + * fix PL_ppaddr and PL_no_modify support 5.005 perls + * added dTHXR, aTHXR and aTHXR_ for API that need + the context argument in pre-5.6.0 perls + * added support for the following API + PL_DBsignal + PL_DBtrace + PL_laststatval + PL_statcache + * added tests for all PL_* variables + * added progress indicator to soak script + * added --test-archives option to buildperl.pl script + * added comments to all autogenerated files that + clearly indicate their purpose and origin + +3.10 - 2006-08-14 + + * remove timestamp from generated ppport.h + +3.09_02 - 2006-07-25 + + * added support for the following API + my_strlcat + my_strlcpy + (thanks to Steve Peters for providing a patch) + +3.09_01 - 2006-07-21 + + * avoid using 'glob' when running under miniperl + +3.09 - 2006-07-08 + + * fix Makefile.PL's c_o override + * update API info + * improve soak script + - now counts warnings emitted during testing + - output is colored (can be turned off) + * add a section on integrating this module into + the core to the HACKERS file + +3.08_07 - 2006-07-03 + + * fix cpan #20179: Licensing information for PPPort is + unclear + * only --unstrip a stripped ppport.h if an appropriate + version of Devel::PPPort is installed + * add a --version option to ppport.h + +3.08_06 - 2006-06-25 + + * fix breakage on MSWin32, where generating XS files on + the fly doesn't seem to work the same way as under Linux + (thanks to Sadahiro Tomoyuki for providing a patch) + * load the shared files only when testing the module + * remove PPPort.xs from CPAN distribution + +3.08_05 - 2006-06-23 + + * when in the core, generate PPPort.pm and PPPort.xs + automatically + * PPPort.pm can now be loaded by miniperl + +3.08_04 - 2006-05-29 + + * update API info + * fix a bug in the automated API info generator that + caused slightly wrong output + * improve the speed of the automated API info generator; + we're now down from several hours to a few minutes + +3.08_03 - 2006-05-25 + + * update API info + * add devel/regenerate script to regenerate API info + * improve and speed up the development tools + +3.08_02 - 2006-05-22 + + * fix a POD error + * added POD test + * changed hv_stores() to omit the hash parameter + * improve soak script + - can now search directories for perl executables + - can use only perl binaries of at least a certain + revision using the --min option + - sorts tests by perl version + - shows a summary of failed versions + * added support for the following API + PERL_USE_GCC_BRACE_GROUPS + PoisonFree + PoisonNew + PoisonWith + SvREFCNT_inc + SvREFCNT_inc_NN + SvREFCNT_inc_simple + SvREFCNT_inc_simple_NN + SvREFCNT_inc_simple_void + SvREFCNT_inc_simple_void_NN + SvREFCNT_inc_void + SvREFCNT_inc_void_NN + +3.08_01 - 2006-05-20 + + * update NOOP and dNOOP to include lint directives + * update API info (for 5.8.8 and 5.9.3) + * added support for the following API + ckWARN + dVAR + hv_fetchs + hv_stores + my_snprintf + newSVpvs + packWARN + PERL_ABS + PERL_UNUSED_ARG + PERL_UNUSED_CONTEXT + PERL_UNUSED_VAR + STR_WITH_LEN + sv_catpvs + sv_setpvs + SVf + SvVSTRING_mg + warner + +3.08 - 2006-01-19 + + * thanks to Craig Berry for fixing my broken ppphtest + * add AUTHOR and ABSTRACT_FROM to Makefile.PL + +3.07 - 2006-01-16 + + * improve internals documentation in HACKERS + * minor internal cleanups + * thanks to Steve Peters for adding support for + the following API + SvMAGIC_set + SvPVX_const + SvPVX_mutable + SvRV_set + SvSTASH_set + SvUV_set + +3.06_04 - 2005-10-30 + + * add --strip / --unstrip options + * added support for the following API + Newx + Newxc + Newxz + XSRETURN + +3.06_03 - 2005-10-18 + + * fix extra ')' in PPPort_pm.PL + * fix compiler warnings + * fix test for PL_signals + * fix API listing + * more tests + +3.06_02 - 2005-10-18 + + * improve devel/buildperl.pl utility + * added support for the following API + dAXMARK + PL_signals + PERL_SIGNALS_UNSAFE_FLAG + XSprePUSH + +3.06_01 - 2005-06-25 + + * fix --compat-version argument checking + * filter files passed on the command line by default + to make sure 'perl ppport.h *' does something useful + * add --nofilter option to override the filtering + * testsuite now hopefully supports MacOS Classic + * check definedness of PERL_UNUSED_DECL + * update API info + +3.06 - 2005-02-02 + + * fix cpan #11327: make fails with syntax error + * fix XCPT_* macros + +3.05 - 2005-01-31 + + * fix a test for SvPV_nolen + * add more examples to tht documentation + * improve wording baseline information + * added support for the following API + dXCPT + dXSTARG + XCPT_CATCH + XCPT_RETHROW + XCPT_TRY_END + XCPT_TRY_START + +3.04 - 2004-12-29 + + * fix a hint for sv_pvn_force + * fix VMS problem with unquoted command line arguments + not preserving case (perl change #23367) + * add --api-info switch for ppport.h + +3.03 - 2004-09-08 + + * MY_CXT_CLONE was broken + +3.02 - 2004-09-08 + + * added support for the following API: + END_EXTERN_C + EXTERN_C + MY_CXT_CLONE + PERL_GCC_BRACE_GROUPS_FORBIDDEN + START_EXTERN_C + STMT_END + STMT_START + +3.01 - 2004-08-23 + + * patchlevel.h tweak + +3.00_03 - 2004-08-20 + + * make sure the @INC path is kept up-to-date when changing + directories while running in the core test suite + +3.00_02 - 2004-08-19 + + * remove PPPort.pm and PPPort.xs dependencies from Makefile.PL, + as they can be rebuilt with a "make regen" when neccessary + +3.00_01 - 2004-08-17 + + * fixed problems with $^X in t/ppphtest.t when building in + the core on OpenBSD + * fixed a "duplicate dependencies" bug that could lead to + global NEED_'s where static NEED_'s are sufficient + * added support for the following API: + PL_DBsingle + PL_DBsub + PL_debstash + PL_diehook + PL_errgv + PL_no_modify + PL_perl_destruct_level + PL_ppaddr + PL_stack_sp + PL_sv_arenaroot + PL_tainted + PL_tainting + PUSHu + sv_catpvf_mg + sv_catpvf_mg_nocontext + sv_setpvf_mg + sv_setpvf_mg_nocontext + sv_vcatpvf + sv_vcatpvf_mg + sv_vsetpvf + sv_vsetpvf_mg + vnewSVpvf + XPUSHu + +3.00 - 2004-08-16 + + * added support for dAX and dITEMS, which got lost while + working on the 3.00 internals + +2.99_07 - 2004-08-13 + + * improve/check documentation + * add tests for CopFILE and CopSTASHPV + * add file headers + * some code cleanups + +2.99_06 - 2004-08-11 + + * --compat-version now considers all macros/functions + provided by Devel::PPPort, not only the documented API + * fixed: PL_rsfp was PL_rsfpv + * turn __PPPORT_NAME__ back to ppport.h, because the former + looks ugly on search.cpan.org + +2.99_05 - 2004-08-10 + + * --compat-version now also hides compatibility warnings for + unsupported API calls + +2.99_04 - 2004-08-10 + + * added code to check for correct INSTALLDIRS + * added --compat-version option to ppport.h script to only + check for compatibility with at least the given Perl version + * some small adjustments + +2.99_03 - 2004-08-09 + + * remove useless dependency from Makefile.PL (spotted by + Craig A. Berry) + * added checking for and replacement of C++ comments as + well as --cplusplus option to suppress it to ppport.h + script + * added more diagnostic output to ppport.h script + * added a hint for gv_stashpvn + * fixed the thread tests (spotted by Craig A. Berry) + * added more tests + * renamed and documented DPPP_NAMESPACE + * renamed some files + +2.99_02 - 2004-08-08 + + * second beta + * feature complete for 3.00 + * implemented missing functionality for ppport.h script: + - can now perform global (i.e. multi-file) NEED_ checks + - checks source for missing aTHX arguments + - checks source for unsupported API calls + - can now lists provided and unsupported API + - can use Text::Diff on platforms without diff utility + - can use custom diff utility / options + - can write one patch against the module + - can write single copies with changes applied + * updated the documentation for Devel::PPPort and ppport.h + * added lots of tests for the ppport.h script + * merged tests for call_* eval_* from XS::APItest + * added HACKERS file to document internals + * now includes PPPort.pm, so you can read the full docs + using search.cpan.org + +2.99_01 - 2004-08-07 + + * first beta towards 3.00 + * complete rework of internals + * autogenerated API-checks + * autogenerated .pm, .xs and .t files + * ppport.h changes: + - no static/global functions without explicit NEED_ + - can now be run without -x + - now shows hints and dependencies + - now has POD documentation, so perldoc ppport.h works + - now has options + - now uses File::Find when available + * tested with multi-threaded (ithreads and 5.005-threads) perls + from 5.005 and single-threaded perls from 5.003 up to 5.9.x + * added support for the following API: + CopFILE + CopFILEAV + CopFILEGV + CopFILEGV_set + CopFILE_set + CopFILESV + CopSTASH + CopSTASH_eq + CopSTASHPV + CopSTASHPV_set + CopSTASH_set + CopyD + dUNDERBAR + IN_PERL_COMPILETIME + IV_MAX + IV_MIN + IVTYPE + memEQ + memNE + MoveD + mPUSHi + mPUSHn + mPUSHp + mPUSHu + mXPUSHi + mXPUSHn + mXPUSHp + mXPUSHu + newCONSTSUB + newSVuv + PERL_INT_MAX + PERL_INT_MIN + PERL_LONG_MAX + PERL_LONG_MIN + PERL_QUAD_MAX + PERL_QUAD_MIN + PERL_SHORT_MAX + PERL_SHORT_MIN + PERL_UCHAR_MAX + PERL_UCHAR_MIN + PERL_UINT_MAX + PERL_UINT_MIN + PERL_ULONG_MAX + PERL_ULONG_MIN + PERL_UQUAD_MAX + PERL_UQUAD_MIN + PERL_USHORT_MAX + PERL_USHORT_MIN + PL_hexdigit + PL_rsfp + Poison + PUSHmortal + sv_2pvbyte + sv_2pvbyte_nolen + sv_2pv_nolen + sv_2uv + sv_catpv_mg + sv_catpvn_mg + sv_catpvn_nomg + sv_catsv_mg + sv_catsv_nomg + SvGETMAGIC + SvIV_nomg + SvPV_force_nomg + sv_pvn + sv_pvn_force + sv_pvn_nomg + SvPV_nomg + sv_setiv_mg + sv_setnv_mg + sv_setpv_mg + sv_setpvn_mg + sv_setsv_mg + sv_setsv_nomg + sv_setuv + sv_setuv_mg + sv_usepvn_mg + sv_uv + SvUV + SvUV_nomg + SvUVx + SvUVX + SvUVXx + UNDERBAR + UV_MAX + UV_MIN + UVTYPE + XPUSHmortal + XSRETURN_UV + XST_mUV + ZeroD + +2.008 - 20th October 2003 + + * eval_(pv|sv) added + * PERL_MAGIC_* added + +2.007 - 18th September 2003 + + * small fix in grok_numeric_radix: variable was used uninitialized + +2.006 - 8th September 2003 + + * call_(pv|sv|method|argv) added + * still compiler-warnings for grok_??? and 5.6.x, fixed + +2.005 - 2nd September 2003 + + * Some tweaks to grok_(hex|oct|bin) to make compiler warnings + go away for older perls + * grok_number and grok_numeric_radix added + +2.004 - 22th August 2003 + + * Added grok_(hex|oct|bin) and related constants + +2.003 - 8th May 2003 + + * Added get_av, get_cv, get_hv and get_sv + +2.002 - 2nd December 2001 + + * More portability issues in Makefile.PL addresed. + * Merged the Harness sub-module into Devel::PPPort + * More documentation in PPPort.pm + +2.001 + + * Some portability issues in Makefile.PL addresed. + +2.000 + + * Initial port to the perl core. + +1.007 + + * Original version of the module by Kenneth Albanowski. diff --git a/cpan/Devel-PPPort/HACKERS b/cpan/Devel-PPPort/HACKERS new file mode 100644 index 0000000000..540947f4d1 --- /dev/null +++ b/cpan/Devel-PPPort/HACKERS @@ -0,0 +1,326 @@ +=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 114 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 114 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 114 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.10.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 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 either the author +(E<lt>mhx@cpan.orgE<gt>) or to the CPAN Request Tracker at +L<http://rt.cpan.org>. + +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-2009, 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/cpan/Devel-PPPort/MANIFEST.SKIP b/cpan/Devel-PPPort/MANIFEST.SKIP new file mode 100644 index 0000000000..4df9284b91 --- /dev/null +++ b/cpan/Devel-PPPort/MANIFEST.SKIP @@ -0,0 +1,18 @@ +^Makefile$ +~$ +\.old(?:\..*)?$ +\.swp$ +\.o$ +\.bs$ +\.bak$ +\.orig$ +\.cache\.cm$ +^blib +^pm_to_blib +^backup +^parts/todo- +^parts/base- +^ppport\.h$ +^PPPort\.c$ +^testing +Devel-PPPort.*\.tar\.gz$ diff --git a/cpan/Devel-PPPort/Makefile.PL b/cpan/Devel-PPPort/Makefile.PL new file mode 100644 index 0000000000..67eebc1b52 --- /dev/null +++ b/cpan/Devel-PPPort/Makefile.PL @@ -0,0 +1,141 @@ +################################################################################ +# +# Makefile.PL -- generate Makefile +# +################################################################################ +# +# $Revision: 30 $ +# $Author: mhx $ +# $Date: 2009/06/12 04:07:05 +0200 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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, +); + +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 + push @moreopts, INSTALLDIRS => ($] >= 5.007003 ? '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/cpan/Devel-PPPort/PPPort.xs b/cpan/Devel-PPPort/PPPort.xs new file mode 100644 index 0000000000..2586824ebb --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/PPPort_pm.PL b/cpan/Devel-PPPort/PPPort_pm.PL new file mode 100644 index 0000000000..fcc8671ef6 --- /dev/null +++ b/cpan/Devel-PPPort/PPPort_pm.PL @@ -0,0 +1,669 @@ +################################################################################ +# +# PPPort_pm.PL -- generate PPPort.pm +# +################################################################################ +# +# $Revision: 65 $ +# $Author: mhx $ +# $Date: 2009/06/12 04:10:36 +0200 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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 } 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.10.0}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 +# +################################################################################ +# +# $Revision: 65 $ +# $Author: mhx $ +# $Date: 2009/06/12 04:10:36 +0200 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, Marcus Holland-Moritz. +# Version 2.x, Copyright (C) 2001, Paul Marquess. +# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +=head1 NAME + +Devel::PPPort - Perl/Pollution/Portability + +=head1 SYNOPSIS + + Devel::PPPort::WriteFile(); # defaults to ./ppport.h + Devel::PPPort::WriteFile('someheader.h'); + +=head1 DESCRIPTION + +Perl's API has changed over time, gaining new features, new functions, +increasing its flexibility, and reducing the impact on the C namespace +environment (reduced pollution). The header file written by this module, +typically F<ppport.h>, attempts to bring some of the newer Perl API +features to older versions of Perl, so that you can worry less about +keeping track of old releases, but users can still reap the benefit. + +C<Devel::PPPort> contains a single function, called C<WriteFile>. Its +only purpose is to write the F<ppport.h> C header file. This file +contains a series of macros and, if explicitly requested, functions that +allow XS modules to be built using older versions of Perl. Currently, +Perl versions from __MIN_PERL__ to __MAX_PERL__ are supported. + +This module is used by C<h2xs> to write the file F<ppport.h>. + +=head2 Why use ppport.h? + +You should use F<ppport.h> in modern code so that your code will work +with the widest range of Perl interpreters possible, without significant +additional work. + +You should attempt older code to fully use F<ppport.h>, because the +reduced pollution of newer Perl versions is an important thing. It's so +important that the old polluting ways of original Perl modules will not be +supported very far into the future, and your module will almost certainly +break! By adapting to it now, you'll gain compatibility and a sense of +having done the electronic ecology some good. + +=head2 How to use ppport.h + +Don't direct the users of your module to download C<Devel::PPPort>. +They are most probably no XS writers. Also, don't make F<ppport.h> +optional. Rather, just take the most recent copy of F<ppport.h> that +you can find (e.g. by generating it with the latest C<Devel::PPPort> +release from CPAN), copy it into your project, adjust your project to +use it, and distribute the header along with your module. + +=head2 Running ppport.h + +But F<ppport.h> is more than just a C header. It's also a Perl script +that can check your source code. It will suggest hints and portability +notes, and can even make suggestions on how to change your code. You +can run it like any other Perl program: + + perl ppport.h [options] [files] + +It also has embedded documentation, so you can use + + perldoc ppport.h + +to find out more about how to use it. + +=head1 FUNCTIONS + +=head2 WriteFile + +C<WriteFile> takes one optional argument. When called with one +argument, it expects to be passed a filename. When called with +no arguments, it defaults to the filename F<ppport.h>. + +The function returns a true value if the file was written successfully. +Otherwise it returns a false value. + +=head1 COMPATIBILITY + +F<ppport.h> supports Perl versions from __MIN_PERL__ to __MAX_PERL__ +in threaded and non-threaded configurations. + +=head2 Provided Perl compatibility API + +The header file written by this module, typically F<ppport.h>, provides +access to the following elements of the Perl API that is not available +in older Perl releases: + + __PROVIDED_API__ + +=head2 Perl API not supported by ppport.h + +There is still a big part of the API not supported by F<ppport.h>. +Either because it doesn't make sense to back-port that part of the API, +or simply because it hasn't been implemented yet. Patches welcome! + +Here's a list of the currently unsupported API, and also the version of +Perl below which it is unsupported: + +=over 4 + +__UNSUPPORTED_API__ + +=back + +=head1 BUGS + +If you find any bugs, C<Devel::PPPort> doesn't seem to build on your +system or any of its tests fail, please use the CPAN Request Tracker +at L<http://rt.cpan.org/> to create a ticket for the module. + +=head1 AUTHORS + +=over 2 + +=item * + +Version 1.x of Devel::PPPort was written by Kenneth Albanowski. + +=item * + +Version 2.x was ported to the Perl core by Paul Marquess. + +=item * + +Version 3.x was ported back to CPAN by Marcus Holland-Moritz. + +=back + +=head1 COPYRIGHT + +Version 3.x, Copyright (C) 2004-2009, 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 = do { my @r = '$Snapshot: /Devel-PPPort/3.19 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; + +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 WriteFile +{ + my $file = shift || 'ppport.h'; + defined $data or _init_data(); + my $copy = $data; + $copy =~ s/\bppport\.h\b/$file/g; + + open F, ">$file" or return undef; + print F $copy; + close F; + + return 1; +} + +1; + +__DATA__ +#if 0 +<<'SKIP'; +#endif +/* +---------------------------------------------------------------------- + + ppport.h -- Perl/Pollution/Portability Version __VERSION__ + + Automatically created by __PKG__ running under perl __PERL_VERSION__. + + 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/cpan/Devel-PPPort/PPPort_xs.PL b/cpan/Devel-PPPort/PPPort_xs.PL new file mode 100644 index 0000000000..8d9fd4f674 --- /dev/null +++ b/cpan/Devel-PPPort/PPPort_xs.PL @@ -0,0 +1,140 @@ +################################################################################ +# +# PPPort_xs.PL -- generate RealPPPort.xs +# +################################################################################ +# +# $Revision: 15 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:48 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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 (exists $ENV{PERL_NO_GET_CONTEXT} && $ENV{PERL_NO_GET_CONTEXT}) { +$SECTION{xshead}{code} .= <<END; +#define PERL_NO_GET_CONTEXT +END +} + +my $file; +my $sec; + +for $file (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 +* +******************************************************************************** +* +* $Revision: 15 $ +* $Author: mhx $ +* $Date: 2009/01/18 14:10:48 +0100 $ +* +******************************************************************************** +* +* Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/README b/cpan/Devel-PPPort/README new file mode 100644 index 0000000000..fc24309964 --- /dev/null +++ b/cpan/Devel-PPPort/README @@ -0,0 +1,78 @@ + + ------------------------------------------------------ + Devel::PPPort - Perl/Pollution/Portability Version 3 + ------------------------------------------------------ + +CONTENTS + +1. DESCRIPTION +2. INSTALLATION +3. DOCUMENTATION +4. BUGS +5. COPYRIGHT + + +-------------- +1. DESCRIPTION +-------------- + +Perl's API has changed over time, gaining new features, new functions, +increasing its flexibility, and reducing the impact on the C namespace +environment (reduced pollution). The header file written by this module, +typically F<ppport.h>, attempts to bring some of the newer Perl API +features to older versions of Perl, so that you can worry less about +keeping track of old releases, but users can still reap the benefit. + +--------------- +2. INSTALLATION +--------------- + +Installation of the Devel::PPPort module follows the standard Perl Way +and should not be harder than: + + perl Makefile.PL + make + make test + make install + +Note that you may need to become superuser to 'make install'. + +If you're building the module under Windows, you may need to use a +different make program, such as 'nmake', instead of 'make'. + +---------------- +3. DOCUMENTATION +---------------- + +To see the documentation, use the perldoc command: + + perldoc Devel::PPPort + +You can also visit CPAN Search and see the documentation online as +pretty nice HTML. This is also where you will find the most recent +version of this module: + + http://search.cpan.org/~mhx/Devel-PPPort/ + +------- +4. BUGS +------- + +If you find any bugs, Devel::PPPort doesn't seem to build on your +system or any of its tests fail, please use the CPAN Request Tracker + + http://rt.cpan.org/ + +to create a ticket for the module. + +------------ +5. COPYRIGHT +------------ + +Version 3.x, Copyright (C) 2004-2009, 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. + diff --git a/cpan/Devel-PPPort/TODO b/cpan/Devel-PPPort/TODO new file mode 100644 index 0000000000..961acd918c --- /dev/null +++ b/cpan/Devel-PPPort/TODO @@ -0,0 +1,347 @@ +TODO: + +* > 3. In several cases, "perl ppport.h --copy=.new" output a new file in + > which the only change was the addition of "#include "ppport.h"". In each + > case, that actually wasn't necessary because the source file in question + > already #included another source file which #included ppport.h itself. + > Would it be possible for the analyzer to follow #include directives to + > spot cases like this? + + Uh, well, I guess it would be possible. But I have some concerns: + + 1. ppport.h is already too big. :-) + + 2. There is code in ppport.h to actually remove an + + #include "ppport.h" + + if it appears not to be needed. If it's not needed in your + included file, it might be dropped from there and moved to + the other file that included the first one. This would make + the logic much more complicated. + + 3. As ppport.h is configurable, it's not (always) a good idea + to put it into a file that's included from another file. + + I guess I'll have to think about this a little more. Maybe I can + come up with a fancy solution that doesn't increase the code size + too much. + + +* On 14/12/06, Nicholas Clark <nick@ccl4.org> wrote: + > On Thu, Dec 14, 2006 at 05:03:24AM +0100, Andreas J. Koenig wrote: + > + > > Params::Validate and Clone suffer from the same cold: + > + > The same patch will make both compile and pass tests. + > I'm wondering if it might be better to totally drop SVt_PBVM and let source + > code fail to compile. + + I don't think so. Because : + 1. your redefinition of SVt_PBVM is probably what most XS modules want + 2. anyway, if we remove it from the core, it might appear in Devel::PPPort :) + + +* maybe backport bytes_from_utf8() for 5.6.0 (or even before)? + +* check which of the following we need to support: + + amagic_generation + AMG_names + an + Argv + argvgv + argvoutgv + basetime + beginav + block_type + bodytarget + bufend + bufptr + check + chopset + Cmd + compcv + compiling + comppad + comppad_name + comppad_name_fill + copline + cop_seqmax + cryptseen + cshlen + cshname + curcop + curinterp + curpad + curpm + curstash + curstname + dbargs + DBgv + DBline + DBsignal + DBsingle + DBsub + DBtrace + debstash + debug + defgv + defoutgv + defstash + delaymagic + diehook + dirty + doextract + doswitches + do_undump + dowarn + egid + encoding + endav + envgv + errgv + error_count + errors + euid + eval_root + evalseq + eval_start + expect + fdpid + filemode + firstgv + fold + forkprocess + formfeed + formtarget + freq + generation + gensym + gid + hexdigit + hints + incgv + in_eval + in_my + inplace + lastfd + last_in_gv + last_lop + last_lop_op + lastscream + laststatval + laststype + last_uni + lex_brackets + lex_brackstack + lex_casemods + lex_casestack + lex_defer + lex_dojoin + lex_expect + lex_formbrack + lex_inpat + lex_inwhat + lex_op + lex_repl + lex_starts + lex_state + lex_stuff + lineary + linestr + localizing + main_cv + main_root + mainstack + main_start + markstack + markstack_max + markstack_ptr + max_intro_pending + maxo + maxscream + maxsysfd + min_intro_pending + minus_a + minus_c + minus_F + minus_l + minus_n + minus_p + multi_close + multi_end + multi_open + multi_start + na + nexttoke + nexttype + nextval + nice_chunk + nice_chunk_size + No + no_aelem + no_dir_func + no_func + no_mem + nomemok + no_modify + no_myglob + no_security + no_sock_func + no_symref + no_usym + no_wrongref + nrs + oldbufptr + oldname + oldoldbufptr + op + opargs + op_desc + op_mask + op_name + op_seq + origalen + origargc + origargv + origenviron + origfilename + osname + padix + padix_floor + pad_reset_pending + patchlevel + patleave + perldb + perl_destruct_level + pidstatus + ppaddr + preambleav + preambled + preprocess + profiledata + regdummy + regendp + regeol + reginput + regkind + reglastparen + regsize + regstartp + restartop + rs + rsfp + rsfp_filters + runops + savestack + savestack_ix + savestack_max + sawampersand + scopestack + scopestack_ix + scopestack_max + screamfirst + screamnext + secondgv + signals + sig_name + sig_num + simple + sortcop + sortstash + splitstr + stack_base + stack_max + stack_sp + statbuf + statcache + statgv + statname + statusvalue + stdingv + sub_generation + subline + subname + Sv + sv_arenaroot + sv_count + sv_no + sv_objcount + sv_root + sv_undef + sv_yes + tainted + tainting + timesbuf + tmps_floor + tmps_ix + tmps_max + tmps_stack + tokenbuf + top_env + toptarget + uid + unsafe + varies + vtbl_amagic + vtbl_amagicelem + vtbl_arylen + vtbl_bm + vtbl_dbline + vtbl_env + vtbl_envelem + vtbl_glob + vtbl_isa + vtbl_isaelem + vtbl_mglob + vtbl_pack + vtbl_packelem + vtbl_pos + vtbl_sig + vtbl_sigelem + vtbl_substr + vtbl_sv + vtbl_taint + vtbl_uvar + vtbl_vec + warnhook + warn_nl + warn_nosemi + warn_reserved + warn_uninit + watchaddr + watchok + Xpv + Yes + +* have an --env option for soak to set env variable combinations + +* only overwrite generated files if they actually changed + +* try to make parts/apicheck.pl automatically find NEED_ #defines + +* add support for my_vsnprintf? + +* try to perform some core consistency checks: + + - check if 'd' flag in embed.fnc matches with + supplied documentation + + - check if all public API is documented + +* check (during make regen?) if MAX_PERL in PPPort_pm.PL + needs to be updated + +* see if we can implement sv_catpvf() for < 5.004 + +* MULTICALL ? + +* improve apicheck (things like utf8_mg_pos_init() are + not currently checked) + +* more documentation, more tests + +* Resolve dependencies in Makefile.PL and remind of + running 'make regen' + diff --git a/cpan/Devel-PPPort/apicheck_c.PL b/cpan/Devel-PPPort/apicheck_c.PL new file mode 100644 index 0000000000..e4d861e18a --- /dev/null +++ b/cpan/Devel-PPPort/apicheck_c.PL @@ -0,0 +1,29 @@ +################################################################################ +# +# apicheck_c.PL -- generate apicheck.c +# +################################################################################ +# +# $Revision: 11 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:49 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/devel/buildperl.pl b/cpan/Devel-PPPort/devel/buildperl.pl new file mode 100644 index 0000000000..49b7fbbf29 --- /dev/null +++ b/cpan/Devel-PPPort/devel/buildperl.pl @@ -0,0 +1,539 @@ +#!/usr/bin/perl -w +################################################################################ +# +# buildperl.pl -- build various versions of perl automatically +# +################################################################################ +# +# $Revision: 15 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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)/ ], + }, + 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 ], + ], + }, +); + +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)$/ 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}); + + print "building perl $perl->{version} ($current{config})\n"; + + run_or_die("./Configure $config{$current{config}}{config_args} -Dusedevel -Uinstallusrbinperl -Dprefix=$prefix"); + run_or_die("sed -i -e '/^.*<built-in>/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 +{ + 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-2009, 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/cpan/Devel-PPPort/devel/devtools.pl b/cpan/Devel-PPPort/devel/devtools.pl new file mode 100644 index 0000000000..a87c172000 --- /dev/null +++ b/cpan/Devel-PPPort/devel/devtools.pl @@ -0,0 +1,129 @@ +################################################################################ +# +# devtools.pl -- various utility functions +# +################################################################################ +# +# $Revision: 5 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/devel/mkapidoc.sh b/cpan/Devel-PPPort/devel/mkapidoc.sh new file mode 100644 index 0000000000..a4de2b4a27 --- /dev/null +++ b/cpan/Devel-PPPort/devel/mkapidoc.sh @@ -0,0 +1,87 @@ +#!/bin/bash +################################################################################ +# +# mkapidoc.sh -- generate apidoc.fnc from scanning the Perl source +# +################################################################################ +# +# $Revision: 13 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/devel/mktodo b/cpan/Devel-PPPort/devel/mktodo new file mode 100644 index 0000000000..d2bf8b8d8c --- /dev/null +++ b/cpan/Devel-PPPort/devel/mktodo @@ -0,0 +1,62 @@ +#!/usr/bin/perl -w +################################################################################ +# +# mktodo -- generate baseline and todo files by running mktodo.pl +# +################################################################################ +# +# $Revision: 16 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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, +); + +GetOptions(\%opt, qw( base check! verbose )) or die; + +identify(); + +my $outdir = 'parts/todo'; + +my $install = '/tmp/perl/install/default'; +# my $install = '/tmp/perl/install/thread'; + +my @perls = sort { $b->{version} <=> $a->{version} } + map { { version => `$_ -e 'printf "%.6f", \$]'`, path => $_ } } + ('bleadperl', glob "$install/*/bin/perl5.*"); + +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/cpan/Devel-PPPort/devel/mktodo.pl b/cpan/Devel-PPPort/devel/mktodo.pl new file mode 100644 index 0000000000..156a1c8518 --- /dev/null +++ b/cpan/Devel-PPPort/devel/mktodo.pl @@ -0,0 +1,346 @@ +#!/usr/bin/perl -w +################################################################################ +# +# mktodo.pl -- generate baseline and todo files +# +################################################################################ +# +# $Revision: 16 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:51 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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 %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; + } + } + } + + 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 = run(qw(make apicheck.i)); + + if ($r->{didnotrun} or $r->{status}) { + die "cannot run make apicheck.i"; + } + + 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/cpan/Devel-PPPort/devel/regenerate b/cpan/Devel-PPPort/devel/regenerate new file mode 100644 index 0000000000..31765055cd --- /dev/null +++ b/cpan/Devel-PPPort/devel/regenerate @@ -0,0 +1,161 @@ +#!/usr/bin/perl -w +################################################################################ +# +# regenerate -- regenerate baseline and todo files +# +################################################################################ +# +# $Revision: 8 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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 )) 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/\E$cur/$old/ or die "Ooops!"; + move($src, $dst) or die "Moving $src to $dst failed: $!\n"; + } +} + +my $T0 = time; +my @args = ddverbose(); +push @args, '--nocheck' unless $opt{check}; + +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', 'write')) { + 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-2009, 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/cpan/Devel-PPPort/devel/scanprov b/cpan/Devel-PPPort/devel/scanprov new file mode 100644 index 0000000000..19d294472a --- /dev/null +++ b/cpan/Devel-PPPort/devel/scanprov @@ -0,0 +1,77 @@ +#!/usr/bin/perl -w +################################################################################ +# +# scanprov -- scan Perl headers for provided macros +# +################################################################################ +# +# $Revision: 9 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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'; + +die "Usage: $0 [check|write]\n" unless @ARGV && $ARGV[0] =~ /^(check|write)$/; +my $mode = $1; + +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 $install = '/tmp/perl/install/default'; + +my @perls = sort { $b->{version} <=> $a->{version} } + map { { version => `$_ -e 'printf "%.6f", \$]'`, path => $_ } } + ('bleadperl', glob "$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"; + $mode eq 'write' and (open F, ">>$file" or die "$file: $!\n"); + for (@new) { + print "adding $_\n"; + $mode eq 'write' and printf F "%-30s # added by $0\n", $_; + } + $mode eq 'write' and close F; +} diff --git a/cpan/Devel-PPPort/mktests.PL b/cpan/Devel-PPPort/mktests.PL new file mode 100644 index 0000000000..82ccab3238 --- /dev/null +++ b/cpan/Devel-PPPort/mktests.PL @@ -0,0 +1,114 @@ +################################################################################ +# +# mktests.PL -- generate test files for Devel::PPPort +# +################################################################################ +# +# $Revision: 31 $ +# $Author: mhx $ +# $Date: 2009/06/11 20:53:42 +0200 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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'}) { + 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/cpan/Devel-PPPort/module2.c b/cpan/Devel-PPPort/module2.c new file mode 100644 index 0000000000..e5f4ef607c --- /dev/null +++ b/cpan/Devel-PPPort/module2.c @@ -0,0 +1,60 @@ +/******************************************************************************* +* +* Perl/Pollution/Portability +* +******************************************************************************** +* +* $Revision: 12 $ +* $Author: mhx $ +* $Date: 2009/01/18 14:10:49 +0100 $ +* +******************************************************************************** +* +* Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/module3.c b/cpan/Devel-PPPort/module3.c new file mode 100644 index 0000000000..bcfbcd08b3 --- /dev/null +++ b/cpan/Devel-PPPort/module3.c @@ -0,0 +1,77 @@ +/******************************************************************************* +* +* Perl/Pollution/Portability +* +******************************************************************************** +* +* $Revision: 12 $ +* $Author: mhx $ +* $Date: 2009/01/18 14:10:49 +0100 $ +* +******************************************************************************** +* +* Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/apicheck.pl b/cpan/Devel-PPPort/parts/apicheck.pl new file mode 100644 index 0000000000..e6caab57c9 --- /dev/null +++ b/cpan/Devel-PPPort/parts/apicheck.pl @@ -0,0 +1,323 @@ +#!/usr/bin/perl -w +################################################################################ +# +# apicheck.pl -- generate C source for automated API check +# +################################################################################ +# +# $Revision: 35 $ +# $Author: mhx $ +# $Date: 2009/06/12 12:29:35 +0200 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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_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_load_module +#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_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_vload_module +#define NEED_vnewSVpvf +#define NEED_warner +#define NEED_newSVpvn_flags + +#include "ppport.h" + +#endif + +static int VARarg1; +static char *VARarg2; +static double VARarg3; + +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"; + + unless ($f->{flags}{'m'} and @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/cpan/Devel-PPPort/parts/apidoc.fnc b/cpan/Devel-PPPort/parts/apidoc.fnc new file mode 100644 index 0000000000..740e04fc45 --- /dev/null +++ b/cpan/Devel-PPPort/parts/apidoc.fnc @@ -0,0 +1,330 @@ +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +: +: !!!! 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>. +: + +Ama|char*|savepvs|const char* s +Ama|SV*|newSVpvs|const char* s +Ama|SV*|newSVpvs_flags|const char* s|U32 flags +Ama|SV*|newSVpvs_share|const char* s +Am|bool|isALNUM|char ch +Am|bool|isALPHA|char ch +Am|bool|isDIGIT|char ch +Am|bool|isLOWER|char ch +Am|bool|isSPACE|char ch +Am|bool|isUPPER|char ch +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|bool|SvIOK_notUV|SV* sv +Am|bool|SvIOK_UV|SV* sv +Am|bool|SvIsCOW_shared_hash|SV* sv +Am|bool|SvIsCOW|SV* sv +Am|bool|SvRXOK|SV* sv +Am|bool|SvTAINTED|SV* sv +Am|bool|SvTRUE|SV* sv +Am|bool|SvUOK|SV* sv +Am|bool|SvVOK|SV* sv +Am|char*|HePV|HE* he|STRLEN len +Am|char*|HeUTF8|HE* he|STRLEN len +Am|char*|HvNAME|HV* stash +Am|char*|SvEND|SV* sv +Am|char*|SvGAMAGIC|SV* sv +Am|char *|SvGROW|SV* sv|STRLEN len +Am|char*|SvPVbyte_force|SV* sv|STRLEN len +Am|char*|SvPVbyte_nolen|SV* sv +Am|char*|SvPVbyte|SV* sv|STRLEN len +Am|char*|SvPVbytex_force|SV* sv|STRLEN len +Am|char*|SvPVbytex|SV* sv|STRLEN len +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|SV* sv|STRLEN len +Am|char*|SvPV|SV* sv|STRLEN len +Am|char*|SvPVutf8_force|SV* sv|STRLEN len +Am|char*|SvPVutf8_nolen|SV* sv +Am|char*|SvPVutf8|SV* sv|STRLEN len +Am|char*|SvPVutf8x_force|SV* sv|STRLEN len +Am|char*|SvPVutf8x|SV* sv|STRLEN len +Am|char*|SvPVX|SV* sv +Am|char*|SvPVx|SV* sv|STRLEN len +Am|char|toLOWER|char ch +Am|char|toUPPER|char ch +Am|HV*|CvSTASH|CV* cv +Am|HV*|gv_stashpvs|const char* name|I32 create +Am|HV*|SvSTASH|SV* sv +Am|int|AvFILL|AV* av +Am|IV|SvIV_nomg|SV* sv +Am|IV|SvIV|SV* sv +Am|IV|SvIVx|SV* sv +Am|IV|SvIVX|SV* sv +Amn|char*|CLASS +Amn|char*|POPp +Amn|char*|POPpbytex +Amn|char*|POPpx +Amn|HV*|PL_modglobal +Amn|I32|ax +Amn|I32|items +Amn|I32|ix +Amn|IV|POPi +Amn|long|POPl +Amn|NV|POPn +Amn|STRLEN|PL_na +Amn|SV|PL_sv_no +Amn|SV|PL_sv_undef +Amn|SV|PL_sv_yes +Amn|SV*|POPs +Amn|U32|GIMME +Amn|U32|GIMME_V +Am|NV|SvNV|SV* sv +Am|NV|SvNVx|SV* sv +Am|NV|SvNVX|SV* sv +Amn|(whatever)|RETVAL +Amn|(whatever)|THIS +Am|REGEXP *|SvRX|SV *sv +Ams||dAX +Ams||dAXMARK +Ams||dITEMS +Ams||dMARK +Ams||dMULTICALL +Ams||dORIGMARK +Ams||dSP +Ams||dUNDERBAR +Ams||dXCPT +Ams||dXSARGS +Ams||dXSI32 +Ams||ENTER +Ams||FREETMPS +Ams||LEAVE +Ams||MULTICALL +Ams||POP_MULTICALL +Ams||PUSH_MULTICALL +Ams||PUTBACK +Ams||SAVETMPS +Ams||SPAGAIN +Am|STRLEN|HeKLEN|HE* he +Am|STRLEN|SvCUR|SV* sv +Am|STRLEN|SvLEN|SV* sv +Am|SV*|GvSV|GV* gv +Am|SV*|HeSVKEY_force|HE* he +Am|SV*|HeSVKEY|HE* he +Am|SV*|HeSVKEY_set|HE* he|SV* sv +Am|SV*|HeVAL|HE* he +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*|newRV_inc|SV* sv +Am|SV*|newSVpvn_utf8|NULLOK const char* s|STRLEN len|U32 utf8 +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|svtype|SvTYPE|SV* sv +Ams||XCPT_RETHROW +Ams||XSRETURN_EMPTY +Ams||XSRETURN_NO +Ams||XSRETURN_UNDEF +Ams||XSRETURN_YES +Ams||XS_VERSION_BOOTCHECK +Am|U32|HeHASH|HE* he +Am|U32|SvIOKp|SV* sv +Am|U32|SvIOK|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 +AmU||G_ARRAY +AmU||G_DISCARD +AmU||G_EVAL +AmU||G_NOARGS +AmU||G_SCALAR +AmU||G_VOID +AmU||HEf_SVKEY +AmU||MARK +AmU||newXSproto|char* name|XSUBADDR_t f|char* filename|const char *proto +AmU||Nullav +AmU||Nullch +AmU||Nullcv +AmU||Nullhv +AmU||Nullsv +AmU||ORIGMARK +AmU||SP +AmU||SVt_IV +AmU||SVt_NV +AmU||SVt_PV +AmU||SVt_PVAV +AmU||SVt_PVCV +AmU||SVt_PVHV +AmU||SVt_PVMG +AmU||svtype +AmU||UNDERBAR +Am|UV|SvUV_nomg|SV* sv +Am|UV|SvUV|SV* sv +Am|UV|SvUVx|SV* sv +Am|UV|SvUVX|SV* sv +AmU||XCPT_CATCH +AmU||XCPT_TRY_END +AmU||XCPT_TRY_START +AmU||XS +AmU||XS_VERSION +Am|void *|CopyD|void* src|void* dest|int nitems|type +Am|void|Copy|void* src|void* dest|int nitems|type +Am|void|EXTEND|SP|int nitems +Am|void*|HeKEY|HE* he +Am|void *|MoveD|void* src|void* dest|int nitems|type +Am|void|Move|void* src|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|Newxc|void* ptr|int nitems|type|cast +Am|void|Newx|void* ptr|int nitems|type +Am|void|Newxz|void* ptr|int nitems|type +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|PoisonFree|void* dest|int nitems|type +Am|void|PoisonNew|void* dest|int nitems|type +Am|void|Poison|void* dest|int nitems|type +Am|void|PoisonWith|void* dest|int nitems|type|U8 byte +Am|void|PUSHi|IV iv +Am|void|PUSHMARK|SP +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|Renewc|void* ptr|int nitems|type|cast +Am|void|Renew|void* ptr|int nitems|type +Am|void|Safefree|void* ptr +Am|void|StructCopy|type src|type dest|type +Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len +Am|void|sv_catpvs|SV* sv|const char* s +Am|void|sv_catsv_nomg|SV* dsv|SV* ssv +Am|void|SvCUR_set|SV* sv|STRLEN len +Am|void|SvGETMAGIC|SV* sv +Am|void|SvIOK_off|SV* sv +Am|void|SvIOK_only|SV* sv +Am|void|SvIOK_only_UV|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|SV* sv +Am|void|SvPOK_only_UTF8|SV* sv +Am|void|SvPOK_on|SV* sv +Am|void|SvPV_set|SV* sv|char* val +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|SvSetMagicSV_nosteal|SV* dsv|SV* ssv +Am|void|SvSETMAGIC|SV* sv +Am|void|SvSetMagicSV|SV* dsb|SV* ssv +Am|void|sv_setpvs|SV* sv|const char* s +Am|void|sv_setsv_nomg|SV* dsv|SV* ssv +Am|void|SvSetSV_nosteal|SV* dsv|SV* ssv +Am|void|SvSetSV|SV* dsb|SV* ssv +Am|void|SvSHARE|SV* sv +Am|void|SvSTASH_set|SV* sv|HV* val +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|int nitems +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|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 *|ZeroD|void* dest|int nitems|type +Am|void|Zero|void* dest|int nitems|type +m|AV *|CvPADLIST|CV *cv +m|bool|CvWEAKOUTSIDE|CV *cv +m|char *|PAD_COMPNAME_PV|PADOFFSET po +m|HV *|PAD_COMPNAME_OURSTASH|PADOFFSET po +m|HV *|PAD_COMPNAME_TYPE|PADOFFSET po +mn|bool|PL_dowarn +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 +ms||djSP +m|STRLEN|PAD_COMPNAME_GEN|PADOFFSET po +m|STRLEN|PAD_COMPNAME_GEN_set|PADOFFSET po|int gen +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_SVl |PADOFFSET po +m|U32|PAD_COMPNAME_FLAGS|PADOFFSET po +mU||LVRET +m|void|CX_CURPAD_SAVE|struct context +m|void|PAD_CLONE_VARS|PerlInterpreter *proto_perl|CLONE_PARAMS* param +m|void|PAD_DUP|PADLIST dstpad|PADLIST srcpad|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_NOSAVE |PADLIST padlist|I32 n +m|void|PAD_SET_CUR |PADLIST padlist|I32 n +m|void|PAD_SV |PADOFFSET po +m|void|SAVECLEARSV |SV **svp +m|void|SAVECOMPPAD +m|void|SAVEPADSV |PADOFFSET po diff --git a/cpan/Devel-PPPort/parts/base/5004000 b/cpan/Devel-PPPort/parts/base/5004000 new file mode 100644 index 0000000000..5350285413 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5004000 @@ -0,0 +1,89 @@ +5.004000 +GIMME_V # E +G_VOID # E +HEf_SVKEY # E +HeHASH # U +HeKEY # U +HeKLEN # U +HePV # U +HeSVKEY # U +HeSVKEY_force # U +HeSVKEY_set # U +HeVAL # U +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_gimme # E +call_list # E +cv_const_sv # E +delimcpy # E +do_open # E (Perl_do_open) +gv_autoload4 # E +gv_efullname3 # U +gv_fetchmethod_autoload # E +gv_fullname3 # U +gv_stashpvn # E +hv_delayfree_ent # E +hv_delete_ent # U +hv_exists_ent # U +hv_fetch_ent # U +hv_free_ent # E +hv_iterkeysv # E +hv_ksplit # E +hv_store_ent # U +ibcmp_locale # E +my_failure_exit # E +my_memcmp # U +my_pclose # E (Perl_my_pclose) +my_popen # E (Perl_my_popen) +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_gets # E (Perl_sv_gets) +sv_setuv # E +sv_taint # U +sv_tainted # E +sv_untaint # E +sv_vcatpvfn # E +sv_vsetpvfn # E +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 +SvUVXx # added by devel/scanprov +boolSV # added by devel/scanprov +isPRINT # added by devel/scanprov +memEQ # added by devel/scanprov +memNE # added by devel/scanprov diff --git a/cpan/Devel-PPPort/parts/base/5004010 b/cpan/Devel-PPPort/parts/base/5004010 new file mode 100644 index 0000000000..8c29866603 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5004010 @@ -0,0 +1 @@ +5.004010 diff --git a/cpan/Devel-PPPort/parts/base/5004020 b/cpan/Devel-PPPort/parts/base/5004020 new file mode 100644 index 0000000000..4b43fdf8e4 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5004020 @@ -0,0 +1 @@ +5.004020 diff --git a/cpan/Devel-PPPort/parts/base/5004030 b/cpan/Devel-PPPort/parts/base/5004030 new file mode 100644 index 0000000000..e45facbb1f --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5004030 @@ -0,0 +1 @@ +5.004030 diff --git a/cpan/Devel-PPPort/parts/base/5004040 b/cpan/Devel-PPPort/parts/base/5004040 new file mode 100644 index 0000000000..69ccd5d62c --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5004040 @@ -0,0 +1 @@ +5.004040 diff --git a/cpan/Devel-PPPort/parts/base/5004050 b/cpan/Devel-PPPort/parts/base/5004050 new file mode 100644 index 0000000000..f0e0456422 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5004050 @@ -0,0 +1,43 @@ +5.004050 +PL_na # E +PL_sv_no # E +PL_sv_undef # E +PL_sv_yes # E +SvGETMAGIC # U +do_binmode # E +newCONSTSUB # E +newSVpvn # E +save_aelem # E +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_rsfp # added by devel/scanprov +PL_rsfp_filters # 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/cpan/Devel-PPPort/parts/base/5005000 b/cpan/Devel-PPPort/parts/base/5005000 new file mode 100644 index 0000000000..1f2bf06332 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5005000 @@ -0,0 +1,37 @@ +5.005000 +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) +screaminstr # E (Perl_screaminstr) +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/cpan/Devel-PPPort/parts/base/5005010 b/cpan/Devel-PPPort/parts/base/5005010 new file mode 100644 index 0000000000..deebff5bf8 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5005010 @@ -0,0 +1 @@ +5.005010 diff --git a/cpan/Devel-PPPort/parts/base/5005020 b/cpan/Devel-PPPort/parts/base/5005020 new file mode 100644 index 0000000000..d19ff2ae09 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5005020 @@ -0,0 +1 @@ +5.005020 diff --git a/cpan/Devel-PPPort/parts/base/5005030 b/cpan/Devel-PPPort/parts/base/5005030 new file mode 100644 index 0000000000..f268c751da --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5005030 @@ -0,0 +1,4 @@ +5.005030 +POPpx # E +get_vtbl # E +save_generic_svref # E diff --git a/cpan/Devel-PPPort/parts/base/5005040 b/cpan/Devel-PPPort/parts/base/5005040 new file mode 100644 index 0000000000..8a165c2033 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5005040 @@ -0,0 +1 @@ +5.005040 diff --git a/cpan/Devel-PPPort/parts/base/5006000 b/cpan/Devel-PPPort/parts/base/5006000 new file mode 100644 index 0000000000..924da63a68 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5006000 @@ -0,0 +1,295 @@ +5.006000 +PERL_SYS_INIT3 # U +POPn # 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 +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) +is_uni_alnum # E +is_uni_alnum_lc # E +is_uni_alnumc # E +is_uni_alnumc_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_alnumc # E +is_utf8_alpha # E +is_utf8_ascii # E +is_utf8_char # E +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 # E +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_2nv # E (Perl_sv_2nv) +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 +tmps_grow # E +to_uni_lower_lc # E +to_uni_title_lc # E +to_uni_upper_lc # E +utf8_distance # E +utf8_hop # E +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 +isASCII # added by devel/scanprov +isCNTRL # added by devel/scanprov +isGRAPH # added by devel/scanprov +isPUNCT # added by devel/scanprov +isXDIGIT # added by devel/scanprov +pTHX # added by devel/scanprov +pTHX_ # added by devel/scanprov diff --git a/cpan/Devel-PPPort/parts/base/5006001 b/cpan/Devel-PPPort/parts/base/5006001 new file mode 100644 index 0000000000..ed53af5cc3 --- /dev/null +++ b/cpan/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 +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 +isBLANK # added by devel/scanprov +isPSXSPC # added by devel/scanprov diff --git a/cpan/Devel-PPPort/parts/base/5006002 b/cpan/Devel-PPPort/parts/base/5006002 new file mode 100644 index 0000000000..dfe09ce2c5 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5006002 @@ -0,0 +1 @@ +5.006002 diff --git a/cpan/Devel-PPPort/parts/base/5007000 b/cpan/Devel-PPPort/parts/base/5007000 new file mode 100644 index 0000000000..49d08465db --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5007000 @@ -0,0 +1 @@ +5.007000 diff --git a/cpan/Devel-PPPort/parts/base/5007001 b/cpan/Devel-PPPort/parts/base/5007001 new file mode 100644 index 0000000000..19ae691d12 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5007001 @@ -0,0 +1,24 @@ +5.007001 +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_uvuni # 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/cpan/Devel-PPPort/parts/base/5007002 b/cpan/Devel-PPPort/parts/base/5007002 new file mode 100644 index 0000000000..148eef9252 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5007002 @@ -0,0 +1,74 @@ +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 # added by devel/scanprov +PERL_MAGIC_overload_elem # 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/cpan/Devel-PPPort/parts/base/5007003 b/cpan/Devel-PPPort/parts/base/5007003 new file mode 100644 index 0000000000..325f06ad93 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5007003 @@ -0,0 +1,85 @@ +5.007003 +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_copypv # 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 +to_utf8_fold # U +to_utf8_lower # E (Perl_to_utf8_lower) +to_utf8_title # E (Perl_to_utf8_title) +to_utf8_upper # E (Perl_to_utf8_upper) +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/cpan/Devel-PPPort/parts/base/5008000 b/cpan/Devel-PPPort/parts/base/5008000 new file mode 100644 index 0000000000..8af2dfae4d --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/parts/base/5008001 b/cpan/Devel-PPPort/parts/base/5008001 new file mode 100644 index 0000000000..a389fd85da --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5008001 @@ -0,0 +1,26 @@ +5.008001 +SvVOK # U +XSRETURN_UV # U +doing_taint # U +find_runcv # U +is_utf8_string_loc # U +packlist # U +save_bool # U +savestack_grow_cnt # U +seed # U +sv_cat_decode # U +sv_compile_2op # E (Perl_sv_compile_2op) +sv_setpviv # U +sv_setpviv_mg # U +unpackstring # U +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/cpan/Devel-PPPort/parts/base/5008002 b/cpan/Devel-PPPort/parts/base/5008002 new file mode 100644 index 0000000000..63aac525fe --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5008002 @@ -0,0 +1 @@ +5.008002 diff --git a/cpan/Devel-PPPort/parts/base/5008003 b/cpan/Devel-PPPort/parts/base/5008003 new file mode 100644 index 0000000000..50c6ce1aa1 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5008003 @@ -0,0 +1,3 @@ +5.008003 +SvIsCOW # U +SvIsCOW_shared_hash # U diff --git a/cpan/Devel-PPPort/parts/base/5008004 b/cpan/Devel-PPPort/parts/base/5008004 new file mode 100644 index 0000000000..bb7bcdf66a --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5008004 @@ -0,0 +1 @@ +5.008004 diff --git a/cpan/Devel-PPPort/parts/base/5008005 b/cpan/Devel-PPPort/parts/base/5008005 new file mode 100644 index 0000000000..7bd2029f4b --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5008005 @@ -0,0 +1 @@ +5.008005 diff --git a/cpan/Devel-PPPort/parts/base/5008006 b/cpan/Devel-PPPort/parts/base/5008006 new file mode 100644 index 0000000000..ba5cad07ed --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5008006 @@ -0,0 +1 @@ +5.008006 diff --git a/cpan/Devel-PPPort/parts/base/5008007 b/cpan/Devel-PPPort/parts/base/5008007 new file mode 100644 index 0000000000..7d656f0b9e --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5008007 @@ -0,0 +1 @@ +5.008007 diff --git a/cpan/Devel-PPPort/parts/base/5008008 b/cpan/Devel-PPPort/parts/base/5008008 new file mode 100644 index 0000000000..f17b19ff4b --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5008008 @@ -0,0 +1 @@ +5.008008 diff --git a/cpan/Devel-PPPort/parts/base/5009000 b/cpan/Devel-PPPort/parts/base/5009000 new file mode 100644 index 0000000000..28bc85958e --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/parts/base/5009001 b/cpan/Devel-PPPort/parts/base/5009001 new file mode 100644 index 0000000000..0666184e1d --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/parts/base/5009002 b/cpan/Devel-PPPort/parts/base/5009002 new file mode 100644 index 0000000000..65d7de9072 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/parts/base/5009003 b/cpan/Devel-PPPort/parts/base/5009003 new file mode 100644 index 0000000000..23060550f0 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5009003 @@ -0,0 +1,67 @@ +5.009003 +Newx # E +Newxc # E +Newxz # 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_p # 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 +newWHILEOP # E (Perl_newWHILEOP) +savepvs # U +sortsv_flags # U +sv_catpvs # U +vverify # U +GvSVn # added by devel/scanprov +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/cpan/Devel-PPPort/parts/base/5009004 b/cpan/Devel-PPPort/parts/base/5009004 new file mode 100644 index 0000000000..2f88d2a2ff --- /dev/null +++ b/cpan/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_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 +isGV_with_GP # added by devel/scanprov diff --git a/cpan/Devel-PPPort/parts/base/5009005 b/cpan/Devel-PPPort/parts/base/5009005 new file mode 100644 index 0000000000..68ceff2b01 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5009005 @@ -0,0 +1,35 @@ +5.009005 +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 +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 +re_intuit_start # E (Perl_re_intuit_start) +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 +PL_parser # added by devel/scanprov +SV_COW_SHARED_HASH_KEYS # added by devel/scanprov +SVfARG # added by devel/scanprov diff --git a/cpan/Devel-PPPort/parts/base/5010000 b/cpan/Devel-PPPort/parts/base/5010000 new file mode 100644 index 0000000000..922e614159 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/parts/base/5011000 b/cpan/Devel-PPPort/parts/base/5011000 new file mode 100644 index 0000000000..fe92c15d26 --- /dev/null +++ b/cpan/Devel-PPPort/parts/base/5011000 @@ -0,0 +1,52 @@ +5.011000 +HeUTF8 # U +MULTICALL # E +PERL_SYS_TERM # E +POP_MULTICALL # E +PUSH_MULTICALL # E +SvOOK_offset # U +av_iter_p # U +croak_xs_usage # U +fetch_cop_label # U +gv_fetchmethod_flags # U +hv_assert # 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 +pad_sv # U +pregfree2 # U +ref # U (Perl_ref) +save_adelete # U +save_helem_flags # U +save_padsv_and_mortalize # U +save_pushptr # U +stashpv_hvname_match # U +sv_insert_flags # U +sv_magic_portable # U +sv_utf8_upgrade_flags_grow # U +DEFSV_set # added by devel/scanprov +PERL_BCDVERSION # added by devel/scanprov +PERL_MAGIC_glob # added by devel/scanprov +PERL_MAGIC_mutex # 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_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/cpan/Devel-PPPort/parts/embed.fnc b/cpan/Devel-PPPort/parts/embed.fnc new file mode 100644 index 0000000000..68f38171c7 --- /dev/null +++ b/cpan/Devel-PPPort/parts/embed.fnc @@ -0,0 +1,2212 @@ +: BEGIN {die "You meant to run embed.pl"} # Stop early if fed to perl. +: +: 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 member of public API +: m Implemented as a macro - no export, no +: proto, no #define +: d function has documentation with its source +: s static function, should have an S_ prefix in +: source file; for macros (m), suffix the usage +: example with a semicolon +: n has no implicit interpreter/thread context argument +: p function has a Perl_ prefix +: f function takes printf style format string, varargs +: r function never returns +: o has no compatibility macro (#define foo Perl_foo) +: x not exported +: X explicitly exported +: M may change +: E visible to extensions included in the Perl core +: b binary backward compatibility; function is a macro +: but has also Perl_ implementation (which is exported) +: U suppress usage example in autogenerated documentation +: a allocates memory a la malloc/calloc. Is also "R". +: R Return value must not be ignored. +: P pure function: no effects except the return value; +: return value depends only on parms and/or globals +: (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. + +START_EXTERN_C + +#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 + +AnpR |void* |get_context +Anp |void |set_context |NN void *t + +END_EXTERN_C + +/* functions with flag 'n' should come before here */ +START_EXTERN_C +# include "pp_proto.h" +Ap |SV* |amagic_call |NN SV* left|NN SV* right|int method|int dir +Ap |bool |Gv_AMupdate |NN HV* stash +ApR |CV* |gv_handler |NULLOK HV* stash|I32 id +: Used in perly.y +p |OP* |append_elem |I32 optype|NULLOK OP* first|NULLOK OP* last +: Used in perly.y +p |OP* |append_list |I32 optype|NULLOK LISTOP* first|NULLOK LISTOP* 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|I32 key|I32 flags +ApdR |bool |av_exists |NN AV *av|I32 key +Apd |void |av_extend |NN AV *av|I32 key +ApdR |SV** |av_fetch |NN AV *av|I32 key|I32 lval +Apd |void |av_fill |NN AV *av|I32 fill +ApdR |I32 |av_len |NN AV *av +ApdR |AV* |av_make |I32 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|I32 key|NULLOK SV *val +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|I32 num +Apo |SV** |av_arylen_p |NN AV *av +Apo |IV* |av_iter_p |NN AV *av +#if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) +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 +pR |OP* |block_end |I32 floor|NULLOK OP* seq +ApR |I32 |block_gimme +: Used in perly.y +pR |int |block_start |int full +: 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 +: Used in serveral source files +pR |bool |cando |Mode_t mode|bool effective|NN const Stat_t* statbufp +ApR |U32 |cast_ulong |NV f +ApR |I32 |cast_i32 |NV f +ApR |IV |cast_iv |NV f +ApR |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 +: Used in perly.y +pR |OP* |convert |I32 optype|I32 flags|NULLOK OP* o +: Used in op.c and perl.c +pM |PERL_CONTEXT* |create_eval_scope|U32 flags +: croak()'s first parm can be NULL. Otherwise, mod_perl breaks. +Afprd |void |croak |NULLOK const char* pat|... +Apr |void |vcroak |NULLOK const char* pat|NULLOK va_list* args +Aprd |void |croak_xs_usage |NN const CV *const cv \ + |NN const char *const params + +#if defined(PERL_IMPLICIT_CONTEXT) +Afnrp |void |croak_nocontext|NULLOK const char* pat|... +Afnp |OP* |die_nocontext |NN 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 sv.c +p |void |cv_ckproto_len |NN const CV* cv|NULLOK const GV* gv\ + |NULLOK const char* p|const STRLEN len +: Used in pp.c and pp_sys.c +pd |CV* |cv_clone |NN CV* proto +ApdR |SV* |gv_const_sv |NN GV* gv +ApdR |SV* |cv_const_sv |NULLOK const CV *const cv +: Used in pad.c +pR |SV* |op_const_sv |NULLOK const OP* o|NULLOK CV* cv +Apd |void |cv_undef |NN 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 +EXpR |I32 |cxinc +Afp |void |deb |NN const char* pat|... +Ap |void |vdeb |NN const char* pat|NULLOK va_list* args +Ap |void |debprofdump +Ap |I32 |debop |NN const OP* o +Ap |I32 |debstack +Ap |I32 |debstackptrs +Ap |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 +: Used in various files +p |void |deprecate |NN const char *const s +: Used in various files +p |void |deprecate_old |NN const char *const s +Afp |OP* |die |NULLOK const char* pat|... +#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +s |OP* |vdie |NULLOK const char* pat|NULLOK va_list* args +#endif +: Used in util.c +p |OP* |die_where |NULLOK const char* message|STRLEN msglen +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 +p |void |do_chop |NN SV *astr|NN SV *sv +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 +pmb |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) || defined(PERL_DECL_PROT) +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 +p |OP* |do_kv +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 +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 +: 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 +: Used in pp.c +p |I32 |do_chomp |NN SV* sv +: 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|I32 offset|I32 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 |I32 |dowantarray +Ap |void |dump_all +Ap |void |dump_eval +#if defined(DUMP_FDS) +Ap |void |dump_fds |NN char* s +#endif +Ap |void |dump_form |NN const GV* gv +Ap |void |gv_dump |NN 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 +Ap |void |dump_sub |NN const GV* gv +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 +: 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) || defined(PERL_DECL_PROT) +s |OP* |force_list |NULLOK OP* arg +: 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) || defined(PERL_DECL_PROT) +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_AVadd |NN GV* gv +Ap |GV* |gv_HVadd |NN GV* gv +Ap |GV* |gv_IOadd |NN GV* gv +ApR |GV* |gv_autoload4 |NULLOK HV* stash|NN const char* name|STRLEN len|I32 method +Ap |void |gv_check |NN const 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 +Apd |GV* |gv_fetchmeth |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level +Apd |GV* |gv_fetchmeth_autoload |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level +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 +ApdM |GV* |gv_fetchmethod_flags|NN HV* stash|NN const char* name \ + |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 +Ap |void |gv_init |NN GV* gv|NULLOK HV* stash|NN const char* name|STRLEN len|int multi +Ap |void |gv_name_set |NN GV* gv|NN const char *name|U32 len|U32 flags +Apd |HV* |gv_stashpv |NN const char* name|I32 flags +Apd |HV* |gv_stashpvn |NN const char* name|U32 namelen|I32 flags +Apd |HV* |gv_stashsv |NN SV* sv|I32 flags +Apd |void |hv_clear |NULLOK HV *hv +: used in SAVEHINTS() and op.c +poM |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 +Ap |void |hv_free_ent |NN HV *hv|NULLOK HE *entryK +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 +: Used in B.xs +XEdpoM |HV * |refcounted_he_chain_2hv|NULLOK const struct refcounted_he *c +: Used in APItest.xs +XEpoM |SV * |refcounted_he_fetch|NULLOK const struct refcounted_he *chain \ + |NULLOK SV *keysv|NULLOK const char *key \ + |STRLEN klen, int flags, U32 hash +: Used in various files +dpoM |void |refcounted_he_free|NULLOK struct refcounted_he *he +: Used in various files +XEdpoM |struct refcounted_he *|refcounted_he_new \ + |NULLOK struct refcounted_he *const parent \ + |NULLOK SV *const key|NULLOK SV *const value +#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) +s |struct refcounted_he * |refcounted_he_new_common \ + |NULLOK struct refcounted_he *const parent \ + |NN const char *const key_p \ + |const STRLEN key_len|const char flags \ + |char value_type|NN const void *value \ + |const STRLEN value_len +#endif +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 +AbmdM |SV** |hv_store_flags |NULLOK HV *hv|NULLOK const char *key \ + |I32 klen|NULLOK SV *val|U32 hash|int flags +Apd |void |hv_undef |NULLOK HV *hv +ApP |I32 |ibcmp |NN const char* a|NN const char* b|I32 len +ApP |I32 |ibcmp_locale |NN const char* a|NN const char* b|I32 len +Apd |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 +#if defined(PERL_IN_DOIO_C) || defined(PERL_DECL_PROT) +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 mg.c +p |void |init_debugger +Ap |void |init_stacks +Ap |void |init_tm |NN struct tm *ptm +: Used in perly.y +pd |U32 |intro_my +ApPR |char* |instr |NN const char* big|NN const char* little +: Used in sv.c +p |bool |io_close |NN IO* io|bool not_implicit +: Used in perly.y +pR |OP* |invert |NULLOK OP* cmd +ApR |I32 |is_lvalue_sub +ApPR |U32 |to_uni_upper_lc|U32 c +ApPR |U32 |to_uni_title_lc|U32 c +ApPR |U32 |to_uni_lower_lc|U32 c +ApPR |bool |is_uni_alnum |UV c +ApPR |bool |is_uni_alnumc |UV c +ApPR |bool |is_uni_idfirst |UV c +ApPR |bool |is_uni_alpha |UV c +ApPR |bool |is_uni_ascii |UV c +ApPR |bool |is_uni_space |UV c +ApPR |bool |is_uni_cntrl |UV c +ApPR |bool |is_uni_graph |UV c +ApPR |bool |is_uni_digit |UV c +ApPR |bool |is_uni_upper |UV c +ApPR |bool |is_uni_lower |UV c +ApPR |bool |is_uni_print |UV c +ApPR |bool |is_uni_punct |UV c +ApPR |bool |is_uni_xdigit |UV c +Ap |UV |to_uni_upper |UV c|NN U8 *p|NN STRLEN *lenp +Ap |UV |to_uni_title |UV c|NN U8 *p|NN STRLEN *lenp +Ap |UV |to_uni_lower |UV c|NN U8 *p|NN STRLEN *lenp +Ap |UV |to_uni_fold |UV c|NN U8 *p|NN STRLEN *lenp +ApPR |bool |is_uni_alnum_lc|UV c +ApPR |bool |is_uni_alnumc_lc|UV c +ApPR |bool |is_uni_idfirst_lc|UV c +ApPR |bool |is_uni_alpha_lc|UV c +ApPR |bool |is_uni_ascii_lc|UV c +ApPR |bool |is_uni_space_lc|UV c +ApPR |bool |is_uni_cntrl_lc|UV c +ApPR |bool |is_uni_graph_lc|UV c +ApPR |bool |is_uni_digit_lc|UV c +ApPR |bool |is_uni_upper_lc|UV c +ApPR |bool |is_uni_lower_lc|UV c +ApPR |bool |is_uni_print_lc|UV c +ApPR |bool |is_uni_punct_lc|UV c +ApPR |bool |is_uni_xdigit_lc|UV c +Apd |STRLEN |is_utf8_char |NN const U8 *s +Apd |bool |is_utf8_string |NN const U8 *s|STRLEN len +Apdmb |bool |is_utf8_string_loc|NN const U8 *s|STRLEN len|NULLOK const U8 **p +Apd |bool |is_utf8_string_loclen|NN const U8 *s|STRLEN len|NULLOK const U8 **ep|NULLOK STRLEN *el +ApR |bool |is_utf8_alnum |NN const U8 *p +ApR |bool |is_utf8_alnumc |NN const U8 *p +ApR |bool |is_utf8_idfirst|NN const U8 *p +ApR |bool |is_utf8_idcont |NN const U8 *p +ApR |bool |is_utf8_alpha |NN const U8 *p +ApR |bool |is_utf8_ascii |NN const U8 *p +ApR |bool |is_utf8_space |NN const U8 *p +ApR |bool |is_utf8_cntrl |NN const U8 *p +ApR |bool |is_utf8_digit |NN const U8 *p +ApR |bool |is_utf8_graph |NN const U8 *p +ApR |bool |is_utf8_upper |NN const U8 *p +ApR |bool |is_utf8_lower |NN const U8 *p +ApR |bool |is_utf8_print |NN const U8 *p +ApR |bool |is_utf8_punct |NN const U8 *p +ApR |bool |is_utf8_xdigit |NN const U8 *p +ApR |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 +Ap |void |leave_scope |I32 base +: Used in pp_ctl.c, and by Data::Alias +EXp |void |lex_end +: Used in various files +p |void |lex_start |NULLOK SV* line|NULLOK PerlIO *rsfp|bool new_filter +Ap |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 +#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) +s |OP* |linklist |NN OP *o +s |OP* |listkids |NULLOK OP* o +#endif +: Used in S_doeval in pp_ctl.c +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 +Apd |UV |grok_hex |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result +Apd |int |grok_number |NN const char *pv|STRLEN len|NULLOK UV *valuep +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 +: 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 +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_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_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 |U32 |magic_len |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 +pr |int |magic_regdatum_set|NN SV* sv|NN MAGIC* mg +p |int |magic_set |NN SV* sv|NN MAGIC* mg +p |int |magic_setamagic|NN SV* sv|NN MAGIC* mg +p |int |magic_setarylen|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_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_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 +Ap |void |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 +Afp |SV* |mess |NN const char* pat|... +Ap |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 +ApdR |MAGIC* |mg_find |NULLOK const SV* sv|int type +Apd |int |mg_free |NN SV* sv +Apd |int |mg_get |NN SV* sv +Apd |U32 |mg_length |NN SV* sv +Apd |void |mg_magical |NN SV* sv +Apd |int |mg_set |NN SV* sv +Ap |I32 |mg_size |NN SV* sv +Ap |void |mini_mktime |NN struct tm *ptm +: Used by MOD(), which Data::Alias uses +EXp |OP* |mod |NULLOK OP* o|I32 type +: 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_BCOPY)) || (!defined(HAS_MEMMOVE) && !defined(HAS_SAFE_MEMCPY) && !defined(HAS_SAFE_BCOPY)) +Anp |char* |my_bcopy |NN const char* from|NN char* to|I32 len +#endif +#if !defined(HAS_BZERO) && !defined(HAS_MEMSET) +Anp |char* |my_bzero |NN char* loc|I32 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 +Ap |I32 |my_lstat +#if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) +AnpP |I32 |my_memcmp |NN const char* s1|NN const char* s2|I32 len +#endif +#if !defined(HAS_MEMSET) +Anp |void* |my_memset |NN char* loc|I32 ch|I32 len +#endif +Ap |I32 |my_pclose |NULLOK PerlIO* ptr +Ap |PerlIO*|my_popen |NN const char* cmd|NN const char* mode +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 +Ap |I32 |my_stat +Ap |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 +#if defined(MYSWAP) +ApPa |short |my_swap |short s +ApPa |long |my_htonl |long l +ApPa |long |my_ntohl |long l +#endif +: Used in pp_ctl.c +p |void |my_unexec +Apa |OP* |newANONLIST |NULLOK OP* o +Apa |OP* |newANONHASH |NULLOK OP* o +Ap |OP* |newANONSUB |I32 floor|NULLOK OP* proto|NULLOK OP* block +Apa |OP* |newASSIGNOP |I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right +Apa |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 +#ifdef PERL_MAD +Ap |OP* |newFORM |I32 floor|NULLOK OP* o|NULLOK OP* block +#else +Ap |void |newFORM |I32 floor|NULLOK OP* o|NULLOK OP* block +#endif +Apa |OP* |newFOROP |I32 flags|NULLOK char* label|line_t forline \ + |NULLOK OP* sv|NN OP* expr|NULLOK OP* block|NULLOK OP* cont +Apa |OP* |newGIVENOP |NN OP* cond|NN OP* block|PADOFFSET defsv_off +Apa |OP* |newLOGOP |I32 optype|I32 flags|NN OP *first|NN OP *other +Apa |OP* |newLOOPEX |I32 type|NN OP* label +Apa |OP* |newLOOPOP |I32 flags|I32 debuggable|NULLOK OP* expr|NULLOK OP* block +Apa |OP* |newNULLLIST +Apa |OP* |newOP |I32 optype|I32 flags +Ap |void |newPROG |NN OP* o +Apa |OP* |newRANGE |I32 flags|NN OP* left|NN OP* right +Apa |OP* |newSLICEOP |I32 flags|NULLOK OP* subscript|NULLOK OP* listop +Apa |OP* |newSTATEOP |I32 flags|NULLOK char* label|NULLOK OP* o +Ap |CV* |newSUB |I32 floor|NULLOK OP* o|NULLOK OP* proto|NULLOK OP* block +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 +Apa |OP* |newBINOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last +Apa |OP* |newCVREF |I32 flags|NULLOK OP* o +Apa |OP* |newGVOP |I32 type|I32 flags|NN GV* gv +Apa |GV* |newGVgen |NN const char* pack +Apa |OP* |newGVREF |I32 type|NULLOK OP* o +ApaR |OP* |newHVREF |NN OP* o +AmdbR |HV* |newHV +ApaR |HV* |newHVhv |NULLOK HV *hv +Apa |IO* |newIO +Apa |OP* |newLISTOP |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last +#ifdef USE_ITHREADS +Apa |OP* |newPADOP |I32 type|I32 flags|NN SV* sv +#endif +Apa |OP* |newPMOP |I32 type|I32 flags +Apa |OP* |newPVOP |I32 type|I32 flags|NULLOK char* pv +Apa |SV* |newRV |NN SV *const sv +Apda |SV* |newRV_noinc |NN SV *const sv +Apda |SV* |newSV |const STRLEN len +Apa |OP* |newSVREF |NN OP* o +Apa |OP* |newSVOP |I32 type|I32 flags|NN SV* sv +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 +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 +Apa |OP* |newUNOP |I32 type|I32 flags|NULLOK OP* first +Apa |OP* |newWHENOP |NULLOK OP* cond|NN OP* block +Apa |OP* |newWHILEOP |I32 flags|I32 debuggable|NULLOK LOOP* loop \ + |I32 whileline|NULLOK OP* expr|NULLOK OP* block|NULLOK OP* cont \ + |I32 has_my +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 |SV* |new_version |NN SV *ver +Apd |SV* |upg_version |NN SV *ver|bool qv +Apd |bool |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 +ApP |char* |ninstr |NN const char* big|NN const char* bigend \ + |NN const char* little|NN const char* lend +Ap |void |op_free |NULLOK OP* arg +: Used in perly.y +#ifdef PERL_MAD +p |OP* |package |NN OP* o +#else +p |void |package |NN OP* o +#endif +: Used in op.c +pd |PADOFFSET|pad_alloc |I32 optype|U32 tmptype +: Used in toke.c and perly.y +p |PADOFFSET|allocmy |NN const char *const name +: Used in op.c and toke.c +pdR |PADOFFSET|pad_findmy |NN const char* name +Ap |PADOFFSET|find_rundefsvoffset | +: Used in perly.y +pR |OP* |oopsAV |NN OP* o +: Used in perly.y +pR |OP* |oopsHV |NN OP* o +: Defined in pad.c, used only in op.c +pd |void |pad_leavemy +Apd |SV* |pad_sv |PADOFFSET po +: Defined in pad.c, used only in op.c +pd |void |pad_free |PADOFFSET po +#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) +sd |void |pad_reset +#endif +: Used in op.c +pd |void |pad_swipe |PADOFFSET po|bool refadjust +: FIXME +p |void |peep |NULLOK OP* o +: Defined in doio.c, used only in pp_hot.c +dopM |PerlIO*|start_glob |NN SV *tmpglob|NN IO *io +#if defined(USE_REENTRANT_API) +Ap |void |reentrant_size +Ap |void |reentrant_init +Ap |void |reentrant_free +Anp |void* |reentrant_retry|NN const char *f|... +#endif +Ap |void |call_atexit |ATEXIT_t fn|NULLOK void *ptr +Apd |I32 |call_argv |NN const char* sub_name|I32 flags|NN char** argv +Apd |I32 |call_method |NN const char* methname|I32 flags +Apd |I32 |call_pv |NN const char* sub_name|I32 flags +Apd |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 +Apd |SV* |eval_pv |NN const char* p|I32 croak_on_error +Apd |I32 |eval_sv |NN SV* sv|I32 flags +Apd |SV* |get_sv |NN const char *name|I32 flags +Apd |AV* |get_av |NN const char *name|I32 flags +Apd |HV* |get_hv |NN const char *name|I32 flags +Apd |CV* |get_cv |NN const char* name|I32 flags +Apd |CV* |get_cvn_flags |NN const char* name|STRLEN len|I32 flags +Ap |int |init_i18nl10n |int printwarn +Ap |int |init_i18nl14n |int printwarn +Ap |void |new_collate |NULLOK const char* newcoll +Ap |void |new_ctype |NN const char* newctype +Ap |void |new_numeric |NULLOK const char* newcoll +Ap |void |set_numeric_local +Ap |void |set_numeric_radix +Ap |void |set_numeric_standard +Apd |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 +Ap |void |pmflag |NN U32* pmfl|int ch +: Used in perly.y +p |OP* |pmruntime |NN OP *o|NN OP *expr|bool isreg +#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) +s |OP* |pmtrans |NN OP* o|NN OP* expr|NN OP* repl +#endif +Ap |void |pop_scope +: Used in perly.y +p |OP* |prepend_elem |I32 optype|NULLOK OP* head|NULLOK OP* tail +Ap |void |push_scope +Amb |OP* |ref |NULLOK OP* o|I32 type +#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) +s |OP* |refkids |NULLOK OP* o|I32 type +#endif +Ap |void |regdump |NN const regexp* r +Ap |void |regdump |NN const regexp* r +Ap |SV* |regclass_swash |NULLOK const regexp *prog \ + |NN const struct regnode *node|bool doinit \ + |NULLOK SV **listsvp|NULLOK SV **altsvp +Ap |I32 |pregexec |NN REGEXP * const prog|NN char* stringarg \ + |NN char* strend|NN char* strbeg|I32 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 |NN REGEXP* r +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 +Ap |REGEXP*|pregcomp |NN SV * const pattern|const U32 flags +Ap |REGEXP*|re_compile |NN SV * const pattern|U32 flags +Ap |char* |re_intuit_start|NN REGEXP * const rx|NULLOK SV* sv|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|I32 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 + +: FIXME - why the E? +Ep |void |regprop |NULLOK const regexp *prog|NN SV* sv|NN const regnode* o +Ap |void |repeatcpy |NN char* to|NN const char* from|I32 len|I32 count +ApP |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) || defined(PERL_DECL_PROT) +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 +Apda |char* |savesharedpvn |NN const char *const pv|const STRLEN len +Apda |char* |savesvpv |NN SV* sv +Ap |void |savestack_grow +Ap |void |savestack_grow_cnt |I32 need +Ap |void |save_aelem |NN AV* av|I32 idx|NN SV **sptr +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_adelete |NN AV *av|I32 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 +pmb |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 +Ap |void |save_gp |NN GV* gv|I32 empty +Ap |HV* |save_hash |NN GV* gv +p |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 +pmb |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 +Ap |SV* |save_svref |NN SV** sptr +Ap |void |save_pushptr |NULLOK void *const ptr|const int type +: Used by SAVECOPARYBASE() in op.c +p |void |save_pushi32ptr|const I32 i|NULLOK void *const ptr|const int type +: Used by SAVESWITCHSTACK() in pp.c +p |void |save_pushptrptr|NULLOK void *const ptr1 \ + |NULLOK void *const ptr2|const int type +#if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) +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 +: Used in perly.y +p |OP* |scalar |NULLOK OP* o +#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) +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 +: Used in perly.y +p |OP* |scope |NULLOK OP* o +Ap |char* |screaminstr |NN SV *bigstr|NN SV *littlestr|I32 start_shift \ + |I32 end_shift|NN I32 *old_posp|I32 last +Apd |void |setdefout |NULLOK 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|int n +Ap |I32 |start_subparse |I32 is_format|U32 flags +: Used in pp_ctl.c +p |void |sub_crush_depth|NN CV* cv +Apd |bool |sv_2bool |NN SV *const sv +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) || defined(PERL_DECL_PROT) +s |bool |glob_2number |NN GV* const gv +#endif +Amb |IV |sv_2iv |NULLOK SV *sv +Apd |IV |sv_2iv_flags |NULLOK SV *const sv|const I32 flags +Apd |SV* |sv_2mortal |NULLOK SV *const sv +Apd |NV |sv_2nv |NULLOK SV *const sv +: Used in pp.c, pp_hot.c, sv.c +pMd |SV* |sv_2num |NN SV *const sv +Amb |char* |sv_2pv |NULLOK SV *sv|NULLOK STRLEN *lp +Apd |char* |sv_2pv_flags |NULLOK SV *const sv|NULLOK STRLEN *const lp|const I32 flags +Apd |char* |sv_2pvutf8 |NN SV *const sv|NULLOK STRLEN *const lp +Apd |char* |sv_2pvbyte |NN SV *const sv|NULLOK STRLEN *const lp +Ap |char* |sv_pvn_nomg |NN SV* sv|NULLOK STRLEN* lp +Amb |UV |sv_2uv |NULLOK SV *sv +Apd |UV |sv_2uv_flags |NULLOK 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) || defined(PERL_DECL_PROT) +sd |void |sv_add_arena |NN char *const ptr|const U32 size \ + |const U32 flags +#endif +Apd |int |sv_backoff |NN SV *const sv +Apd |SV* |sv_bless |NN SV *const sv|NN HV *const stash +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 sv +Apd |I32 |sv_cmp |NULLOK SV *const sv1|NULLOK SV *const sv2 +Apd |I32 |sv_cmp_locale |NULLOK SV *const sv1|NULLOK SV *const sv2 +#if defined(USE_LOCALE_COLLATE) +Apd |char* |sv_collxfrm |NN SV *const sv|NN STRLEN *const nxp +#endif +Ap |OP* |sv_compile_2op |NN SV *sv|NN OP **startop \ + |NN const char *code|NN PAD **padp +Apd |int |getcwd_sv |NN SV* sv +Apd |void |sv_dec |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_does |NN SV* sv|NN const char *const name +Apd |I32 |sv_eq |NULLOK SV* sv1|NULLOK SV* sv2 +Apd |void |sv_free |NULLOK SV *const sv +: FIXME Used in SvREFCNT_dec() but only +: if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +poMX |void |sv_free2 |NN SV *const sv +: 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 +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 +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 +ApdaR |SV* |sv_mortalcopy |NULLOK SV *const oldsv +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 |void |sv_pos_b2u |NULLOK SV *const sv|NN I32 *const offsetp +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 |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 +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 +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 +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_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 +Ap |SV* |swash_init |NN const char* pkg|NN const char* name|NN SV* listsv|I32 minbits|I32 none +Ap |UV |swash_fetch |NN SV *swash|NN const U8 *ptr|bool do_utf8 +Ap |void |taint_env +Ap |void |taint_proper |NULLOK const char* f|NN const char *const s +Apd |UV |to_utf8_case |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp \ + |NN SV **swashp|NN const char *normal|NN const char *special +Apd |UV |to_utf8_lower |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +Apd |UV |to_utf8_upper |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +Apd |UV |to_utf8_title |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +Apd |UV |to_utf8_fold |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +#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 +#ifdef PERL_MAD +p |OP * |utilize |int aver|I32 floor|NULLOK OP* version \ + |NN OP* idop|NULLOK OP* arg +#else +p |void |utilize |int aver|I32 floor|NULLOK OP* version|NN OP* idop|NULLOK OP* arg +#endif +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 +ApdPR |U8* |utf8_hop |NN const U8 *s|I32 off +ApMd |U8* |utf8_to_bytes |NN U8 *s|NN STRLEN *len +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 +Apd |UV |utf8_to_uvchr |NN const U8 *s|NULLOK STRLEN *retlen +Apd |UV |utf8_to_uvuni |NN const U8 *s|NULLOK STRLEN *retlen + +#ifdef EBCDIC +Adp |UV |utf8n_to_uvchr |NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags +#else +Adpbm |UV |utf8n_to_uvchr |NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags +#endif + +Adp |UV |utf8n_to_uvuni |NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 flags + +#ifdef EBCDIC +Apd |U8* |uvchr_to_utf8 |NN U8 *d|UV uv +#else +Apdbm |U8* |uvchr_to_utf8 |NN U8 *d|UV uv +#endif + +Apbm |U8* |uvuni_to_utf8 |NN U8 *d|UV uv +Ap |U8* |uvchr_to_utf8_flags |NN U8 *d|UV uv|UV flags +Apd |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 +p |void |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 +: Only used in perl.c +pR |UV |get_hash_seed +: Used in doio.c, pp_hot.c, pp_sys.c +p |void |report_evil_fh |NULLOK const GV *gv|NULLOK const IO *io|I32 op +: Used in mg.c, pp.c, pp_hot.c, regcomp.c +XEpd |void |report_uninit |NULLOK const SV *uninit_sv +Afpd |void |warn |NN const char* pat|... +Ap |void |vwarn |NN const char* pat|NULLOK va_list* args +Afp |void |warner |U32 err|NN const char* pat|... +Ap |void |vwarner |U32 err|NN const char* pat|NULLOK va_list* args +: FIXME +p |void |watch |NN char** addr +Ap |I32 |whichsig |NN const char* sig +: Used in pp_ctl.c +p |void |write_to_stderr|NN const char* message|int msglen +: Used in op.c +p |int |yyerror |NN const char *const s +: Used in perly.y, and by Data::Alias +EXp |int |yylex +: Used in perl.c, pp_ctl.c +p |int |yyparse +: Only used in scope.c +p |void |parser_free |NN const yy_parser *parser +#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) +s |int |yywarn |NN const char *const s +#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 +#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 |NN 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|NN 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 +Ap |void |tmps_grow |I32 n +Apd |SV* |sv_rvweaken |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 +Ap |CV* |newATTRSUB |I32 floor|NULLOK OP *o|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block +#ifdef PERL_MAD +Apr |OP * |newMYSUB |I32 floor|NULLOK OP *o|NULLOK OP *proto \ + |NULLOK OP *attrs|NULLOK OP *block +#else +Apr |void |newMYSUB |I32 floor|NULLOK OP *o|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block +#endif +: 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 +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) || defined(PERL_DECL_PROT) +s |SV ** |sv_dup_inc_multiple|NN SV *const *source|NN SV **dest \ + |SSize_t items|NN CLONE_PARAMS *const param +#endif +ApR |SV* |sv_dup |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 +Ap |void |ptr_table_clear|NULLOK PTR_TBL_t *const tbl +Ap |void |ptr_table_free|NULLOK PTR_TBL_t *const tbl +#if defined(USE_ITHREADS) +# if defined(HAVE_INTERP_INTERN) +Ap |void |sys_intern_dup |NN struct interp_intern* src|NN struct interp_intern* dst +# endif +#endif +#if defined(HAVE_INTERP_INTERN) +Ap |void |sys_intern_clear +Ap |void |sys_intern_init +#endif + +ApR |const char * |custom_op_name |NN const OP *o +ApR |const char * |custom_op_desc |NN const OP *o + +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 + +END_EXTERN_C + +#if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) +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) || defined(PERL_DECL_PROT) +s |void |gv_init_sv |NN GV *gv|const svtype sv_type +s |HV* |gv_get_super_pkg|NN const char* name|I32 namelen +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) || defined(PERL_DECL_PROT) +: Used in hv.c +paRxo |void* |get_arena |const size_t svtype|const U32 misc +: #endif + +#if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) +s |void |hsplit |NN HV *hv +s |void |hfreeentries |NN HV *hv +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 +sn |struct xpvhv_aux*|hv_auxinit|NN HV *hv +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 +sM |SV * |refcounted_he_value |NN const struct refcounted_he *he +#endif + +#if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT) +s |void |save_magic |I32 mgs_ix|NN SV *sv +s |int |magic_methpack |NN SV *sv|NN const MAGIC *mg|NN const char *meth +s |int |magic_methcall |NN SV *sv|NN const MAGIC *mg|NN const char *meth|I32 f \ + |int n|NULLOK SV *val +s |void |restore_magic |NULLOK const void *p +s |void |unwind_handler_stack|NN const void *p + +#endif + +#if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) +: These are all indirectly referenced by globals.c. This is somewhat annoying. +pR |OP* |ck_anoncode |NN OP *o +pR |OP* |ck_bitop |NN OP *o +pR |OP* |ck_concat |NN OP *o +pR |OP* |ck_defined |NN OP *o +pR |OP* |ck_delete |NN OP *o +pR |OP* |ck_die |NN OP *o +pR |OP* |ck_eof |NN OP *o +pR |OP* |ck_eval |NN OP *o +pR |OP* |ck_exec |NN OP *o +pR |OP* |ck_exists |NN OP *o +pR |OP* |ck_exit |NN OP *o +pR |OP* |ck_ftst |NN OP *o +pR |OP* |ck_fun |NN OP *o +pR |OP* |ck_glob |NN OP *o +pR |OP* |ck_grep |NN OP *o +pR |OP* |ck_index |NN OP *o +pR |OP* |ck_join |NN OP *o +pR |OP* |ck_lfun |NN OP *o +pR |OP* |ck_listiob |NN OP *o +pR |OP* |ck_match |NN OP *o +pR |OP* |ck_method |NN OP *o +pR |OP* |ck_null |NN OP *o +pR |OP* |ck_open |NN OP *o +pR |OP* |ck_readline |NN OP *o +pR |OP* |ck_repeat |NN OP *o +pR |OP* |ck_require |NN OP *o +pR |OP* |ck_return |NN OP *o +pR |OP* |ck_rfun |NN OP *o +pR |OP* |ck_rvconst |NN OP *o +pR |OP* |ck_sassign |NN OP *o +pR |OP* |ck_select |NN OP *o +pR |OP* |ck_shift |NN OP *o +pR |OP* |ck_sort |NN OP *o +pR |OP* |ck_spair |NN OP *o +pR |OP* |ck_split |NN OP *o +pR |OP* |ck_subr |NN OP *o +pR |OP* |ck_substr |NN OP *o +pR |OP* |ck_svconst |NN OP *o +pR |OP* |ck_trunc |NN OP *o +pR |OP* |ck_unpack |NN OP *o +pR |OP* |ck_each |NN OP *o +sRn |bool |is_handle_constructor|NN const OP *o|I32 numargs +sR |I32 |is_list_assignment|NULLOK const OP *o +# ifdef USE_ITHREADS +so |void |forget_pmop |NN PMOP *const o|U32 flags +# else +so |void |forget_pmop |NN PMOP *const o +# endif +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* |newDEFSVOP +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 +s |const char* |gv_ename |NN GV *gv +sRn |bool |scalar_mod_type|NN 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|bool for_my +s |void |apply_attrs_my |NN HV *stash|NN OP *target|NULLOK OP *attrs|NN OP **imopsp +s |void |bad_type |I32 n|NN const char *t|NN const char *name|NN const OP *kid +s |void |no_bareword_allowed|NN const OP *o +sR |OP* |no_fh_allowed|NN OP *o +sR |OP* |too_few_arguments|NN OP *o|NN const char* name +sR |OP* |too_many_arguments|NN OP *o|NN const char* name +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 |void |process_special_blocks |NN const char *const fullname\ + |NN GV *const gv|NN CV *const cv +#endif +#if defined(PL_OP_SLAB_ALLOC) +Apa |void* |Slab_Alloc |size_t sz +Ap |void |Slab_Free |NN void *op +# if defined(PERL_DEBUG_READONLY_OPS) +: Used in perl.c +poxM |void |pending_Slabs_to_ro +: 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 +# if defined(PERL_IN_OP_C) +s |void |Slab_to_rw |NN void *op +# endif +# endif +#endif + +#if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) +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 |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 |int |open_script |NN const char *scriptname|bool dosearch \ + |NN bool *suidscript|NN PerlIO **rsfpp +s |void |usage |NN const char *name +#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW +so |void |validate_suid |NN PerlIO *rsfp +#endif + +s |void* |parse_body |NULLOK char **env|XSINIT_t xsinit +rs |void |run_body |I32 oldscope +s |SV * |incpush_if_exists|NN AV *const av|NN SV *dir|NN SV *const stem +#endif + +#if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) +sR |SV* |refto |NN SV* sv +#endif +#if defined(PERL_IN_PP_C) || defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) +: 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) || defined(PERL_DECL_PROT) +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 * |bytes_to_uni |NN const U8 *start|STRLEN len|NN char *dest +#endif + +#if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT) +sR |OP* |docatch |NULLOK OP *o +sR |OP* |dofindlabel |NN OP *o|NN const char *label|NN OP **opstack|NN OP **oplimit +sR |OP* |doparseform |NN SV *sv +snR |bool |num_overflow |NV value|I32 fldsize|I32 frcsize +sR |I32 |dopoptoeval |I32 startingblock +sR |I32 |dopoptogiven |I32 startingblock +sR |I32 |dopoptolabel |NN const char *label +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 |int gimme|NULLOK OP** startop|NULLOK CV* outside|U32 seq +sR |PerlIO *|check_type_and_open|NN const char *name +#ifndef PERL_DISABLE_PMC +sR |PerlIO *|doopen_pm |NN const char *name|const STRLEN namelen +#endif +sRn |bool |path_is_absolute|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 +#endif + +#if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) +s |void |do_oddball |NN HV *hash|NN SV **relem|NN SV **firstrelem +sR |SV* |method_common |NN SV* meth|NULLOK U32* hashp +#endif + +#if defined(PERL_IN_PP_SORT_C) || defined(PERL_DECL_PROT) +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 +s |I32 |amagic_cmp_locale|NN SV *const str1|NN SV *const str2 +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) || defined(PERL_DECL_PROT) +s |OP* |doform |NN CV *cv|NN GV *gv|NN 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 + +#if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT) +Es |regnode*|reg |NN struct RExC_state_t *pRExC_state \ + |I32 paren|NN I32 *flagp|U32 depth +Es |regnode*|reganode |NN struct RExC_state_t *pRExC_state|U8 op \ + |U32 arg +Es |regnode*|regatom |NN struct RExC_state_t *pRExC_state \ + |NN I32 *flagp|U32 depth +Es |regnode*|regbranch |NN struct RExC_state_t *pRExC_state \ + |NN I32 *flagp|I32 first|U32 depth +Es |STRLEN |reguni |NN const struct RExC_state_t *pRExC_state \ + |UV uv|NN char *s +Es |regnode*|regclass |NN struct RExC_state_t *pRExC_state|U32 depth +ERsn |I32 |regcurly |NN const char *s +Es |regnode*|reg_node |NN struct RExC_state_t *pRExC_state|U8 op +Es |UV |reg_recode |const char value|NN SV **encp +Es |regnode*|regpiece |NN struct RExC_state_t *pRExC_state \ + |NN I32 *flagp|U32 depth +Es |regnode*|reg_namedseq |NN struct RExC_state_t *pRExC_state \ + |NULLOK UV *valuep +Es |void |reginsert |NN struct RExC_state_t *pRExC_state \ + |U8 op|NN regnode *opnd|U32 depth +Es |void |regtail |NN struct RExC_state_t *pRExC_state \ + |NN regnode *p|NN const regnode *val|U32 depth +Es |SV * |reg_scan_name |NN struct RExC_state_t *pRExC_state \ + |U32 flags +Es |U32 |join_exact |NN struct RExC_state_t *pRExC_state \ + |NN regnode *scan|NN I32 *min|U32 flags|NULLOK regnode *val|U32 depth +EsRn |char * |regwhite |NN struct RExC_state_t *pRExC_state \ + |NN char *p +Es |char * |nextchar |NN struct RExC_state_t *pRExC_state +Es |bool |reg_skipcomment|NN struct RExC_state_t *pRExC_state +Es |void |scan_commit |NN const struct RExC_state_t *pRExC_state \ + |NN struct scan_data_t *data|NN I32 *minlenp \ + |int is_inf +Esn |void |cl_anything |NN const struct RExC_state_t *pRExC_state \ + |NN struct regnode_charclass_class *cl +EsRn |int |cl_is_anything |NN const struct regnode_charclass_class *cl +Esn |void |cl_init |NN const struct RExC_state_t *pRExC_state \ + |NN struct regnode_charclass_class *cl +Esn |void |cl_init_zero |NN const struct RExC_state_t *pRExC_state \ + |NN struct regnode_charclass_class *cl +Esn |void |cl_and |NN struct regnode_charclass_class *cl \ + |NN const struct regnode_charclass_class *and_with +Esn |void |cl_or |NN const struct RExC_state_t *pRExC_state \ + |NN struct regnode_charclass_class *cl \ + |NN const struct regnode_charclass_class *or_with +Es |I32 |study_chunk |NN struct RExC_state_t *pRExC_state \ + |NN regnode **scanp|NN I32 *minlenp \ + |NN I32 *deltap|NN regnode *last \ + |NULLOK struct scan_data_t *data \ + |I32 stopparen|NULLOK U8* recursed \ + |NULLOK struct regnode_charclass_class *and_withp \ + |U32 flags|U32 depth +EsRn |U32 |add_data |NN struct RExC_state_t *pRExC_state|U32 n \ + |NN const char *s +rs |void |re_croak2 |NN const char* pat1|NN const char* pat2|... +Es |I32 |regpposixcc |NN struct RExC_state_t *pRExC_state|I32 value +Es |void |checkposixcc |NN struct RExC_state_t *pRExC_state +Es |I32 |make_trie |NN struct 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 |void |make_trie_failtable |NN struct RExC_state_t *pRExC_state \ + |NN regnode *source|NN regnode *stclass \ + |U32 depth +# ifdef DEBUGGING +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_byte |NN SV* sv|int c +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 struct RExC_state_t *pRExC_state \ + |NN regnode *p|NN const regnode *val|U32 depth +# endif +#endif + +#if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT) +ERs |I32 |regmatch |NN regmatch_info *reginfo|NN regnode *prog +ERs |I32 |regrepeat |NN const regexp *prog|NN const regnode *p|I32 max|int depth +ERs |I32 |regtry |NN regmatch_info *reginfo|NN char **startpos +ERs |bool |reginclass |NULLOK const regexp *prog|NN const regnode *n|NN const U8 *p|NULLOK STRLEN *lenp\ + |bool do_utf8sv_is_utf8 +Es |CHECKPOINT|regcppush |I32 parenfloor +Es |char* |regcppop |NN const regexp *rex +ERsn |U8* |reghop3 |NN U8 *s|I32 off|NN const U8 *lim +#ifdef XXX_dmq +ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN const U8 *llim \ + |NN const U8 *rlim +#endif +ERsn |U8* |reghopmaybe3 |NN U8 *s|I32 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 |swap_match_buff|NN regexp * prog +Es |void |to_utf8_substr |NN regexp * prog +Es |void |to_byte_substr |NN regexp * prog +ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex \ + |NN const regnode *scan +# 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 +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 +# endif +#endif + +#if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT) +s |CV* |deb_curcv |const I32 ix +s |void |debprof |NN const OP *o +s |void |sequence |NULLOK const OP *o +s |void |sequence_tail |NULLOK 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) || defined(PERL_DECL_PROT) +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_DECL_PROT) +: 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) || defined(PERL_DECL_PROT) +: Used in hv.c and mg.c +poM |int |sv_kill_backrefs |NN SV *const sv|NN AV *const av +#endif + +#if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) +nsR |char * |uiv_2buf |NN char *const buf|const IV iv|UV uv|const int is_uv|NN char **const peob +s |void |sv_unglob |NN SV *const sv +s |void |not_a_number |NN SV *const sv +s |I32 |visit |NN SVFUNC_t f|const U32 flags|const U32 mask +s |void |sv_del_backref |NN SV *const tsv|NN SV *const sv +sR |SV * |varname |NULLOK const GV *const gv|const char gvtype \ + |PADOFFSET targ|NULLOK const SV *const keyname \ + |I32 aindex|int subscript_type +# 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|STRLEN uoffset +sn |STRLEN |sv_pos_u2b_midway|NN const U8 *const start \ + |NN const U8 *send|const 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 \ + |const STRLEN uoffset|STRLEN uoffset0|STRLEN boffset0 +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 +sn |char * |F0convert |NV nv|NN char *const endbuf|NN STRLEN *const len +# if defined(PERL_OLD_COPY_ON_WRITE) +sM |void |sv_release_COW |NN SV *sv|NN const char *pvx|NN SV *after +# endif +s |SV * |more_sv +s |void * |more_bodies |const svtype sv_type +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 +s |void |glob_assign_ref|NN SV *const dstr|NN SV *const sstr +sRn |PTR_TBL_ENT_t *|ptr_table_find|NN PTR_TBL_t *const tbl|NULLOK const void *const sv +#endif + +#if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) +s |void |check_uni +s |void |force_next |I32 type +s |char* |force_version |NN char *s|int guessing +s |char* |force_word |NN char *start|int token|int check_keyword \ + |int allow_pack|int allow_tick +s |SV* |tokeq |NN SV *sv +s |void |readpipe_override| +sR |char* |scan_const |NN char *start +sR |char* |scan_formline |NN char *s +sR |char* |scan_heredoc |NN char *s +s |char* |scan_ident |NN char *s|NN const char *send|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 +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 |NN char *s +sR |char* |swallow_bom |NN U8 *s +s |void |checkcomma |NN const char *s|NN const char *name \ + |NN const char *what +s |bool |feature_is_enabled|NN const char *const name|STRLEN namelen +s |void |force_ident |NN const char *s|int kind +s |void |incline |NN const char *s +s |int |intuit_method |NN char *s|NULLOK GV *gv|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 +sR |I32 |sublex_done +sR |I32 |sublex_push +sR |I32 |sublex_start +sR |char * |filter_gets |NN SV *sv|NN PerlIO *fp|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 |ao |int toketype +# 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 +s |void |printbuf |NN const char *const fmt|NN const char *const s +# endif +#endif + +#if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) +s |bool|isa_lookup |NN HV *stash|NN const char * const name +so |HV * |get_isa_hash |NN HV *const stash +#endif + +#if defined(PERL_IN_LOCALE_C) || defined(PERL_DECL_PROT) +#if defined(USE_LOCALE_NUMERIC) || defined(USE_LOCALE_COLLATE) +s |char* |stdize_locale |NN char* locs +#endif +#endif + +#if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) +s |const COP*|closest_cop |NN const COP *cop|NULLOK const OP *o +s |SV* |mess_alloc +s |const char *|vdie_croak_common|NULLOK const char *pat|NULLOK va_list *args \ + |NULLOK STRLEN *msglen|NULLOK I32* utf8 +s |bool |vdie_common |NULLOK const char *message|STRLEN msglen\ + |I32 utf8|bool warn +sr |char * |write_no_mem +#if defined(PERL_MEM_LOG) && defined(PERL_MEM_LOG_STDERR) +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_IN_NUMERIC_C) || defined(PERL_DECL_PROT) +sn |NV|mulexp10 |NV value|I32 exponent +#endif + +#if defined(PERL_IN_UTF8_C) || defined(PERL_DECL_PROT) +sRn |STRLEN |is_utf8_char_slow|NN const U8 *s|const STRLEN len +sR |bool |is_utf8_common |NN const U8 *const p|NN SV **swash|NN const char * const swashname +sR |SV* |swash_get |NN SV* swash|UV start|UV span +#endif + +START_EXTERN_C + +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_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 +Apd |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 +Apd |void |sv_copypv |NN SV *const dsv|NN SV *const ssv +Ap |char* |my_atof2 |NN const char *s|NN NV* value +Apn |int |my_socketpair |int family|int type|int protocol|int fd[2] +Ap |int |my_dirfd |NULLOK DIR* dir +#ifdef PERL_OLD_COPY_ON_WRITE +: 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) && !defined(USE_SFIO) +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|int cnt +Ap |void |PerlIO_set_ptrcnt |NULLOK PerlIO *f|NULLOK STDCHAR *ptr \ + |int 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 + +Ap |STDCHAR *|PerlIO_get_base |NULLOK PerlIO *f +Ap |STDCHAR *|PerlIO_get_ptr |NULLOK PerlIO *f +ApR |int |PerlIO_get_bufsiz |NULLOK PerlIO *f +ApR |int |PerlIO_get_cnt |NULLOK PerlIO *f + +ApR |PerlIO *|PerlIO_stdin +ApR |PerlIO *|PerlIO_stdout +ApR |PerlIO *|PerlIO_stderr +#endif /* PERLIO_LAYERS */ + +: Only used in dump.c +p |void |deb_stack_all +#if defined(PERL_IN_DEB_C) || defined(PERL_DECL_PROT) +s |void |deb_stack_n |NN SV** stack_base|I32 stack_min \ + |I32 stack_max|I32 mark_min|I32 mark_max +#endif + +: Used in perl.c, pp_ctl.c, toke.c +pda |PADLIST*|pad_new |int flags +: Only used in op.c +pd |void |pad_undef |NN CV* cv +: Only used in op.c +pd |PADOFFSET|pad_add_name |NN const char *name\ + |NULLOK HV* typestash|NULLOK HV* ourstash|bool clone|bool state +: Only used in op.c +pd |PADOFFSET|pad_add_anon |NN SV* sv|OPCODE op_type +: Only used in op.c +pd |void |pad_check_dup |NN const char* name|bool is_our|NN const HV* ourstash +#ifdef DEBUGGING +: Only used PAD_SETSV() in op.c +pd |void |pad_setsv |PADOFFSET po|NN SV* sv +#endif +: Only used in op.c +pd |void |pad_block_start|int full +: Only used in op.c +pd |void |pad_tidy |padtidy_type type +: Used in dump.c +pd |void |do_dump_pad |I32 level|NN PerlIO *file|NULLOK PADLIST *padlist|int full +: Only used in op.c +pd |void |pad_fixup_inner_anons|NN PADLIST *padlist|NN CV *old_cv|NN CV *new_cv + +: Used in pp_ctl.c, pp_hot.c, pp_sort.c +pdX |void |pad_push |NN PADLIST *padlist|int depth +: Only used in PAD_COMPNAME_TYPE() in op.c +pR |HV* |pad_compname_type|const PADOFFSET po + +#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT) +sd |PADOFFSET|pad_findlex |NN const char *name|NN const CV* cv|U32 seq|int warn \ + |NULLOK SV** out_capture|NN SV** out_name_sv \ + |NN int *out_flags +# if defined(DEBUGGING) +sd |void |cv_dump |NN const CV *cv|NN const char *title +# endif +#endif +ApdR |CV* |find_runcv |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 +Apod |void |hv_assert |NN HV *hv + +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_name_set |NN HV *hv|NULLOK 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_DECL_PROT) +: Only used in sv.c +poM |void |hv_kill_backrefs |NN HV *hv +#endif +Apd |void |hv_clear_placeholders |NN HV *hv +ApoR |I32* |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) || defined(PERL_DECL_PROT) +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 top +#endif + +#ifdef PERL_NEED_MY_HTOLE16 +np |U16 |my_htole16 |U16 n +#endif +#ifdef PERL_NEED_MY_LETOH16 +np |U16 |my_letoh16 |U16 n +#endif +#ifdef PERL_NEED_MY_HTOBE16 +np |U16 |my_htobe16 |U16 n +#endif +#ifdef PERL_NEED_MY_BETOH16 +np |U16 |my_betoh16 |U16 n +#endif +#ifdef PERL_NEED_MY_HTOLE32 +np |U32 |my_htole32 |U32 n +#endif +#ifdef PERL_NEED_MY_LETOH32 +np |U32 |my_letoh32 |U32 n +#endif +#ifdef PERL_NEED_MY_HTOBE32 +np |U32 |my_htobe32 |U32 n +#endif +#ifdef PERL_NEED_MY_BETOH32 +np |U32 |my_betoh32 |U32 n +#endif +#ifdef PERL_NEED_MY_HTOLE64 +np |U64 |my_htole64 |U64 n +#endif +#ifdef PERL_NEED_MY_LETOH64 +np |U64 |my_letoh64 |U64 n +#endif +#ifdef PERL_NEED_MY_HTOBE64 +np |U64 |my_htobe64 |U64 n +#endif +#ifdef PERL_NEED_MY_BETOH64 +np |U64 |my_betoh64 |U64 n +#endif + +#ifdef PERL_NEED_MY_HTOLES +np |short |my_htoles |short n +#endif +#ifdef PERL_NEED_MY_LETOHS +np |short |my_letohs |short n +#endif +#ifdef PERL_NEED_MY_HTOBES +np |short |my_htobes |short n +#endif +#ifdef PERL_NEED_MY_BETOHS +np |short |my_betohs |short n +#endif +#ifdef PERL_NEED_MY_HTOLEI +np |int |my_htolei |int n +#endif +#ifdef PERL_NEED_MY_LETOHI +np |int |my_letohi |int n +#endif +#ifdef PERL_NEED_MY_HTOBEI +np |int |my_htobei |int n +#endif +#ifdef PERL_NEED_MY_BETOHI +np |int |my_betohi |int n +#endif +#ifdef PERL_NEED_MY_HTOLEL +np |long |my_htolel |long n +#endif +#ifdef PERL_NEED_MY_LETOHL +np |long |my_letohl |long n +#endif +#ifdef PERL_NEED_MY_HTOBEL +np |long |my_htobel |long n +#endif +#ifdef PERL_NEED_MY_BETOHL +np |long |my_betohl |long n +#endif + +: I think that these are only used by the above, which are macros, and in turn +: currently they are only used in pp_pack.c, but this is in util.c +np |void |my_swabn |NN void* ptr|int n + +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 +: Only used in pp.c +dpR |bool |is_gv_magical_sv|NN SV *const name_sv|U32 flags + +ApR |bool |stashpv_hvname_match|NN const COP *c|NN const HV *hv + +#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP +: Used in sv.c +p |void |dump_sv_child |NN SV *sv +#endif + +#ifdef PERL_DONT_CREATE_GVSV +Ap |GV* |gv_SVadd |NN GV* gv +#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 + +: Used in av.c, hv.c +p |void |offer_nice_chunk |NN void *const chunk|const U32 chunk_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 + +: 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 + +#ifndef HAS_STRLCAT +Apno |Size_t |my_strlcat |NULLOK char *dst|NULLOK const char *src|Size_t size +#endif + +#ifndef HAS_STRLCPY +Apno |Size_t |my_strlcpy |NULLOK char *dst|NULLOK const char *src|Size_t size +#endif + +#ifdef PERL_MAD +Mnp |void |pad_peg |NN const char* s +#if defined(PERL_IN_DUMP_C) || defined(PERL_DECL_PROT) +sf |void |xmldump_attr |I32 level|NN PerlIO *file|NN const char* pat \ + |... +#endif +Mfp |void |xmldump_indent |I32 level|NN PerlIO *file|NN const char* pat \ + |... +Mp |void |xmldump_vindent|I32 level|NN PerlIO *file|NN const char* pat \ + |NULLOK va_list *args +Mp |void |xmldump_all +Mp |void |xmldump_packsubs |NN const HV* stash +Mp |void |xmldump_sub |NN const GV* gv +Mp |void |xmldump_form |NN const GV* gv +Mp |void |xmldump_eval +Mp |char* |sv_catxmlsv |NN SV *dsv|NN SV *ssv +Mp |char* |sv_catxmlpvn |NN SV *dsv|NN const char *pv|STRLEN len|int utf8 +Mp |char* |sv_xmlpeek |NN SV* sv +Mp |void |do_pmop_xmldump|I32 level|NN PerlIO *file \ + |NULLOK const PMOP *pm +Mp |void |pmop_xmldump |NULLOK const PMOP* pm +Mp |void |do_op_xmldump |I32 level|NN PerlIO *file|NULLOK const OP *o +Mp |void |op_xmldump |NN const OP *o + +Mp |TOKEN* |newTOKEN |I32 optype|YYSTYPE lval \ + |NULLOK MADPROP* madprop +Mp |void |token_free |NN TOKEN *tk +Mp |void |token_getmad |NN TOKEN *tk|NULLOK OP *o|char slot +Mp |void |op_getmad_weak |NULLOK OP* from|NULLOK OP* o|char slot +Mp |void |op_getmad |NULLOK OP* from|NULLOK OP* o|char slot +Mp |void |prepend_madprops|NULLOK MADPROP* mp|NULLOK OP* o|char slot +Mp |void |append_madprops|NULLOK MADPROP* tm|NULLOK OP* o|char slot +Mp |void |addmad |NULLOK MADPROP* tm|NULLOK MADPROP** root \ + |char slot +Mp |MADPROP*|newMADsv |char key|NN SV* sv +Mp |MADPROP*|newMADPROP |char key|char type|NULLOK const void* val \ + |I32 vlen +Mp |void |mad_free |NULLOK MADPROP* mp + +# if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) +s |char* |skipspace0 |NN char *s +s |char* |skipspace1 |NN char *s +s |char* |skipspace2 |NN char *s|NULLOK SV **sv +s |void |start_force |int where +s |void |curmad |char slot|NULLOK SV *sv +# endif +Mp |int |madlex +Mp |int |madparse +#endif +#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) || defined(PERL_DECL_PROT) +sd |AV* |mro_get_linear_isa_dfs|NN HV* stash|U32 level +#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 +: 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 *|fetch_cop_label|NULLOK struct refcounted_he *const chain \ + |NULLOK STRLEN *len|NULLOK U32 *flags +: Only used in op.c +xpoM |struct refcounted_he *|store_cop_label \ + |NULLOK struct refcounted_he *const chain|NN const char *label + +END_EXTERN_C +/* + * ex: set ts=8 sts=4 sw=4 noet: + */ diff --git a/cpan/Devel-PPPort/parts/inc/HvNAME b/cpan/Devel-PPPort/parts/inc/HvNAME new file mode 100644 index 0000000000..135549db26 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/HvNAME @@ -0,0 +1,45 @@ +################################################################################ +## +## $Revision: 1 $ +## $Author: mhx $ +## $Date: 2009/06/12 12:29:57 +0200 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/MY_CXT b/cpan/Devel-PPPort/parts/inc/MY_CXT new file mode 100644 index 0000000000..d67af01377 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/MY_CXT @@ -0,0 +1,192 @@ +################################################################################ +## +## $Revision: 16 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:55 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/SvPV b/cpan/Devel-PPPort/parts/inc/SvPV new file mode 100644 index 0000000000..e81fb684c1 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/SvPV @@ -0,0 +1,524 @@ +################################################################################ +## +## $Revision: 22 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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_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 + +void +SvPV_renew(sv, nlen, insv) + SV *sv + IV 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 => 47 + +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++); + +$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); + +my $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; +($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/cpan/Devel-PPPort/parts/inc/SvREFCNT b/cpan/Devel-PPPort/parts/inc/SvREFCNT new file mode 100644 index 0000000000..46c5deb356 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/SvREFCNT @@ -0,0 +1,130 @@ +################################################################################ +## +## $Revision: 5 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/Sv_set b/cpan/Devel-PPPort/parts/inc/Sv_set new file mode 100644 index 0000000000..95cf2d672e --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/Sv_set @@ -0,0 +1,124 @@ +################################################################################ +## +## $Revision: 7 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:53 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/call b/cpan/Devel-PPPort/parts/inc/call new file mode 100644 index 0000000000..85159e22a8 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/call @@ -0,0 +1,367 @@ +################################################################################ +## +## $Revision: 19 $ +## $Author: mhx $ +## $Date: 2009/01/23 18:27:48 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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); +#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/cpan/Devel-PPPort/parts/inc/cop b/cpan/Devel-PPPort/parts/inc/cop new file mode 100644 index 0000000000..7c8674112d --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/cop @@ -0,0 +1,84 @@ +################################################################################ +## +## $Revision: 8 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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 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 */ + +=xsubs + +char * +CopSTASHPV() + CODE: + RETVAL = CopSTASHPV(PL_curcop); + OUTPUT: + RETVAL + +char * +CopFILE() + CODE: + RETVAL = CopFILE(PL_curcop); + OUTPUT: + RETVAL + +=tests plan => 2 + +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); + diff --git a/cpan/Devel-PPPort/parts/inc/exception b/cpan/Devel-PPPort/parts/inc/exception new file mode 100644 index 0000000000..122277bbb1 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/exception @@ -0,0 +1,74 @@ +################################################################################ +## +## $Revision: 7 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:53 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/format b/cpan/Devel-PPPort/parts/inc/format new file mode 100644 index 0000000000..d39670416c --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/format @@ -0,0 +1,70 @@ +################################################################################ +## +## $Revision: 9 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:55 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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" +# else +# if IVSIZE == INTSIZE +# define IVdf "d" +# define UVuf "u" +# define UVof "o" +# define UVxf "x" +# define UVXf "X" +# endif +# 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/cpan/Devel-PPPort/parts/inc/grok b/cpan/Devel-PPPort/parts/inc/grok new file mode 100644 index 0000000000..5e32f8e990 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/grok @@ -0,0 +1,677 @@ +################################################################################ +## +## $Revision: 16 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:55 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = grok_bin(pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +UV +grok_hex(string) + SV *string + PREINIT: + char *pv; + I32 flags; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = grok_hex(pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +UV +grok_oct(string) + SV *string + PREINIT: + char *pv; + I32 flags; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = grok_oct(pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +UV +Perl_grok_number(string) + SV *string + PREINIT: + const char *pv; + STRLEN len; + CODE: + pv = SvPV(string, len); + if (!Perl_grok_number(aTHX_ pv, len, &RETVAL)) + XSRETURN_UNDEF; + OUTPUT: + RETVAL + +UV +Perl_grok_bin(string) + SV *string + PREINIT: + char *pv; + I32 flags; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +UV +Perl_grok_hex(string) + SV *string + PREINIT: + char *pv; + I32 flags; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +UV +Perl_grok_oct(string) + SV *string + PREINIT: + char *pv; + I32 flags; + STRLEN len; + CODE: + pv = SvPV(string, len); + RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL); + OUTPUT: + RETVAL + +=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/cpan/Devel-PPPort/parts/inc/gv b/cpan/Devel-PPPort/parts/inc/gv new file mode 100644 index 0000000000..1b911e738d --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/gv @@ -0,0 +1,66 @@ +################################################################################ +## +## $Revision: 1 $ +## $Author: mhx $ +## $Date: 2009/06/12 12:29:56 +0200 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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__ GvSVn(gv) GvSV(gv) +__UNDEFINED__ isGV_with_GP(gv) isGV(gv) + +=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 + + +=tests plan => 2 + +ok(Devel::PPPort::GvSVn(), 1); + +ok(Devel::PPPort::isGV_with_GP(), 2) diff --git a/cpan/Devel-PPPort/parts/inc/limits b/cpan/Devel-PPPort/parts/inc/limits new file mode 100644 index 0000000000..25b3940179 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/limits @@ -0,0 +1,331 @@ +################################################################################ +## +## $Revision: 7 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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__ 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__ 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/cpan/Devel-PPPort/parts/inc/mPUSH b/cpan/Devel-PPPort/parts/inc/mPUSH new file mode 100644 index 0000000000..3613058837 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/mPUSH @@ -0,0 +1,138 @@ +################################################################################ +## +## $Revision: 11 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/magic b/cpan/Devel-PPPort/parts/inc/magic new file mode 100644 index 0000000000..31721715ea --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/magic @@ -0,0 +1,369 @@ +################################################################################ +## +## $Revision: 17 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:55 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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__ +/sv_\w+_mg/ +sv_magic_portable + +=implementation + +__UNDEFINED__ SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END + +__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 + +=xsubs + +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, '~'); + 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 => 15 + +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'); + +my $ver = eval qq[qv("v1.2.0")]; +ok($[ < 5.009 || $@ eq ''); +ok($@ || 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/cpan/Devel-PPPort/parts/inc/memory b/cpan/Devel-PPPort/parts/inc/memory new file mode 100644 index 0000000000..761d80c959 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/memory @@ -0,0 +1,84 @@ +################################################################################ +## +## $Revision: 5 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:53 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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__ 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++; + Poison(p, 6, char); + if (memNE(p, "\0\0\0\0\0\0", 6)) + 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(), 4); + diff --git a/cpan/Devel-PPPort/parts/inc/misc b/cpan/Devel-PPPort/parts/inc/misc new file mode 100644 index 0000000000..3844bbb317 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/misc @@ -0,0 +1,565 @@ +################################################################################ +## +## $Revision: 53 $ +## $Author: mhx $ +## $Date: 2009/03/31 23:05:55 +0200 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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_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 +XSRETURN + +=implementation + +#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 + +__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 +__UNDEFINED__ isALNUMC(c) (isALPHA(c) || isDIGIT(c)) +__UNDEFINED__ isASCII(c) ((c) <= 127) +__UNDEFINED__ isCNTRL(c) ((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 + +=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; + 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; + SP -= items; + iv = SvIV(ST(0)) - 1; + mPUSHi(iv); + XSRETURN(1); +} + +=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 +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]; + PUSHMARK(SP); + mXPUSHs(newSVpv(string, 0)); + PUTBACK; + ENTER; + (void)*(lower)(aTHXR); + SPAGAIN; + LEAVE; + XSRETURN(1); + +=tests plan => 39 + +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) { + eval q{ + 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); + diff --git a/cpan/Devel-PPPort/parts/inc/newCONSTSUB b/cpan/Devel-PPPort/parts/inc/newCONSTSUB new file mode 100644 index 0000000000..4b266d7990 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/newCONSTSUB @@ -0,0 +1,111 @@ +################################################################################ +## +## $Revision: 15 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:55 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/newRV b/cpan/Devel-PPPort/parts/inc/newRV new file mode 100644 index 0000000000..1467d1ae9d --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/newRV @@ -0,0 +1,74 @@ +################################################################################ +## +## $Revision: 9 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:55 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/newSV_type b/cpan/Devel-PPPort/parts/inc/newSV_type new file mode 100644 index 0000000000..06ebdb4100 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/newSV_type @@ -0,0 +1,86 @@ +################################################################################ +## +## $Revision: 1 $ +## $Author: mhx $ +## $Date: 2009/06/12 12:29:57 +0200 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/newSVpv b/cpan/Devel-PPPort/parts/inc/newSVpv new file mode 100644 index 0000000000..3a38549f98 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/newSVpv @@ -0,0 +1,115 @@ +################################################################################ +## +## $Revision: 6 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:51 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/podtest b/cpan/Devel-PPPort/parts/inc/podtest new file mode 100644 index 0000000000..ceea0cf7a2 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/podtest @@ -0,0 +1,52 @@ +################################################################################ +## +## $Revision: 9 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/ppphbin b/cpan/Devel-PPPort/parts/inc/ppphbin new file mode 100644 index 0000000000..583f266a77 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/ppphbin @@ -0,0 +1,828 @@ +################################################################################ +## +## $Revision: 50 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/ppphdoc b/cpan/Devel-PPPort/parts/inc/ppphdoc new file mode 100644 index 0000000000..62d484106f --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/ppphdoc @@ -0,0 +1,353 @@ +################################################################################ +## +## $Revision: 32 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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 +automagially 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 using the CPAN Request Tracker at L<http://rt.cpan.org/>. + +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-2009, 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/cpan/Devel-PPPort/parts/inc/ppphtest b/cpan/Devel-PPPort/parts/inc/ppphtest new file mode 100644 index 0000000000..f94cc7de2d --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/ppphtest @@ -0,0 +1,901 @@ +################################################################################ +## +## $Revision: 46 $ +## $Author: mhx $ +## $Date: 2009/01/23 18:28:00 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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 => 235 + +BEGIN { + if ($ENV{'SKIP_SLOW_TESTS'}) { + for (1 .. 235) { + 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")); + +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/cpan/Devel-PPPort/parts/inc/pv_tools b/cpan/Devel-PPPort/parts/inc/pv_tools new file mode 100644 index 0000000000..c7e4c1e907 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/pv_tools @@ -0,0 +1,281 @@ +################################################################################ +## +## $Revision: 5 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:51 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/pvs b/cpan/Devel-PPPort/parts/inc/pvs new file mode 100644 index 0000000000..71485ad32e --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/pvs @@ -0,0 +1,128 @@ +################################################################################ +## +## $Revision: 11 $ +## $Author: mhx $ +## $Date: 2009/06/12 12:19:15 +0200 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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__ 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_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt) +__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) + +=xsubs + +void +newSVpvs() + PPCODE: + mXPUSHs(newSVpvs("newSVpvs")); + XSRETURN(1); + +void +newSVpvs_flags() + PPCODE: + XPUSHs(newSVpvs_flags("newSVpvs_flags", SVs_TEMP)); + XSRETURN(1); + +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_fetchpvn_flags() + CODE: + RETVAL = newRV_inc((SV*)gv_fetchpvn_flags("Devel::PPPort::VERSION", sizeof("Devel::PPPort::VERSION")-1, 0, SVt_PV)); + OUTPUT: + RETVAL + +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 + + +=tests plan => 11 + +my $x = 'foo'; + +ok(Devel::PPPort::newSVpvs(), "newSVpvs"); +ok(Devel::PPPort::newSVpvs_flags(), "newSVpvs_flags"); + +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_fetchpvn_flags(), \*Devel::PPPort::VERSION); +ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION); +ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::); diff --git a/cpan/Devel-PPPort/parts/inc/shared_pv b/cpan/Devel-PPPort/parts/inc/shared_pv new file mode 100644 index 0000000000..db779be835 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/shared_pv @@ -0,0 +1,91 @@ +################################################################################ +## +## $Revision: 5 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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 + +#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/cpan/Devel-PPPort/parts/inc/snprintf b/cpan/Devel-PPPort/parts/inc/snprintf new file mode 100644 index 0000000000..310bfbaa10 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/snprintf @@ -0,0 +1,70 @@ +################################################################################ +## +## $Revision: 6 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/sprintf b/cpan/Devel-PPPort/parts/inc/sprintf new file mode 100644 index 0000000000..6756f9abc9 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/sprintf @@ -0,0 +1,62 @@ +################################################################################ +## +## $Revision: 2 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:51 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/strlfuncs b/cpan/Devel-PPPort/parts/inc/strlfuncs new file mode 100644 index 0000000000..d351703e19 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/strlfuncs @@ -0,0 +1,114 @@ +################################################################################ +## +## $Revision: 6 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/sv_xpvf b/cpan/Devel-PPPort/parts/inc/sv_xpvf new file mode 100644 index 0000000000..3c990c6e93 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/sv_xpvf @@ -0,0 +1,321 @@ +################################################################################ +## +## $Revision: 10 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:53 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/threads b/cpan/Devel-PPPort/parts/inc/threads new file mode 100644 index 0000000000..518bdf1fcb --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/threads @@ -0,0 +1,75 @@ +################################################################################ +## +## $Revision: 11 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:53 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/uv b/cpan/Devel-PPPort/parts/inc/uv new file mode 100644 index 0000000000..5fdec7afa0 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/uv @@ -0,0 +1,129 @@ +################################################################################ +## +## $Revision: 17 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/variables b/cpan/Devel-PPPort/parts/inc/variables new file mode 100644 index 0000000000..515e6200a4 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/variables @@ -0,0 +1,483 @@ +################################################################################ +## +## $Revision: 20 $ +## $Author: mhx $ +## $Date: 2009/06/12 04:10:50 +0200 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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 + * doint. 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) +{ + 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); + +#define ppp_TESTVAR(var) STMT_START { mXPUSHi(&var != NULL); count++; } STMT_END + +#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); + ppp_TESTVAR(PL_dirty); + 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/cpan/Devel-PPPort/parts/inc/version b/cpan/Devel-PPPort/parts/inc/version new file mode 100644 index 0000000000..ca8d8a6e35 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/version @@ -0,0 +1,58 @@ +################################################################################ +## +## $Revision: 10 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:54 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/inc/warn b/cpan/Devel-PPPort/parts/inc/warn new file mode 100644 index 0000000000..76bd881e97 --- /dev/null +++ b/cpan/Devel-PPPort/parts/inc/warn @@ -0,0 +1,175 @@ +################################################################################ +## +## $Revision: 7 $ +## $Author: mhx $ +## $Date: 2009/01/18 14:10:52 +0100 $ +## +################################################################################ +## +## Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/ppport.fnc b/cpan/Devel-PPPort/parts/ppport.fnc new file mode 100644 index 0000000000..567955e3bc --- /dev/null +++ b/cpan/Devel-PPPort/parts/ppport.fnc @@ -0,0 +1,29 @@ +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +: +: Perl/Pollution/Portability +: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +: +: $Revision: 3 $ +: $Author: mhx $ +: $Date: 2009/01/18 14:10:51 +0100 $ +: +:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: +: +: Version 3.x, Copyright (C) 2004-2009, 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/cpan/Devel-PPPort/parts/ppptools.pl b/cpan/Devel-PPPort/parts/ppptools.pl new file mode 100644 index 0000000000..36830eb186 --- /dev/null +++ b/cpan/Devel-PPPort/parts/ppptools.pl @@ -0,0 +1,400 @@ +################################################################################ +# +# ppptools.pl -- various utility functions +# +################################################################################ +# +# $Revision: 27 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:51 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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, $_) } @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://! + 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; + for (@args) { + $_ = [trim_arg($_)]; + } + ($ret) = trim_arg($ret); + push @func, { + name => $name, + flags => { map { $_, 1 } $flags =~ /./g }, + ret => $ret, + args => \@args, + cond => ppcond(\@pps), + }; + } + } + } + + 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/cpan/Devel-PPPort/parts/todo/5004000 b/cpan/Devel-PPPort/parts/todo/5004000 new file mode 100644 index 0000000000..1382ea7648 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5004000 @@ -0,0 +1,68 @@ +5.004000 +GIMME_V # E +G_VOID # E +HEf_SVKEY # E +HeHASH # U +HeKEY # U +HeKLEN # U +HePV # U +HeSVKEY # U +HeSVKEY_force # U +HeSVKEY_set # U +HeVAL # U +SvSetMagicSV # U +SvSetMagicSV_nosteal # U +SvSetSV_nosteal # U +SvTAINTED # U +SvTAINTED_off # U +SvTAINTED_on # U +block_gimme # U +call_list # U +cv_const_sv # U +delimcpy # U +do_open # E (Perl_do_open) +form # U +gv_autoload4 # U +gv_efullname3 # U +gv_fetchmethod_autoload # U +gv_fullname3 # U +hv_delayfree_ent # U +hv_delete_ent # U +hv_exists_ent # U +hv_fetch_ent # U +hv_free_ent # U +hv_iterkeysv # U +hv_ksplit # U +hv_store_ent # U +ibcmp_locale # U +my_failure_exit # U +my_memcmp # U +my_pclose # E (Perl_my_pclose) +my_popen # E (Perl_my_popen) +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_gets # E (Perl_sv_gets) +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 +unsharepvn # U +vnewSVpvf # U +warner # U diff --git a/cpan/Devel-PPPort/parts/todo/5004010 b/cpan/Devel-PPPort/parts/todo/5004010 new file mode 100644 index 0000000000..8c29866603 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5004010 @@ -0,0 +1 @@ +5.004010 diff --git a/cpan/Devel-PPPort/parts/todo/5004020 b/cpan/Devel-PPPort/parts/todo/5004020 new file mode 100644 index 0000000000..4b43fdf8e4 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5004020 @@ -0,0 +1 @@ +5.004020 diff --git a/cpan/Devel-PPPort/parts/todo/5004030 b/cpan/Devel-PPPort/parts/todo/5004030 new file mode 100644 index 0000000000..e45facbb1f --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5004030 @@ -0,0 +1 @@ +5.004030 diff --git a/cpan/Devel-PPPort/parts/todo/5004040 b/cpan/Devel-PPPort/parts/todo/5004040 new file mode 100644 index 0000000000..69ccd5d62c --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5004040 @@ -0,0 +1 @@ +5.004040 diff --git a/cpan/Devel-PPPort/parts/todo/5004050 b/cpan/Devel-PPPort/parts/todo/5004050 new file mode 100644 index 0000000000..f1c9f8942a --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5004050 @@ -0,0 +1,4 @@ +5.004050 +do_binmode # U +save_aelem # U +save_helem # U diff --git a/cpan/Devel-PPPort/parts/todo/5005000 b/cpan/Devel-PPPort/parts/todo/5005000 new file mode 100644 index 0000000000..b99f61e20e --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5005000 @@ -0,0 +1,27 @@ +5.005000 +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) +screaminstr # E (Perl_screaminstr) +sv_iv # U +sv_nv # U +sv_peek # U +sv_pvn # U +sv_pvn_nomg # U +sv_true # U diff --git a/cpan/Devel-PPPort/parts/todo/5005010 b/cpan/Devel-PPPort/parts/todo/5005010 new file mode 100644 index 0000000000..deebff5bf8 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5005010 @@ -0,0 +1 @@ +5.005010 diff --git a/cpan/Devel-PPPort/parts/todo/5005020 b/cpan/Devel-PPPort/parts/todo/5005020 new file mode 100644 index 0000000000..d19ff2ae09 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5005020 @@ -0,0 +1 @@ +5.005020 diff --git a/cpan/Devel-PPPort/parts/todo/5005030 b/cpan/Devel-PPPort/parts/todo/5005030 new file mode 100644 index 0000000000..885afa0d23 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5005030 @@ -0,0 +1,4 @@ +5.005030 +POPpx # E +get_vtbl # U +save_generic_svref # U diff --git a/cpan/Devel-PPPort/parts/todo/5005040 b/cpan/Devel-PPPort/parts/todo/5005040 new file mode 100644 index 0000000000..8a165c2033 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5005040 @@ -0,0 +1 @@ +5.005040 diff --git a/cpan/Devel-PPPort/parts/todo/5006000 b/cpan/Devel-PPPort/parts/todo/5006000 new file mode 100644 index 0000000000..4e4f83e3b5 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5006000 @@ -0,0 +1,151 @@ +5.006000 +PERL_SYS_INIT3 # U +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 +av_delete # U +av_exists # U +call_atexit # E +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_alnumc # U +is_uni_alnumc_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_alnumc # 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 +tmps_grow # 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/cpan/Devel-PPPort/parts/todo/5006001 b/cpan/Devel-PPPort/parts/todo/5006001 new file mode 100644 index 0000000000..3f4ea792ff --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/parts/todo/5006002 b/cpan/Devel-PPPort/parts/todo/5006002 new file mode 100644 index 0000000000..dfe09ce2c5 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5006002 @@ -0,0 +1 @@ +5.006002 diff --git a/cpan/Devel-PPPort/parts/todo/5007000 b/cpan/Devel-PPPort/parts/todo/5007000 new file mode 100644 index 0000000000..49d08465db --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5007000 @@ -0,0 +1 @@ +5.007000 diff --git a/cpan/Devel-PPPort/parts/todo/5007001 b/cpan/Devel-PPPort/parts/todo/5007001 new file mode 100644 index 0000000000..f8f9664f8e --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5007001 @@ -0,0 +1,19 @@ +5.007001 +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_uvuni # U +uvuni_to_utf8 # U diff --git a/cpan/Devel-PPPort/parts/todo/5007002 b/cpan/Devel-PPPort/parts/todo/5007002 new file mode 100644 index 0000000000..cb28d72bf3 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/parts/todo/5007003 b/cpan/Devel-PPPort/parts/todo/5007003 new file mode 100644 index 0000000000..2271d2bcd9 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5007003 @@ -0,0 +1,62 @@ +5.007003 +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_copypv # 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 +to_utf8_fold # U +to_utf8_lower # E (Perl_to_utf8_lower) +to_utf8_title # E (Perl_to_utf8_title) +to_utf8_upper # E (Perl_to_utf8_upper) +unpack_str # U +uvchr_to_utf8_flags # U +uvuni_to_utf8_flags # U +vdeb # U diff --git a/cpan/Devel-PPPort/parts/todo/5008000 b/cpan/Devel-PPPort/parts/todo/5008000 new file mode 100644 index 0000000000..a22b04eb81 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5008000 @@ -0,0 +1,5 @@ +5.008000 +hv_iternext_flags # U +hv_store_flags # U +is_utf8_idcont # U +nothreadhook # U diff --git a/cpan/Devel-PPPort/parts/todo/5008001 b/cpan/Devel-PPPort/parts/todo/5008001 new file mode 100644 index 0000000000..ddc9d09c43 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5008001 @@ -0,0 +1,14 @@ +5.008001 +SvVOK # U +doing_taint # U +find_runcv # U +is_utf8_string_loc # U +packlist # U +save_bool # U +savestack_grow_cnt # U +seed # U +sv_cat_decode # U +sv_compile_2op # E (Perl_sv_compile_2op) +sv_setpviv # U +sv_setpviv_mg # U +unpackstring # U diff --git a/cpan/Devel-PPPort/parts/todo/5008002 b/cpan/Devel-PPPort/parts/todo/5008002 new file mode 100644 index 0000000000..63aac525fe --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5008002 @@ -0,0 +1 @@ +5.008002 diff --git a/cpan/Devel-PPPort/parts/todo/5008003 b/cpan/Devel-PPPort/parts/todo/5008003 new file mode 100644 index 0000000000..50c6ce1aa1 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5008003 @@ -0,0 +1,3 @@ +5.008003 +SvIsCOW # U +SvIsCOW_shared_hash # U diff --git a/cpan/Devel-PPPort/parts/todo/5008004 b/cpan/Devel-PPPort/parts/todo/5008004 new file mode 100644 index 0000000000..bb7bcdf66a --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5008004 @@ -0,0 +1 @@ +5.008004 diff --git a/cpan/Devel-PPPort/parts/todo/5008005 b/cpan/Devel-PPPort/parts/todo/5008005 new file mode 100644 index 0000000000..7bd2029f4b --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5008005 @@ -0,0 +1 @@ +5.008005 diff --git a/cpan/Devel-PPPort/parts/todo/5008006 b/cpan/Devel-PPPort/parts/todo/5008006 new file mode 100644 index 0000000000..ba5cad07ed --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5008006 @@ -0,0 +1 @@ +5.008006 diff --git a/cpan/Devel-PPPort/parts/todo/5008007 b/cpan/Devel-PPPort/parts/todo/5008007 new file mode 100644 index 0000000000..7d656f0b9e --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5008007 @@ -0,0 +1 @@ +5.008007 diff --git a/cpan/Devel-PPPort/parts/todo/5008008 b/cpan/Devel-PPPort/parts/todo/5008008 new file mode 100644 index 0000000000..f17b19ff4b --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5008008 @@ -0,0 +1 @@ +5.008008 diff --git a/cpan/Devel-PPPort/parts/todo/5009000 b/cpan/Devel-PPPort/parts/todo/5009000 new file mode 100644 index 0000000000..28bc85958e --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/parts/todo/5009001 b/cpan/Devel-PPPort/parts/todo/5009001 new file mode 100644 index 0000000000..26d2c4c548 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/parts/todo/5009002 b/cpan/Devel-PPPort/parts/todo/5009002 new file mode 100644 index 0000000000..d00dcdac9b --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5009002 @@ -0,0 +1,8 @@ +5.009002 +SvPVbyte_force # U +find_rundefsvoffset # U +gv_fetchsv # U +op_refcnt_lock # U +op_refcnt_unlock # U +savesvpv # U +vnormal # U diff --git a/cpan/Devel-PPPort/parts/todo/5009003 b/cpan/Devel-PPPort/parts/todo/5009003 new file mode 100644 index 0000000000..6a69c9f043 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5009003 @@ -0,0 +1,25 @@ +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_p # U +hv_placeholders_set # U +hv_riter_p # U +hv_riter_set # U +is_utf8_string_loclen # U +newGIVENOP # U +newSVhek # U +newSVpvs_share # U +newWHENOP # U +newWHILEOP # E (Perl_newWHILEOP) +savepvs # U +sortsv_flags # U +vverify # U diff --git a/cpan/Devel-PPPort/parts/todo/5009004 b/cpan/Devel-PPPort/parts/todo/5009004 new file mode 100644 index 0000000000..0d6b7d5051 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5009004 @@ -0,0 +1,8 @@ +5.009004 +PerlIO_context_layers # U +gv_name_set # U +my_vsnprintf # U +newXS_flags # U +regclass_swash # E (Perl_regclass_swash) +sv_does # U +sv_usepvn_flags # U diff --git a/cpan/Devel-PPPort/parts/todo/5009005 b/cpan/Devel-PPPort/parts/todo/5009005 new file mode 100644 index 0000000000..8b84717446 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5009005 @@ -0,0 +1,30 @@ +5.009005 +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 +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 +re_intuit_start # E (Perl_re_intuit_start) +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/cpan/Devel-PPPort/parts/todo/5010000 b/cpan/Devel-PPPort/parts/todo/5010000 new file mode 100644 index 0000000000..737f374ef0 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/parts/todo/5011000 b/cpan/Devel-PPPort/parts/todo/5011000 new file mode 100644 index 0000000000..f58fa28417 --- /dev/null +++ b/cpan/Devel-PPPort/parts/todo/5011000 @@ -0,0 +1,27 @@ +5.011000 +HeUTF8 # U +MULTICALL # E +PERL_SYS_TERM # E +POP_MULTICALL # E +PUSH_MULTICALL # E +SvOOK_offset # U +av_iter_p # U +croak_xs_usage # U +fetch_cop_label # U +gv_fetchmethod_flags # U +hv_assert # U +mro_get_from_name # U +mro_get_private_data # U +mro_register # U +mro_set_mro # U +mro_set_private_data # U +pad_sv # U +pregfree2 # U +ref # U (Perl_ref) +save_adelete # U +save_helem_flags # U +save_padsv_and_mortalize # U +save_pushptr # U +stashpv_hvname_match # U +sv_insert_flags # U +sv_utf8_upgrade_flags_grow # U diff --git a/cpan/Devel-PPPort/ppport_h.PL b/cpan/Devel-PPPort/ppport_h.PL new file mode 100644 index 0000000000..e652c352d9 --- /dev/null +++ b/cpan/Devel-PPPort/ppport_h.PL @@ -0,0 +1,25 @@ +################################################################################ +# +# ppport_h.PL -- generate ppport.h +# +################################################################################ +# +# $Revision: 7 $ +# $Author: mhx $ +# $Date: 2006/06/25 03:41:08 +0200 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2006, 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/cpan/Devel-PPPort/soak b/cpan/Devel-PPPort/soak new file mode 100644 index 0000000000..1e9807068c --- /dev/null +++ b/cpan/Devel-PPPort/soak @@ -0,0 +1,606 @@ +#!/usr/bin/perl -w +################################################################################ +# +# soak -- Test Perl modules with multiple Perl releases. +# +# Original Author: Paul Marquess +# +################################################################################ +# +# $Revision: 19 $ +# $Author: mhx $ +# $Date: 2009/01/18 14:10:50 +0100 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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 = do { my @r = '$Snapshot: /Devel-PPPort/3.19 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; + +$| = 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-2009, 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/cpan/Devel-PPPort/t/HvNAME.t b/cpan/Devel-PPPort/t/HvNAME.t new file mode 100644 index 0000000000..f54fac2c89 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/MY_CXT.t b/cpan/Devel-PPPort/t/MY_CXT.t new file mode 100644 index 0000000000..a94bd386c4 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/SvPV.t b/cpan/Devel-PPPort/t/SvPV.t new file mode 100644 index 0000000000..63c7d72c43 --- /dev/null +++ b/cpan/Devel-PPPort/t/SvPV.t @@ -0,0 +1,116 @@ +################################################################################ +# +# !!!!! 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 (47) { + load(); + plan(tests => 47); + } +} + +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++); + +$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); + +my $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; +($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/cpan/Devel-PPPort/t/SvREFCNT.t b/cpan/Devel-PPPort/t/SvREFCNT.t new file mode 100644 index 0000000000..0b46a51793 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/Sv_set.t b/cpan/Devel-PPPort/t/Sv_set.t new file mode 100644 index 0000000000..77a7a860db --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/call.t b/cpan/Devel-PPPort/t/call.t new file mode 100644 index 0000000000..4d3e80e4c8 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/cop.t b/cpan/Devel-PPPort/t/cop.t new file mode 100644 index 0000000000..1162a5ed50 --- /dev/null +++ b/cpan/Devel-PPPort/t/cop.t @@ -0,0 +1,62 @@ +################################################################################ +# +# !!!!! 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 (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 $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); + diff --git a/cpan/Devel-PPPort/t/exception.t b/cpan/Devel-PPPort/t/exception.t new file mode 100644 index 0000000000..c432df6e69 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/format.t b/cpan/Devel-PPPort/t/format.t new file mode 100644 index 0000000000..a25ede533f --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/grok.t b/cpan/Devel-PPPort/t/grok.t new file mode 100644 index 0000000000..b807ce8ccd --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/gv.t b/cpan/Devel-PPPort/t/gv.t new file mode 100644 index 0000000000..3bf9ce6cef --- /dev/null +++ b/cpan/Devel-PPPort/t/gv.t @@ -0,0 +1,54 @@ +################################################################################ +# +# !!!!! 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 (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::GvSVn(), 1); + +ok(Devel::PPPort::isGV_with_GP(), 2) + diff --git a/cpan/Devel-PPPort/t/limits.t b/cpan/Devel-PPPort/t/limits.t new file mode 100644 index 0000000000..ed1cb2e3ac --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/mPUSH.t b/cpan/Devel-PPPort/t/mPUSH.t new file mode 100644 index 0000000000..2f38276828 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/magic.t b/cpan/Devel-PPPort/t/magic.t new file mode 100644 index 0000000000..23b19ed438 --- /dev/null +++ b/cpan/Devel-PPPort/t/magic.t @@ -0,0 +1,95 @@ +################################################################################ +# +# !!!!! 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 (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; + +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'); + +my $ver = eval qq[qv("v1.2.0")]; +ok($[ < 5.009 || $@ eq ''); +ok($@ || 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/cpan/Devel-PPPort/t/memory.t b/cpan/Devel-PPPort/t/memory.t new file mode 100644 index 0000000000..501b819864 --- /dev/null +++ b/cpan/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(), 4); + diff --git a/cpan/Devel-PPPort/t/misc.t b/cpan/Devel-PPPort/t/misc.t new file mode 100644 index 0000000000..9dcc565547 --- /dev/null +++ b/cpan/Devel-PPPort/t/misc.t @@ -0,0 +1,127 @@ +################################################################################ +# +# !!!!! 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 (39) { + load(); + plan(tests => 39); + } +} + +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) { + eval q{ + 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); + diff --git a/cpan/Devel-PPPort/t/newCONSTSUB.t b/cpan/Devel-PPPort/t/newCONSTSUB.t new file mode 100644 index 0000000000..cb207a4587 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/newRV.t b/cpan/Devel-PPPort/t/newRV.t new file mode 100644 index 0000000000..731a62b1f6 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/newSV_type.t b/cpan/Devel-PPPort/t/newSV_type.t new file mode 100644 index 0000000000..1b3233e5ce --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/newSVpv.t b/cpan/Devel-PPPort/t/newSVpv.t new file mode 100644 index 0000000000..d14a53fbe8 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/podtest.t b/cpan/Devel-PPPort/t/podtest.t new file mode 100644 index 0000000000..c1a35b20a0 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/ppphtest.t b/cpan/Devel-PPPort/t/ppphtest.t new file mode 100644 index 0000000000..ae97b74171 --- /dev/null +++ b/cpan/Devel-PPPort/t/ppphtest.t @@ -0,0 +1,930 @@ +################################################################################ +# +# !!!!! 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'}) { + 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 (235) { + load(); + plan(tests => 235); + } +} + +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 .. 235) { + 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")); + +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/cpan/Devel-PPPort/t/pv_tools.t b/cpan/Devel-PPPort/t/pv_tools.t new file mode 100644 index 0000000000..e53beed0a0 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/pvs.t b/cpan/Devel-PPPort/t/pvs.t new file mode 100644 index 0000000000..7886096615 --- /dev/null +++ b/cpan/Devel-PPPort/t/pvs.t @@ -0,0 +1,71 @@ +################################################################################ +# +# !!!!! 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 (11) { + load(); + plan(tests => 11); + } +} + +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"); + +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_fetchpvn_flags(), \*Devel::PPPort::VERSION); +ok(Devel::PPPort::gv_fetchpvs(), \*Devel::PPPort::VERSION); +ok(Devel::PPPort::gv_stashpvs(), \%Devel::PPPort::); + diff --git a/cpan/Devel-PPPort/t/shared_pv.t b/cpan/Devel-PPPort/t/shared_pv.t new file mode 100644 index 0000000000..eac79c6ca8 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/snprintf.t b/cpan/Devel-PPPort/t/snprintf.t new file mode 100644 index 0000000000..0b90004d9e --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/sprintf.t b/cpan/Devel-PPPort/t/sprintf.t new file mode 100644 index 0000000000..8b0d51fc91 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/strlfuncs.t b/cpan/Devel-PPPort/t/strlfuncs.t new file mode 100644 index 0000000000..c8175472de --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/sv_xpvf.t b/cpan/Devel-PPPort/t/sv_xpvf.t new file mode 100644 index 0000000000..15074317df --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/testutil.pl b/cpan/Devel-PPPort/t/testutil.pl new file mode 100644 index 0000000000..4fc7d667a6 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/threads.t b/cpan/Devel-PPPort/t/threads.t new file mode 100644 index 0000000000..a1c8caa5c8 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/uv.t b/cpan/Devel-PPPort/t/uv.t new file mode 100644 index 0000000000..bc123c6bbf --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/variables.t b/cpan/Devel-PPPort/t/variables.t new file mode 100644 index 0000000000..ef1ac8b20d --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/t/warn.t b/cpan/Devel-PPPort/t/warn.t new file mode 100644 index 0000000000..d538055a65 --- /dev/null +++ b/cpan/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/cpan/Devel-PPPort/typemap b/cpan/Devel-PPPort/typemap new file mode 100644 index 0000000000..7225c4076d --- /dev/null +++ b/cpan/Devel-PPPort/typemap @@ -0,0 +1,41 @@ +################################################################################ +# +# typemap -- XS type mappings not present in early perls +# +################################################################################ +# +# $Revision: 9 $ +# $Author: mhx $ +# $Date: 2009/06/12 04:07:19 +0200 $ +# +################################################################################ +# +# Version 3.x, Copyright (C) 2004-2009, 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 + +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); |