eval $checkccflag
;;
esac
+ case "$gccversion" in
+ 1*) ;;
+ 2*) ;;
+ ?*) echo " "
+ echo "Checking if your compiler accepts -fno-delete-null-pointer-checks" 2>&1
+ echo 'int main(void) { return 0; }' > gcctest.c
+ if $cc -O2 -fno-delete-null-pointer-checks -o gcctest gcctest.c; then
+ echo "Yes, it does." 2>&1
+ case "$ccflags" in
+ *delete-null-pointer-checks*)
+ echo "Leaving current flags $ccflags alone." 2>&1
+ ;;
+ *) dflt="$dflt -fno-delete-null-pointer-checks" ;;
+ esac
+ else
+ echo "Nope, it doesn't, but that's ok." 2>&1
+ fi
+ ;;
+ esac
# For gcc, adding -pipe speeds up compilations for some, but apparently
# some assemblers can't read from stdin. (It also slows down compilations
# in other cases, but those are apparently rarer these days.) AD 5/2004.
;;
esac
-randfunc=Perl_drand48
-drand01="Perl_drand48()"
-seedfunc="Perl_drand48_init"
+randfunc=drand48
+drand01="drand48()"
+seedfunc="srand48"
randbits=48
randseedtype=U32
find_extensions='
for xxx in *; do
case "$xxx" in
+ CVS) ;;
DynaLoader|dynaload) ;;
*)
this_ext=`echo "$xxx" | $sed -e s/-/\\\//g`;
nonxs_ext=''
for xxx in $nonxs_extensions ; do
case "$xxx" in
+ CVS|RCS|SCCS|.svn)
+ ;;
VMS*)
;;
*) nonxs_ext="$nonxs_ext $xxx"
Changes Describe how to peruse changes between releases
charclass_invlists.h Compiled-in inversion lists
CODE_OF_CONDUCT.md Information on where to find the Standards of Conduct
+config.over Site-specific overrides for Configure defaults
config_h.SH Produces config.h
configpm Produces lib/Config.pm
Configure Portability tool
cpan/NEXT/t/next.t NEXT
cpan/NEXT/t/stringify.t NEXT
cpan/NEXT/t/unseen.t NEXT
+cpan/OpenBSD-MkTemp/lib/OpenBSD/MkTemp.pm OpenBSD::MkTemp
+cpan/OpenBSD-MkTemp/MkTemp.xs OpenBSD::MkTemp
+cpan/OpenBSD-MkTemp/README OpenBSD::MkTemp Readme
+cpan/OpenBSD-MkTemp/t/OpenBSD-MkTemp.t OpenBSD::MkTemp test file
+cpan/OpenBSD-Pledge/lib/OpenBSD/Pledge.pm OpenBSD::Pledge
+cpan/OpenBSD-Pledge/Pledge.xs OpenBSD::Pledge
+cpan/OpenBSD-Pledge/t/OpenBSD-Pledge.t OpenBSD::Pledge test file
+cpan/OpenBSD-Unveil/lib/OpenBSD/Unveil.pm OpenBSD::Unveil
+cpan/OpenBSD-Unveil/t/OpenBSD-Unveil.t OpenBSD::Unveil test file
+cpan/OpenBSD-Unveil/Unveil.xs OpenBSD::Unveil
cpan/Params-Check/lib/Params/Check.pm Params::Check
cpan/Params-Check/t/01_Params-Check.t Params::Check tests
cpan/parent/lib/parent.pm Establish an ISA relationship with base classes at compile time
cpan/Term-ANSIColor/t/taint/basic.t
cpan/Term-Cap/Cap.pm Perl module supporting termcap usage
cpan/Term-Cap/test.pl See if Term::Cap works
+cpan/Term-ReadKey/Changes Term::ReadKey
+cpan/Term-ReadKey/Configure.pm Term::ReadKey
+cpan/Term-ReadKey/example/test.pl Term::ReadKey
+cpan/Term-ReadKey/genchars.pl Term::ReadKey
+cpan/Term-ReadKey/Makefile.PL Term::ReadKey
+cpan/Term-ReadKey/ppport.h Term::ReadKey
+cpan/Term-ReadKey/ReadKey.xs Term::ReadKey
+cpan/Term-ReadKey/ReadKey.pm.PL Term::ReadKey
+cpan/Term-ReadKey/README Term::ReadKey
+cpan/Term-ReadKey/t/01_basic.t Term::ReadKey
+cpan/Term-ReadKey/t/02_terminal_functions.t Term::ReadKey
cpan/Test-Harness/bin/prove The prove harness utility
cpan/Test-Harness/lib/App/Prove.pm Gubbins for the prove utility
cpan/Test-Harness/lib/App/Prove/State.pm Gubbins for the prove utility
ext/B/B/Terse.pm Compiler Terse backend
ext/B/B/Xref.pm Compiler Xref backend
ext/B/hints/darwin.pl Hints for named architecture
-ext/B/hints/openbsd.pl Hints for named architecture
ext/B/Makefile.PL Compiler backend makefile writer
ext/B/O.pm Compiler front-end module (-MO=...)
ext/B/t/b.t See if B works
feature.h Feature header
form.h Public declarations for formats
generate_uudmap.c Generate uudmap.h, the uuencode decoding map
+git_version.h Pre-generated git_version.h for OpenBSD
globals.c File to declare global symbols (for shared library)
globvar.sym Global variables that need hiding when embedded
gv.c Glob value code
lib/Config.t See if Config works
lib/Config/Extensions.pm Convenient hash lookup for built extensions
lib/Config/Extensions.t See if Config::Extensions works
+lib/Config_git.pl Pre-generated Config_git.pl for OpenBSD
lib/CORE.pod document the CORE namespace
lib/DB.pm Debugger API (draft)
lib/DB.t See if DB works
cpan/Pod-Simple/pm_to_blib: dist/if/pm_to_blib
ext/Pod-Functions/pm_to_blib: cpan/Pod-Simple/pm_to_blib cpan/Pod-Escapes/pm_to_blib pod/perlfunc.pod
cpan/IO-Compress/pm_to_blib: dist/lib/pm_to_blib
+lib/auto/Term/ReadKey/ReadKey.so: lib/auto/Cwd/Cwd.so
'
for f in $dynamic_ext; do
: the dependency named here will never exist
## In the following dollars and backticks do not need the extra backslash.
$spitshell >>$Makefile <<!GROK!THIS!
-private = preplibrary \$(CONFIGPM) \$(CONFIGPOD) git_version.h lib/buildcustomize.pl
+private = preplibrary \$(CONFIGPM) \$(CONFIGPOD) lib/buildcustomize.pl
# Files to be built with variable substitution before miniperl
# is available.
.PHONY: all utilities
+# OpenBSD uses pre-generated lib/Config_git.pl and git_version.h files
# Both git_version.h and lib/Config_git.pl are built
# by make_patchnum.pl.
-git_version.h: lib/Config_git.pl
-
-lib/Config_git.pl: $(MINIPERL_EXE) make_patchnum.pl
- $(MINIPERL) make_patchnum.pl
-
-# make sure that we recompile perl.c if the git version changes
-perl$(OBJ_EXT): git_version.h
+#git_version.h: lib/Config_git.pl
+#
+#lib/Config_git.pl: $(MINIPERL_EXE) make_patchnum.pl
+# $(MINIPERL) make_patchnum.pl
+#
+## make sure that we recompile perl.c if the git version changes
+#perl$(OBJ_EXT): git_version.h
!NO!SUBS!
unidatafiles $(unidatafiles) pod/perluniprops.pod: uni.data
uni.data: $(MINIPERL_EXE) $(CONFIGPM) lib/unicore/mktables $(nonxs_ext)
- $(MINIPERL) lib/unicore/mktables -C lib/unicore -P pod -maketest -makelist -p
-# Commented out so always runs, mktables looks at far more files than we
-# can in this makefile to decide if needs to run or not
-# touch uni.data
+ touch uni.data
# $(PERL_EXE) and ext because pod_lib.pl needs Digest::MD5
# But also this ensures that all extensions are built before we try to scan
-rm -f *perl.xok
-rm -f cygwin.c libperl*.def libperl*.dll cygperl*.dll *.exe.stackdump
-rm -f $(PERL_EXE) $(MINIPERL_EXE) $(LIBPERL) libperl.* microperl
- -rm -f config.arch config.over $(DTRACE_H)
+ -rm -f $(DTRACE_H)
_cleaner1:
-cd os2; rm -f Makefile
-rmdir lib/TAP/Formatter lib/TAP lib/Sys/Syslog lib/Sys lib/Sub
-rmdir lib/Search lib/Scalar lib/Pod/Text lib/Pod/Simple
-rmdir lib/Pod/Perldoc lib/Pod/Html lib/PerlIO/via lib/PerlIO lib/Perl
- -rmdir lib/Parse/CPAN lib/Parse lib/Params lib/Net/FTP lib/Module/Load
- -rmdir lib/Module/CoreList lib/Module lib/Memoize lib/Math/BigRat
- -rmdir lib/Math/BigInt lib/Math/BigFloat lib/Math lib/MIME
- -rmdir lib/Locale/Maketext lib/Locale lib/List/Util lib/List
+ -rmdir lib/Parse/CPAN lib/Parse lib/Params lib/OpenBSD lib/Net/FTP
+ -rmdir lib/Module/Load lib/Module/CoreList lib/Module lib/Memoize
+ -rmdir lib/Math/BigRat lib/Math/BigInt lib/Math/BigFloat lib/Math
+ -rmdir lib/MIME lib/Locale/Maketext lib/Locale lib/List/Util lib/List
-rmdir lib/JSON/PP lib/JSON lib/IPC lib/IO/Uncompress/Adapter
-rmdir lib/IO/Uncompress lib/IO/Socket lib/IO/Compress/Zlib
-rmdir lib/IO/Compress/Zip lib/IO/Compress/Gzip lib/IO/Compress/Base
-# $OpenBSD: Makefile.bsd-wrapper,v 1.112 2022/04/12 02:54:51 afresh1 Exp $
+# $OpenBSD: Makefile.bsd-wrapper,v 1.113 2023/02/15 01:38:20 afresh1 Exp $
#
# Build wrapper for Perl
#
test: all
${MAKE} test
+test_harness: all
+ ${MAKE} test_harness
+
clean:
-@test ! -e Makefile || ${MAKE} realclean
.for page sect file in \
corelist 1 utils/corelist \
cpan 1 utils/cpan \
+ DebugWrap 1 lib/perl5db.t \
enc2xs 1 utils/enc2xs \
encguess 1 utils/encguess \
h2ph 1 utils/h2ph \
perl5303delta 1 pod/perl5303delta.pod \
perl5320delta 1 pod/perl5320delta.pod \
perl5321delta 1 pod/perl5321delta.pod \
+ perl5340delta 1 pod/perl5340delta.pod \
+ perl5341delta 1 pod/perl5341delta.pod \
+ perl5360delta 1 pod/perl5360delta.pod \
perl561delta 1 pod/perl561delta.pod \
perl56delta 1 pod/perl56delta.pod \
perl581delta 1 pod/perl581delta.pod \
perldeprecation 1 pod/perldeprecation.pod \
perldiag 1 pod/perldiag.pod \
perldoc 1 lib/perldoc.pod \
+ perldocstyle 1 pod/perldocstyle.pod \
perldsc 1 pod/perldsc.pod \
perlembed 1 pod/perlembed.pod \
perlexperiment 1 pod/perlexperiment.pod \
pod2man 1 cpan/podlators/blib/script/pod2man \
pod2text 1 cpan/podlators/blib/script/pod2text \
pod2usage 1 cpan/Pod-Usage/blib/script/pod2usage \
+ podbuildtoc 1 pod/buildtoc \
podchecker 1 cpan/Pod-Checker/blib/script/podchecker \
prove 1 utils/prove \
splain 1 utils/splain \
streamzip 1 utils/streamzip \
- xsubpp 1 lib/ExtUtils/xsubpp \
+ xsubpp 1 utils/xsubpp \
AnyDBM_File 3p lib/AnyDBM_File.pm \
App::Cpan 3p lib/App/Cpan.pm \
App::Prove 3p lib/App/Prove.pm \
B::Xref 3p lib/B/Xref.pm \
base 3p lib/base.pm \
Benchmark 3p lib/Benchmark.pm \
+ bigfloat 3p lib/bigfloat.pm \
bigint 3p lib/bigint.pm \
bignum 3p lib/bignum.pm \
bigrat 3p lib/bigrat.pm \
blib 3p lib/blib.pm \
+ builtin 3p lib/builtin.pm \
bytes 3p lib/bytes.pm \
Carp 3p lib/Carp.pm \
charnames 3p lib/charnames.pm \
ExtUtils::MM_MacOS 3p lib/ExtUtils/MM_MacOS.pm \
ExtUtils::MM_NW5 3p lib/ExtUtils/MM_NW5.pm \
ExtUtils::MM_OS2 3p lib/ExtUtils/MM_OS2.pm \
+ ExtUtils::MM_OS390 3p lib/ExtUtils/MM_OS390.pm \
ExtUtils::MM_QNX 3p lib/ExtUtils/MM_QNX.pm \
ExtUtils::MM_Unix 3p lib/ExtUtils/MM_Unix.pm \
ExtUtils::MM_UWIN 3p lib/ExtUtils/MM_UWIN.pm \
ExtUtils::ParseXS::Constants 3p lib/ExtUtils/ParseXS/Constants.pm \
ExtUtils::ParseXS::Eval 3p lib/ExtUtils/ParseXS/Eval.pm \
ExtUtils::ParseXS::Utilities 3p lib/ExtUtils/ParseXS/Utilities.pm \
+ ExtUtils::PL2Bat 3p lib/ExtUtils/PL2Bat.pm \
ExtUtils::testlib 3p lib/ExtUtils/testlib.pm \
ExtUtils::Typemaps 3p lib/ExtUtils/Typemaps.pm \
ExtUtils::Typemaps::Cmd 3p lib/ExtUtils/Typemaps/Cmd.pm \
Pod::Escapes 3p lib/Pod/Escapes.pm \
Pod::Functions 3p lib/Pod/Functions.pm \
Pod::Html 3p lib/Pod/Html.pm \
+ Pod::Html::Util 3p lib/Pod/Html/Util.pm \
Pod::Man 3p lib/Pod/Man.pm \
Pod::ParseLink 3p lib/Pod/ParseLink.pm \
Pod::Perldoc 3p lib/Pod/Perldoc.pm \
Test2::API::Breakage 3p lib/Test2/API/Breakage.pm \
Test2::API::Context 3p lib/Test2/API/Context.pm \
Test2::API::Instance 3p lib/Test2/API/Instance.pm \
+ Test2::API::InterceptResult 3p lib/Test2/API/InterceptResult.pm \
+ Test2::API::InterceptResult::Event 3p lib/Test2/API/InterceptResult/Event.pm \
+ Test2::API::InterceptResult::Hub 3p lib/Test2/API/InterceptResult/Hub.pm \
+ Test2::API::InterceptResult::Squasher 3p lib/Test2/API/InterceptResult/Squasher.pm \
Test2::API::Stack 3p lib/Test2/API/Stack.pm \
Test2::Event 3p lib/Test2/Event.pm \
Test2::Event::Bail 3p lib/Test2/Event/Bail.pm \
lib/vmsish.{pm,t}
],
},
+ 'openbsd' => {
+ 'FILES' => q[lib/Config_git.pl],
+ },
);
# legacy CPAN flag
5.004_07 to 5.004_08 patch as an example.
# unpack perl5.004_07/
- gzip -d -c perl5.004_07.tar.gz | tar -xof -
+ gzip -d -c perl5.004_07.tar.gz | tar -xf -
# unpack perl5.004_08/
- gzip -d -c perl5.004_08.tar.gz | tar -xof -
+ gzip -d -c perl5.004_08.tar.gz | tar -xf -
makepatch perl5.004_07 perl5.004_08 > perl5.004_08.pat
Makepatch will automatically generate appropriate B<rm> commands to remove
}
if ($orig_config_txt ne $config_txt or $orig_heavy_txt ne $heavy_txt) {
+ # During the build don't look in /usr/local for libs or includes
+ # but after, we want to let modules look there.
+ my $install_heavy_txt = $heavy_txt;
+ $install_heavy_txt =~ s,^(ccflags|cppflags)[^=]*='[^']+,$& -I/usr/local/include,gm;
+ $install_heavy_txt =~ s,^(ldflags|lddlflags)[^=]*='[^']+,$& -L/usr/local/lib,gm;
+
+ open INSTALL_CONFIG_HEAVY, ">", "$Config_heavy.install"
+ or die "Can't open install $Config_heavy: $!\n";
+ print INSTALL_CONFIG_HEAVY $install_heavy_txt;
+ close INSTALL_CONFIG_HEAVY;
+ print "updated install $Config_heavy\n";
+
open CONFIG, ">", $Config_PM or die "Can't open $Config_PM: $!\n";
open CONFIG_HEAVY, ">", $Config_heavy or die "Can't open $Config_heavy: $!\n";
print CONFIG $config_txt;
my $path = shift;
return undef
- if $path =~ /(~|\.bak|_bak)$/ ||
+ if $path =~ /^(?:RCS|CVS|SCCS|\.svn|_darcs)$/ ||
+ $path =~ /(~|\.bak|_bak)$/ ||
$path =~ /\..*\.sw(o|p)$/ ||
$path =~ /\B\.svn\b/;
--- /dev/null
+CHANGES
+-------
+
+ 2.202 27 June 2022
+
+ * Z_NULL should be 'UV' rather than 'PV'
+ https://github.com/pmqs/Compress-Raw-Zlib/issues/17
+ Sun Jun 26 22:02:04 2022 +0100
+ de28f0335d3d605d696b19d43fc48de42272455c
+
+ 2.201 25 June 2022
+
+ * 2.021
+ Sat Jun 25 08:42:46 2022 +0100
+ 85416cab509c18c5fa3f923de7b45b6c7c0f7a6f
+
+ * 2.201
+ Sat Jun 25 08:39:26 2022 +0100
+ b3d63862b2ff4ac9d28e23be500c0d32ad69dd11
+
+ * More zlib-ng updates
+ Thu Jun 23 22:42:13 2022 +0100
+ 313f626425181702b5fc80af2b6ea7eed41d5a9d
+
+ * Fix test count regression in t/07bufsize.t (#16)
+ Wed Jun 22 09:45:11 2022 +0100
+ 98dc5b4a2b30c26752b6f686462b06b8db72a5e4
+
+ 2.200 21 June 2022
+
+ * Added zlib-ng support
+ https://github.com/pmqs/Compress-Raw-Zlib/issues/9
+
+ * Only set Z_SOLO when building zlib sources https://github.com/pmqs/Compress-Raw-Zlib/issues/12
+ Tue Jun 7 10:13:00 2022 +0100
+ c44e0b732e214b7f77d42a3af6ae64ef944cee90
+
+ 2.105 14 April 2022
+
+ * Add Compress::Raw::Zlib::VERSION to output
+ Sat May 14 15:16:57 2022 +0100
+ 3e22c93169a67986017f64d9a2e5085c417d8624
+
+ * Dump version info when running test harness
+ Sat May 14 15:10:17 2022 +0100
+ ca9f33ba0323d0abc91a83800636f180b2b44162
+
+ * Fix use of ZLIB_INCLUDE/LIB
+ Sat May 14 09:01:38 2022 +0100
+ 8a7d4a97d7441b61a8a888342766419044fa5a33
+
+ * More fixes for BUILD_ZLIB off
+ Sat May 14 08:54:04 2022 +0100
+ 2d9650094dab90858ef58bfbda62f3bc60e159e4
+
+ * Add BUILD_ZLIB to the matrix
+ Sat May 14 08:31:54 2022 +0100
+ b61b92fc9d06bf04f1adec337357ffbd39535901
+
+ * Merge branch 'master' of https://github.com/pmqs/Compress-Raw-Zlib
+ Sat May 14 08:27:14 2022 +0100
+ 3ac7d0d3d45ae263402fab1ebb3835e2ae16c5a6
+
+ * Fix for BUILD_ZLIB disabled
+ Sat May 14 08:25:34 2022 +0100
+ b0f04e37fb58a34ef01767ad16a8f63ca868eec6
+
+ * Add BUILD_ZLIB to the matrix
+ Sat May 14 08:22:56 2022 +0100
+ aa8f5ff981c7305c995d4e2f798ae0d7d45866a5
+
+ 2.104 13 April 2022
+
+ * Merge pull request #11 from monkburger/symbol_fix_2
+ Fri May 13 07:17:19 2022 +0100
+ 64aea2d3f78946d7df4096eadfa0d7267f4439a5
+
+ * perl_crz -> Perl_crz
+ Tue May 3 18:19:24 2022 +0000
+ 20502e6c2eba8ddcad80b20574e840457c0cb369
+
+ * This is a slightly different way to fix https://github.com/pmqs/Compress-Raw-Zlib/issues/8
+ Tue May 3 18:06:48 2022 +0000
+ d9cd27fb212da7455b6ba44729ca11bb441f3950
+
+ * add tests for crc32/adler32_combine
+ Mon May 2 16:18:13 2022 +0100
+ dcfe9ef439790f1a4fae81cf3eac38cfeb848294
+
+ 2.103 3 April 2022
+
+ * Sync upstream fix for CVE-2018-25032
+ https://github.com/advisories/GHSA-jc36-42cf-vqwj
+
+ Update to Zlib 1.2.12
+ d507f527768f6cbab5831ed3ec17fe741163785c
+
+ Fix for inflateSync return code change
+ f47ea5f36c40fe19efe404dd75fd790b115de596
+
+ Fix for incorrect CRC from zlib 1.2.12.1
+ https://github.com/madler/zlib/commit/ec3df00224d4b396e2ac6586ab5d25f673caa4c2
+ 60104e3a162a116548303861ae0811fb850e65fd
+
+ * AUTHOR doesn't contain the stated information
+ bf5a03c1b440c8d9e41cffb344bf889794cc532b
+
+
+ 2.101 20 February 2021
+
+ * fix version numbers in meta files
+
+ 2.100 7 January 2021
+
+ * trim whitespace
+ 5de62cd3987c736c14d1aa804936808fbc1fe9cb
+
+ 2.096 31 July 2020
+
+ * No changes
+
+ 2.095 19 July 2020
+
+ * No changes
+
+ 2.094 13 July 2020
+
+ * Issue with Append mode & SvOOK
+ https://github.com/pmqs/Compress-Raw-Zlib/issues/3
+ 80ee0524012f46c5984c2d57649af0b07f82c750
+
+ 2.093 7 December 2019
+
+ * No Changes
+
+ 2.092 4 December 2019
+
+ * No Changes
+
+ 2.091 23 November 2019
+
+ * Silence "macro expands to multiple statements" warning
+ Change sourced upstream from https://github.com/Perl/perl5/issues/17013
+ https://github.com/pmqs/Compress-Raw-Zlib/issues/2
+ da2bd1fc765b80d01ed10a79b6c4a035e5095ed8
+
+ 2.090 9 November 2019
+
+ * No Changes
+
+ 2.089 3 November 2019
+
+ * No Changes
+
+ 2.088 31 October 2019
+
+ * Add SUPPORT section
+ d348ad76c2073a2973d094891fbd0c2e24bf397d
+
+ * 000prereq.t: dump Perl version
+ e1afe502818cb1ccf5bad917b14b029b408f47f1
+
+ 2.087 10 August 2019
+
+ * clang warning in ppport.h
+ update to latest ppport.h
+ https://github.com/pmqs/Compress-Raw-Zlib/issues/1
+ 664a5fbacf778acdd4cfbcc571997f3df5ee43d3
+
+ 2.086 31 March 2019
+
+ * Moved source to github https://github.com/pmqs/Compress-Raw-Zlib
+
+ * Add META_MERGE to Makefile.PL
+
+ * Added meta-json.t & meta-yaml.t
+
+ 2.084 5 January 2019
+
+ * No Changes
+
+ 2.083 30 December 2018
+
+ * No Changes
+
+ 2.081 4 April 2018
+
+ * previous release used $^W instead of use warnings. Fixed.
+
+ 2.080 2 April 2018
+
+ * No Changes
+
+ 2.076 21 Nov 2017
+
+ * Zlib.xs
+ Silence gcc compiler warnings when -Wsign-compare is enabled
+ #123688: Compilation warnings with clang
+
+ * zlib-src/inflate.c and zlib-src/infback.c
+ Silence gcc compiler warnings when -Wimplicit-fallthrough is enabled
+ #123358: Compilation warnings with gcc-7.*
+
+ * Makefile.PL
+ Windows uses -lzlib. Linux uses -lz
+ #123699: wrong external zlib name used on Windows
+
+ 2.075 14 Nov 2017
+
+ * Update zlib-src directory to use zlib 1.2.11
+ #123245: perl 5.26.1 is vulnerable to CVE-2016-9843, CVE-2016-9841, CVE-2016-9840, CVE-2016-9842
+
+ * Zlib.xs
+ Don't allow offset to be greater than length of buffer in crc32.
+
+ * Zlib.xs
+ Change my_zcalloc to use safecalloc.
+ The link, https://github.com/madler/zlib/issues/253, is the upstream report for the remaining
+ valgrind errors not already dealt with by 1.2.11. Using calloc in Zlib.xs for now as a workaround.
+ #121074: valgrind errors in the test suite
+
+ 2.074 19 Feb 2017
+
+ * Fix bad 2.073 release
+
+ 2.073 18 Feb 2017
+
+ * Zlib.xs
+ Comment out unused variables & remove C++-ism
+ #120272: [PATCH] Unbreak compilation
+
+ 2.072 12 Feb 2017
+
+ * Makefile.PL
+ #120084: Need Fix for Makefile.PL depending on . in @INC
+
+ * zlib-src
+ #120207: inflateUndermine: subvert arg conditionally used/unused
+
+ * zlib-src
+ #112829: two gcc6-found problems
+
+ * fix deflateParams for zlib > 1.2.8
+ #119762: Tests broken with zlib-1.2.10
+
+ 2.071 30 Dec 2016
+
+ * #119580 (inflate.c: One (last?) compilation warning)
+ Identical issue reeported in upstream zlib
+ https://github.com/madler/zlib/issues/111
+
+ Fix checked into zlib dev codeline via
+ https://github.com/madler/zlib/commit/2edb94a3025d288dc251bc6cbb2c02e60fbd7438
+
+ 2.070 28 Dec 2016
+
+ * #107642: compilation warning from inflate.c
+
+ * #119007: [PATCH] Wrong FLAG_APPEND logic analog to Bzip2
+
+ 2.069 26 Sept 2015
+
+ * reduce compiler warnings and stderr noise
+ [#101341]
+
+ * amigaos4: cpan/Compress-Raw-Zlib: also __amigaos4__
+ [#106799]
+
+ * const all global data
+ https://github.com/madler/zlib/commit/82e9dc60932bf2ce5422a5e76e66e5a05abd26e3
+ [#101298]
+
+ * Coverity finding: Unused value
+ https://github.com/madler/zlib/commit/9859a94c1002484ee5f824c05683a5b2484cbf49
+ [105414]
+
+ * Coverity findings
+ [102399]
+
+ * Coverity finding: Overlapping buffer in memory copy
+ [105413]
+
+ 2.068 10 Dec 2014
+
+ * Silence more compiler warnings
+
+ * Disable running of 07bufsize.y by default.
+ COMPRESS_ZLIB_RUN_MOST needs set to run them. Makes life more
+ bearable on legacy platforms
+
+
+ 2.067 8 Dec 2014
+
+ * Silence compiler warnings
+
+ 2.066 21 Sept 2014
+
+ * Another COW violation
+ [#98069]
+
+ * misleading nesting/indentation (found by Coverity)
+ [#95405]
+
+ 2.065 3 February 2014
+
+ * [PATCH] resolve c++ build failure in core
+ [#92657]
+
+ * gcc -g3: final link failed: Memory exhausted
+ [#88936]
+
+ 2.064 1 February 2014
+
+ * [PATCH] Handle non-PVs better
+ [#91558]
+
+ * Z_OK instead of Z_BUF_ERROR
+ [#92521]
+
+ 2.063 23 October 2013
+
+ * gcc -g3: final link failed: Memory exhausted
+ [#88936]
+
+ * Compress::Raw::Zlib uses AutoLoader for no reason
+ [#88260]
+
+ * Typo in Compress::Zlib _combine function documentation
+ [#89305]
+
+ 2.062 11 August 2013
+
+ * typo fix
+ [#86417]
+
+ 2.061 19 May 2013
+
+ * Include zlib 1.2.8 source.
+
+ * typo fix
+ [#85431]
+
+ * silence compiler warning by making 2nd parameter to
+ DispStream a const char*
+
+ * Mishandling of BUILD_ZLIB=0 option
+ [#85492]
+
+ 2.060 7 January 2013
+
+ * Mention SimpleZip in POD
+
+ 2.059 24 November 2012
+
+ * Copy-on-write support
+ [#81353]
+
+ 2.058 12 November 2012
+
+ * No Changes
+
+ 2.057 10 November 2012
+
+ * Compress::Raw::Zlib needs to use PERL_NO_GET_CONTEXT
+ [#80319]
+
+ * Install to 'site' instead of 'perl' when perl version is 5.11+
+ [#79812]
+
+ * update to ppport.h that includes SvPV_nomg_nolen
+ [#78079]
+
+ 2.056 10 August 2012
+
+ * Fix C++ build issue
+ Thanks to Karl Williamson for supplying the patch.
+
+ 2.055 4 August 2012
+
+ * Fix misuse of magic in API
+ [#78079]
+
+ 2.054 8 May 2012
+
+ * Build issue on Win32
+ [#77030]
+
+ 2.053 6 May 2012
+
+ * Include zlib 1.2.7 source.
+
+ 2.052 29 April 2012
+
+ * Fixed build issue when Perl is built with C++
+
+ 2.051 20 February 2012
+
+ * Bug in Compress::Raw::Zlib on Windows
+ [#75222]
+
+ 2.050 20 February 2012
+
+ * Build failure on Irix & Solaris.
+ [RT #69985]
+
+ 2.049 18 February 2012
+
+ * Include zlib 1.2.6 source.
+
+ 2.048 29 January 2012
+
+ * Set minimum zlib version to 1.2.0
+
+ 2.047 28 January 2012
+
+ * Allow flush to be called multiple times without any intermediate
+ call to deflate and still return Z_OK.
+ In the code below $status was Z_BUF_ERROR before this change.
+
+ $def->flush(...);
+ $status = $def->flush(...);
+
+ * Added support for zlibCompileFlags
+
+ * Set minimum Perl version to 5.6
+
+ 2.045 3 December 2011
+
+ * Moved FAQ.pod into Zlib.pm
+
+ 2.044 2 December 2011
+
+ * Moved FAQ.pod under the lib directory so it can get installed
+
+ 2.043 20 November 2011
+
+ * No Changes
+
+ 2.042 17 November 2011
+
+ * No Changes
+
+ 2.040 28 October 2011
+
+ * No Changes
+
+ 2.039 28 October 2011
+
+ * croak if attempt to freeze/thaw compression object
+ [RT #69985]
+
+ 2.037 22 June 2011
+
+ * No Changes
+
+ 2.036 6 May 2011
+
+ * Added offset patramter to CRC32
+
+ 2.035 6 May 2011
+
+ * No Changes
+
+ 2.033 11 Jan 2011
+ * Fixed typos & spelling errors.
+ [perl# 81782]
+
+ 2.032 4 Jan 2011
+
+ * Document inflateReset
+ [RT #61082]
+
+ 2.030 22 July 2010
+
+ * Ran the zlib2ansi script against the files in zlib-src.
+ Thanks to Nicholas Clark for the reminder.
+
+ * Added "-DNO_VIZ" to DEFINE in Makefile.PL
+ [RT #65293]
+
+ 2.027 24 April 2010
+
+ * Updated to include zlib 1.2.5
+
+ 2.026 7 April 2010
+
+ * Fixed definition of Z_TREES in Makefile.PL
+ [RT #65293]
+
+ * Fixed build issue with definition of off64_t not found on Solaris
+ by modifying the zlib source - changed the symbol
+ _LARGEFILE64_SOURCE to _LARGEFILE64_SOURCE_dummy in zconf.h,
+ zlib.h and zutil.h
+ [RT #56108]
+
+ 2.025 27 March 2010
+
+ * Updated to include zlib 1.2.4
+
+ * Allow zlib version check to be disabled by setting
+ TEST_SKIP_VERSION_CHECK environment variable.
+ [RT #54510]
+
+ 2.023 9 November 2009
+
+ * fixed instance where $[ should have been $] in t/02zlib.t
+ Thanks to Robin Barker and zefram [RT #50765] for independently
+ spotting the issue.
+
+ 2.021 30 August 2009
+
+ * Changed test harness so that it can cope with PERL5OPT=-MCarp=verbose
+ [RT# 47225]
+
+ 2.020 3 June 2009
+
+ * Minor documentation update.
+
+ 2.019 4 May 2009
+
+ * No Changes
+
+ 2.018 3 May 2009
+
+ * No Changes
+
+ 2.017 28 March 2009
+
+ * Added 'LimitOutput' option
+
+ * Removed MAN3PODS from Makefile.PL
+
+ * Fixed coring issue when LimitOutput was used.
+
+ * Documented Compress::Raw::Zlib::zlib_version()
+
+ * Documented Compress::Raw::Zlib::deflateReset()
+ [RT #40566]
+
+ 2.015 3 September 2008
+
+ * Makefile.PL
+ Backout changes made in 2.014
+
+ 2.014 2 September 2008
+
+ * Makefile.PL
+ Updated to check for indirect dependencies.
+
+ 2.012 15 July 2008
+
+ * Document the gzip flags that WindowBits can take.
+
+ * Allow a dictionary to be used with a raw inflate.
+ Needs zlib 1.2.2.1 or better.
+ [RT #36046]
+
+ 2.011 5 May 2008
+
+ * A C++-style comment sneaked in with the last update. Fixed.
+ [core patch #33828]
+
+ 2.010 5 May 2008
+
+ * No Changes
+
+ 2.009 20 April 2008
+
+ * No Changes
+
+ 2.008 2 November 2007
+
+ * Minor documentation changes in README
+
+ 2.006 1 September 2007
+
+ * Makefile.PL
+ Added INSTALLDIRS directive to install as a core module when built
+ on a perl >= 5.9.
+
+ 2.005 18 June 2007
+
+ * Only include ppport.h when not being built with perl.
+ [core patch #30655]
+
+ 2.004 3 March 2007
+
+ * Fixed lvalue substr issue
+
+ * Remove redundant code from Zlib.xs
+
+ 2.003 2 January 2007
+
+ * Added explicit version checking
+
+ 2.002 29 December 2006
+
+ * Documentation updates.
+
+ 2.001 1 November 2006
+
+ * Remove beta status.
+
+ 2.000_14 26 October 2006
+
+ * Fixed memory leak on realloc.
+
+ * Ticket #18986 says that ExtUtils::Install 1.39 fixes the in-use
+ issue on win32/cygwin, so make the code that checks whether trying
+ to install via the cpan shell conditional on the version of
+ ExtUtils::Install.
+ http://rt.cpan.org/Ticket/Display.html?id=18986
+
+ 2.000_10 13 March 2006
+
+ * Fixed a potential NULL pointer dereference problem in
+ Compress::Raw::Zlib::resetLastBlockByte.
+ Issue highlighted by David Dyck and reproduced by Marcus Holland-Moritz.
+
+ 2.000_09 3 March 2006
+
+ * Released onto CPAN
+
+ * Documentation updates.
+
+ 2.000_08 2 March 2006
+
+ * Moved the IO::* modules out into their own distributions.
+
+ * Breakout zlib specific code into separate modules.
+
+ * Limited support for reading/writing zip files added.
+
+ 2.000_06 5 October 2005
+
+ * Added eof parameter to Compress::Zlib::inflate method.
+
+ * Fixed issue with 64-bit
+
+ 2.000_05 4 October 2005
+
+ * Renamed IO::* to IO::Compress::* & IO::Uncompress::*
+
+ 2.000_04 23 September 2005
+
+ * Fixed some more non-portable test that were failing on VMS.
+
+ * fixed problem where error messages in the oneshot interface were
+ getting lost.
+
+ 2.000_03 12 September 2005
+
+ * Fixed some non-portable test that were failing on VMS.
+
+ * Fixed export of zlib constants from the IO::* classes
+
+ 2.000_02 6 September 2005
+
+ * Split Append mode into Append and Merge
+
+ * Fixed typos in the documentation.
+
+ * Added pod/FAQ.pod
+
+ * Added libscan to Makefile.PL
+
+ * Added InputLength for IO::Gunzip et al
+
+ 2.000_01 22 August 2005
+
+ * Fixed VERSION in Compress::Gzip::Constants
+
+ * Removed Compress::Gzip::Info from the distribution.
+
+ 2.000_00 21 August 2005
+
+ * First Beta relase of Compress::zlib rewrite.
--- /dev/null
+README
+Changes
+t/000prereq.t
+t/01version.t
+t/02zlib.t
+t/07bufsize.t
+t/09limitoutput.t
+t/18lvalue.t
+t/19nonpv.t
+t/99pod.t
+t/Test/Builder.pm
+t/Test/More.pm
+t/Test/Simple.pm
+t/compress/CompTestUtils.pm
+t/meta-json.t
+t/meta-yaml.t
+Zlib.xs
+typemap
+Makefile.PL
+private/MakeUtil.pm
+MANIFEST
+ppport.h
+config.in
+zlib-src/adler32.c
+zlib-src/compress.c
+zlib-src/crc32.c
+zlib-src/crc32.h
+zlib-src/deflate.c
+zlib-src/deflate.h
+zlib-src/infback.c
+zlib-src/inffast.c
+zlib-src/inffast.h
+zlib-src/inffixed.h
+zlib-src/inflate.c
+zlib-src/inflate.h
+zlib-src/inftrees.c
+zlib-src/inftrees.h
+zlib-src/trees.c
+zlib-src/trees.h
+zlib-src/uncompr.c
+zlib-src/zconf.h
+zlib-src/zlib.h
+zlib-src/zutil.c
+zlib-src/zutil.h
+fallback/constants.h
+fallback/constants.xs
+lib/Compress/Raw/Zlib.pm
+examples/filtdef Perl
+examples/filtinf Perl
+META.yml Module meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
--- /dev/null
+{
+ "abstract" : "unknown",
+ "author" : [
+ "unknown"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150005",
+ "license" : [
+ "perl_5"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Compress-Raw-Zlib",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc",
+ "t",
+ "private"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "configure" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "bugtracker" : {
+ "web" : "https://github.com/pmqs/Compress-Raw-Zlib/issues"
+ },
+ "homepage" : "https://github.com/pmqs/Compress-Raw-Zlib",
+ "repository" : {
+ "type" : "git",
+ "url" : "git://github.com/pmqs/Compress-Raw-Zlib.git",
+ "web" : "https://github.com/pmqs/Compress-Raw-Zlib"
+ }
+ },
+ "version" : "2.202",
+ "x_serialization_backend" : "JSON::PP version 2.27300"
+}
my $ZLIB_LIB ;
my $ZLIB_INCLUDE ;
my $BUILD_ZLIB = 0 ;
+my $USE_ZLIB_NG = 0;
my $OLD_ZLIB = '' ;
my $WALL = '' ;
my $GZIP_OS_CODE = -1 ;
my $OPT_Z_PREFIX = '-DZ_PREFIX' ;
my $OPT_ZLIB_INCLUDE = "-I$ZLIB_INCLUDE";
my $OPT_ZLIB_LIB = "-L$ZLIB_LIB" ;
+my $OPT_SOLO = '-DZ_SOLO';
+my $OPT_USE_ZLIB_NG = "";
if (! $BUILD_ZLIB)
{
$OPT_ZLIB_LIB = ''
if $ZLIB_LIB eq './zlib-src' ;
+
+ $OPT_SOLO = '';
+}
+
+if ( $USE_ZLIB_NG)
+{
+ $OPT_USE_ZLIB_NG = '-DUSE_ZLIB_NG';
+ $ZLIB_LIBRARY_NAME = $^O eq 'MSWin32' ? 'zlib-ng' : 'z-ng' ;
}
WriteMakefile(
NAME => 'Compress::Raw::Zlib',
VERSION_FROM => 'lib/Compress/Raw/Zlib.pm',
INC => $OPT_ZLIB_INCLUDE ,
- DEFINE => "-DNO_VIZ -DZ_SOLO $OLD_ZLIB $WALL $OPT_Z_PREFIX -DGZIP_OS_CODE=$GZIP_OS_CODE $USE_PPPORT_H -DPerl_crz_BUILD_ZLIB=$BUILD_ZLIB" ,
+ DEFINE => "-DNO_VIZ $OPT_SOLO $OLD_ZLIB $WALL $OPT_Z_PREFIX $OPT_USE_ZLIB_NG -DGZIP_OS_CODE=$GZIP_OS_CODE $USE_PPPORT_H -DPerl_crz_BUILD_ZLIB=$BUILD_ZLIB" ,
XS => { 'Zlib.xs' => 'Zlib.c'},
'depend' => { 'Makefile' => 'config.in' },
'clean' => { FILES => '*.c constants.h constants.xs' },
Z_NEED_DICT
Z_NO_COMPRESSION
Z_NO_FLUSH
- Z_NULL
Z_OK
Z_PARTIAL_FLUSH
Z_RLE
Z_UNKNOWN
Z_VERSION_ERROR
+ ZLIBNG_VERNUM
+ ZLIBNG_VER_MAJOR
+ ZLIBNG_VER_MINOR
+ ZLIBNG_VER_REVISION
+ ZLIBNG_VER_STATUS
+ ZLIBNG_VER_MODIFIED
);
- #ZLIB_VERNUM
my %verSpecificNames = (
Z_TREES => '1240',
}
keys %verSpecificNames ;
+ push @names, { name => 'Z_NULL', type => 'UV' };
+ push @names, { name => 'ZLIBNG_VERSION', type => 'PV' };
+
ExtUtils::Constant::WriteConstants(
NAME => 'Zlib',
NAMES => \@names,
}
}
+sub getBoolean
+{
+ my $name = shift ;
+ my $info = shift;
+
+ my $x = defined $ENV{$name}
+ ? $ENV{$name}
+ : $info->{$name} ;
+
+ return ($x =~ /^yes|on|true|1$/i) ? 1 : 0;
+}
+
sub ParseCONFIG
{
my ($k, $v) ;
my @badkey = () ;
my %Info = () ;
- my @Options = qw( INCLUDE LIB BUILD_ZLIB OLD_ZLIB GZIP_OS_CODE ) ;
+ my @Options = qw( INCLUDE LIB BUILD_ZLIB OLD_ZLIB GZIP_OS_CODE USE_ZLIB_NG) ;
my %ValidOption = map {$_, 1} @Options ;
my %Parsed = %ValidOption ;
my $CONFIG = 'config.in' ;
$ZLIB_INCLUDE = defined $ENV{'ZLIB_INCLUDE'}
? $ENV{'ZLIB_INCLUDE'}
: $Info{'INCLUDE'} ;
+
$ZLIB_LIB = defined $ENV{'ZLIB_LIB'}
?$ENV{'ZLIB_LIB'}
: $Info{'LIB'} ;
+ $USE_ZLIB_NG = getBoolean('USE_ZLIB_NG', \%Info);
+
if ($^O eq 'VMS') {
$ZLIB_INCLUDE = VMS::Filespec::vmspath($ZLIB_INCLUDE);
$ZLIB_LIB = VMS::Filespec::vmspath($ZLIB_LIB);
}
- my $y = defined $ENV{'OLD_ZLIB'}
- ? $ENV{'OLD_ZLIB'}
- : $Info{'OLD_ZLIB'} ;
- $OLD_ZLIB = '-DOLD_ZLIB' if $y and $y =~ /^yes|on|true|1$/i;
-
- my $x = defined $ENV{'BUILD_ZLIB'}
- ? $ENV{'BUILD_ZLIB'}
- : $Info{'BUILD_ZLIB'} ;
-
- if ($x and $x =~ /^yes|on|true|1$/i ) {
+ $OLD_ZLIB = '-DOLD_ZLIB'
+ if getBoolean('OLD_ZLIB', \%Info);
- $BUILD_ZLIB = 1 ;
+ $BUILD_ZLIB = getBoolean('BUILD_ZLIB', \%Info);
- # ZLIB_LIB & ZLIB_INCLUDE must point to the same place when
- # BUILD_ZLIB is specified.
- die "INCLUDE & LIB must be the same when BUILD_ZLIB is True\n"
- if $ZLIB_LIB ne $ZLIB_INCLUDE ;
+ if ($BUILD_ZLIB ) {
- # Check the zlib source directory exists
- die "LIB/INCLUDE directory '$ZLIB_LIB' does not exits\n"
- unless -d $ZLIB_LIB ;
+ # ZLIB_LIB & ZLIB_INCLUDE must point to the same place when
+ # BUILD_ZLIB is specified.
+ die "INCLUDE & LIB must be the same when BUILD_ZLIB is True\n"
+ if $ZLIB_LIB ne $ZLIB_INCLUDE ;
- # check for a well known file
- die "LIB/INCLUDE directory, '$ZLIB_LIB', doesn't seem to have the zlib source files\n"
- unless -e catfile($ZLIB_LIB, 'zlib.h') ;
+ # Check the zlib source directory exists
+ die "LIB/INCLUDE directory '$ZLIB_LIB' does not exits\n"
+ unless -d $ZLIB_LIB ;
+ # check for a well known file
+ if ($USE_ZLIB_NG)
+ {
+ die "LIB/INCLUDE directory, '$ZLIB_LIB', doesn't seem to have the zlib-ng source files\n"
+ unless -e catfile($ZLIB_LIB, 'zlib-ng.h') ;
+ }
+ else
+ {
+ die "LIB/INCLUDE directory, '$ZLIB_LIB', doesn't seem to have the zlib source files\n"
+ unless -e catfile($ZLIB_LIB, 'zlib.h') ;
+ }
- # write the Makefile
- print "Building Zlib enabled\n" ;
+ # write the Makefile
+ print "Building Zlib enabled\n" ;
}
$GZIP_OS_CODE = defined $ENV{'GZIP_OS_CODE'}
GZIP_OS_CODE [$GZIP_OS_CODE]
OLD_ZLIB [$OLD_ZLIB]
BUILD_ZLIB [$BUILD_ZLIB]
+ USE_ZLIB_NG [$USE_ZLIB_NG]
EOM
--- /dev/null
+
+ Compress-Raw-Zlib
+
+ Version 2.202
+
+ 27 June 2022
+
+ Copyright (c) 2005-2022 Paul Marquess. All rights reserved.
+ This program is free software; you can redistribute it
+ and/or modify it under the same terms as Perl itself.
+
+ The directory zlib-src contains a subset of the
+ source files copied directly from zlib version 1.2.13.
+ These files are Copyright(C) 1995-2022
+ Jean-loup Gailly and Mark Adler.
+ Full source for the zlib library is available at
+ http://www.zlib.org
+
+DESCRIPTION
+-----------
+
+This module provides a Perl interface to the zlib compression library.
+
+PREREQUISITES
+-------------
+
+Before you can build Compress-Raw-Zlib you need to have the following
+installed on your system:
+
+ * A C compiler
+
+ * Perl 5.006 or better.
+
+By default, Compress-Raw-Zlib will build its own private copy of the
+zlib library. If you want to use a different version of
+zlib, follow the instructions in the section called
+"Controlling the version of zlib used by Compress-Raw-Zlib"
+later in this document.
+
+BUILDING THE MODULE
+-------------------
+
+Assuming you have met all the prerequisites, the module can now be built
+using this sequence of commands:
+
+ perl Makefile.PL
+ make
+ make test
+
+INSTALLATION
+------------
+
+To install Compress-Raw-Zlib, run the command below:
+
+ make install
+
+Controlling the version of zlib used by Compress-Raw-Zlib
+----------------------------------------------------------
+
+Compress-Raw-Zlib interfaces to the zlib compression library. There
+are three options available to control which version/instance of the
+zlib library is used:
+
+ 1. Build a private copy of the zlib library using the
+ zlib library source that is included with this module.
+ This is the default and recommended option.
+
+ 2. Build a private copy of the zlib library using a standard
+ zlib source distribution.
+
+ 3. Use a pre-built zlib library.
+
+Note that if you intend to use either Option 2 or 3, you need to have
+zlib version 1.2.0 or better.
+
+The contents of the file config.in are used to control which of the
+three options is actually used. This file is read during the
+
+ perl Makefile.PL
+
+step of the build, so remember to make any required changes to config.in
+before building this module.
+
+ Option 1
+ --------
+
+ For option 1, edit the file config.in and set the variables in it
+ as follows:
+
+ BUILD_ZLIB = True
+ INCLUDE = ./zlib-src
+ LIB = ./zlib-src
+ OLD_ZLIB = False
+ GZIP_OS_CODE = AUTO_DETECT
+
+ Option 2
+ --------
+
+ For option 2, fetch a copy of the zlib source distribution from
+ http://www.zlib.org and unpack it into the Compress-Raw-Zlib source
+ directory. Assuming you have fetched zlib 1.2.13,
+ it will create a directory called zlib-1.2.13.
+
+ Now set the variables in the file config.in as follows (if the version
+ you have fetched isn't 1.2.13, change the INCLUDE and LIB
+ variables appropriately):
+
+ BUILD_ZLIB = True
+ INCLUDE = ./zlib-1.2.13
+ LIB = ./zlib-1.2.13
+ OLD_ZLIB = False
+ GZIP_OS_CODE = AUTO_DETECT
+
+ Option 3
+ --------
+
+ For option 3, you need to find out where zlib is stored on your
+ system. There are two parts to this.
+
+ First, find the directory where the zlib library is stored (some
+ common names for the library are libz.a and libz.so). Set the LIB variable
+ in the config.in file to that directory.
+
+ Secondly, find the directory where the file zlib.h is stored. Now set
+ the INCLUDE variable in the config.in file to that directory.
+
+ Next set BUILD_ZLIB to False.
+
+ Finally, if you are running zlib 1.0.5 or older, set the OLD_ZLIB
+ variable to True. Otherwise set it to False.
+
+ As an example, if the zlib library on your system is in
+ /usr/local/lib, zlib.h is in /usr/local/include and zlib is more
+ recent than version 1.0.5, the variables in config.in should be set as
+ follows:
+
+ BUILD_ZLIB = False
+ INCLUDE = /usr/local/include
+ LIB = /usr/local/lib
+ OLD_ZLIB = False
+ GZIP_OS_CODE = AUTO_DETECT
+
+Setting the Gzip OS Code
+------------------------
+
+Every gzip stream stores a byte in its header to identify the Operating
+System that was used to create the gzip stream. When you build Compress-Raw-Zlib it will attempt to determine the value that is correct for
+your Operating System. This will then be used by IO::Compress::Gzip as the
+default value for the OS byte in all gzip headers it creates.
+
+The variable GZIP_OS_CODE in the config.in file controls the setting of
+this value when building Compress-Raw-Zlib. If GZIP_OS_CODE is set to
+AUTO_DETECT, Compress-Raw-Zlib will attempt to determine the correct value for
+your Operating System.
+
+Alternatively, you can override auto-detection of the default OS code and
+explicitly set it yourself. Set the GZIP_OS_CODE variable in the config.in
+file to be a number between 0 and 255. For example
+
+ GZIP_OS_CODE = 3
+
+See RFC 1952 for valid OS codes that can be used.
+
+If you are running one of the less popular Operating Systems, it is
+possible that the default value picked by this module is incorrect or the
+default value (3) is used when there is a better value available. When
+Compress-Raw-Zlib cannot determine what operating system you are running, it
+will use the default value 3 for the OS code.
+
+If you find you have to change this value, because you think the value auto
+detected is incorrect, please take a few moments to contact the author of
+this module.
+
+TROUBLESHOOTING
+---------------
+
+Undefined Symbol gzsetparams
+----------------------------
+
+If you get the error shown below when you run the Compress-Raw-Zlib test
+harness it probably means you are running a copy of zlib that is
+version 1.0.5 or older.
+
+t/01version.........Can't load 'blib/arch/auto/Compress/Zlib/Zlib.so' for
+ module Compress::Raw::Zlib: blib/arch/auto/Compress/Raw/Zlib/Zlib.so:
+ undefined symbol: gzsetparams at ...
+
+There are two ways to fix this problem:
+
+ 1. Upgrade to the latest version of zlib.
+
+ 2. Edit config.in and set the OLD_ZLIB variable to True.
+
+Test Harness 01version fails
+----------------------------
+If the 01version test harness fails, and the problem isn't covered by the
+scenario above, it probably means that you have two versions of
+zlib installed on your system.
+
+Run the command below to see if this is indeed the case
+
+ make test TEST_VERBOSE=1 TEST_FILES=t/01version.t
+
+Try removing the one you don't want to use and rebuild.
+
+Solaris build fails with "language optional software package not installed"
+---------------------------------------------------------------------------
+
+If you are trying to build this module under Solaris and you get an
+error message like this
+
+ /usr/ucb/cc: language optional software package not installed
+
+it means that Perl cannot find the C compiler on your system. The cryptic
+message is just Sun's way of telling you that you haven't bought their
+C compiler.
+
+When you build a Perl module that needs a C compiler, the Perl build
+system tries to use the same C compiler that was used to build perl
+itself. In this case your Perl binary was built with a C compiler that
+lived in /usr/ucb.
+
+To continue with building this module, you need to get a C compiler,
+or tell Perl where your C compiler is, if you already have one.
+
+Assuming you have now got a C compiler, what you do next will be dependent
+on what C compiler you have installed. If you have just installed Sun's
+C compiler, you shouldn't have to do anything. Just try rebuilding
+this module.
+
+If you have installed another C compiler, say gcc, you have to tell perl
+how to use it instead of /usr/ucb/cc.
+
+This set of options seems to work if you want to use gcc. Your mileage
+may vary.
+
+ perl Makefile.PL CC=gcc CCCDLFLAGS=-fPIC OPTIMIZE=" "
+ make test
+
+If that doesn't work for you, it's time to make changes to the Makefile
+by hand. Good luck!
+
+Solaris build fails with "gcc: unrecognized option `-KPIC'"
+-----------------------------------------------------------
+
+You are running Solaris and you get an error like this when you try to
+build this Perl module
+
+ gcc: unrecognized option `-KPIC'
+
+This symptom usually means that you are using a Perl binary that has been
+built with the Sun C compiler, but you are using gcc to build this module.
+
+When Perl builds modules that need a C compiler, it will attempt to use
+the same C compiler and command line options that was used to build perl
+itself. In this case "-KPIC" is a valid option for the Sun C compiler,
+but not for gcc. The equivalent option for gcc is "-fPIC".
+
+The solution is either:
+
+ 1. Build both Perl and this module with the same C compiler, either
+ by using the Sun C compiler for both or gcc for both.
+
+ 2. Try generating the Makefile for this module like this perl
+
+ perl Makefile.PL CC=gcc CCCDLFLAGS=-fPIC OPTIMIZE=" " LD=gcc
+ make test
+
+ This second option seems to work when mixing a Perl binary built
+ with the Sun C compiler and this module built with gcc. Your
+ mileage may vary.
+
+HP-UX Notes
+-----------
+
+I've had a report that when building Compress-Raw-Zlib under HP-UX that it
+is necessary to have first built the zlib library with the -fpic
+option.
+
+Linux Notes
+-----------
+
+Although most Linux distributions already come with zlib, some
+people report getting this error when they try to build this module:
+
+$ make
+cp Zlib.pm blib/lib/Compress/Zlib.pm
+AutoSplitting blib/lib/Compress/Zlib.pm (blib/lib/auto/Compress/Zlib)
+/usr/bin/perl -I/usr/lib/perl5/5.6.1/i386-linux -I/usr/lib/perl5/5.6.1 /usr/lib/perl5/5.6.1/ExtUtils/xsubpp -typemap /usr/lib/perl5/5.6.1/ExtUtils/typemap -typemap typemap Zlib.xs > Zlib.xsc && mv Zlib.xsc Zlib.c
+gcc -c -I/usr/local/include -fno-strict-aliasing -I/usr/local/include -O2 -march=i386 -mcpu=i686 -DVERSION=\"1.16\" -DXS_VERSION=\"1.16\" -fPIC -I/usr/lib/perl5/5.6.1/i386-linux/CORE Zlib.c
+Zlib.xs:25:19: zlib.h: No such file or directory
+make: *** [Zlib.o] Error 1
+
+This usually means that you have not installed the development RPM
+for zlib. Check for an RPM that start with "zlib-devel" in your Linux
+distribution.
+
+Win32 Notes
+-----------
+
+If you are running Activestate Perl (from http://www.activestate.com),
+it ships with a pre-compiled version of Compress-Raw-Zlib. To check if a
+newer version of Compress-Raw-Zlib is available run this from the command
+prompt
+
+ C:\> ppm verify -upgrade Compress-Raw-Zlib
+
+If you are not running Activestate Perl and you don't have access
+to a C compiler, you will not be able to build and install this module.
+
+Win32 & Cygwin Notes
+--------------------
+
+It is not possible to install Compress-Raw-Zlib using the CPAN shell.
+This is because the Compress-Raw-Zlib DLL is itself used by the CPAN shell
+and it is impossible to remove a DLL while it is already loaded under
+Windows.
+
+The workaround is to install Compress-Raw-Zlib manually using the
+instructions given at the start of this file.
+
+SUPPORT
+-------
+
+General feedback/questions/bug reports should be sent to
+https://github.com/pmqs/Compress-Raw-Zlib/issues (preferred) or
+https://rt.cpan.org/Public/Dist/Display.html?Name=Compress-Raw-Zlib.
+
+FEEDBACK
+--------
+
+How to report a problem with Compress-Raw-Zlib.
+
+To help me help you, I need all of the following information:
+
+ 1. The Versions of everything relevant.
+ This includes:
+
+ a. The *complete* output from running this
+
+ perl -V
+
+ Do not edit the output in any way.
+ Note, I want you to run "perl -V" and NOT "perl -v".
+
+ If your perl does not understand the "-V" option it is too
+ old. This module needs Perl version 5.004 or better.
+
+ b. The version of Compress-Raw-Zlib you have.
+ If you have successfully installed Compress-Raw-Zlib, this one-liner
+ will tell you:
+
+ perl -MCompress::Raw::Zlib -e 'print qq[ver $Compress::Raw::Zlib::VERSION\n]'
+
+ If you are running windows use this
+
+ perl -MCompress::Raw::Zlib -e "print qq[ver $Compress::Raw::Zlib::VERSION\n]"
+
+ If you haven't installed Compress-Raw-Zlib then search Compress::Raw::Zlib.pm
+ for a line like this:
+
+ $VERSION = "2.202" ;
+
+ c. The version of zlib you have used.
+ If you have successfully installed Compress-Raw-Zlib, this one-liner
+ will tell you:
+
+ perl -MCompress::Raw::Zlib -e "print q[zlib ver ]. Compress::Raw::Zlib::ZLIB_VERSION.qq[\n]"
+
+ If not, look at the beginning of the file zlib.h.
+
+ 2. If you are having problems building Compress-Raw-Zlib, send me a
+ complete log of what happened. Start by unpacking the Compress-Raw-Zlib
+ module into a fresh directory and keep a log of all the steps
+
+ [edit config.in, if necessary]
+ perl Makefile.PL
+ make
+ make test TEST_VERBOSE=1
+
+Paul Marquess <pmqs@cpan.org>
#include "perl.h"
#include "XSUB.h"
-#include "zlib.h"
+#if USE_ZLIB_NG
+# include "zlib-ng.h"
+#else
+# include "zlib.h"
+#endif
+
/* zlib prior to 1.06 doesn't know about z_off_t */
#ifndef z_off_t
# define z_off_t long
#endif
-#if ! defined(ZLIB_VERNUM) || ZLIB_VERNUM < 0x1200
+#if ! USE_ZLIB_NG && (! defined(ZLIB_VERNUM) || ZLIB_VERNUM < 0x1200)
# define NEED_DUMMY_BYTE_AT_END
#endif
-#if defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1210
+#if USE_ZLIB_NG || (defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1210)
# define MAGIC_APPEND
# define AT_LEAST_ZLIB_1_2_1
#endif
-#if defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1221
+#if USE_ZLIB_NG || (defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1221)
# define AT_LEAST_ZLIB_1_2_2_1
#endif
-#if defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1222
+#if USE_ZLIB_NG || (defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1222)
# define AT_LEAST_ZLIB_1_2_2_2
#endif
-#if defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1223
+#if USE_ZLIB_NG || (defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1223)
# define AT_LEAST_ZLIB_1_2_2_3
#endif
-#if defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1230
+#if USE_ZLIB_NG || (defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1230)
# define AT_LEAST_ZLIB_1_2_3
#endif
-#if defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1252
+#if USE_ZLIB_NG || (defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1252)
/*
Use Z_SOLO to build source means need own malloc/free
*/
# define AT_LEAST_ZLIB_1_2_5_2
#endif
-#if defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1280
-# define AT_LEAST_ZLIB_1_2_8
-#endif
-#if defined(ZLIB_VERNUM) && ZLIB_VERNUM >= 0x1290
-# define AT_LEAST_ZLIB_1_2_9
+/* zlib vs zlib-ng */
+
+#if USE_ZLIB_NG
+
+/* zlibng native */
+
+# define HAVE_ZLIB_NG_NATIVE TRUE
+# define HAVE_ZLIB_NG_COMPAT FALSE
+
+# ifndef ZLIBNG_VER_STATUS
+# define ZLIBNG_VER_STATUS 0
+# endif
+
+# ifndef ZLIBNG_VER_MODIFIED
+# define ZLIBNG_VER_MODIFIED 0
+# endif
+
+# define CRZ_adlerInitial zng_adler32(0L, Z_NULL, 0)
+# define CRZ_crcInitial zng_crc32(0L, Z_NULL, 0)
+
+# define CRZ_ZSTREAM zng_stream
+
+
+
+# define CRZ_adler32 zng_adler32
+# define CRZ_adler32_combine zng_adler32_combine
+# define CRZ_crc32 zng_crc32
+# define CRZ_crc32_combine zng_crc32_combine
+# define CRZ_deflate zng_deflate
+# define CRZ_deflateEnd zng_deflateEnd
+# define CRZ_deflateInit zng_deflateInit
+# define CRZ_deflateInit2 zng_deflateInit2
+# define CRZ_deflateParams zng_deflateParams
+# define CRZ_deflatePrime zng_deflatePrime
+# define CRZ_deflateReset zng_deflateReset
+# define CRZ_deflateSetDictionary zng_deflateSetDictionary
+# define CRZ_deflateTune zng_deflateTune
+# define CRZ_inflate zng_inflate
+# define CRZ_inflateEnd zng_inflateEnd
+# define CRZ_inflateInit2 zng_inflateInit2
+# define CRZ_inflateReset zng_inflateReset
+# define CRZ_inflateSetDictionary zng_inflateSetDictionary
+# define CRZ_inflateSync zng_inflateSync
+# define CRZ_zlibCompileFlags zng_zlibCompileFlags
+
+
+/* zlib symbols & functions */
+
+// # define CRZ_ZLIB_VERSION ZLIBNG_VERSION
+// # define ZLIB_VERSION ZLIBNG_VERSION
+# define CRZ_ZLIB_VERSION ""
+# define ZLIB_VERSION ""
+
+// # define CRZ_zlibVersion zlibng_version
+// # define CRZ_zlib_version zlibng_version
+
+ const char *CRZ_zlibVersion(void) { return ""; }
+ const char *CRZ_zlib_version(void) { return ""; }
+
+
+#else /* zlib specific */
+
+
+# define HAVE_ZLIB_NG_NATIVE FALSE
+
+/* Is this real zlib or zlib-ng in compat mode */
+# ifdef ZLIBNG_VERSION
+ /* zlib-ng in compat mode */
+# define HAVE_ZLIB_NG_COMPAT TRUE
+
+# ifndef ZLIBNG_VER_STATUS
+# define ZLIBNG_VER_STATUS 0
+# endif
+
+# ifndef ZLIBNG_VER_MODIFIED
+# define ZLIBNG_VER_MODIFIED 0
+# endif
+
+ const char *zlibng_version(void) { return ZLIBNG_VERSION ; }
+
+
+# else
+ /* zlib native mode */
+
+# define HAVE_ZLIB_NG_COMPAT FALSE
+
+ /* zlib doesn't have the ZLIBNG synbols, so create them */
+# define ZLIBNG_VERSION ""
+# define ZLIBNG_VERNUM 0
+# define ZLIBNG_VER_MAJOR 0
+# define ZLIBNG_VER_MINOR 0
+# define ZLIBNG_VER_REVISION 0
+# define ZLIBNG_VER_STATUS 0
+# define ZLIBNG_VER_MODIFIED 0
+# define ZLIBNG_VERNUM 0
+
+ const char *zlibng_version(void) { return ""; }
+
+# endif
+
+
+
+# define CRZ_adlerInitial adler32(0L, Z_NULL, 0)
+# define CRZ_crcInitial crc32(0L, Z_NULL, 0)
+
+# define CRZ_ZSTREAM z_stream
+
+# define CRZ_adler32 adler32
+# define CRZ_adler32_combine adler32_combine
+# define CRZ_crc32 crc32
+# define CRZ_crc32_combine crc32_combine
+# define CRZ_deflate deflate
+# define CRZ_deflateEnd deflateEnd
+# define CRZ_deflateInit deflateInit
+# define CRZ_deflateInit2 deflateInit2
+# define CRZ_deflateParams deflateParams
+# define CRZ_deflatePrime deflatePrime
+# define CRZ_deflateReset deflateReset
+# define CRZ_deflateSetDictionary deflateSetDictionary
+# define CRZ_deflateTune deflateTune
+# define CRZ_inflate inflate
+# define CRZ_inflateEnd inflateEnd
+# define CRZ_inflateInit2 inflateInit2
+# define CRZ_inflateReset inflateReset
+# define CRZ_inflateSetDictionary inflateSetDictionary
+# define CRZ_inflateSync inflateSync
+# define CRZ_zlibCompileFlags zlibCompileFlags
+# define CRZ_zlibVersion zlibVersion
+# define CRZ_zlib_version zlibVersion
+
#endif
+
#ifdef USE_PPPORT_H
# define NEED_sv_2pvbyte
# define NEED_sv_2pv_nolen
#define FLAG_LIMIT_OUTPUT 16
uLong crc32 ;
uLong adler32 ;
- z_stream stream;
- uLong bufsize;
+ CRZ_ZSTREAM stream;
+ uLong bufsize;
SV * dictionary ;
uLong dict_adler ;
int last_error ;
# define GZIP_OS_CODE OS_CODE
#endif
-#define adlerInitial adler32(0L, Z_NULL, 0)
-#define crcInitial crc32(0L, Z_NULL, 0)
/* static const char * const my_z_errmsg[] = { */
static const char my_z_errmsg[][32] = {
static void
#ifdef CAN_PROTOTYPE
-DispHex(void * ptr, int length)
+DispHex(const void * ptr, int length)
#else
DispHex(ptr, length)
- void * ptr;
+ const void * ptr;
int length;
#endif
{
printf(" avail_out %lu\n", (unsigned long)s->stream.avail_out);
printf(" total_in %ld\n", s->stream.total_in);
printf(" total_out %ld\n", s->stream.total_out);
+#if ! USE_ZLIB_NG
printf(" adler %ld\n", s->stream.adler );
+#else
+ printf(" adler %u\n", s->stream.adler );
+#endif
printf(" bufsize %ld\n", s->bufsize);
printf(" dictionary %p\n", s->dictionary);
printf(" dict_adler 0x%ld\n",s->dict_adler);
s->flags = flags ;
s->zip_mode = (windowBits < 0) ;
if (flags & FLAG_CRC32)
- s->crc32 = crcInitial ;
+ s->crc32 = CRZ_crcInitial ;
if (flags & FLAG_ADLER32)
- s->adler32 = adlerInitial ;
+ s->adler32 = CRZ_adlerInitial ;
}
{
dTHX;
int ret ;
- z_stream * strm = &s->stream;
+ CRZ_ZSTREAM * strm = &s->stream;
Bytef* output = s->deflateParams_out_buffer ;
{
dTHX;
int ret ;
- z_stream * strm = &s->stream;
+ CRZ_ZSTREAM * strm = &s->stream;
Bytef* output = s->deflateParams_out_buffer ;
uLong total_output = s->deflateParams_out_length;
strm->next_out = output + total_output;
strm->avail_out = s->bufsize;
- ret = deflateParams(&(s->stream), s->Level, s->Strategy);
+ ret = CRZ_deflateParams(&(s->stream), s->Level, s->Strategy);
/* fprintf(stderr, "deflateParams %d %s %lu\n", ret,
GetErrorString(ret), s->bufsize - strm->avail_out); */
INCLUDE: constants.xs
BOOT:
+#if ! USE_ZLIB_NG
/* Check this version of zlib is == 1 */
- if (zlibVersion()[0] != '1')
- croak("Compress::Raw::Zlib needs zlib version 1.x\n") ;
+ if (CRZ_zlibVersion()[0] != '1')
+ croak("Compress::Raw::Zlib needs zlib version 1.x\n") ;
+#endif
{
/* Create the $os_code scalar */
sv_setiv(os_code_sv, Perl_crz_BUILD_ZLIB) ;
}
-
-#define Zip_zlib_version() (const char*)zlib_version
+#define Zip_zlib_version() (const char*)CRZ_zlib_version()
const char*
Zip_zlib_version()
+const char*
+zlibng_version()
+
+#define Zip_is_zlib_native() (! (HAVE_ZLIB_NG_NATIVE || HAVE_ZLIB_NG_COMPAT))
+bool
+Zip_is_zlib_native()
+
+#define Zip_is_zlibng_native() (bool)HAVE_ZLIB_NG_NATIVE
+bool
+Zip_is_zlibng_native()
+
+#define Zip_is_zlibng_compat() (bool)HAVE_ZLIB_NG_COMPAT
+bool
+Zip_is_zlibng_compat()
+
+#define Zip_is_zlibng() (bool)(HAVE_ZLIB_NG_NATIVE || HAVE_ZLIB_NG_COMPAT)
+bool
+Zip_is_zlibng()
+
unsigned
ZLIB_VERNUM()
CODE:
#ifdef ZLIB_VERNUM
RETVAL = ZLIB_VERNUM ;
+#elif USE_ZLIB_NG
+ RETVAL = 0 ;
#else
/* 1.1.4 => 0x1140 */
- RETVAL = (ZLIB_VERSION[0] - '0') << 12 ;
- RETVAL += (ZLIB_VERSION[2] - '0') << 8 ;
- RETVAL += (ZLIB_VERSION[4] - '0') << 4 ;
- if (strlen(ZLIB_VERSION) > 5)
- RETVAL += (ZLIB_VERSION[6] - '0') ;
+ RETVAL = (CRZ_ZLIB_VERSION[0] - '0') << 12 ;
+ RETVAL += (CRZ_ZLIB_VERSION[2] - '0') << 8 ;
+ RETVAL += (CRZ_ZLIB_VERSION[4] - '0') << 4 ;
+ if (strlen(CRZ_ZLIB_VERSION) > 5)
+ RETVAL += (CRZ_ZLIB_VERSION[6] - '0') ;
#endif
OUTPUT:
RETVAL
#ifndef AT_LEAST_ZLIB_1_2_1
-#define zlibCompileFlags() 0
+# define Zip_zlibCompileFlags 0
+#else
+# define Zip_zlibCompileFlags CRZ_zlibCompileFlags
#endif
uLong
-zlibCompileFlags()
+Zip_zlibCompileFlags()
MODULE = Compress::Raw::Zlib PACKAGE = Compress::Raw::Zlib PREFIX = Zip_
-#define Zip_adler32(buf, adler) adler32(adler, buf, (uInt)len)
+#define Zip_adler32(buf, adler) CRZ_adler32(adler, buf, (uInt)len)
uLong
-Zip_adler32(buf, adler=adlerInitial)
+Zip_adler32(buf, adler=CRZ_adlerInitial)
uLong adler = NO_INIT
STRLEN len = NO_INIT
Bytef * buf = NO_INIT
buf = (Byte*)SvPVbyte(sv, len) ;
if (items < 2)
- adler = adlerInitial;
+ adler = CRZ_adlerInitial;
else if (SvOK(ST(1)))
adler = SvUV(ST(1)) ;
else
- adler = adlerInitial;
+ adler = CRZ_adlerInitial;
OUTPUT:
RETVAL
-#define Zip_crc32(buf, crc, offset) crc32(crc, buf+offset, (uInt)len-offset)
+#define Zip_crc32(buf, crc, offset) CRZ_crc32(crc, buf+offset, (uInt)len-offset)
uLong
-Zip_crc32(buf, crc=crcInitial, offset=0)
+Zip_crc32(buf, crc=CRZ_crcInitial, offset=0)
uLong crc = NO_INIT
STRLEN len = NO_INIT
Bytef * buf = NO_INIT
croak("Offset out of range in Compress::Raw::Zlib::crc32");
if (items < 2)
- crc = crcInitial;
+ crc = CRZ_crcInitial;
else if (SvOK(ST(1)))
crc = SvUV(ST(1)) ;
else
- crc = crcInitial;
+ crc = CRZ_crcInitial;
uLong
crc32_combine(crc1, crc2, len2)
crc1 = crc1; crc2 = crc2 ; len2 = len2; /* Silence -Wall */
croak("crc32_combine needs zlib 1.2.3 or better");
#else
- RETVAL = crc32_combine(crc1, crc2, len2);
+ RETVAL = CRZ_crc32_combine(crc1, crc2, len2);
#endif
OUTPUT:
RETVAL
adler1 = adler1; adler2 = adler2 ; len2 = len2; /* Silence -Wall */
croak("adler32_combine needs zlib 1.2.3 or better");
#else
- RETVAL = adler32_combine(adler1, adler2, len2);
+ RETVAL = CRZ_adler32_combine(adler1, adler2, len2);
#endif
OUTPUT:
RETVAL
s->MemLevel = memLevel;
s->Strategy = strategy;
- err = deflateInit2(&(s->stream), level,
+ err = CRZ_deflateInit2(&(s->stream), level,
method, windowBits, memLevel, strategy);
if (trace) {
if (DO_UTF8(dictionary) && !sv_utf8_downgrade(dictionary, 1))
croak("Wide character in Compress::Raw::Zlib::Deflate::new dicrionary parameter");
#endif
- err = deflateSetDictionary(&(s->stream), (const Bytef*) SvPVX(dictionary), SvCUR(dictionary)) ;
+ err = CRZ_deflateSetDictionary(&(s->stream), (const Bytef*) SvPVX(dictionary), SvCUR(dictionary)) ;
if (trace)
warn("deflateSetDictionary returned %d\n", err);
s->dict_adler = s->stream.adler ;
s->WindowBits = windowBits;
- err = inflateInit2(&(s->stream), windowBits);
+ err = CRZ_inflateInit2(&(s->stream), windowBits);
if (err != Z_OK) {
Safefree(s) ;
s = NULL ;
if (s->WindowBits < 0) {
STRLEN dlen;
const Bytef* b = (const Bytef*)SvPVbyte(dictionary, dlen);
- err = inflateSetDictionary(&(s->stream),
+ err = CRZ_inflateSetDictionary(&(s->stream),
b, dlen);
if (err != Z_OK) {
Safefree(s) ;
deflateReset(s)
Compress::Raw::Zlib::deflateStream s
CODE:
- RETVAL = deflateReset(&(s->stream)) ;
+ RETVAL = CRZ_deflateReset(&(s->stream)) ;
if (RETVAL == Z_OK) {
PostInitStream(s, s->flags, s->bufsize, s->WindowBits) ;
}
s->stream.avail_in = origlen;
if (s->flags & FLAG_CRC32)
- s->crc32 = crc32(s->crc32, s->stream.next_in, s->stream.avail_in) ;
+ s->crc32 = CRZ_crc32(s->crc32, s->stream.next_in, s->stream.avail_in) ;
if (s->flags & FLAG_ADLER32)
- s->adler32 = adler32(s->adler32, s->stream.next_in, s->stream.avail_in) ;
+ s->adler32 = CRZ_adler32(s->adler32, s->stream.next_in, s->stream.avail_in) ;
/* and retrieve the output buffer */
output = deRef_l(output, "deflate") ;
/* Perl_sv_dump(output); */
}
- RETVAL = deflate(&(s->stream), Z_NO_FLUSH);
+ RETVAL = CRZ_deflate(&(s->stream), Z_NO_FLUSH);
/*
if (RETVAL != Z_STREAM_ERROR) {
int done = increment - s->stream.avail_out ;
CODE:
if (trace)
printf("Compress::Raw::Zlib::deflateStream::DESTROY %p\n", s);
- deflateEnd(&s->stream) ;
+ CRZ_deflateEnd(&s->stream) ;
if (s->dictionary)
SvREFCNT_dec(s->dictionary) ;
#ifndef SETP_BYTE
/* Perl_sv_dump(output); */
}
- RETVAL = deflate(&(s->stream), f);
+ RETVAL = CRZ_deflate(&(s->stream), f);
/*
if (RETVAL != Z_STREAM_ERROR) {
int done = availableout - s->stream.avail_out ;
msg(s)
Compress::Raw::Zlib::deflateStream s
CODE:
- RETVAL = s->stream.msg;
+ RETVAL = (char*)s->stream.msg;
OUTPUT:
RETVAL
nice_length = nice_length; max_chain = max_chain; /* Silence -Wall */
croak("deflateTune needs zlib 1.2.2.3 or better");
#else
- RETVAL = deflateTune(&(s->stream), good_length, max_lazy, nice_length, max_chain);
+ RETVAL = CRZ_deflateTune(&(s->stream), good_length, max_lazy, nice_length, max_chain);
#endif
OUTPUT:
RETVAL
inflateReset(s)
Compress::Raw::Zlib::inflateStream s
CODE:
- RETVAL = inflateReset(&(s->stream)) ;
+ RETVAL = CRZ_inflateReset(&(s->stream)) ;
if (RETVAL == Z_OK) {
PostInitStream(s, s->flags, s->bufsize, s->WindowBits) ;
}
s->stream.avail_out);
DispStream(s, "BEFORE");
Perl_sv_dump(output); */
- RETVAL = inflate(&(s->stream), Z_SYNC_FLUSH);
+ RETVAL = CRZ_inflate(&(s->stream), Z_SYNC_FLUSH);
/* printf("INFLATE returned %d %s, avail in %d, out %d\n", RETVAL,
GetErrorString(RETVAL), s->stream.avail_in, s->stream.avail_out); */
STRLEN dlen;
const Bytef* b = (const Bytef*)SvPV(s->dictionary, dlen) ;
s->dict_adler = s->stream.adler ;
- RETVAL = inflateSetDictionary(&(s->stream),
+ RETVAL = CRZ_inflateSetDictionary(&(s->stream),
b, dlen);
if (RETVAL == Z_OK)
continue;
}
}
#ifdef NEED_DUMMY_BYTE_AT_END
- if (eof && RETVAL == Z_OK && s->flags & FLAG_LIMIT_OUTPUT == 0) {
- Bytef* nextIn = s->stream.next_in;
+ if (eof && RETVAL == Z_OK && (s->flags & FLAG_LIMIT_OUTPUT) == 0) {
+ Bytef* nextIn = (Bytef*)s->stream.next_in;
uInt availIn = s->stream.avail_in;
s->stream.next_in = (Bytef*) " ";
s->stream.avail_in = 1;
s->stream.avail_out = increment;
bufinc *= 2 ;
}
- RETVAL = inflate(&(s->stream), Z_SYNC_FLUSH);
+ RETVAL = CRZ_inflate(&(s->stream), Z_SYNC_FLUSH);
s->stream.next_in = nextIn ;
s->stream.avail_in = availIn ;
}
SvSETMAGIC(output);
if (s->flags & FLAG_CRC32 )
- s->crc32 = crc32(s->crc32,
+ s->crc32 = CRZ_crc32(s->crc32,
(const Bytef*)SvPVX(output)+prefix_length,
SvCUR(output)-prefix_length) ;
if (s->flags & FLAG_ADLER32)
- s->adler32 = adler32(s->adler32,
+ s->adler32 = CRZ_adler32(s->adler32,
(const Bytef*)SvPVX(output)+prefix_length,
SvCUR(output)-prefix_length) ;
s->stream.next_out = (Bytef*) NULL;
s->stream.avail_out = 0;
- RETVAL = inflateSync(&(s->stream));
+ RETVAL = CRZ_inflateSync(&(s->stream));
s->last_error = RETVAL ;
/* fix the input buffer */
DESTROY(s)
Compress::Raw::Zlib::inflateStream s
CODE:
- inflateEnd(&s->stream) ;
+ CRZ_inflateEnd(&s->stream) ;
if (s->dictionary)
SvREFCNT_dec(s->dictionary) ;
#ifndef SETP_BYTE
msg(s)
Compress::Raw::Zlib::inflateStream s
CODE:
- RETVAL = s->stream.msg;
+ RETVAL = (char*)s->stream.msg;
OUTPUT:
RETVAL
DESTROY(s)
Compress::Raw::Zlib::inflateScanStream s
CODE:
- inflateEnd(&s->stream) ;
+ CRZ_inflateEnd(&s->stream) ;
if (s->dictionary)
SvREFCNT_dec(s->dictionary) ;
#ifndef SETP_BYTE
inflateReset(s)
Compress::Raw::Zlib::inflateScanStream s
CODE:
- RETVAL = inflateReset(&(s->stream)) ;
+ RETVAL = CRZ_inflateReset(&(s->stream)) ;
if (RETVAL == Z_OK) {
PostInitStream(s, s->flags, s->bufsize, s->WindowBits) ;
}
/* DispStream(s, "before inflate\n"); */
/* inflate and check for errors */
- RETVAL = inflate(&(s->stream), Z_BLOCK);
+ RETVAL = CRZ_inflate(&(s->stream), Z_BLOCK);
if (start_len > 1 && ! eof_mode)
s->window_lastByte = *(s->stream.next_in - 1 ) ;
break ;
if (s->flags & FLAG_CRC32 )
- s->crc32 = crc32(s->crc32, s->window + s->window_have,
+ s->crc32 = CRZ_crc32(s->crc32, s->window + s->window_have,
WINDOW_SIZE - s->window_have - s->stream.avail_out);
if (s->flags & FLAG_ADLER32)
- s->adler32 = adler32(s->adler32, s->window + s->window_have,
+ s->adler32 = CRZ_adler32(s->adler32, s->window + s->window_have,
WINDOW_SIZE - s->window_have - s->stream.avail_out);
s->uncompressedBytes =
s->MemLevel = memLevel;
s->Strategy = strategy;
- err = deflateInit2(&(s->stream), level,
+ err = CRZ_deflateInit2(&(s->stream), level,
method, windowBits, memLevel, strategy);
if (err == Z_OK) {
- err = deflateSetDictionary(&(s->stream), inf_s->window, inf_s->window_have);
+ err = CRZ_deflateSetDictionary(&(s->stream), inf_s->window, inf_s->window_have);
s->dict_adler = s->stream.adler ;
}
s->stream.total_in = inf_s->stream.total_out ;
if (inf_s->window_left) {
/* printf("** window_left %d, window_lastByte %d\n", inf_s->window_left, inf_s->window_lastByte); */
- deflatePrime(&(s->stream), 8 - inf_s->window_left, inf_s->window_lastByte);
+ CRZ_deflatePrime(&(s->stream), 8 - inf_s->window_left, inf_s->window_lastByte);
}
}
}
# Setting the Gzip OS Code
#
-BUILD_ZLIB = True
-INCLUDE = ./zlib-src
-LIB = ./zlib-src
+BUILD_ZLIB = False
+INCLUDE = /usr/include
+LIB = /usr/lib
OLD_ZLIB = False
GZIP_OS_CODE = AUTO_DETECT
+USE_ZLIB_NG = False
# end of file config.in
--- /dev/null
+#!/usr/local/bin/perl
+
+use Compress::Raw::Zlib ;
+
+use strict ;
+use warnings ;
+
+binmode STDIN;
+binmode STDOUT;
+
+my $x = new Compress::Raw::Zlib::Deflate()
+ or die "Cannot create a deflation stream\n" ;
+
+my $output = '' ;
+
+while (<>)
+{
+ $x->deflate($_, $output) == Z_OK
+ or die "deflate failed\n" ;
+
+ print $output ;
+}
+
+$x->flush($output) == Z_OK
+ or die "flush failed\n" ;
+
+print $output ;
--- /dev/null
+#!/usr/local/bin/perl
+
+use Compress::Raw::Zlib ;
+
+use strict ;
+use warnings ;
+
+binmode STDIN;
+binmode STDOUT;
+
+my $x = new Compress::Raw::Zlib::Inflate
+ or die "Cannot create a inflation stream\n" ;
+
+my $input = '' ;
+my $output = '' ;
+my $status ;
+
+while (read(STDIN, $input, 4096))
+{
+ $status = $x->inflate($input, $output) ;
+
+ print $output
+ if $status == Z_OK or $status == Z_STREAM_END ;
+
+ last if $status != Z_OK ;
+}
+
+die "inflation failed\n"
+ unless $status == Z_STREAM_END ;
use bytes ;
our ($VERSION, $XS_VERSION, @ISA, @EXPORT, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD, %DEFLATE_CONSTANTS, @DEFLATE_CONSTANTS);
-$VERSION = '2.105';
+$VERSION = '2.202';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
Z_UNKNOWN
Z_VERSION_ERROR
+ ZLIBNG_VERSION
+ ZLIBNG_VERNUM
+ ZLIBNG_VER_MAJOR
+ ZLIBNG_VER_MINOR
+ ZLIBNG_VER_REVISION
+ ZLIBNG_VER_STATUS
+ ZLIBNG_VER_MODIFIED
+
WANT_GZIP
WANT_GZIP_OR_ZLIB
);
=head1 NAME
-Compress::Raw::Zlib - Low-Level Interface to zlib compression library
+Compress::Raw::Zlib - Low-Level Interface to zlib or zlib-ng compression library
=head1 SYNOPSIS
my $version = Compress::Raw::Zlib::zlib_version();
my $flags = Compress::Raw::Zlib::zlibCompileFlags();
+ is_zlib_native();
+ is_zlibng_native();
+ is_zlibng_compat();
+ is_zlibng();
+
=head1 DESCRIPTION
-The I<Compress::Raw::Zlib> module provides a Perl interface to the I<zlib>
-compression library (see L</SEE ALSO> for details about where to get
-I<zlib>).
+The I<Compress::Raw::Zlib> module provides a Perl interface to the I<zlib> or I<zlib-ng>
+compression libraries (see L</SEE ALSO> for details about where to get
+I<zlib> or I<zlib-ng>).
+
+In the text below all references to I<zlib> are also applicable to I<zlib-ng> unless otherwise stated.
=head1 Compress::Raw::Zlib::Deflate
=head2 my $version = Compress::Raw::Zlib::zlib_version();
-Returns the version of the zlib library.
+Returns the version of the I<zlib> library if this module has been built with the I<zlib> library.
+If this module has been built with I<zlib-ng> in native mode, this function will return a empty string.
+If this module has been built with I<zlib-ng> in compat mode, this function will return the Izlib> API
+verion that I<zlib-ng> is supporting.
+
+=head2 my $version = Compress::Raw::Zlib::zlibng_version();
+
+Returns the version of the zlib-ng library if this module has been built with the I<zlib-ng> library.
+If this module has been built with I<zlib>, this function will return a empty string.
=head2 my $flags = Compress::Raw::Zlib::zlibCompileFlags();
Returns the flags indicating compile-time options that were used to build
-the zlib library. See the zlib documentation for a description of the flags
+the zlib or zlib-ng library. See the zlib documentation for a description of the flags
returned by C<zlibCompileFlags>.
Note that when the zlib sources are built along with this module the
If you are using zlib 1.2.0 or older, C<zlibCompileFlags> will return 0.
+=head2 is_zlib_native();
+=head2 is_zlibng_native();
+=head2 is_zlibng_compat();
+=head2 is_zlibng();
+
+These function can use used to check if C<Compress::Raw::Zlib> was been built with I<zlib> or I<zlib-ng>.
+
+The function C<is_zlib_native> returns true if C<Compress::Raw::Zlib> was built with I<zlib>.
+The function C<is_zlibng> returns true if C<Compress::Raw::Zlib> was built with I<zlib-ng>.
+
+The I<zlib-ng> library has an option to build with a zlib-compataible API.
+The c<is_zlibng_compat> function retuens true if zlib-ng has ben built with this API.
+
+Finally, C<is_zlibng_native> returns true if I<zlib-ng> was built with its native API.
+
=head1 The LimitOutput option.
By default C<< $i->inflate($input, $output) >> will uncompress I<all> data
The primary site for the I<zlib> compression library is
L<http://www.zlib.org>.
+The primary site for the I<zlib-ng> compression library is
+L<https://github.com/zlib-ng/zlib-ng>.
+
The primary site for gzip is L<http://www.gzip.org>.
=head1 AUTHOR
--- /dev/null
+#if 0
+<<'SKIP';
+#endif
+/*
+----------------------------------------------------------------------
+
+ ppport.h -- Perl/Pollution/Portability Version 3.52
+
+ Automatically created by Devel::PPPort running under perl 5.024000.
+
+ 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
+
+=pod
+
+=head1 NAME
+
+ppport.h - Perl/Pollution/Portability version 3.52
+
+=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 5.003, and has been tested up to 5.30.
+
+=head1 OPTIONS
+
+=head2 --help
+
+Display a brief usage summary.
+
+=head2 --version
+
+Display the version of F<ppport.h>.
+
+=head2 --patch=I<file>
+
+If this option is given, a single patch file will be created if
+any changes are suggested. This requires a working diff program
+to be installed on your system.
+
+=head2 --copy=I<suffix>
+
+If this option is given, a copy of each file will be saved with
+the given suffix that contains the suggested changes. This does
+not require any external programs. Note that this does not
+automagically add a dot between the original filename and the
+suffix. If you want the dot, you have to include it in the option
+argument.
+
+If neither C<--patch> or C<--copy> are given, the default is to
+simply print the diffs for each file. This requires either
+C<Text::Diff> or a C<diff> program to be installed.
+
+=head2 --diff=I<program>
+
+Manually set the diff program and options to use. The default
+is to use C<Text::Diff>, when installed, and output unified
+context diffs.
+
+=head2 --compat-version=I<version>
+
+Tell F<ppport.h> to check for compatibility with the given
+Perl version. The default is to check for compatibility with Perl
+version 5.003. 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.
+
+ Function / Variable Static Request Global Request
+ -----------------------------------------------------------------------------------------
+ PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
+ PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
+ SvRX() NEED_SvRX NEED_SvRX_GLOBAL
+ caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL
+ croak_xs_usage() NEED_croak_xs_usage NEED_croak_xs_usage_GLOBAL
+ die_sv() NEED_die_sv NEED_die_sv_GLOBAL
+ eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
+ grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
+ grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
+ grok_number() NEED_grok_number NEED_grok_number_GLOBAL
+ grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
+ grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
+ gv_fetchpvn_flags() NEED_gv_fetchpvn_flags NEED_gv_fetchpvn_flags_GLOBAL
+ load_module() NEED_load_module NEED_load_module_GLOBAL
+ mess() NEED_mess NEED_mess_GLOBAL
+ mess_nocontext() NEED_mess_nocontext NEED_mess_nocontext_GLOBAL
+ mess_sv() NEED_mess_sv NEED_mess_sv_GLOBAL
+ mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
+ my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
+ my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
+ my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
+ my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
+ my_strnlen() NEED_my_strnlen NEED_my_strnlen_GLOBAL
+ newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
+ newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
+ newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
+ newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
+ newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
+ pv_display() NEED_pv_display NEED_pv_display_GLOBAL
+ pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
+ pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
+ sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
+ sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
+ sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
+ sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
+ sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
+ sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
+ sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
+ sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL
+ utf8_to_uvchr_buf() NEED_utf8_to_uvchr_buf NEED_utf8_to_uvchr_buf_GLOBAL
+ vload_module() NEED_vload_module NEED_vload_module_GLOBAL
+ vmess() NEED_vmess NEED_vmess_GLOBAL
+ vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
+ warner() NEED_warner NEED_warner_GLOBAL
+
+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
+send a bug report to L<perlbug@perl.org|mailto:perlbug@perl.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-2013, Marcus Holland-Moritz.
+
+Version 2.x, Copyright (C) 2001, Paul Marquess.
+
+Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+See L<Devel::PPPort>.
+
+=cut
+
+use strict;
+
+# Disable broken TRIE-optimization
+BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if "$]" >= 5.009004 && "$]" <= 5.009005 }
+
+my $VERSION = 3.52;
+
+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(
+AvFILLp|5.004050||p
+AvFILL|||
+BOM_UTF8|||
+BhkDISABLE||5.024000|
+BhkENABLE||5.024000|
+BhkENTRY_set||5.024000|
+BhkENTRY|||
+BhkFLAGS|||
+CALL_BLOCK_HOOKS|||
+CLASS|||n
+CPERLscope|5.005000||p
+CX_CURPAD_SAVE|||
+CX_CURPAD_SV|||
+C_ARRAY_END|5.013002||p
+C_ARRAY_LENGTH|5.008001||p
+CopFILEAV|5.006000||p
+CopFILEGV_set|5.006000||p
+CopFILEGV|5.006000||p
+CopFILESV|5.006000||p
+CopFILE_set|5.006000||p
+CopFILE|5.006000||p
+CopSTASHPV_set|5.006000||p
+CopSTASHPV|5.006000||p
+CopSTASH_eq|5.006000||p
+CopSTASH_set|5.006000||p
+CopSTASH|5.006000||p
+CopyD|5.009002|5.004050|p
+Copy|||
+CvPADLIST||5.008001|
+CvSTASH|||
+CvWEAKOUTSIDE|||
+DECLARATION_FOR_LC_NUMERIC_MANIPULATION||5.021010|n
+DEFSV_set|5.010001||p
+DEFSV|5.004050||p
+DO_UTF8||5.006000|
+END_EXTERN_C|5.005000||p
+ENTER|||
+ERRSV|5.004050||p
+EXTEND|||
+EXTERN_C|5.005000||p
+F0convert|||n
+FREETMPS|||
+GIMME_V||5.004000|n
+GIMME|||n
+GROK_NUMERIC_RADIX|5.007002||p
+G_ARRAY|||
+G_DISCARD|||
+G_EVAL|||
+G_METHOD|5.006001||p
+G_NOARGS|||
+G_SCALAR|||
+G_VOID||5.004000|
+GetVars|||
+GvAV|||
+GvCV|||
+GvHV|||
+GvSV|||
+Gv_AMupdate||5.011000|
+HEf_SVKEY|5.003070||p
+HeHASH||5.003070|
+HeKEY||5.003070|
+HeKLEN||5.003070|
+HePV||5.004000|
+HeSVKEY_force||5.003070|
+HeSVKEY_set||5.004000|
+HeSVKEY||5.003070|
+HeUTF8|5.010001|5.008000|p
+HeVAL||5.003070|
+HvENAMELEN||5.015004|
+HvENAMEUTF8||5.015004|
+HvENAME||5.013007|
+HvNAMELEN_get|5.009003||p
+HvNAMELEN||5.015004|
+HvNAMEUTF8||5.015004|
+HvNAME_get|5.009003||p
+HvNAME|||
+INT2PTR|5.006000||p
+IN_LOCALE_COMPILETIME|5.007002||p
+IN_LOCALE_RUNTIME|5.007002||p
+IN_LOCALE|5.007002||p
+IN_PERL_COMPILETIME|5.008001||p
+IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
+IS_NUMBER_INFINITY|5.007002||p
+IS_NUMBER_IN_UV|5.007002||p
+IS_NUMBER_NAN|5.007003||p
+IS_NUMBER_NEG|5.007002||p
+IS_NUMBER_NOT_INT|5.007002||p
+IVSIZE|5.006000||p
+IVTYPE|5.006000||p
+IVdf|5.006000||p
+LEAVE|||
+LIKELY|||p
+LINKLIST||5.013006|
+LVRET|||
+MARK|||
+MULTICALL||5.024000|
+MUTABLE_PTR|5.010001||p
+MUTABLE_SV|5.010001||p
+MY_CXT_CLONE|5.009002||p
+MY_CXT_INIT|5.007003||p
+MY_CXT|5.007003||p
+MoveD|5.009002|5.004050|p
+Move|||
+NOOP|5.005000||p
+NUM2PTR|5.006000||p
+NVTYPE|5.006000||p
+NVef|5.006001||p
+NVff|5.006001||p
+NVgf|5.006001||p
+Newxc|5.009003||p
+Newxz|5.009003||p
+Newx|5.009003||p
+Nullav|||
+Nullch|||
+Nullcv|||
+Nullhv|||
+Nullsv|||
+OP_CLASS||5.013007|
+OP_DESC||5.007003|
+OP_NAME||5.007003|
+OP_TYPE_IS_OR_WAS||5.019010|
+OP_TYPE_IS||5.019007|
+ORIGMARK|||
+OpHAS_SIBLING|5.021007||p
+OpLASTSIB_set|5.021011||p
+OpMAYBESIB_set|5.021011||p
+OpMORESIB_set|5.021011||p
+OpSIBLING|5.021007||p
+PAD_BASE_SV|||
+PAD_CLONE_VARS|||
+PAD_COMPNAME_FLAGS|||
+PAD_COMPNAME_GEN_set|||
+PAD_COMPNAME_GEN|||
+PAD_COMPNAME_OURSTASH|||
+PAD_COMPNAME_PV|||
+PAD_COMPNAME_TYPE|||
+PAD_RESTORE_LOCAL|||
+PAD_SAVE_LOCAL|||
+PAD_SAVE_SETNULLPAD|||
+PAD_SETSV|||
+PAD_SET_CUR_NOSAVE|||
+PAD_SET_CUR|||
+PAD_SVl|||
+PAD_SV|||
+PERLIO_FUNCS_CAST|5.009003||p
+PERLIO_FUNCS_DECL|5.009003||p
+PERL_ABS|5.008001||p
+PERL_ARGS_ASSERT_CROAK_XS_USAGE|||p
+PERL_BCDVERSION|5.024000||p
+PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
+PERL_HASH|5.003070||p
+PERL_INT_MAX|5.003070||p
+PERL_INT_MIN|5.003070||p
+PERL_LONG_MAX|5.003070||p
+PERL_LONG_MIN|5.003070||p
+PERL_MAGIC_arylen|5.007002||p
+PERL_MAGIC_backref|5.007002||p
+PERL_MAGIC_bm|5.007002||p
+PERL_MAGIC_collxfrm|5.007002||p
+PERL_MAGIC_dbfile|5.007002||p
+PERL_MAGIC_dbline|5.007002||p
+PERL_MAGIC_defelem|5.007002||p
+PERL_MAGIC_envelem|5.007002||p
+PERL_MAGIC_env|5.007002||p
+PERL_MAGIC_ext|5.007002||p
+PERL_MAGIC_fm|5.007002||p
+PERL_MAGIC_glob|5.024000||p
+PERL_MAGIC_isaelem|5.007002||p
+PERL_MAGIC_isa|5.007002||p
+PERL_MAGIC_mutex|5.024000||p
+PERL_MAGIC_nkeys|5.007002||p
+PERL_MAGIC_overload_elem|5.024000||p
+PERL_MAGIC_overload_table|5.007002||p
+PERL_MAGIC_overload|5.024000||p
+PERL_MAGIC_pos|5.007002||p
+PERL_MAGIC_qr|5.007002||p
+PERL_MAGIC_regdata|5.007002||p
+PERL_MAGIC_regdatum|5.007002||p
+PERL_MAGIC_regex_global|5.007002||p
+PERL_MAGIC_shared_scalar|5.007003||p
+PERL_MAGIC_shared|5.007003||p
+PERL_MAGIC_sigelem|5.007002||p
+PERL_MAGIC_sig|5.007002||p
+PERL_MAGIC_substr|5.007002||p
+PERL_MAGIC_sv|5.007002||p
+PERL_MAGIC_taint|5.007002||p
+PERL_MAGIC_tiedelem|5.007002||p
+PERL_MAGIC_tiedscalar|5.007002||p
+PERL_MAGIC_tied|5.007002||p
+PERL_MAGIC_utf8|5.008001||p
+PERL_MAGIC_uvar_elem|5.007003||p
+PERL_MAGIC_uvar|5.007002||p
+PERL_MAGIC_vec|5.007002||p
+PERL_MAGIC_vstring|5.008001||p
+PERL_PV_ESCAPE_ALL|5.009004||p
+PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
+PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
+PERL_PV_ESCAPE_NOCLEAR|5.009004||p
+PERL_PV_ESCAPE_QUOTE|5.009004||p
+PERL_PV_ESCAPE_RE|5.009005||p
+PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
+PERL_PV_ESCAPE_UNI|5.009004||p
+PERL_PV_PRETTY_DUMP|5.009004||p
+PERL_PV_PRETTY_ELLIPSES|5.010000||p
+PERL_PV_PRETTY_LTGT|5.009004||p
+PERL_PV_PRETTY_NOCLEAR|5.010000||p
+PERL_PV_PRETTY_QUOTE|5.009004||p
+PERL_PV_PRETTY_REGPROP|5.009004||p
+PERL_QUAD_MAX|5.003070||p
+PERL_QUAD_MIN|5.003070||p
+PERL_REVISION|5.006000||p
+PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
+PERL_SCAN_DISALLOW_PREFIX|5.007003||p
+PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
+PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
+PERL_SHORT_MAX|5.003070||p
+PERL_SHORT_MIN|5.003070||p
+PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
+PERL_SUBVERSION|5.006000||p
+PERL_SYS_INIT3||5.006000|
+PERL_SYS_INIT|||
+PERL_SYS_TERM||5.024000|
+PERL_UCHAR_MAX|5.003070||p
+PERL_UCHAR_MIN|5.003070||p
+PERL_UINT_MAX|5.003070||p
+PERL_UINT_MIN|5.003070||p
+PERL_ULONG_MAX|5.003070||p
+PERL_ULONG_MIN|5.003070||p
+PERL_UNUSED_ARG|5.009003||p
+PERL_UNUSED_CONTEXT|5.009004||p
+PERL_UNUSED_DECL|5.007002||p
+PERL_UNUSED_RESULT|5.021001||p
+PERL_UNUSED_VAR|5.007002||p
+PERL_UQUAD_MAX|5.003070||p
+PERL_UQUAD_MIN|5.003070||p
+PERL_USE_GCC_BRACE_GROUPS|5.009004||p
+PERL_USHORT_MAX|5.003070||p
+PERL_USHORT_MIN|5.003070||p
+PERL_VERSION|5.006000||p
+PL_DBsignal|5.005000||p
+PL_DBsingle|||pn
+PL_DBsub|||pn
+PL_DBtrace|||pn
+PL_Sv|5.005000||p
+PL_bufend|5.024000||p
+PL_bufptr|5.024000||p
+PL_check||5.006000|
+PL_compiling|5.004050||p
+PL_comppad_name||5.017004|
+PL_comppad||5.008001|
+PL_copline|5.024000||p
+PL_curcop|5.004050||p
+PL_curpad||5.005000|
+PL_curstash|5.004050||p
+PL_debstash|5.004050||p
+PL_defgv|5.004050||p
+PL_diehook|5.004050||p
+PL_dirty|5.004050||p
+PL_dowarn|||pn
+PL_errgv|5.004050||p
+PL_error_count|5.024000||p
+PL_expect|5.024000||p
+PL_hexdigit|5.005000||p
+PL_hints|5.005000||p
+PL_in_my_stash|5.024000||p
+PL_in_my|5.024000||p
+PL_keyword_plugin||5.011002|
+PL_last_in_gv|||n
+PL_laststatval|5.005000||p
+PL_lex_state|5.024000||p
+PL_lex_stuff|5.024000||p
+PL_linestr|5.024000||p
+PL_modglobal||5.005000|n
+PL_na|5.004050||pn
+PL_no_modify|5.006000||p
+PL_ofsgv|||n
+PL_opfreehook||5.011000|n
+PL_parser|5.009005||p
+PL_peepp||5.007003|n
+PL_perl_destruct_level|5.004050||p
+PL_perldb|5.004050||p
+PL_ppaddr|5.006000||p
+PL_rpeepp||5.013005|n
+PL_rsfp_filters|5.024000||p
+PL_rsfp|5.024000||p
+PL_rs|||n
+PL_signals|5.008001||p
+PL_stack_base|5.004050||p
+PL_stack_sp|5.004050||p
+PL_statcache|5.005000||p
+PL_stdingv|5.004050||p
+PL_sv_arenaroot|5.004050||p
+PL_sv_no|5.004050||pn
+PL_sv_undef|5.004050||pn
+PL_sv_yes|5.004050||pn
+PL_sv_zero|||n
+PL_tainted|5.004050||p
+PL_tainting|5.004050||p
+PL_tokenbuf|5.024000||p
+POP_MULTICALL||5.024000|
+POPi|||n
+POPl|||n
+POPn|||n
+POPpbytex||5.007001|n
+POPpx||5.005030|n
+POPp|||n
+POPs|||n
+POPul||5.006000|n
+POPu||5.004000|n
+PTR2IV|5.006000||p
+PTR2NV|5.006000||p
+PTR2UV|5.006000||p
+PTR2nat|5.009003||p
+PTR2ul|5.007001||p
+PTRV|5.006000||p
+PUSHMARK|||
+PUSH_MULTICALL||5.024000|
+PUSHi|||
+PUSHmortal|5.009002||p
+PUSHn|||
+PUSHp|||
+PUSHs|||
+PUSHu|5.004000||p
+PUTBACK|||
+PadARRAY||5.024000|
+PadMAX||5.024000|
+PadlistARRAY||5.024000|
+PadlistMAX||5.024000|
+PadlistNAMESARRAY||5.024000|
+PadlistNAMESMAX||5.024000|
+PadlistNAMES||5.024000|
+PadlistREFCNT||5.017004|
+PadnameIsOUR|||
+PadnameIsSTATE|||
+PadnameLEN||5.024000|
+PadnameOURSTASH|||
+PadnameOUTER|||
+PadnamePV||5.024000|
+PadnameREFCNT_dec||5.024000|
+PadnameREFCNT||5.024000|
+PadnameSV||5.024000|
+PadnameTYPE|||
+PadnameUTF8||5.021007|
+PadnamelistARRAY||5.024000|
+PadnamelistMAX||5.024000|
+PadnamelistREFCNT_dec||5.024000|
+PadnamelistREFCNT||5.024000|
+PerlIO_clearerr||5.007003|
+PerlIO_close||5.007003|
+PerlIO_context_layers||5.009004|
+PerlIO_eof||5.007003|
+PerlIO_error||5.007003|
+PerlIO_fileno||5.007003|
+PerlIO_fill||5.007003|
+PerlIO_flush||5.007003|
+PerlIO_get_base||5.007003|
+PerlIO_get_bufsiz||5.007003|
+PerlIO_get_cnt||5.007003|
+PerlIO_get_ptr||5.007003|
+PerlIO_read||5.007003|
+PerlIO_restore_errno|||
+PerlIO_save_errno|||
+PerlIO_seek||5.007003|
+PerlIO_set_cnt||5.007003|
+PerlIO_set_ptrcnt||5.007003|
+PerlIO_setlinebuf||5.007003|
+PerlIO_stderr||5.007003|
+PerlIO_stdin||5.007003|
+PerlIO_stdout||5.007003|
+PerlIO_tell||5.007003|
+PerlIO_unread||5.007003|
+PerlIO_write||5.007003|
+PerlLIO_dup2_cloexec|||
+PerlLIO_dup_cloexec|||
+PerlLIO_open3_cloexec|||
+PerlLIO_open_cloexec|||
+PerlProc_pipe_cloexec|||
+PerlSock_accept_cloexec|||
+PerlSock_socket_cloexec|||
+PerlSock_socketpair_cloexec|||
+Perl_langinfo|||n
+Perl_setlocale|||n
+PoisonFree|5.009004||p
+PoisonNew|5.009004||p
+PoisonWith|5.009004||p
+Poison|5.008000||p
+READ_XDIGIT||5.017006|
+REPLACEMENT_CHARACTER_UTF8|||
+RESTORE_LC_NUMERIC||5.024000|
+RETVAL|||n
+Renewc|||
+Renew|||
+SAVECLEARSV|||
+SAVECOMPPAD|||
+SAVEPADSV|||
+SAVETMPS|||
+SAVE_DEFSV|5.004050||p
+SPAGAIN|||
+SP|||
+START_EXTERN_C|5.005000||p
+START_MY_CXT|5.007003||p
+STMT_END|||p
+STMT_START|||p
+STORE_LC_NUMERIC_FORCE_TO_UNDERLYING||5.024000|
+STORE_LC_NUMERIC_SET_TO_NEEDED||5.024000|
+STR_WITH_LEN|5.009003||p
+ST|||
+SV_CONST_RETURN|5.009003||p
+SV_COW_DROP_PV|5.008001||p
+SV_COW_SHARED_HASH_KEYS|5.009005||p
+SV_GMAGIC|5.007002||p
+SV_HAS_TRAILING_NUL|5.009004||p
+SV_IMMEDIATE_UNREF|5.007001||p
+SV_MUTABLE_RETURN|5.009003||p
+SV_NOSTEAL|5.009002||p
+SV_SMAGIC|5.009003||p
+SV_UTF8_NO_ENCODING|5.008001||p
+SVfARG|5.009005||p
+SVf_UTF8|5.006000||p
+SVf|5.006000||p
+SVt_INVLIST||5.019002|
+SVt_IV|||
+SVt_NULL|||
+SVt_NV|||
+SVt_PVAV|||
+SVt_PVCV|||
+SVt_PVFM|||
+SVt_PVGV|||
+SVt_PVHV|||
+SVt_PVIO|||
+SVt_PVIV|||
+SVt_PVLV|||
+SVt_PVMG|||
+SVt_PVNV|||
+SVt_PV|||
+SVt_REGEXP||5.011000|
+Safefree|||
+Slab_Alloc|||
+Slab_Free|||
+Slab_to_ro|||
+Slab_to_rw|||
+StructCopy|||
+SvCUR_set|||
+SvCUR|||
+SvEND|||
+SvGAMAGIC||5.006001|
+SvGETMAGIC|5.004050||p
+SvGROW|||
+SvIOK_UV||5.006000|
+SvIOK_notUV||5.006000|
+SvIOK_off|||
+SvIOK_only_UV||5.006000|
+SvIOK_only|||
+SvIOK_on|||
+SvIOKp|||
+SvIOK|||
+SvIVX|||
+SvIV_nomg|5.009001||p
+SvIV_set|||
+SvIVx|||
+SvIV|||
+SvIsCOW_shared_hash||5.008003|
+SvIsCOW||5.008003|
+SvLEN_set|||
+SvLEN|||
+SvLOCK||5.007003|
+SvMAGIC_set|5.009003||p
+SvNIOK_off|||
+SvNIOKp|||
+SvNIOK|||
+SvNOK_off|||
+SvNOK_only|||
+SvNOK_on|||
+SvNOKp|||
+SvNOK|||
+SvNVX|||
+SvNV_nomg||5.013002|
+SvNV_set|||
+SvNVx|||
+SvNV|||
+SvOK|||
+SvOOK_offset||5.011000|
+SvOOK|||
+SvPOK_off|||
+SvPOK_only_UTF8||5.006000|
+SvPOK_only|||
+SvPOK_on|||
+SvPOKp|||
+SvPOK|||
+SvPVCLEAR|||
+SvPVX_const|5.009003||p
+SvPVX_mutable|5.009003||p
+SvPVX|||
+SvPV_const|5.009003||p
+SvPV_flags_const_nolen|5.009003||p
+SvPV_flags_const|5.009003||p
+SvPV_flags_mutable|5.009003||p
+SvPV_flags|5.007002||p
+SvPV_force_flags_mutable|5.009003||p
+SvPV_force_flags_nolen|5.009003||p
+SvPV_force_flags|5.007002||p
+SvPV_force_mutable|5.009003||p
+SvPV_force_nolen|5.009003||p
+SvPV_force_nomg_nolen|5.009003||p
+SvPV_force_nomg|5.007002||p
+SvPV_force|||p
+SvPV_mutable|5.009003||p
+SvPV_nolen_const|5.009003||p
+SvPV_nolen|5.006000||p
+SvPV_nomg_const_nolen|5.009003||p
+SvPV_nomg_const|5.009003||p
+SvPV_nomg_nolen|5.013007||p
+SvPV_nomg|5.007002||p
+SvPV_renew|5.009003||p
+SvPV_set|||
+SvPVbyte_force||5.009002|
+SvPVbyte_nolen||5.006000|
+SvPVbytex_force||5.006000|
+SvPVbytex||5.006000|
+SvPVbyte|5.006000||p
+SvPVutf8_force||5.006000|
+SvPVutf8_nolen||5.006000|
+SvPVutf8x_force||5.006000|
+SvPVutf8x||5.006000|
+SvPVutf8||5.006000|
+SvPVx|||
+SvPV|||
+SvREADONLY_off|||
+SvREADONLY_on|||
+SvREADONLY|||
+SvREFCNT_dec_NN||5.017007|
+SvREFCNT_dec|||
+SvREFCNT_inc_NN|5.009004||p
+SvREFCNT_inc_simple_NN|5.009004||p
+SvREFCNT_inc_simple_void_NN|5.009004||p
+SvREFCNT_inc_simple_void|5.009004||p
+SvREFCNT_inc_simple|5.009004||p
+SvREFCNT_inc_void_NN|5.009004||p
+SvREFCNT_inc_void|5.009004||p
+SvREFCNT_inc|||p
+SvREFCNT|||
+SvROK_off|||
+SvROK_on|||
+SvROK|||
+SvRV_set|5.009003||p
+SvRV|||
+SvRXOK|5.009005||p
+SvRX|5.009005||p
+SvSETMAGIC|||
+SvSHARED_HASH|5.009003||p
+SvSHARE||5.007003|
+SvSTASH_set|5.009003||p
+SvSTASH|||
+SvSetMagicSV_nosteal||5.004000|
+SvSetMagicSV||5.004000|
+SvSetSV_nosteal||5.004000|
+SvSetSV|||
+SvTAINTED_off||5.004000|
+SvTAINTED_on||5.004000|
+SvTAINTED||5.004000|
+SvTAINT|||
+SvTHINKFIRST|||
+SvTRUE_nomg||5.013006|
+SvTRUE|||
+SvTYPE|||
+SvUNLOCK||5.007003|
+SvUOK|5.007001|5.006000|p
+SvUPGRADE|||
+SvUTF8_off||5.006000|
+SvUTF8_on||5.006000|
+SvUTF8||5.006000|
+SvUVXx|5.004000||p
+SvUVX|5.004000||p
+SvUV_nomg|5.009001||p
+SvUV_set|5.009003||p
+SvUVx|5.004000||p
+SvUV|5.004000||p
+SvVOK||5.008001|
+SvVSTRING_mg|5.009004||p
+THIS|||n
+UNDERBAR|5.009002||p
+UNICODE_REPLACEMENT|||p
+UNLIKELY|||p
+UTF8SKIP||5.006000|
+UTF8_IS_INVARIANT|||
+UTF8_IS_NONCHAR|||
+UTF8_IS_SUPER|||
+UTF8_IS_SURROGATE|||
+UTF8_MAXBYTES|5.009002||p
+UTF8_SAFE_SKIP|||p
+UVCHR_IS_INVARIANT|||
+UVCHR_SKIP||5.022000|
+UVSIZE|5.006000||p
+UVTYPE|5.006000||p
+UVXf|5.007001||p
+UVof|5.006000||p
+UVuf|5.006000||p
+UVxf|5.006000||p
+WARN_ALL|5.006000||p
+WARN_AMBIGUOUS|5.006000||p
+WARN_ASSERTIONS|5.024000||p
+WARN_BAREWORD|5.006000||p
+WARN_CLOSED|5.006000||p
+WARN_CLOSURE|5.006000||p
+WARN_DEBUGGING|5.006000||p
+WARN_DEPRECATED|5.006000||p
+WARN_DIGIT|5.006000||p
+WARN_EXEC|5.006000||p
+WARN_EXITING|5.006000||p
+WARN_GLOB|5.006000||p
+WARN_INPLACE|5.006000||p
+WARN_INTERNAL|5.006000||p
+WARN_IO|5.006000||p
+WARN_LAYER|5.008000||p
+WARN_MALLOC|5.006000||p
+WARN_MISC|5.006000||p
+WARN_NEWLINE|5.006000||p
+WARN_NUMERIC|5.006000||p
+WARN_ONCE|5.006000||p
+WARN_OVERFLOW|5.006000||p
+WARN_PACK|5.006000||p
+WARN_PARENTHESIS|5.006000||p
+WARN_PIPE|5.006000||p
+WARN_PORTABLE|5.006000||p
+WARN_PRECEDENCE|5.006000||p
+WARN_PRINTF|5.006000||p
+WARN_PROTOTYPE|5.006000||p
+WARN_QW|5.006000||p
+WARN_RECURSION|5.006000||p
+WARN_REDEFINE|5.006000||p
+WARN_REGEXP|5.006000||p
+WARN_RESERVED|5.006000||p
+WARN_SEMICOLON|5.006000||p
+WARN_SEVERE|5.006000||p
+WARN_SIGNAL|5.006000||p
+WARN_SUBSTR|5.006000||p
+WARN_SYNTAX|5.006000||p
+WARN_TAINT|5.006000||p
+WARN_THREADS|5.008000||p
+WARN_UNINITIALIZED|5.006000||p
+WARN_UNOPENED|5.006000||p
+WARN_UNPACK|5.006000||p
+WARN_UNTIE|5.006000||p
+WARN_UTF8|5.006000||p
+WARN_VOID|5.006000||p
+WIDEST_UTYPE|5.015004||p
+XCPT_CATCH|5.009002||p
+XCPT_RETHROW|5.009002||p
+XCPT_TRY_END|5.009002||p
+XCPT_TRY_START|5.009002||p
+XPUSHi|||
+XPUSHmortal|5.009002||p
+XPUSHn|||
+XPUSHp|||
+XPUSHs|||
+XPUSHu|5.004000||p
+XSPROTO|5.010000||p
+XSRETURN_EMPTY|||
+XSRETURN_IV|||
+XSRETURN_NO|||
+XSRETURN_NV|||
+XSRETURN_PV|||
+XSRETURN_UNDEF|||
+XSRETURN_UV|5.008001||p
+XSRETURN_YES|||
+XSRETURN|||p
+XST_mIV|||
+XST_mNO|||
+XST_mNV|||
+XST_mPV|||
+XST_mUNDEF|||
+XST_mUV|5.008001||p
+XST_mYES|||
+XS_APIVERSION_BOOTCHECK||5.024000|
+XS_EXTERNAL||5.024000|
+XS_INTERNAL||5.024000|
+XS_VERSION_BOOTCHECK||5.024000|
+XS_VERSION|||
+XSprePUSH|5.006000||p
+XS|||
+XopDISABLE||5.024000|
+XopENABLE||5.024000|
+XopENTRYCUSTOM||5.024000|
+XopENTRY_set||5.024000|
+XopENTRY||5.024000|
+XopFLAGS||5.013007|
+ZeroD|5.009002||p
+Zero|||
+__ASSERT_|||p
+_aMY_CXT|5.007003||p
+_inverse_folds|||
+_is_grapheme|||
+_is_in_locale_category|||
+_new_invlist_C_array|||
+_pMY_CXT|5.007003||p
+_to_fold_latin1|||n
+_to_upper_title_latin1|||
+_to_utf8_case|||
+_variant_byte_number|||n
+_warn_problematic_locale|||n
+aMY_CXT_|5.007003||p
+aMY_CXT|5.007003||p
+aTHXR_|5.024000||p
+aTHXR|5.024000||p
+aTHX_|5.006000||p
+aTHX|5.006000||p
+abort_execution|||
+add_above_Latin1_folds|||
+add_data|||n
+add_multi_match|||
+add_utf16_textfilter|||
+adjust_size_and_find_bucket|||n
+advance_one_LB|||
+advance_one_SB|||
+advance_one_WB|||
+allocmy|||
+amagic_call|||
+amagic_cmp_locale|||
+amagic_cmp|||
+amagic_deref_call||5.013007|
+amagic_i_ncmp|||
+amagic_is_enabled|||
+amagic_ncmp|||
+anonymise_cv_maybe|||
+any_dup|||
+ao|||
+apply_attrs_my|||
+apply_attrs|||
+apply|||
+argvout_final|||
+assert_uft8_cache_coherent|||
+assignment_type|||
+atfork_lock||5.007003|n
+atfork_unlock||5.007003|n
+av_arylen_p||5.009003|
+av_clear|||
+av_delete||5.006000|
+av_exists||5.006000|
+av_extend_guts|||
+av_extend|||
+av_fetch|||
+av_fill|||
+av_iter_p||5.011000|
+av_len|||
+av_make|||
+av_nonelem|||
+av_pop|||
+av_push|||
+av_reify|||
+av_shift|||
+av_store|||
+av_tindex|5.017009|5.017009|p
+av_top_index|5.017009|5.017009|p
+av_undef|||
+av_unshift|||
+ax|||n
+backup_one_GCB|||
+backup_one_LB|||
+backup_one_SB|||
+backup_one_WB|||
+bad_type_gv|||
+bad_type_pv|||
+bind_match|||
+block_end||5.004000|
+block_gimme||5.004000|
+block_start||5.004000|
+blockhook_register||5.013003|
+boolSV|5.004000||p
+boot_core_PerlIO|||
+boot_core_UNIVERSAL|||
+boot_core_mro|||
+bytes_cmp_utf8||5.013007|
+cBOOL|5.013000||p
+call_argv|5.006000||p
+call_atexit||5.006000|
+call_list||5.004000|
+call_method|5.006000||p
+call_pv|5.006000||p
+call_sv|5.006000||p
+caller_cx|5.013005|5.006000|p
+calloc||5.007002|n
+cando|||
+cast_i32||5.006000|n
+cast_iv||5.006000|n
+cast_ulong||5.006000|n
+cast_uv||5.006000|n
+category_name|||n
+change_engine_size|||
+check_and_deprecate|||
+check_type_and_open|||
+check_uni|||
+checkcomma|||
+ckWARN2_d|||
+ckWARN2|||
+ckWARN3_d|||
+ckWARN3|||
+ckWARN4_d|||
+ckWARN4|||
+ckWARN_d|||
+ckWARN|5.006000||p
+ck_entersub_args_core|||
+ck_entersub_args_list||5.013006|
+ck_entersub_args_proto_or_list||5.013006|
+ck_entersub_args_proto||5.013006|
+ck_warner_d||5.011001|v
+ck_warner||5.011001|v
+ckwarn_common|||
+ckwarn_d||5.009003|
+ckwarn||5.009003|
+clear_defarray||5.023008|
+clear_special_blocks|||
+clone_params_del|||n
+clone_params_new|||n
+closest_cop|||
+cntrl_to_mnemonic|||n
+compute_EXACTish|||n
+construct_ahocorasick_from_trie|||
+cop_free|||
+cop_hints_2hv||5.013007|
+cop_hints_fetch_pvn||5.013007|
+cop_hints_fetch_pvs||5.013007|
+cop_hints_fetch_pv||5.013007|
+cop_hints_fetch_sv||5.013007|
+cophh_2hv||5.013007|
+cophh_copy||5.013007|
+cophh_delete_pvn||5.013007|
+cophh_delete_pvs||5.013007|
+cophh_delete_pv||5.013007|
+cophh_delete_sv||5.013007|
+cophh_fetch_pvn||5.013007|
+cophh_fetch_pvs||5.013007|
+cophh_fetch_pv||5.013007|
+cophh_fetch_sv||5.013007|
+cophh_free||5.013007|
+cophh_new_empty||5.024000|
+cophh_store_pvn||5.013007|
+cophh_store_pvs||5.013007|
+cophh_store_pv||5.013007|
+cophh_store_sv||5.013007|
+core_prototype|||
+coresub_op|||
+cr_textfilter|||
+croak_caller|||vn
+croak_memory_wrap|5.019003||pn
+croak_no_mem|||n
+croak_no_modify|5.013003||pn
+croak_nocontext|||pvn
+croak_popstack|||n
+croak_sv|5.013001||p
+croak_xs_usage|5.010001||pn
+croak|||v
+csighandler||5.009003|n
+current_re_engine|||
+curse|||
+custom_op_desc||5.007003|
+custom_op_get_field|||
+custom_op_name||5.007003|
+custom_op_register||5.013007|
+custom_op_xop||5.013007|
+cv_clone_into|||
+cv_clone|||
+cv_const_sv_or_av|||n
+cv_const_sv||5.003070|n
+cv_dump|||
+cv_forget_slab|||
+cv_get_call_checker_flags|||
+cv_get_call_checker||5.013006|
+cv_name||5.021005|
+cv_set_call_checker_flags||5.021004|
+cv_set_call_checker||5.013006|
+cv_undef_flags|||
+cv_undef|||
+cvgv_from_hek|||
+cvgv_set|||
+cvstash_set|||
+cx_dump||5.005000|
+cx_dup|||
+cxinc|||
+dAXMARK|5.009003||p
+dAX|5.007002||p
+dITEMS|5.007002||p
+dMARK|||
+dMULTICALL||5.009003|
+dMY_CXT_SV|5.007003||p
+dMY_CXT|5.007003||p
+dNOOP|5.006000||p
+dORIGMARK|||
+dSP|||
+dTHR|5.004050||p
+dTHXR|5.024000||p
+dTHXa|5.006000||p
+dTHXoa|5.006000||p
+dTHX|5.006000||p
+dUNDERBAR|5.009002||p
+dVAR|5.009003||p
+dXCPT|5.009002||p
+dXSARGS|||
+dXSI32|||
+dXSTARG|5.006000||p
+deb_curcv|||
+deb_nocontext|||vn
+deb_stack_all|||
+deb_stack_n|||
+debop||5.005000|
+debprofdump||5.005000|
+debprof|||
+debstackptrs||5.007003|
+debstack||5.007003|
+debug_start_match|||
+deb||5.007003|v
+defelem_target|||
+del_sv|||
+delimcpy_no_escape|||n
+delimcpy||5.004000|n
+despatch_signals||5.007001|
+destroy_matcher|||
+die_nocontext|||vn
+die_sv|5.013001||p
+die_unwind|||
+die|||v
+dirp_dup|||
+div128|||
+djSP|||
+do_aexec5|||
+do_aexec|||
+do_aspawn|||
+do_binmode||5.004050|
+do_chomp|||
+do_close|||
+do_delete_local|||
+do_dump_pad|||
+do_eof|||
+do_exec3|||
+do_exec|||
+do_gv_dump||5.006000|
+do_gvgv_dump||5.006000|
+do_hv_dump||5.006000|
+do_ipcctl|||
+do_ipcget|||
+do_join|||
+do_magic_dump||5.006000|
+do_msgrcv|||
+do_msgsnd|||
+do_ncmp|||
+do_oddball|||
+do_op_dump||5.006000|
+do_open9||5.006000|
+do_openn||5.007001|
+do_open||5.003070|
+do_pmop_dump||5.006000|
+do_print|||
+do_readline|||
+do_seek|||
+do_semop|||
+do_shmio|||
+do_smartmatch|||
+do_spawn_nowait|||
+do_spawn|||
+do_sprintf|||
+do_sv_dump||5.006000|
+do_sysseek|||
+do_tell|||
+do_trans_complex_utf8|||
+do_trans_complex|||
+do_trans_count_utf8|||
+do_trans_count|||
+do_trans_simple_utf8|||
+do_trans_simple|||
+do_trans|||
+do_vecget|||
+do_vecset|||
+do_vop|||
+docatch|||
+does_utf8_overflow|||n
+doeval_compile|||
+dofile|||
+dofindlabel|||
+doform|||
+doing_taint||5.008001|n
+dooneliner|||
+doopen_pm|||
+doparseform|||
+dopoptoeval|||
+dopoptogivenfor|||
+dopoptolabel|||
+dopoptoloop|||
+dopoptosub_at|||
+dopoptowhen|||
+doref||5.009003|
+dounwind|||
+dowantarray|||
+drand48_init_r|||n
+drand48_r|||n
+dtrace_probe_call|||
+dtrace_probe_load|||
+dtrace_probe_op|||
+dtrace_probe_phase|||
+dump_all_perl|||
+dump_all||5.006000|
+dump_c_backtrace|||
+dump_eval||5.006000|
+dump_exec_pos|||
+dump_form||5.006000|
+dump_indent||5.006000|v
+dump_mstats|||
+dump_packsubs_perl|||
+dump_packsubs||5.006000|
+dump_regex_sets_structures|||
+dump_sub_perl|||
+dump_sub||5.006000|
+dump_sv_child|||
+dump_trie_interim_list|||
+dump_trie_interim_table|||
+dump_trie|||
+dump_vindent||5.006000|
+dumpuntil|||
+dup_attrlist|||
+dup_warnings|||
+edit_distance|||n
+emulate_setlocale|||n
+eval_pv|5.006000||p
+eval_sv|5.006000||p
+exec_failed|||
+expect_number|||
+fbm_compile||5.005000|
+fbm_instr||5.005000|
+feature_is_enabled|||
+filter_add|||
+filter_del|||
+filter_gets|||
+filter_read|||
+finalize_optree|||
+finalize_op|||
+find_and_forget_pmops|||
+find_array_subscript|||
+find_beginning|||
+find_byclass|||
+find_default_stash|||
+find_hash_subscript|||
+find_in_my_stash|||
+find_lexical_cv|||
+find_next_masked|||n
+find_runcv_where|||
+find_runcv||5.008001|
+find_rundefsv||5.013002|
+find_script|||
+find_span_end_mask|||n
+find_span_end|||n
+first_symbol|||n
+fixup_errno_string|||
+foldEQ_latin1_s2_folded|||n
+foldEQ_latin1||5.013008|n
+foldEQ_locale||5.013002|n
+foldEQ_utf8||5.013002|
+foldEQ||5.013002|n
+fold_constants|||
+forbid_setid|||
+force_ident_maybe_lex|||
+force_ident|||
+force_list|||
+force_next|||
+force_strict_version|||
+force_version|||
+force_word|||
+forget_pmop|||
+form_nocontext|||vn
+form||5.004000|v
+fp_dup|||
+fprintf_nocontext|||vn
+free_c_backtrace|||
+free_global_struct|||
+free_tied_hv_pool|||
+free_tmps|||
+gen_constant_list|||
+get_ANYOFM_contents|||
+get_ANYOF_cp_list_for_ssc|||
+get_and_check_backslash_N_name_wrapper|||
+get_and_check_backslash_N_name|||
+get_aux_mg|||
+get_av|5.006000||p
+get_c_backtrace_dump|||
+get_c_backtrace|||
+get_context||5.006000|n
+get_cvn_flags|||
+get_cvs|5.011000||p
+get_cv|5.006000||p
+get_db_sub|||
+get_debug_opts|||
+get_hash_seed|||
+get_hv|5.006000||p
+get_mstats|||
+get_no_modify|||
+get_num|||
+get_op_descs||5.005000|
+get_op_names||5.005000|
+get_opargs|||
+get_ppaddr||5.006000|
+get_sv|5.006000||p
+get_vtbl||5.005030|
+getcwd_sv||5.007002|
+getenv_len|||
+glob_2number|||
+glob_assign_glob|||
+gp_dup|||
+gp_free|||
+gp_ref|||
+grok_atoUV|||n
+grok_bin|5.007003||p
+grok_bslash_N|||
+grok_hex|5.007003||p
+grok_infnan||5.021004|
+grok_number_flags||5.021002|
+grok_number|5.007002||p
+grok_numeric_radix|5.007002||p
+grok_oct|5.007003||p
+group_end|||
+gv_AVadd|||
+gv_HVadd|||
+gv_IOadd|||
+gv_SVadd|||
+gv_add_by_type||5.011000|
+gv_autoload4||5.004000|
+gv_autoload_pvn||5.015004|
+gv_autoload_pv||5.015004|
+gv_autoload_sv||5.015004|
+gv_check|||
+gv_const_sv||5.009003|
+gv_dump||5.006000|
+gv_efullname3||5.003070|
+gv_efullname4||5.006001|
+gv_efullname|||
+gv_fetchfile_flags||5.009005|
+gv_fetchfile|||
+gv_fetchmeth_autoload||5.007003|
+gv_fetchmeth_internal|||
+gv_fetchmeth_pv_autoload||5.015004|
+gv_fetchmeth_pvn_autoload||5.015004|
+gv_fetchmeth_pvn||5.015004|
+gv_fetchmeth_pv||5.015004|
+gv_fetchmeth_sv_autoload||5.015004|
+gv_fetchmeth_sv||5.015004|
+gv_fetchmethod_autoload||5.004000|
+gv_fetchmethod|||
+gv_fetchmeth|||
+gv_fetchpvn_flags|5.009002||p
+gv_fetchpvs|5.009004||p
+gv_fetchpv|||
+gv_fetchsv|||
+gv_fullname3||5.003070|
+gv_fullname4||5.006001|
+gv_fullname|||
+gv_handler||5.007001|
+gv_init_pvn|||
+gv_init_pv||5.015004|
+gv_init_svtype|||
+gv_init_sv||5.015004|
+gv_init|||
+gv_is_in_main|||
+gv_magicalize_isa|||
+gv_magicalize|||
+gv_name_set||5.009004|
+gv_override|||
+gv_setref|||
+gv_stashpvn_internal|||
+gv_stashpvn|5.003070||p
+gv_stashpvs|5.009003||p
+gv_stashpv|||
+gv_stashsvpvn_cached|||
+gv_stashsv|||
+handle_named_backref|||
+handle_possible_posix|||
+handle_regex_sets|||
+handle_user_defined_property|||
+he_dup|||
+hek_dup|||
+hfree_next_entry|||
+hsplit|||
+hv_assert|||
+hv_auxinit_internal|||n
+hv_auxinit|||
+hv_clear_placeholders||5.009001|
+hv_clear|||
+hv_common_key_len||5.010000|
+hv_common||5.010000|
+hv_copy_hints_hv||5.009004|
+hv_delayfree_ent||5.004000|
+hv_delete_ent||5.003070|
+hv_delete|||
+hv_eiter_p||5.009003|
+hv_eiter_set||5.009003|
+hv_ename_add|||
+hv_ename_delete|||
+hv_exists_ent||5.003070|
+hv_exists|||
+hv_fetch_ent||5.003070|
+hv_fetchs|5.009003||p
+hv_fetch|||
+hv_fill||5.013002|
+hv_free_ent_ret|||
+hv_free_entries|||
+hv_free_ent||5.004000|
+hv_iterinit|||
+hv_iterkeysv||5.003070|
+hv_iterkey|||
+hv_iternextsv|||
+hv_iternext|||
+hv_iterval|||
+hv_ksplit||5.003070|
+hv_magic_check|||n
+hv_magic|||
+hv_name_set||5.009003|
+hv_notallowed|||
+hv_placeholders_get||5.009003|
+hv_placeholders_p|||
+hv_placeholders_set||5.009003|
+hv_pushkv|||
+hv_rand_set||5.018000|
+hv_riter_p||5.009003|
+hv_riter_set||5.009003|
+hv_scalar||5.009001|
+hv_store_ent||5.003070|
+hv_stores|5.009004||p
+hv_store|||
+hv_undef_flags|||
+hv_undef|||
+ibcmp_locale||5.004000|
+ibcmp_utf8||5.007003|
+ibcmp|||
+incline|||
+incpush_if_exists|||
+incpush_use_sep|||
+incpush|||
+ingroup|||
+init_argv_symbols|||
+init_constants|||
+init_dbargs|||
+init_debugger|||
+init_global_struct|||
+init_ids|||
+init_interp|||
+init_main_stash|||
+init_named_cv|||
+init_perllib|||
+init_postdump_symbols|||
+init_predump_symbols|||
+init_stacks||5.005000|
+init_tm||5.007002|
+init_uniprops|||
+inplace_aassign|||
+instr|||n
+intro_my||5.004000|
+intuit_method|||
+intuit_more|||
+invert|||
+invoke_exception_hook|||
+io_close|||
+isALNUMC_A|||p
+isALNUMC|5.006000||p
+isALNUM_A|||p
+isALNUM|||p
+isALPHANUMERIC_A|||p
+isALPHANUMERIC|5.017008|5.017008|p
+isALPHA_A|||p
+isALPHA|||p
+isASCII_A|||p
+isASCII|5.006000||p
+isBLANK_A|||p
+isBLANK|5.006001||p
+isC9_STRICT_UTF8_CHAR|||n
+isCNTRL_A|||p
+isCNTRL|5.006000||p
+isDIGIT_A|||p
+isDIGIT|||p
+isFF_OVERLONG|||n
+isFOO_utf8_lc|||
+isGCB|||
+isGRAPH_A|||p
+isGRAPH|5.006000||p
+isIDCONT_A|||p
+isIDCONT|5.017008|5.017008|p
+isIDFIRST_A|||p
+isIDFIRST|||p
+isLB|||
+isLOWER_A|||p
+isLOWER|||p
+isOCTAL_A|||p
+isOCTAL|5.013005|5.013005|p
+isPRINT_A|||p
+isPRINT|5.004000||p
+isPSXSPC_A|||p
+isPSXSPC|5.006001||p
+isPUNCT_A|||p
+isPUNCT|5.006000||p
+isSB|||
+isSCRIPT_RUN|||
+isSPACE_A|||p
+isSPACE|||p
+isSTRICT_UTF8_CHAR|||n
+isUPPER_A|||p
+isUPPER|||p
+isUTF8_CHAR_flags|||
+isUTF8_CHAR||5.021001|n
+isWB|||
+isWORDCHAR_A|||p
+isWORDCHAR|5.013006|5.013006|p
+isXDIGIT_A|||p
+isXDIGIT|5.006000||p
+is_an_int|||
+is_ascii_string||5.011000|n
+is_c9strict_utf8_string_loclen|||n
+is_c9strict_utf8_string_loc|||n
+is_c9strict_utf8_string|||n
+is_handle_constructor|||n
+is_invariant_string||5.021007|n
+is_lvalue_sub||5.007001|
+is_safe_syscall||5.019004|
+is_ssc_worth_it|||n
+is_strict_utf8_string_loclen|||n
+is_strict_utf8_string_loc|||n
+is_strict_utf8_string|||n
+is_utf8_char_buf||5.015008|n
+is_utf8_common_with_len|||
+is_utf8_common|||
+is_utf8_cp_above_31_bits|||n
+is_utf8_fixed_width_buf_flags|||n
+is_utf8_fixed_width_buf_loc_flags|||n
+is_utf8_fixed_width_buf_loclen_flags|||n
+is_utf8_invariant_string_loc|||n
+is_utf8_invariant_string|||n
+is_utf8_non_invariant_string|||n
+is_utf8_overlong_given_start_byte_ok|||n
+is_utf8_string_flags|||n
+is_utf8_string_loc_flags|||n
+is_utf8_string_loclen_flags|||n
+is_utf8_string_loclen||5.009003|n
+is_utf8_string_loc||5.008001|n
+is_utf8_string||5.006001|n
+is_utf8_valid_partial_char_flags|||n
+is_utf8_valid_partial_char|||n
+isa_lookup|||
+isinfnansv|||
+isinfnan||5.021004|n
+items|||n
+ix|||n
+jmaybe|||
+join_exact|||
+keyword_plugin_standard|||
+keyword|||
+leave_scope|||
+lex_stuff_pvs||5.013005|
+listkids|||
+list|||
+load_module_nocontext|||vn
+load_module|5.006000||pv
+localize|||
+looks_like_bool|||
+looks_like_number|||
+lop|||
+mPUSHi|5.009002||p
+mPUSHn|5.009002||p
+mPUSHp|5.009002||p
+mPUSHs|5.010001||p
+mPUSHu|5.009002||p
+mXPUSHi|5.009002||p
+mXPUSHn|5.009002||p
+mXPUSHp|5.009002||p
+mXPUSHs|5.010001||p
+mXPUSHu|5.009002||p
+magic_clear_all_env|||
+magic_cleararylen_p|||
+magic_clearenv|||
+magic_clearhints|||
+magic_clearhint|||
+magic_clearisa|||
+magic_clearpack|||
+magic_clearsig|||
+magic_copycallchecker|||
+magic_dump||5.006000|
+magic_existspack|||
+magic_freearylen_p|||
+magic_freeovrld|||
+magic_getarylen|||
+magic_getdebugvar|||
+magic_getdefelem|||
+magic_getnkeys|||
+magic_getpack|||
+magic_getpos|||
+magic_getsig|||
+magic_getsubstr|||
+magic_gettaint|||
+magic_getuvar|||
+magic_getvec|||
+magic_get|||
+magic_killbackrefs|||
+magic_methcall1|||
+magic_methcall|||v
+magic_methpack|||
+magic_nextpack|||
+magic_regdata_cnt|||
+magic_regdatum_get|||
+magic_regdatum_set|||
+magic_scalarpack|||
+magic_set_all_env|||
+magic_setarylen|||
+magic_setcollxfrm|||
+magic_setdbline|||
+magic_setdebugvar|||
+magic_setdefelem|||
+magic_setenv|||
+magic_sethint|||
+magic_setisa|||
+magic_setlvref|||
+magic_setmglob|||
+magic_setnkeys|||
+magic_setnonelem|||
+magic_setpack|||
+magic_setpos|||
+magic_setregexp|||
+magic_setsig|||
+magic_setsubstr|||
+magic_settaint|||
+magic_setutf8|||
+magic_setuvar|||
+magic_setvec|||
+magic_set|||
+magic_sizepack|||
+magic_wipepack|||
+make_matcher|||
+make_trie|||
+malloc_good_size|||n
+malloced_size|||n
+malloc||5.007002|n
+markstack_grow||5.021001|
+matcher_matches_sv|||
+maybe_multimagic_gv|||
+mayberelocate|||
+measure_struct|||
+memEQs|5.009005||p
+memEQ|5.004000||p
+memNEs|5.009005||p
+memNE|5.004000||p
+mem_collxfrm|||
+mem_log_alloc|||n
+mem_log_common|||n
+mem_log_free|||n
+mem_log_realloc|||n
+mess_alloc|||
+mess_nocontext|||pvn
+mess_sv|5.013001||p
+mess|5.006000||pv
+mfree||5.007002|n
+mg_clear|||
+mg_copy|||
+mg_dup|||
+mg_find_mglob|||
+mg_findext|5.013008||pn
+mg_find|||n
+mg_free_type||5.013006|
+mg_freeext|||
+mg_free|||
+mg_get|||
+mg_localize|||
+mg_magical|||n
+mg_set|||
+mg_size||5.005000|
+mini_mktime||5.007002|n
+minus_v|||
+missingterm|||
+mode_from_discipline|||
+modkids|||
+more_bodies|||
+more_sv|||
+moreswitches|||
+move_proto_attr|||
+mro_clean_isarev|||
+mro_gather_and_rename|||
+mro_get_from_name||5.010001|
+mro_get_linear_isa_dfs|||
+mro_get_linear_isa||5.009005|
+mro_get_private_data||5.010001|
+mro_isa_changed_in|||
+mro_meta_dup|||
+mro_meta_init|||
+mro_method_changed_in||5.009005|
+mro_package_moved|||
+mro_register||5.010001|
+mro_set_mro||5.010001|
+mro_set_private_data||5.010001|
+mul128|||
+multiconcat_stringify|||
+multideref_stringify|||
+my_atof2||5.007002|
+my_atof3|||
+my_atof||5.006000|
+my_attrs|||
+my_bytes_to_utf8|||n
+my_chsize|||
+my_clearenv|||
+my_cxt_index|||
+my_cxt_init|||
+my_dirfd||5.009005|n
+my_exit_jump|||
+my_exit|||
+my_failure_exit||5.004000|
+my_fflush_all||5.006000|
+my_fork||5.007003|n
+my_kid|||
+my_lstat_flags|||
+my_lstat||5.024000|
+my_memrchr|||n
+my_mkostemp|||n
+my_mkstemp_cloexec|||n
+my_mkstemp|||n
+my_nl_langinfo|||n
+my_pclose||5.003070|
+my_popen_list||5.007001|
+my_popen||5.003070|
+my_setenv|||
+my_snprintf|5.009004||pvn
+my_socketpair||5.007003|n
+my_sprintf|5.009003||pvn
+my_stat_flags|||
+my_stat||5.024000|
+my_strerror|||
+my_strftime||5.007002|
+my_strlcat|5.009004||pn
+my_strlcpy|5.009004||pn
+my_strnlen|||pn
+my_strtod|||n
+my_unexec|||
+my_vsnprintf||5.009004|n
+need_utf8|||n
+newANONATTRSUB||5.006000|
+newANONHASH|||
+newANONLIST|||
+newANONSUB|||
+newASSIGNOP|||
+newATTRSUB_x|||
+newATTRSUB||5.006000|
+newAVREF|||
+newAV|||
+newBINOP|||
+newCONDOP|||
+newCONSTSUB_flags||5.015006|
+newCONSTSUB|5.004050||p
+newCVREF|||
+newDEFSVOP||5.021006|
+newFORM|||
+newFOROP||5.013007|
+newGIVENOP||5.009003|
+newGIVWHENOP|||
+newGVOP|||
+newGVREF|||
+newGVgen_flags||5.015004|
+newGVgen|||
+newHVREF|||
+newHVhv||5.005000|
+newHV|||
+newIO|||
+newLISTOP|||
+newLOGOP|||
+newLOOPEX|||
+newLOOPOP|||
+newMETHOP_internal|||
+newMETHOP_named||5.021005|
+newMETHOP||5.021005|
+newMYSUB||5.017004|
+newNULLLIST|||
+newOP|||
+newPADOP|||
+newPMOP|||
+newPROG|||
+newPVOP|||
+newRANGE|||
+newRV_inc|5.004000||p
+newRV_noinc|5.004000||p
+newRV|||
+newSLICEOP|||
+newSTATEOP|||
+newSTUB|||
+newSUB|||
+newSVOP|||
+newSVREF|||
+newSV_type|5.009005||p
+newSVavdefelem|||
+newSVhek||5.009003|
+newSViv|||
+newSVnv|||
+newSVpadname||5.017004|
+newSVpv_share||5.013006|
+newSVpvf_nocontext|||vn
+newSVpvf||5.004000|v
+newSVpvn_flags|5.010001||p
+newSVpvn_share|5.007001||p
+newSVpvn_utf8|5.010001||p
+newSVpvn|5.004050||p
+newSVpvs_flags|5.010001||p
+newSVpvs_share|5.009003||p
+newSVpvs|5.009003||p
+newSVpv|||
+newSVrv|||
+newSVsv_flags|||
+newSVsv_nomg|||
+newSVsv|||
+newSVuv|5.006000||p
+newSV|||
+newUNOP_AUX||5.021007|
+newUNOP|||
+newWHENOP||5.009003|
+newWHILEOP||5.013007|
+newXS_deffile|||
+newXS_len_flags|||
+newXSproto||5.006000|
+newXS||5.006000|
+new_collate|||
+new_constant|||
+new_ctype|||
+new_he|||
+new_logop|||
+new_msg_hv|||
+new_numeric|||
+new_regcurly|||n
+new_stackinfo||5.005000|
+new_version||5.009000|
+next_symbol|||
+nextargv|||
+nextchar|||
+ninstr|||n
+no_bareword_allowed|||
+no_fh_allowed|||
+no_op|||
+noperl_die|||vn
+not_a_number|||
+not_incrementable|||
+nothreadhook||5.008000|
+notify_parser_that_changed_to_utf8|||
+nuke_stacks|||
+num_overflow|||n
+oopsAV|||
+oopsHV|||
+op_append_elem||5.013006|
+op_append_list||5.013006|
+op_class|||
+op_clear|||
+op_contextualize||5.013006|
+op_convert_list||5.021006|
+op_dump||5.006000|
+op_free|||
+op_integerize|||
+op_linklist||5.013006|
+op_lvalue_flags|||
+op_null||5.007002|
+op_parent|||n
+op_prepend_elem||5.013006|
+op_refcnt_lock||5.009002|
+op_refcnt_unlock||5.009002|
+op_relocate_sv|||
+op_sibling_splice||5.021002|n
+op_std_init|||
+open_script|||
+openn_cleanup|||
+openn_setup|||
+opmethod_stash|||
+opslab_force_free|||
+opslab_free_nopad|||
+opslab_free|||
+optimize_optree|||
+optimize_op|||
+output_posix_warnings|||
+pMY_CXT_|5.007003||p
+pMY_CXT|5.007003||p
+pTHX_|5.006000||p
+pTHX|5.006000||p
+packWARN|5.007003||p
+pack_cat||5.007003|
+pack_rec|||
+package_version|||
+package|||
+packlist||5.008001|
+pad_add_anon||5.008001|
+pad_add_name_pvn||5.015001|
+pad_add_name_pvs||5.015001|
+pad_add_name_pv||5.015001|
+pad_add_name_sv||5.015001|
+pad_add_weakref|||
+pad_alloc_name|||
+pad_block_start|||
+pad_check_dup|||
+pad_compname_type||5.009003|
+pad_findlex|||
+pad_findmy_pvn||5.015001|
+pad_findmy_pvs||5.015001|
+pad_findmy_pv||5.015001|
+pad_findmy_sv||5.015001|
+pad_fixup_inner_anons|||
+pad_free|||
+pad_leavemy|||
+pad_new||5.008001|
+pad_push|||
+pad_reset|||
+pad_setsv|||
+pad_sv|||
+pad_swipe|||
+padlist_dup|||
+padlist_store|||
+padname_dup|||
+padname_free|||
+padnamelist_dup|||
+padnamelist_free|||
+parse_body|||
+parse_gv_stash_name|||
+parse_ident|||
+parse_lparen_question_flags|||
+parse_unicode_opts|||
+parse_uniprop_string|||
+parser_dup|||
+parser_free_nexttoke_ops|||
+parser_free|||
+path_is_searchable|||n
+peep|||
+pending_ident|||
+perl_alloc_using|||n
+perl_alloc|||n
+perl_clone_using|||n
+perl_clone|||n
+perl_construct|||n
+perl_destruct||5.007003|n
+perl_free|||n
+perl_parse||5.006000|n
+perl_run|||n
+pidgone|||
+pm_description|||
+pmop_dump||5.006000|
+pmruntime|||
+pmtrans|||
+pop_scope|||
+populate_ANYOF_from_invlist|||
+populate_isa|||v
+pregcomp||5.009005|
+pregexec|||
+pregfree2||5.011000|
+pregfree|||
+prescan_version||5.011004|
+print_bytes_for_locale|||
+print_collxfrm_input_and_return|||
+printbuf|||
+printf_nocontext|||vn
+process_special_blocks|||
+ptr_hash|||n
+ptr_table_fetch||5.009005|
+ptr_table_find|||n
+ptr_table_free||5.009005|
+ptr_table_new||5.009005|
+ptr_table_split||5.009005|
+ptr_table_store||5.009005|
+push_scope|||
+put_charclass_bitmap_innards_common|||
+put_charclass_bitmap_innards_invlist|||
+put_charclass_bitmap_innards|||
+put_code_point|||
+put_range|||
+pv_display|5.006000||p
+pv_escape|5.009004||p
+pv_pretty|5.009004||p
+pv_uni_display||5.007003|
+qerror|||
+quadmath_format_needed|||n
+quadmath_format_single|||n
+re_compile||5.009005|
+re_croak2|||
+re_dup_guts|||
+re_exec_indentf|||v
+re_indentf|||v
+re_intuit_start||5.019001|
+re_intuit_string||5.006000|
+re_op_compile|||
+re_printf|||v
+realloc||5.007002|n
+reentrant_free||5.024000|
+reentrant_init||5.024000|
+reentrant_retry||5.024000|vn
+reentrant_size||5.024000|
+ref_array_or_hash|||
+refcounted_he_chain_2hv|||
+refcounted_he_fetch_pvn|||
+refcounted_he_fetch_pvs|||
+refcounted_he_fetch_pv|||
+refcounted_he_fetch_sv|||
+refcounted_he_free|||
+refcounted_he_inc|||
+refcounted_he_new_pvn|||
+refcounted_he_new_pvs|||
+refcounted_he_new_pv|||
+refcounted_he_new_sv|||
+refcounted_he_value|||
+refkids|||
+refto|||
+ref||5.024000|
+reg2Lanode|||
+reg_check_named_buff_matched|||n
+reg_named_buff_all||5.009005|
+reg_named_buff_exists||5.009005|
+reg_named_buff_fetch||5.009005|
+reg_named_buff_firstkey||5.009005|
+reg_named_buff_iter|||
+reg_named_buff_nextkey||5.009005|
+reg_named_buff_scalar||5.009005|
+reg_named_buff|||
+reg_node|||
+reg_numbered_buff_fetch|||
+reg_numbered_buff_length|||
+reg_numbered_buff_store|||
+reg_qr_package|||
+reg_scan_name|||
+reg_skipcomment|||n
+reg_temp_copy|||
+reganode|||
+regatom|||
+regbranch|||
+regclass|||
+regcp_restore|||
+regcppop|||
+regcppush|||
+regcurly|||n
+regdump_extflags|||
+regdump_intflags|||
+regdump||5.005000|
+regdupe_internal|||
+regex_set_precedence|||n
+regexec_flags||5.005000|
+regfree_internal||5.009005|
+reghop3|||n
+reghop4|||n
+reghopmaybe3|||n
+reginclass|||
+reginitcolors||5.006000|
+reginsert|||
+regmatch|||
+regnext||5.005000|
+regnode_guts|||
+regpiece|||
+regprop|||
+regrepeat|||
+regtail_study|||
+regtail|||
+regtry|||
+reg|||
+repeatcpy|||n
+report_evil_fh|||
+report_redefined_cv|||
+report_uninit|||
+report_wrongway_fh|||
+require_pv||5.006000|
+require_tie_mod|||
+restore_magic|||
+restore_switched_locale|||
+rninstr|||n
+rpeep|||
+rsignal_restore|||
+rsignal_save|||
+rsignal_state||5.004000|
+rsignal||5.004000|
+run_body|||
+run_user_filter|||
+runops_debug||5.005000|
+runops_standard||5.005000|
+rv2cv_op_cv||5.013006|
+rvpv_dup|||
+rxres_free|||
+rxres_restore|||
+rxres_save|||
+safesyscalloc||5.006000|n
+safesysfree||5.006000|n
+safesysmalloc||5.006000|n
+safesysrealloc||5.006000|n
+same_dirent|||
+save_I16||5.004000|
+save_I32|||
+save_I8||5.006000|
+save_adelete||5.011000|
+save_aelem_flags||5.011000|
+save_aelem||5.004050|
+save_alloc||5.006000|
+save_aptr|||
+save_ary|||
+save_bool||5.008001|
+save_clearsv|||
+save_delete|||
+save_destructor_x||5.006000|
+save_destructor||5.006000|
+save_freeop|||
+save_freepv|||
+save_freesv|||
+save_generic_pvref||5.006001|
+save_generic_svref||5.005030|
+save_gp||5.004000|
+save_hash|||
+save_hdelete||5.011000|
+save_hek_flags|||n
+save_helem_flags||5.011000|
+save_helem||5.004050|
+save_hints||5.010001|
+save_hptr|||
+save_int|||
+save_item|||
+save_iv||5.005000|
+save_lines|||
+save_list|||
+save_long|||
+save_magic_flags|||
+save_mortalizesv||5.007001|
+save_nogv|||
+save_op||5.005000|
+save_padsv_and_mortalize||5.010001|
+save_pptr|||
+save_pushi32ptr||5.010001|
+save_pushptri32ptr|||
+save_pushptrptr||5.010001|
+save_pushptr||5.010001|
+save_re_context||5.006000|
+save_scalar_at|||
+save_scalar|||
+save_set_svflags||5.009000|
+save_shared_pvref||5.007003|
+save_sptr|||
+save_strlen|||
+save_svref|||
+save_to_buffer|||n
+save_vptr||5.006000|
+savepvn|||
+savepvs||5.009003|
+savepv|||
+savesharedpvn||5.009005|
+savesharedpvs||5.013006|
+savesharedpv||5.007003|
+savesharedsvpv||5.013006|
+savestack_grow_cnt||5.008001|
+savestack_grow|||
+savesvpv||5.009002|
+sawparens|||
+scalar_mod_type|||n
+scalarboolean|||
+scalarkids|||
+scalarseq|||
+scalarvoid|||
+scalar|||
+scan_bin||5.006000|
+scan_commit|||
+scan_const|||
+scan_formline|||
+scan_heredoc|||
+scan_hex|||
+scan_ident|||
+scan_inputsymbol|||
+scan_num||5.007001|
+scan_oct|||
+scan_pat|||
+scan_subst|||
+scan_trans|||
+scan_version||5.009001|
+scan_vstring||5.009005|
+search_const|||
+seed||5.008001|
+sequence_num|||
+set_ANYOF_arg|||
+set_caret_X|||
+set_context||5.006000|n
+set_numeric_radix||5.006000|
+set_numeric_standard||5.006000|
+set_numeric_underlying|||
+set_padlist|||n
+set_regex_pv|||
+setdefout|||
+setfd_cloexec_for_nonsysfd|||
+setfd_cloexec_or_inhexec_by_sysfdness|||
+setfd_cloexec|||n
+setfd_inhexec_for_sysfd|||
+setfd_inhexec|||n
+setlocale_debug_string|||n
+share_hek_flags|||
+share_hek||5.004000|
+should_warn_nl|||n
+si_dup|||
+sighandler|||n
+simplify_sort|||
+skip_to_be_ignored_text|||
+softref2xv|||
+sortcv_stacked|||
+sortcv_xsub|||
+sortcv|||
+sortsv_flags||5.009003|
+sortsv||5.007003|
+space_join_names_mortal|||
+ss_dup|||
+ssc_add_range|||
+ssc_and|||
+ssc_anything|||
+ssc_clear_locale|||n
+ssc_cp_and|||
+ssc_finalize|||
+ssc_init|||
+ssc_intersection|||
+ssc_is_anything|||n
+ssc_is_cp_posixl_init|||n
+ssc_or|||
+ssc_union|||
+stack_grow|||
+start_subparse||5.004000|
+stdize_locale|||
+strEQ|||
+strGE|||
+strGT|||
+strLE|||
+strLT|||
+strNE|||
+str_to_version||5.006000|
+strip_return|||
+strnEQ|||
+strnNE|||
+study_chunk|||
+sub_crush_depth|||
+sublex_done|||
+sublex_push|||
+sublex_start|||
+sv_2bool_flags||5.013006|
+sv_2bool|||
+sv_2cv|||
+sv_2io|||
+sv_2iuv_common|||
+sv_2iuv_non_preserve|||
+sv_2iv_flags||5.009001|
+sv_2iv|||
+sv_2mortal|||
+sv_2nv_flags||5.013001|
+sv_2pv_flags|5.007002||p
+sv_2pv_nolen|5.006000||p
+sv_2pvbyte_nolen|5.006000||p
+sv_2pvbyte|5.006000||p
+sv_2pvutf8_nolen||5.006000|
+sv_2pvutf8||5.006000|
+sv_2pv|||
+sv_2uv_flags||5.009001|
+sv_2uv|5.004000||p
+sv_add_arena|||
+sv_add_backref|||
+sv_backoff|||n
+sv_bless|||
+sv_buf_to_ro|||
+sv_buf_to_rw|||
+sv_cat_decode||5.008001|
+sv_catpv_flags||5.013006|
+sv_catpv_mg|5.004050||p
+sv_catpv_nomg||5.013006|
+sv_catpvf_mg_nocontext|||pvn
+sv_catpvf_mg|5.006000|5.004000|pv
+sv_catpvf_nocontext|||vn
+sv_catpvf||5.004000|v
+sv_catpvn_flags||5.007002|
+sv_catpvn_mg|5.004050||p
+sv_catpvn_nomg|5.007002||p
+sv_catpvn|||
+sv_catpvs_flags||5.013006|
+sv_catpvs_mg||5.013006|
+sv_catpvs_nomg||5.013006|
+sv_catpvs|5.009003||p
+sv_catpv|||
+sv_catsv_flags||5.007002|
+sv_catsv_mg|5.004050||p
+sv_catsv_nomg|5.007002||p
+sv_catsv|||
+sv_chop|||
+sv_clean_all|||
+sv_clean_objs|||
+sv_clear|||
+sv_cmp_flags||5.013006|
+sv_cmp_locale_flags||5.013006|
+sv_cmp_locale||5.004000|
+sv_cmp|||
+sv_collxfrm_flags||5.013006|
+sv_collxfrm|||
+sv_copypv_flags||5.017002|
+sv_copypv_nomg||5.017002|
+sv_copypv|||
+sv_dec_nomg||5.013002|
+sv_dec|||
+sv_del_backref|||
+sv_derived_from_pvn||5.015004|
+sv_derived_from_pv||5.015004|
+sv_derived_from_sv||5.015004|
+sv_derived_from||5.004000|
+sv_destroyable||5.010000|
+sv_display|||
+sv_does_pvn||5.015004|
+sv_does_pv||5.015004|
+sv_does_sv||5.015004|
+sv_does||5.009004|
+sv_dump|||
+sv_dup_common|||
+sv_dup_inc_multiple|||
+sv_dup_inc|||
+sv_dup|||
+sv_eq_flags||5.013006|
+sv_eq|||
+sv_exp_grow|||
+sv_force_normal_flags||5.007001|
+sv_force_normal||5.006000|
+sv_free_arenas|||
+sv_free|||
+sv_gets||5.003070|
+sv_grow|||
+sv_i_ncmp|||
+sv_inc_nomg||5.013002|
+sv_inc|||
+sv_insert_flags||5.010001|
+sv_insert|||
+sv_isa|||
+sv_isobject|||
+sv_iv||5.005000|
+sv_len_utf8_nomg|||
+sv_len_utf8||5.006000|
+sv_len|||
+sv_magic_portable|5.024000|5.004000|p
+sv_magicext_mglob|||
+sv_magicext||5.007003|
+sv_magic|||
+sv_mortalcopy_flags|||
+sv_mortalcopy|||
+sv_ncmp|||
+sv_newmortal|||
+sv_newref|||
+sv_nolocking||5.007003|
+sv_nosharing||5.007003|
+sv_nounlocking|||
+sv_nv||5.005000|
+sv_only_taint_gmagic|||n
+sv_or_pv_pos_u2b|||
+sv_peek||5.005000|
+sv_pos_b2u_flags||5.019003|
+sv_pos_b2u_midway|||
+sv_pos_b2u||5.006000|
+sv_pos_u2b_cached|||
+sv_pos_u2b_flags||5.011005|
+sv_pos_u2b_forwards|||n
+sv_pos_u2b_midway|||n
+sv_pos_u2b||5.006000|
+sv_pvbyten_force||5.006000|
+sv_pvbyten||5.006000|
+sv_pvbyte||5.006000|
+sv_pvn_force_flags|5.007002||p
+sv_pvn_force|||
+sv_pvn_nomg|5.007003|5.005000|p
+sv_pvn||5.005000|
+sv_pvutf8n_force||5.006000|
+sv_pvutf8n||5.006000|
+sv_pvutf8||5.006000|
+sv_pv||5.006000|
+sv_recode_to_utf8||5.007003|
+sv_reftype|||
+sv_ref||5.015004|
+sv_replace|||
+sv_report_used|||
+sv_resetpvn|||
+sv_reset|||
+sv_rvunweaken|||
+sv_rvweaken||5.006000|
+sv_set_undef|||
+sv_sethek|||
+sv_setiv_mg|5.004050||p
+sv_setiv|||
+sv_setnv_mg|5.006000||p
+sv_setnv|||
+sv_setpv_bufsize|||
+sv_setpv_mg|5.004050||p
+sv_setpvf_mg_nocontext|||pvn
+sv_setpvf_mg|5.006000|5.004000|pv
+sv_setpvf_nocontext|||vn
+sv_setpvf||5.004000|v
+sv_setpviv_mg||5.008001|
+sv_setpviv||5.008001|
+sv_setpvn_mg|5.004050||p
+sv_setpvn|||
+sv_setpvs_mg||5.013006|
+sv_setpvs|5.009004||p
+sv_setpv|||
+sv_setref_iv|||
+sv_setref_nv|||
+sv_setref_pvn|||
+sv_setref_pvs||5.024000|
+sv_setref_pv|||
+sv_setref_uv||5.007001|
+sv_setsv_flags||5.007002|
+sv_setsv_mg|5.004050||p
+sv_setsv_nomg|5.007002||p
+sv_setsv|||
+sv_setuv_mg|5.004050||p
+sv_setuv|5.004000||p
+sv_string_from_errnum|||
+sv_tainted||5.004000|
+sv_taint||5.004000|
+sv_true||5.005000|
+sv_unglob|||
+sv_uni_display||5.007003|
+sv_unmagicext|5.013008||p
+sv_unmagic|||
+sv_unref_flags||5.007001|
+sv_unref|||
+sv_untaint||5.004000|
+sv_upgrade|||
+sv_usepvn_flags||5.009004|
+sv_usepvn_mg|5.004050||p
+sv_usepvn|||
+sv_utf8_decode|||
+sv_utf8_downgrade|||
+sv_utf8_encode||5.006000|
+sv_utf8_upgrade_flags_grow||5.011000|
+sv_utf8_upgrade_flags||5.007002|
+sv_utf8_upgrade_nomg||5.007002|
+sv_utf8_upgrade||5.007001|
+sv_uv|5.005000||p
+sv_vcatpvf_mg|5.006000|5.004000|p
+sv_vcatpvfn_flags||5.017002|
+sv_vcatpvfn||5.004000|
+sv_vcatpvf|5.006000|5.004000|p
+sv_vsetpvf_mg|5.006000|5.004000|p
+sv_vsetpvfn||5.004000|
+sv_vsetpvf|5.006000|5.004000|p
+svtype|||
+swallow_bom|||
+swatch_get|||
+switch_category_locale_to_template|||
+switch_to_global_locale|||n
+sync_locale||5.021004|n
+sys_init3||5.010000|n
+sys_init||5.010000|n
+sys_intern_clear|||
+sys_intern_dup|||
+sys_intern_init|||
+sys_term||5.010000|n
+taint_env|||
+taint_proper|||
+tied_method|||v
+tmps_grow_p|||
+toFOLD_utf8_safe|||
+toFOLD_utf8||5.019001|
+toFOLD_uvchr||5.023009|
+toFOLD||5.019001|
+toLOWER_L1||5.019001|
+toLOWER_LC||5.004000|
+toLOWER_utf8_safe|||
+toLOWER_utf8||5.015007|
+toLOWER_uvchr||5.023009|
+toLOWER|||
+toTITLE_utf8_safe|||
+toTITLE_utf8||5.015007|
+toTITLE_uvchr||5.023009|
+toTITLE||5.019001|
+toUPPER_utf8_safe|||
+toUPPER_utf8||5.015007|
+toUPPER_uvchr||5.023009|
+toUPPER|||
+to_byte_substr|||
+to_lower_latin1|||n
+to_utf8_substr|||
+tokenize_use|||
+tokeq|||
+tokereport|||
+too_few_arguments_pv|||
+too_many_arguments_pv|||
+translate_substr_offsets|||n
+traverse_op_tree|||
+try_amagic_bin|||
+try_amagic_un|||
+turkic_fc|||
+turkic_lc|||
+turkic_uc|||
+uiv_2buf|||n
+unlnk|||
+unpack_rec|||
+unpack_str||5.007003|
+unpackstring||5.008001|
+unreferenced_to_tmp_stack|||
+unshare_hek_or_pvn|||
+unshare_hek|||
+unsharepvn||5.003070|
+unwind_handler_stack|||
+update_debugger_info|||
+upg_version||5.009005|
+usage|||
+utf16_textfilter|||
+utf16_to_utf8_reversed||5.006001|
+utf16_to_utf8||5.006001|
+utf8_distance||5.006000|
+utf8_hop_back|||n
+utf8_hop_forward|||n
+utf8_hop_safe|||n
+utf8_hop||5.006000|n
+utf8_length||5.007001|
+utf8_mg_len_cache_update|||
+utf8_mg_pos_cache_update|||
+utf8_to_uvchr_buf|5.015009|5.015009|p
+utf8_to_uvchr|||p
+utf8n_to_uvchr_error|||n
+utf8n_to_uvchr||5.007001|n
+utf8n_to_uvuni||5.007001|
+utilize|||
+uvchr_to_utf8_flags||5.007003|
+uvchr_to_utf8||5.007001|
+uvoffuni_to_utf8_flags||5.019004|
+uvuni_to_utf8_flags||5.007003|
+uvuni_to_utf8||5.007001|
+valid_utf8_to_uvchr|||n
+validate_suid|||
+variant_under_utf8_count|||n
+varname|||
+vcmp||5.009000|
+vcroak||5.006000|
+vdeb||5.007003|
+vform||5.006000|
+visit|||
+vivify_defelem|||
+vivify_ref|||
+vload_module|5.006000||p
+vmess|5.006000|5.006000|p
+vnewSVpvf|5.006000|5.004000|p
+vnormal||5.009002|
+vnumify||5.009000|
+vstringify||5.009000|
+vverify||5.009003|
+vwarner||5.006000|
+vwarn||5.006000|
+wait4pid|||
+warn_nocontext|||pvn
+warn_on_first_deprecated_use|||
+warn_sv|5.013001||p
+warner_nocontext|||vn
+warner|5.006000|5.004000|pv
+warn|||v
+was_lvalue_sub|||
+watch|||
+whichsig_pvn||5.015004|
+whichsig_pv||5.015004|
+whichsig_sv||5.015004|
+whichsig|||
+win32_croak_not_implemented|||n
+win32_setlocale|||
+with_queued_errors|||
+wrap_op_checker||5.015008|
+write_to_stderr|||
+xs_boot_epilog|||
+xs_handshake|||vn
+xs_version_bootcheck|||
+yyerror_pvn|||
+yyerror_pv|||
+yyerror|||
+yylex|||
+yyparse|||
+yyquit|||
+yyunlex|||
+yywarn|||
+);
+
+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}) : "5.003";
+ 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;
+}
+
+__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)
+
+#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 D_PPP_DEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
+#define PERL_BCDVERSION ((D_PPP_DEC2BCD(PERL_REVISION)<<24)|(D_PPP_DEC2BCD(PERL_VERSION)<<12)|D_PPP_DEC2BCD(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 */
+#ifndef dTHR
+# define dTHR dNOOP
+#endif
+#ifndef dTHX
+# define dTHX dNOOP
+#endif
+
+#ifndef dTHXa
+# define dTHXa(x) dNOOP
+#endif
+#ifndef pTHX
+# define pTHX void
+#endif
+
+#ifndef pTHX_
+# define pTHX_
+#endif
+
+#ifndef aTHX
+# define aTHX
+#endif
+
+#ifndef aTHX_
+# define aTHX_
+#endif
+
+#if (PERL_BCDVERSION < 0x5006000)
+# 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
+#ifndef dTHXoa
+# define dTHXoa(x) dTHXa(x)
+#endif
+
+#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
+#ifndef IVTYPE
+# define IVTYPE int
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_INT_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_INT_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_UINT_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_UINT_MAX
+#endif
+
+# ifdef INTSIZE
+#ifndef IVSIZE
+# define IVSIZE INTSIZE
+#endif
+
+# endif
+# else
+# if defined(convex) || defined(uts)
+#ifndef IVTYPE
+# define IVTYPE long long
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_QUAD_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_QUAD_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_UQUAD_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_UQUAD_MAX
+#endif
+
+# ifdef LONGLONGSIZE
+#ifndef IVSIZE
+# define IVSIZE LONGLONGSIZE
+#endif
+
+# endif
+# else
+#ifndef IVTYPE
+# define IVTYPE long
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_LONG_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_LONG_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_ULONG_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_ULONG_MAX
+#endif
+
+# ifdef LONGSIZE
+#ifndef IVSIZE
+# define IVSIZE LONGSIZE
+#endif
+
+# endif
+# endif
+# endif
+#ifndef IVSIZE
+# define IVSIZE 8
+#endif
+
+#ifndef LONGSIZE
+# define LONGSIZE 8
+#endif
+
+#ifndef PERL_QUAD_MIN
+# define PERL_QUAD_MIN IV_MIN
+#endif
+
+#ifndef PERL_QUAD_MAX
+# define PERL_QUAD_MAX IV_MAX
+#endif
+
+#ifndef PERL_UQUAD_MIN
+# define PERL_UQUAD_MIN UV_MIN
+#endif
+
+#ifndef PERL_UQUAD_MAX
+# define PERL_UQUAD_MAX UV_MAX
+#endif
+
+#else
+#ifndef IVTYPE
+# define IVTYPE long
+#endif
+
+#ifndef LONGSIZE
+# define LONGSIZE 4
+#endif
+
+#ifndef IV_MIN
+# define IV_MIN PERL_LONG_MIN
+#endif
+
+#ifndef IV_MAX
+# define IV_MAX PERL_LONG_MAX
+#endif
+
+#ifndef UV_MIN
+# define UV_MIN PERL_ULONG_MIN
+#endif
+
+#ifndef UV_MAX
+# define UV_MAX PERL_ULONG_MAX
+#endif
+
+#endif
+
+#ifndef IVSIZE
+# ifdef LONGSIZE
+# define IVSIZE LONGSIZE
+# else
+# define IVSIZE 4 /* A bold guess, but the best we can make. */
+# endif
+#endif
+#ifndef UVTYPE
+# define UVTYPE unsigned IVTYPE
+#endif
+
+#ifndef UVSIZE
+# define UVSIZE IVSIZE
+#endif
+#ifndef cBOOL
+# define cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
+#endif
+
+#ifndef OpHAS_SIBLING
+# define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling))
+#endif
+
+#ifndef OpSIBLING
+# define OpSIBLING(o) (0 + (o)->op_sibling)
+#endif
+
+#ifndef OpMORESIB_set
+# define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
+#endif
+
+#ifndef OpLASTSIB_set
+# define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
+#endif
+
+#ifndef OpMAYBESIB_set
+# define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
+#endif
+
+#ifndef HEf_SVKEY
+# define HEf_SVKEY -2
+#endif
+
+#if defined(DEBUGGING) && !defined(__COVERITY__)
+#ifndef __ASSERT_
+# define __ASSERT_(statement) assert(statement),
+#endif
+
+#else
+#ifndef __ASSERT_
+# define __ASSERT_(statement)
+#endif
+
+#endif
+
+#ifndef SvRX
+#if defined(NEED_SvRX)
+static void * DPPP_(my_SvRX)(pTHX_ SV *rv);
+static
+#else
+extern void * DPPP_(my_SvRX)(pTHX_ SV *rv);
+#endif
+
+#if defined(NEED_SvRX) || defined(NEED_SvRX_GLOBAL)
+
+#ifdef SvRX
+# undef SvRX
+#endif
+#define SvRX(a) DPPP_(my_SvRX)(aTHX_ a)
+
+
+void *
+DPPP_(my_SvRX)(pTHX_ SV *rv)
+{
+ if (SvROK(rv)) {
+ SV *sv = SvRV(rv);
+ if (SvMAGICAL(sv)) {
+ MAGIC *mg = mg_find(sv, PERL_MAGIC_qr);
+ if (mg && mg->mg_obj) {
+ return mg->mg_obj;
+ }
+ }
+ }
+ return 0;
+}
+#endif
+#endif
+#ifndef SvRXOK
+# define SvRXOK(sv) (!!SvRX(sv))
+#endif
+
+#ifndef PERL_UNUSED_DECL
+# ifdef HASATTRIBUTE
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
+# else
+# define PERL_UNUSED_DECL
+# endif
+#endif
+
+#ifndef PERL_UNUSED_ARG
+# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
+# include <note.h>
+# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
+# else
+# define PERL_UNUSED_ARG(x) ((void)x)
+# endif
+#endif
+
+#ifndef PERL_UNUSED_VAR
+# define PERL_UNUSED_VAR(x) ((void)x)
+#endif
+
+#ifndef PERL_UNUSED_CONTEXT
+# ifdef USE_ITHREADS
+# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
+# else
+# define PERL_UNUSED_CONTEXT
+# endif
+#endif
+
+#ifndef PERL_UNUSED_RESULT
+# if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
+# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
+# else
+# define PERL_UNUSED_RESULT(v) ((void)(v))
+# endif
+#endif
+#ifndef NOOP
+# define NOOP /*EMPTY*/(void)0
+#endif
+
+#ifndef dNOOP
+# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
+#endif
+
+#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
+#ifndef PTR2nat
+# define PTR2nat(p) (PTRV)(p)
+#endif
+
+#ifndef NUM2PTR
+# define NUM2PTR(any,d) (any)PTR2nat(d)
+#endif
+
+#ifndef PTR2IV
+# define PTR2IV(p) INT2PTR(IV,p)
+#endif
+
+#ifndef PTR2UV
+# define PTR2UV(p) INT2PTR(UV,p)
+#endif
+
+#ifndef PTR2NV
+# define PTR2NV(p) NUM2PTR(NV,p)
+#endif
+
+#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
+#ifndef boolSV
+# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
+#endif
+
+/* DEFSV appears first in 5.004_56 */
+#ifndef DEFSV
+# define DEFSV GvSV(PL_defgv)
+#endif
+
+#ifndef SAVE_DEFSV
+# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
+#endif
+
+#ifndef DEFSV_set
+# define DEFSV_set(sv) (DEFSV = (sv))
+#endif
+
+/* Older perls (<=5.003) lack AvFILLp */
+#ifndef AvFILLp
+# define AvFILLp AvFILL
+#endif
+#ifndef av_tindex
+# define av_tindex AvFILL
+#endif
+
+#ifndef av_top_index
+# define av_top_index AvFILL
+#endif
+#ifndef ERRSV
+# define ERRSV get_sv("@",FALSE)
+#endif
+
+/* 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.
+ */
+#ifndef gv_stashpvn
+# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
+#endif
+
+/* Replace: 1 */
+#ifndef get_cv
+# define get_cv perl_get_cv
+#endif
+
+#ifndef get_sv
+# define get_sv perl_get_sv
+#endif
+
+#ifndef get_av
+# define get_av perl_get_av
+#endif
+
+#ifndef get_hv
+# define get_hv perl_get_hv
+#endif
+
+/* Replace: 0 */
+#ifndef dUNDERBAR
+# define dUNDERBAR dNOOP
+#endif
+
+#ifndef UNDERBAR
+# define UNDERBAR DEFSV
+#endif
+#ifndef dAX
+# define dAX I32 ax = MARK - PL_stack_base + 1
+#endif
+
+#ifndef dITEMS
+# define dITEMS I32 items = SP - MARK
+#endif
+#ifndef dXSTARG
+# define dXSTARG SV * targ = sv_newmortal()
+#endif
+#ifndef dAXMARK
+# define dAXMARK I32 ax = POPMARK; \
+ register SV ** const mark = PL_stack_base + ax++
+#endif
+#ifndef XSprePUSH
+# define XSprePUSH (sp = PL_stack_base + ax - 1)
+#endif
+
+#if (PERL_BCDVERSION < 0x5005000)
+# undef XSRETURN
+# define XSRETURN(off) \
+ STMT_START { \
+ PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
+ return; \
+ } STMT_END
+#endif
+#ifndef XSPROTO
+# define XSPROTO(name) void name(pTHX_ CV* cv)
+#endif
+
+#ifndef SVfARG
+# define SVfARG(p) ((void*)(p))
+#endif
+#ifndef PERL_ABS
+# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
+#endif
+#ifndef dVAR
+# define dVAR dNOOP
+#endif
+#ifndef SVf
+# define SVf "_"
+#endif
+#ifndef UTF8_MAXBYTES
+# define UTF8_MAXBYTES UTF8_MAXLEN
+#endif
+#ifndef CPERLscope
+# define CPERLscope(x) x
+#endif
+#ifndef PERL_HASH
+# define 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
+#endif
+
+#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 (PERL_BCDVERSION < 0x5009003)
+
+# 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
+
+#ifndef WIDEST_UTYPE
+# ifdef QUADKIND
+# ifdef U64TYPE
+# define WIDEST_UTYPE U64TYPE
+# else
+# define WIDEST_UTYPE Quad_t
+# endif
+# else
+# define WIDEST_UTYPE U32
+# endif
+#endif
+
+#ifdef EBCDIC
+
+/* This is the first version where these macros are fully correct. Relying on
+ * the C library functions, as earlier releases did, causes problems with
+ * locales */
+# if (PERL_BCDVERSION < 0x5022000)
+# undef isALNUM
+# undef isALNUM_A
+# undef isALNUMC
+# undef isALNUMC_A
+# undef isALPHA
+# undef isALPHA_A
+# undef isALPHANUMERIC
+# undef isALPHANUMERIC_A
+# undef isASCII
+# undef isASCII_A
+# undef isBLANK
+# undef isBLANK_A
+# undef isCNTRL
+# undef isCNTRL_A
+# undef isDIGIT
+# undef isDIGIT_A
+# undef isGRAPH
+# undef isGRAPH_A
+# undef isIDCONT
+# undef isIDCONT_A
+# undef isIDFIRST
+# undef isIDFIRST_A
+# undef isLOWER
+# undef isLOWER_A
+# undef isOCTAL
+# undef isOCTAL_A
+# undef isPRINT
+# undef isPRINT_A
+# undef isPSXSPC
+# undef isPSXSPC_A
+# undef isPUNCT
+# undef isPUNCT_A
+# undef isSPACE
+# undef isSPACE_A
+# undef isUPPER
+# undef isUPPER_A
+# undef isWORDCHAR
+# undef isWORDCHAR_A
+# undef isXDIGIT
+# undef isXDIGIT_A
+# endif
+#ifndef isASCII
+# define isASCII(c) (isCNTRL(c) || isPRINT(c))
+#endif
+
+ /* The below is accurate for all EBCDIC code pages supported by
+ * all the versions of Perl overridden by this */
+#ifndef isCNTRL
+# define isCNTRL(c) ( (c) == '\0' || (c) == '\a' || (c) == '\b' \
+ || (c) == '\f' || (c) == '\n' || (c) == '\r' \
+ || (c) == '\t' || (c) == '\v' \
+ || ((c) <= 3 && (c) >= 1) /* SOH, STX, ETX */ \
+ || (c) == 7 /* U+7F DEL */ \
+ || ((c) <= 0x13 && (c) >= 0x0E) /* SO, SI */ \
+ /* DLE, DC[1-3] */ \
+ || (c) == 0x18 /* U+18 CAN */ \
+ || (c) == 0x19 /* U+19 EOM */ \
+ || ((c) <= 0x1F && (c) >= 0x1C) /* [FGRU]S */ \
+ || (c) == 0x26 /* U+17 ETB */ \
+ || (c) == 0x27 /* U+1B ESC */ \
+ || (c) == 0x2D /* U+05 ENQ */ \
+ || (c) == 0x2E /* U+06 ACK */ \
+ || (c) == 0x32 /* U+16 SYN */ \
+ || (c) == 0x37 /* U+04 EOT */ \
+ || (c) == 0x3C /* U+14 DC4 */ \
+ || (c) == 0x3D /* U+15 NAK */ \
+ || (c) == 0x3F /* U+1A SUB */ \
+ )
+#endif
+
+/* The ordering of the tests in this and isUPPER are to exclude most characters
+ * early */
+#ifndef isLOWER
+# define isLOWER(c) ( (c) >= 'a' && (c) <= 'z' \
+ && ( (c) <= 'i' \
+ || ((c) >= 'j' && (c) <= 'r') \
+ || (c) >= 's'))
+#endif
+
+#ifndef isUPPER
+# define isUPPER(c) ( (c) >= 'A' && (c) <= 'Z' \
+ && ( (c) <= 'I' \
+ || ((c) >= 'J' && (c) <= 'R') \
+ || (c) >= 'S'))
+#endif
+
+#else /* Above is EBCDIC; below is ASCII */
+
+# if (PERL_BCDVERSION < 0x5004000)
+/* The implementation of these in older perl versions can give wrong results if
+ * the C program locale is set to other than the C locale */
+# undef isALNUM
+# undef isALNUM_A
+# undef isALPHA
+# undef isALPHA_A
+# undef isDIGIT
+# undef isDIGIT_A
+# undef isIDFIRST
+# undef isIDFIRST_A
+# undef isLOWER
+# undef isLOWER_A
+# undef isUPPER
+# undef isUPPER_A
+# endif
+
+# if (PERL_BCDVERSION < 0x5008000)
+/* Hint: isCNTRL
+ * Earlier perls omitted DEL */
+# undef isCNTRL
+# endif
+
+# if (PERL_BCDVERSION < 0x5010000)
+/* 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
+# undef isPRINT_A
+# endif
+
+# if (PERL_BCDVERSION < 0x5014000)
+/* Hint: isASCII
+ * The implementation in older perl versions always returned true if the
+ * parameter was a signed char
+ */
+# undef isASCII
+# undef isASCII_A
+# endif
+
+# if (PERL_BCDVERSION < 0x5020000)
+/* Hint: isSPACE
+ * The implementation in older perl versions didn't include \v */
+# undef isSPACE
+# undef isSPACE_A
+# endif
+#ifndef isASCII
+# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
+#endif
+
+#ifndef isCNTRL
+# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
+#endif
+
+#ifndef isLOWER
+# define isLOWER(c) ((c) >= 'a' && (c) <= 'z')
+#endif
+
+#ifndef isUPPER
+# define isUPPER(c) ((c) <= 'Z' && (c) >= 'A')
+#endif
+
+#endif /* Below are definitions common to EBCDIC and ASCII */
+#ifndef isALNUM
+# define isALNUM(c) isWORDCHAR(c)
+#endif
+
+#ifndef isALNUMC
+# define isALNUMC(c) isALPHANUMERIC(c)
+#endif
+
+#ifndef isALPHA
+# define isALPHA(c) (isUPPER(c) || isLOWER(c))
+#endif
+
+#ifndef isALPHANUMERIC
+# define isALPHANUMERIC(c) (isALPHA(c) || isDIGIT(c))
+#endif
+
+#ifndef isBLANK
+# define isBLANK(c) ((c) == ' ' || (c) == '\t')
+#endif
+
+#ifndef isDIGIT
+# define isDIGIT(c) ((c) <= '9' && (c) >= '0')
+#endif
+
+#ifndef isGRAPH
+# define isGRAPH(c) (isWORDCHAR(c) || isPUNCT(c))
+#endif
+
+#ifndef isIDCONT
+# define isIDCONT(c) isWORDCHAR(c)
+#endif
+
+#ifndef isIDFIRST
+# define isIDFIRST(c) (isALPHA(c) || (c) == '_')
+#endif
+
+#ifndef isOCTAL
+# define isOCTAL(c) (((WIDEST_UTYPE)((c)) & ~7) == '0')
+#endif
+
+#ifndef isPRINT
+# define isPRINT(c) (isGRAPH(c) || (c) == ' ')
+#endif
+
+#ifndef isPSXSPC
+# define isPSXSPC(c) isSPACE(c)
+#endif
+
+#ifndef isPUNCT
+# define isPUNCT(c) ( (c) == '-' || (c) == '!' || (c) == '"' \
+ || (c) == '#' || (c) == '$' || (c) == '%' \
+ || (c) == '&' || (c) == '\'' || (c) == '(' \
+ || (c) == ')' || (c) == '*' || (c) == '+' \
+ || (c) == ',' || (c) == '.' || (c) == '/' \
+ || (c) == ':' || (c) == ';' || (c) == '<' \
+ || (c) == '=' || (c) == '>' || (c) == '?' \
+ || (c) == '@' || (c) == '[' || (c) == '\\' \
+ || (c) == ']' || (c) == '^' || (c) == '_' \
+ || (c) == '`' || (c) == '{' || (c) == '|' \
+ || (c) == '}' || (c) == '~')
+#endif
+
+#ifndef isSPACE
+# define isSPACE(c) ( isBLANK(c) || (c) == '\n' || (c) == '\r' \
+ || (c) == '\v' || (c) == '\f')
+#endif
+
+#ifndef isWORDCHAR
+# define isWORDCHAR(c) (isALPHANUMERIC(c) || (c) == '_')
+#endif
+
+#ifndef isXDIGIT
+# define isXDIGIT(c) ( isDIGIT(c) \
+ || ((c) >= 'a' && (c) <= 'f') \
+ || ((c) >= 'A' && (c) <= 'F'))
+#endif
+#ifndef isALNUM_A
+# define isALNUM_A isALNUM
+#endif
+
+#ifndef isALNUMC_A
+# define isALNUMC_A isALNUMC
+#endif
+
+#ifndef isALPHA_A
+# define isALPHA_A isALPHA
+#endif
+
+#ifndef isALPHANUMERIC_A
+# define isALPHANUMERIC_A isALPHANUMERIC
+#endif
+
+#ifndef isASCII_A
+# define isASCII_A isASCII
+#endif
+
+#ifndef isBLANK_A
+# define isBLANK_A isBLANK
+#endif
+
+#ifndef isCNTRL_A
+# define isCNTRL_A isCNTRL
+#endif
+
+#ifndef isDIGIT_A
+# define isDIGIT_A isDIGIT
+#endif
+
+#ifndef isGRAPH_A
+# define isGRAPH_A isGRAPH
+#endif
+
+#ifndef isIDCONT_A
+# define isIDCONT_A isIDCONT
+#endif
+
+#ifndef isIDFIRST_A
+# define isIDFIRST_A isIDFIRST
+#endif
+
+#ifndef isLOWER_A
+# define isLOWER_A isLOWER
+#endif
+
+#ifndef isOCTAL_A
+# define isOCTAL_A isOCTAL
+#endif
+
+#ifndef isPRINT_A
+# define isPRINT_A isPRINT
+#endif
+
+#ifndef isPSXSPC_A
+# define isPSXSPC_A isPSXSPC
+#endif
+
+#ifndef isPUNCT_A
+# define isPUNCT_A isPUNCT
+#endif
+
+#ifndef isSPACE_A
+# define isSPACE_A isSPACE
+#endif
+
+#ifndef isUPPER_A
+# define isUPPER_A isUPPER
+#endif
+
+#ifndef isWORDCHAR_A
+# define isWORDCHAR_A isWORDCHAR
+#endif
+
+#ifndef isXDIGIT_A
+# define isXDIGIT_A isXDIGIT
+#endif
+
+/* Until we figure out how to support this in older perls... */
+#if (PERL_BCDVERSION >= 0x5008000)
+#ifndef HeUTF8
+# define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
+ SvUTF8(HeKEY_sv(he)) : \
+ (U32)HeKUTF8(he))
+#endif
+
+#endif
+#ifndef C_ARRAY_LENGTH
+# define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
+#endif
+
+#ifndef C_ARRAY_END
+# define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a))
+#endif
+#ifndef LIKELY
+# define LIKELY(x) (x)
+#endif
+
+#ifndef UNLIKELY
+# define UNLIKELY(x) (x)
+#endif
+#ifndef UNICODE_REPLACEMENT
+# define UNICODE_REPLACEMENT 0xFFFD
+#endif
+
+#ifndef MUTABLE_PTR
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+# define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
+#else
+# define MUTABLE_PTR(p) ((void *) (p))
+#endif
+#endif
+#ifndef MUTABLE_SV
+# define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
+#endif
+#ifndef WARN_ALL
+# define WARN_ALL 0
+#endif
+
+#ifndef WARN_CLOSURE
+# define WARN_CLOSURE 1
+#endif
+
+#ifndef WARN_DEPRECATED
+# define WARN_DEPRECATED 2
+#endif
+
+#ifndef WARN_EXITING
+# define WARN_EXITING 3
+#endif
+
+#ifndef WARN_GLOB
+# define WARN_GLOB 4
+#endif
+
+#ifndef WARN_IO
+# define WARN_IO 5
+#endif
+
+#ifndef WARN_CLOSED
+# define WARN_CLOSED 6
+#endif
+
+#ifndef WARN_EXEC
+# define WARN_EXEC 7
+#endif
+
+#ifndef WARN_LAYER
+# define WARN_LAYER 8
+#endif
+
+#ifndef WARN_NEWLINE
+# define WARN_NEWLINE 9
+#endif
+
+#ifndef WARN_PIPE
+# define WARN_PIPE 10
+#endif
+
+#ifndef WARN_UNOPENED
+# define WARN_UNOPENED 11
+#endif
+
+#ifndef WARN_MISC
+# define WARN_MISC 12
+#endif
+
+#ifndef WARN_NUMERIC
+# define WARN_NUMERIC 13
+#endif
+
+#ifndef WARN_ONCE
+# define WARN_ONCE 14
+#endif
+
+#ifndef WARN_OVERFLOW
+# define WARN_OVERFLOW 15
+#endif
+
+#ifndef WARN_PACK
+# define WARN_PACK 16
+#endif
+
+#ifndef WARN_PORTABLE
+# define WARN_PORTABLE 17
+#endif
+
+#ifndef WARN_RECURSION
+# define WARN_RECURSION 18
+#endif
+
+#ifndef WARN_REDEFINE
+# define WARN_REDEFINE 19
+#endif
+
+#ifndef WARN_REGEXP
+# define WARN_REGEXP 20
+#endif
+
+#ifndef WARN_SEVERE
+# define WARN_SEVERE 21
+#endif
+
+#ifndef WARN_DEBUGGING
+# define WARN_DEBUGGING 22
+#endif
+
+#ifndef WARN_INPLACE
+# define WARN_INPLACE 23
+#endif
+
+#ifndef WARN_INTERNAL
+# define WARN_INTERNAL 24
+#endif
+
+#ifndef WARN_MALLOC
+# define WARN_MALLOC 25
+#endif
+
+#ifndef WARN_SIGNAL
+# define WARN_SIGNAL 26
+#endif
+
+#ifndef WARN_SUBSTR
+# define WARN_SUBSTR 27
+#endif
+
+#ifndef WARN_SYNTAX
+# define WARN_SYNTAX 28
+#endif
+
+#ifndef WARN_AMBIGUOUS
+# define WARN_AMBIGUOUS 29
+#endif
+
+#ifndef WARN_BAREWORD
+# define WARN_BAREWORD 30
+#endif
+
+#ifndef WARN_DIGIT
+# define WARN_DIGIT 31
+#endif
+
+#ifndef WARN_PARENTHESIS
+# define WARN_PARENTHESIS 32
+#endif
+
+#ifndef WARN_PRECEDENCE
+# define WARN_PRECEDENCE 33
+#endif
+
+#ifndef WARN_PRINTF
+# define WARN_PRINTF 34
+#endif
+
+#ifndef WARN_PROTOTYPE
+# define WARN_PROTOTYPE 35
+#endif
+
+#ifndef WARN_QW
+# define WARN_QW 36
+#endif
+
+#ifndef WARN_RESERVED
+# define WARN_RESERVED 37
+#endif
+
+#ifndef WARN_SEMICOLON
+# define WARN_SEMICOLON 38
+#endif
+
+#ifndef WARN_TAINT
+# define WARN_TAINT 39
+#endif
+
+#ifndef WARN_THREADS
+# define WARN_THREADS 40
+#endif
+
+#ifndef WARN_UNINITIALIZED
+# define WARN_UNINITIALIZED 41
+#endif
+
+#ifndef WARN_UNPACK
+# define WARN_UNPACK 42
+#endif
+
+#ifndef WARN_UNTIE
+# define WARN_UNTIE 43
+#endif
+
+#ifndef WARN_UTF8
+# define WARN_UTF8 44
+#endif
+
+#ifndef WARN_VOID
+# define WARN_VOID 45
+#endif
+
+#ifndef WARN_ASSERTIONS
+# define WARN_ASSERTIONS 46
+#endif
+#ifndef packWARN
+# define packWARN(a) (a)
+#endif
+
+#ifndef ckWARN
+# ifdef G_WARN_ON
+# define ckWARN(a) (PL_dowarn & G_WARN_ON)
+# else
+# define ckWARN(a) PL_dowarn
+# endif
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
+#if defined(NEED_warner)
+static void DPPP_(my_warner)(U32 err, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
+#endif
+
+#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
+
+#define Perl_warner DPPP_(my_warner)
+
+
+void
+DPPP_(my_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
+
+#define _ppport_MIN(a,b) (((a) <= (b)) ? (a) : (b))
+#ifndef sv_setuv
+# define 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
+#endif
+#ifndef newSVuv
+# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
+#endif
+#ifndef sv_2uv
+# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
+#endif
+
+#ifndef SvUVX
+# define SvUVX(sv) ((UV)SvIVX(sv))
+#endif
+
+#ifndef SvUVXx
+# define SvUVXx(sv) SvUVX(sv)
+#endif
+
+#ifndef SvUV
+# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
+#endif
+
+#ifndef SvUVx
+# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
+#endif
+
+/* Hint: sv_uv
+ * Always use the SvUVx() macro instead of sv_uv().
+ */
+#ifndef sv_uv
+# define sv_uv(sv) SvUVx(sv)
+#endif
+
+#if !defined(SvUOK) && defined(SvIOK_UV)
+# define SvUOK(sv) SvIOK_UV(sv)
+#endif
+#ifndef XST_mUV
+# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
+#endif
+
+#ifndef XSRETURN_UV
+# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
+#endif
+#ifndef PUSHu
+# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
+#endif
+
+#ifndef XPUSHu
+# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
+#endif
+
+#if defined UTF8SKIP
+
+/* Don't use official version because it uses MIN, which may not be available */
+#undef UTF8_SAFE_SKIP
+#ifndef UTF8_SAFE_SKIP
+# define UTF8_SAFE_SKIP(s, e) ( \
+ ((((e) - (s)) <= 0) \
+ ? 0 \
+ : _ppport_MIN(((e) - (s)), UTF8SKIP(s))))
+#endif
+
+#endif
+
+#if !defined(my_strnlen)
+#if defined(NEED_my_strnlen)
+static STRLEN DPPP_(my_my_strnlen)(const char *str, Size_t maxlen);
+static
+#else
+extern STRLEN DPPP_(my_my_strnlen)(const char *str, Size_t maxlen);
+#endif
+
+#if defined(NEED_my_strnlen) || defined(NEED_my_strnlen_GLOBAL)
+
+#define my_strnlen DPPP_(my_my_strnlen)
+#define Perl_my_strnlen DPPP_(my_my_strnlen)
+
+
+STRLEN
+DPPP_(my_my_strnlen)(const char *str, Size_t maxlen)
+{
+ const char *p = str;
+
+ while(maxlen-- && *p)
+ p++;
+
+ return p - str;
+}
+
+#endif
+#endif
+
+#if (PERL_BCDVERSION < 0x5031002)
+ /* Versions prior to this accepted things that are now considered
+ * malformations, and didn't return -1 on error with warnings enabled
+ * */
+# undef utf8_to_uvchr_buf
+#endif
+
+/* This implementation brings modern, generally more restricted standards to
+ * utf8_to_uvchr_buf. Some of these are security related, and clearly must
+ * be done. But its arguable that the others need not, and hence should not.
+ * The reason they're here is that a module that intends to play with the
+ * latest perls shoud be able to work the same in all releases. An example is
+ * that perl no longer accepts any UV for a code point, but limits them to
+ * IV_MAX or below. This is for future internal use of the larger code points.
+ * If it turns out that some of these changes are breaking code that isn't
+ * intended to work with modern perls, the tighter restrictions could be
+ * relaxed. khw thinks this is unlikely, but has been wrong in the past. */
+
+#ifndef utf8_to_uvchr_buf
+ /* Choose which underlying implementation to use. At least one must be
+ * present or the perl is too early to handle this function */
+# if defined(utf8n_to_uvchr) || defined(utf8_to_uv)
+# if defined(utf8n_to_uvchr) /* This is the preferred implementation */
+# define _ppport_utf8_to_uvchr_buf_callee utf8n_to_uvchr
+# else
+# define _ppport_utf8_to_uvchr_buf_callee utf8_to_uv
+# endif
+
+# endif
+
+#ifdef _ppport_utf8_to_uvchr_buf_callee
+# if defined(NEED_utf8_to_uvchr_buf)
+static UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen);
+static
+#else
+extern UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen);
+#endif
+
+#if defined(NEED_utf8_to_uvchr_buf) || defined(NEED_utf8_to_uvchr_buf_GLOBAL)
+
+#ifdef utf8_to_uvchr_buf
+# undef utf8_to_uvchr_buf
+#endif
+#define utf8_to_uvchr_buf(a,b,c) DPPP_(my_utf8_to_uvchr_buf)(aTHX_ a,b,c)
+#define Perl_utf8_to_uvchr_buf DPPP_(my_utf8_to_uvchr_buf)
+
+
+UV
+DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen)
+{
+ UV ret;
+ STRLEN curlen;
+ bool overflows = 0;
+ const U8 *cur_s = s;
+ const bool do_warnings = ckWARN_d(WARN_UTF8);
+
+ if (send > s) {
+ curlen = send - s;
+ }
+ else {
+ assert(0); /* Modern perls die under this circumstance */
+ curlen = 0;
+ if (! do_warnings) { /* Handle empty here if no warnings needed */
+ if (retlen) *retlen = 0;
+ return UNICODE_REPLACEMENT;
+ }
+ }
+
+ /* The modern version allows anything that evaluates to a legal UV, but not
+ * overlongs nor an empty input */
+ ret = _ppport_utf8_to_uvchr_buf_callee(
+ s, curlen, retlen, (UTF8_ALLOW_ANYUV
+ & ~(UTF8_ALLOW_LONG|UTF8_ALLOW_EMPTY)));
+
+ /* But actually, modern versions restrict the UV to being no more than what
+ * an IV can hold */
+ if (ret > PERL_INT_MAX) {
+ overflows = 1;
+ }
+
+# if (PERL_BCDVERSION < 0x5026000)
+# ifndef EBCDIC
+
+ /* There are bugs in versions earlier than this on non-EBCDIC platforms
+ * in which it did not detect all instances of overflow, which could be
+ * a security hole. Also, earlier versions did not allow the overflow
+ * malformation under any circumstances, and modern ones do. So we
+ * need to check here. */
+
+ else if (curlen > 0 && *s >= 0xFE) {
+
+ /* If the main routine detected overflow, great; it returned 0. But if the
+ * input's first byte indicates it could overflow, we need to verify.
+ * First, on a 32-bit machine the first byte being at least \xFE
+ * automatically is overflow */
+ if (sizeof(ret) < 8) {
+ overflows = 1;
+ }
+ else {
+ const U8 highest[] = /* 2*63-1 */
+ "\xFF\x80\x87\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF";
+ const U8 *cur_h = highest;
+
+ for (cur_s = s; cur_s < send; cur_s++, cur_h++) {
+ if (UNLIKELY(*cur_s == *cur_h)) {
+ continue;
+ }
+
+ /* If this byte is larger than the corresponding highest UTF-8
+ * byte, the sequence overflows; otherwise the byte is less than
+ * (as we handled the equality case above), and so the sequence
+ * doesn't overflow */
+ overflows = *cur_s > *cur_h;
+ break;
+
+ }
+
+ /* Here, either we set the bool and broke out of the loop, or got
+ * to the end and all bytes are the same which indicates it doesn't
+ * overflow. */
+ }
+ }
+
+# endif
+# endif /* < 5.26 */
+
+ if (UNLIKELY(overflows)) {
+ if (! do_warnings) {
+ if (retlen) {
+ *retlen = _ppport_MIN(*retlen, UTF8SKIP(s));
+ *retlen = _ppport_MIN(*retlen, curlen);
+ }
+ return UNICODE_REPLACEMENT;
+ }
+ else {
+
+ /* On versions that correctly detect overflow, but forbid it
+ * always, 0 will be returned, but also a warning will have been
+ * raised. Don't repeat it */
+ if (ret != 0) {
+ /* We use the error message in use from 5.8-5.14 */
+ Perl_warner(aTHX_ packWARN(WARN_UTF8),
+ "Malformed UTF-8 character (overflow at 0x%" UVxf
+ ", byte 0x%02x, after start byte 0x%02x)",
+ ret, *cur_s, *s);
+ }
+ if (retlen) {
+ *retlen = (STRLEN) -1;
+ }
+ return 0;
+ }
+ }
+
+ /* If failed and warnings are off, to emulate the behavior of the real
+ * utf8_to_uvchr(), try again, allowing anything. (Note a return of 0 is
+ * ok if the input was '\0') */
+ if (UNLIKELY(ret == 0 && (curlen == 0 || *s != '\0'))) {
+
+ /* If curlen is 0, we already handled the case where warnings are
+ * disabled, so this 'if' will be true, and we won't look at the
+ * contents of 's' */
+ if (do_warnings) {
+ *retlen = (STRLEN) -1;
+ }
+ else {
+ ret = _ppport_utf8_to_uvchr_buf_callee(
+ s, curlen, retlen, UTF8_ALLOW_ANY);
+ /* Override with the REPLACEMENT character, as that is what the
+ * modern version of this function returns */
+ ret = UNICODE_REPLACEMENT;
+
+# if (PERL_BCDVERSION < 0x5016000)
+
+ /* Versions earlier than this don't necessarily return the proper
+ * length. It should not extend past the end of string, nor past
+ * what the first byte indicates the length is, nor past the
+ * continuation characters */
+ if (retlen && *retlen >= 0) {
+ *retlen = _ppport_MIN(*retlen, curlen);
+ *retlen = _ppport_MIN(*retlen, UTF8SKIP(s));
+ unsigned int i = 1;
+ do {
+ if (s[i] < 0x80 || s[i] > 0xBF) {
+ *retlen = i;
+ break;
+ }
+ } while (++i < *retlen);
+ }
+
+# endif
+
+ }
+ }
+
+ return ret;
+}
+
+# endif
+#endif
+#endif
+
+#if defined(UTF8SKIP) && defined(utf8_to_uvchr_buf)
+#undef utf8_to_uvchr /* Always redefine this unsafe function so that it refuses
+ to read past a NUL, making it much less likely to read
+ off the end of the buffer. A NUL indicates the start
+ of the next character anyway. If the input isn't
+ NUL-terminated, the function remains unsafe, as it
+ always has been. */
+#ifndef utf8_to_uvchr
+# define utf8_to_uvchr(s, lp) \
+ ((*(s) == '\0') \
+ ? utf8_to_uvchr_buf(s,((s)+1), lp) /* Handle single NUL specially */ \
+ : utf8_to_uvchr_buf(s, (s) + my_strnlen((char *) (s), UTF8SKIP(s)), (lp)))
+#endif
+
+#endif
+
+#ifdef HAS_MEMCMP
+#ifndef memNE
+# define memNE(s1,s2,l) (memcmp(s1,s2,l))
+#endif
+
+#ifndef memEQ
+# define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
+#endif
+
+#else
+#ifndef memNE
+# define memNE(s1,s2,l) (bcmp(s1,s2,l))
+#endif
+
+#ifndef memEQ
+# define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
+#endif
+
+#endif
+#ifndef memEQs
+# define memEQs(s1, l, s2) \
+ (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
+#endif
+
+#ifndef memNEs
+# define memNEs(s1, l, s2) !memEQs(s1, l, s2)
+#endif
+#ifndef MoveD
+# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
+#endif
+
+#ifndef CopyD
+# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
+#endif
+
+#ifdef HAS_MEMSET
+#ifndef ZeroD
+# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
+#endif
+
+#else
+#ifndef ZeroD
+# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
+#endif
+
+#endif
+#ifndef PoisonWith
+# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
+#endif
+
+#ifndef PoisonNew
+# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
+#endif
+
+#ifndef PoisonFree
+# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
+#endif
+
+#ifndef Poison
+# define Poison(d,n,t) PoisonFree(d,n,t)
+#endif
+#ifndef Newx
+# define Newx(v,n,t) New(0,v,n,t)
+#endif
+
+#ifndef Newxc
+# define Newxc(v,n,t,c) Newc(0,v,n,t,c)
+#endif
+
+#ifndef Newxz
+# define Newxz(v,n,t) Newz(0,v,n,t)
+#endif
+#ifndef PERL_MAGIC_sv
+# define PERL_MAGIC_sv '\0'
+#endif
+
+#ifndef PERL_MAGIC_overload
+# define PERL_MAGIC_overload 'A'
+#endif
+
+#ifndef PERL_MAGIC_overload_elem
+# define PERL_MAGIC_overload_elem 'a'
+#endif
+
+#ifndef PERL_MAGIC_overload_table
+# define PERL_MAGIC_overload_table 'c'
+#endif
+
+#ifndef PERL_MAGIC_bm
+# define PERL_MAGIC_bm 'B'
+#endif
+
+#ifndef PERL_MAGIC_regdata
+# define PERL_MAGIC_regdata 'D'
+#endif
+
+#ifndef PERL_MAGIC_regdatum
+# define PERL_MAGIC_regdatum 'd'
+#endif
+
+#ifndef PERL_MAGIC_env
+# define PERL_MAGIC_env 'E'
+#endif
+
+#ifndef PERL_MAGIC_envelem
+# define PERL_MAGIC_envelem 'e'
+#endif
+
+#ifndef PERL_MAGIC_fm
+# define PERL_MAGIC_fm 'f'
+#endif
+
+#ifndef PERL_MAGIC_regex_global
+# define PERL_MAGIC_regex_global 'g'
+#endif
+
+#ifndef PERL_MAGIC_isa
+# define PERL_MAGIC_isa 'I'
+#endif
+
+#ifndef PERL_MAGIC_isaelem
+# define PERL_MAGIC_isaelem 'i'
+#endif
+
+#ifndef PERL_MAGIC_nkeys
+# define PERL_MAGIC_nkeys 'k'
+#endif
+
+#ifndef PERL_MAGIC_dbfile
+# define PERL_MAGIC_dbfile 'L'
+#endif
+
+#ifndef PERL_MAGIC_dbline
+# define PERL_MAGIC_dbline 'l'
+#endif
+
+#ifndef PERL_MAGIC_mutex
+# define PERL_MAGIC_mutex 'm'
+#endif
+
+#ifndef PERL_MAGIC_shared
+# define PERL_MAGIC_shared 'N'
+#endif
+
+#ifndef PERL_MAGIC_shared_scalar
+# define PERL_MAGIC_shared_scalar 'n'
+#endif
+
+#ifndef PERL_MAGIC_collxfrm
+# define PERL_MAGIC_collxfrm 'o'
+#endif
+
+#ifndef PERL_MAGIC_tied
+# define PERL_MAGIC_tied 'P'
+#endif
+
+#ifndef PERL_MAGIC_tiedelem
+# define PERL_MAGIC_tiedelem 'p'
+#endif
+
+#ifndef PERL_MAGIC_tiedscalar
+# define PERL_MAGIC_tiedscalar 'q'
+#endif
+
+#ifndef PERL_MAGIC_qr
+# define PERL_MAGIC_qr 'r'
+#endif
+
+#ifndef PERL_MAGIC_sig
+# define PERL_MAGIC_sig 'S'
+#endif
+
+#ifndef PERL_MAGIC_sigelem
+# define PERL_MAGIC_sigelem 's'
+#endif
+
+#ifndef PERL_MAGIC_taint
+# define PERL_MAGIC_taint 't'
+#endif
+
+#ifndef PERL_MAGIC_uvar
+# define PERL_MAGIC_uvar 'U'
+#endif
+
+#ifndef PERL_MAGIC_uvar_elem
+# define PERL_MAGIC_uvar_elem 'u'
+#endif
+
+#ifndef PERL_MAGIC_vstring
+# define PERL_MAGIC_vstring 'V'
+#endif
+
+#ifndef PERL_MAGIC_vec
+# define PERL_MAGIC_vec 'v'
+#endif
+
+#ifndef PERL_MAGIC_utf8
+# define PERL_MAGIC_utf8 'w'
+#endif
+
+#ifndef PERL_MAGIC_substr
+# define PERL_MAGIC_substr 'x'
+#endif
+
+#ifndef PERL_MAGIC_defelem
+# define PERL_MAGIC_defelem 'y'
+#endif
+
+#ifndef PERL_MAGIC_glob
+# define PERL_MAGIC_glob '*'
+#endif
+
+#ifndef PERL_MAGIC_arylen
+# define PERL_MAGIC_arylen '#'
+#endif
+
+#ifndef PERL_MAGIC_pos
+# define PERL_MAGIC_pos '.'
+#endif
+
+#ifndef PERL_MAGIC_backref
+# define PERL_MAGIC_backref '<'
+#endif
+
+#ifndef PERL_MAGIC_ext
+# define PERL_MAGIC_ext '~'
+#endif
+
+#ifdef NEED_mess_sv
+#define NEED_mess
+#endif
+
+#ifdef NEED_mess
+#define NEED_mess_nocontext
+#define NEED_vmess
+#endif
+
+#ifndef croak_sv
+#if (PERL_BCDVERSION >= 0x5007003) || ( (PERL_BCDVERSION >= 0x5006001) && (PERL_BCDVERSION < 0x5007000) )
+# if ( (PERL_BCDVERSION >= 0x5008000) && (PERL_BCDVERSION < 0x5008009) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5010001) )
+# define D_PPP_FIX_UTF8_ERRSV(errsv, sv) \
+ STMT_START { \
+ if (sv != errsv) \
+ SvFLAGS(errsv) = (SvFLAGS(errsv) & ~SVf_UTF8) | \
+ (SvFLAGS(sv) & SVf_UTF8); \
+ } STMT_END
+# else
+# define D_PPP_FIX_UTF8_ERRSV(errsv, sv) STMT_START {} STMT_END
+# endif
+# define croak_sv(sv) \
+ STMT_START { \
+ if (SvROK(sv)) { \
+ sv_setsv(ERRSV, sv); \
+ croak(NULL); \
+ } else { \
+ D_PPP_FIX_UTF8_ERRSV(ERRSV, sv); \
+ croak("%" SVf, SVfARG(sv)); \
+ } \
+ } STMT_END
+#elif (PERL_BCDVERSION >= 0x5004000)
+# define croak_sv(sv) croak("%" SVf, SVfARG(sv))
+#else
+# define croak_sv(sv) croak("%s", SvPV_nolen(sv))
+#endif
+#endif
+
+#ifndef die_sv
+#if defined(NEED_die_sv)
+static OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
+static
+#else
+extern OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
+#endif
+
+#if defined(NEED_die_sv) || defined(NEED_die_sv_GLOBAL)
+
+#ifdef die_sv
+# undef die_sv
+#endif
+#define die_sv(a) DPPP_(my_die_sv)(aTHX_ a)
+#define Perl_die_sv DPPP_(my_die_sv)
+
+OP *
+DPPP_(my_die_sv)(pTHX_ SV *sv)
+{
+ croak_sv(sv);
+ return (OP *)NULL;
+}
+#endif
+#endif
+
+#ifndef warn_sv
+#if (PERL_BCDVERSION >= 0x5004000)
+# define warn_sv(sv) warn("%" SVf, SVfARG(sv))
+#else
+# define warn_sv(sv) warn("%s", SvPV_nolen(sv))
+#endif
+#endif
+
+#ifndef vmess
+#if defined(NEED_vmess)
+static SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
+static
+#else
+extern SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
+#endif
+
+#if defined(NEED_vmess) || defined(NEED_vmess_GLOBAL)
+
+#ifdef vmess
+# undef vmess
+#endif
+#define vmess(a,b) DPPP_(my_vmess)(aTHX_ a,b)
+#define Perl_vmess DPPP_(my_vmess)
+
+SV*
+DPPP_(my_vmess)(pTHX_ const char* pat, va_list* args)
+{
+ mess(pat, args);
+ return PL_mess_sv;
+}
+#endif
+#endif
+
+#if (PERL_BCDVERSION < 0x5006000)
+#undef mess
+#endif
+
+#if !defined(mess_nocontext) && !defined(Perl_mess_nocontext)
+#if defined(NEED_mess_nocontext)
+static SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
+static
+#else
+extern SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
+#endif
+
+#if defined(NEED_mess_nocontext) || defined(NEED_mess_nocontext_GLOBAL)
+
+#define mess_nocontext DPPP_(my_mess_nocontext)
+#define Perl_mess_nocontext DPPP_(my_mess_nocontext)
+
+SV*
+DPPP_(my_mess_nocontext)(const char* pat, ...)
+{
+ dTHX;
+ SV *sv;
+ va_list args;
+ va_start(args, pat);
+ sv = vmess(pat, &args);
+ va_end(args);
+ return sv;
+}
+#endif
+#endif
+
+#ifndef mess
+#if defined(NEED_mess)
+static SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
+static
+#else
+extern SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
+#endif
+
+#if defined(NEED_mess) || defined(NEED_mess_GLOBAL)
+
+#define Perl_mess DPPP_(my_mess)
+
+SV*
+DPPP_(my_mess)(pTHX_ const char* pat, ...)
+{
+ SV *sv;
+ va_list args;
+ va_start(args, pat);
+ sv = vmess(pat, &args);
+ va_end(args);
+ return sv;
+}
+#ifdef mess_nocontext
+#define mess mess_nocontext
+#else
+#define mess Perl_mess_nocontext
+#endif
+#endif
+#endif
+
+#ifndef mess_sv
+#if defined(NEED_mess_sv)
+static SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
+static
+#else
+extern SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
+#endif
+
+#if defined(NEED_mess_sv) || defined(NEED_mess_sv_GLOBAL)
+
+#ifdef mess_sv
+# undef mess_sv
+#endif
+#define mess_sv(a,b) DPPP_(my_mess_sv)(aTHX_ a,b)
+#define Perl_mess_sv DPPP_(my_mess_sv)
+
+SV *
+DPPP_(my_mess_sv)(pTHX_ SV *basemsg, bool consume)
+{
+ SV *tmp;
+ SV *ret;
+
+ if (SvPOK(basemsg) && SvCUR(basemsg) && *(SvEND(basemsg)-1) == '\n') {
+ if (consume)
+ return basemsg;
+ ret = mess("");
+ SvSetSV_nosteal(ret, basemsg);
+ return ret;
+ }
+
+ if (consume) {
+ sv_catsv(basemsg, mess(""));
+ return basemsg;
+ }
+
+ ret = mess("");
+ tmp = newSVsv(ret);
+ SvSetSV_nosteal(ret, basemsg);
+ sv_catsv(ret, tmp);
+ sv_dec(tmp);
+ return ret;
+}
+#endif
+#endif
+
+#ifndef warn_nocontext
+#define warn_nocontext warn
+#endif
+
+#ifndef croak_nocontext
+#define croak_nocontext croak
+#endif
+
+#ifndef croak_no_modify
+#define croak_no_modify() croak_nocontext("%s", PL_no_modify)
+#define Perl_croak_no_modify() croak_no_modify()
+#endif
+
+#ifndef croak_memory_wrap
+#if (PERL_BCDVERSION >= 0x5009002) || ( (PERL_BCDVERSION >= 0x5008006) && (PERL_BCDVERSION < 0x5009000) )
+# define croak_memory_wrap() croak_nocontext("%s", PL_memory_wrap)
+#else
+# define croak_memory_wrap() croak_nocontext("panic: memory wrap")
+#endif
+#endif
+
+#ifndef croak_xs_usage
+#if defined(NEED_croak_xs_usage)
+static void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params);
+static
+#else
+extern void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params);
+#endif
+
+#if defined(NEED_croak_xs_usage) || defined(NEED_croak_xs_usage_GLOBAL)
+
+#define croak_xs_usage DPPP_(my_croak_xs_usage)
+#define Perl_croak_xs_usage DPPP_(my_croak_xs_usage)
+
+
+#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
+#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
+#endif
+
+void
+DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params)
+{
+ dTHX;
+ const GV *const gv = CvGV(cv);
+
+ PERL_ARGS_ASSERT_CROAK_XS_USAGE;
+
+ if (gv) {
+ const char *const gvname = GvNAME(gv);
+ const HV *const stash = GvSTASH(gv);
+ const char *const hvname = stash ? HvNAME(stash) : NULL;
+
+ if (hvname)
+ croak("Usage: %s::%s(%s)", hvname, gvname, params);
+ else
+ croak("Usage: %s(%s)", gvname, params);
+ } else {
+ /* Pants. I don't think that it should be possible to get here. */
+ croak("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
+ }
+}
+#endif
+#endif
+
+#ifndef PERL_SIGNALS_UNSAFE_FLAG
+
+#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
+
+#if (PERL_BCDVERSION < 0x5008000)
+# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
+#else
+# define D_PPP_PERL_SIGNALS_INIT 0
+#endif
+
+#if defined(NEED_PL_signals)
+static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
+#elif defined(NEED_PL_signals_GLOBAL)
+U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
+#else
+extern U32 DPPP_(my_PL_signals);
+#endif
+#define PL_signals DPPP_(my_PL_signals)
+
+#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 (PERL_BCDVERSION <= 0x5005005)
+/* Replace: 1 */
+# define PL_ppaddr ppaddr
+# define PL_no_modify no_modify
+/* Replace: 0 */
+#endif
+
+#if (PERL_BCDVERSION <= 0x5004005)
+/* 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 (PERL_BCDVERSION >= 0x5009005)
+# 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)
+#if defined(NEED_PL_parser)
+static yy_parser DPPP_(dummy_PL_parser);
+#elif defined(NEED_PL_parser_GLOBAL)
+yy_parser DPPP_(dummy_PL_parser);
+#else
+extern yy_parser DPPP_(dummy_PL_parser);
+#endif
+
+# endif
+
+/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
+/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
+ * Do not use this variable unless you know exactly what you're
+ * doing. It is internal to the perl parser and may change or even
+ * be removed in the future. As of perl 5.9.5, you have to check
+ * for (PL_parser != NULL) for this variable to have any effect.
+ * An always non-NULL PL_parser dummy is provided for earlier
+ * perl versions.
+ * If PL_parser is NULL when you try to access this variable, a
+ * dummy is being accessed instead and a warning is issued unless
+ * you define DPPP_PL_parser_NO_DUMMY_WARNING.
+ * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
+ * this variable will croak with a panic message.
+ */
+
+# define PL_expect D_PPP_my_PL_parser_var(expect)
+# define PL_copline D_PPP_my_PL_parser_var(copline)
+# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
+# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
+# define PL_linestr D_PPP_my_PL_parser_var(linestr)
+# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
+# define PL_bufend D_PPP_my_PL_parser_var(bufend)
+# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
+# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
+# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
+# define PL_in_my D_PPP_my_PL_parser_var(in_my)
+# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
+# define PL_error_count D_PPP_my_PL_parser_var(error_count)
+
+
+#else
+
+/* ensure that PL_parser != NULL and cannot be dereferenced */
+# define PL_parser ((void *) 1)
+
+#endif
+#ifndef mPUSHs
+# define mPUSHs(s) PUSHs(sv_2mortal(s))
+#endif
+
+#ifndef PUSHmortal
+# define PUSHmortal PUSHs(sv_newmortal())
+#endif
+
+#ifndef mPUSHp
+# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
+#endif
+
+#ifndef mPUSHn
+# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
+#endif
+
+#ifndef mPUSHi
+# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
+#endif
+
+#ifndef mPUSHu
+# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
+#endif
+#ifndef mXPUSHs
+# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
+#endif
+
+#ifndef XPUSHmortal
+# define XPUSHmortal XPUSHs(sv_newmortal())
+#endif
+
+#ifndef mXPUSHp
+# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
+#endif
+
+#ifndef mXPUSHn
+# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
+#endif
+
+#ifndef mXPUSHi
+# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
+#endif
+
+#ifndef mXPUSHu
+# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
+#endif
+
+/* Replace: 1 */
+#ifndef call_sv
+# define call_sv perl_call_sv
+#endif
+
+#ifndef call_pv
+# define call_pv perl_call_pv
+#endif
+
+#ifndef call_argv
+# define call_argv perl_call_argv
+#endif
+
+#ifndef call_method
+# define call_method perl_call_method
+#endif
+#ifndef eval_sv
+# define eval_sv perl_eval_sv
+#endif
+
+/* Replace: 0 */
+#ifndef PERL_LOADMOD_DENY
+# define PERL_LOADMOD_DENY 0x1
+#endif
+
+#ifndef PERL_LOADMOD_NOIMPORT
+# define PERL_LOADMOD_NOIMPORT 0x2
+#endif
+
+#ifndef PERL_LOADMOD_IMPORT_OPS
+# define PERL_LOADMOD_IMPORT_OPS 0x4
+#endif
+
+#ifndef G_METHOD
+# define G_METHOD 64
+# ifdef call_sv
+# undef call_sv
+# endif
+# if (PERL_BCDVERSION < 0x5006000)
+# 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 defined(NEED_eval_pv)
+static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
+static
+#else
+extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
+#endif
+
+#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
+
+#ifdef eval_pv
+# undef eval_pv
+#endif
+#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
+#define Perl_eval_pv DPPP_(my_eval_pv)
+
+
+SV*
+DPPP_(my_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 && SvTRUEx(ERRSV))
+ croak_sv(ERRSV);
+
+ return sv;
+}
+
+#endif
+#endif
+
+#ifndef vload_module
+#if defined(NEED_vload_module)
+static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
+static
+#else
+extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
+#endif
+
+#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
+
+#ifdef vload_module
+# undef vload_module
+#endif
+#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
+#define Perl_vload_module DPPP_(my_vload_module)
+
+
+void
+DPPP_(my_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 (PERL_BCDVERSION >= 0x5004000)
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
+ veop, modname, imop);
+#elif (PERL_BCDVERSION > 0x5003000)
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
+ veop, modname, imop);
+#else
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
+ modname, imop);
+#endif
+ PL_expect = oexpect;
+ PL_copline = ocopline;
+ PL_curcop = ocurcop;
+ }
+}
+
+#endif
+#endif
+
+#ifndef load_module
+#if defined(NEED_load_module)
+static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
+static
+#else
+extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
+#endif
+
+#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
+
+#ifdef load_module
+# undef load_module
+#endif
+#define load_module DPPP_(my_load_module)
+#define Perl_load_module DPPP_(my_load_module)
+
+
+void
+DPPP_(my_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
+#ifndef newRV_inc
+# define newRV_inc(sv) newRV(sv) /* Replace */
+#endif
+
+#ifndef newRV_noinc
+#if defined(NEED_newRV_noinc)
+static SV * DPPP_(my_newRV_noinc)(SV *sv);
+static
+#else
+extern SV * DPPP_(my_newRV_noinc)(SV *sv);
+#endif
+
+#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
+
+#ifdef newRV_noinc
+# undef newRV_noinc
+#endif
+#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
+#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
+
+SV *
+DPPP_(my_newRV_noinc)(SV *sv)
+{
+ SV *rv = (SV *)newRV(sv);
+ SvREFCNT_dec(sv);
+ return rv;
+}
+#endif
+#endif
+
+/* 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 (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
+#if defined(NEED_newCONSTSUB)
+static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
+static
+#else
+extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
+#endif
+
+#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
+
+#ifdef newCONSTSUB
+# undef newCONSTSUB
+#endif
+#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
+#define Perl_newCONSTSUB DPPP_(my_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
+DPPP_(my_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 (PERL_BCDVERSION < 0x5003022)
+ start_subparse(),
+#elif (PERL_BCDVERSION == 0x5003022)
+ 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
+
+/*
+ * 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 (PERL_BCDVERSION < 0x5004068)
+/* 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
+
+#ifndef IVdf
+# if IVSIZE == LONGSIZE
+# define IVdf "ld"
+# define UVuf "lu"
+# define UVof "lo"
+# define UVxf "lx"
+# define UVXf "lX"
+# elif IVSIZE == INTSIZE
+# define IVdf "d"
+# define UVuf "u"
+# define UVof "o"
+# define UVxf "x"
+# define UVXf "X"
+# else
+# error "cannot define IV/UV formats"
+# endif
+#endif
+
+#ifndef NVef
+# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
+ defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
+ /* 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
+
+#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
+#ifndef SvREFCNT_inc_simple_void
+# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
+#endif
+
+#ifndef SvREFCNT_inc_simple_NN
+# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
+#endif
+
+#ifndef SvREFCNT_inc_void_NN
+# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
+#endif
+
+#ifndef SvREFCNT_inc_simple_void_NN
+# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
+#endif
+
+#ifndef newSV_type
+
+#if defined(NEED_newSV_type)
+static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
+static
+#else
+extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
+#endif
+
+#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
+
+#ifdef newSV_type
+# undef newSV_type
+#endif
+#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
+#define Perl_newSV_type DPPP_(my_newSV_type)
+
+
+SV*
+DPPP_(my_newSV_type)(pTHX_ svtype const t)
+{
+ SV* const sv = newSV(0);
+ sv_upgrade(sv, t);
+ return sv;
+}
+
+#endif
+
+#endif
+
+#if (PERL_BCDVERSION < 0x5006000)
+# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
+#else
+# define D_PPP_CONSTPV_ARG(x) (x)
+#endif
+#ifndef newSVpvn
+# define newSVpvn(data,len) ((data) \
+ ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
+ : newSV(0))
+#endif
+#ifndef newSVpvn_utf8
+# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
+#endif
+#ifndef SVf_UTF8
+# define SVf_UTF8 0
+#endif
+
+#ifndef newSVpvn_flags
+
+#if defined(NEED_newSVpvn_flags)
+static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
+static
+#else
+extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
+#endif
+
+#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
+
+#ifdef newSVpvn_flags
+# undef newSVpvn_flags
+#endif
+#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
+#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
+
+
+SV *
+DPPP_(my_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
+
+/* 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().
+ */
+#ifndef sv_2pv_nolen
+# define sv_2pv_nolen(sv) SvPV_nolen(sv)
+#endif
+
+#ifdef SvPVbyte
+
+/* Hint: SvPVbyte
+ * Does not work in perl-5.6.1, ppport.h implements a version
+ * borrowed from perl-5.7.3.
+ */
+
+#if (PERL_BCDVERSION < 0x5007000)
+
+#if defined(NEED_sv_2pvbyte)
+static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
+static
+#else
+extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
+#endif
+
+#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
+
+#ifdef sv_2pvbyte
+# undef sv_2pvbyte
+#endif
+#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
+#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
+
+
+char *
+DPPP_(my_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
+#ifndef sv_2pvbyte_nolen
+# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
+#endif
+
+/* 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 */
+#ifndef SV_IMMEDIATE_UNREF
+# define SV_IMMEDIATE_UNREF 0
+#endif
+
+#ifndef SV_GMAGIC
+# define SV_GMAGIC 0
+#endif
+
+#ifndef SV_COW_DROP_PV
+# define SV_COW_DROP_PV 0
+#endif
+
+#ifndef SV_UTF8_NO_ENCODING
+# define SV_UTF8_NO_ENCODING 0
+#endif
+
+#ifndef SV_NOSTEAL
+# define SV_NOSTEAL 0
+#endif
+
+#ifndef SV_CONST_RETURN
+# define SV_CONST_RETURN 0
+#endif
+
+#ifndef SV_MUTABLE_RETURN
+# define SV_MUTABLE_RETURN 0
+#endif
+
+#ifndef SV_SMAGIC
+# define SV_SMAGIC 0
+#endif
+
+#ifndef SV_HAS_TRAILING_NUL
+# define SV_HAS_TRAILING_NUL 0
+#endif
+
+#ifndef SV_COW_SHARED_HASH_KEYS
+# define SV_COW_SHARED_HASH_KEYS 0
+#endif
+
+#if (PERL_BCDVERSION < 0x5007002)
+
+#if defined(NEED_sv_2pv_flags)
+static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+static
+#else
+extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+#endif
+
+#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
+
+#ifdef sv_2pv_flags
+# undef sv_2pv_flags
+#endif
+#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
+#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
+
+
+char *
+DPPP_(my_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 defined(NEED_sv_pvn_force_flags)
+static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+static
+#else
+extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+#endif
+
+#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
+
+#ifdef sv_pvn_force_flags
+# undef sv_pvn_force_flags
+#endif
+#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
+#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
+
+
+char *
+DPPP_(my_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 (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
+# define D_PPP_SVPV_NOLEN_LP_ARG &PL_na
+#else
+# define D_PPP_SVPV_NOLEN_LP_ARG 0
+#endif
+#ifndef SvPV_const
+# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_mutable
+# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
+#endif
+#ifndef SvPV_flags
+# define SvPV_flags(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
+#endif
+#ifndef SvPV_flags_const
+# define 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))
+#endif
+#ifndef SvPV_flags_const_nolen
+# define SvPV_flags_const_nolen(sv, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX_const(sv) : \
+ (const char*) sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
+#endif
+#ifndef SvPV_flags_mutable
+# define 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))
+#endif
+#ifndef SvPV_force
+# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_force_nolen
+# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_force_mutable
+# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
+#endif
+
+#ifndef SvPV_force_nomg
+# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
+#endif
+
+#ifndef SvPV_force_nomg_nolen
+# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
+#endif
+#ifndef SvPV_force_flags
+# define 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))
+#endif
+#ifndef SvPV_force_flags_nolen
+# define SvPV_force_flags_nolen(sv, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? SvPVX(sv) : sv_pvn_force_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, flags))
+#endif
+#ifndef SvPV_force_flags_mutable
+# define 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))
+#endif
+#ifndef SvPV_nolen
+# define SvPV_nolen(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
+#endif
+#ifndef SvPV_nolen_const
+# define SvPV_nolen_const(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX_const(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
+#endif
+#ifndef SvPV_nomg
+# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
+#endif
+
+#ifndef SvPV_nomg_const
+# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
+#endif
+
+#ifndef SvPV_nomg_const_nolen
+# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
+#endif
+
+#ifndef SvPV_nomg_nolen
+# define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_flags(sv, D_PPP_SVPV_NOLEN_LP_ARG, 0))
+#endif
+#ifndef SvPV_renew
+# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
+ SvPV_set((sv), (char *) saferealloc( \
+ (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
+ } STMT_END
+#endif
+#ifndef SvMAGIC_set
+# define SvMAGIC_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
+ (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
+#endif
+
+#if (PERL_BCDVERSION < 0x5009003)
+#ifndef SvPVX_const
+# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
+#endif
+
+#ifndef SvPVX_mutable
+# define SvPVX_mutable(sv) (0 + SvPVX(sv))
+#endif
+#ifndef SvRV_set
+# define SvRV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
+ (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
+#endif
+
+#else
+#ifndef SvPVX_const
+# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
+#endif
+
+#ifndef SvPVX_mutable
+# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
+#endif
+#ifndef SvRV_set
+# define SvRV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
+ ((sv)->sv_u.svu_rv = (val)); } STMT_END
+#endif
+
+#endif
+#ifndef SvSTASH_set
+# define SvSTASH_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
+ (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
+#endif
+
+#if (PERL_BCDVERSION < 0x5004000)
+#ifndef SvUV_set
+# define SvUV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
+ (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
+#endif
+
+#else
+#ifndef SvUV_set
+# define SvUV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
+ (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
+#endif
+
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
+#if defined(NEED_vnewSVpvf)
+static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
+static
+#else
+extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
+#endif
+
+#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
+
+#ifdef vnewSVpvf
+# undef vnewSVpvf
+#endif
+#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
+#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
+
+
+SV *
+DPPP_(my_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 (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
+# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
+# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
+#if defined(NEED_sv_catpvf_mg)
+static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+#endif
+
+#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
+
+#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
+
+
+void
+DPPP_(my_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 (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
+#if defined(NEED_sv_catpvf_mg_nocontext)
+static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+#endif
+
+#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
+
+#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+
+
+void
+DPPP_(my_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 (PERL_BCDVERSION >= 0x5004000) && !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 (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
+#if defined(NEED_sv_setpvf_mg)
+static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+#endif
+
+#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
+
+#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
+
+
+void
+DPPP_(my_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 (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
+#if defined(NEED_sv_setpvf_mg_nocontext)
+static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+static
+#else
+extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+#endif
+
+#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
+
+#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+
+
+void
+DPPP_(my_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 (PERL_BCDVERSION >= 0x5004000) && !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
+
+/* Hint: newSVpvn_share
+ * The SVs created by this function only mimic the behaviour of
+ * shared PVs without really being shared. Only use if you know
+ * what you're doing.
+ */
+
+#ifndef newSVpvn_share
+
+#if defined(NEED_newSVpvn_share)
+static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+static
+#else
+extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+#endif
+
+#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
+
+#ifdef newSVpvn_share
+# undef newSVpvn_share
+#endif
+#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
+#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
+
+
+SV *
+DPPP_(my_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
+#ifndef SvSHARED_HASH
+# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
+#endif
+#ifndef HvNAME_get
+# define HvNAME_get(hv) HvNAME(hv)
+#endif
+#ifndef HvNAMELEN_get
+# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
+#endif
+
+#ifndef gv_fetchpvn_flags
+#if defined(NEED_gv_fetchpvn_flags)
+static GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
+static
+#else
+extern GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
+#endif
+
+#if defined(NEED_gv_fetchpvn_flags) || defined(NEED_gv_fetchpvn_flags_GLOBAL)
+
+#ifdef gv_fetchpvn_flags
+# undef gv_fetchpvn_flags
+#endif
+#define gv_fetchpvn_flags(a,b,c,d) DPPP_(my_gv_fetchpvn_flags)(aTHX_ a,b,c,d)
+#define Perl_gv_fetchpvn_flags DPPP_(my_gv_fetchpvn_flags)
+
+
+GV*
+DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types) {
+ char *namepv = savepvn(name, len);
+ GV* stash = gv_fetchpv(namepv, TRUE, SVt_PVHV);
+ Safefree(namepv);
+ return stash;
+}
+
+#endif
+#endif
+#ifndef GvSVn
+# define GvSVn(gv) GvSV(gv)
+#endif
+
+#ifndef isGV_with_GP
+# define isGV_with_GP(gv) isGV(gv)
+#endif
+
+#ifndef gv_fetchsv
+# define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
+#endif
+#ifndef get_cvn_flags
+# define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
+#endif
+
+#ifndef gv_init_pvn
+# define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
+#endif
+
+/* 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
+ */
+#ifndef STR_WITH_LEN
+# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
+#endif
+#ifndef newSVpvs
+# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
+#endif
+
+#ifndef newSVpvs_flags
+# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
+#endif
+
+#ifndef newSVpvs_share
+# define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
+#endif
+
+#ifndef sv_catpvs
+# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
+#endif
+
+#ifndef sv_setpvs
+# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
+#endif
+
+#ifndef hv_fetchs
+# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
+#endif
+
+#ifndef hv_stores
+# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
+#endif
+#ifndef gv_fetchpvs
+# define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
+#endif
+
+#ifndef gv_stashpvs
+# define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
+#endif
+#ifndef get_cvs
+# define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
+#endif
+#ifndef SvGETMAGIC
+# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
+#endif
+
+/* That's the best we can do... */
+#ifndef sv_catpvn_nomg
+# define sv_catpvn_nomg sv_catpvn
+#endif
+
+#ifndef sv_catsv_nomg
+# define sv_catsv_nomg sv_catsv
+#endif
+
+#ifndef sv_setsv_nomg
+# define sv_setsv_nomg sv_setsv
+#endif
+
+#ifndef sv_pvn_nomg
+# define sv_pvn_nomg sv_pvn
+#endif
+
+#ifndef SvIV_nomg
+# define SvIV_nomg SvIV
+#endif
+
+#ifndef SvUV_nomg
+# define SvUV_nomg SvUV
+#endif
+
+#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
+#ifndef SvVSTRING_mg
+# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
+#endif
+
+/* 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 (PERL_BCDVERSION < 0x5004000)
+
+ /* code that uses sv_magic_portable will not compile */
+
+#elif (PERL_BCDVERSION < 0x5008000)
+
+# define sv_magic_portable(sv, obj, how, name, namlen) \
+ STMT_START { \
+ SV *SvMp_sv = (sv); \
+ char *SvMp_name = (char *) (name); \
+ I32 SvMp_namlen = (namlen); \
+ if (SvMp_name && SvMp_namlen == 0) \
+ { \
+ MAGIC *mg; \
+ sv_magic(SvMp_sv, obj, how, 0, 0); \
+ mg = SvMAGIC(SvMp_sv); \
+ mg->mg_len = -42; /* XXX: this is the tricky part */ \
+ mg->mg_ptr = SvMp_name; \
+ } \
+ else \
+ { \
+ sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
+ } \
+ } STMT_END
+
+#else
+
+# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
+
+#endif
+
+#if !defined(mg_findext)
+#if defined(NEED_mg_findext)
+static MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
+static
+#else
+extern MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
+#endif
+
+#if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
+
+#define mg_findext DPPP_(my_mg_findext)
+#define Perl_mg_findext DPPP_(my_mg_findext)
+
+
+MAGIC *
+DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl) {
+ if (sv) {
+ MAGIC *mg;
+
+#ifdef AvPAD_NAMELIST
+ assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
+#endif
+
+ for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
+ if (mg->mg_type == type && mg->mg_virtual == vtbl)
+ return mg;
+ }
+ }
+
+ return NULL;
+}
+
+#endif
+#endif
+
+#if !defined(sv_unmagicext)
+#if defined(NEED_sv_unmagicext)
+static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
+static
+#else
+extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
+#endif
+
+#if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
+
+#ifdef sv_unmagicext
+# undef sv_unmagicext
+#endif
+#define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
+#define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
+
+
+int
+DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
+{
+ MAGIC* mg;
+ MAGIC** mgp;
+
+ if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
+ return 0;
+ mgp = &(SvMAGIC(sv));
+ for (mg = *mgp; mg; mg = *mgp) {
+ const MGVTBL* const virt = mg->mg_virtual;
+ if (mg->mg_type == type && virt == vtbl) {
+ *mgp = mg->mg_moremagic;
+ if (virt && virt->svt_free)
+ virt->svt_free(aTHX_ sv, mg);
+ if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
+ if (mg->mg_len > 0)
+ Safefree(mg->mg_ptr);
+ else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
+ SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
+ else if (mg->mg_type == PERL_MAGIC_utf8)
+ Safefree(mg->mg_ptr);
+ }
+ if (mg->mg_flags & MGf_REFCOUNTED)
+ SvREFCNT_dec(mg->mg_obj);
+ Safefree(mg);
+ }
+ else
+ mgp = &mg->mg_moremagic;
+ }
+ if (SvMAGIC(sv)) {
+ if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */
+ mg_magical(sv); /* else fix the flags now */
+ }
+ else {
+ SvMAGICAL_off(sv);
+ SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+ }
+ return 0;
+}
+
+#endif
+#endif
+
+#ifdef USE_ITHREADS
+#ifndef CopFILE
+# define CopFILE(c) ((c)->cop_file)
+#endif
+
+#ifndef CopFILEGV
+# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
+#endif
+
+#ifndef CopFILE_set
+# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
+#endif
+
+#ifndef CopFILESV
+# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
+#endif
+
+#ifndef CopFILEAV
+# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
+#endif
+
+#ifndef CopSTASHPV
+# define CopSTASHPV(c) ((c)->cop_stashpv)
+#endif
+
+#ifndef CopSTASHPV_set
+# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
+#endif
+
+#ifndef CopSTASH
+# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
+#endif
+
+#ifndef CopSTASH_set
+# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
+#endif
+
+#ifndef CopSTASH_eq
+# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
+ || (CopSTASHPV(c) && HvNAME(hv) \
+ && strEQ(CopSTASHPV(c), HvNAME(hv)))))
+#endif
+
+#else
+#ifndef CopFILEGV
+# define CopFILEGV(c) ((c)->cop_filegv)
+#endif
+
+#ifndef CopFILEGV_set
+# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
+#endif
+
+#ifndef CopFILE_set
+# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
+#endif
+
+#ifndef CopFILESV
+# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
+#endif
+
+#ifndef CopFILEAV
+# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
+#endif
+
+#ifndef CopFILE
+# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
+#endif
+
+#ifndef CopSTASH
+# define CopSTASH(c) ((c)->cop_stash)
+#endif
+
+#ifndef CopSTASH_set
+# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
+#endif
+
+#ifndef CopSTASHPV
+# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
+#endif
+
+#ifndef CopSTASHPV_set
+# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
+#endif
+
+#ifndef CopSTASH_eq
+# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
+#endif
+
+#endif /* USE_ITHREADS */
+
+#if (PERL_BCDVERSION >= 0x5006000)
+#ifndef caller_cx
+
+# if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
+static I32
+DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock)
+{
+ I32 i;
+
+ for (i = startingblock; i >= 0; i--) {
+ register const PERL_CONTEXT * const cx = &cxstk[i];
+ switch (CxTYPE(cx)) {
+ default:
+ continue;
+ case CXt_EVAL:
+ case CXt_SUB:
+ case CXt_FORMAT:
+ return i;
+ }
+ }
+ return i;
+}
+# endif
+
+# if defined(NEED_caller_cx)
+static const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
+static
+#else
+extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
+#endif
+
+#if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
+
+#ifdef caller_cx
+# undef caller_cx
+#endif
+#define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
+#define Perl_caller_cx DPPP_(my_caller_cx)
+
+
+const PERL_CONTEXT *
+DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
+{
+ register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix);
+ register const PERL_CONTEXT *cx;
+ register const PERL_CONTEXT *ccstack = cxstack;
+ const PERL_SI *top_si = PL_curstackinfo;
+
+ for (;;) {
+ /* we may be in a higher stacklevel, so dig down deeper */
+ while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
+ top_si = top_si->si_prev;
+ ccstack = top_si->si_cxstack;
+ cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
+ }
+ if (cxix < 0)
+ return NULL;
+ /* caller() should not report the automatic calls to &DB::sub */
+ if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
+ ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
+ count++;
+ if (!count--)
+ break;
+ cxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
+ }
+
+ cx = &ccstack[cxix];
+ if (dbcxp) *dbcxp = cx;
+
+ if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
+ const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
+ /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
+ field below is defined for any cx. */
+ /* caller() should not report the automatic calls to &DB::sub */
+ if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
+ cx = &ccstack[dbcxix];
+ }
+
+ return cx;
+}
+
+# endif
+#endif /* caller_cx */
+#endif /* 5.6.0 */
+#ifndef IN_PERL_COMPILETIME
+# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
+#endif
+
+#ifndef IN_LOCALE_RUNTIME
+# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
+#endif
+
+#ifndef IN_LOCALE_COMPILETIME
+# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
+#endif
+
+#ifndef IN_LOCALE
+# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
+#endif
+#ifndef IS_NUMBER_IN_UV
+# define IS_NUMBER_IN_UV 0x01
+#endif
+
+#ifndef IS_NUMBER_GREATER_THAN_UV_MAX
+# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
+#endif
+
+#ifndef IS_NUMBER_NOT_INT
+# define IS_NUMBER_NOT_INT 0x04
+#endif
+
+#ifndef IS_NUMBER_NEG
+# define IS_NUMBER_NEG 0x08
+#endif
+
+#ifndef IS_NUMBER_INFINITY
+# define IS_NUMBER_INFINITY 0x10
+#endif
+
+#ifndef IS_NUMBER_NAN
+# define IS_NUMBER_NAN 0x20
+#endif
+#ifndef GROK_NUMERIC_RADIX
+# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
+#endif
+#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
+# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
+#endif
+
+#ifndef PERL_SCAN_SILENT_ILLDIGIT
+# define PERL_SCAN_SILENT_ILLDIGIT 0x04
+#endif
+
+#ifndef PERL_SCAN_ALLOW_UNDERSCORES
+# define PERL_SCAN_ALLOW_UNDERSCORES 0x01
+#endif
+
+#ifndef PERL_SCAN_DISALLOW_PREFIX
+# define PERL_SCAN_DISALLOW_PREFIX 0x02
+#endif
+
+#ifndef grok_numeric_radix
+#if defined(NEED_grok_numeric_radix)
+static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+static
+#else
+extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+#endif
+
+#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
+
+#ifdef grok_numeric_radix
+# undef grok_numeric_radix
+#endif
+#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
+#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
+
+bool
+DPPP_(my_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 defined(NEED_grok_number)
+static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+static
+#else
+extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+#endif
+
+#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
+
+#ifdef grok_number
+# undef grok_number
+#endif
+#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
+#define Perl_grok_number DPPP_(my_grok_number)
+
+int
+DPPP_(my_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 defined(NEED_grok_bin)
+static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+static
+#else
+extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+#endif
+
+#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
+
+#ifdef grok_bin
+# undef grok_bin
+#endif
+#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
+#define Perl_grok_bin DPPP_(my_grok_bin)
+
+UV
+DPPP_(my_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 defined(NEED_grok_hex)
+static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+static
+#else
+extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+#endif
+
+#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
+
+#ifdef grok_hex
+# undef grok_hex
+#endif
+#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
+#define Perl_grok_hex DPPP_(my_grok_hex)
+
+UV
+DPPP_(my_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 defined(NEED_grok_oct)
+static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+static
+#else
+extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
+#endif
+
+#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
+
+#ifdef grok_oct
+# undef grok_oct
+#endif
+#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
+#define Perl_grok_oct DPPP_(my_grok_oct)
+
+UV
+DPPP_(my_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
+
+#if !defined(my_snprintf)
+#if defined(NEED_my_snprintf)
+static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
+static
+#else
+extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
+#endif
+
+#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
+
+#define my_snprintf DPPP_(my_my_snprintf)
+#define Perl_my_snprintf DPPP_(my_my_snprintf)
+
+
+int
+DPPP_(my_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
+
+#if !defined(my_sprintf)
+#if defined(NEED_my_sprintf)
+static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
+static
+#else
+extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
+#endif
+
+#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
+
+#define my_sprintf DPPP_(my_my_sprintf)
+#define Perl_my_sprintf DPPP_(my_my_sprintf)
+
+
+int
+DPPP_(my_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
+
+#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
+
+#if !defined(my_strlcat)
+#if defined(NEED_my_strlcat)
+static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
+static
+#else
+extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
+#endif
+
+#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
+
+#define my_strlcat DPPP_(my_my_strlcat)
+#define Perl_my_strlcat DPPP_(my_my_strlcat)
+
+
+Size_t
+DPPP_(my_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 defined(NEED_my_strlcpy)
+static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
+static
+#else
+extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
+#endif
+
+#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
+
+#define my_strlcpy DPPP_(my_my_strlcpy)
+#define Perl_my_strlcpy DPPP_(my_my_strlcpy)
+
+
+Size_t
+DPPP_(my_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
+#ifndef PERL_PV_ESCAPE_QUOTE
+# define PERL_PV_ESCAPE_QUOTE 0x0001
+#endif
+
+#ifndef PERL_PV_PRETTY_QUOTE
+# define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
+#endif
+
+#ifndef PERL_PV_PRETTY_ELLIPSES
+# define PERL_PV_PRETTY_ELLIPSES 0x0002
+#endif
+
+#ifndef PERL_PV_PRETTY_LTGT
+# define PERL_PV_PRETTY_LTGT 0x0004
+#endif
+
+#ifndef PERL_PV_ESCAPE_FIRSTCHAR
+# define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
+#endif
+
+#ifndef PERL_PV_ESCAPE_UNI
+# define PERL_PV_ESCAPE_UNI 0x0100
+#endif
+
+#ifndef PERL_PV_ESCAPE_UNI_DETECT
+# define PERL_PV_ESCAPE_UNI_DETECT 0x0200
+#endif
+
+#ifndef PERL_PV_ESCAPE_ALL
+# define PERL_PV_ESCAPE_ALL 0x1000
+#endif
+
+#ifndef PERL_PV_ESCAPE_NOBACKSLASH
+# define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
+#endif
+
+#ifndef PERL_PV_ESCAPE_NOCLEAR
+# define PERL_PV_ESCAPE_NOCLEAR 0x4000
+#endif
+
+#ifndef PERL_PV_ESCAPE_RE
+# define PERL_PV_ESCAPE_RE 0x8000
+#endif
+
+#ifndef PERL_PV_PRETTY_NOCLEAR
+# define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
+#endif
+#ifndef PERL_PV_PRETTY_DUMP
+# define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
+#endif
+
+#ifndef PERL_PV_PRETTY_REGPROP
+# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
+#endif
+
+/* 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 defined(NEED_pv_escape)
+static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
+static
+#else
+extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
+#endif
+
+#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
+
+#ifdef pv_escape
+# undef pv_escape
+#endif
+#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
+#define Perl_pv_escape DPPP_(my_pv_escape)
+
+
+char *
+DPPP_(my_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_buf)
+ 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_buf)
+ 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_buf)
+ isuni ? utf8_to_uvchr_buf((U8*)pv, end, &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 defined(NEED_pv_pretty)
+static char * DPPP_(my_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);
+static
+#else
+extern char * DPPP_(my_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);
+#endif
+
+#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
+
+#ifdef pv_pretty
+# undef pv_pretty
+#endif
+#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
+#define Perl_pv_pretty DPPP_(my_pv_pretty)
+
+
+char *
+DPPP_(my_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 defined(NEED_pv_display)
+static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
+static
+#else
+extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
+#endif
+
+#if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
+
+#ifdef pv_display
+# undef pv_display
+#endif
+#define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
+#define Perl_pv_display DPPP_(my_pv_display)
+
+
+char *
+DPPP_(my_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
+
+#endif /* _P_P_PORTABILITY_H_ */
+
+/* End of File ppport.h */
my $path = shift;
return undef
- if $path =~ /(~|\.bak|_bak)$/ ||
+ if $path =~ /^(?:RCS|CVS|SCCS|\.svn|_darcs)$/ ||
+ $path =~ /(~|\.bak|_bak)$/ ||
$path =~ /\..*\.sw(o|p)$/ ||
$path =~ /\B\.svn\b/;
--- /dev/null
+# suppressions file for address sanitizer
+
+leak:Perl_yylex
+leak:Perl_yyparse
+leak:Perl_init_i18nl10n
+leak:Perl_newSTATEOP
+leak:S_optimize_op
+leak:Perl_re_op_compile
+leak:S_doeval_compile
+leak:Perl_re_dup_guts
--- /dev/null
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = ("../lib", "lib/compress");
+ }
+}
+
+use lib qw(t t/compress);
+use strict ;
+use warnings ;
+
+use Test::More ;
+
+BEGIN
+{
+
+ diag "Running Perl version $]\n";
+
+ # use Test::NoWarnings, if available
+ my $extra = 0 ;
+ $extra = 1
+ if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
+
+
+ my $VERSION = '2.202';
+ my @NAMES = qw(
+
+ );
+
+ my @OPT = qw(
+
+ );
+
+ plan tests => 1 + @NAMES + @OPT + $extra ;
+
+ ok 1;
+
+ foreach my $name (@NAMES)
+ {
+ use_ok($name, $VERSION);
+ }
+
+
+ foreach my $name (@OPT)
+ {
+ eval " require $name " ;
+ if ($@)
+ {
+ ok 1, "$name not available"
+ }
+ else
+ {
+ my $ver = eval("\$${name}::VERSION");
+ is $ver, $VERSION, "$name version should be $VERSION"
+ or diag "$name version is $ver, need $VERSION" ;
+ }
+ }
+
+}
+
+sub bit
+{
+ return 1 << $_[0];
+}
+
+{
+ # Print our versions of all modules used
+
+ use Compress::Raw::Zlib;
+
+ my @results = ( [ 'Perl', $] ] );
+ my @modules = qw(
+ Compress::Raw::Zlib
+ );
+
+ my %have = ();
+
+ for my $module (@modules)
+ {
+ my $ver = packageVer($module) ;
+ my $v = defined $ver
+ ? $ver
+ : "Not Installed" ;
+ push @results, [$module, $v] ;
+ $have{$module} ++
+ if $ver ;
+ }
+
+ push @results, ['',''];
+ push @results, ["zlib_version (from zlib library)", Compress::Raw::Zlib::zlib_version() ];
+ push @results, ["ZLIB_VERSION (from zlib.h)", Compress::Raw::Zlib::ZLIB_VERSION ];
+ push @results, ["ZLIB_VERNUM", sprintf("0x%x", Compress::Raw::Zlib::ZLIB_VERNUM) ];
+ push @results, ['',''];
+
+ push @results, ['BUILD_ZLIB', $Compress::Raw::Zlib::BUILD_ZLIB];
+ push @results, ['GZIP_OS_CODE', $Compress::Raw::Zlib::gzip_os_code];
+ push @results, ['',''];
+
+ if (Compress::Raw::Zlib::is_zlibng)
+ {
+ push @results, ["Using zlib-ng", "Yes" ];
+
+ push @results, ["zlibng_version", Compress::Raw::Zlib::zlibng_version() ];
+
+ if (Compress::Raw::Zlib::is_zlibng_compat)
+ {
+ push @results, ["zlib-ng Mode", "Compat" ];
+ }
+ else
+ {
+ push @results, ["zlib-ng Mode", "Native" ];
+ }
+
+ my @ng = qw(
+ ZLIBNG_VERSION
+ ZLIBNG_VER_MAJOR
+ ZLIBNG_VER_MINOR
+ ZLIBNG_VER_REVISION
+ ZLIBNG_VER_STATUS
+ ZLIBNG_VER_MODIFIED
+ );
+
+ for my $n (@ng)
+ {
+ no strict 'refs';
+ push @results, [" $n", &{ "Compress::Raw::Zlib::$n" } ];
+ }
+
+ no strict 'refs';
+ push @results, [" ZLIBNG_VERNUM", sprintf("0x%x", &{ "Compress::Raw::Zlib::ZLIBNG_VERNUM" }) ];
+
+ }
+ else
+ {
+ push @results, ["Using zlib-ng", "No" ];
+ }
+
+ push @results, ['',''];
+ push @results, ["is_zlib_native", Compress::Raw::Zlib::is_zlib_native() ? 1 : 0 ];
+ push @results, ["is_zlibng", Compress::Raw::Zlib::is_zlibng() ?1 : 0];
+ push @results, ["is_zlibng_native", Compress::Raw::Zlib::is_zlibng_native() ? 1 : 0 ];
+ push @results, ["is_zlibng_compat", Compress::Raw::Zlib::is_zlibng_compat() ? 1 : 0];
+
+
+ my $zlib_h = ZLIB_VERSION ;
+ my $libz = Compress::Raw::Zlib::zlib_version;
+ my $ZLIB_VERNUM = sprintf ("0x%X", Compress::Raw::Zlib::ZLIB_VERNUM()) ;
+ my $flags = Compress::Raw::Zlib::zlibCompileFlags();
+
+ push @results, ['',''];
+ push @results, ['zlibCompileFlags', $flags];
+ push @results, [' Type Sizes', ''];
+
+ my %sizes = (
+ 0 => '16 bit',
+ 1 => '32 bit',
+ 2 => '64 bit',
+ 3 => 'other'
+ );
+
+ push @results, [' size of uInt', $sizes{ ($flags >> 0) & 0x3 } ];
+ push @results, [' size of uLong', $sizes{ ($flags >> 2) & 0x3 } ];
+ push @results, [' size of pointer', $sizes{ ($flags >> 4) & 0x3 } ];
+ push @results, [' size of z_off_t', $sizes{ ($flags >> 6) & 0x3 } ];
+
+ my @compiler_options;
+ push @compiler_options, 'ZLIB_DEBUG' if $flags & bit(8) ;
+ push @compiler_options, 'ASM' if $flags & bit(9) ;
+ push @compiler_options, 'ZLIB_WINAPI' if $flags & bit(10) ;
+ push @compiler_options, 'None' unless @compiler_options;
+ push @results, [' Compiler Options', join ", ", @compiler_options];
+
+ my @one_time;
+ push @one_time, 'BUILDFIXED' if $flags & bit(12) ;
+ push @one_time, 'DYNAMIC_CRC_TABLE' if $flags & bit(13) ;
+ push @one_time, 'None' unless @one_time;
+ push @results, [' One-time table building', join ", ", @one_time];
+
+ my @library;
+ push @library, 'NO_GZCOMPRESS' if $flags & bit(16) ;
+ push @library, 'NO_GZIP' if $flags & bit(17) ;
+ push @library, 'None' unless @library;
+ push @results, [' Library content', join ", ", @library];
+
+ my @operational;
+ push @operational, 'PKZIP_BUG_WORKAROUND' if $flags & bit(20) ;
+ push @operational, 'FASTEST' if $flags & bit(21) ;
+ push @operational, 'None' unless @operational;
+ push @results, [' Operation variations', join ", ", @operational];
+
+
+
+ if ($have{"Compress::Raw::Lzma"})
+ {
+ my $ver = eval { Compress::Raw::Lzma::lzma_version_string(); } || "unknown";
+ push @results, ["lzma", $ver] ;
+ }
+
+ use List::Util qw(max);
+ my $width = max map { length $_->[0] } @results;
+
+ diag "\n\n" ;
+ for my $m (@results)
+ {
+ my ($name, $ver) = @$m;
+
+ my $b = " " x (1 + $width - length $name);
+
+ diag $name . $b . $ver . "\n" ;
+ }
+
+ diag "\n\n" ;
+}
+
+sub packageVer
+{
+ no strict 'refs';
+ my $package = shift;
+
+ eval "use $package;";
+ return ${ "${package}::VERSION" };
+
+}
\ No newline at end of file
$extra = 1
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- plan tests => 2 + $extra ;
+ plan tests => 9 + $extra ;
use_ok('Compress::Raw::Zlib', 2) ;
}
-sub bit
-{
- return 1 << $_[0];
-}
-
-{
+use CompTestUtils;
- my $zlib_h = ZLIB_VERSION ;
- my $libz = Compress::Raw::Zlib::zlib_version;
- my $ZLIB_VERNUM = sprintf ("0x%X", Compress::Raw::Zlib::ZLIB_VERNUM()) ;
- my $flags = Compress::Raw::Zlib::zlibCompileFlags();
-
- my %sizes = (
- 0 => '16 bit',
- 1 => '32 bit',
- 2 => '64 bit',
- 3 => 'other'
- );
- my $uIntSize = $sizes{ ($flags >> 0) & 0x3 };
- my $uLongSize = $sizes{ ($flags >> 2) & 0x3 };
- my $pointerSize = $sizes{ ($flags >> 4) & 0x3 };
- my $zOffSize = $sizes{ ($flags >> 6) & 0x3 };
-
- my @compiler_options;
- push @compiler_options, 'ZLIB_DEBUG' if $flags & bit(8) ;
- push @compiler_options, 'ASM' if $flags & bit(9) ;
- push @compiler_options, 'ZLIB_WINAPI' if $flags & bit(10) ;
- push @compiler_options, 'None' unless @compiler_options;
- my $compiler_options = join ", ", @compiler_options;
-
- my @one_time;
- push @one_time, 'BUILDFIXED' if $flags & bit(12) ;
- push @one_time, 'DYNAMIC_CRC_TABLE' if $flags & bit(13) ;
- push @one_time, 'None' unless @one_time;
- my $one_time = join ", ", @one_time;
-
- my @library;
- push @library, 'NO_GZCOMPRESS' if $flags & bit(16) ;
- push @library, 'NO_GZIP' if $flags & bit(17) ;
- push @library, 'None' unless @library;
- my $library = join ", ", @library;
-
- my @operational;
- push @operational, 'PKZIP_BUG_WORKAROUND' if $flags & bit(20) ;
- push @operational, 'FASTEST' if $flags & bit(21) ;
- push @operational, 'None' unless @operational;
- my $operational = join ", ", @operational;
-
- diag <<EOM ;
-
-
-Compress::Raw::Zlib::VERSION $Compress::Raw::Zlib::VERSION
-
-ZLIB_VERSION (from zlib.h) $zlib_h
-zlib_version (from zlib library) $libz
-
-ZLIB_VERNUM $ZLIB_VERNUM
-BUILD_ZLIB $Compress::Raw::Zlib::BUILD_ZLIB
-GZIP_OS_CODE $Compress::Raw::Zlib::gzip_os_code
-
-zlibCompileFlags $flags
- Type Sizes
- size of uInt $uIntSize
- size of uLong $uLongSize
- size of pointer $pointerSize
- size of z_off_t $zOffSize
- Compiler Options $compiler_options
- One-time table building $one_time
- Library content $library
- Operation variations $operational
-
-EOM
-}
# Check zlib_version and ZLIB_VERSION are the same.
+test_zlib_header_matches_library();
-SKIP: {
- skip "TEST_SKIP_VERSION_CHECK is set", 1
- if $ENV{TEST_SKIP_VERSION_CHECK};
-
- my $zlib_h = ZLIB_VERSION ;
- my $libz = Compress::Raw::Zlib::zlib_version;
-
- is($zlib_h, $libz, "ZLIB_VERSION ($zlib_h) matches Compress::Raw::Zlib::zlib_version")
- or diag <<EOM;
-
-The version of zlib.h does not match the version of libz
-
-You have zlib.h version $zlib_h
- and libz version $libz
+SKIP:
+{
+ # If running a github workflow that tests upstream zlib/zlib-ng, check we have the version requested
+
+ # Not github or not asking for explicit verson, so skip
+ skip "Not github", 7
+ if ! (defined $ENV{GITHUB_ACTION} && defined $ENV{ZLIB_VERSION}) ;
+
+ my $expected_version = $ENV{ZLIB_VERSION} ;
+ # zlib prefixes tags with a "v", so remove
+ $expected_version =~ s/^v//i;
+
+ skip "Skipping version tests for 'develop' branch", 7
+ if ($expected_version eq 'develop') ;
+
+ if ($ENV{USE_ZLIB_NG})
+ {
+ # zlib-ng native
+ my $zv = Compress::Raw::Zlib::zlibng_version();
+ is substr($zv, 0, length($expected_version)), $expected_version, "Expected version is $expected_version";
+ ok ! Compress::Raw::Zlib::is_zlib_native(), "! is_zlib_native";
+ ok Compress::Raw::Zlib::is_zlibng(), "is_zlibng";
+ ok Compress::Raw::Zlib::is_zlibng_native(), "is_zlibng_native";
+ ok ! Compress::Raw::Zlib::is_zlibng_compat(), "! is_zlibng_compat";
+ is Compress::Raw::Zlib::zlib_version(), '', "zlib_version() should be empty";
+ is Compress::Raw::Zlib::ZLIB_VERSION, '', "ZLIB_VERSION should be empty";
+ }
+ elsif ($ENV{ZLIB_NG_PRESENT})
+ {
+ # zlib-ng compat
+ my %zlibng2zlib = (
+ '2.0.0' => '1.2.11.zlib-ng',
+ '2.0.1' => '1.2.11.zlib-ng',
+ '2.0.2' => '1.2.11.zlib-ng',
+ '2.0.3' => '1.2.11.zlib-ng',
+ '2.0.4' => '1.2.11.zlib-ng',
+ '2.0.5' => '1.2.11.zlib-ng',
+ '2.0.6' => '1.2.11.zlib-ng',
+ );
+
+ my $zv = Compress::Raw::Zlib::zlibng_version();
+
+ my $compat_ver = $zlibng2zlib{$expected_version};
+
+ is substr($zv, 0, length($expected_version)), $expected_version, "Expected Version is $expected_version";
+ ok ! Compress::Raw::Zlib::is_zlib_native(), "! is_zlib_native";
+ ok Compress::Raw::Zlib::is_zlibng(), "is_zlibng";
+ ok ! Compress::Raw::Zlib::is_zlibng_native(), "! is_zlibng_native";
+ ok Compress::Raw::Zlib::is_zlibng_compat(), "is_zlibng_compat";
+ is Compress::Raw::Zlib::zlib_version(), $compat_ver, "zlib_version() should be $compat_ver";
+ is Compress::Raw::Zlib::ZLIB_VERSION, $compat_ver, "ZLIB_VERSION should be $compat_ver";
+ }
+ else
+ {
+ # zlib native
+ my $zv = Compress::Raw::Zlib::zlib_version();
+ is substr($zv, 0, length($expected_version)), $expected_version, "Expected Version is $expected_version";
+ ok Compress::Raw::Zlib::is_zlib_native(), "is_zlib_native";
+ ok ! Compress::Raw::Zlib::is_zlibng(), "! is_zlibng";
+ ok ! Compress::Raw::Zlib::is_zlibng_native(), "! is_zlibng_native";
+ ok ! Compress::Raw::Zlib::is_zlibng_compat(), "! is_zlibng_compat";
+ is Compress::Raw::Zlib::zlibng_version(), '', "zlibng_version() should be empty";
+ is Compress::Raw::Zlib::ZLIBNG_VERSION, '', "ZLIBNG_VERSION should be empty"; }
-You probably have two versions of zlib installed on your system.
-Try removing the one you don't want to use and rebuild.
-EOM
}
use bytes;
use Test::More ;
-use CompTestUtils;
use constant ZLIB_1_2_12_0 => 0x12C0;
use_ok('Compress::Raw::Zlib', 2) ;
}
+use CompTestUtils;
+
my $Zlib_ver = Compress::Raw::Zlib::zlib_version ;
my $len = length $hello ;
# Check zlib_version and ZLIB_VERSION are the same.
-SKIP: {
- skip "TEST_SKIP_VERSION_CHECK is set", 1
- if $ENV{TEST_SKIP_VERSION_CHECK};
- is Compress::Raw::Zlib::zlib_version, ZLIB_VERSION,
- "ZLIB_VERSION matches Compress::Raw::Zlib::zlib_version" ;
-}
+test_zlib_header_matches_library();
{
title "Error Cases" ;
}
# Z_STREAM_END returned by 1.12.2, Z_DATA_ERROR for older zlib
- if (ZLIB_VERNUM >= ZLIB_1_2_12_0)
+ # ZLIB_NG has the fix for all versions
+ if (ZLIB_VERNUM >= ZLIB_1_2_12_0 || Compress::Raw::Zlib::is_zlibng)
{
cmp_ok $status, '==', Z_STREAM_END ;
}
$GOT = '';
$status = $k->inflate($rest, $GOT);
# Z_STREAM_END returned by 1.12.2, Z_DATA_ERROR for older zlib
- if (ZLIB_VERNUM >= ZLIB_1_2_12_0 )
+ if (ZLIB_VERNUM >= ZLIB_1_2_12_0 || Compress::Raw::Zlib::is_zlibng)
{
cmp_ok $status, '==', Z_STREAM_END ;
}
my $flags = Compress::Raw::Zlib::zlibCompileFlags;
- if (ZLIB_VERNUM() < 0x1210)
+ if (!Compress::Raw::Zlib::is_zlibng && ZLIB_VERNUM() < 0x1210)
{
is $flags, 0, "zlibCompileFlags == 0 if < 1.2.1";
}
use bytes;
use Test::More ;
-use CompTestUtils;
BEGIN
{
use_ok('Compress::Raw::Zlib', 2) ;
}
+use CompTestUtils;
my $hello = <<EOM ;
hello world
my $len = length $hello ;
# Check zlib_version and ZLIB_VERSION are the same.
-SKIP: {
- skip "TEST_SKIP_VERSION_CHECK is set", 1
- if $ENV{TEST_SKIP_VERSION_CHECK};
- is Compress::Raw::Zlib::zlib_version, ZLIB_VERSION,
- "ZLIB_VERSION matches Compress::Raw::Zlib::zlib_version" ;
-}
-
+test_zlib_header_matches_library();
for my $i (1 .. 13)
{
use bytes;
use Test::More ;
-use CompTestUtils;
BEGIN
{
$extra = 1
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- plan tests => 107 + $extra ;
+ plan tests => 108 + $extra ;
use_ok('Compress::Raw::Zlib', 2) ;
}
+use CompTestUtils;
+test_zlib_header_matches_library();
my $hello = "I am a HAL 9000 computer" x 2001;
my $tmp = $hello ;
use bytes;
use Test::More ;
-use CompTestUtils;
BEGIN
{
use_ok('Compress::Raw::Zlib', 2) ;
}
+use CompTestUtils;
+
my $hello = <<EOM ;
my $len = length $hello ;
# Check zlib_version and ZLIB_VERSION are the same.
-SKIP: {
- skip "TEST_SKIP_VERSION_CHECK is set", 1
- if $ENV{TEST_SKIP_VERSION_CHECK};
- is Compress::Raw::Zlib::zlib_version, ZLIB_VERSION,
- "ZLIB_VERSION matches Compress::Raw::Zlib::zlib_version" ;
-}
-
+test_zlib_header_matches_library();
{
title 'deflate/inflate with lvalue sub';
use warnings;
use Test::More ;
-use CompTestUtils;
BEGIN
{
use_ok('Compress::Raw::Zlib', 2) ;
}
+use CompTestUtils;
my $hello = <<EOM ;
my $len = length $hello ;
# Check zlib_version and ZLIB_VERSION are the same.
-SKIP: {
- skip "TEST_SKIP_VERSION_CHECK is set", 1
- if $ENV{TEST_SKIP_VERSION_CHECK};
- is Compress::Raw::Zlib::zlib_version, ZLIB_VERSION,
- "ZLIB_VERSION matches Compress::Raw::Zlib::zlib_version" ;
-}
+test_zlib_header_matches_library();
{
--- /dev/null
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = ("../lib", "lib/compress");
+ }
+}
+
+use lib qw(t t/compress);
+use Test::More;
+
+eval "use Test::Pod 1.00";
+
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+
+all_pod_files_ok();
--- /dev/null
+package Test::Builder;
+
+use 5.004;
+
+# $^C was only introduced in 5.005-ish. We do this to prevent
+# use of uninitialized value warnings in older perls.
+$^C ||= 0;
+
+use strict;
+our ($VERSION);
+$VERSION = '0.30';
+$VERSION = eval $VERSION; # make the alpha version come out as a number
+
+# Make Test::Builder thread-safe for ithreads.
+BEGIN {
+ use Config;
+ # Load threads::shared when threads are turned on
+ if( $] >= 5.008 && $Config{useithreads} && $INC{'threads.pm'}) {
+ require threads::shared;
+
+ # Hack around YET ANOTHER threads::shared bug. It would
+ # occassionally forget the contents of the variable when sharing it.
+ # So we first copy the data, then share, then put our copy back.
+ *share = sub (\[$@%]) {
+ my $type = ref $_[0];
+ my $data;
+
+ if( $type eq 'HASH' ) {
+ %$data = %{$_[0]};
+ }
+ elsif( $type eq 'ARRAY' ) {
+ @$data = @{$_[0]};
+ }
+ elsif( $type eq 'SCALAR' ) {
+ $$data = ${$_[0]};
+ }
+ else {
+ die "Unknown type: ".$type;
+ }
+
+ $_[0] = &threads::shared::share($_[0]);
+
+ if( $type eq 'HASH' ) {
+ %{$_[0]} = %$data;
+ }
+ elsif( $type eq 'ARRAY' ) {
+ @{$_[0]} = @$data;
+ }
+ elsif( $type eq 'SCALAR' ) {
+ ${$_[0]} = $$data;
+ }
+ else {
+ die "Unknown type: ".$type;
+ }
+
+ return $_[0];
+ };
+ }
+ # 5.8.0's threads::shared is busted when threads are off.
+ # We emulate it here.
+ else {
+ *share = sub { return $_[0] };
+ *lock = sub { 0 };
+ }
+}
+
+
+=head1 NAME
+
+Test::Builder - Backend for building test libraries
+
+=head1 SYNOPSIS
+
+ package My::Test::Module;
+ use Test::Builder;
+ require Exporter;
+ @ISA = qw(Exporter);
+ @EXPORT = qw(ok);
+
+ my $Test = Test::Builder->new;
+ $Test->output('my_logfile');
+
+ sub import {
+ my($self) = shift;
+ my $pack = caller;
+
+ $Test->exported_to($pack);
+ $Test->plan(@_);
+
+ $self->export_to_level(1, $self, 'ok');
+ }
+
+ sub ok {
+ my($test, $name) = @_;
+
+ $Test->ok($test, $name);
+ }
+
+
+=head1 DESCRIPTION
+
+Test::Simple and Test::More have proven to be popular testing modules,
+but they're not always flexible enough. Test::Builder provides the a
+building block upon which to write your own test libraries I<which can
+work together>.
+
+=head2 Construction
+
+=over 4
+
+=item B<new>
+
+ my $Test = Test::Builder->new;
+
+Returns a Test::Builder object representing the current state of the
+test.
+
+Since you only run one test per program C<new> always returns the same
+Test::Builder object. No matter how many times you call new(), you're
+getting the same object. This is called a singleton. This is done so that
+multiple modules share such global information as the test counter and
+where test output is going.
+
+If you want a completely new Test::Builder object different from the
+singleton, use C<create>.
+
+=cut
+
+my $Test = Test::Builder->new;
+sub new {
+ my($class) = shift;
+ $Test ||= $class->create;
+ return $Test;
+}
+
+
+=item B<create>
+
+ my $Test = Test::Builder->create;
+
+Ok, so there can be more than one Test::Builder object and this is how
+you get it. You might use this instead of C<new()> if you're testing
+a Test::Builder based module, but otherwise you probably want C<new>.
+
+B<NOTE>: the implementation is not complete. C<level>, for example, is
+still shared amongst B<all> Test::Builder objects, even ones created using
+this method. Also, the method name may change in the future.
+
+=cut
+
+sub create {
+ my $class = shift;
+
+ my $self = bless {}, $class;
+ $self->reset;
+
+ return $self;
+}
+
+=item B<reset>
+
+ $Test->reset;
+
+Reinitializes the Test::Builder singleton to its original state.
+Mostly useful for tests run in persistent environments where the same
+test might be run multiple times in the same process.
+
+=cut
+
+our ($Level);
+
+sub reset {
+ my ($self) = @_;
+
+ # We leave this a global because it has to be localized and localizing
+ # hash keys is just asking for pain. Also, it was documented.
+ $Level = 1;
+
+ $self->{Test_Died} = 0;
+ $self->{Have_Plan} = 0;
+ $self->{No_Plan} = 0;
+ $self->{Original_Pid} = $$;
+
+ share($self->{Curr_Test});
+ $self->{Curr_Test} = 0;
+ $self->{Test_Results} = &share([]);
+
+ $self->{Exported_To} = undef;
+ $self->{Expected_Tests} = 0;
+
+ $self->{Skip_All} = 0;
+
+ $self->{Use_Nums} = 1;
+
+ $self->{No_Header} = 0;
+ $self->{No_Ending} = 0;
+
+ $self->_dup_stdhandles unless $^C;
+
+ return undef;
+}
+
+=back
+
+=head2 Setting up tests
+
+These methods are for setting up tests and declaring how many there
+are. You usually only want to call one of these methods.
+
+=over 4
+
+=item B<exported_to>
+
+ my $pack = $Test->exported_to;
+ $Test->exported_to($pack);
+
+Tells Test::Builder what package you exported your functions to.
+This is important for getting TODO tests right.
+
+=cut
+
+sub exported_to {
+ my($self, $pack) = @_;
+
+ if( defined $pack ) {
+ $self->{Exported_To} = $pack;
+ }
+ return $self->{Exported_To};
+}
+
+=item B<plan>
+
+ $Test->plan('no_plan');
+ $Test->plan( skip_all => $reason );
+ $Test->plan( tests => $num_tests );
+
+A convenient way to set up your tests. Call this and Test::Builder
+will print the appropriate headers and take the appropriate actions.
+
+If you call plan(), don't call any of the other methods below.
+
+=cut
+
+sub plan {
+ my($self, $cmd, $arg) = @_;
+
+ return unless $cmd;
+
+ if( $self->{Have_Plan} ) {
+ die sprintf "You tried to plan twice! Second plan at %s line %d\n",
+ ($self->caller)[1,2];
+ }
+
+ if( $cmd eq 'no_plan' ) {
+ $self->no_plan;
+ }
+ elsif( $cmd eq 'skip_all' ) {
+ return $self->skip_all($arg);
+ }
+ elsif( $cmd eq 'tests' ) {
+ if( $arg ) {
+ return $self->expected_tests($arg);
+ }
+ elsif( !defined $arg ) {
+ die "Got an undefined number of tests. Looks like you tried to ".
+ "say how many tests you plan to run but made a mistake.\n";
+ }
+ elsif( !$arg ) {
+ die "You said to run 0 tests! You've got to run something.\n";
+ }
+ }
+ else {
+ require Carp;
+ my @args = grep { defined } ($cmd, $arg);
+ Carp::croak("plan() doesn't understand @args");
+ }
+
+ return 1;
+}
+
+=item B<expected_tests>
+
+ my $max = $Test->expected_tests;
+ $Test->expected_tests($max);
+
+Gets/sets the # of tests we expect this test to run and prints out
+the appropriate headers.
+
+=cut
+
+sub expected_tests {
+ my $self = shift;
+ my($max) = @_;
+
+ if( @_ ) {
+ die "Number of tests must be a postive integer. You gave it '$max'.\n"
+ unless $max =~ /^\+?\d+$/ and $max > 0;
+
+ $self->{Expected_Tests} = $max;
+ $self->{Have_Plan} = 1;
+
+ $self->_print("1..$max\n") unless $self->no_header;
+ }
+ return $self->{Expected_Tests};
+}
+
+
+=item B<no_plan>
+
+ $Test->no_plan;
+
+Declares that this test will run an indeterminate # of tests.
+
+=cut
+
+sub no_plan {
+ my $self = shift;
+
+ $self->{No_Plan} = 1;
+ $self->{Have_Plan} = 1;
+}
+
+=item B<has_plan>
+
+ $plan = $Test->has_plan
+
+Find out whether a plan has been defined. $plan is either C<undef> (no plan has been set), C<no_plan> (indeterminate # of tests) or an integer (the number of expected tests).
+
+=cut
+
+sub has_plan {
+ my $self = shift;
+
+ return($self->{Expected_Tests}) if $self->{Expected_Tests};
+ return('no_plan') if $self->{No_Plan};
+ return(undef);
+};
+
+
+=item B<skip_all>
+
+ $Test->skip_all;
+ $Test->skip_all($reason);
+
+Skips all the tests, using the given $reason. Exits immediately with 0.
+
+=cut
+
+sub skip_all {
+ my($self, $reason) = @_;
+
+ my $out = "1..0";
+ $out .= " # Skip $reason" if $reason;
+ $out .= "\n";
+
+ $self->{Skip_All} = 1;
+
+ $self->_print($out) unless $self->no_header;
+ exit(0);
+}
+
+=back
+
+=head2 Running tests
+
+These actually run the tests, analogous to the functions in
+Test::More.
+
+$name is always optional.
+
+=over 4
+
+=item B<ok>
+
+ $Test->ok($test, $name);
+
+Your basic test. Pass if $test is true, fail if $test is false. Just
+like Test::Simple's ok().
+
+=cut
+
+sub ok {
+ my($self, $test, $name) = @_;
+
+ # $test might contain an object which we don't want to accidentally
+ # store, so we turn it into a boolean.
+ $test = $test ? 1 : 0;
+
+ unless( $self->{Have_Plan} ) {
+ require Carp;
+ Carp::croak("You tried to run a test without a plan! Gotta have a plan.");
+ }
+
+ lock $self->{Curr_Test};
+ $self->{Curr_Test}++;
+
+ # In case $name is a string overloaded object, force it to stringify.
+ $self->_unoverload(\$name);
+
+ $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
+ You named your test '$name'. You shouldn't use numbers for your test names.
+ Very confusing.
+ERR
+
+ my($pack, $file, $line) = $self->caller;
+
+ my $todo = $self->todo($pack);
+ $self->_unoverload(\$todo);
+
+ my $out;
+ my $result = &share({});
+
+ unless( $test ) {
+ $out .= "not ";
+ @$result{ 'ok', 'actual_ok' } = ( ( $todo ? 1 : 0 ), 0 );
+ }
+ else {
+ @$result{ 'ok', 'actual_ok' } = ( 1, $test );
+ }
+
+ $out .= "ok";
+ $out .= " $self->{Curr_Test}" if $self->use_numbers;
+
+ if( defined $name ) {
+ $name =~ s|#|\\#|g; # # in a name can confuse Test::Harness.
+ $out .= " - $name";
+ $result->{name} = $name;
+ }
+ else {
+ $result->{name} = '';
+ }
+
+ if( $todo ) {
+ $out .= " # TODO $todo";
+ $result->{reason} = $todo;
+ $result->{type} = 'todo';
+ }
+ else {
+ $result->{reason} = '';
+ $result->{type} = '';
+ }
+
+ $self->{Test_Results}[$self->{Curr_Test}-1] = $result;
+ $out .= "\n";
+
+ $self->_print($out);
+
+ unless( $test ) {
+ my $msg = $todo ? "Failed (TODO)" : "Failed";
+ $self->_print_diag("\n") if $ENV{HARNESS_ACTIVE};
+ $self->diag(" $msg test ($file at line $line)\n");
+ }
+
+ return $test ? 1 : 0;
+}
+
+
+sub _unoverload {
+ my $self = shift;
+
+ local($@,$!);
+
+ eval { require overload } || return;
+
+ foreach my $thing (@_) {
+ eval {
+ if( defined $$thing ) {
+ if( my $string_meth = overload::Method($$thing, '""') ) {
+ $$thing = $$thing->$string_meth();
+ }
+ }
+ };
+ }
+}
+
+
+=item B<is_eq>
+
+ $Test->is_eq($got, $expected, $name);
+
+Like Test::More's is(). Checks if $got eq $expected. This is the
+string version.
+
+=item B<is_num>
+
+ $Test->is_num($got, $expected, $name);
+
+Like Test::More's is(). Checks if $got == $expected. This is the
+numeric version.
+
+=cut
+
+sub is_eq {
+ my($self, $got, $expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $expect ) {
+ # undef only matches undef and nothing else
+ my $test = !defined $got && !defined $expect;
+
+ $self->ok($test, $name);
+ $self->_is_diag($got, 'eq', $expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, 'eq', $expect, $name);
+}
+
+sub is_num {
+ my($self, $got, $expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $expect ) {
+ # undef only matches undef and nothing else
+ my $test = !defined $got && !defined $expect;
+
+ $self->ok($test, $name);
+ $self->_is_diag($got, '==', $expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, '==', $expect, $name);
+}
+
+sub _is_diag {
+ my($self, $got, $type, $expect) = @_;
+
+ foreach my $val (\$got, \$expect) {
+ if( defined $$val ) {
+ if( $type eq 'eq' ) {
+ # quote and force string context
+ $$val = "'$$val'"
+ }
+ else {
+ # force numeric context
+ $$val = $$val+0;
+ }
+ }
+ else {
+ $$val = 'undef';
+ }
+ }
+
+ return $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
+ got: %s
+ expected: %s
+DIAGNOSTIC
+
+}
+
+=item B<isnt_eq>
+
+ $Test->isnt_eq($got, $dont_expect, $name);
+
+Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
+the string version.
+
+=item B<isnt_num>
+
+ $Test->is_num($got, $dont_expect, $name);
+
+Like Test::More's isnt(). Checks if $got ne $dont_expect. This is
+the numeric version.
+
+=cut
+
+sub isnt_eq {
+ my($self, $got, $dont_expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $dont_expect ) {
+ # undef only matches undef and nothing else
+ my $test = defined $got || defined $dont_expect;
+
+ $self->ok($test, $name);
+ $self->_cmp_diag($got, 'ne', $dont_expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, 'ne', $dont_expect, $name);
+}
+
+sub isnt_num {
+ my($self, $got, $dont_expect, $name) = @_;
+ local $Level = $Level + 1;
+
+ if( !defined $got || !defined $dont_expect ) {
+ # undef only matches undef and nothing else
+ my $test = defined $got || defined $dont_expect;
+
+ $self->ok($test, $name);
+ $self->_cmp_diag($got, '!=', $dont_expect) unless $test;
+ return $test;
+ }
+
+ return $self->cmp_ok($got, '!=', $dont_expect, $name);
+}
+
+
+=item B<like>
+
+ $Test->like($this, qr/$regex/, $name);
+ $Test->like($this, '/$regex/', $name);
+
+Like Test::More's like(). Checks if $this matches the given $regex.
+
+You'll want to avoid qr// if you want your tests to work before 5.005.
+
+=item B<unlike>
+
+ $Test->unlike($this, qr/$regex/, $name);
+ $Test->unlike($this, '/$regex/', $name);
+
+Like Test::More's unlike(). Checks if $this B<does not match> the
+given $regex.
+
+=cut
+
+sub like {
+ my($self, $this, $regex, $name) = @_;
+
+ local $Level = $Level + 1;
+ $self->_regex_ok($this, $regex, '=~', $name);
+}
+
+sub unlike {
+ my($self, $this, $regex, $name) = @_;
+
+ local $Level = $Level + 1;
+ $self->_regex_ok($this, $regex, '!~', $name);
+}
+
+=item B<maybe_regex>
+
+ $Test->maybe_regex(qr/$regex/);
+ $Test->maybe_regex('/$regex/');
+
+Convenience method for building testing functions that take regular
+expressions as arguments, but need to work before perl 5.005.
+
+Takes a quoted regular expression produced by qr//, or a string
+representing a regular expression.
+
+Returns a Perl value which may be used instead of the corresponding
+regular expression, or undef if it's argument is not recognised.
+
+For example, a version of like(), sans the useful diagnostic messages,
+could be written as:
+
+ sub laconic_like {
+ my ($self, $this, $regex, $name) = @_;
+ my $usable_regex = $self->maybe_regex($regex);
+ die "expecting regex, found '$regex'\n"
+ unless $usable_regex;
+ $self->ok($this =~ m/$usable_regex/, $name);
+ }
+
+=cut
+
+
+sub maybe_regex {
+ my ($self, $regex) = @_;
+ my $usable_regex = undef;
+
+ return $usable_regex unless defined $regex;
+
+ my($re, $opts);
+
+ # Check for qr/foo/
+ if( ref $regex eq 'Regexp' ) {
+ $usable_regex = $regex;
+ }
+ # Check for '/foo/' or 'm,foo,'
+ elsif( ($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx or
+ (undef, $re, $opts) = $regex =~ m,^ m([^\w\s]) (.+) \1 (\w*) $,sx
+ )
+ {
+ $usable_regex = length $opts ? "(?$opts)$re" : $re;
+ }
+
+ return $usable_regex;
+};
+
+sub _regex_ok {
+ my($self, $this, $regex, $cmp, $name) = @_;
+
+ local $Level = $Level + 1;
+
+ my $ok = 0;
+ my $usable_regex = $self->maybe_regex($regex);
+ unless (defined $usable_regex) {
+ $ok = $self->ok( 0, $name );
+ $self->diag(" '$regex' doesn't look much like a regex to me.");
+ return $ok;
+ }
+
+ {
+ local $^W = 0;
+ my $test = $this =~ /$usable_regex/ ? 1 : 0;
+ $test = !$test if $cmp eq '!~';
+ $ok = $self->ok( $test, $name );
+ }
+
+ unless( $ok ) {
+ $this = defined $this ? "'$this'" : 'undef';
+ my $match = $cmp eq '=~' ? "doesn't match" : "matches";
+ $self->diag(sprintf <<DIAGNOSTIC, $this, $match, $regex);
+ %s
+ %13s '%s'
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+=item B<cmp_ok>
+
+ $Test->cmp_ok($this, $type, $that, $name);
+
+Works just like Test::More's cmp_ok().
+
+ $Test->cmp_ok($big_num, '!=', $other_big_num);
+
+=cut
+
+sub cmp_ok {
+ my($self, $got, $type, $expect, $name) = @_;
+
+ my $test;
+ {
+ local $^W = 0;
+ local($@,$!); # don't interfere with $@
+ # eval() sometimes resets $!
+ $test = eval "\$got $type \$expect";
+ }
+ local $Level = $Level + 1;
+ my $ok = $self->ok($test, $name);
+
+ unless( $ok ) {
+ if( $type =~ /^(eq|==)$/ ) {
+ $self->_is_diag($got, $type, $expect);
+ }
+ else {
+ $self->_cmp_diag($got, $type, $expect);
+ }
+ }
+ return $ok;
+}
+
+sub _cmp_diag {
+ my($self, $got, $type, $expect) = @_;
+
+ $got = defined $got ? "'$got'" : 'undef';
+ $expect = defined $expect ? "'$expect'" : 'undef';
+ return $self->diag(sprintf <<DIAGNOSTIC, $got, $type, $expect);
+ %s
+ %s
+ %s
+DIAGNOSTIC
+}
+
+=item B<BAILOUT>
+
+ $Test->BAILOUT($reason);
+
+Indicates to the Test::Harness that things are going so badly all
+testing should terminate. This includes running any additional test
+scripts.
+
+It will exit with 255.
+
+=cut
+
+sub BAILOUT {
+ my($self, $reason) = @_;
+
+ $self->_print("Bail out! $reason");
+ exit 255;
+}
+
+=item B<skip>
+
+ $Test->skip;
+ $Test->skip($why);
+
+Skips the current test, reporting $why.
+
+=cut
+
+sub skip {
+ my($self, $why) = @_;
+ $why ||= '';
+ $self->_unoverload(\$why);
+
+ unless( $self->{Have_Plan} ) {
+ require Carp;
+ Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
+ }
+
+ lock($self->{Curr_Test});
+ $self->{Curr_Test}++;
+
+ $self->{Test_Results}[$self->{Curr_Test}-1] = &share({
+ 'ok' => 1,
+ actual_ok => 1,
+ name => '',
+ type => 'skip',
+ reason => $why,
+ });
+
+ my $out = "ok";
+ $out .= " $self->{Curr_Test}" if $self->use_numbers;
+ $out .= " # skip";
+ $out .= " $why" if length $why;
+ $out .= "\n";
+
+ $self->_print($out);
+
+ return 1;
+}
+
+
+=item B<todo_skip>
+
+ $Test->todo_skip;
+ $Test->todo_skip($why);
+
+Like skip(), only it will declare the test as failing and TODO. Similar
+to
+
+ print "not ok $tnum # TODO $why\n";
+
+=cut
+
+sub todo_skip {
+ my($self, $why) = @_;
+ $why ||= '';
+
+ unless( $self->{Have_Plan} ) {
+ require Carp;
+ Carp::croak("You tried to run tests without a plan! Gotta have a plan.");
+ }
+
+ lock($self->{Curr_Test});
+ $self->{Curr_Test}++;
+
+ $self->{Test_Results}[$self->{Curr_Test}-1] = &share({
+ 'ok' => 1,
+ actual_ok => 0,
+ name => '',
+ type => 'todo_skip',
+ reason => $why,
+ });
+
+ my $out = "not ok";
+ $out .= " $self->{Curr_Test}" if $self->use_numbers;
+ $out .= " # TODO & SKIP $why\n";
+
+ $self->_print($out);
+
+ return 1;
+}
+
+
+=begin _unimplemented
+
+=item B<skip_rest>
+
+ $Test->skip_rest;
+ $Test->skip_rest($reason);
+
+Like skip(), only it skips all the rest of the tests you plan to run
+and terminates the test.
+
+If you're running under no_plan, it skips once and terminates the
+test.
+
+=end _unimplemented
+
+=back
+
+
+=head2 Test style
+
+=over 4
+
+=item B<level>
+
+ $Test->level($how_high);
+
+How far up the call stack should $Test look when reporting where the
+test failed.
+
+Defaults to 1.
+
+Setting $Test::Builder::Level overrides. This is typically useful
+localized:
+
+ {
+ local $Test::Builder::Level = 2;
+ $Test->ok($test);
+ }
+
+=cut
+
+sub level {
+ my($self, $level) = @_;
+
+ if( defined $level ) {
+ $Level = $level;
+ }
+ return $Level;
+}
+
+
+=item B<use_numbers>
+
+ $Test->use_numbers($on_or_off);
+
+Whether or not the test should output numbers. That is, this if true:
+
+ ok 1
+ ok 2
+ ok 3
+
+or this if false
+
+ ok
+ ok
+ ok
+
+Most useful when you can't depend on the test output order, such as
+when threads or forking is involved.
+
+Test::Harness will accept either, but avoid mixing the two styles.
+
+Defaults to on.
+
+=cut
+
+sub use_numbers {
+ my($self, $use_nums) = @_;
+
+ if( defined $use_nums ) {
+ $self->{Use_Nums} = $use_nums;
+ }
+ return $self->{Use_Nums};
+}
+
+=item B<no_header>
+
+ $Test->no_header($no_header);
+
+If set to true, no "1..N" header will be printed.
+
+=item B<no_ending>
+
+ $Test->no_ending($no_ending);
+
+Normally, Test::Builder does some extra diagnostics when the test
+ends. It also changes the exit code as described below.
+
+If this is true, none of that will be done.
+
+=cut
+
+sub no_header {
+ my($self, $no_header) = @_;
+
+ if( defined $no_header ) {
+ $self->{No_Header} = $no_header;
+ }
+ return $self->{No_Header};
+}
+
+sub no_ending {
+ my($self, $no_ending) = @_;
+
+ if( defined $no_ending ) {
+ $self->{No_Ending} = $no_ending;
+ }
+ return $self->{No_Ending};
+}
+
+
+=back
+
+=head2 Output
+
+Controlling where the test output goes.
+
+It's ok for your test to change where STDOUT and STDERR point to,
+Test::Builder's default output settings will not be affected.
+
+=over 4
+
+=item B<diag>
+
+ $Test->diag(@msgs);
+
+Prints out the given @msgs. Like C<print>, arguments are simply
+appended together.
+
+Normally, it uses the failure_output() handle, but if this is for a
+TODO test, the todo_output() handle is used.
+
+Output will be indented and marked with a # so as not to interfere
+with test output. A newline will be put on the end if there isn't one
+already.
+
+We encourage using this rather than calling print directly.
+
+Returns false. Why? Because diag() is often used in conjunction with
+a failing test (C<ok() || diag()>) it "passes through" the failure.
+
+ return ok(...) || diag(...);
+
+=for blame transfer
+Mark Fowler <mark@twoshortplanks.com>
+
+=cut
+
+sub diag {
+ my($self, @msgs) = @_;
+ return unless @msgs;
+
+ # Prevent printing headers when compiling (i.e. -c)
+ return if $^C;
+
+ # Smash args together like print does.
+ # Convert undef to 'undef' so its readable.
+ my $msg = join '', map { defined($_) ? $_ : 'undef' } @msgs;
+
+ # Escape each line with a #.
+ $msg =~ s/^/# /gm;
+
+ # Stick a newline on the end if it needs it.
+ $msg .= "\n" unless $msg =~ /\n\Z/;
+
+ local $Level = $Level + 1;
+ $self->_print_diag($msg);
+
+ return 0;
+}
+
+=begin _private
+
+=item B<_print>
+
+ $Test->_print(@msgs);
+
+Prints to the output() filehandle.
+
+=end _private
+
+=cut
+
+sub _print {
+ my($self, @msgs) = @_;
+
+ # Prevent printing headers when only compiling. Mostly for when
+ # tests are deparsed with B::Deparse
+ return if $^C;
+
+ my $msg = join '', @msgs;
+
+ local($\, $", $,) = (undef, ' ', '');
+ my $fh = $self->output;
+
+ # Escape each line after the first with a # so we don't
+ # confuse Test::Harness.
+ $msg =~ s/\n(.)/\n# $1/sg;
+
+ # Stick a newline on the end if it needs it.
+ $msg .= "\n" unless $msg =~ /\n\Z/;
+
+ print $fh $msg;
+}
+
+
+=item B<_print_diag>
+
+ $Test->_print_diag(@msg);
+
+Like _print, but prints to the current diagnostic filehandle.
+
+=cut
+
+sub _print_diag {
+ my $self = shift;
+
+ local($\, $", $,) = (undef, ' ', '');
+ my $fh = $self->todo ? $self->todo_output : $self->failure_output;
+ print $fh @_;
+}
+
+=item B<output>
+
+ $Test->output($fh);
+ $Test->output($file);
+
+Where normal "ok/not ok" test output should go.
+
+Defaults to STDOUT.
+
+=item B<failure_output>
+
+ $Test->failure_output($fh);
+ $Test->failure_output($file);
+
+Where diagnostic output on test failures and diag() should go.
+
+Defaults to STDERR.
+
+=item B<todo_output>
+
+ $Test->todo_output($fh);
+ $Test->todo_output($file);
+
+Where diagnostics about todo test failures and diag() should go.
+
+Defaults to STDOUT.
+
+=cut
+
+sub output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $self->{Out_FH} = _new_fh($fh);
+ }
+ return $self->{Out_FH};
+}
+
+sub failure_output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $self->{Fail_FH} = _new_fh($fh);
+ }
+ return $self->{Fail_FH};
+}
+
+sub todo_output {
+ my($self, $fh) = @_;
+
+ if( defined $fh ) {
+ $self->{Todo_FH} = _new_fh($fh);
+ }
+ return $self->{Todo_FH};
+}
+
+
+sub _new_fh {
+ my($file_or_fh) = shift;
+
+ my $fh;
+ if( _is_fh($file_or_fh) ) {
+ $fh = $file_or_fh;
+ }
+ else {
+ $fh = do { local *FH };
+ open $fh, ">$file_or_fh" or
+ die "Can't open test output log $file_or_fh: $!";
+ _autoflush($fh);
+ }
+
+ return $fh;
+}
+
+
+sub _is_fh {
+ my $maybe_fh = shift;
+
+ return 1 if ref \$maybe_fh eq 'GLOB'; # its a glob
+
+ return UNIVERSAL::isa($maybe_fh, 'GLOB') ||
+ UNIVERSAL::isa($maybe_fh, 'IO::Handle') ||
+
+ # 5.5.4's tied() and can() doesn't like getting undef
+ UNIVERSAL::can((tied($maybe_fh) || ''), 'TIEHANDLE');
+}
+
+
+sub _autoflush {
+ my($fh) = shift;
+ my $old_fh = select $fh;
+ $| = 1;
+ select $old_fh;
+}
+
+
+sub _dup_stdhandles {
+ my $self = shift;
+
+ $self->_open_testhandles;
+
+ # Set everything to unbuffered else plain prints to STDOUT will
+ # come out in the wrong order from our own prints.
+ _autoflush(\*TESTOUT);
+ _autoflush(\*STDOUT);
+ _autoflush(\*TESTERR);
+ _autoflush(\*STDERR);
+
+ $self->output(\*TESTOUT);
+ $self->failure_output(\*TESTERR);
+ $self->todo_output(\*TESTOUT);
+}
+
+
+my $Opened_Testhandles = 0;
+sub _open_testhandles {
+ return if $Opened_Testhandles;
+ # We dup STDOUT and STDERR so people can change them in their
+ # test suites while still getting normal test output.
+ open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT: $!";
+ open(TESTERR, ">&STDERR") or die "Can't dup STDERR: $!";
+ $Opened_Testhandles = 1;
+}
+
+
+=back
+
+
+=head2 Test Status and Info
+
+=over 4
+
+=item B<current_test>
+
+ my $curr_test = $Test->current_test;
+ $Test->current_test($num);
+
+Gets/sets the current test number we're on. You usually shouldn't
+have to set this.
+
+If set forward, the details of the missing tests are filled in as 'unknown'.
+if set backward, the details of the intervening tests are deleted. You
+can erase history if you really want to.
+
+=cut
+
+sub current_test {
+ my($self, $num) = @_;
+
+ lock($self->{Curr_Test});
+ if( defined $num ) {
+ unless( $self->{Have_Plan} ) {
+ require Carp;
+ Carp::croak("Can't change the current test number without a plan!");
+ }
+
+ $self->{Curr_Test} = $num;
+
+ # If the test counter is being pushed forward fill in the details.
+ my $test_results = $self->{Test_Results};
+ if( $num > @$test_results ) {
+ my $start = @$test_results ? @$test_results : 0;
+ for ($start..$num-1) {
+ $test_results->[$_] = &share({
+ 'ok' => 1,
+ actual_ok => undef,
+ reason => 'incrementing test number',
+ type => 'unknown',
+ name => undef
+ });
+ }
+ }
+ # If backward, wipe history. Its their funeral.
+ elsif( $num < @$test_results ) {
+ $#{$test_results} = $num - 1;
+ }
+ }
+ return $self->{Curr_Test};
+}
+
+
+=item B<summary>
+
+ my @tests = $Test->summary;
+
+A simple summary of the tests so far. True for pass, false for fail.
+This is a logical pass/fail, so todos are passes.
+
+Of course, test #1 is $tests[0], etc...
+
+=cut
+
+sub summary {
+ my($self) = shift;
+
+ return map { $_->{'ok'} } @{ $self->{Test_Results} };
+}
+
+=item B<details>
+
+ my @tests = $Test->details;
+
+Like summary(), but with a lot more detail.
+
+ $tests[$test_num - 1] =
+ { 'ok' => is the test considered a pass?
+ actual_ok => did it literally say 'ok'?
+ name => name of the test (if any)
+ type => type of test (if any, see below).
+ reason => reason for the above (if any)
+ };
+
+'ok' is true if Test::Harness will consider the test to be a pass.
+
+'actual_ok' is a reflection of whether or not the test literally
+printed 'ok' or 'not ok'. This is for examining the result of 'todo'
+tests.
+
+'name' is the name of the test.
+
+'type' indicates if it was a special test. Normal tests have a type
+of ''. Type can be one of the following:
+
+ skip see skip()
+ todo see todo()
+ todo_skip see todo_skip()
+ unknown see below
+
+Sometimes the Test::Builder test counter is incremented without it
+printing any test output, for example, when current_test() is changed.
+In these cases, Test::Builder doesn't know the result of the test, so
+it's type is 'unkown'. These details for these tests are filled in.
+They are considered ok, but the name and actual_ok is left undef.
+
+For example "not ok 23 - hole count # TODO insufficient donuts" would
+result in this structure:
+
+ $tests[22] = # 23 - 1, since arrays start from 0.
+ { ok => 1, # logically, the test passed since it's todo
+ actual_ok => 0, # in absolute terms, it failed
+ name => 'hole count',
+ type => 'todo',
+ reason => 'insufficient donuts'
+ };
+
+=cut
+
+sub details {
+ my $self = shift;
+ return @{ $self->{Test_Results} };
+}
+
+=item B<todo>
+
+ my $todo_reason = $Test->todo;
+ my $todo_reason = $Test->todo($pack);
+
+todo() looks for a $TODO variable in your tests. If set, all tests
+will be considered 'todo' (see Test::More and Test::Harness for
+details). Returns the reason (ie. the value of $TODO) if running as
+todo tests, false otherwise.
+
+todo() is about finding the right package to look for $TODO in. It
+uses the exported_to() package to find it. If that's not set, it's
+pretty good at guessing the right package to look at based on $Level.
+
+Sometimes there is some confusion about where todo() should be looking
+for the $TODO variable. If you want to be sure, tell it explicitly
+what $pack to use.
+
+=cut
+
+sub todo {
+ my($self, $pack) = @_;
+
+ $pack = $pack || $self->exported_to || $self->caller($Level);
+ return 0 unless $pack;
+
+ no strict 'refs';
+ return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
+ : 0;
+}
+
+=item B<caller>
+
+ my $package = $Test->caller;
+ my($pack, $file, $line) = $Test->caller;
+ my($pack, $file, $line) = $Test->caller($height);
+
+Like the normal caller(), except it reports according to your level().
+
+=cut
+
+sub caller {
+ my($self, $height) = @_;
+ $height ||= 0;
+
+ my @caller = CORE::caller($self->level + $height + 1);
+ return wantarray ? @caller : $caller[0];
+}
+
+=back
+
+=cut
+
+=begin _private
+
+=over 4
+
+=item B<_sanity_check>
+
+ $self->_sanity_check();
+
+Runs a bunch of end of test sanity checks to make sure reality came
+through ok. If anything is wrong it will die with a fairly friendly
+error message.
+
+=cut
+
+#'#
+sub _sanity_check {
+ my $self = shift;
+
+ _whoa($self->{Curr_Test} < 0, 'Says here you ran a negative number of tests!');
+ _whoa(!$self->{Have_Plan} and $self->{Curr_Test},
+ 'Somehow your tests ran without a plan!');
+ _whoa($self->{Curr_Test} != @{ $self->{Test_Results} },
+ 'Somehow you got a different number of results than tests ran!');
+}
+
+=item B<_whoa>
+
+ _whoa($check, $description);
+
+A sanity check, similar to assert(). If the $check is true, something
+has gone horribly wrong. It will die with the given $description and
+a note to contact the author.
+
+=cut
+
+sub _whoa {
+ my($check, $desc) = @_;
+ if( $check ) {
+ die <<WHOA;
+WHOA! $desc
+This should never happen! Please contact the author immediately!
+WHOA
+ }
+}
+
+=item B<_my_exit>
+
+ _my_exit($exit_num);
+
+Perl seems to have some trouble with exiting inside an END block. 5.005_03
+and 5.6.1 both seem to do odd things. Instead, this function edits $?
+directly. It should ONLY be called from inside an END block. It
+doesn't actually exit, that's your job.
+
+=cut
+
+sub _my_exit {
+ $? = $_[0];
+
+ return 1;
+}
+
+
+=back
+
+=end _private
+
+=cut
+
+$SIG{__DIE__} = sub {
+ # We don't want to muck with death in an eval, but $^S isn't
+ # totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
+ # with it. Instead, we use caller. This also means it runs under
+ # 5.004!
+ my $in_eval = 0;
+ for( my $stack = 1; my $sub = (CORE::caller($stack))[3]; $stack++ ) {
+ $in_eval = 1 if $sub =~ /^\(eval\)/;
+ }
+ $Test->{Test_Died} = 1 unless $in_eval;
+};
+
+sub _ending {
+ my $self = shift;
+
+ $self->_sanity_check();
+
+ # Don't bother with an ending if this is a forked copy. Only the parent
+ # should do the ending.
+ # Exit if plan() was never called. This is so "require Test::Simple"
+ # doesn't puke.
+ if( ($self->{Original_Pid} != $$) or
+ (!$self->{Have_Plan} && !$self->{Test_Died}) )
+ {
+ _my_exit($?);
+ return;
+ }
+
+ # Figure out if we passed or failed and print helpful messages.
+ my $test_results = $self->{Test_Results};
+ if( @$test_results ) {
+ # The plan? We have no plan.
+ if( $self->{No_Plan} ) {
+ $self->_print("1..$self->{Curr_Test}\n") unless $self->no_header;
+ $self->{Expected_Tests} = $self->{Curr_Test};
+ }
+
+ # Auto-extended arrays and elements which aren't explicitly
+ # filled in with a shared reference will puke under 5.8.0
+ # ithreads. So we have to fill them in by hand. :(
+ my $empty_result = &share({});
+ for my $idx ( 0..$self->{Expected_Tests}-1 ) {
+ $test_results->[$idx] = $empty_result
+ unless defined $test_results->[$idx];
+ }
+
+ my $num_failed = grep !$_->{'ok'},
+ @{$test_results}[0..$self->{Expected_Tests}-1];
+ $num_failed += abs($self->{Expected_Tests} - @$test_results);
+
+ if( $self->{Curr_Test} < $self->{Expected_Tests} ) {
+ my $s = $self->{Expected_Tests} == 1 ? '' : 's';
+ $self->diag(<<"FAIL");
+Looks like you planned $self->{Expected_Tests} test$s but only ran $self->{Curr_Test}.
+FAIL
+ }
+ elsif( $self->{Curr_Test} > $self->{Expected_Tests} ) {
+ my $num_extra = $self->{Curr_Test} - $self->{Expected_Tests};
+ my $s = $self->{Expected_Tests} == 1 ? '' : 's';
+ $self->diag(<<"FAIL");
+Looks like you planned $self->{Expected_Tests} test$s but ran $num_extra extra.
+FAIL
+ }
+ elsif ( $num_failed ) {
+ my $s = $num_failed == 1 ? '' : 's';
+ $self->diag(<<"FAIL");
+Looks like you failed $num_failed test$s of $self->{Expected_Tests}.
+FAIL
+ }
+
+ if( $self->{Test_Died} ) {
+ $self->diag(<<"FAIL");
+Looks like your test died just after $self->{Curr_Test}.
+FAIL
+
+ _my_exit( 255 ) && return;
+ }
+
+ _my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
+ }
+ elsif ( $self->{Skip_All} ) {
+ _my_exit( 0 ) && return;
+ }
+ elsif ( $self->{Test_Died} ) {
+ $self->diag(<<'FAIL');
+Looks like your test died before it could output anything.
+FAIL
+ _my_exit( 255 ) && return;
+ }
+ else {
+ $self->diag("No tests run!\n");
+ _my_exit( 255 ) && return;
+ }
+}
+
+END {
+ $Test->_ending if defined $Test and !$Test->no_ending;
+}
+
+=head1 EXIT CODES
+
+If all your tests passed, Test::Builder will exit with zero (which is
+normal). If anything failed it will exit with how many failed. If
+you run less (or more) tests than you planned, the missing (or extras)
+will be considered failures. If no tests were ever run Test::Builder
+will throw a warning and exit with 255. If the test died, even after
+having successfully completed all its tests, it will still be
+considered a failure and will exit with 255.
+
+So the exit codes are...
+
+ 0 all tests successful
+ 255 test died
+ any other number how many failed (including missing or extras)
+
+If you fail more than 254 tests, it will be reported as 254.
+
+
+=head1 THREADS
+
+In perl 5.8.0 and later, Test::Builder is thread-safe. The test
+number is shared amongst all threads. This means if one thread sets
+the test number using current_test() they will all be effected.
+
+Test::Builder is only thread-aware if threads.pm is loaded I<before>
+Test::Builder.
+
+=head1 EXAMPLES
+
+CPAN can provide the best examples. Test::Simple, Test::More,
+Test::Exception and Test::Differences all use Test::Builder.
+
+=head1 SEE ALSO
+
+Test::Simple, Test::More, Test::Harness
+
+=head1 AUTHORS
+
+Original code by chromatic, maintained by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2004 by chromatic E<lt>chromatic@wgz.orgE<gt> and
+ Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
--- /dev/null
+package Test::More;
+
+use 5.004;
+
+use strict;
+use Test::Builder;
+
+
+# Can't use Carp because it might cause use_ok() to accidentally succeed
+# even though the module being used forgot to use Carp. Yes, this
+# actually happened.
+sub _carp {
+ my($file, $line) = (caller(1))[1,2];
+ warn @_, " at $file line $line\n";
+}
+
+
+
+require Exporter;
+our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $TODO);
+$VERSION = '0.60';
+$VERSION = eval $VERSION; # make the alpha version come out as a number
+
+@ISA = qw(Exporter);
+@EXPORT = qw(ok use_ok require_ok
+ is isnt like unlike is_deeply
+ cmp_ok
+ skip todo todo_skip
+ pass fail
+ eq_array eq_hash eq_set
+ $TODO
+ plan
+ can_ok isa_ok
+ diag
+ );
+
+my $Test = Test::Builder->new;
+my $Show_Diag = 1;
+
+
+# 5.004's Exporter doesn't have export_to_level.
+sub _export_to_level
+{
+ my $pkg = shift;
+ my $level = shift;
+ (undef) = shift; # redundant arg
+ my $callpkg = caller($level);
+ $pkg->export($callpkg, @_);
+}
+
+
+=head1 NAME
+
+Test::More - yet another framework for writing test scripts
+
+=head1 SYNOPSIS
+
+ use Test::More tests => $Num_Tests;
+ # or
+ use Test::More qw(no_plan);
+ # or
+ use Test::More skip_all => $reason;
+
+ BEGIN { use_ok( 'Some::Module' ); }
+ require_ok( 'Some::Module' );
+
+ # Various ways to say "ok"
+ ok($this eq $that, $test_name);
+
+ is ($this, $that, $test_name);
+ isnt($this, $that, $test_name);
+
+ # Rather than print STDERR "# here's what went wrong\n"
+ diag("here's what went wrong");
+
+ like ($this, qr/that/, $test_name);
+ unlike($this, qr/that/, $test_name);
+
+ cmp_ok($this, '==', $that, $test_name);
+
+ is_deeply($complex_structure1, $complex_structure2, $test_name);
+
+ SKIP: {
+ skip $why, $how_many unless $have_some_feature;
+
+ ok( foo(), $test_name );
+ is( foo(42), 23, $test_name );
+ };
+
+ TODO: {
+ local $TODO = $why;
+
+ ok( foo(), $test_name );
+ is( foo(42), 23, $test_name );
+ };
+
+ can_ok($module, @methods);
+ isa_ok($object, $class);
+
+ pass($test_name);
+ fail($test_name);
+
+ # UNIMPLEMENTED!!!
+ my @status = Test::More::status;
+
+ # UNIMPLEMENTED!!!
+ BAIL_OUT($why);
+
+
+=head1 DESCRIPTION
+
+B<STOP!> If you're just getting started writing tests, have a look at
+Test::Simple first. This is a drop in replacement for Test::Simple
+which you can switch to once you get the hang of basic testing.
+
+The purpose of this module is to provide a wide range of testing
+utilities. Various ways to say "ok" with better diagnostics,
+facilities to skip tests, test future features and compare complicated
+data structures. While you can do almost anything with a simple
+C<ok()> function, it doesn't provide good diagnostic output.
+
+
+=head2 I love it when a plan comes together
+
+Before anything else, you need a testing plan. This basically declares
+how many tests your script is going to run to protect against premature
+failure.
+
+The preferred way to do this is to declare a plan when you C<use Test::More>.
+
+ use Test::More tests => $Num_Tests;
+
+There are rare cases when you will not know beforehand how many tests
+your script is going to run. In this case, you can declare that you
+have no plan. (Try to avoid using this as it weakens your test.)
+
+ use Test::More qw(no_plan);
+
+B<NOTE>: using no_plan requires a Test::Harness upgrade else it will
+think everything has failed. See L<BUGS>)
+
+In some cases, you'll want to completely skip an entire testing script.
+
+ use Test::More skip_all => $skip_reason;
+
+Your script will declare a skip with the reason why you skipped and
+exit immediately with a zero (success). See L<Test::Harness> for
+details.
+
+If you want to control what functions Test::More will export, you
+have to use the 'import' option. For example, to import everything
+but 'fail', you'd do:
+
+ use Test::More tests => 23, import => ['!fail'];
+
+Alternatively, you can use the plan() function. Useful for when you
+have to calculate the number of tests.
+
+ use Test::More;
+ plan tests => keys %Stuff * 3;
+
+or for deciding between running the tests at all:
+
+ use Test::More;
+ if( $^O eq 'MacOS' ) {
+ plan skip_all => 'Test irrelevant on MacOS';
+ }
+ else {
+ plan tests => 42;
+ }
+
+=cut
+
+sub plan {
+ my(@plan) = @_;
+
+ my $idx = 0;
+ my @cleaned_plan;
+ while( $idx <= $#plan ) {
+ my $item = $plan[$idx];
+
+ if( $item eq 'no_diag' ) {
+ $Show_Diag = 0;
+ }
+ else {
+ push @cleaned_plan, $item;
+ }
+
+ $idx++;
+ }
+
+ $Test->plan(@cleaned_plan);
+}
+
+sub import {
+ my($class) = shift;
+
+ my $caller = caller;
+
+ $Test->exported_to($caller);
+
+ my $idx = 0;
+ my @plan;
+ my @imports;
+ while( $idx <= $#_ ) {
+ my $item = $_[$idx];
+
+ if( $item eq 'import' ) {
+ push @imports, @{$_[$idx+1]};
+ $idx++;
+ }
+ else {
+ push @plan, $item;
+ }
+
+ $idx++;
+ }
+
+ plan(@plan);
+
+ __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
+}
+
+
+=head2 Test names
+
+By convention, each test is assigned a number in order. This is
+largely done automatically for you. However, it's often very useful to
+assign a name to each test. Which would you rather see:
+
+ ok 4
+ not ok 5
+ ok 6
+
+or
+
+ ok 4 - basic multi-variable
+ not ok 5 - simple exponential
+ ok 6 - force == mass * acceleration
+
+The later gives you some idea of what failed. It also makes it easier
+to find the test in your script, simply search for "simple
+exponential".
+
+All test functions take a name argument. It's optional, but highly
+suggested that you use it.
+
+
+=head2 I'm ok, you're not ok.
+
+The basic purpose of this module is to print out either "ok #" or "not
+ok #" depending on if a given test succeeded or failed. Everything
+else is just gravy.
+
+All of the following print "ok" or "not ok" depending on if the test
+succeeded or failed. They all also return true or false,
+respectively.
+
+=over 4
+
+=item B<ok>
+
+ ok($this eq $that, $test_name);
+
+This simply evaluates any expression (C<$this eq $that> is just a
+simple example) and uses that to determine if the test succeeded or
+failed. A true expression passes, a false one fails. Very simple.
+
+For example:
+
+ ok( $exp{9} == 81, 'simple exponential' );
+ ok( Film->can('db_Main'), 'set_db()' );
+ ok( $p->tests == 4, 'saw tests' );
+ ok( !grep !defined $_, @items, 'items populated' );
+
+(Mnemonic: "This is ok.")
+
+$test_name is a very short description of the test that will be printed
+out. It makes it very easy to find a test in your script when it fails
+and gives others an idea of your intentions. $test_name is optional,
+but we B<very> strongly encourage its use.
+
+Should an ok() fail, it will produce some diagnostics:
+
+ not ok 18 - sufficient mucus
+ # Failed test 18 (foo.t at line 42)
+
+This is actually Test::Simple's ok() routine.
+
+=cut
+
+sub ok ($;$) {
+ my($test, $name) = @_;
+ $Test->ok($test, $name);
+}
+
+=item B<is>
+
+=item B<isnt>
+
+ is ( $this, $that, $test_name );
+ isnt( $this, $that, $test_name );
+
+Similar to ok(), is() and isnt() compare their two arguments
+with C<eq> and C<ne> respectively and use the result of that to
+determine if the test succeeded or failed. So these:
+
+ # Is the ultimate answer 42?
+ is( ultimate_answer(), 42, "Meaning of Life" );
+
+ # $foo isn't empty
+ isnt( $foo, '', "Got some foo" );
+
+are similar to these:
+
+ ok( ultimate_answer() eq 42, "Meaning of Life" );
+ ok( $foo ne '', "Got some foo" );
+
+(Mnemonic: "This is that." "This isn't that.")
+
+So why use these? They produce better diagnostics on failure. ok()
+cannot know what you are testing for (beyond the name), but is() and
+isnt() know what the test was and why it failed. For example this
+test:
+
+ my $foo = 'waffle'; my $bar = 'yarblokos';
+ is( $foo, $bar, 'Is foo the same as bar?' );
+
+Will produce something like this:
+
+ not ok 17 - Is foo the same as bar?
+ # Failed test (foo.t at line 139)
+ # got: 'waffle'
+ # expected: 'yarblokos'
+
+So you can figure out what went wrong without rerunning the test.
+
+You are encouraged to use is() and isnt() over ok() where possible,
+however do not be tempted to use them to find out if something is
+true or false!
+
+ # XXX BAD!
+ is( exists $brooklyn{tree}, 1, 'A tree grows in Brooklyn' );
+
+This does not check if C<exists $brooklyn{tree}> is true, it checks if
+it returns 1. Very different. Similar caveats exist for false and 0.
+In these cases, use ok().
+
+ ok( exists $brooklyn{tree}, 'A tree grows in Brooklyn' );
+
+For those grammatical pedants out there, there's an C<isn't()>
+function which is an alias of isnt().
+
+=cut
+
+sub is ($$;$) {
+ $Test->is_eq(@_);
+}
+
+sub isnt ($$;$) {
+ $Test->isnt_eq(@_);
+}
+
+*isn't = \&isnt;
+
+
+=item B<like>
+
+ like( $this, qr/that/, $test_name );
+
+Similar to ok(), like() matches $this against the regex C<qr/that/>.
+
+So this:
+
+ like($this, qr/that/, 'this is like that');
+
+is similar to:
+
+ ok( $this =~ /that/, 'this is like that');
+
+(Mnemonic "This is like that".)
+
+The second argument is a regular expression. It may be given as a
+regex reference (i.e. C<qr//>) or (for better compatibility with older
+perls) as a string that looks like a regex (alternative delimiters are
+currently not supported):
+
+ like( $this, '/that/', 'this is like that' );
+
+Regex options may be placed on the end (C<'/that/i'>).
+
+Its advantages over ok() are similar to that of is() and isnt(). Better
+diagnostics on failure.
+
+=cut
+
+sub like ($$;$) {
+ $Test->like(@_);
+}
+
+
+=item B<unlike>
+
+ unlike( $this, qr/that/, $test_name );
+
+Works exactly as like(), only it checks if $this B<does not> match the
+given pattern.
+
+=cut
+
+sub unlike ($$;$) {
+ $Test->unlike(@_);
+}
+
+
+=item B<cmp_ok>
+
+ cmp_ok( $this, $op, $that, $test_name );
+
+Halfway between ok() and is() lies cmp_ok(). This allows you to
+compare two arguments using any binary perl operator.
+
+ # ok( $this eq $that );
+ cmp_ok( $this, 'eq', $that, 'this eq that' );
+
+ # ok( $this == $that );
+ cmp_ok( $this, '==', $that, 'this == that' );
+
+ # ok( $this && $that );
+ cmp_ok( $this, '&&', $that, 'this && that' );
+ ...etc...
+
+Its advantage over ok() is when the test fails you'll know what $this
+and $that were:
+
+ not ok 1
+ # Failed test (foo.t at line 12)
+ # '23'
+ # &&
+ # undef
+
+It's also useful in those cases where you are comparing numbers and
+is()'s use of C<eq> will interfere:
+
+ cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
+
+=cut
+
+sub cmp_ok($$$;$) {
+ $Test->cmp_ok(@_);
+}
+
+
+=item B<can_ok>
+
+ can_ok($module, @methods);
+ can_ok($object, @methods);
+
+Checks to make sure the $module or $object can do these @methods
+(works with functions, too).
+
+ can_ok('Foo', qw(this that whatever));
+
+is almost exactly like saying:
+
+ ok( Foo->can('this') &&
+ Foo->can('that') &&
+ Foo->can('whatever')
+ );
+
+only without all the typing and with a better interface. Handy for
+quickly testing an interface.
+
+No matter how many @methods you check, a single can_ok() call counts
+as one test. If you desire otherwise, use:
+
+ foreach my $meth (@methods) {
+ can_ok('Foo', $meth);
+ }
+
+=cut
+
+sub can_ok ($@) {
+ my($proto, @methods) = @_;
+ my $class = ref $proto || $proto;
+
+ unless( @methods ) {
+ my $ok = $Test->ok( 0, "$class->can(...)" );
+ $Test->diag(' can_ok() called with no methods');
+ return $ok;
+ }
+
+ my @nok = ();
+ foreach my $method (@methods) {
+ local($!, $@); # don't interfere with caller's $@
+ # eval sometimes resets $!
+ eval { $proto->can($method) } || push @nok, $method;
+ }
+
+ my $name;
+ $name = @methods == 1 ? "$class->can('$methods[0]')"
+ : "$class->can(...)";
+
+ my $ok = $Test->ok( !@nok, $name );
+
+ $Test->diag(map " $class->can('$_') failed\n", @nok);
+
+ return $ok;
+}
+
+=item B<isa_ok>
+
+ isa_ok($object, $class, $object_name);
+ isa_ok($ref, $type, $ref_name);
+
+Checks to see if the given C<< $object->isa($class) >>. Also checks to make
+sure the object was defined in the first place. Handy for this sort
+of thing:
+
+ my $obj = Some::Module->new;
+ isa_ok( $obj, 'Some::Module' );
+
+where you'd otherwise have to write
+
+ my $obj = Some::Module->new;
+ ok( defined $obj && $obj->isa('Some::Module') );
+
+to safeguard against your test script blowing up.
+
+It works on references, too:
+
+ isa_ok( $array_ref, 'ARRAY' );
+
+The diagnostics of this test normally just refer to 'the object'. If
+you'd like them to be more specific, you can supply an $object_name
+(for example 'Test customer').
+
+=cut
+
+sub isa_ok ($$;$) {
+ my($object, $class, $obj_name) = @_;
+
+ my $diag;
+ $obj_name = 'The object' unless defined $obj_name;
+ my $name = "$obj_name isa $class";
+ if( !defined $object ) {
+ $diag = "$obj_name isn't defined";
+ }
+ elsif( !ref $object ) {
+ $diag = "$obj_name isn't a reference";
+ }
+ else {
+ # We can't use UNIVERSAL::isa because we want to honor isa() overrides
+ local($@, $!); # eval sometimes resets $!
+ my $rslt = eval { $object->isa($class) };
+ if( $@ ) {
+ if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
+ if( !UNIVERSAL::isa($object, $class) ) {
+ my $ref = ref $object;
+ $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ }
+ } else {
+ die <<WHOA;
+WHOA! I tried to call ->isa on your object and got some weird error.
+This should never happen. Please contact the author immediately.
+Here's the error.
+$@
+WHOA
+ }
+ }
+ elsif( !$rslt ) {
+ my $ref = ref $object;
+ $diag = "$obj_name isn't a '$class' it's a '$ref'";
+ }
+ }
+
+
+
+ my $ok;
+ if( $diag ) {
+ $ok = $Test->ok( 0, $name );
+ $Test->diag(" $diag\n");
+ }
+ else {
+ $ok = $Test->ok( 1, $name );
+ }
+
+ return $ok;
+}
+
+
+=item B<pass>
+
+=item B<fail>
+
+ pass($test_name);
+ fail($test_name);
+
+Sometimes you just want to say that the tests have passed. Usually
+the case is you've got some complicated condition that is difficult to
+wedge into an ok(). In this case, you can simply use pass() (to
+declare the test ok) or fail (for not ok). They are synonyms for
+ok(1) and ok(0).
+
+Use these very, very, very sparingly.
+
+=cut
+
+sub pass (;$) {
+ $Test->ok(1, @_);
+}
+
+sub fail (;$) {
+ $Test->ok(0, @_);
+}
+
+=back
+
+=head2 Diagnostics
+
+If you pick the right test function, you'll usually get a good idea of
+what went wrong when it failed. But sometimes it doesn't work out
+that way. So here we have ways for you to write your own diagnostic
+messages which are safer than just C<print STDERR>.
+
+=over 4
+
+=item B<diag>
+
+ diag(@diagnostic_message);
+
+Prints a diagnostic message which is guaranteed not to interfere with
+test output. Like C<print> @diagnostic_message is simply concatinated
+together.
+
+Handy for this sort of thing:
+
+ ok( grep(/foo/, @users), "There's a foo user" ) or
+ diag("Since there's no foo, check that /etc/bar is set up right");
+
+which would produce:
+
+ not ok 42 - There's a foo user
+ # Failed test (foo.t at line 52)
+ # Since there's no foo, check that /etc/bar is set up right.
+
+You might remember C<ok() or diag()> with the mnemonic C<open() or
+die()>.
+
+All diag()s can be made silent by passing the "no_diag" option to
+Test::More. C<use Test::More tests => 1, 'no_diag'>. This is useful
+if you have diagnostics for personal testing but then wish to make
+them silent for release without commenting out each individual
+statement.
+
+B<NOTE> The exact formatting of the diagnostic output is still
+changing, but it is guaranteed that whatever you throw at it it won't
+interfere with the test.
+
+=cut
+
+sub diag {
+ return unless $Show_Diag;
+ $Test->diag(@_);
+}
+
+
+=back
+
+=head2 Module tests
+
+You usually want to test if the module you're testing loads ok, rather
+than just vomiting if its load fails. For such purposes we have
+C<use_ok> and C<require_ok>.
+
+=over 4
+
+=item B<use_ok>
+
+ BEGIN { use_ok($module); }
+ BEGIN { use_ok($module, @imports); }
+
+These simply use the given $module and test to make sure the load
+happened ok. It's recommended that you run use_ok() inside a BEGIN
+block so its functions are exported at compile-time and prototypes are
+properly honored.
+
+If @imports are given, they are passed through to the use. So this:
+
+ BEGIN { use_ok('Some::Module', qw(foo bar)) }
+
+is like doing this:
+
+ use Some::Module qw(foo bar);
+
+Version numbers can be checked like so:
+
+ # Just like "use Some::Module 1.02"
+ BEGIN { use_ok('Some::Module', 1.02) }
+
+Don't try to do this:
+
+ BEGIN {
+ use_ok('Some::Module');
+
+ ...some code that depends on the use...
+ ...happening at compile time...
+ }
+
+because the notion of "compile-time" is relative. Instead, you want:
+
+ BEGIN { use_ok('Some::Module') }
+ BEGIN { ...some code that depends on the use... }
+
+
+=cut
+
+sub use_ok ($;@) {
+ my($module, @imports) = @_;
+ @imports = () unless @imports;
+
+ my($pack,$filename,$line) = caller;
+
+ local($@,$!); # eval sometimes interferes with $!
+
+ if( @imports == 1 and $imports[0] =~ /^\d+(?:\.\d+)?$/ ) {
+ # probably a version check. Perl needs to see the bare number
+ # for it to work with non-Exporter based modules.
+ eval <<USE;
+package $pack;
+use $module $imports[0];
+USE
+ }
+ else {
+ eval <<USE;
+package $pack;
+use $module \@imports;
+USE
+ }
+
+ my $ok = $Test->ok( !$@, "use $module;" );
+
+ unless( $ok ) {
+ chomp $@;
+ $@ =~ s{^BEGIN failed--compilation aborted at .*$}
+ {BEGIN failed--compilation aborted at $filename line $line.}m;
+ $Test->diag(<<DIAGNOSTIC);
+ Tried to use '$module'.
+ Error: $@
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+=item B<require_ok>
+
+ require_ok($module);
+ require_ok($file);
+
+Like use_ok(), except it requires the $module or $file.
+
+=cut
+
+sub require_ok ($) {
+ my($module) = shift;
+
+ my $pack = caller;
+
+ # Try to deterine if we've been given a module name or file.
+ # Module names must be barewords, files not.
+ $module = qq['$module'] unless _is_module_name($module);
+
+ local($!, $@); # eval sometimes interferes with $!
+ eval <<REQUIRE;
+package $pack;
+require $module;
+REQUIRE
+
+ my $ok = $Test->ok( !$@, "require $module;" );
+
+ unless( $ok ) {
+ chomp $@;
+ $Test->diag(<<DIAGNOSTIC);
+ Tried to require '$module'.
+ Error: $@
+DIAGNOSTIC
+
+ }
+
+ return $ok;
+}
+
+
+sub _is_module_name {
+ my $module = shift;
+
+ # Module names start with a letter.
+ # End with an alphanumeric.
+ # The rest is an alphanumeric or ::
+ $module =~ s/\b::\b//g;
+ $module =~ /^[a-zA-Z]\w*$/;
+}
+
+=back
+
+=head2 Conditional tests
+
+Sometimes running a test under certain conditions will cause the
+test script to die. A certain function or method isn't implemented
+(such as fork() on MacOS), some resource isn't available (like a
+net connection) or a module isn't available. In these cases it's
+necessary to skip tests, or declare that they are supposed to fail
+but will work in the future (a todo test).
+
+For more details on the mechanics of skip and todo tests see
+L<Test::Harness>.
+
+The way Test::More handles this is with a named block. Basically, a
+block of tests which can be skipped over or made todo. It's best if I
+just show you...
+
+=over 4
+
+=item B<SKIP: BLOCK>
+
+ SKIP: {
+ skip $why, $how_many if $condition;
+
+ ...normal testing code goes here...
+ }
+
+This declares a block of tests that might be skipped, $how_many tests
+there are, $why and under what $condition to skip them. An example is
+the easiest way to illustrate:
+
+ SKIP: {
+ eval { require HTML::Lint };
+
+ skip "HTML::Lint not installed", 2 if $@;
+
+ my $lint = new HTML::Lint;
+ isa_ok( $lint, "HTML::Lint" );
+
+ $lint->parse( $html );
+ is( $lint->errors, 0, "No errors found in HTML" );
+ }
+
+If the user does not have HTML::Lint installed, the whole block of
+code I<won't be run at all>. Test::More will output special ok's
+which Test::Harness interprets as skipped, but passing, tests.
+
+It's important that $how_many accurately reflects the number of tests
+in the SKIP block so the # of tests run will match up with your plan.
+If your plan is C<no_plan> $how_many is optional and will default to 1.
+
+It's perfectly safe to nest SKIP blocks. Each SKIP block must have
+the label C<SKIP>, or Test::More can't work its magic.
+
+You don't skip tests which are failing because there's a bug in your
+program, or for which you don't yet have code written. For that you
+use TODO. Read on.
+
+=cut
+
+#'#
+sub skip {
+ my($why, $how_many) = @_;
+
+ unless( defined $how_many ) {
+ # $how_many can only be avoided when no_plan is in use.
+ _carp "skip() needs to know \$how_many tests are in the block"
+ unless $Test->has_plan eq 'no_plan';
+ $how_many = 1;
+ }
+
+ for( 1..$how_many ) {
+ $Test->skip($why);
+ }
+
+ local $^W = 0;
+ last SKIP;
+}
+
+
+=item B<TODO: BLOCK>
+
+ TODO: {
+ local $TODO = $why if $condition;
+
+ ...normal testing code goes here...
+ }
+
+Declares a block of tests you expect to fail and $why. Perhaps it's
+because you haven't fixed a bug or haven't finished a new feature:
+
+ TODO: {
+ local $TODO = "URI::Geller not finished";
+
+ my $card = "Eight of clubs";
+ is( URI::Geller->your_card, $card, 'Is THIS your card?' );
+
+ my $spoon;
+ URI::Geller->bend_spoon;
+ is( $spoon, 'bent', "Spoon bending, that's original" );
+ }
+
+With a todo block, the tests inside are expected to fail. Test::More
+will run the tests normally, but print out special flags indicating
+they are "todo". Test::Harness will interpret failures as being ok.
+Should anything succeed, it will report it as an unexpected success.
+You then know the thing you had todo is done and can remove the
+TODO flag.
+
+The nice part about todo tests, as opposed to simply commenting out a
+block of tests, is it's like having a programmatic todo list. You know
+how much work is left to be done, you're aware of what bugs there are,
+and you'll know immediately when they're fixed.
+
+Once a todo test starts succeeding, simply move it outside the block.
+When the block is empty, delete it.
+
+B<NOTE>: TODO tests require a Test::Harness upgrade else it will
+treat it as a normal failure. See L<BUGS>)
+
+
+=item B<todo_skip>
+
+ TODO: {
+ todo_skip $why, $how_many if $condition;
+
+ ...normal testing code...
+ }
+
+With todo tests, it's best to have the tests actually run. That way
+you'll know when they start passing. Sometimes this isn't possible.
+Often a failing test will cause the whole program to die or hang, even
+inside an C<eval BLOCK> with and using C<alarm>. In these extreme
+cases you have no choice but to skip over the broken tests entirely.
+
+The syntax and behavior is similar to a C<SKIP: BLOCK> except the
+tests will be marked as failing but todo. Test::Harness will
+interpret them as passing.
+
+=cut
+
+sub todo_skip {
+ my($why, $how_many) = @_;
+
+ unless( defined $how_many ) {
+ # $how_many can only be avoided when no_plan is in use.
+ _carp "todo_skip() needs to know \$how_many tests are in the block"
+ unless $Test->has_plan eq 'no_plan';
+ $how_many = 1;
+ }
+
+ for( 1..$how_many ) {
+ $Test->todo_skip($why);
+ }
+
+ local $^W = 0;
+ last TODO;
+}
+
+=item When do I use SKIP vs. TODO?
+
+B<If it's something the user might not be able to do>, use SKIP.
+This includes optional modules that aren't installed, running under
+an OS that doesn't have some feature (like fork() or symlinks), or maybe
+you need an Internet connection and one isn't available.
+
+B<If it's something the programmer hasn't done yet>, use TODO. This
+is for any code you haven't written yet, or bugs you have yet to fix,
+but want to put tests in your testing script (always a good idea).
+
+
+=back
+
+=head2 Complex data structures
+
+Not everything is a simple eq check or regex. There are times you
+need to see if two data structures are equivalent. For these
+instances Test::More provides a handful of useful functions.
+
+B<NOTE> I'm not quite sure what will happen with filehandles.
+
+=over 4
+
+=item B<is_deeply>
+
+ is_deeply( $this, $that, $test_name );
+
+Similar to is(), except that if $this and $that are hash or array
+references, it does a deep comparison walking each data structure to
+see if they are equivalent. If the two structures are different, it
+will display the place where they start differing.
+
+Test::Differences and Test::Deep provide more in-depth functionality
+along these lines.
+
+=back
+
+=cut
+
+our (@Data_Stack, %Refs_Seen);
+my $DNE = bless [], 'Does::Not::Exist';
+sub is_deeply {
+ unless( @_ == 2 or @_ == 3 ) {
+ my $msg = <<WARNING;
+is_deeply() takes two or three args, you gave %d.
+This usually means you passed an array or hash instead
+of a reference to it
+WARNING
+ chop $msg; # clip off newline so carp() will put in line/file
+
+ _carp sprintf $msg, scalar @_;
+
+ return $Test->ok(0);
+ }
+
+ my($this, $that, $name) = @_;
+
+ my $ok;
+ if( !ref $this and !ref $that ) { # neither is a reference
+ $ok = $Test->is_eq($this, $that, $name);
+ }
+ elsif( !ref $this xor !ref $that ) { # one's a reference, one isn't
+ $ok = $Test->ok(0, $name);
+ $Test->diag( _format_stack({ vals => [ $this, $that ] }) );
+ }
+ else { # both references
+ local @Data_Stack = ();
+ if( _deep_check($this, $that) ) {
+ $ok = $Test->ok(1, $name);
+ }
+ else {
+ $ok = $Test->ok(0, $name);
+ $Test->diag(_format_stack(@Data_Stack));
+ }
+ }
+
+ return $ok;
+}
+
+sub _format_stack {
+ my(@Stack) = @_;
+
+ my $var = '$FOO';
+ my $did_arrow = 0;
+ foreach my $entry (@Stack) {
+ my $type = $entry->{type} || '';
+ my $idx = $entry->{'idx'};
+ if( $type eq 'HASH' ) {
+ $var .= "->" unless $did_arrow++;
+ $var .= "{$idx}";
+ }
+ elsif( $type eq 'ARRAY' ) {
+ $var .= "->" unless $did_arrow++;
+ $var .= "[$idx]";
+ }
+ elsif( $type eq 'REF' ) {
+ $var = "\${$var}";
+ }
+ }
+
+ my @vals = @{$Stack[-1]{vals}}[0,1];
+ my @vars = ();
+ ($vars[0] = $var) =~ s/\$FOO/ \$got/;
+ ($vars[1] = $var) =~ s/\$FOO/\$expected/;
+
+ my $out = "Structures begin differing at:\n";
+ foreach my $idx (0..$#vals) {
+ my $val = $vals[$idx];
+ $vals[$idx] = !defined $val ? 'undef' :
+ $val eq $DNE ? "Does not exist" :
+ ref $val ? "$val" :
+ "'$val'";
+ }
+
+ $out .= "$vars[0] = $vals[0]\n";
+ $out .= "$vars[1] = $vals[1]\n";
+
+ $out =~ s/^/ /msg;
+ return $out;
+}
+
+
+sub _type {
+ my $thing = shift;
+
+ return '' if !ref $thing;
+
+ for my $type (qw(ARRAY HASH REF SCALAR GLOB Regexp)) {
+ return $type if UNIVERSAL::isa($thing, $type);
+ }
+
+ return '';
+}
+
+
+=head2 Discouraged comparison functions
+
+The use of the following functions is discouraged as they are not
+actually testing functions and produce no diagnostics to help figure
+out what went wrong. They were written before is_deeply() existed
+because I couldn't figure out how to display a useful diff of two
+arbitrary data structures.
+
+These functions are usually used inside an ok().
+
+ ok( eq_array(\@this, \@that) );
+
+C<is_deeply()> can do that better and with diagnostics.
+
+ is_deeply( \@this, \@that );
+
+They may be deprecated in future versions.
+
+=over 4
+
+=item B<eq_array>
+
+ my $is_eq = eq_array(\@this, \@that);
+
+Checks if two arrays are equivalent. This is a deep check, so
+multi-level structures are handled correctly.
+
+=cut
+
+#'#
+sub eq_array {
+ local @Data_Stack;
+ _deep_check(@_);
+}
+
+sub _eq_array {
+ my($a1, $a2) = @_;
+
+ if( grep !_type($_) eq 'ARRAY', $a1, $a2 ) {
+ warn "eq_array passed a non-array ref";
+ return 0;
+ }
+
+ return 1 if $a1 eq $a2;
+
+ my $ok = 1;
+ my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
+ for (0..$max) {
+ my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
+ my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
+
+ push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
+ $ok = _deep_check($e1,$e2);
+ pop @Data_Stack if $ok;
+
+ last unless $ok;
+ }
+
+ return $ok;
+}
+
+sub _deep_check {
+ my($e1, $e2) = @_;
+ my $ok = 0;
+
+ # Effectively turn %Refs_Seen into a stack. This avoids picking up
+ # the same referenced used twice (such as [\$a, \$a]) to be considered
+ # circular.
+ local %Refs_Seen = %Refs_Seen;
+
+ {
+ # Quiet uninitialized value warnings when comparing undefs.
+ local $^W = 0;
+
+ $Test->_unoverload(\$e1, \$e2);
+
+ # Either they're both references or both not.
+ my $same_ref = !(!ref $e1 xor !ref $e2);
+ my $not_ref = (!ref $e1 and !ref $e2);
+
+ if( defined $e1 xor defined $e2 ) {
+ $ok = 0;
+ }
+ elsif ( $e1 == $DNE xor $e2 == $DNE ) {
+ $ok = 0;
+ }
+ elsif ( $same_ref and ($e1 eq $e2) ) {
+ $ok = 1;
+ }
+ elsif ( $not_ref ) {
+ push @Data_Stack, { type => '', vals => [$e1, $e2] };
+ $ok = 0;
+ }
+ else {
+ if( $Refs_Seen{$e1} ) {
+ return $Refs_Seen{$e1} eq $e2;
+ }
+ else {
+ $Refs_Seen{$e1} = "$e2";
+ }
+
+ my $type = _type($e1);
+ $type = 'DIFFERENT' unless _type($e2) eq $type;
+
+ if( $type eq 'DIFFERENT' ) {
+ push @Data_Stack, { type => $type, vals => [$e1, $e2] };
+ $ok = 0;
+ }
+ elsif( $type eq 'ARRAY' ) {
+ $ok = _eq_array($e1, $e2);
+ }
+ elsif( $type eq 'HASH' ) {
+ $ok = _eq_hash($e1, $e2);
+ }
+ elsif( $type eq 'REF' ) {
+ push @Data_Stack, { type => $type, vals => [$e1, $e2] };
+ $ok = _deep_check($$e1, $$e2);
+ pop @Data_Stack if $ok;
+ }
+ elsif( $type eq 'SCALAR' ) {
+ push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
+ $ok = _deep_check($$e1, $$e2);
+ pop @Data_Stack if $ok;
+ }
+ else {
+ _whoa(1, "No type in _deep_check");
+ }
+ }
+ }
+
+ return $ok;
+}
+
+
+sub _whoa {
+ my($check, $desc) = @_;
+ if( $check ) {
+ die <<WHOA;
+WHOA! $desc
+This should never happen! Please contact the author immediately!
+WHOA
+ }
+}
+
+
+=item B<eq_hash>
+
+ my $is_eq = eq_hash(\%this, \%that);
+
+Determines if the two hashes contain the same keys and values. This
+is a deep check.
+
+=cut
+
+sub eq_hash {
+ local @Data_Stack;
+ return _deep_check(@_);
+}
+
+sub _eq_hash {
+ my($a1, $a2) = @_;
+
+ if( grep !_type($_) eq 'HASH', $a1, $a2 ) {
+ warn "eq_hash passed a non-hash ref";
+ return 0;
+ }
+
+ return 1 if $a1 eq $a2;
+
+ my $ok = 1;
+ my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
+ foreach my $k (keys %$bigger) {
+ my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
+ my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
+
+ push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
+ $ok = _deep_check($e1, $e2);
+ pop @Data_Stack if $ok;
+
+ last unless $ok;
+ }
+
+ return $ok;
+}
+
+=item B<eq_set>
+
+ my $is_eq = eq_set(\@this, \@that);
+
+Similar to eq_array(), except the order of the elements is B<not>
+important. This is a deep check, but the irrelevancy of order only
+applies to the top level.
+
+ ok( eq_set(\@this, \@that) );
+
+Is better written:
+
+ is_deeply( [sort @this], [sort @that] );
+
+B<NOTE> By historical accident, this is not a true set comparision.
+While the order of elements does not matter, duplicate elements do.
+
+Test::Deep contains much better set comparison functions.
+
+=cut
+
+sub eq_set {
+ my($a1, $a2) = @_;
+ return 0 unless @$a1 == @$a2;
+
+ # There's faster ways to do this, but this is easiest.
+ local $^W = 0;
+
+ # We must make sure that references are treated neutrally. It really
+ # doesn't matter how we sort them, as long as both arrays are sorted
+ # with the same algorithm.
+ # Have to inline the sort routine due to a threading/sort bug.
+ # See [rt.cpan.org 6782]
+ return eq_array(
+ [sort { ref $a ? -1 : ref $b ? 1 : $a cmp $b } @$a1],
+ [sort { ref $a ? -1 : ref $b ? 1 : $a cmp $b } @$a2]
+ );
+}
+
+=back
+
+
+=head2 Extending and Embedding Test::More
+
+Sometimes the Test::More interface isn't quite enough. Fortunately,
+Test::More is built on top of Test::Builder which provides a single,
+unified backend for any test library to use. This means two test
+libraries which both use Test::Builder B<can be used together in the
+same program>.
+
+If you simply want to do a little tweaking of how the tests behave,
+you can access the underlying Test::Builder object like so:
+
+=over 4
+
+=item B<builder>
+
+ my $test_builder = Test::More->builder;
+
+Returns the Test::Builder object underlying Test::More for you to play
+with.
+
+=cut
+
+sub builder {
+ return Test::Builder->new;
+}
+
+=back
+
+
+=head1 EXIT CODES
+
+If all your tests passed, Test::Builder will exit with zero (which is
+normal). If anything failed it will exit with how many failed. If
+you run less (or more) tests than you planned, the missing (or extras)
+will be considered failures. If no tests were ever run Test::Builder
+will throw a warning and exit with 255. If the test died, even after
+having successfully completed all its tests, it will still be
+considered a failure and will exit with 255.
+
+So the exit codes are...
+
+ 0 all tests successful
+ 255 test died
+ any other number how many failed (including missing or extras)
+
+If you fail more than 254 tests, it will be reported as 254.
+
+B<NOTE> This behavior may go away in future versions.
+
+
+=head1 CAVEATS and NOTES
+
+=over 4
+
+=item Backwards compatibility
+
+Test::More works with Perls as old as 5.004_05.
+
+
+=item Overloaded objects
+
+String overloaded objects are compared B<as strings>. This prevents
+Test::More from piercing an object's interface allowing better blackbox
+testing. So if a function starts returning overloaded objects instead of
+bare strings your tests won't notice the difference. This is good.
+
+However, it does mean that functions like is_deeply() cannot be used to
+test the internals of string overloaded objects. In this case I would
+suggest Test::Deep which contains more flexible testing functions for
+complex data structures.
+
+
+=item Threads
+
+Test::More will only be aware of threads if "use threads" has been done
+I<before> Test::More is loaded. This is ok:
+
+ use threads;
+ use Test::More;
+
+This may cause problems:
+
+ use Test::More
+ use threads;
+
+
+=item Test::Harness upgrade
+
+no_plan and todo depend on new Test::Harness features and fixes. If
+you're going to distribute tests that use no_plan or todo your
+end-users will have to upgrade Test::Harness to the latest one on
+CPAN. If you avoid no_plan and TODO tests, the stock Test::Harness
+will work fine.
+
+Installing Test::More should also upgrade Test::Harness.
+
+=back
+
+
+=head1 HISTORY
+
+This is a case of convergent evolution with Joshua Pritikin's Test
+module. I was largely unaware of its existence when I'd first
+written my own ok() routines. This module exists because I can't
+figure out how to easily wedge test names into Test's interface (along
+with a few other problems).
+
+The goal here is to have a testing utility that's simple to learn,
+quick to use and difficult to trip yourself up with while still
+providing more flexibility than the existing Test.pm. As such, the
+names of the most common routines are kept tiny, special cases and
+magic side-effects are kept to a minimum. WYSIWYG.
+
+
+=head1 SEE ALSO
+
+L<Test::Simple> if all this confuses you and you just want to write
+some tests. You can upgrade to Test::More later (it's forward
+compatible).
+
+L<Test> is the old testing module. Its main benefit is that it has
+been distributed with Perl since 5.004_05.
+
+L<Test::Harness> for details on how your test results are interpreted
+by Perl.
+
+L<Test::Differences> for more ways to test complex data structures.
+And it plays well with Test::More.
+
+L<Test::Class> is like XUnit but more perlish.
+
+L<Test::Deep> gives you more powerful complex data structure testing.
+
+L<Test::Unit> is XUnit style testing.
+
+L<Test::Inline> shows the idea of embedded testing.
+
+L<Bundle::Test> installs a whole bunch of useful test modules.
+
+
+=head1 AUTHORS
+
+Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
+from Joshua Pritikin's Test module and lots of help from Barrie
+Slaymaker, Tony Bowden, blackstar.co.uk, chromatic, Fergal Daly and
+the perl-qa gang.
+
+
+=head1 BUGS
+
+See F<http://rt.cpan.org> to report and view bugs.
+
+
+=head1 COPYRIGHT
+
+Copyright 2001, 2002, 2004 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
--- /dev/null
+package Test::Simple;
+
+use 5.004;
+
+use strict 'vars';
+our ($VERSION);
+$VERSION = '0.60';
+$VERSION = eval $VERSION; # make the alpha version come out as a number
+
+
+use Test::Builder;
+my $Test = Test::Builder->new;
+
+sub import {
+ my $self = shift;
+ my $caller = caller;
+ *{$caller.'::ok'} = \&ok;
+
+ $Test->exported_to($caller);
+ $Test->plan(@_);
+}
+
+
+=head1 NAME
+
+Test::Simple - Basic utilities for writing tests.
+
+=head1 SYNOPSIS
+
+ use Test::Simple tests => 1;
+
+ ok( $foo eq $bar, 'foo is bar' );
+
+
+=head1 DESCRIPTION
+
+** If you are unfamiliar with testing B<read Test::Tutorial> first! **
+
+This is an extremely simple, extremely basic module for writing tests
+suitable for CPAN modules and other pursuits. If you wish to do more
+complicated testing, use the Test::More module (a drop-in replacement
+for this one).
+
+The basic unit of Perl testing is the ok. For each thing you want to
+test your program will print out an "ok" or "not ok" to indicate pass
+or fail. You do this with the ok() function (see below).
+
+The only other constraint is you must pre-declare how many tests you
+plan to run. This is in case something goes horribly wrong during the
+test and your test program aborts, or skips a test or whatever. You
+do this like so:
+
+ use Test::Simple tests => 23;
+
+You must have a plan.
+
+
+=over 4
+
+=item B<ok>
+
+ ok( $foo eq $bar, $name );
+ ok( $foo eq $bar );
+
+ok() is given an expression (in this case C<$foo eq $bar>). If it's
+true, the test passed. If it's false, it didn't. That's about it.
+
+ok() prints out either "ok" or "not ok" along with a test number (it
+keeps track of that for you).
+
+ # This produces "ok 1 - Hell not yet frozen over" (or not ok)
+ ok( get_temperature($hell) > 0, 'Hell not yet frozen over' );
+
+If you provide a $name, that will be printed along with the "ok/not
+ok" to make it easier to find your test when if fails (just search for
+the name). It also makes it easier for the next guy to understand
+what your test is for. It's highly recommended you use test names.
+
+All tests are run in scalar context. So this:
+
+ ok( @stuff, 'I have some stuff' );
+
+will do what you mean (fail if stuff is empty)
+
+=cut
+
+sub ok ($;$) {
+ $Test->ok(@_);
+}
+
+
+=back
+
+Test::Simple will start by printing number of tests run in the form
+"1..M" (so "1..5" means you're going to run 5 tests). This strange
+format lets Test::Harness know how many tests you plan on running in
+case something goes horribly wrong.
+
+If all your tests passed, Test::Simple will exit with zero (which is
+normal). If anything failed it will exit with how many failed. If
+you run less (or more) tests than you planned, the missing (or extras)
+will be considered failures. If no tests were ever run Test::Simple
+will throw a warning and exit with 255. If the test died, even after
+having successfully completed all its tests, it will still be
+considered a failure and will exit with 255.
+
+So the exit codes are...
+
+ 0 all tests successful
+ 255 test died
+ any other number how many failed (including missing or extras)
+
+If you fail more than 254 tests, it will be reported as 254.
+
+This module is by no means trying to be a complete testing system.
+It's just to get you started. Once you're off the ground its
+recommended you look at L<Test::More>.
+
+
+=head1 EXAMPLE
+
+Here's an example of a simple .t file for the fictional Film module.
+
+ use Test::Simple tests => 5;
+
+ use Film; # What you're testing.
+
+ my $btaste = Film->new({ Title => 'Bad Taste',
+ Director => 'Peter Jackson',
+ Rating => 'R',
+ NumExplodingSheep => 1
+ });
+ ok( defined($btaste) && ref $btaste eq 'Film, 'new() works' );
+
+ ok( $btaste->Title eq 'Bad Taste', 'Title() get' );
+ ok( $btaste->Director eq 'Peter Jackson', 'Director() get' );
+ ok( $btaste->Rating eq 'R', 'Rating() get' );
+ ok( $btaste->NumExplodingSheep == 1, 'NumExplodingSheep() get' );
+
+It will produce output like this:
+
+ 1..5
+ ok 1 - new() works
+ ok 2 - Title() get
+ ok 3 - Director() get
+ not ok 4 - Rating() get
+ # Failed test (t/film.t at line 14)
+ ok 5 - NumExplodingSheep() get
+ # Looks like you failed 1 tests of 5
+
+Indicating the Film::Rating() method is broken.
+
+
+=head1 CAVEATS
+
+Test::Simple will only report a maximum of 254 failures in its exit
+code. If this is a problem, you probably have a huge test script.
+Split it into multiple files. (Otherwise blame the Unix folks for
+using an unsigned short integer as the exit status).
+
+Because VMS's exit codes are much, much different than the rest of the
+universe, and perl does horrible mangling to them that gets in my way,
+it works like this on VMS.
+
+ 0 SS$_NORMAL all tests successful
+ 4 SS$_ABORT something went wrong
+
+Unfortunately, I can't differentiate any further.
+
+
+=head1 NOTES
+
+Test::Simple is B<explicitly> tested all the way back to perl 5.004.
+
+Test::Simple is thread-safe in perl 5.8.0 and up.
+
+=head1 HISTORY
+
+This module was conceived while talking with Tony Bowden in his
+kitchen one night about the problems I was having writing some really
+complicated feature into the new Testing module. He observed that the
+main problem is not dealing with these edge cases but that people hate
+to write tests B<at all>. What was needed was a dead simple module
+that took all the hard work out of testing and was really, really easy
+to learn. Paul Johnson simultaneously had this idea (unfortunately,
+he wasn't in Tony's kitchen). This is it.
+
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Test::More>
+
+More testing functions! Once you outgrow Test::Simple, look at
+Test::More. Test::Simple is 100% forward compatible with Test::More
+(i.e. you can just use Test::More instead of Test::Simple in your
+programs and things will still work).
+
+=item L<Test>
+
+The original Perl testing module.
+
+=item L<Test::Unit>
+
+Elaborate unit testing.
+
+=item L<Test::Inline>, L<SelfTest>
+
+Embed tests in your code!
+
+=item L<Test::Harness>
+
+Interprets the output of your test program.
+
+=back
+
+
+=head1 AUTHORS
+
+Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
+E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
+
+
+=head1 COPYRIGHT
+
+Copyright 2001, 2002, 2004 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See F<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
}
+sub test_zlib_header_matches_library
+{
+SKIP: {
+ skip "TEST_SKIP_VERSION_CHECK is set", 1
+ if $ENV{TEST_SKIP_VERSION_CHECK};
+
+ if (Compress::Raw::Zlib::is_zlibng_native())
+ {
+ my $zlibng_h = Compress::Raw::Zlib::ZLIBNG_VERSION ;
+ my $libzng = Compress::Raw::Zlib::zlibng_version();
+ is($zlibng_h, $libzng, "ZLIBNG_VERSION ($zlibng_h) matches Compress::Raw::Zlib::zlibng_version")
+ or diag <<EOM;
+
+The version of zlib-ng.h does not match the version of libz-ng
+
+You have zlib-ng.h version $zlibng_h
+ and libz-ng version $libzng
+
+You probably have two versions of zlib-ng installed on your system.
+Try removing the one you don't want to use and rebuild.
+EOM
+ }
+ else
+ {
+ my $zlib_h = ZLIB_VERSION ;
+ my $libz = Compress::Raw::Zlib::zlib_version();
+ is($zlib_h, $libz, "ZLIB_VERSION ($zlib_h) matches Compress::Raw::Zlib::zlib_version")
+ or diag <<EOM;
+
+The version of zlib.h does not match the version of libz
+
+You have zlib.h version $zlib_h
+ and libz version $libz
+
+You probably have two versions of zlib installed on your system.
+Try removing the one you don't want to use and rebuild.
+EOM
+ }
+ }
+}
+
{
package LexFile ;
--- /dev/null
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = ("../lib", "lib/compress");
+ }
+}
+
+use lib qw(t t/compress);
+use Test::More;
+eval "use Test::CPAN::Meta::JSON";
+plan skip_all => "Test::CPAN::Meta::JSON required for testing META.json" if $@;
+meta_json_ok();
\ No newline at end of file
--- /dev/null
+BEGIN {
+ if ($ENV{PERL_CORE}) {
+ chdir 't' if -d 't';
+ @INC = ("../lib", "lib/compress");
+ }
+}
+
+use lib qw(t t/compress);
+use Test::More;
+eval "use Test::CPAN::Meta";
+plan skip_all => "Test::CPAN::Meta required for testing META.yml" if $@;
+meta_yaml_ok();
\ No newline at end of file
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
+#include <sys/types.h>
+#include <md5.h>
#ifdef __cplusplus
}
#endif
# define SvPVbyte(sv, lp) (sv_utf8_downgrade((sv), 0), SvPV((sv), (lp)))
#endif
-/* Perl does not guarantee that U32 is exactly 32 bits. Some system
- * has no integral type with exactly 32 bits. For instance, A Cray has
- * short, int and long all at 64 bits so we need to apply this macro
- * to reduce U32 values to 32 bits at appropriate places. If U32
- * really does have 32 bits then this is a no-op.
- */
-#if BYTEORDER > 0x4321 || defined(TRUNCATE_U32)
- #define TO32(x) ((x) & 0xFFFFffff)
- #define TRUNC32(x) ((x) &= 0xFFFFffff)
-#else
- #define TO32(x) (x)
- #define TRUNC32(x) /*nothing*/
-#endif
-
-/* The MD5 algorithm is defined in terms of little endian 32-bit
- * values. The following macros (and functions) allow us to convert
- * between native integers and such values.
- */
-static void u2s(U32 u, U8* s)
-{
- *s++ = (U8)(u & 0xFF);
- *s++ = (U8)((u >> 8) & 0xFF);
- *s++ = (U8)((u >> 16) & 0xFF);
- *s = (U8)((u >> 24) & 0xFF);
-}
-
-#define s2u(s,u) ((u) = (U32)(*s) | \
- ((U32)(*(s+1)) << 8) | \
- ((U32)(*(s+2)) << 16) | \
- ((U32)(*(s+3)) << 24))
-
-/* This structure keeps the current state of algorithm.
- */
-typedef struct {
- U32 A, B, C, D; /* current digest */
- U32 bytes_low; /* counts bytes in message */
- U32 bytes_high; /* turn it into a 64-bit counter */
- U8 buffer[128]; /* collect complete 64 byte blocks */
-} MD5_CTX;
-
#if defined(USE_ITHREADS) && defined(MGf_DUP)
STATIC int dup_md5_ctx(pTHX_ MAGIC *mg, CLONE_PARAMS *params)
{
};
#endif
-
-/* Padding is added at the end of the message in order to fill a
- * complete 64 byte block (- 8 bytes for the message length). The
- * padding is also the reason the buffer in MD5_CTX have to be
- * 128 bytes.
- */
-static const unsigned char PADDING[64] = {
- 0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
-};
-
-/* Constants for MD5Transform routine.
- */
-#define S11 7
-#define S12 12
-#define S13 17
-#define S14 22
-#define S21 5
-#define S22 9
-#define S23 14
-#define S24 20
-#define S31 4
-#define S32 11
-#define S33 16
-#define S34 23
-#define S41 6
-#define S42 10
-#define S43 15
-#define S44 21
-
-/* F, G, H and I are basic MD5 functions.
- */
-#define F(x, y, z) ((((x) & ((y) ^ (z))) ^ (z)))
-#define G(x, y, z) F(z, x, y)
-#define H(x, y, z) ((x) ^ (y) ^ (z))
-#define I(x, y, z) ((y) ^ ((x) | (~z)))
-
-/* ROTATE_LEFT rotates x left n bits.
- */
-#define ROTATE_LEFT(x, n) (((x) << (n) | ((x) >> (32-(n)))))
-
-/* FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4.
- * Rotation is separate from addition to prevent recomputation.
- */
-#define FF(a, b, c, d, s, ac) \
- (a) += F ((b), (c), (d)) + (NEXTx) + (U32)(ac); \
- TRUNC32((a)); \
- (a) = ROTATE_LEFT ((a), (s)); \
- (a) += (b); \
- TRUNC32((a));
-
-#define GG(a, b, c, d, x, s, ac) \
- (a) += G ((b), (c), (d)) + X[x] + (U32)(ac); \
- TRUNC32((a)); \
- (a) = ROTATE_LEFT ((a), (s)); \
- (a) += (b); \
- TRUNC32((a));
-
-#define HH(a, b, c, d, x, s, ac) \
- (a) += H ((b), (c), (d)) + X[x] + (U32)(ac); \
- TRUNC32((a)); \
- (a) = ROTATE_LEFT ((a), (s)); \
- (a) += (b); \
- TRUNC32((a));
-
-#define II(a, b, c, d, x, s, ac) \
- (a) += I ((b), (c), (d)) + X[x] + (U32)(ac); \
- TRUNC32((a)); \
- (a) = ROTATE_LEFT ((a), (s)); \
- (a) += (b); \
- TRUNC32((a));
-
-
-static void
-MD5Init(MD5_CTX *ctx)
-{
- /* Start state */
- ctx->A = 0x67452301;
- ctx->B = 0xefcdab89;
- ctx->C = 0x98badcfe;
- ctx->D = 0x10325476;
-
- /* message length */
- ctx->bytes_low = ctx->bytes_high = 0;
-}
-
-
-static void
-MD5Transform(MD5_CTX* ctx, const U8* buf, STRLEN blocks)
-{
-#ifdef MD5_DEBUG
- static int tcount = 0;
-#endif
-
- U32 A = ctx->A;
- U32 B = ctx->B;
- U32 C = ctx->C;
- U32 D = ctx->D;
-
- do {
- U32 a = A;
- U32 b = B;
- U32 c = C;
- U32 d = D;
-
- U32 X[16]; /* little-endian values, used in round 2-4 */
- U32 *uptr = X;
- U32 tmp;
- #define NEXTx (s2u(buf,tmp), buf += 4, *uptr++ = tmp)
-
-#ifdef MD5_DEBUG
- if (buf == ctx->buffer)
- fprintf(stderr,"%5d: Transform ctx->buffer", ++tcount);
- else
- fprintf(stderr,"%5d: Transform %p (%d)", ++tcount, buf, blocks);
-
- {
- int i;
- fprintf(stderr,"[");
- for (i = 0; i < 16; i++) {
- fprintf(stderr,"%x,", x[i]); /* FIXME */
- }
- fprintf(stderr,"]\n");
- }
-#endif
-
- /* Round 1 */
- FF (a, b, c, d, S11, 0xd76aa478); /* 1 */
- FF (d, a, b, c, S12, 0xe8c7b756); /* 2 */
- FF (c, d, a, b, S13, 0x242070db); /* 3 */
- FF (b, c, d, a, S14, 0xc1bdceee); /* 4 */
- FF (a, b, c, d, S11, 0xf57c0faf); /* 5 */
- FF (d, a, b, c, S12, 0x4787c62a); /* 6 */
- FF (c, d, a, b, S13, 0xa8304613); /* 7 */
- FF (b, c, d, a, S14, 0xfd469501); /* 8 */
- FF (a, b, c, d, S11, 0x698098d8); /* 9 */
- FF (d, a, b, c, S12, 0x8b44f7af); /* 10 */
- FF (c, d, a, b, S13, 0xffff5bb1); /* 11 */
- FF (b, c, d, a, S14, 0x895cd7be); /* 12 */
- FF (a, b, c, d, S11, 0x6b901122); /* 13 */
- FF (d, a, b, c, S12, 0xfd987193); /* 14 */
- FF (c, d, a, b, S13, 0xa679438e); /* 15 */
- FF (b, c, d, a, S14, 0x49b40821); /* 16 */
-
- /* Round 2 */
- GG (a, b, c, d, 1, S21, 0xf61e2562); /* 17 */
- GG (d, a, b, c, 6, S22, 0xc040b340); /* 18 */
- GG (c, d, a, b, 11, S23, 0x265e5a51); /* 19 */
- GG (b, c, d, a, 0, S24, 0xe9b6c7aa); /* 20 */
- GG (a, b, c, d, 5, S21, 0xd62f105d); /* 21 */
- GG (d, a, b, c, 10, S22, 0x2441453); /* 22 */
- GG (c, d, a, b, 15, S23, 0xd8a1e681); /* 23 */
- GG (b, c, d, a, 4, S24, 0xe7d3fbc8); /* 24 */
- GG (a, b, c, d, 9, S21, 0x21e1cde6); /* 25 */
- GG (d, a, b, c, 14, S22, 0xc33707d6); /* 26 */
- GG (c, d, a, b, 3, S23, 0xf4d50d87); /* 27 */
- GG (b, c, d, a, 8, S24, 0x455a14ed); /* 28 */
- GG (a, b, c, d, 13, S21, 0xa9e3e905); /* 29 */
- GG (d, a, b, c, 2, S22, 0xfcefa3f8); /* 30 */
- GG (c, d, a, b, 7, S23, 0x676f02d9); /* 31 */
- GG (b, c, d, a, 12, S24, 0x8d2a4c8a); /* 32 */
-
- /* Round 3 */
- HH (a, b, c, d, 5, S31, 0xfffa3942); /* 33 */
- HH (d, a, b, c, 8, S32, 0x8771f681); /* 34 */
- HH (c, d, a, b, 11, S33, 0x6d9d6122); /* 35 */
- HH (b, c, d, a, 14, S34, 0xfde5380c); /* 36 */
- HH (a, b, c, d, 1, S31, 0xa4beea44); /* 37 */
- HH (d, a, b, c, 4, S32, 0x4bdecfa9); /* 38 */
- HH (c, d, a, b, 7, S33, 0xf6bb4b60); /* 39 */
- HH (b, c, d, a, 10, S34, 0xbebfbc70); /* 40 */
- HH (a, b, c, d, 13, S31, 0x289b7ec6); /* 41 */
- HH (d, a, b, c, 0, S32, 0xeaa127fa); /* 42 */
- HH (c, d, a, b, 3, S33, 0xd4ef3085); /* 43 */
- HH (b, c, d, a, 6, S34, 0x4881d05); /* 44 */
- HH (a, b, c, d, 9, S31, 0xd9d4d039); /* 45 */
- HH (d, a, b, c, 12, S32, 0xe6db99e5); /* 46 */
- HH (c, d, a, b, 15, S33, 0x1fa27cf8); /* 47 */
- HH (b, c, d, a, 2, S34, 0xc4ac5665); /* 48 */
-
- /* Round 4 */
- II (a, b, c, d, 0, S41, 0xf4292244); /* 49 */
- II (d, a, b, c, 7, S42, 0x432aff97); /* 50 */
- II (c, d, a, b, 14, S43, 0xab9423a7); /* 51 */
- II (b, c, d, a, 5, S44, 0xfc93a039); /* 52 */
- II (a, b, c, d, 12, S41, 0x655b59c3); /* 53 */
- II (d, a, b, c, 3, S42, 0x8f0ccc92); /* 54 */
- II (c, d, a, b, 10, S43, 0xffeff47d); /* 55 */
- II (b, c, d, a, 1, S44, 0x85845dd1); /* 56 */
- II (a, b, c, d, 8, S41, 0x6fa87e4f); /* 57 */
- II (d, a, b, c, 15, S42, 0xfe2ce6e0); /* 58 */
- II (c, d, a, b, 6, S43, 0xa3014314); /* 59 */
- II (b, c, d, a, 13, S44, 0x4e0811a1); /* 60 */
- II (a, b, c, d, 4, S41, 0xf7537e82); /* 61 */
- II (d, a, b, c, 11, S42, 0xbd3af235); /* 62 */
- II (c, d, a, b, 2, S43, 0x2ad7d2bb); /* 63 */
- II (b, c, d, a, 9, S44, 0xeb86d391); /* 64 */
-
- A += a; TRUNC32(A);
- B += b; TRUNC32(B);
- C += c; TRUNC32(C);
- D += d; TRUNC32(D);
-
- } while (--blocks);
- ctx->A = A;
- ctx->B = B;
- ctx->C = C;
- ctx->D = D;
-}
-
-
-#ifdef MD5_DEBUG
-static char*
-ctx_dump(MD5_CTX* ctx)
-{
- static char buf[1024];
- sprintf(buf, "{A=%x,B=%x,C=%x,D=%x,%d,%d(%d)}",
- ctx->A, ctx->B, ctx->C, ctx->D,
- ctx->bytes_low, ctx->bytes_high, (ctx->bytes_low&0x3F));
- return buf;
-}
-#endif
-
-
-static void
-MD5Update(MD5_CTX* ctx, const U8* buf, STRLEN len)
-{
- STRLEN blocks;
- STRLEN fill = ctx->bytes_low & 0x3F;
-
-#ifdef MD5_DEBUG
- static int ucount = 0;
- fprintf(stderr,"%5i: Update(%s, %p, %d)\n", ++ucount, ctx_dump(ctx),
- buf, len);
-#endif
-
- ctx->bytes_low += len;
- if (ctx->bytes_low < len) /* wrap around */
- ctx->bytes_high++;
-
- if (fill) {
- STRLEN missing = 64 - fill;
- if (len < missing) {
- Copy(buf, ctx->buffer + fill, len, U8);
- return;
- }
- Copy(buf, ctx->buffer + fill, missing, U8);
- MD5Transform(ctx, ctx->buffer, 1);
- buf += missing;
- len -= missing;
- }
-
- blocks = len >> 6;
- if (blocks)
- MD5Transform(ctx, buf, blocks);
- if ( (len &= 0x3F)) {
- Copy(buf + (blocks << 6), ctx->buffer, len, U8);
- }
-}
-
-
-static void
-MD5Final(U8* digest, MD5_CTX *ctx)
-{
- STRLEN fill = ctx->bytes_low & 0x3F;
- STRLEN padlen = (fill < 56 ? 56 : 120) - fill;
- U32 bits_low, bits_high;
-#ifdef MD5_DEBUG
- fprintf(stderr," Final: %s\n", ctx_dump(ctx));
-#endif
- Copy(PADDING, ctx->buffer + fill, padlen, U8);
- fill += padlen;
-
- bits_low = ctx->bytes_low << 3;
- bits_high = (ctx->bytes_high << 3) | (ctx->bytes_low >> 29);
- u2s(bits_low, ctx->buffer + fill); fill += 4;
- u2s(bits_high, ctx->buffer + fill); fill += 4;
-
- MD5Transform(ctx, ctx->buffer, fill >> 6);
-#ifdef MD5_DEBUG
- fprintf(stderr," Result: %s\n", ctx_dump(ctx));
-#endif
-
- u2s(ctx->A, digest);
- u2s(ctx->B, digest+4);
- u2s(ctx->C, digest+8);
- u2s(ctx->D, digest+12);
-}
-
-#ifndef INT2PTR
-#define INT2PTR(any,d) (any)(d)
-#endif
-
static MD5_CTX* get_md5_ctx(pTHX_ SV* sv)
{
MAGIC *mg;
InputStream fh
PREINIT:
MD5_CTX* context = get_md5_ctx(aTHX_ self);
- STRLEN fill = context->bytes_low & 0x3F;
+ STRLEN fill = (context->count >> 3) & (MD5_BLOCK_LENGTH - 1);
#ifdef USE_HEAP_INSTEAD_OF_STACK
unsigned char* buffer;
#else
PPCODE:
if (items > 2) {
STRLEN len;
- unsigned long blocks = SvUV(ST(1));
+ ctx->count = SvUV(ST(1)) << 3;
unsigned char *buf = (unsigned char *)(SvPV(ST(2), len));
- ctx->A = buf[ 0] | (buf[ 1]<<8) | (buf[ 2]<<16) | (buf[ 3]<<24);
- ctx->B = buf[ 4] | (buf[ 5]<<8) | (buf[ 6]<<16) | (buf[ 7]<<24);
- ctx->C = buf[ 8] | (buf[ 9]<<8) | (buf[10]<<16) | (buf[11]<<24);
- ctx->D = buf[12] | (buf[13]<<8) | (buf[14]<<16) | (buf[15]<<24);
- ctx->bytes_low = blocks << 6;
- ctx->bytes_high = blocks >> 26;
+ ctx->state[0] = buf[ 0] | (buf[ 1]<<8) | (buf[ 2]<<16) | (buf[ 3]<<24);
+ ctx->state[1] = buf[ 4] | (buf[ 5]<<8) | (buf[ 6]<<16) | (buf[ 7]<<24);
+ ctx->state[2] = buf[ 8] | (buf[ 9]<<8) | (buf[10]<<16) | (buf[11]<<24);
+ ctx->state[3] = buf[12] | (buf[13]<<8) | (buf[14]<<16) | (buf[15]<<24);
if (items == 4) {
buf = (unsigned char *)(SvPV(ST(3), len));
MD5Update(ctx, buf, len);
XSRETURN(0);
}
- w=ctx->A; out[ 0]=(char)w; out[ 1]=(char)(w>>8); out[ 2]=(char)(w>>16); out[ 3]=(char)(w>>24);
- w=ctx->B; out[ 4]=(char)w; out[ 5]=(char)(w>>8); out[ 6]=(char)(w>>16); out[ 7]=(char)(w>>24);
- w=ctx->C; out[ 8]=(char)w; out[ 9]=(char)(w>>8); out[10]=(char)(w>>16); out[11]=(char)(w>>24);
- w=ctx->D; out[12]=(char)w; out[13]=(char)(w>>8); out[14]=(char)(w>>16); out[15]=(char)(w>>24);
+ w=ctx->state[0]; out[ 0]=(char)w; out[ 1]=(char)(w>>8); out[ 2]=(char)(w>>16); out[ 3]=(char)(w>>24);
+ w=ctx->state[0]; out[ 4]=(char)w; out[ 5]=(char)(w>>8); out[ 6]=(char)(w>>16); out[ 7]=(char)(w>>24);
+ w=ctx->state[0]; out[ 8]=(char)w; out[ 9]=(char)(w>>8); out[10]=(char)(w>>16); out[11]=(char)(w>>24);
+ w=ctx->state[0]; out[12]=(char)w; out[13]=(char)(w>>8); out[14]=(char)(w>>16); out[15]=(char)(w>>24);
EXTEND(SP, 3);
- ST(0) = sv_2mortal(newSVuv(ctx->bytes_high << 26 |
- ctx->bytes_low >> 6));
+ ST(0) = sv_2mortal(newSViv((ctx->count >> 3)
+ - ((ctx->count >> 3) % MD5_BLOCK_LENGTH)));
ST(1) = sv_2mortal(newSVpv(out, 16));
- if ((ctx->bytes_low & 0x3F) == 0)
- XSRETURN(2);
+ if (((ctx->count >> 3) & (MD5_BLOCK_LENGTH - 1)) == 0)
+ XSRETURN(2);
ST(2) = sv_2mortal(newSVpv((char *)ctx->buffer,
- ctx->bytes_low & 0x3F));
+ (ctx->count >> 3) & (MD5_BLOCK_LENGTH - 1)));
+
XSRETURN(3);
void
# This is the output of: 'md5sum README MD5.xs rfc1321.txt'
$EXPECT = <<EOT;
2f93400875dbb56f36691d5f69f3eba5 README
-3fce99bf3f4df26d65843a6990849df0 MD5.xs
+5956d385c276e47faebef391177ee1d3 MD5.xs
754b9db19f79dbc4992f7166eb0f37ce rfc1321.txt
EOT
}
$ENV{MAKEFLAGS} =~ /\b(s|silent|quiet)\b/);
my $Curdir = File::Spec->curdir;
+my $Perm_Dir = $ENV{PERL_CORE} ? 0770 : 0755;
sub _estr(@) {
return join "\n",'!' x 72,@_,'!' x 72,'';
_chdir($cwd);
}
foreach my $targetdir (sort keys %check_dirs) {
- _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
+ _mkpath( $targetdir, 0, $Perm_Dir, $verbose, $dry_run );
}
foreach my $found (@found_files) {
my ($diff, $ffd, $origfile, $mode, $size, $atime, $mtime,
$targetfile= _unlink_or_rename( $targetfile, 'tryhard', 'install' )
unless $dry_run;
} elsif ( ! -d $targetdir ) {
- _mkpath( $targetdir, 0, 0755, $verbose, $dry_run );
+ _mkpath( $targetdir, 0, $Perm_Dir, $verbose, $dry_run );
}
print "Installing $targetfile\n";
if ($pack{'write'}) {
$dir = install_rooted_dir(dirname($pack{'write'}));
- _mkpath( $dir, 0, 0755, $verbose, $dry_run );
+ _mkpath( $dir, 0, $Perm_Dir, $verbose, $dry_run );
print "Writing $pack{'write'}\n" if $verbose;
$packlist->write(install_rooted_file($pack{'write'})) unless $dry_run;
}
my($fromto,$autodir,$pm_filter) = @_;
my %dirs;
- _mkpath($autodir,0,0755) if defined $autodir;
+ _mkpath($autodir,0,$Perm_Dir) if defined $autodir;
while(my($from, $to) = each %$fromto) {
if( -f $to && -s $from == -s $to && -M $to < -M $from ) {
print "Skip $to (unchanged)\n" unless $INSTALL_QUIET;
} else {
my $dirname = dirname($to);
if (!$dirs{$dirname}++) {
- _mkpath($dirname,0,0755);
+ _mkpath($dirname,0,$Perm_Dir);
}
}
if ($need_filtering) {
sub init_PERM {
my($self) = shift;
- $self->{PERM_DIR} = 755 unless defined $self->{PERM_DIR};
+ my $perm_dir = $self->{PERL_CORE} ? 770 : 755;
+ $self->{PERM_DIR} = $perm_dir unless defined $self->{PERM_DIR};
$self->{PERM_RW} = 644 unless defined $self->{PERM_RW};
$self->{PERM_RWX} = 755 unless defined $self->{PERM_RWX};
my $path = shift;
return undef
- if $path =~ /(~|\.bak|_bak)$/ ||
+ if $path =~ /^(?:RCS|CVS|SCCS|\.svn|_darcs)$/ ||
+ $path =~ /(~|\.bak|_bak)$/ ||
$path =~ /\..*\.sw(o|p)$/ ||
$path =~ /\B\.svn\b/;
$extra = 1
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
- plan tests => 355 + $extra ;
+ plan tests => 390 + $extra ;
}
$self->opt_M_with('Pod::Perldoc::ToPod'); # the always-there fallthru
$self->opt_o_with('text');
+ $self->opt_o_with('man')
+ if $ENV{TERM} && $ENV{TERM} !~ /dumb|emacs|none|unknown/i;
return;
}
#
# See RT #77465
#
- #push @switches, 'utf8' => 1;
+ # Then again, do *not* comment it out on OpenBSD:
+ # mandoc handles UTF-8 input just fine.
+ push @switches, 'utf8' => 1;
$self->debug( "Pod::Man switches are [@switches]\n" );
$version ge $minimum_groff_version;
}
-sub _have_mandoc_with_utf8 {
- my( $self ) = @_;
-
- $self->_is_mandoc and not system 'mandoc -Tlocale -V > /dev/null 2>&1';
- }
-
sub _collect_nroff_switches {
my( $self ) = shift;
push @render_switches, '-rLL=' . (int $c) . 'n' if $cols > 80;
}
+ if( $self->_is_mandoc ) {
+ push @render_switches, '-Owidth=' . $self->_get_columns;
+ }
+
# I hear persistent reports that adding a -c switch to $render
# solves many people's problems. But I also hear that some mans
# don't have a -c switch, so that unconditionally adding it here
if( $self->_is_nroff ) { qw() }
elsif( $self->_have_groff_with_utf8 ) { qw(-Kutf8 -Tutf8) }
elsif( $self->_is_ebcdic ) { qw(-Tcp1047) }
- elsif( $self->_have_mandoc_with_utf8 ) { qw(-Tlocale) }
elsif( $self->_is_mandoc ) { qw() }
else { qw(-Tlatin1) }
}
length $done
);
+ # wait for it to exit
+ waitpid( $pid, 0 );
+
if( $? ) {
$self->warn( "Error from pipe to $render!\n" );
$self->debug( 'Error: ' . do { local $/; <$err> } );
}
# create a lib/ dir in order to avoid warnings in Test::Distribution
-mkdir "lib", 0755;
+mkdir "lib", $ENV{PERL_CORE} ? 0770 : 0755;
# virtual paths given to EU::MM
my %virtual_path = ( 'Syslog.pm' => '$(INST_LIBDIR)/Syslog.pm' );
$cut = $i + 1;
$cut++ if ($dirs[$i + 1] && $dirs[$i + 1] eq 'lib');
last;
+ } elsif ($dirs[$i] eq 'lib' && $dirs[$i + 1] && $dirs[0] eq 'ext') {
+ $cut = $i + 1;
}
}
if ($cut > 0) {
# Parse our options, trying to retain backward compatibility with pod2man but
# allowing short forms as well. --lax is currently ignored.
my %options;
+$options{utf8} = 1;
Getopt::Long::config ('bundling_override');
GetOptions (\%options, 'center|c=s', 'date|d=s', 'errors=s', 'fixed=s',
'fixedbold=s', 'fixeditalic=s', 'fixedbolditalic=s', 'help|h',
'lax|l', 'lquote=s', 'name|n=s', 'nourls', 'official|o',
'quotes|q=s', 'release|r=s', 'rquote=s', 'section|s=s', 'stderr',
- 'verbose|v', 'utf8|u')
+ 'verbose|v', 'utf8|u!')
or exit 1;
pod2usage (0) if $options{help};
__END__
=for stopwords
-en em --stderr stderr --utf8 UTF-8 overdo markup MT-LEVEL Allbery Solaris URL
+en em --stderr stderr --no-utf8 UTF-8 overdo markup MT-LEVEL Allbery Solaris URL
troff troff-specific formatters uppercased Christiansen --nourls UTC prepend
lquote rquote
[B<--fixedbolditalic>=I<font>] [B<--name>=I<name>] [B<--nourls>]
[B<--official>] [B<--release>=I<version>] [B<--section>=I<manext>]
[B<--quotes>=I<quotes>] [B<--lquote>=I<quote>] [B<--rquote>=I<quote>]
- [B<--stderr>] [B<--utf8>] [B<--verbose>] [I<input> [I<output>] ...]
+ [B<--stderr>] [B<--no-utf8>] [B<--verbose>] [I<input> [I<output>] ...]
pod2man B<--help>
=item B<-u>, B<--utf8>
-By default, B<pod2man> produces the most conservative possible *roff
-output to try to ensure that it will work with as many different *roff
-implementations as possible. Many *roff implementations cannot handle
-non-ASCII characters, so this means all non-ASCII characters are converted
-either to a *roff escape sequence that tries to create a properly accented
-character (at least for troff output) or to C<X>.
-
-This option says to instead output literal UTF-8 characters. If your
-*roff implementation can handle it, this is the best output format to use
-and avoids corruption of documents containing non-ASCII characters.
-However, be warned that *roff source with literal UTF-8 characters is not
-supported by many implementations and may even result in segfaults and
-other bad behavior.
+This option allows B<pod2man> to output literal UTF-8 characters.
+On OpenBSD, it is enabled by default and can be disabled with
+B<--no-utf8>, in which case non-ASCII characters are converted
+either to *roff escape sequences or to C<X>.
Be aware that, when using this option, the input encoding of your POD
source should be properly declared unless it's US-ASCII. Pod::Simple will
skip "no Socket::SO_PROTOCOL", 1 if !defined(eval { Socket::SO_PROTOCOL });
skip "SO_PROTOCOL defined but not implemented", 1
if !defined $new->sockopt(Socket::SO_PROTOCOL);
+ skip "SO_PROTOCOL returns chosen protocol on OpenBSD", 1
+ if $^O eq 'openbsd';
is($new->protocol(), $p, 'protocol match');
}
SKIP: {
print "# Looping for $busycount iterations should take about 0.025s\n";
}
- my $TIMEOUT = 60;
+ my $TIMEOUT = 600;
my $mutex = 1;
share($mutex);
use ExtUtils::MakeMaker;
WriteMakefile(
NAME => 'NDBM_File',
- LIBS => ["-L/usr/local/lib -lndbm", "-ldbm -lucb"],
+ #LIBS => ["-L/usr/local/lib -lndbm", "-ldbm -lucb"],
XSPROTOARG => '-noprototypes', # XXX remove later?
VERSION_FROM => 'NDBM_File.pm',
);
d_setruid=$undef
esac
+# OpenBSD 5.5 on has 64 bit time_t
+case "$osvers" in
+[0-4].*|5.[0-4]) ;;
+*)
+ cppflags="$cppflags -DBIG_TIME"
+ ;;
+esac
+
#
# Not all platforms support dynamic loading...
# For the case of "$openbsd_distribution", the hints file
test -z "$usedl" && usedl=$define
# We use -fPIC here because -fpic is *NOT* enough for some of the
# extensions like Tk on some OpenBSD platforms (ie: sparc)
- cccdlflags="-DPIC -fPIC $cccdlflags"
+ PICFLAG=-fPIC
+ if [ -e /usr/share/mk/bsd.own.mk ]; then
+ PICFLAG=`make -f /usr/share/mk/bsd.own.mk -V PICFLAG`
+ fi
+ cccdlflags="-DPIC ${PICFLAG} $cccdlflags"
case "$osvers" in
[01].*|2.[0-7]|2.[0-7].*)
lddlflags="-Bshareable $lddlflags"
;;
*) # from 3.1 onwards
ld=${cc:-cc}
- lddlflags="-shared -fPIC $lddlflags"
+ lddlflags="-shared ${PICFLAG} $lddlflags"
libswanted=`echo $libswanted | sed 's/ dl / /'`
;;
esac
# around for old NetBSD binaries.
libswanted=`echo $libswanted | sed 's/ crypt / /'`
+# OpenBSD hasn't ever needed linking to libutil
+libswanted=`echo $libswanted | sed 's/ util / /'`
+
# Configure can't figure this out non-interactively
d_suidsafe=$define
;;
esac
+#
+# Unaligned access on alpha with -ftree-ter
+# http://gcc.gnu.org/bugzilla/show_bug.cgi?id=59679
+# More details
+# https://rt.perl.org/Public/Bug/Display.html?id=120888
+#
+case "${ARCH}-${osvers}" in
+ alpha-*)
+ ccflags="-fno-tree-ter $ccflags"
+ ;;
+esac
+
+# Special per-arch specific ccflags
+case "${ARCH}-${osvers}" in
+ vax-*)
+ ccflags="-DUSE_PERL_ATOF=0 $ccflags"
+ ;;
+esac
+
# This script UU/usethreads.cbu will get 'called-back' by Configure
# after it has prompted the user for whether to use threads.
cat > UU/usethreads.cbu <<'EOCBU'
# Broken up to OpenBSD 3.6, fixed in OpenBSD 3.7
d_getservbyname_r=$undef ;;
esac
+ ;;
+*)
+ libswanted=`echo $libswanted | sed 's/ pthread / /'`
esac
EOCBU
siteprefix='/usr/local'
siteprefixexp='/usr/local'
# Ports installs non-std libs in /usr/local/lib so look there too
- locincpth='/usr/local/include'
- loclibpth='/usr/local/lib'
+ locincpth=''
+ loclibpth=''
# Link perl with shared libperl
- if [ "$usedl" = "$define" -a -r shlib_version ]; then
+ if [ "$usedl" = "$define" -a -r $src/shlib_version ]; then
useshrplib=true
- libperl=`. ./shlib_version; echo libperl.so.${major}.${minor}`
+ libperl=`. $src/shlib_version; echo libperl.so.${major}.${minor}`
fi
;;
esac
# which is being fixed. In the meantime, forbid POSIX 2008 locales
d_newlocale="$undef"
+# OpenBSD's locale support is not that complete yet
+ccflags="-DNO_LOCALE_NUMERIC -DNO_LOCALE_COLLATE $ccflags"
+
# Seems that OpenBSD returns bogus values in _Thread_local variables in code in
# shared objects, so we need to disable it. See GH #19109
d_thread_local=undef
use strict;
use vars qw($Is_VMS $Is_W32 $Is_OS2 $Is_Cygwin $Is_Darwin $Is_AmigaOS
%opts $packlist);
-use subs qw(unlink link chmod);
+use subs qw(unlink link chmod chown);
require File::Path;
require File::Copy;
unless -f $to and (chmod(0666, $to), unlink $to)
and File::Copy::copy($from, $to) and ++$success;
}
+ if (defined($opts{uid}) || defined($opts{gid})) {
+ chown($opts{uid}, $opts{gid}, $to) if $success;
+ }
$packlist->{$xto} = { type => 'file' };
}
$success;
unless $opts{notify};
}
+sub chown {
+ my($uid,$gid,$name) = @_;
+
+ return if ($^O eq 'dos');
+ printf " chown %s:%s %s\n", $uid, $gid, $name if $opts{verbose};
+ CORE::chown($uid,$gid,$name)
+ || warn sprintf("Couldn't chown %s:%s %s: $!\n", $uid, $gid, $name)
+ unless $opts{notify};
+}
+
sub samepath {
my($p1, $p2) = @_;
}
sub mkpath {
- File::Path::mkpath(shift , $opts{verbose}, 0777) unless $opts{notify};
+ File::Path::make_path(shift, {owner=>$opts{uid}, group=>$opts{gid},
+ mode=>0777, verbose=>$opts{verbose}}) unless $opts{notify};
}
sub unixtoamiga
my $usage = 0;
if (!GetOptions(\%opts, 'notify|n', 'strip|s', 'silent|S',
'skip-otherperls|o', 'force|f', 'verbose|V', 'archname|A',
- 'nopods|p', 'destdir:s', 'help|h|?',
+ 'nopods|p', 'destdir:s', 'help|h|?', 'user|u:s', 'group|g:s',
'versiononly|v' => \$versiononly, '<>' => sub {
if ($_[0] eq '+v') {
$versiononly = 0;
-A Also install perl with the architecture's name in the perl binary's
name.
-p Don't install the pod files. [This will break use diagnostics;]
+ -g group install files with the specified group
+ -u user install files with the specified user
-destdir Prefix installation directories by this string.
-h Display this help message.
EOT
exit $usage;
}
}
+$opts{'uid'} = getpwnam($opts{'user'}) if exists($opts{'user'});
+$opts{'gid'} = getgrnam($opts{'group'}) if exists($opts{'group'});
$versiononly = 1 if $Config{versiononly} && !defined $versiononly;
my (@scripts, @tolink);
}
# Exclude nonxs extensions that are not architecture dependent
-my @nonxs = grep(!/^Errno$/, split(' ', $Config{'nonxs_ext'}));
+my @nonxs = grep(!/^(Errno|IO\/Compress)$/, split(' ', $Config{'nonxs_ext'}));
my @ext_dirs = qw(cpan dist ext);
foreach my $ext_dir (@ext_dirs) {
my $installarchlib = "$opts{destdir}$Config{installarchlib}";
my $installsitelib = "$opts{destdir}$Config{installsitelib}";
my $installsitearch = "$opts{destdir}$Config{installsitearch}";
-my $installman1dir = "$opts{destdir}$Config{installman1dir}";
+my $installman1dir = "none";
my $man1ext = $Config{man1ext};
my $libperl = $Config{libperl};
# Shared library and dynamic loading suffixes.
$installbin || die "No installbin directory in config.sh\n";
-d $installbin || mkpath($installbin);
-d $installbin || $opts{notify} || die "$installbin is not a directory\n";
--w $installbin || $opts{notify} || die "$installbin is not writable by you\n"
- unless $installbin =~ m#^/afs/# || $opts{notify};
if (!$Is_VMS) {
-x 'perl' . $exe_ext || die "perl isn't executable!\n";
}
}
--f 't/rantests' || $Is_W32
- || warn "WARNING: You've never run 'make test' or",
- " some tests failed! (Installing anyway.)\n";
+#-f 't/rantests' || $Is_W32
+# || warn "WARNING: You've never run 'make test' or",
+# " some tests failed! (Installing anyway.)\n";
# This will be used to store the packlist
$packlist = ExtUtils::Packlist->new("$installarchlib/.packlist");
$packlist->{"$Config{installbin}/$perldll"} = { type => 'file' };
} # if ($Is_W32 or $Is_Cygwin)
+# Get the install command and flags from the environment
+my @installcmd = $ENV{"INSTALL"} || "install";
+push(@installcmd, $ENV{"INSTALL_COPY"} || "-c");
+
# First we install the version-numbered executables.
if ($Is_VMS) {
}
}
else {
- safe_unlink("$installbin/$perl_verbase$ver$exe_ext");
- copy("perl$exe_ext", "$installbin/$perl_verbase$ver$exe_ext");
- strip("$installbin/$perl_verbase$ver$exe_ext");
- fix_dep_names("$installbin/$perl_verbase$ver$exe_ext");
- chmod(0755, "$installbin/$perl_verbase$ver$exe_ext");
+ my $ver = ''; # don't install a versioned perl binary
+ install("perl$exe_ext", "$installbin/$perl_verbase$ver$exe_ext", "0755");
`chtag -r "$installbin/$perl_verbase$ver$exe_ext"` if ($^O eq 'os390');
}
@corefiles = <*.h>;
} else {
# [als] hard-coded 'libperl' name... not good!
- @corefiles = <*.h libperl*.* perl*$Config{lib_ext}>;
+ #@corefiles = <*.h libperl*.* perl*$Config{lib_ext}>;
+ @corefiles = <*.h *.inc perl*$Config{lib_ext}>;
+ install($libperl, "$opts{destdir}$Config{glibpth}/$libperl", "0444");
# AIX needs perl.exp installed as well.
push(@corefiles,'perl.exp') if $^O eq 'aix';
# Install main perl executables
# Make links to ordinary names if installbin directory isn't current directory.
-if (! $versiononly && ! samepath($installbin, '.') && ! $Is_VMS) {
+if (0) { # don't install a versioned perl binary
+#if (! $versiononly && ! samepath($installbin, '.') && ! $Is_VMS) {
safe_unlink("$installbin/$perl$exe_ext", "$installbin/suid$perl$exe_ext");
if ($^O eq 'vos') {
# VOS doesn't support hard links, so use a symlink.
$packlist->write() unless $opts{notify};
+if (defined($opts{uid}) || defined($opts{gid})) {
+ chown($opts{uid}, $opts{gid}, $packlist->packlist_file());
+}
print " Installation complete\n" if $opts{verbose};
exit 0;
sub copy {
my($from,$to) = @_;
+ my($success) = 0;
my $xto = $to;
$xto =~ s/^\Q$opts{destdir}\E//;
unless $opts{silent};
print " creating new version of $xto\n"
if $Is_VMS and -e $to and !$opts{silent};
- unless ($opts{notify} or File::Copy::copy($from, $to)) {
+ unless ($opts{notify} or File::Copy::copy($from, $to) and ++$success) {
# Might have been that F::C::c can't overwrite the target
warn "Couldn't copy $from to $to: $!\n"
unless -f $to and (chmod(0666, $to), unlink $to)
- and File::Copy::copy($from, $to);
+ and File::Copy::copy($from, $to) and ++$success;
}
+ if (defined($opts{uid}) || defined($opts{gid})) {
+ chown($opts{uid}, $opts{gid}, $to) if $success;
+ }
+ $packlist->{$xto} = { type => 'file' };
+}
+
+sub install {
+ my($from,$to,$mode) = @_;
+
+ my $xto = $to;
+ my $cmd = join(' ', @installcmd);
+ $cmd .= " -m $mode" if $mode;
+ $cmd .= " -s" if $opts{strip};
+ $cmd .= " -o $opts{uid}" if defined($opts{uid});
+ $cmd .= " -g $opts{gid}" if defined($opts{gid});
+ $cmd .= " $from $to";
+ $xto =~ s/^\Q$opts{destdir}\E// if $opts{destdir};
+ print $opts{verbose} ? " install $from $xto\n" : " $xto\n" unless $opts{silent};
+ system($cmd);
+ warn "Couldn't $cmd\n" if $?;
$packlist->{$xto} = { type => 'file' };
}
return;
}
+ # If we have different install version, install that instead
+ return if -e "$_.install";
+ $name =~ s/\.install$//;
+
# ignore patch backups, RCS files, emacs backup & temp files and the
# .exists files, .PL files, and test files.
return if $name =~ m{\.orig$|\.rej$|~$|^#.+#$|,v$|^\.exists|\.PL$|\.plc$|\.t$|^test\.pl$|^dbm_filter_util\.pl$|^filter-util\.pl$|^uupacktool\.pl$|^\.gitignore$} ||
AnyDBM_File - provide framework for multiple DBMs
-NDBM_File, DB_File, GDBM_File, SDBM_File, ODBM_File - various DBM implementations
-
=head1 SYNOPSIS
use AnyDBM_File;
@old_watch,
);
+sub _DB__use_full_path
+{
+ # If running in the perl test suite, don't use old system libs
+ return &{$_[0]} if $ENV{PERL_CORE};
+ local @INC = @INC;
+ eval { require Config; };
+ unshift(@INC,
+ @Config::Config{qw(archlibexp privlibexp sitearchexp sitelibexp)});
+ &{$_[0]};
+}
+
sub _DB__determine_if_we_should_break
{
# if we have something here, see if we should break.
if (!eval {
local @INC = @INC;
pop @INC if $INC[-1] eq '.';
- require PadWalker; PadWalker->VERSION(0.08) }) {
+ _DB__use_full_path(sub {
+ require PadWalker;
+ });
+ PadWalker->VERSION(0.08) }) {
my $Err = $@;
_db_warn(
$Err =~ /locate/
use vars qw($ornaments);
use vars qw($rl_attribs);
-
sub setterm {
# Load Term::Readline, but quietly; don't debug it and don't trace it.
local $frame = 0;
local $doret = -2;
- require Term::ReadLine;
+ _DB__use_full_path(sub {
+ require Term::ReadLine;
+ });
+
# If noTTY is set, but we have a TTY name, go ahead and hook up to it.
if ($notty) {
# We need $term defined or we can not switch to the newly created xterm
if ($tty ne '' && !defined $term) {
- require Term::ReadLine;
+ _DB__use_full_path(sub {
+ require Term::ReadLine;
+ });
if ( !$rl ) {
$term = Term::ReadLine::Stub->new( 'perldb', $IN, $OUT );
}
return if $skipCvGV; # Backdoor to avoid problems if XS broken...
return unless ref $in;
$in = \&$in; # Hard reference...
- eval { require Devel::Peek; 1 } or return;
+ eval { _DB__use_full_path(sub { require Devel::Peek; 1; }); } or return;
my $gv = Devel::Peek::CvGV($in) or return;
*$gv{PACKAGE} . '::' . *$gv{NAME};
} ## end sub CvGV_name_or_bust
PERL_STATIC_INLINE NV
S_strtod(pTHX_ const char * const s, char ** e)
{
- DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
NV result;
+ DECLARATION_FOR_LC_NUMERIC_MANIPULATION;
STORE_LC_NUMERIC_SET_TO_NEEDED();
# endif
#endif
+#undef PERL_BUILD_DATE
+
#ifdef PERL_BUILD_DATE
PUSHs(Perl_newSVpvn_flags(aTHX_
STR_WITH_LEN("Compiled at " PERL_BUILD_DATE),
Or, you can combine this step with the next to save disk space:
- gzip -dc yourmodule.tar.gz | tar -xof -
+ gzip -dc yourmodule.tar.gz | tar -xf -
B. UNPACK
-Unpack the result with C<tar -xof yourmodule.tar>
+Unpack the result with C<tar -xf yourmodule.tar>
C. BUILD
die "p5p-controlled module $filename missing =head1 NAME\n"
if $filename !~ m{^(dist/|cpan/)}n # under our direct control
&& $filename !~ m{/_[^/]+\z} # not private
+ && $filename !~ m{/unicore/} # not unicore
&& $filename ne 'lib/meta_notation.pm' # no pod
&& $filename ne 'lib/overload/numbers.pm'; # no pod
warn "$filename missing =head1 NAME\n" unless $Quiet;
C<"\015">. If you get in the habit of using C<"\n"> for networking,
you may be burned some day.
X<newline> X<line terminator> X<eol> X<end of line>
-X<\n> X<\r> X<\r\n>
+X<\r>
For constructs that do interpolate, variables beginning with "C<$>"
or "C<@>" are interpolated. Subscripted variables such as C<$a[3]> or
"Integer overflow in srand");
anum = UV_MAX;
}
+ (void)srand48_deterministic((Rand_seed_t)anum);
}
else {
anum = seed();
+ (void)seedDrand01((Rand_seed_t)anum);
}
- (void)seedDrand01((Rand_seed_t)anum);
PL_srand_called = TRUE;
if (anum)
XPUSHu(anum);
assert(!frame);
DEBUG_STUDYDATA("pre-fin", data, depth, is_inf, min, stopmin, delta);
+ /* is this pattern infinite? Eg, consider /(a|b+)/ */
+ if (is_inf_internal)
+ delta = OPTIMIZE_INFTY;
+
+ /* deal with (*ACCEPT), Eg, consider /(foo(*ACCEPT)|bop)bar/ */
if (min > stopmin) {
- /* stopmin might be shorter than min if we saw an (*ACCEPT). If
- this is the case then it means this pattern is variable length
- and we need to ensure that the delta accounts for it. delta
- represents the difference between min length and max length for
- this part of the pattern. */
- delta += min - stopmin;
+ /*
+ At this point 'min' represents the minimum length string we can
+ match while *ignoring* the implication of ACCEPT, and 'delta'
+ represents the difference between the minimum length and maximum
+ length, and if the pattern matches an infinitely long string
+ (consider the + and * quantifiers) then we use the special delta
+ value of OPTIMIZE_INFTY to represent it. 'stopmin' is the
+ minimum length that can be matched *and* accepted.
+
+ A pattern is accepted when matching was successful *and*
+ complete, and thus there is no further matching needing to be
+ done, no backtracking to occur, etc. Prior to the introduction
+ of ACCEPT the only opcode that signaled acceptance was the END
+ opcode, which is always the very last opcode in a regex program.
+ ACCEPT is thus conceptually an early successful return out of
+ the matching process. stopmin starts out as OPTIMIZE_INFTY to
+ represent "the entire pattern", and is ratched down to the
+ "current min" if necessary when an ACCEPT opcode is encountered.
+
+ Thus stopmin might be smaller than min if we saw an (*ACCEPT),
+ and we now need to account for it in both min and delta.
+ Consider that in a pattern /AB/ normally the min length it can
+ match can be computed as min(A)+min(B). But (*ACCEPT) means
+ that it might be something else, not even neccesarily min(A) at
+ all. Consider
+
+ A = /(foo(*ACCEPT)|x+)/
+ B = /whop/
+ AB = /(foo(*ACCEPT)|x+)whop/
+
+ The min for A is 1 for "x" and the delta for A is OPTIMIZE_INFTY
+ for "xxxxx...", its stopmin is 3 for "foo". The min for B is 4 for
+ "whop", and the delta of 0 as the pattern is of fixed length, the
+ stopmin would be OPTIMIZE_INFTY as it does not contain an ACCEPT.
+ When handling AB we expect to see a min of 5 for "xwhop", and a
+ delta of OPTIMIZE_INFTY for "xxxxx...whop", and a stopmin of 3
+ for "foo". This should result in a final min of 3 for "foo", and
+ a final delta of OPTIMIZE_INFTY for "xxxxx...whop".
+
+ In something like /(dude(*ACCEPT)|irk)x{3,7}/ we would have a
+ min of 6 for "irkxxx" and a delta of 4 for "irkxxxxxxx", and the
+ stop min would be 4 for "dude". This should result in a final
+ min of 4 for "dude", and a final delta of 6, for "irkxxxxxxx".
+
+ When min is smaller than stopmin then we can ignore it. In the
+ fragment /(x{10,20}(*ACCEPT)|a)b+/, we would have a min of 2,
+ and a delta of OPTIMIZE_INFTY, and a stopmin of 10. Obviously
+ the ACCEPT doesn't reduce the minimum length of the string that
+ might be matched, nor affect the maximum length.
+
+ In something like /foo(*ACCEPT)ba?r/ we would have a min of 5
+ for "foobr", a delta of 1 for "foobar", and a stopmin of 3 for
+ "foo". We currently turn this into a min of 3 for "foo" and a
+ delta of 3 for "foobar" even though technically "foobar" isn't
+ possible. ACCEPT affects some aspects of the optimizer, like
+ length computations and mandatory substring optimizations, but
+ there are other optimzations this routine perfoms that are not
+ affected and this compromise simplifies implementation.
+
+ It might be helpful to consider that this C function is called
+ recursively on the pattern in a bottom up fashion, and that the
+ min returned by a nested call may be marked as coming from an
+ ACCEPT, causing its callers to treat the returned min as a
+ stopmin as the recursion unwinds. Thus a single ACCEPT can affect
+ multiple calls into this function in different ways.
+ */
+
+ if (OPTIMIZE_INFTY - delta >= min - stopmin)
+ delta += min - stopmin;
+ else
+ delta = OPTIMIZE_INFTY;
min = stopmin;
}
*scanp = scan;
- *deltap = is_inf_internal ? OPTIMIZE_INFTY : delta;
+ *deltap = delta;
if (flags & SCF_DO_SUBSTR && is_inf)
data->pos_delta = OPTIMIZE_INFTY - data->pos_min;
}
/* add a data member to the struct reg_data attached to this regex, it should
- * always return a non-zero return */
+ * always return a non-zero return. the 's' argument is the type of the items
+ * being added and the n is the number of items. The length of 's' should match
+ * the number of items. */
STATIC U32
S_add_data(RExC_state_t* const pRExC_state, const char* const s, const U32 n)
{
/* this is where the old regcomp.h started */
+
+/* Define the various regnode structures. These all should be a multiple
+ * of 32 bits large, and they should by and large correspond with each other
+ * in terms of naming, etc. Things can and will break in subtle ways if you
+ * change things without care. If you look at regexp.h you will see it
+ * contains this:
+ *
+ * struct regnode {
+ * U8 flags;
+ * U8 type;
+ * U16 next_off;
+ * };
+ *
+ * This structure is the base unit of elements in the regexp program. When
+ * we increment our way through the program we increment by the size of this
+ * structure, and in all cases where regnode sizing is considered it is in
+ * units of this structure.
+ *
+ * This implies that no regnode style structure should contain 64 bit
+ * aligned members. Since the base regnode is 32 bits any member might
+ * not be 64 bit aligned no matter how you might try to pad out the
+ * struct itself (the regnode_ssc is special in this regard as it is
+ * never used in a program directly). If you want to store 64 bit
+ * members you need to store them specially. The struct regnode_p and the
+ * ARGp() and ARGp_SET() macros and related inline functions provide an example
+ * solution. Note they deal with a slightly more complicated problem than simple
+ * alignment, as pointers may be 32 bits or 64 bits depending on platform,
+ * but they illustrate the pattern to follow if you want to put a 64 bit value
+ * into a regnode.
+
+ * NOTE: Ideally we do not put pointers into the regnodes in a program. Instead
+ * we put them in the "data" part of the regexp structure and store the index into
+ * the data in the pointers in the regnode. This allows the pointer to be handled
+ * properly during clone/free operations (eg refcount bookkeeping). See S_add_data(),
+ * Perl_regdupe_internal(), Perl_regfree_internal() in regcomp.c for how the data
+ * array can be used, the letters 'arsSu' all refer to different types of SV that
+ * we already have support for in the data array.
+ */
+
struct regnode_string {
U8 str_len;
U8 type;
};
/* Node whose argument is 'SV *'. This needs to be used very carefully in
- * situations where pointers won't become invalid because of, say re-mallocs */
+ * situations where pointers won't become invalid because of, say re-mallocs.
+ *
+ * Note that this regnode type is problematic and should not be used or copied
+ * and will be removed in the future. Pointers should be stored in the data[]
+ * array and an index into the data array stored in the regnode, which allows the
+ * pointers to be handled properly during clone/free operations on the regexp
+ * data structure. As a byproduct it also saves space, often we use a 16 bit
+ * member to store indexes into the data[] array.
+ *
+ * Also note that the weird storage here is because regnodes are 32 bit aligned,
+ * which means we cannot have a 64 bit aligned member. To make things more annoying
+ * the size of a pointer may vary by platform. Thus we use a character array, and
+ * then use inline functions to copy the data in or out.
+ * */
struct regnode_p {
U8 flags;
U8 type;
U16 next_off;
- SV * arg1;
+ char arg1_sv_ptr_bytes[sizeof(SV *)];
};
/* Similar to a regnode_1 but with an extra signed argument */
};
/* A synthetic start class (SSC); is a regnode_charclass_posixl_fold, plus an
- * extra SV*, used only during its construction and which is not used by
- * regexec.c. Note that the 'next_off' field is unused, as the SSC stands
- * alone, so there is never a next node. Also, there is no alignment issue,
- * because these are declared or allocated as a complete unit so the compiler
- * takes care of alignment. This is unlike the other regnodes which are
- * allocated in terms of multiples of a single-argument regnode. SSC nodes can
- * have a pointer field because there is no alignment issue, and because it is
- * set to NULL after construction, before any cloning of the pattern */
+ * extra SV*, used only during regex construction and which is not used by the
+ * main machinery in regexec.c and which does not get embedded in the final compiled
+ * regex program.
+ *
+ * Because it does not get embedded it does not have to comply with the alignment
+ * and sizing constraints required for a normal regnode structure: it MAY contain
+ * pointers or members of whatever size needed and the compiler will do the right
+ * thing. (Every other regnode type is 32 bit aligned.)
+ *
+ * Note that the 'next_off' field is unused, as the SSC stands alone, so there is
+ * never a next node.
+ */
struct regnode_ssc {
U8 flags; /* ANYOF_MATCHES_POSIXL bit must go here */
U8 type;
#undef ARG2
#define ARG(p) ARG_VALUE(ARG_LOC(p))
-#define ARGp(p) ARG_VALUE(ARGp_LOC(p))
+#define ARGp(p) ARGp_VALUE_inline(p)
#define ARG1(p) ARG_VALUE(ARG1_LOC(p))
#define ARG2(p) ARG_VALUE(ARG2_LOC(p))
#define ARG2L(p) ARG_VALUE(ARG2L_LOC(p))
#define ARG_SET(p, val) ARG__SET(ARG_LOC(p), (val))
-#define ARGp_SET(p, val) ARG__SET(ARGp_LOC(p), (val))
#define ARG1_SET(p, val) ARG__SET(ARG1_LOC(p), (val))
#define ARG2_SET(p, val) ARG__SET(ARG2_LOC(p), (val))
#define ARG2L_SET(p, val) ARG__SET(ARG2L_LOC(p), (val))
+#define ARGp_SET(p, val) ARGp_SET_inline((p),(val))
#undef NEXT_OFF
#undef NODE_ALIGN
#define NODE_ALIGN(node)
#define ARG_LOC(p) (((struct regnode_1 *)p)->arg1)
-#define ARGp_LOC(p) (((struct regnode_p *)p)->arg1)
+#define ARGp_BYTES_LOC(p) (((struct regnode_p *)p)->arg1_sv_ptr_bytes)
#define ARG1_LOC(p) (((struct regnode_2 *)p)->arg1)
#define ARG2_LOC(p) (((struct regnode_2 *)p)->arg2)
#define ARG2L_LOC(p) (((struct regnode_2L *)p)->arg2)
(offset) += 2; \
} STMT_END
+/* define these after we define the normal macros, so we can use
+ * ARGp_BYTES_LOC(n) */
+
+static inline SV *
+ARGp_VALUE_inline(struct regnode *node) {
+ SV *ptr;
+ memcpy(&ptr, ARGp_BYTES_LOC(node), sizeof(ptr));
+
+ return ptr;
+}
+
+static inline void
+ARGp_SET_inline(struct regnode *node, SV *ptr) {
+ memcpy(ARGp_BYTES_LOC(node), &ptr, sizeof(ptr));
+}
+
#define REG_MAGIC 0234
/* An ANYOF node is basically a bitmap with the index being a code point. If
$package = $1;
last;
}
+ elsif (/^\s*package\s*$/) {
+ # If they're hiding their package name, we ignore them
+ ++$ignore{"/$path"};
+ $package='';
+ last;
+ }
}
close $fh
or die "Can't close $file: $!";
-major=22
+major=23
minor=0
}
eval("sub flim () { 0; }") unless defined(&flim);
eval("sub flam () { 1; }") unless defined(&flam);
- eval 'sub blli_in_use {
- my($blli) = @_;
- eval q({ ($blli->{l2_proto}) || ($blli->{l3_proto}); });
- }' unless defined(&blli_in_use);
eval 'sub multiline () {"multilinestring";}' unless defined(&multiline);
}
1;
}
} else {
# Fudge it by waiting a bit more:
- sleep 2;
+ sleep 3;
}
my $ppid2 = getppid();
print $w "$how,$ppid1,$ppid2\n";
# Regenerate this file using:
# cd t
# ./perl -I../lib porting/customized.t --regen
+Digest::MD5 cpan/Digest-MD5/MD5.xs 3d56a25a9eaed20712d50223c19dd193444072bd
+Digest::MD5 cpan/Digest-MD5/t/files.t 889559c1419ab72f32a24160095018a3240e82ba
ExtUtils::Constant cpan/ExtUtils-Constant/lib/ExtUtils/Constant/Base.pm 7560e1018f806db5689dee78728ccb8374aea741
ExtUtils::Constant cpan/ExtUtils-Constant/t/Constant.t 165e9c7132b003fd192d32a737b0f51f9ba4999e
Filter::Util::Call pod/perlfilter.pod 545265af2f45741a0e59eecdd0cfc0c9e490c1e8
Net::Ping dist/Net-Ping/t/450_service.t f6578680f2872d7fc9f24dd75388d55654761875
Net::Ping dist/Net-Ping/t/500_ping_icmp.t 3eeb60181c01b85f876bd6658644548fdf2e24d4
Net::Ping dist/Net-Ping/t/501_ping_icmpv6.t cd719bca662b054b676dd2ee6e0c73c7a5e50cf9
-Pod::Perldoc cpan/Pod-Perldoc/lib/Pod/Perldoc.pm 582be34c077c9ff44d99914724a0cc2140bcd48c
+Pod::Perldoc cpan/Pod-Perldoc/lib/Pod/Perldoc.pm d97aa26b722e6e3120b19ee0d7cf9af04dfdfb7f
Socket cpan/Socket/Socket.pm a993d3a80844b2c89a63d1f815d2e0ed0034a4f5
Socket cpan/Socket/Socket.xs 146541e7deb5593f0469740a6e38bfd0b42c0329
Test::Harness cpan/Test-Harness/t/harness.t 38b13cfc479d37d91c104b97dd364a74dfde0f2f
+version vutil.c 8f1e65848649b125b6e2d3a91d54f5e147d12e41
Win32API::File cpan/Win32API-File/File.pm 8fd212857f821cb26648878b96e57f13bf21b99e
Win32API::File cpan/Win32API-File/File.xs beb870fed4490d2faa547b4a8576b8d64d1d27c5
libnet cpan/libnet/lib/Net/Cmd.pm effaa3ba5c2ea320869d0c769aa206fb75d7dd89
# Exceptions that are found in dual-life bin dirs but aren't
# installed by default; some occur only during testing:
my $not_installed = qr{^(?:
+ \.\./cpan/Archive-Tar/bin/ptar.*
+ |
+ \.\./cpan/JSON-PP/bin/json_pp
+ |
+ \.\./cpan/IO-Compress/bin/zipdetails
+ |
\.\./cpan/Encode/bin/u(?:cm(?:2table|lint|sort)|nidump)
|
\.\./cpan/Module-(?:Metadata|Build)
watchdog(($ENV{PERL_TEST_TIME_OUT_FACTOR} || 1)
* (($::running_as_thread && $::running_as_thread)
- ? 150 : 225));
+ ? 150 : 540));
{
# [perl #120446]
=cut
*/
+#if defined(__m88k__)
+/* XXX workaround: m88k gcc3 produces wrong code with NATIVE_TO_UNI() */
+#define UVCHR_IS_INVARIANT(cp) (OFFUNI_IS_INVARIANT(cp))
+#else /* the original one */
#define UVCHR_IS_INVARIANT(cp) (OFFUNI_IS_INVARIANT(NATIVE_TO_UNI(cp)))
+#endif
/* This defines the 1-bits that are to be in the first byte of a multi-byte
* UTF-8 encoded character that mark it as a start byte and give the number of
U32
Perl_seed(pTHX)
{
+#if defined(__OpenBSD__)
+ return arc4random();
+#else
/*
* This is really just a quick hack which grabs various garbage
* values. It really should be a real hash algorithm which
u += SEED_C5 * (U32)PTR2UV(&when);
#endif
return u;
+#endif
}
void
utils/h2ph
utils/h2xs
utils/instmodsh
-utils/json_pp
utils/libnetcfg
-utils/perlbug # link = utils/perlthanks
+utils/perlbug
utils/perldoc
utils/perlivp
utils/piconv
utils/pl2pm
utils/pod2html
utils/prove
-utils/ptar
-utils/ptardiff
-utils/ptargrep
-utils/shasum
utils/splain
utils/streamzip
utils/xsubpp
-utils/zipdetails
# Files to be built with variable substitution after miniperl is
# available. Dependencies handled manually below (for now).
-pl = corelist.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL json_pp.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL ptar.PL ptardiff.PL ptargrep.PL shasum.PL splain.PL libnetcfg.PL piconv.PL enc2xs.PL encguess.PL xsubpp.PL pod2html.PL zipdetails.PL streamzip.PL
-plextract = corelist cpan h2ph h2xs instmodsh json_pp perlbug perldoc perlivp pl2pm prove ptar ptardiff ptargrep shasum splain libnetcfg piconv enc2xs encguess xsubpp pod2html zipdetails streamzip
-plextractexe = ./corelist ./cpan ./h2ph ./h2xs ./json_pp ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./ptar ./ptardiff ./ptargrep ./shasum ./splain ./libnetcfg ./piconv ./enc2xs ./encguess ./xsubpp ./pod2html ./zipdetails ./streamzip
+pl = corelist.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL splain.PL libnetcfg.PL piconv.PL enc2xs.PL encguess.PL xsubpp.PL pod2html.PL zipdetails.PL streamzip.PL
+plextract = corelist cpan h2ph h2xs instmodsh perlbug perldoc perlivp pl2pm prove splain libnetcfg piconv enc2xs encguess xsubpp pod2html zipdetails streamzip
+plextractexe = ./corelist ./cpan ./h2ph ./h2xs ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./splain ./libnetcfg ./piconv ./enc2xs ./encguess xsubpp.PL ./pod2html ./zipdetails ./streamzip
all: $(plextract)
instmodsh: instmodsh.PL ../config.sh
-json_pp: json_pp.PL ../config.sh
-
perlbug: perlbug.PL ../config.sh ../patchlevel.h
perldoc: perldoc.PL ../config.sh
prove: prove.PL ../config.sh
-ptar: ptar.PL ../config.sh
-
-ptardiff: ptardiff.PL ../config.sh
-
-ptargrep: ptargrep.PL ../config.sh
-
pl2pm: pl2pm.PL ../config.sh
-shasum: shasum.PL ../config.sh
-
splain: splain.PL ../config.sh ../lib/diagnostics.pm
libnetcfg: libnetcfg.PL ../config.sh
xsubpp: xsubpp.PL ../config.sh
-zipdetails: zipdetails.PL ../config.sh
-
streamzip: streamzip.PL ../config.sh
pod2html: pod2html.PL ../config.sh ../ext/Pod-Html/bin/pod2html
$in =~ s/\?\?</{/g; # | ??<| {|
$in =~ s/\?\?>/}/g; # | ??>| }|
}
- if ($in =~ /^\#ifdef __LANGUAGE_PASCAL__/) {
+ if ($in =~ s/^\#ifdef __LANGUAGE_PASCAL__//) {
# Tru64 disassembler.h evilness: mixed C and Pascal.
while (<IN>) {
last if /^\#endif/;
$in = "";
next READ;
}
- if ($in =~ /^extern inline / && # Inlined assembler.
- $^O eq 'linux' && $file =~ m!(?:^|/)asm/[^/]+\.h$!) {
+ # Skip inlined functions in headers
+ if ($in =~ s/^(extern|static) (__inline__|inline) .*[^;]\s*$//) {
while (<IN>) {
last if /^}/;
}
authors and maintainers of perl.
If you wish to generate a bug report, please run it without the -T flag
-(or run the program perlbug rather than perlthanks)
EOF
} else {
paraprint <<"EOF";
This program provides an easy way to generate a bug report for the core
perl distribution (along with tests or patches). To send a thank-you
-note to $thanksaddress instead of a bug report, please run 'perlthanks'.
+note to $thanksaddress instead of a bug report, please use the -T flag.
The GitHub issue tracker at https://github.com/Perl/perl5/issues is the
best place to submit your report so it can be tracked and resolved.
B<perlbug> S<[ B<-v> ]> S<[ B<-r> I<returnaddress> ]>
S<[ B<-ok> | B<-okay> | B<-nok> | B<-nokay> ]>
-B<perlthanks>
-
=head1 DESCRIPTION
=item Can you use C<perlbug> to submit a thank-you note?
-Yes, you can do this by either using the C<-T> option, or by invoking
-the program as C<perlthanks>. Thank-you notes are good. It makes people
+Yes, you can do this by using the C<-T> option.
+Thank-you notes are good. It makes people
smile.
=back
/* may get too much accuracy */
char tbuf[64];
+#ifdef __vax__
+ SV *sv = SvNVX(ver) > 10e37 ? newSV(64) : 0;
+#else
SV *sv = SvNVX(ver) > 10e50 ? newSV(64) : 0;
+#endif
char *buf;
#if PERL_VERSION_GE(5,19,0)
-if exist $(LIBDIR)\MIME rmdir /s /q $(LIBDIR)\MIME
-if exist $(LIBDIR)\Module rmdir /s /q $(LIBDIR)\Module
-if exist $(LIBDIR)\Net\FTP rmdir /s /q $(LIBDIR)\Net\FTP
+ -if exist $(LIBDIR)\OpenBSD rmdir /s /q $(LIBDIR)\OpenBSD
-if exist $(LIBDIR)\Params rmdir /s /q $(LIBDIR)\Params
-if exist $(LIBDIR)\Parse rmdir /s /q $(LIBDIR)\Parse
-if exist $(LIBDIR)\Perl rmdir /s /q $(LIBDIR)\Perl
-if exist $(LIBDIR)\MIME rmdir /s /q $(LIBDIR)\MIME
-if exist $(LIBDIR)\Module rmdir /s /q $(LIBDIR)\Module
-if exist $(LIBDIR)\Net\FTP rmdir /s /q $(LIBDIR)\Net\FTP
+ -if exist $(LIBDIR)\OpenBSD rmdir /s /q $(LIBDIR)\OpenBSD
-if exist $(LIBDIR)\Params rmdir /s /q $(LIBDIR)\Params
-if exist $(LIBDIR)\Parse rmdir /s /q $(LIBDIR)\Parse
-if exist $(LIBDIR)\Perl rmdir /s /q $(LIBDIR)\Perl
projects / openbsd / commitdiff