Imported Upstream version 5.25.4 45/136045/1
authorDongHun Kwak <dh0128.kwak@samsung.com>
Wed, 28 Jun 2017 01:48:38 +0000 (10:48 +0900)
committerDongHun Kwak <dh0128.kwak@samsung.com>
Wed, 28 Jun 2017 01:48:43 +0000 (10:48 +0900)
Change-Id: Iab199a43afb52512a0fbc09a7afe6a5a8e0bbfaa
Signed-off-by: DongHun Kwak <dh0128.kwak@samsung.com>
826 files changed:
AUTHORS
Configure
Cross/config.sh-arm-linux
Cross/config.sh-arm-linux-n770
INSTALL
MANIFEST
META.json
META.yml
Makefile.SH
NetWare/Makefile
NetWare/config.wc
NetWare/config_H.wc
Porting/Glossary
Porting/Maintainers.pl
Porting/Maintainers.pm
Porting/checkAUTHORS.pl
Porting/config.sh
Porting/config_H
Porting/deparse-skips.txt
Porting/epigraphs.pod
Porting/makemeta
Porting/perldelta_template.pod
Porting/release_schedule.pod
Porting/todo.pod
README.haiku
README.macosx
README.os2
README.vms
av.c
cflags.SH
charclass_invlists.h
config_h.SH
configure.com
cpan/Archive-Tar/bin/ptar
cpan/Archive-Tar/bin/ptardiff
cpan/Archive-Tar/bin/ptargrep
cpan/Archive-Tar/lib/Archive/Tar.pm
cpan/Archive-Tar/lib/Archive/Tar/Constant.pm
cpan/Archive-Tar/lib/Archive/Tar/File.pm
cpan/CPAN-Meta/corpus/BadMETA.yml [new file with mode: 0644]
cpan/CPAN-Meta/corpus/CL018_yaml.meta [new file with mode: 0644]
cpan/CPAN-Meta/corpus/META-VR.json [new file with mode: 0644]
cpan/CPAN-Meta/corpus/META-VR.yml [new file with mode: 0644]
cpan/CPAN-Meta/corpus/bareyaml.meta [new file with mode: 0644]
cpan/CPAN-Meta/corpus/json.meta [new file with mode: 0644]
cpan/CPAN-Meta/corpus/yaml.meta [new file with mode: 0644]
cpan/CPAN-Meta/lib/CPAN/Meta.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm
cpan/CPAN-Meta/lib/CPAN/Meta/History.pm
cpan/CPAN-Meta/lib/CPAN/Meta/History/Meta_1_0.pod
cpan/CPAN-Meta/lib/CPAN/Meta/History/Meta_1_1.pod
cpan/CPAN-Meta/lib/CPAN/Meta/History/Meta_1_2.pod
cpan/CPAN-Meta/lib/CPAN/Meta/History/Meta_1_3.pod
cpan/CPAN-Meta/lib/CPAN/Meta/History/Meta_1_4.pod
cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm
cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm
cpan/CPAN-Meta/lib/Parse/CPAN/Meta.pm [new file with mode: 0644]
cpan/CPAN-Meta/t/README-data.txt [new file with mode: 0644]
cpan/CPAN-Meta/t/converter-bad.t
cpan/CPAN-Meta/t/converter-fail.t
cpan/CPAN-Meta/t/converter-fragments.t
cpan/CPAN-Meta/t/converter.t
cpan/CPAN-Meta/t/data-test/x_deprecated-META.json [new file with mode: 0644]
cpan/CPAN-Meta/t/data-valid/META-1_4.yml [new file with mode: 0644]
cpan/CPAN-Meta/t/data-valid/META-2.json [new file with mode: 0644]
cpan/CPAN-Meta/t/data-valid/x_deprecated-META.yml [new file with mode: 0644]
cpan/CPAN-Meta/t/lib/Parse/CPAN/Meta/Test.pm [new file with mode: 0644]
cpan/CPAN-Meta/t/load-bad.t
cpan/CPAN-Meta/t/merge.t
cpan/CPAN-Meta/t/meta-obj.t
cpan/CPAN-Meta/t/no-index.t
cpan/CPAN-Meta/t/optional_feature-merge.t
cpan/CPAN-Meta/t/parse-cpan-meta/02_api.t [new file with mode: 0644]
cpan/CPAN-Meta/t/parse-cpan-meta/03_functions.t [new file with mode: 0644]
cpan/CPAN-Meta/t/parse-cpan-meta/04_export.t [new file with mode: 0644]
cpan/CPAN-Meta/t/parse-cpan-meta/05_errors.t [new file with mode: 0644]
cpan/CPAN-Meta/t/prereqs-finalize.t
cpan/CPAN-Meta/t/prereqs-merge.t
cpan/CPAN-Meta/t/prereqs.t
cpan/CPAN-Meta/t/repository.t
cpan/CPAN-Meta/t/save-load.t
cpan/CPAN-Meta/t/validator.t
cpan/CPAN/lib/App/Cpan.pm
cpan/CPAN/lib/CPAN.pm
cpan/CPAN/scripts/cpan
cpan/Config-Perl-V/V.pm
cpan/Config-Perl-V/t/20_plv56.t
cpan/Config-Perl-V/t/21_plv58.t
cpan/Config-Perl-V/t/22_plv510.t
cpan/Config-Perl-V/t/23_plv512.t
cpan/Config-Perl-V/t/24_plv514.t
cpan/Config-Perl-V/t/25_plv516.t
cpan/Config-Perl-V/t/25_plv5162.t
cpan/Config-Perl-V/t/26_plv518.t
cpan/Config-Perl-V/t/26_plv5182.t
cpan/Config-Perl-V/t/27_plv5200.t
cpan/Config-Perl-V/t/27_plv5202.t
cpan/Config-Perl-V/t/28_plv5220.t
cpan/Config-Perl-V/t/28_plv52201w.t
cpan/Config-Perl-V/t/29_plv5235w.t
cpan/Config-Perl-V/t/30_plv5240.t
cpan/Digest-SHA/lib/Digest/SHA.pm
cpan/Digest-SHA/shasum
cpan/Digest-SHA/src/sha.c
cpan/Digest-SHA/src/sha.h
cpan/Digest-SHA/src/sha64bit.c
cpan/Digest-SHA/src/sha64bit.h
cpan/Digest/Digest.pm
cpan/Encode/Encode.pm
cpan/Encode/Encode.xs
cpan/Encode/Makefile.PL
cpan/Encode/bin/enc2xs
cpan/Encode/bin/encguess
cpan/Encode/bin/piconv
cpan/Encode/bin/ucmlint
cpan/Encode/bin/unidump
cpan/Encode/encoding.pm
cpan/Encode/t/Encode.t
cpan/Encode/t/cow.t
cpan/Encode/t/decode.t
cpan/Encode/t/enc_data.t
cpan/Encode/t/enc_eucjp.t
cpan/Encode/t/enc_module.t
cpan/Encode/t/enc_utf8.t
cpan/Encode/t/jperl.t
cpan/Encode/t/mime-header.t
cpan/Encode/t/utf8warnings.t
cpan/ExtUtils-MakeMaker/bin/instmodsh
cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm
cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm
cpan/ExtUtils-MakeMaker/t/min_perl_version.t
cpan/ExtUtils-MakeMaker/t/several_authors.t
cpan/File-Fetch/lib/File/Fetch.pm
cpan/File-Fetch/t/01_File-Fetch.t
cpan/HTTP-Tiny/lib/HTTP/Tiny.pm
cpan/HTTP-Tiny/t/002_croakage.t
cpan/HTTP-Tiny/t/004_timeout.t [new file with mode: 0644]
cpan/HTTP-Tiny/t/020_headers.t
cpan/HTTP-Tiny/t/030_response.t
cpan/HTTP-Tiny/t/040_content.t
cpan/HTTP-Tiny/t/050_chunked_body.t
cpan/HTTP-Tiny/t/070_cookie_jar.t
cpan/HTTP-Tiny/t/100_get.t
cpan/HTTP-Tiny/t/101_head.t
cpan/HTTP-Tiny/t/102_put.t
cpan/HTTP-Tiny/t/103_delete.t
cpan/HTTP-Tiny/t/104_post.t
cpan/HTTP-Tiny/t/110_mirror.t
cpan/HTTP-Tiny/t/130_redirect.t
cpan/HTTP-Tiny/t/140_proxy.t
cpan/HTTP-Tiny/t/150_post_form.t
cpan/HTTP-Tiny/t/160_cookies.t
cpan/HTTP-Tiny/t/161_basic_auth.t
cpan/HTTP-Tiny/t/162_proxy_auth.t
cpan/HTTP-Tiny/t/170_keepalive.t
cpan/HTTP-Tiny/t/BrokenCookieJar.pm
cpan/HTTP-Tiny/t/SimpleCookieJar.pm
cpan/HTTP-Tiny/t/Util.pm
cpan/IO-Compress/bin/zipdetails
cpan/IO-Compress/lib/Compress/Zlib.pm
cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm
cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm
cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm
cpan/IO-Compress/lib/IO/Compress/Base.pm
cpan/IO-Compress/lib/IO/Compress/Base/Common.pm
cpan/IO-Compress/lib/IO/Compress/Bzip2.pm
cpan/IO-Compress/lib/IO/Compress/Deflate.pm
cpan/IO-Compress/lib/IO/Compress/Gzip.pm
cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm
cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm
cpan/IO-Compress/lib/IO/Compress/Zip.pm
cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm
cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm
cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm
cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm
cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm
cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm
cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm
cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm
cpan/IO-Compress/lib/IO/Uncompress/Base.pm
cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm
cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm
cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm
cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm
cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm
cpan/IO-Socket-IP/lib/IO/Socket/IP.pm
cpan/IO-Socket-IP/t/11sockopts.t
cpan/IPC-Cmd/lib/IPC/Cmd.pm
cpan/JSON-PP/bin/json_pp
cpan/JSON-PP/lib/JSON/PP.pm
cpan/Locale-Maketext-Simple/lib/Locale/Maketext/Simple.pm
cpan/Memoize/Memoize.pm
cpan/Module-Load-Conditional/lib/Module/Load/Conditional.pm
cpan/Module-Metadata/lib/Module/Metadata.pm
cpan/Module-Metadata/t/contains_pod.t
cpan/Module-Metadata/t/extract-package.t
cpan/Module-Metadata/t/extract-version.t
cpan/NEXT/lib/NEXT.pm
cpan/Parse-CPAN-Meta/corpus/BadMETA.yml [deleted file]
cpan/Parse-CPAN-Meta/corpus/CL018_yaml.meta [deleted file]
cpan/Parse-CPAN-Meta/corpus/META-VR.json [deleted file]
cpan/Parse-CPAN-Meta/corpus/META-VR.yml [deleted file]
cpan/Parse-CPAN-Meta/corpus/bareyaml.meta [deleted file]
cpan/Parse-CPAN-Meta/corpus/json.meta [deleted file]
cpan/Parse-CPAN-Meta/corpus/yaml.meta [deleted file]
cpan/Parse-CPAN-Meta/lib/Parse/CPAN/Meta.pm [deleted file]
cpan/Parse-CPAN-Meta/t/02_api.t [deleted file]
cpan/Parse-CPAN-Meta/t/03_functions.t [deleted file]
cpan/Parse-CPAN-Meta/t/04_export.t [deleted file]
cpan/Parse-CPAN-Meta/t/05_errors.t [deleted file]
cpan/Parse-CPAN-Meta/t/lib/Parse/CPAN/Meta/Test.pm [deleted file]
cpan/Pod-Perldoc/lib/Pod/Perldoc.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc/BaseTo.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc/GetOptsOO.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc/ToANSI.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc/ToChecker.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc/ToMan.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc/ToNroff.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc/ToPod.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc/ToRtf.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc/ToTerm.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc/ToText.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc/ToTk.pm
cpan/Pod-Perldoc/lib/Pod/Perldoc/ToXml.pm
cpan/Pod-Perldoc/perldoc.pod
cpan/Pod-Perldoc/t/00_load.t [new file with mode: 0644]
cpan/Pod-Perldoc/t/01_about_verbose.t [new file with mode: 0644]
cpan/Pod-Perldoc/t/load.t [deleted file]
cpan/Sys-Syslog/Syslog.pm
cpan/Test-Harness/bin/prove
cpan/Test-Harness/lib/App/Prove.pm
cpan/Test-Harness/lib/App/Prove/State.pm
cpan/Test-Harness/lib/App/Prove/State/Result.pm
cpan/Test-Harness/lib/App/Prove/State/Result/Test.pm
cpan/Test-Harness/lib/TAP/Base.pm
cpan/Test-Harness/lib/TAP/Formatter/Base.pm
cpan/Test-Harness/lib/TAP/Formatter/Color.pm
cpan/Test-Harness/lib/TAP/Formatter/Console.pm
cpan/Test-Harness/lib/TAP/Formatter/Console/ParallelSession.pm
cpan/Test-Harness/lib/TAP/Formatter/Console/Session.pm
cpan/Test-Harness/lib/TAP/Formatter/File.pm
cpan/Test-Harness/lib/TAP/Formatter/File/Session.pm
cpan/Test-Harness/lib/TAP/Formatter/Session.pm
cpan/Test-Harness/lib/TAP/Harness.pm
cpan/Test-Harness/lib/TAP/Harness/Env.pm
cpan/Test-Harness/lib/TAP/Object.pm
cpan/Test-Harness/lib/TAP/Parser.pm
cpan/Test-Harness/lib/TAP/Parser/Aggregator.pm
cpan/Test-Harness/lib/TAP/Parser/Grammar.pm
cpan/Test-Harness/lib/TAP/Parser/Iterator.pm
cpan/Test-Harness/lib/TAP/Parser/Iterator/Array.pm
cpan/Test-Harness/lib/TAP/Parser/Iterator/Process.pm
cpan/Test-Harness/lib/TAP/Parser/Iterator/Stream.pm
cpan/Test-Harness/lib/TAP/Parser/IteratorFactory.pm
cpan/Test-Harness/lib/TAP/Parser/Multiplexer.pm
cpan/Test-Harness/lib/TAP/Parser/Result.pm
cpan/Test-Harness/lib/TAP/Parser/Result/Bailout.pm
cpan/Test-Harness/lib/TAP/Parser/Result/Comment.pm
cpan/Test-Harness/lib/TAP/Parser/Result/Plan.pm
cpan/Test-Harness/lib/TAP/Parser/Result/Pragma.pm
cpan/Test-Harness/lib/TAP/Parser/Result/Test.pm
cpan/Test-Harness/lib/TAP/Parser/Result/Unknown.pm
cpan/Test-Harness/lib/TAP/Parser/Result/Version.pm
cpan/Test-Harness/lib/TAP/Parser/Result/YAML.pm
cpan/Test-Harness/lib/TAP/Parser/ResultFactory.pm
cpan/Test-Harness/lib/TAP/Parser/Scheduler.pm
cpan/Test-Harness/lib/TAP/Parser/Scheduler/Job.pm
cpan/Test-Harness/lib/TAP/Parser/Scheduler/Spinner.pm
cpan/Test-Harness/lib/TAP/Parser/Source.pm
cpan/Test-Harness/lib/TAP/Parser/SourceHandler.pm
cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Executable.pm
cpan/Test-Harness/lib/TAP/Parser/SourceHandler/File.pm
cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Handle.pm
cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Perl.pm
cpan/Test-Harness/lib/TAP/Parser/SourceHandler/RawTAP.pm
cpan/Test-Harness/lib/TAP/Parser/YAMLish/Reader.pm
cpan/Test-Harness/lib/TAP/Parser/YAMLish/Writer.pm
cpan/Test-Harness/lib/Test/Harness.pm
cpan/Test-Simple/lib/Test/Builder.pm
cpan/Test-Simple/lib/Test/Builder/Formatter.pm
cpan/Test-Simple/lib/Test/Builder/Module.pm
cpan/Test-Simple/lib/Test/Builder/Tester.pm
cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm
cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm
cpan/Test-Simple/lib/Test/More.pm
cpan/Test-Simple/lib/Test/Simple.pm
cpan/Test-Simple/lib/Test/Tester.pm
cpan/Test-Simple/lib/Test/Tester/Capture.pm
cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm
cpan/Test-Simple/lib/Test/Tester/Delegate.pm
cpan/Test-Simple/lib/Test/use/ok.pm
cpan/Test-Simple/lib/Test2.pm
cpan/Test-Simple/lib/Test2/API.pm
cpan/Test-Simple/lib/Test2/API/Breakage.pm
cpan/Test-Simple/lib/Test2/API/Context.pm
cpan/Test-Simple/lib/Test2/API/Instance.pm
cpan/Test-Simple/lib/Test2/API/Stack.pm
cpan/Test-Simple/lib/Test2/Event.pm
cpan/Test-Simple/lib/Test2/Event/Bail.pm
cpan/Test-Simple/lib/Test2/Event/Diag.pm
cpan/Test-Simple/lib/Test2/Event/Exception.pm
cpan/Test-Simple/lib/Test2/Event/Generic.pm
cpan/Test-Simple/lib/Test2/Event/Info.pm
cpan/Test-Simple/lib/Test2/Event/Note.pm
cpan/Test-Simple/lib/Test2/Event/Ok.pm
cpan/Test-Simple/lib/Test2/Event/Plan.pm
cpan/Test-Simple/lib/Test2/Event/Skip.pm
cpan/Test-Simple/lib/Test2/Event/Subtest.pm
cpan/Test-Simple/lib/Test2/Event/Waiting.pm
cpan/Test-Simple/lib/Test2/Formatter.pm
cpan/Test-Simple/lib/Test2/Formatter/TAP.pm
cpan/Test-Simple/lib/Test2/Hub.pm
cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm
cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm
cpan/Test-Simple/lib/Test2/Hub/Subtest.pm
cpan/Test-Simple/lib/Test2/IPC.pm
cpan/Test-Simple/lib/Test2/IPC/Driver.pm
cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm
cpan/Test-Simple/lib/Test2/Util.pm
cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm
cpan/Test-Simple/lib/Test2/Util/HashBase.pm
cpan/Test-Simple/lib/Test2/Util/Trace.pm
cpan/Test-Simple/lib/ok.pm
cpan/Test-Simple/t/Test2/modules/API.t
cpan/Test-Simple/t/regression/694_note_diag_return_values.t [new file with mode: 0644]
cpan/Time-Local/lib/Time/Local.pm
cpan/Time-Local/t/Local.t
cpan/bignum/lib/Math/BigFloat/Trace.pm
cpan/bignum/lib/Math/BigInt/Trace.pm
cpan/bignum/lib/bigint.pm
cpan/bignum/lib/bignum.pm
cpan/bignum/lib/bigrat.pm
cpan/libnet/Makefile.PL
cpan/libnet/lib/Net/Cmd.pm
cpan/libnet/lib/Net/Config.pm
cpan/libnet/lib/Net/Domain.pm
cpan/libnet/lib/Net/FTP.pm
cpan/libnet/lib/Net/FTP/A.pm
cpan/libnet/lib/Net/FTP/E.pm
cpan/libnet/lib/Net/FTP/I.pm
cpan/libnet/lib/Net/FTP/L.pm
cpan/libnet/lib/Net/FTP/dataconn.pm
cpan/libnet/lib/Net/NNTP.pm
cpan/libnet/lib/Net/Netrc.pm
cpan/libnet/lib/Net/POP3.pm
cpan/libnet/lib/Net/SMTP.pm
cpan/libnet/lib/Net/Time.pm
cpan/libnet/t/datasend.t
dist/Carp/lib/Carp.pm
dist/Carp/lib/Carp/Heavy.pm
dist/ExtUtils-ParseXS/lib/ExtUtils/xsubpp
dist/I18N-LangTags/lib/I18N/LangTags.pm
dist/I18N-LangTags/lib/I18N/LangTags/Detect.pm
dist/IO/IO.pm
dist/Locale-Maketext/ChangeLog
dist/Locale-Maketext/lib/Locale/Maketext.pm
dist/Module-CoreList/Changes
dist/Module-CoreList/corelist
dist/Module-CoreList/lib/Module/CoreList.pm
dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm
dist/Module-CoreList/lib/Module/CoreList/Utils.pm
dist/Net-Ping/lib/Net/Ping.pm
dist/PathTools/Cwd.pm
dist/PathTools/lib/File/Spec.pm
dist/PathTools/lib/File/Spec/AmigaOS.pm
dist/PathTools/lib/File/Spec/Cygwin.pm
dist/PathTools/lib/File/Spec/Epoc.pm
dist/PathTools/lib/File/Spec/Functions.pm
dist/PathTools/lib/File/Spec/Mac.pm
dist/PathTools/lib/File/Spec/OS2.pm
dist/PathTools/lib/File/Spec/Unix.pm
dist/PathTools/lib/File/Spec/VMS.pm
dist/PathTools/lib/File/Spec/Win32.pm
dist/PathTools/t/Spec.t
dist/Storable/Storable.pm
dist/Storable/t/dclone.t
dist/Storable/t/recurse.t
dist/Test/lib/Test.pm
dist/XSLoader/Makefile.PL
dist/base/Changes
dist/base/lib/base.pm
dist/base/t/incdot.t [new file with mode: 0644]
doio.c
dump.c
embed.fnc
embed.h
embedvar.h
ext/B/B.pm
ext/B/B.xs
ext/B/B/Concise.pm
ext/B/t/concise.t
ext/Errno/Errno_pm.PL
ext/Hash-Util/Util.xs
ext/Hash-Util/lib/Hash/Util.pm
ext/Opcode/Opcode.pm
ext/Opcode/Opcode.xs
ext/POSIX/POSIX.xs
ext/POSIX/lib/POSIX.pm
ext/Pod-Html/bin/pod2html
ext/Pod-Html/lib/Pod/Html.pm
ext/Tie-Hash-NamedCapture/NamedCapture.pm
ext/Tie-Hash-NamedCapture/NamedCapture.xs
ext/XS-APItest/APItest.pm
ext/XS-APItest/APItest.xs
ext/XS-APItest/t/call.t
ext/XS-APItest/t/handy.t
ext/arybase/arybase.pm
ext/arybase/arybase.xs
gv.c
handy.h
hints/catamount.sh
hints/freebsd.sh
hints/gnu.sh
inline.h
intrpvar.h
lib/B/Deparse-core.t
lib/B/Deparse.pm
lib/B/Deparse.t
lib/B/Op_private.pm
lib/Internals.pod [new file with mode: 0644]
lib/Tie/Array/splice.t
lib/charnames.t
lib/locale.t
lib/locale_threads.t [new file with mode: 0644]
lib/overload.t
lib/perl5db.pl
lib/unicore/mktables
lib/utf8.t
locale.c
makedef.pl
makedepend.SH
mathoms.c
metaconfig.h
op.c
opcode.h
opnames.h
pad.c
parser.h
patchlevel.h
perl.c
perl.h
perlapi.h
perlio.c
perlvars.h
perly.act
perly.c
perly.h
perly.tab
perly.y
plan9/config.plan9
plan9/config_sh.sample
pod/.gitignore
pod/perl.pod
pod/perl5253delta.pod [new file with mode: 0644]
pod/perlcall.pod
pod/perldelta.pod
pod/perldiag.pod
pod/perlfunc.pod
pod/perlguts.pod
pod/perlhacktips.pod
pod/perlhist.pod
pod/perlinterp.pod
pod/perlop.pod
pod/perlport.pod
pod/perlre.pod
pod/perlrun.pod
pod/perluniintro.pod
pod/perlvar.pod
pp.c
pp.h
pp_ctl.c
pp_hot.c
pp_pack.c
pp_proto.h
pp_sort.c
pp_sys.c
proto.h
regcharclass.h
regcomp.c
regen/op_private
regen/opcodes
regexec.c
scope.c
scope.h
sv.c
sv.h
symbian/config.sh
t/TEST
t/base/lex.t
t/comp/parser.t
t/io/argv.t
t/io/binmode.t
t/io/bom.t
t/io/closepid.t
t/io/crlf.t
t/io/data.t
t/io/defout.t
t/io/dup.t
t/io/eintr.t
t/io/eintr_print.t
t/io/errnosig.t
t/io/fflush.t
t/io/fs.t
t/io/iofile.t
t/io/layers.t
t/io/nargv.t
t/io/open.t
t/io/openpid.t
t/io/perlio.t
t/io/perlio_fail.t
t/io/perlio_leaks.t
t/io/perlio_open.t
t/io/pipe.t
t/io/print.t
t/io/pvbm.t
t/io/read.t
t/io/say.t
t/io/sem.t
t/io/shm.t
t/io/socket.t
t/io/tell.t
t/io/through.t
t/io/utf8.t
t/lib/common.pl
t/lib/croak/toke
t/lib/dbmt_common.pl
t/lib/strict/subs
t/lib/universal.t
t/lib/warnings/9uninit
t/lib/warnings/perl
t/lib/warnings/pp_hot
t/lib/warnings/pp_pack
t/lib/warnings/sv
t/lib/warnings/toke
t/mro/basic.t
t/mro/inconsistent_c3.t
t/mro/inconsistent_c3_utf8.t
t/mro/isa_aliases.t
t/mro/isa_aliases_utf8.t
t/mro/isa_c3.t
t/mro/isa_c3_utf8.t
t/mro/isa_dfs.t
t/mro/isa_dfs_utf8.t
t/mro/isarev.t
t/mro/isarev_utf8.t
t/mro/method_caching.t
t/mro/method_caching_utf8.t
t/mro/next_edgecases.t
t/mro/next_edgecases_utf8.t
t/mro/overload_c3.t
t/mro/overload_c3_utf8.t
t/mro/overload_dfs.t
t/mro/package_aliases.t
t/mro/package_aliases_utf8.t
t/mro/recursion_c3.t
t/mro/recursion_c3_utf8.t
t/mro/recursion_dfs.t
t/mro/recursion_dfs_utf8.t
t/op/64bitint.t
t/op/aassign.t
t/op/alarm.t
t/op/anonconst.t
t/op/anonsub.t
t/op/append.t
t/op/args.t
t/op/array.t
t/op/assignwarn.t
t/op/attrhand.t
t/op/attrproto.t
t/op/attrs.t
t/op/auto.t
t/op/avhv.t
t/op/bless.t
t/op/bop.t
t/op/caller.t
t/op/chars.t
t/op/chdir.t
t/op/chop.t
t/op/chr.t
t/op/concat2.t
t/op/cond.t
t/op/const-optree.t
t/op/context.t
t/op/coreamp.t
t/op/coresubs.t
t/op/cproto.t
t/op/crypt.t
t/op/current_sub.t
t/op/dbm.t
t/op/decl-refs.t
t/op/defins.t
t/op/delete.t
t/op/die.t
t/op/die_exit.t
t/op/die_keeperr.t
t/op/do.t
t/op/dor.t
t/op/dump.t
t/op/each.t
t/op/each_array.t
t/op/eval.t
t/op/evalbytes.t
t/op/exec.t
t/op/exists_sub.t
t/op/exp.t
t/op/fh.t
t/op/filehandle.t
t/op/filetest_stack_ok.t
t/op/filetest_t.t
t/op/flip.t
t/op/fork.t
t/op/fresh_perl_utf8.t
t/op/getpid.t
t/op/getppid.t
t/op/glob.t
t/op/gmagic.t
t/op/goto.t
t/op/goto_xs.t
t/op/grent.t
t/op/grep.t
t/op/groups.t
t/op/gv.t
t/op/hash-rt85026.t
t/op/hash.t
t/op/hashassign.t
t/op/hashwarn.t
t/op/heredoc.t
t/op/hexfp.t
t/op/inc.t
t/op/inccode.t
t/op/incfilter.t
t/op/infnan.t
t/op/int.t
t/op/join.t
t/op/kill0.t
t/op/leaky-magic.t
t/op/lex.t
t/op/lex_assign.t
t/op/lfs.t
t/op/list.t
t/op/local.t
t/op/lock.t
t/op/loopctl.t
t/op/lop.t
t/op/magic-27839.t
t/op/magic.t
t/op/method.t
t/op/mkdir.t
t/op/my.t
t/op/mydef.t
t/op/negate.t
t/op/not.t
t/op/numconvert.t
t/op/or.t
t/op/ord.t
t/op/packagev.t
t/op/pos.t
t/op/postfixderef.t
t/op/pow.t
t/op/protowarn.t
t/op/pwent.t
t/op/quotemeta.t
t/op/rand.t
t/op/range.t
t/op/read.t
t/op/readdir.t
t/op/recurse.t
t/op/ref.t
t/op/repeat.t
t/op/require_37033.t
t/op/require_errors.t
t/op/reset.t
t/op/runlevel.t
t/op/setpgrpstack.t
t/op/signatures.t
t/op/sleep.t
t/op/sort.t
t/op/splice.t
t/op/split.t
t/op/split_unicode.t
t/op/sprintf.t
t/op/sprintf2.t
t/op/srand.t
t/op/sselect.t
t/op/stash.t
t/op/stat.t
t/op/state.t
t/op/study.t
t/op/studytied.t
t/op/sub_lval.t
t/op/svleak.t
t/op/switch.t
t/op/symbolcache.t
t/op/sysio.t
t/op/taint.t
t/op/threads.t
t/op/tie.t
t/op/tie_fetch_count.t
t/op/tiearray.t
t/op/tiehandle.t
t/op/time.t
t/op/tr.t
t/op/undef.t
t/op/unlink.t
t/op/upgrade.t
t/op/utf8cache.t
t/op/utf8decode.t
t/op/utf8magic.t
t/op/utfhash.t
t/op/ver.t
t/op/waitpid.t
t/op/wantarray.t
t/op/while.t
t/op/yadayada.t
t/opbasic/arith.t
t/opbasic/concat.t
t/perf/benchmarks
t/perf/opcount.t
t/porting/customized.dat
t/porting/known_pod_issues.dat
t/porting/podcheck.t
t/re/charset.t
t/re/fold_grind.t
t/re/no_utf8_pm.t
t/re/overload.t
t/re/pat.t
t/re/pat_advanced.t
t/re/pat_psycho.t
t/re/pat_rt_report.t
t/re/pat_special_cc.t
t/re/pos.t
t/re/qr-72922.t
t/re/qr.t
t/re/qr_gc.t
t/re/qrstack.t
t/re/re_tests
t/re/recompile.t
t/re/reg_60508.t
t/re/reg_email.t
t/re/reg_fold.t
t/re/reg_mesg.t
t/re/reg_nc_tie.t
t/re/reg_nocapture.t
t/re/reg_pmod.t
t/re/reg_posixcc.t
t/re/regex_sets.t
t/re/rt122747.t
t/re/speed.t
t/re/subst.t
t/re/subst_amp.t
t/run/fresh_perl.t
t/run/switchDx.t
t/run/switches.t
t/test.pl
t/thread_it.pl
t/uni/attrs.t
t/uni/bless.t
t/uni/caller.t
t/uni/case.pl
t/uni/gv.t
t/uni/heavy.t
t/uni/lex_utf8.t
t/uni/method.t
t/uni/opcroak.t
t/uni/overload.t
t/uni/parser.t
t/uni/select.t
t/uni/sprintf.t
t/uni/universal.t
toke.c
uconfig.h
uconfig.sh
uconfig64.sh
universal.c
utf8.c
utf8.h
utils/c2ph.PL
utils/h2ph.PL
utils/h2xs.PL
utils/libnetcfg.PL
utils/perlbug.PL
utils/perldoc.PL
utils/perlivp.PL
utils/splain.PL
vms/descrip_mms.template
win32/.gitignore
win32/GNUmakefile
win32/Makefile
win32/config.ce
win32/config.gc
win32/config.vc
win32/makefile.mk
win32/pod.mak

diff --git a/AUTHORS b/AUTHORS
index 7d318420f37438be6a6035852dea2c5d116435ca..ce4cca17832d25c13c84ce835c1dbc49b51555a2 100644 (file)
--- a/AUTHORS
+++ b/AUTHORS
@@ -39,44 +39,44 @@ Adam Spiers
 Adrian M. Enache               <enache@rdslink.ro>
 Adriano Ferreira               <a.r.ferreira@gmail.com>
 Akim Demaille                  <akim@epita.fr>
+Alain Barbet                   <alian@cpan.org>
 Alan Burlison                  <Alan.Burlison@uk.sun.com>
 Alan Champion                  <achampio@lehman.com>
+Alan Ferrency                  <alan@pair.com>
 Alan Grover                    <awgrover@gmail.com>
 Alan Grow                      <agrow@thegotonerd.com>
 Alan Haggai Alavi              <haggai@cpan.org>
 Alan Harder                    <Alan.Harder@Ebay.Sun.COM>
 Alan Hourihane                 <alanh@fairlite.co.uk>
 Alan Modra
-Alan Ferrency                  <alan@pair.com>
 Alastair Douglas               <alastair.douglas@gmail.com>
 Albert Chin-A-Young            <china@thewrittenword.com>
 Albert Dvornik                 <bert@alum.mit.edu>
 Alberto Simões                        <ambs@cpan.org>
 Alessandro Forghieri           <alf@orion.it>
-Alexandre (Midnite) Jousset    <mid@gtmp.org>
-Alexander Alekseev             <alex@alemate.ru>
-Alexander Hartmaier            <abraxxa@cpan.org>
-Alexander Voronov              <alexander-voronov@yandex.ru>
-Alexei Alexandrov              <alexei.alexandrov@gmail.com>
 Alex Davies                    <adavies@ptc.com>
 Alex Gough                     <alex@rcon.org>
 Alex Solovey                   <a.solovey@gmail.com>
 Alex Vandiver                  <alexmv@mit.edu>
 Alex Waugh                     <alex@alexwaugh.com>
+Alexander Alekseev             <alex@alemate.ru>
 Alexander Bluhm                        <alexander_bluhm@genua.de>
-Alexander D'Archangel   <darksuji@gmail.com>
+Alexander D'Archangel          <darksuji@gmail.com>
 Alexander Gernler              <alexander_gernler@genua.de>
 Alexander Gough                        <alex-p5p@earth.li>
+Alexander Hartmaier            <abraxxa@cpan.org>
 Alexander Klimov               <ask@wisdom.weizmann.ac.il>
 Alexander Smishlajev           <als@turnhere.com>
+Alexander Voronov              <alexander-voronov@yandex.ru>
 Alexandr Ciornii               <alexchorny@gmail.com>
+Alexandre (Midnite) Jousset    <mid@gtmp.org>
+Alexei Alexandrov              <alexei.alexandrov@gmail.com>
 Alexey Mahotkin                        <alexm@netli.com>
 Alexey Toptygin                        <alexeyt@freeshell.org>
 Alexey Tourbin                 <at@altlinux.ru>
 Alexey V. Barantsev            <barancev@kazbek.ispras.ru>
 Ali Polatel                    <alip@exherbo.org>
 Allen Smith                    <allens@cpan.org>
-Alain Barbet                   <alian@cpan.org>
 Ambrose Kofi Laing
 Ammon Riley                    <ammon@rhythm.com>
 Ananth Kesari                  <HYanantha@novell.com>
@@ -172,8 +172,8 @@ Bradley Dean                        <bjdean@bjdean.id.au>
 Bram                           <perl-rt@wizbit.be>
 Brendan Byrd                   <BBYRD@CPAN.org>
 Brendan O'Dea                  <bod@debian.org>
-Brent B. Powers                        <powers@ml.com>
 Breno G. de Oliveira           <garu@cpan.org>
+Brent B. Powers                        <powers@ml.com>
 Brent Dax                      <brentdax@cpan.org>
 Brooks D Boyd
 Brian Callaghan                        <callagh@itginc.com>
@@ -201,8 +201,8 @@ C Aditya                    <caditya@novell.com>
 Calle Dybedahl                 <calle@lysator.liu.se>
 Campo Weijerman                        <rfc822@nl.ibm.com>
 Carl Eklof                     <CEklof@endeca.com>
-Carl M. Fongheiser             <cmf@ins.infonet.net>
 Carl Hayter                    <hayter@usc.edu>
+Carl M. Fongheiser             <cmf@ins.infonet.net>
 Carl Witty                     <cwitty@newtonlabs.com>
 Cary D. Renzema                        <caryr@mxim.com>
 Casey R. Tweten                        <crt@kiski.net>
@@ -234,6 +234,8 @@ Chris Lamb                  <lamby@debian.org>
 Chris Lightfoot                        <chris@ex-parrot.com>
 Chris Nandor                   <pudge@pobox.com>
 Chris Pepper
+Chris R. Donnelly              <chris.donnelly@vauto.com>
+Chris Travers                  <chris.travers@gmail.com>
 Chris Tubutis                  <chris@broadband.att.com>
 Chris Wick                     <cwick@lmc.com>
 Chris Williams                 <chrisw@netinfo.com.au>
@@ -250,8 +252,8 @@ Christopher J. Madsen               <perl@cjmweb.net>
 chromatic                      <chromatic@wgz.org>
 Chuck Phillips                 <perl@cadop.com>
 Chunhui Teng                   <cteng@nortel.ca>
-Clark Cooper                   <coopercc@netheaven.com>
 Claes Jacobsson                        <claes@surfar.nu>
+Clark Cooper                   <coopercc@netheaven.com>
 Claudio Ramirez                        <nxadm@cpan.org>
 Clinton A. Pierce              <clintp@geeksalad.org>
 Colin Kuskie                   <ckuskie@cadence.com>
@@ -263,8 +265,8 @@ Conrad E. Kimball           <cek@tblv021.ca.boeing.com>
 Craig A. Berry                 <craigberry@mac.com>
 Craig DeForest                 <zowie@euterpe.boulder.swri.edu>
 Craig Milo Rogers              <Rogers@ISI.EDU>
-Curtis Poe                     <cp@onsitetech.com>
 Curtis Jewell                  <perl@csjewell.fastmail.us>
+Curtis Poe                     <cp@onsitetech.com>
 Dabrien 'Dabe' Murphy          <dabe@dabe.com>
 Dagfinn Ilmari Mannsåker      <ilmari@ilmari.org>
 Dale Amon                      <amon@vnl.com>
@@ -329,8 +331,9 @@ David J. Fiander            <davidf@mks.com>
 David Kerry                    <davidk@tor.securecomputing.com>
 David Landgren                 <david@landgren.net>
 David Leadbeater               <dgl@dgl.cx>
-David McLean                   <davem@icc.gsfc.nasa.gov>
+David M. Syzdek                        <david@syzdek.net>
 David Manura                   <dm.list@math2.org>
+David McLean                   <davem@icc.gsfc.nasa.gov>
 David Mitchell                 <davem@iabyn.nospamdeletethisbit.com>
 David Muir Sharnoff            <muir@idiom.com>
 David Nicol                    <whatever@davidnicol.com>
@@ -339,7 +342,6 @@ David Sparks                        <daves@ca.sophos.com>
 David Starks-Browning          <dstarks@rc.tudelft.nl>
 David Steinbrunner             <dsteinbrunner@pobox.com>
 David Sundstrom                        <sunds@asictest.sc.ti.com>
-David M. Syzdek                        <david@syzdek.net>
 David Wheeler                  <david@justatheory.com>
 Davin Milun                    <milun@cs.Buffalo.EDU>
 Dean Roehrich                  <roehrich@cray.com>
@@ -384,8 +386,8 @@ Edward Peschko                      <edwardp@excitehome.net>
 Elaine -HFB- Ashton            <elaine@chaos.wustl.edu>
 Elizabeth Mattijsen            <liz@dijkmat.nl>
 Enrico Sorcinelli              <bepi@perl.it>
-Eric Arnold                    <eric.arnold@sun.com>
 Eric Amick
+Eric Arnold                    <eric.arnold@sun.com>
 Eric Bartley                   <bartley@icd.cc.purdue.edu>
 Eric Brine                     <ikegami@adaelis.com>
 Eric E. Coe                    <Eric.Coe@oracle.com>
@@ -407,6 +409,7 @@ Fergal Daly                 <fergal@esatclear.ie>
 Fingle Nark                    <finglenark@gmail.com>
 Florent Guillaume
 Florian Ragwitz                        <rafl@debian.org>
+François Désarménien                <desar@club-internet.fr>
 François Perrad                       <francois.perrad@gadz.org>
 Frank Crawford
 Frank Ridderbusch              <Frank.Ridderbusch@pdb.siemens.de>
@@ -414,7 +417,6 @@ Frank Tobin                 <ftobin@uiuc.edu>
 Frank Wiegand                  <frank.wiegand@gmail.com>
 Franklin Chen                  <chen@adi.com>
 Franz Fasching                 <perldev@drfasching.com>
-François Désarménien                <desar@club-internet.fr>
 Frederic Briere                        <fbriere@fbriere.net>
 Fréderic Chauveau             <fmc@pasteur.fr>
 Fyodor Krasnov                 <fyodor@aha.ru>
@@ -427,8 +429,8 @@ Gary L. Armstrong
 Gary Ng                                <71564.1743@compuserve.com>
 Gavin Shelley                  <columbusmonkey@me.com>
 Gene Sullivan                  <genesullivan50@yahoo.com>
-Geoffrey T. Dairiki            <dairiki@dairiki.org>
 Geoffrey F. Green              <geoff-public@stuebegreen.com>
+Geoffrey T. Dairiki            <dairiki@dairiki.org>
 Georg Schwarz                  <geos@epost.de>
 George Greer                   <perl@greerga.m-l.org>
 George Necula                  <necula@eecs.berkeley.edu>
@@ -442,8 +444,8 @@ Giles Lean                  <giles@nemeton.com.au>
 Gisle Aas                      <gisle@aas.no>
 Glenn D. Golden                        <gdg@zplane.com>
 Glenn Linderman                        <perl@nevcal.com>
-Gordon Lack                    <gml4410@ggr.co.uk>
 Gordon J. Miller               <gjm@cray.com>
+Gordon Lack                    <gml4410@ggr.co.uk>
 Goro Fuji                      <gfuji@cpan.org>
 Grace Lee                      <grace@hal.com>
 Graham Barr                    <gbarr@pobox.com>
@@ -529,11 +531,11 @@ Jacqui Caren                      <Jacqui.Caren@ig.co.uk>
 Jake Hamby                     <jehamby@lightside.com>
 James                          <james@rf.net>
 James A. Duncan                        <jduncan@fotango.com>
+James E Keenan                 <jkeenan@cpan.org>
 James FitzGibbon               <james@ican.net>
 James Jurach                   <muaddib@erf.net>
-James E Keenan                 <jkeenan@cpan.org>
 James Mastros                  <james@mastros.biz>
-James McCoy                     <vega.james@gmail.com>
+James McCoy                    <vega.james@gmail.com>
 James Raspass                  <jraspass@gmail.com>
 Jamshid Afshar
 Jan D.                         <jan.djarv@mbox200.swipnet.se>
@@ -739,6 +741,7 @@ Lesley Binks                        <lesley.binks@gmail.com>
 Lincoln D. Stein               <lstein@cshl.org>
 Lionel Cons                    <lionel.cons@cern.ch>
 Louis Strous                   <louis.strous@gmail.com>
+Lubomir Rintel                 <lkundrak@v3.sk>
 Luc St-Louis                   <luc.st-louis@ca.transport.bombardier.com>
 Luca Fini
 Lucas Holt                     <luke@foolishgames.com>
@@ -746,7 +749,6 @@ Ludovic E. R. Tolhurst-Cleaver                      <camel@ltcdev.com>
 Lukas Mai                      <l.mai@web.de>
 Luke Closs                     <lukec@cpan.org>
 Luke Ross                      <lukeross@gmail.com>
-Lubomir Rintel                 <lkundrak@v3.sk>
 Lupe Christoph                 <lupe@lupe-christoph.de>
 Luther Huffman                 <lutherh@stratcom.com>
 Maik Hentsche                  <maik@mm-double.de>
@@ -761,7 +763,6 @@ Marc Simpson                        <marc@0branch.com>
 Marcel Grünauer                       <marcel@codewerk.com>
 Marco Peereboom                        <marco@conformal.com>
 Marcus Holland-Moritz          <mhx-perl@gmx.net>
-Markus Jansen                  <Markus.Jansen@ericsson.com>
 Marek Rouchal                  <marek.rouchal@infineon.com>
 Mark A Biggar                  <mab@wdl.loral.com>
 Mark A. Hershberger            <mah@everybody.org>
@@ -770,7 +771,6 @@ Mark Aufflick                       <mark@aufflick.com>
 Mark Bixby                     <mark@bixby.org>
 Mark Dickinson                 <dickins3@fas.harvard.edu>
 Mark Dootson                   <mdootson@cpan.org>
-Mark Leighton Fisher           <markleightonfisher@gmail.com>
 Mark Fowler                    <mark@twoshortplanks.com>
 Mark Hanson
 Mark J. Reed                   <mreed@strange.turner.com>
@@ -781,7 +781,7 @@ Mark Kettenis                       <kettenis@wins.uva.nl>
 Mark Klein                     <mklein@dis.com>
 Mark Knutsen                   <knutsen@pilot.njin.net>
 Mark Kvale                     <kvale@phy.ucsf.edu>
-Mark Leighton Fisher           <mark-fisher@mindspring.com>
+Mark Leighton Fisher           <markleightonfisher@gmail.com>
 Mark Mielke                    <mark@mark.mielke.cc>
 Mark Murray                    <mark@grondar.za>
 Mark Overmeer                  <mark@overmeer.net>
@@ -791,6 +791,7 @@ Mark Pizzolato                      <mark@infocomm.com>
 Mark R. Levinson               <mrl@isc.upenn.edu>
 Mark Stosberg                  <mark@summersault.com>
 Marko Asplund                  <aspa@merlot.kronodoc.fi>
+Markus Jansen                  <Markus.Jansen@ericsson.com>
 Marnix van Ammers              <marnix@gmail.com>
 Martien Verbruggen             <mgjv@comdyn.com.au>
 Martijn Koster                 <mak@excitecorp.com>
@@ -816,9 +817,9 @@ Mats Peterson                       <mats@sm6sxl.net>
 Matt Johnson                   <matt.w.johnson@gmail.com>
 Matt Kimball
 Matt Kraai                     <kraai@ftbfs.org>
+Matt S Trout                   <mst@shadowcat.co.uk>
 Matt Sergeant                  <matt@sergeant.org>
 Matt Taggart                   <taggart@debian.org>
-Matt S Trout                   <mst@shadowcat.co.uk>
 Matthew Black                  <black@csulb.edu>
 Matthew Green                  <mrg@splode.eterna.com.au>
 Matthew Horsfall               <wolfsage@gmail.com>
@@ -841,7 +842,6 @@ Michael Carman                      <mjcarman@home.com>
 Michael Cook                   <mcook@cognex.com>
 Michael Cummings               <mcummings@gentoo.org>
 Michael De La Rue              <mikedlr@tardis.ed.ac.uk>
-Michael van Elst               <mlelstv@serpens.de>
 Michael Engel                  <engel@nms1.cc.huji.ac.il>
 Michael Fig                    <michael@liveblockauctions.com>
 Michael G Schwern              <schwern@pobox.com>
@@ -853,6 +853,7 @@ Michael Parker                      <michael.parker@st.com>
 Michael Schroeder              <Michael.Schroeder@informatik.uni-erlangen.de>
 Michael Somos                  <somos@grail.cba.csuohio.edu>
 Michael Stevens                        <mstevens@etla.org>
+Michael van Elst               <mlelstv@serpens.de>
 Michael Witten                 <mfwitten@gmail.com>
 Michele Sardo
 Mik Firestone                  <fireston@lexmark.com>
@@ -874,6 +875,7 @@ Mikhail Zabaluev            <mhz@alt-linux.org>
 Milosz Tanski                  <mtanski@gridapp.com>
 Milton L. Hankins              <mlh@swl.msd.ray.com>
 Misty De Meo                   <mistydemeo@github.com>
+Mohammed El-Afifi              <mohammed_elafifi@yahoo.com>
 Moritz Lenz                    <moritz@casella.verplant.org>
 Moshe Kaminsky                 <kaminsky@math.huji.ac.il>
 Mottaqui Karim                 <taqqui.karim@gmail.com>
@@ -895,10 +897,10 @@ Nick Duffek
 Nick Gianniotis
 Nick Ing-Simmons
 Nick Johnston                  <nickjohnstonsky@gmail.com>
-Nick Logan                      <ugexe@cpan.org>
+Nick Logan                     <ugexe@cpan.org>
 Nick Williams                  <Nick.Williams@morganstanley.com>
 Nicolas Kaiser                 <nikai@nikai.net>
-Nicolas R.                     <atoomic@cpan.org>
+Nicolas R.                     <atoomic@cpan.org>
 Niels Thykier                  <niels@thykier.net>
 Nigel Sandever                 <njsandever@hotmail.com>
 Niko Tyni                      <ntyni@debian.org>
@@ -918,15 +920,15 @@ Olaf Flebbe                       <o.flebbe@science-computing.de>
 Olaf Titz                      <olaf@bigred.inka.de>
 Oleg Nesterov                  <oleg@redhat.com>
 Olivier Blin                   <blino@mandriva.com>
-Olli Savia
-Ollivier Robert                        <roberto@keltia.freenix.fr>
 Olivier Mengué                        <dolmen@cpan.org>
 Olivier Thauvin                        <olivier.thauvin@aerov.jussieu.fr>
+Olli Savia
+Ollivier Robert                        <roberto@keltia.freenix.fr>
 Osvaldo Villalon               <ovillalon@dextratech.com>
 Owain G. Ainsworth             <oga@nicotinebsd.org>
 Owen Taylor                    <owt1@cornell.edu>
-parv                           <parv@pair.com>
 Papp Zoltan                    <padre@elte.hu>
+parv                           <parv@pair.com>
 Pascal Rigaux                  <pixel@mandriva.com>
 Patrick Donelan                        <pat@patspam.com>
 Patrick Dugnolle               <patrick.dugnolle@bnpparibas.com>
@@ -957,10 +959,11 @@ Pavel Zakouril                    <Pavel.Zakouril@mff.cuni.cz>
 Pedro Felipe Horrillo Guerra   <pancho@pancho.name>
 Per Einar Ellefsen             <per.einar@skynet.be>
 Perlover                       <perlover@perlover.com>
-Peter BARABAS
 Pete Peterson                  <petersonp@genrad.com>
+Peter BARABAS
 Peter Chines                   <pchines@nhgri.nih.gov>
 Peter Dintelmann               <Peter.Dintelmann@Dresdner-Bank.com>
+Peter E. Yee                   <yee@trident.arc.nasa.gov>
 Peter Gessner                  <peter.gessner@post.rwth-aachen.de>
 Peter Gordon                   <peter@valor.com>
 Peter Haworth                  <pmh@edison.ioppublishing.com>
@@ -976,7 +979,6 @@ Peter Scott                 <Peter@PSDT.com>
 Peter Valdemar Mørch          <pm@capmon.dk>
 Peter van Heusden              <pvh@junior.uwc.ac.za>
 Peter Wolfe                    <wolfe@teloseng.com>
-Peter E. Yee                   <yee@trident.arc.nasa.gov>
 Petr Písař                   <ppisar@redhat.com>
 Petter Reinholdtsen            <pere@hungry.com>
 Phil Lobbes                    <phil@perkpartners.com>
@@ -1033,6 +1035,7 @@ Richard Hitt                      <rbh00@utsglobal.com>
 Richard Kandarian              <richard.kandarian@lanl.gov>
 Richard L. England             <richard_england@mentorg.com>
 Richard L. Maus, Jr.           <rmaus@monmouth.com>
+Richard Levitte                        <levitte@openssl.org>
 Richard Möhn                  <richard.moehn@fu-berlin.de>
 Richard Ohnemus                        <richard_ohnemus@dallas.csd.sterling.com>
 Richard Soderberg              <p5-authors@crystalflame.net>
@@ -1067,9 +1070,9 @@ Rudolph Todd Maceyko              <rm55+@pitt.edu>
 Rujith S. de Silva             <desilva@netbox.com>
 Ruslan Zakirov                 <ruz@bestpractical.com>
 Russ Allbery                   <rra@stanford.edu>
+Russel O'Connor                        <roconnor@world.std.com>
 Russell Fulton                 <russell@ccu1.auckland.ac.nz>
 Russell Mosemann               <mose@ccsn.edu>
-Russel O'Connor                        <roconnor@world.std.com>
 Ryan Herbert                   <rherbert@sycamorehq.com>
 Salvador Fandiño              <sfandino@yahoo.com>
 Salvador Ortiz Garcia          <sog@msg.com.mx>
@@ -1093,13 +1096,14 @@ Sean Davis                      <dive@ender.com>
 Sean M. Burke                  <sburke@cpan.org>
 Sean Robinson                  <robinson_s@sc.maricopa.edu>
 Sean Sheedy                    <seans@ncube.com>
+Sebastian Schmidt              <yath@yath.de>
+Sebastian Steinlechner         <steinlechner@gmx.net>
 Sebastian Wittmeier            <Sebastian.Wittmeier@ginko.de>
 Sébastien Aperghis-Tramoni    <saper@cpan.org>
 Sebastien Barre                        <Sebastien.Barre@utc.fr>
-Sebastian Schmidt              <yath@yath.de>
-Sebastian Steinlechner         <steinlechner@gmx.net>
-Sérgio Durigan Júnior                <sergiodj@linux.vnet.ibm.com>
 Sergey Alekseev                        <varnie29a@mail.ru>
+Sergey Aleynikov               <sergey.aleynikov@gmail.com>
+Sérgio Durigan Júnior                <sergiodj@linux.vnet.ibm.com>
 Shawn                          <svicalifornia@gmail.com>
 Shawn M Moore                  <sartak@gmail.com>
 Sherm Pendley                  <sherm@dot-app.org>
@@ -1127,9 +1131,8 @@ Stas Bekman                       <stas@stason.org>
 Steffen Müller                        <smueller@cpan.org>
 Steffen Schwigon               <ss5@renormalist.net>
 Steffen Ullrich                        <coyote.frank@gmx.net>
-Stéphane Payrard              <stef@mongueurs.net>
 Stepan Kasal                   <skasal@redhat.com>
-Stephane Payrard               <properler@freesurf.fr>
+Stéphane Payrard              <stef@mongueurs.net>
 Stephanie Beals                        <bealzy@us.ibm.com>
 Stephen Bennett                        <sbp@exherbo.com>
 Stephen Clouse                 <stephenc@theiqgroup.com>
@@ -1225,7 +1228,7 @@ Tye McQueen                       <tye@metronet.com>
 Ulrich Habel                   <rhaen@NetBSD.org>
 Ulrich Kunitz                  <kunitz@mai-koeln.com>
 Ulrich Pfeifer                 <pfeifer@wait.de>
-Unicode Consortium              <unicode.org>
+Unicode Consortium             <unicode.org>
 Vadim Konovalov                        <vkonovalov@lucent.com>
 Valeriy E. Ushakov             <uwe@ptc.spbu.ru>
 Vernon Lyon                    <vlyon@cpan.org>
@@ -1274,8 +1277,7 @@ Yuval Kogman                      <nothingmuch@woobling.org>
 Yves Orton                     <demerphq@gmail.com>
 Zachary Miller                 <zcmiller@simon.er.usgs.gov>
 Zachary Storer                 <zacts.3.14159@gmail.com>
+Zbynek Vyskovsky               <kvr@centrum.cz>
 Zefram                         <zefram@fysh.org>
 Zsbán Ambrus                  <ambrus@math.bme.hu>
-Zbynek Vyskovsky               <kvr@centrum.cz>
 Ævar Arnfjörð Bjarmason             <avar@cpan.org>
-Mohammed El-Afifi              <mohammed_elafifi@yahoo.com>
index 3a963510ececba84148b92635e637b5258bd0af0..818ab8e9268d477d1b4f5cef981f1a68257d3bda 100755 (executable)
--- a/Configure
+++ b/Configure
@@ -506,6 +506,7 @@ d_ftello=''
 d_ftime=''
 d_gettimeod=''
 d_futimes=''
+d_gai_strerror=''
 d_Gconvert=''
 d_getaddrinfo=''
 d_getcwd=''
@@ -5252,7 +5253,7 @@ define:define)
 *** Please select one or the other.
 EOM
        exit 1
-        ;;
+       ;;
 esac
 
 : Looking for optional libraries
@@ -7043,6 +7044,16 @@ int main() {
     printf("8\n");
     exit(0);
   }
+#endif
+/* We are largely making this up because it may well be
+ * that the VAX format H was never made available to C,
+ * only to Fortran. */
+#if LONGDBLSIZE == 16 && defined(__vax__)
+  if (b[0] == 0xFD && b[15] == 0x99) {
+    /* VAX format H, PDP-11 mixed endian. */
+    printf("9\n");
+    exit(0);
+  }
 #endif
   printf("-1\n"); /* unknown */
   exit(0);
@@ -7065,8 +7076,9 @@ case "$longdblkind" in
 4) echo "You have x86 80-bit big endian long doubles." >& 4 ;;
 5) echo "You have 128-bit fully little-endian double-double long doubles (64-bit LEs in LE)." >& 4 ;;
 6) echo "You have 128-bit fully big-endian double-double long doubles (64-bit BEs in BE)." >& 4 ;;
-7) echo "You have 128-bit mixed double-double long doubles (64-bit LEs in BE)." >& 4 ;;
-8) echo "You have 128-bit mixed double-double long doubles (64-bit BEs in LE)." >& 4 ;;
+7) echo "You have 128-bit mixed-endian double-double long doubles (64-bit LEs in BE)." >& 4 ;;
+8) echo "You have 128-bit mixed-endian double-double long doubles (64-bit BEs in LE)." >& 4 ;;
+9) echo "You have 128-bit PDP-style mixed-endian long doubles." >& 4 ;;
 *) echo "Cannot figure out your long double." >&4 ;;
 esac
 $rm_try
@@ -14282,6 +14294,34 @@ else
 fi
 $rm_try
 
+: look for gai_strerror
+echo " "
+$cat >try.c <<'EOCP'
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netdb.h>
+int main ()
+{
+    return (gai_strerror (0) ? 0 : 1);
+    }
+EOCP
+set try
+val="$undef"
+if eval $compile; then
+    `$run ./try`
+    case "$?" in
+       0)  echo "A working gai_strerror() found." >&4
+           val="$define" ;;
+       *)  echo "gai_strerror() found, but it doesn't work" >&4
+           ;;
+       esac
+else
+    echo "gai_strerror() NOT found." >&4
+    fi
+set d_gai_strerror
+eval $setvar
+$rm_try
+
 : see if ndbm.h is available
 set ndbm.h i_ndbm
 eval $inhdr
@@ -20512,6 +20552,7 @@ esac
 
 : Check what kind of inf/nan your system has
 $echo "Checking the kind of infinities and nans you have..." >&4
+$echo "(The following tests may crash.  That's okay.)" >&4
 $cat >try.c <<EOP
 #define DOUBLESIZE $doublesize
 #$d_longdbl HAS_LONG_DOUBLE
@@ -24363,6 +24404,7 @@ d_fsync='$d_fsync'
 d_ftello='$d_ftello'
 d_ftime='$d_ftime'
 d_futimes='$d_futimes'
+d_gai_strerror='$d_gai_strerror'
 d_gdbm_ndbm_h_uses_prototypes='$d_gdbm_ndbm_h_uses_prototypes'
 d_gdbmndbm_h_uses_prototypes='$d_gdbmndbm_h_uses_prototypes'
 d_getaddrinfo='$d_getaddrinfo'
index 6fd3eaccddc061e0f2131995608d7e1a72d8ac68..8b3f5c00f92b8a9e0627f18a7c20db54feaf5a88 100644 (file)
@@ -32,12 +32,12 @@ alignbytes='4'
 ansi2knr=''
 aphostname='/bin/hostname'
 api_revision='5'
-api_subversion='3'
+api_subversion='4'
 api_version='25'
-api_versionstring='5.25.3'
+api_versionstring='5.25.4'
 ar='ar'
-archlib='/usr/lib/perl5/5.25.3/armv4l-linux'
-archlibexp='/usr/lib/perl5/5.25.3/armv4l-linux'
+archlib='/usr/lib/perl5/5.25.4/armv4l-linux'
+archlibexp='/usr/lib/perl5/5.25.4/armv4l-linux'
 archname64=''
 archname='armv4l-linux'
 archobjs=''
@@ -56,7 +56,7 @@ castflags='0'
 cat='cat'
 cc='cc'
 cccdlflags='-fpic'
-ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.25.3/armv4l-linux/CORE'
+ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.25.4/armv4l-linux/CORE'
 ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
 ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
 ccname='arm-linux-gcc'
@@ -233,6 +233,7 @@ d_fsync='define'
 d_ftello='define'
 d_ftime='undef'
 d_futimes='undef'
+d_gai_strerror='undef'
 d_gdbm_ndbm_h_uses_prototypes='undef'
 d_gdbmndbm_h_uses_prototypes='undef'
 d_getaddrinfo='undef'
@@ -805,12 +806,13 @@ i_values='define'
 i_varargs='undef'
 i_varhdr='stdarg.h'
 i_vfork='undef'
+i_xlocale='undef'
 ignore_versioned_solibs='y'
 inc_version_list=' '
 inc_version_list_init='0'
 incpath=''
 inews=''
-installarchlib='./install_me_here/usr/lib/perl5/5.25.3/armv4l-linux'
+installarchlib='./install_me_here/usr/lib/perl5/5.25.4/armv4l-linux'
 installbin='./install_me_here/usr/bin'
 installhtml1dir=''
 installhtml3dir=''
@@ -818,13 +820,13 @@ installman1dir='./install_me_here/usr/share/man/man1'
 installman3dir='./install_me_here/usr/share/man/man3'
 installprefix='./install_me_here/usr'
 installprefixexp='./install_me_here/usr'
-installprivlib='./install_me_here/usr/lib/perl5/5.25.3'
+installprivlib='./install_me_here/usr/lib/perl5/5.25.4'
 installscript='./install_me_here/usr/bin'
-installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.25.3/armv4l-linux'
+installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.25.4/armv4l-linux'
 installsitebin='./install_me_here/usr/bin'
 installsitehtml1dir=''
 installsitehtml3dir=''
-installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.25.3'
+installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.25.4'
 installsiteman1dir='./install_me_here/usr/share/man/man1'
 installsiteman3dir='./install_me_here/usr/share/man/man3'
 installsitescript='./install_me_here/usr/bin'
@@ -958,8 +960,8 @@ pmake=''
 pr=''
 prefix='/usr'
 prefixexp='/usr'
-privlib='/usr/lib/perl5/5.25.3'
-privlibexp='/usr/lib/perl5/5.25.3'
+privlib='/usr/lib/perl5/5.25.4'
+privlibexp='/usr/lib/perl5/5.25.4'
 procselfexe='"/proc/self/exe"'
 prototype='define'
 ptrsize='4'
@@ -1024,17 +1026,17 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0'
 sig_size='68'
 signal_t='void'
-sitearch='/usr/lib/perl5/site_perl/5.25.3/armv4l-linux'
-sitearchexp='/usr/lib/perl5/site_perl/5.25.3/armv4l-linux'
+sitearch='/usr/lib/perl5/site_perl/5.25.4/armv4l-linux'
+sitearchexp='/usr/lib/perl5/site_perl/5.25.4/armv4l-linux'
 sitebin='/usr/bin'
 sitebinexp='/usr/bin'
 sitehtml1dir=''
 sitehtml1direxp=''
 sitehtml3dir=''
 sitehtml3direxp=''
-sitelib='/usr/lib/perl5/site_perl/5.25.3'
+sitelib='/usr/lib/perl5/site_perl/5.25.4'
 sitelib_stem='/usr/lib/perl5/site_perl'
-sitelibexp='/usr/lib/perl5/site_perl/5.25.3'
+sitelibexp='/usr/lib/perl5/site_perl/5.25.4'
 siteman1dir='/usr/share/man/man1'
 siteman1direxp='/usr/share/man/man1'
 siteman3dir='/usr/share/man/man3'
@@ -1073,7 +1075,7 @@ stdio_stream_array=''
 strerror_r_proto='0'
 strings='/usr/include/string.h'
 submit=''
-subversion='3'
+subversion='4'
 sysman='/usr/share/man/man1'
 tail=''
 tar=''
@@ -1165,8 +1167,8 @@ vendorprefix=''
 vendorprefixexp=''
 vendorscript=''
 vendorscriptexp=''
-version='5.25.3'
-version_patchlevel_string='version 25 subversion 3'
+version='5.25.4'
+version_patchlevel_string='version 25 subversion 4'
 versiononly='undef'
 vi=''
 xlibpth='/usr/lib/386 /lib/386'
@@ -1180,9 +1182,9 @@ config_args=''
 config_argc=0
 PERL_REVISION=5
 PERL_VERSION=25
-PERL_SUBVERSION=3
+PERL_SUBVERSION=4
 PERL_API_REVISION=5
 PERL_API_VERSION=25
-PERL_API_SUBVERSION=3
+PERL_API_SUBVERSION=4
 PERL_PATCHLEVEL=
 PERL_CONFIG_SH=true
index 4621b80fbbd344aca152c1d6a28fbb53f18c8270..f14c4cb48c2694db4a547d3bdd4e1242b8f147bf 100644 (file)
@@ -32,12 +32,12 @@ alignbytes='4'
 ansi2knr=''
 aphostname='/bin/hostname'
 api_revision='5'
-api_subversion='3'
+api_subversion='4'
 api_version='25'
-api_versionstring='5.25.3'
+api_versionstring='5.25.4'
 ar='ar'
-archlib='/usr/lib/perl5/5.25.3/armv4l-linux'
-archlibexp='/usr/lib/perl5/5.25.3/armv4l-linux'
+archlib='/usr/lib/perl5/5.25.4/armv4l-linux'
+archlibexp='/usr/lib/perl5/5.25.4/armv4l-linux'
 archname64=''
 archname='armv4l-linux'
 archobjs=''
@@ -55,7 +55,7 @@ castflags='0'
 cat='cat'
 cc='arm-none-linux-gnueabi-gcc'
 cccdlflags='-fpic'
-ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.25.3/armv4l-linux/CORE'
+ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.25.4/armv4l-linux/CORE'
 ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
 ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
 ccname='arm-linux-gcc'
@@ -699,7 +699,7 @@ inc_version_list=' '
 inc_version_list_init='0'
 incpath=''
 inews=''
-installarchlib='./install_me_here/usr/lib/perl5/5.25.3/armv4l-linux'
+installarchlib='./install_me_here/usr/lib/perl5/5.25.4/armv4l-linux'
 installbin='./install_me_here/usr/bin'
 installhtml1dir=''
 installhtml3dir=''
@@ -707,13 +707,13 @@ installman1dir='./install_me_here/usr/share/man/man1'
 installman3dir='./install_me_here/usr/share/man/man3'
 installprefix='./install_me_here/usr'
 installprefixexp='./install_me_here/usr'
-installprivlib='./install_me_here/usr/lib/perl5/5.25.3'
+installprivlib='./install_me_here/usr/lib/perl5/5.25.4'
 installscript='./install_me_here/usr/bin'
-installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.25.3/armv4l-linux'
+installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.25.4/armv4l-linux'
 installsitebin='./install_me_here/usr/bin'
 installsitehtml1dir=''
 installsitehtml3dir=''
-installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.25.3'
+installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.25.4'
 installsiteman1dir='./install_me_here/usr/share/man/man1'
 installsiteman3dir='./install_me_here/usr/share/man/man3'
 installsitescript='./install_me_here/usr/bin'
@@ -841,8 +841,8 @@ pmake=''
 pr=''
 prefix='/usr'
 prefixexp='/usr'
-privlib='/usr/lib/perl5/5.25.3'
-privlibexp='/usr/lib/perl5/5.25.3'
+privlib='/usr/lib/perl5/5.25.4'
+privlibexp='/usr/lib/perl5/5.25.4'
 procselfexe='"/proc/self/exe"'
 prototype='define'
 ptrsize='4'
@@ -903,17 +903,17 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0'
 sig_size='68'
 signal_t='void'
-sitearch='/usr/lib/perl5/site_perl/5.25.3/armv4l-linux'
-sitearchexp='/usr/lib/perl5/site_perl/5.25.3/armv4l-linux'
+sitearch='/usr/lib/perl5/site_perl/5.25.4/armv4l-linux'
+sitearchexp='/usr/lib/perl5/site_perl/5.25.4/armv4l-linux'
 sitebin='/usr/bin'
 sitebinexp='/usr/bin'
 sitehtml1dir=''
 sitehtml1direxp=''
 sitehtml3dir=''
 sitehtml3direxp=''
-sitelib='/usr/lib/perl5/site_perl/5.25.3'
+sitelib='/usr/lib/perl5/site_perl/5.25.4'
 sitelib_stem='/usr/lib/perl5/site_perl'
-sitelibexp='/usr/lib/perl5/site_perl/5.25.3'
+sitelibexp='/usr/lib/perl5/site_perl/5.25.4'
 siteman1dir='/usr/share/man/man1'
 siteman1direxp='/usr/share/man/man1'
 siteman3dir='/usr/share/man/man3'
@@ -950,7 +950,7 @@ stdio_stream_array=''
 strerror_r_proto='0'
 strings='/usr/include/string.h'
 submit=''
-subversion='3'
+subversion='4'
 sysman='/usr/share/man/man1'
 tail=''
 tar=''
@@ -1035,8 +1035,8 @@ vendorprefix=''
 vendorprefixexp=''
 vendorscript=''
 vendorscriptexp=''
-version='5.25.3'
-version_patchlevel_string='version 25 subversion 3'
+version='5.25.4'
+version_patchlevel_string='version 25 subversion 4'
 versiononly='undef'
 vi=''
 xlibpth='/usr/lib/386 /lib/386'
@@ -1050,9 +1050,9 @@ config_args=''
 config_argc=0
 PERL_REVISION=5
 PERL_VERSION=25
-PERL_SUBVERSION=3
+PERL_SUBVERSION=4
 PERL_API_REVISION=5
 PERL_API_VERSION=25
-PERL_API_SUBVERSION=3
+PERL_API_SUBVERSION=4
 PERL_PATCHLEVEL=
 PERL_CONFIG_SH=true
diff --git a/INSTALL b/INSTALL
index c80017b450ad799c7bb871fd7731b70f5bb5cd53..3012967ee24ace341aa377e1482c7efd6b59026c 100644 (file)
--- a/INSTALL
+++ b/INSTALL
@@ -581,7 +581,7 @@ The directories set up by Configure fall into three broad categories.
 
 =item Directories for the perl distribution
 
-By default, Configure will use the following directories for 5.25.3.
+By default, Configure will use the following directories for 5.25.4.
 $version is the full perl version number, including subversion, e.g.
 5.12.3, and $archname is a string like sun4-sunos,
 determined by Configure.  The full definitions of all Configure
@@ -930,46 +930,47 @@ You can run perl scripts under the perl debugger at any time with
 B<perl -d your_script>.  If, however, you want to debug perl itself,
 you probably want to have support for perl internal debugging code
 (activated by adding -DDEBUGGING to ccflags), and/or support for the
-system debugger by adding -g to the optimisation flags. For that,
-use the parameter:
+system debugger by adding -g to the optimisation flags.
 
-       sh Configure -DDEBUGGING
+A perl compiled with the DEBUGGING C preprocessor macro will support the
+C<-D> perl command-line switch, have assertions enabled, and have many
+extra checks compiled into the code; but will execute much more slowly
+(typically 2-3x) and the binary will be much larger (typically 2-3x).
 
-or
-
-       sh Configure -DDEBUGGING=<mode>
-
-For a more eye appealing call, -DEBUGGING is defined to be an alias
-for -DDEBUGGING. For both, the -U calls are also supported, in order
-to be able to overrule the hints or Policy.sh settings.
+As a convenience, debugging code (-DDEBUGGING) and debugging symbols (-g)
+can be enabled jointly or separately using a Configure switch, also
+(somewhat confusingly) named -DDEBUGGING.  For a more eye appealing call,
+-DEBUGGING is defined to be an alias for -DDEBUGGING. For both, the -U
+calls are also supported, in order to be able to overrule the hints or
+Policy.sh settings.
 
 Here are the DEBUGGING modes:
 
 =over 4
 
-=item -DDEBUGGING
+=item Configure -DDEBUGGING
 
-=item -DEBUGGING
+=item Configure -DEBUGGING
 
-=item -DEBUGGING=both
+=item Configure -DEBUGGING=both
 
 Sets both -DDEBUGGING in the ccflags, and adds -g to optimize.
 
 You can actually specify -g and -DDEBUGGING independently (see below),
 but usually it's convenient to have both.
 
-=item -DEBUGGING=-g
+=item Configure -DEBUGGING=-g
 
-=item -Doptimize=-g
+=item Configure -Doptimize=-g
 
 Adds -g to optimize, but does not set -DDEBUGGING.
 
 (Note:  Your system may actually require something like cc -g2.
 Check your man pages for cc(1) and also any hint file for your system.)
 
-=item -DEBUGGING=none
+=item Configure -DEBUGGING=none
 
-=item -UDEBUGGING
+=item Configure -UDEBUGGING
 
 Removes -g from optimize, and -DDEBUGGING from ccflags.
 
@@ -2435,7 +2436,7 @@ http://www.chiark.greenend.org.uk/~sgtatham/bugs.html
 
 =head1 Coexistence with earlier versions of perl 5
 
-Perl 5.25.3 is not binary compatible with earlier versions of Perl.
+Perl 5.25.4 is not binary compatible with earlier versions of Perl.
 In other words, you will have to recompile your XS modules.
 
 In general, you can usually safely upgrade from one version of Perl
@@ -2510,9 +2511,9 @@ won't interfere with another version.  (The defaults guarantee this for
 libraries after 5.6.0, but not for executables. TODO?)  One convenient
 way to do this is by using a separate prefix for each version, such as
 
-       sh Configure -Dprefix=/opt/perl5.25.3
+       sh Configure -Dprefix=/opt/perl5.25.4
 
-and adding /opt/perl5.25.3/bin to the shell PATH variable.  Such users
+and adding /opt/perl5.25.4/bin to the shell PATH variable.  Such users
 may also wish to add a symbolic link /usr/local/bin/perl so that
 scripts can still start with #!/usr/local/bin/perl.
 
@@ -2527,11 +2528,11 @@ yet.
 
 =head2 Upgrading from 5.25.2 or earlier
 
-B<Perl 5.25.3 may not be binary compatible with Perl 5.25.2 or
+B<Perl 5.25.4 may not be binary compatible with Perl 5.25.3 or
 earlier Perl releases.>  Perl modules having binary parts
 (meaning that a C compiler is used) will have to be recompiled to be
-used with 5.25.3.  If you find you do need to rebuild an extension with
-5.25.3, you may safely do so without disturbing the older
+used with 5.25.4.  If you find you do need to rebuild an extension with
+5.25.4, you may safely do so without disturbing the older
 installations.  (See L<"Coexistence with earlier versions of perl 5">
 above.)
 
@@ -2564,15 +2565,15 @@ Firstly, the bare minimum to run this script
      print("$f\n");
   }
 
-in Linux with perl-5.25.3 is as follows (under $Config{prefix}):
+in Linux with perl-5.25.4 is as follows (under $Config{prefix}):
 
   ./bin/perl
-  ./lib/perl5/5.25.3/strict.pm
-  ./lib/perl5/5.25.3/warnings.pm
-  ./lib/perl5/5.25.3/i686-linux/File/Glob.pm
-  ./lib/perl5/5.25.3/feature.pm
-  ./lib/perl5/5.25.3/XSLoader.pm
-  ./lib/perl5/5.25.3/i686-linux/auto/File/Glob/Glob.so
+  ./lib/perl5/5.25.4/strict.pm
+  ./lib/perl5/5.25.4/warnings.pm
+  ./lib/perl5/5.25.4/i686-linux/File/Glob.pm
+  ./lib/perl5/5.25.4/feature.pm
+  ./lib/perl5/5.25.4/XSLoader.pm
+  ./lib/perl5/5.25.4/i686-linux/auto/File/Glob/Glob.so
 
 Secondly, for perl-5.10.1, the Debian perl-base package contains 591
 files, (of which 510 are for lib/unicore) totaling about 3.5MB in its
index 8f1b65e3ad907648297ea575436bc00103dee403..7834a2c1a14dff8bc00bc64a13a680e1c7a96015 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -292,6 +292,13 @@ cpan/CPAN/t/02nox.t                See if CPAN::Nox works
 cpan/CPAN/t/03pkgs.t           See if CPAN::Version works
 cpan/CPAN/t/10version.t                See if CPAN the module works
 cpan/CPAN/t/11mirroredby.t             See if CPAN::Mirrored::By works
+cpan/CPAN-Meta/corpus/BadMETA.yml
+cpan/CPAN-Meta/corpus/bareyaml.meta
+cpan/CPAN-Meta/corpus/CL018_yaml.meta
+cpan/CPAN-Meta/corpus/json.meta
+cpan/CPAN-Meta/corpus/META-VR.json
+cpan/CPAN-Meta/corpus/META-VR.yml
+cpan/CPAN-Meta/corpus/yaml.meta
 cpan/CPAN-Meta/lib/CPAN/Meta.pm
 cpan/CPAN-Meta/lib/CPAN/Meta/Converter.pm
 cpan/CPAN-Meta/lib/CPAN/Meta/Feature.pm
@@ -305,6 +312,7 @@ cpan/CPAN-Meta/lib/CPAN/Meta/Merge.pm
 cpan/CPAN-Meta/lib/CPAN/Meta/Prereqs.pm
 cpan/CPAN-Meta/lib/CPAN/Meta/Spec.pm
 cpan/CPAN-Meta/lib/CPAN/Meta/Validator.pm
+cpan/CPAN-Meta/lib/Parse/CPAN/Meta.pm
 cpan/CPAN-Meta/t/converter.t
 cpan/CPAN-Meta/t/converter-bad.t
 cpan/CPAN-Meta/t/converter-fail.t
@@ -351,21 +359,31 @@ cpan/CPAN-Meta/t/data-test/unicode.yml
 cpan/CPAN-Meta/t/data-test/version-not-normal.json
 cpan/CPAN-Meta/t/data-test/version-ranges-1_4.yml
 cpan/CPAN-Meta/t/data-test/version-ranges-2.json
+cpan/CPAN-Meta/t/data-test/x_deprecated-META.json
 cpan/CPAN-Meta/t/data-valid/1122575719-META.yml
 cpan/CPAN-Meta/t/data-valid/1206545041-META.yml
 cpan/CPAN-Meta/t/data-valid/1985684504-META.yml
 cpan/CPAN-Meta/t/data-valid/476602558-META.yml
 cpan/CPAN-Meta/t/data-valid/META-1_0.yml
 cpan/CPAN-Meta/t/data-valid/META-1_1.yml
+cpan/CPAN-Meta/t/data-valid/META-1_4.yml
+cpan/CPAN-Meta/t/data-valid/META-2.json
 cpan/CPAN-Meta/t/data-valid/scalar-meta-spec.yml
+cpan/CPAN-Meta/t/data-valid/x_deprecated-META.yml
+cpan/CPAN-Meta/t/lib/Parse/CPAN/Meta/Test.pm
 cpan/CPAN-Meta/t/load-bad.t
 cpan/CPAN-Meta/t/merge.t
 cpan/CPAN-Meta/t/meta-obj.t
 cpan/CPAN-Meta/t/no-index.t
 cpan/CPAN-Meta/t/optional_feature-merge.t
+cpan/CPAN-Meta/t/parse-cpan-meta/02_api.t
+cpan/CPAN-Meta/t/parse-cpan-meta/03_functions.t
+cpan/CPAN-Meta/t/parse-cpan-meta/04_export.t
+cpan/CPAN-Meta/t/parse-cpan-meta/05_errors.t
 cpan/CPAN-Meta/t/prereqs.t
 cpan/CPAN-Meta/t/prereqs-finalize.t
 cpan/CPAN-Meta/t/prereqs-merge.t
+cpan/CPAN-Meta/t/README-data.txt
 cpan/CPAN-Meta/t/repository.t
 cpan/CPAN-Meta/t/save-load.t
 cpan/CPAN-Meta/t/validator.t
@@ -1309,6 +1327,7 @@ cpan/HTTP-Tiny/t/000_load.t
 cpan/HTTP-Tiny/t/001_api.t
 cpan/HTTP-Tiny/t/002_croakage.t
 cpan/HTTP-Tiny/t/003_agent.t
+cpan/HTTP-Tiny/t/004_timeout.t
 cpan/HTTP-Tiny/t/010_url.t
 cpan/HTTP-Tiny/t/020_headers.t
 cpan/HTTP-Tiny/t/030_response.t
@@ -1871,19 +1890,6 @@ cpan/parent/t/parent-classfromclassfile.t        tests for parent.pm
 cpan/parent/t/parent-classfromfile.t           tests for parent.pm
 cpan/parent/t/parent-pmc.t                     tests for parent.pm
 cpan/parent/t/parent-returns-false.t           tests for parent.pm
-cpan/Parse-CPAN-Meta/corpus/BadMETA.yml
-cpan/Parse-CPAN-Meta/corpus/bareyaml.meta
-cpan/Parse-CPAN-Meta/corpus/CL018_yaml.meta
-cpan/Parse-CPAN-Meta/corpus/json.meta
-cpan/Parse-CPAN-Meta/corpus/META-VR.json
-cpan/Parse-CPAN-Meta/corpus/META-VR.yml
-cpan/Parse-CPAN-Meta/corpus/yaml.meta
-cpan/Parse-CPAN-Meta/lib/Parse/CPAN/Meta.pm
-cpan/Parse-CPAN-Meta/t/02_api.t
-cpan/Parse-CPAN-Meta/t/03_functions.t
-cpan/Parse-CPAN-Meta/t/04_export.t
-cpan/Parse-CPAN-Meta/t/05_errors.t
-cpan/Parse-CPAN-Meta/t/lib/Parse/CPAN/Meta/Test.pm
 cpan/Perl-OSType/lib/Perl/OSType.pm                    Perl::OSType
 cpan/Perl-OSType/t/OSType.t                    Perl::OSType
 cpan/perlfaq/lib/perlfaq.pm    Perl frequently asked questions
@@ -1976,7 +1982,8 @@ cpan/Pod-Perldoc/lib/Pod/Perldoc/ToTk.pm  convert POD via Tk::Pod
 cpan/Pod-Perldoc/lib/Pod/Perldoc/ToXml.pm      convert POD to XML
 cpan/Pod-Perldoc/Makefile.PL
 cpan/Pod-Perldoc/perldoc.pod
-cpan/Pod-Perldoc/t/load.t                      test file for Pod-Perldoc
+cpan/Pod-Perldoc/t/00_load.t                   test file for Pod-Perldoc
+cpan/Pod-Perldoc/t/01_about_verbose.t          test file for Pod-Perldoc
 cpan/Pod-Perldoc/t/man/_get_columns.t          test file for Pod-Perldoc
 cpan/Pod-Perldoc/t/pod.t                       test file for Pod-Perldoc
 cpan/Pod-Simple/lib/Pod/Simple.pm                      Pod made simple
@@ -2724,6 +2731,7 @@ cpan/Test-Simple/t/lib/TieOut.pm
 cpan/Test-Simple/t/regression/642_persistent_end.t
 cpan/Test-Simple/t/regression/662-tbt-no-plan.t
 cpan/Test-Simple/t/regression/684-nested_todo_diag.t
+cpan/Test-Simple/t/regression/694_note_diag_return_values.t
 cpan/Test-Simple/t/regression/no_name_in_subtest.t
 cpan/Test-Simple/t/Test2/acceptance/try_it_done_testing.t
 cpan/Test-Simple/t/Test2/acceptance/try_it_fork.t
@@ -3163,6 +3171,7 @@ dist/base/t/fields.t              See if fields work
 dist/base/t/fields-5_6_0.t     See if fields work
 dist/base/t/fields-5_8_0.t     See if fields work
 dist/base/t/fields-base.t      See if fields work
+dist/base/t/incdot.t           Test how base.pm handles '.' in @INC
 dist/base/t/isa.t              See if base's behaviour doesn't change
 dist/base/t/lib/Broken.pm      Test module for base.pm
 dist/base/t/lib/Dummy.pm       Test module for base.pm
@@ -4415,11 +4424,13 @@ lib/h2ph.t                      See if h2ph works like it should
 lib/h2xs.t                     See if h2xs produces expected lists of files
 lib/integer.pm                 For "use integer"
 lib/integer.t                  For "use integer" testing
+lib/Internals.pod              Document the Internals namespace (implemented by universal.c)
 lib/Internals.t                        For Internals::* testing
 lib/less.pm                    For "use less"
 lib/less.t                     See if less support works
 lib/locale.pm                  For "use locale"
 lib/locale.t                   See if locale support works
+lib/locale_threads.t           Tes locale and threads interactions
 lib/meta_notation.pm           Helper for certain /lib .pm's
 lib/meta_notation.t            See if meta_notation.t works
 lib/Net/hostent.pm             By-name interface to Perl's builtin gethost*
@@ -4812,6 +4823,7 @@ pod/perl5240delta.pod             Perl changes in version 5.24.0
 pod/perl5250delta.pod          Perl changes in version 5.25.0
 pod/perl5251delta.pod          Perl changes in version 5.25.1
 pod/perl5252delta.pod          Perl changes in version 5.25.2
+pod/perl5253delta.pod          Perl changes in version 5.25.3
 pod/perl561delta.pod           Perl changes in version 5.6.1
 pod/perl56delta.pod            Perl changes in version 5.6
 pod/perl581delta.pod           Perl changes in version 5.8.1
@@ -5617,7 +5629,7 @@ t/porting/podcheck.t              Test the POD of shipped modules is well formed
 t/porting/re_context.t         Check assumptions made by save_re_context()
 t/porting/readme.t             Check that all files in Porting/ are mentioned in Porting/README.pod
 t/porting/regen.t              Check that regen.pl doesn't need running
-t/porting/ss_dup.t             Check that sv.c:ss_dup handle everything
+t/porting/ss_dup.t             Check that sv.c:ss_dup handles everything
 t/porting/test_bootstrap.t     Test that the instructions for test bootstrapping aren't accidentally overlooked.
 t/porting/utils.t              Check that utility scripts still compile
 t/re/anyof.t                   See if bracketed char classes [...] compile properly
index 4c2497a710d5495b57f672fcee08777acc06ee67..aa687099e70574eaa038e32ee167519f4f106f9f 100644 (file)
--- a/META.json
+++ b/META.json
@@ -4,7 +4,7 @@
       "perl5-porters@perl.org"
    ],
    "dynamic_config" : 1,
-   "generated_by" : "CPAN::Meta version 2.150005",
+   "generated_by" : "CPAN::Meta version 2.150010",
    "license" : [
       "perl_5"
    ],
          "url" : "http://perl5.git.perl.org/"
       }
    },
-   "version" : "5.025003",
-   "x_serialization_backend" : "JSON::PP version 2.27400"
+   "version" : "5.025004",
+   "x_serialization_backend" : "JSON::PP version 2.27400_01"
 }
index 9c8ad97f374652486f1f3b7bac066ed61055ff64..25a0777f79f61e337182dde1c7d1d8b144261be7 100644 (file)
--- a/META.yml
+++ b/META.yml
@@ -4,7 +4,7 @@ author:
   - perl5-porters@perl.org
 build_requires: {}
 dynamic_config: 1
-generated_by: 'CPAN::Meta version 2.150005, CPAN::Meta::Converter version 2.150005'
+generated_by: 'CPAN::Meta version 2.150010, CPAN::Meta::Converter version 2.150010'
 license: perl
 meta-spec:
   url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -111,5 +111,5 @@ resources:
   homepage: http://www.perl.org/
   license: http://dev.perl.org/licenses/
   repository: http://perl5.git.perl.org/
-version: '5.025003'
+version: '5.025004'
 x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
index 84d06cad43be50c9875fd4bb3cc418d4a5654a30..561d5e1c2f92aa4472513c44e5b8ca2784ca88c0 100755 (executable)
@@ -522,7 +522,7 @@ miniperl_objs = $(miniperl_objs_nodt) $(DTRACE_MINI_O)
 perllib_objs  = $(perllib_objs_nodt) $(DTRACE_PERLLIB_O)
 perlmain_objs = perlmain$(OBJ_EXT) $(DTRACE_MAIN_O)
 
-perltoc_pod_prereqs = extra.pods pod/perl5253delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod
+perltoc_pod_prereqs = extra.pods pod/perl5254delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod
 generated_pods = pod/perltoc.pod $(perltoc_pod_prereqs)
 generated_headers = uudmap.h bitcount.h mg_data.h
 
@@ -1085,9 +1085,9 @@ pod/perlintern.pod: $(MINIPERL_EXE) autodoc.pl embed.fnc
 pod/perlmodlib.pod: $(MINIPERL_EXE) pod/perlmodlib.PL MANIFEST
        $(MINIPERL) pod/perlmodlib.PL -q
 
-pod/perl5253delta.pod: pod/perldelta.pod
-       $(RMS) pod/perl5253delta.pod
-       $(LNS) perldelta.pod pod/perl5253delta.pod
+pod/perl5254delta.pod: pod/perldelta.pod
+       $(RMS) pod/perl5254delta.pod
+       $(LNS) perldelta.pod pod/perl5254delta.pod
 
 extra.pods: $(MINIPERL_EXE)
        -@test ! -f extra.pods || rm -f `cat extra.pods`
index 1d7ee3afaa9eb07edc55da2e83ed347055ca8c81..77e27c85a14968f0e0572401247583297ac03df7 100644 (file)
@@ -86,7 +86,7 @@ NLM_VERSION    = 3,20,0
 
 
 # Here comes the CW tools - TO BE FILLED TO BUILD WITH CW -
-MODULE_DESC     = "Perl 5.25.3 for NetWare"
+MODULE_DESC     = "Perl 5.25.4 for NetWare"
 CCTYPE          = CodeWarrior
 C_COMPILER             = mwccnlm -c
 CPP_COMPILER   = mwccnlm
@@ -462,7 +462,7 @@ INST_NW_TOP2 = $(INST_NW_DRV)\perl
 # versioned installation can be obtained by setting INST_TOP above to a
 # path that includes an arbitrary version string.
 #
-INST_VER       = \5.25.3
+INST_VER       = \5.25.4
 
 #
 # Comment this out if you DON'T want your perl installation to have
index 7ae8d4f81e4a6eab778f334be0c828a9874d4c83..d61924e037d8d1adeec13391a77983c3cc7b0707 100644 (file)
@@ -221,6 +221,7 @@ d_fsync='undef'
 d_ftello='undef'
 d_ftime='define'
 d_futimes='undef'
+d_gai_strerror='undef'
 d_gdbm_ndbm_h_uses_prototypes='undef'
 d_gdbmndbm_h_uses_prototypes='undef'
 d_getaddrinfo='undef'
@@ -787,6 +788,7 @@ i_values='undef'
 i_varargs='undef'
 i_varhdr='varargs.h'
 i_vfork='undef'
+i_xlocale='undef'
 ignore_versioned_solibs=''
 inc_version_list=''
 inc_version_list_init='0'
index 3846db8b76bcfce7ad9e94f6323f57c6aee03c35..59a984a416306c7efdcf420d54002ba0aec21c8f 100644 (file)
  *     This symbol contains the ~name expanded version of ARCHLIB, to be used
  *     in programs that are not prepared to deal with ~ expansion at run-time.
  */
-#define ARCHLIB "c:\\perl\\5.25.3\\lib\\NetWare-x86-multi-thread"              /**/
+#define ARCHLIB "c:\\perl\\5.25.4\\lib\\NetWare-x86-multi-thread"              /**/
 /*#define ARCHLIB_EXP ""       /**/
 
 /* ARCHNAME:
  *     This symbol is the filename expanded version of the BIN symbol, for
  *     programs that do not want to deal with that at run-time.
  */
-#define BIN "c:\\perl\\5.25.3\\bin\\NetWare-x86-multi-thread"  /**/
-#define BIN_EXP "c:\\perl\\5.25.3\\bin\\NetWare-x86-multi-thread"      /**/
+#define BIN "c:\\perl\\5.25.4\\bin\\NetWare-x86-multi-thread"  /**/
+#define BIN_EXP "c:\\perl\\5.25.4\\bin\\NetWare-x86-multi-thread"      /**/
 
 /* BYTEORDER:
  *     This symbol holds the hexadecimal constant defined in byteorder,
  *     This symbol contains the ~name expanded version of SITEARCH, to be used
  *     in programs that are not prepared to deal with ~ expansion at run-time.
  */
-#define SITEARCH "c:\\perl\\site\\5.25.3\\lib\\NetWare-x86-multi-thread"               /**/
+#define SITEARCH "c:\\perl\\site\\5.25.4\\lib\\NetWare-x86-multi-thread"               /**/
 /*#define SITEARCH_EXP ""      /**/
 
 /* SITELIB:
  *     removed.  The elements in inc_version_list (inc_version_list.U) can
  *     be tacked onto this variable to generate a list of directories to search.
  */
-#define SITELIB "c:\\perl\\site\\5.25.3\\lib"          /**/
+#define SITELIB "c:\\perl\\site\\5.25.4\\lib"          /**/
 /*#define SITELIB_EXP ""       /**/
 #define SITELIB_STEM ""                /**/
 
index 750351e77ceb1aad6be5cc113bcbc23db371f79c..39a17b85ec638072da3b60d7d4d60548d77915e0 100644 (file)
@@ -983,6 +983,12 @@ d_futimes (d_futimes.U):
        This variable conditionally defines the HAS_FUTIMES symbol, which
        indicates to the C program that the futimes() routine is available.
 
+d_gai_strerror (d_gai_strerror.U):
+       This variable conditionally defines the HAS_GAI_STRERROR symbol
+       if the gai_strerror() routine is available and can be used to
+       translate error codes returned by getaddrinfo() into human
+       readable strings.
+
 d_Gconvert (d_gconvert.U):
        This variable holds what Gconvert is defined as to convert
        floating point numbers into strings.  By default, Configure
@@ -2009,6 +2015,11 @@ d_quad (quadtype.U):
        This variable, if defined, tells that there's a 64-bit integer type,
        quadtype.
 
+d_querylocale (d_newlocale.U):
+       This variable conditionally defines the HAS_QUERYLOCALE symbol, which
+       indicates to the C program that the querylocale() routine is available
+       to return the name of the locale for a category mask.
+
 d_random_r (d_random_r.U):
        This variable conditionally defines the HAS_RANDOM_R symbol,
        which indicates to the C program that the random_r()
@@ -2558,6 +2569,12 @@ d_strerror (d_strerror.U):
        This variable conditionally defines HAS_STRERROR if strerror() is
        available to translate error numbers to strings.
 
+d_strerror_l (d_strerror_l.U):
+       This variable conditionally defines the HAS_STRERROR_L symbol, which
+       indicates to the C program that the strerror_l() routine is available
+       to return the error message for a given errno value in a particular
+       locale (identified by a locale_t object).
+
 d_strerror_r (d_strerror_r.U):
        This variable conditionally defines the HAS_STRERROR_R symbol,
        which indicates to the C program that the strerror_r()
@@ -2913,6 +2930,9 @@ doublekind (longdblfio.U):
        6 = IEEE 754 128-bit big endian,
        7 = IEEE 754 64-bit mixed endian le-be,
        8 = IEEE 754 64-bit mixed endian be-le,
+       9 = VAX 32bit little endian F float format
+       10 = VAX 64bit little endian D float format
+       11 = VAX 64bit little endian G float format
        -1 = unknown format.
 
 doublemantbits (mantbits.U):
@@ -4170,8 +4190,9 @@ longdblkind (d_longdbl.U):
        4 = x86 80-bit big endian,
        5 = double-double 128-bit little endian,
        6 = double-double 128-bit big endian,
-       7 = 128-bit mixed double-double (64-bit LEs in BE),
-       8 = 128-bit mixed double-double (64-bit BEs in LE),
+       7 = 128-bit mixed-endian double-double (64-bit LEs in BE),
+       8 = 128-bit mixed-endian double-double (64-bit BEs in LE),
+       9 = 128-bit PDP-style mixed-endian long doubles,
        -1 = unknown format.
 
 longdblmantbits (mantbits.U):
index b617a1a9728360bb2200c730226d09ffedf0ab82..6fd65213e5472c3e7d1b6ab6cf8ad941379e5213 100755 (executable)
@@ -120,7 +120,7 @@ use File::Glob qw(:case);
 %Modules = (
 
     'Archive::Tar' => {
-        'DISTRIBUTION' => 'BINGOS/Archive-Tar-2.08.tar.gz',
+        'DISTRIBUTION' => 'BINGOS/Archive-Tar-2.10.tar.gz',
         'FILES'        => q[cpan/Archive-Tar],
         'BUGS'         => 'bug-archive-tar@rt.cpan.org',
         'EXCLUDED'     => [
@@ -181,6 +181,10 @@ use File::Glob qw(:case);
     'base' => {
         'DISTRIBUTION' => 'RJBS/base-2.23.tar.gz',
         'FILES'        => q[dist/base],
+        'CUSTOMIZED'   => [
+            # https://rt.perl.org/Ticket/Display.html?id=127834
+            qw( lib/base.pm )
+        ],
     },
 
     'bignum' => {
@@ -195,6 +199,13 @@ use File::Glob qw(:case);
                 t/03podcov.t
                 ),
         ],
+        'CUSTOMIZED'   => [
+            qw(
+               lib/Math/BigFloat/Trace.pm
+               lib/Math/BigInt/Trace.pm lib/bigint.pm
+               lib/bignum.pm lib/bigrat.pm
+            )
+        ],
     },
 
     'Carp' => {
@@ -227,7 +238,7 @@ use File::Glob qw(:case);
     },
 
     'Config::Perl::V' => {
-        'DISTRIBUTION' => 'HMBRAND/Config-Perl-V-0.26.tgz',
+        'DISTRIBUTION' => 'HMBRAND/Config-Perl-V-0.27.tgz',
         'FILES'        => q[cpan/Config-Perl-V],
         'EXCLUDED'     => [qw(
                examples/show-v.pl
@@ -283,19 +294,23 @@ use File::Glob qw(:case);
                 t/yaml_code.yml
                 ),
         ],
+        'CUSTOMIZED'   => [
+            # CVE-2016-1238
+            qw(
+               lib/App/Cpan.pm lib/CPAN.pm scripts/cpan
+            )
+        ],
     },
 
     # Note: When updating CPAN-Meta the META.* files will need to be regenerated
     # perl -Icpan/CPAN-Meta/lib Porting/makemeta
     'CPAN::Meta' => {
-        'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-2.150005.tar.gz',
+        'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-2.150010.tar.gz',
         'FILES'        => q[cpan/CPAN-Meta],
         'EXCLUDED'     => [
             qw[t/00-report-prereqs.t
                t/00-report-prereqs.dd
-               t/data-test/x_deprecated-META.json
-               t/data-valid/x_deprecated-META.yml
-               t/README-data.txt],
+              ],
             qr{^xt},
             qr{^history},
         ],
@@ -359,6 +374,10 @@ use File::Glob qw(:case);
         'DISTRIBUTION' => 'GAAS/Digest-1.17.tar.gz',
         'FILES'        => q[cpan/Digest],
         'EXCLUDED'     => ['digest-bench'],
+        'CUSTOMIZED'   => [
+            # CVE-2016-1238
+            qw( Digest.pm )
+        ],
     },
 
     'Digest::MD5' => {
@@ -368,7 +387,7 @@ use File::Glob qw(:case);
     },
 
     'Digest::SHA' => {
-        'DISTRIBUTION' => 'MSHELOR/Digest-SHA-5.95.tar.gz',
+        'DISTRIBUTION' => 'MSHELOR/Digest-SHA-5.96.tar.gz',
         'FILES'        => q[cpan/Digest-SHA],
         'EXCLUDED'     => [
             qw( t/pod.t
@@ -385,19 +404,9 @@ use File::Glob qw(:case);
     },
 
     'Encode' => {
-        'DISTRIBUTION' => 'DANKOGAI/Encode-2.84.tar.gz',
+        'DISTRIBUTION' => 'DANKOGAI/Encode-2.86.tar.gz',
         'FILES'        => q[cpan/Encode],
-        CUSTOMIZED     => [
-            qw( encoding.pm
-                Byte/Makefile.PL
-                t/enc_data.t
-                t/enc_eucjp.t
-                t/enc_module.t
-                t/enc_utf8.t
-                t/encoding.t
-                t/jperl.t
-                ),
-        ],
+        'CUSTOMIZED'   => [ qw[ Encode.xs ] ],
     },
 
     'encoding::warnings' => {
@@ -469,7 +478,7 @@ use File::Glob qw(:case);
     },
 
     'ExtUtils::MakeMaker' => {
-        'DISTRIBUTION' => 'BINGOS/ExtUtils-MakeMaker-7.18.tar.gz',
+        'DISTRIBUTION' => 'BINGOS/ExtUtils-MakeMaker-7.24.tar.gz',
         'FILES'        => q[cpan/ExtUtils-MakeMaker],
         'EXCLUDED'     => [
             qr{^t/lib/Test/},
@@ -481,7 +490,6 @@ use File::Glob qw(:case);
             'README.packaging',
             'lib/ExtUtils/MakeMaker/version/vpp.pm',
         ],
-        'CUSTOMIZED' => [ qw( t/basic.t t/lib/MakeMaker/Test/Setup/XS.pm ) ],
     },
 
     'ExtUtils::Manifest' => {
@@ -499,7 +507,7 @@ use File::Glob qw(:case);
     },
 
     'File::Fetch' => {
-        'DISTRIBUTION' => 'BINGOS/File-Fetch-0.48.tar.gz',
+        'DISTRIBUTION' => 'BINGOS/File-Fetch-0.52.tar.gz',
         'FILES'        => q[cpan/File-Fetch],
     },
 
@@ -583,7 +591,7 @@ use File::Glob qw(:case);
     },
 
     'HTTP::Tiny' => {
-        'DISTRIBUTION' => 'DAGOLDEN/HTTP-Tiny-0.058.tar.gz',
+        'DISTRIBUTION' => 'DAGOLDEN/HTTP-Tiny-0.064.tar.gz',
         'FILES'        => q[cpan/HTTP-Tiny],
         'EXCLUDED'     => [
             't/00-report-prereqs.t',
@@ -627,10 +635,41 @@ use File::Glob qw(:case);
             't/010examples-zlib.t',
             't/cz-05examples.t',
         ],
+        'CUSTOMIZED'   => [
+            # CVE-2016-1238
+            qw(
+               bin/zipdetails lib/Compress/Zlib.pm
+               lib/IO/Compress/Adapter/Bzip2.pm
+               lib/IO/Compress/Adapter/Deflate.pm
+               lib/IO/Compress/Adapter/Identity.pm
+               lib/IO/Compress/Base.pm
+               lib/IO/Compress/Base/Common.pm
+               lib/IO/Compress/Bzip2.pm
+               lib/IO/Compress/Deflate.pm
+               lib/IO/Compress/Gzip.pm
+               lib/IO/Compress/Gzip/Constants.pm
+               lib/IO/Compress/RawDeflate.pm
+               lib/IO/Compress/Zip.pm
+               lib/IO/Compress/Zip/Constants.pm
+               lib/IO/Compress/Zlib/Constants.pm
+               lib/IO/Compress/Zlib/Extra.pm
+               lib/IO/Uncompress/Adapter/Bunzip2.pm
+               lib/IO/Uncompress/Adapter/Identity.pm
+               lib/IO/Uncompress/Adapter/Inflate.pm
+               lib/IO/Uncompress/AnyInflate.pm
+               lib/IO/Uncompress/AnyUncompress.pm
+               lib/IO/Uncompress/Base.pm
+               lib/IO/Uncompress/Bunzip2.pm
+               lib/IO/Uncompress/Gunzip.pm
+               lib/IO/Uncompress/Inflate.pm
+               lib/IO/Uncompress/RawInflate.pm
+               lib/IO/Uncompress/Unzip.pm
+            )
+        ],
     },
 
     'IO::Socket::IP' => {
-        'DISTRIBUTION' => 'PEVANS/IO-Socket-IP-0.37.tar.gz',
+        'DISTRIBUTION' => 'PEVANS/IO-Socket-IP-0.38.tar.gz',
         'FILES'        => q[cpan/IO-Socket-IP],
         'EXCLUDED'     => [
             qr{^examples/},
@@ -643,7 +682,7 @@ use File::Glob qw(:case);
     },
 
     'IPC::Cmd' => {
-        'DISTRIBUTION' => 'BINGOS/IPC-Cmd-0.94.tar.gz',
+        'DISTRIBUTION' => 'BINGOS/IPC-Cmd-0.96.tar.gz',
         'FILES'        => q[cpan/IPC-Cmd],
     },
 
@@ -660,6 +699,10 @@ use File::Glob qw(:case);
     'JSON::PP' => {
         'DISTRIBUTION' => 'MAKAMAKA/JSON-PP-2.27400.tar.gz',
         'FILES'        => q[cpan/JSON-PP],
+        'CUSTOMIZED'   => [
+            # CVE-2016-1238
+            qw( bin/json_pp lib/JSON/PP.pm ),
+        ],
     },
 
     'lib' => {
@@ -673,7 +716,7 @@ use File::Glob qw(:case);
     },
 
     'libnet' => {
-        'DISTRIBUTION' => 'SHAY/libnet-3.09.tar.gz',
+        'DISTRIBUTION' => 'SHAY/libnet-3.10.tar.gz',
         'FILES'        => q[cpan/libnet],
         'EXCLUDED'     => [
             qw( Configure
@@ -703,7 +746,7 @@ use File::Glob qw(:case);
     },
 
     'Locale::Maketext' => {
-        'DISTRIBUTION' => 'TODDR/Locale-Maketext-1.27.tar.gz',
+        'DISTRIBUTION' => 'TODDR/Locale-Maketext-1.28.tar.gz',
         'FILES'        => q[dist/Locale-Maketext],
         'EXCLUDED'     => [
             qw(
@@ -717,6 +760,10 @@ use File::Glob qw(:case);
     'Locale::Maketext::Simple' => {
         'DISTRIBUTION' => 'JESSE/Locale-Maketext-Simple-0.21.tar.gz',
         'FILES'        => q[cpan/Locale-Maketext-Simple],
+        'CUSTOMIZED'   => [
+            # CVE-2016-1238
+            qw( lib/Locale/Maketext/Simple.pm )
+        ],
     },
 
     'Math::BigInt' => {
@@ -785,6 +832,10 @@ use File::Glob qw(:case);
         'DISTRIBUTION' => 'MJD/Memoize-1.03.tgz',
         'FILES'        => q[cpan/Memoize],
         'EXCLUDED'     => ['article.html'],
+        'CUSTOMIZED'   => [
+            # CVE-2016-1238
+            qw( Memoize.pm )
+        ],
     },
 
     'MIME::Base64' => {
@@ -794,7 +845,7 @@ use File::Glob qw(:case);
     },
 
     'Module::CoreList' => {
-        'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20160620.tar.gz',
+        'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20160720.tar.gz',
         'FILES'        => q[dist/Module-CoreList],
     },
 
@@ -804,7 +855,7 @@ use File::Glob qw(:case);
     },
 
     'Module::Load::Conditional' => {
-        'DISTRIBUTION' => 'BINGOS/Module-Load-Conditional-0.64.tar.gz',
+        'DISTRIBUTION' => 'BINGOS/Module-Load-Conditional-0.68.tar.gz',
         'FILES'        => q[cpan/Module-Load-Conditional],
     },
 
@@ -814,7 +865,7 @@ use File::Glob qw(:case);
     },
 
     'Module::Metadata' => {
-        'DISTRIBUTION' => 'ETHER/Module-Metadata-1.000032-TRIAL.tar.gz',
+        'DISTRIBUTION' => 'ETHER/Module-Metadata-1.000033.tar.gz',
         'FILES'        => q[cpan/Module-Metadata],
         'EXCLUDED'     => [
             qw(t/00-report-prereqs.t),
@@ -822,9 +873,6 @@ use File::Glob qw(:case);
             qr{weaver.ini},
             qr{^xt},
         ],
-        # https://rt.perl.org/Ticket/Display.html?id=128160
-       # https://github.com/Perl-Toolchain-Gang/Module-Metadata/commit/59b3f5b45ff862a1a422a409518255736fe81b66
-        'CUSTOMIZED'   => [ qw[ t/extract-package.t t/metadata.t ] ],
     },
 
     'Net::Ping' => {
@@ -833,7 +881,7 @@ use File::Glob qw(:case);
     },
 
     'NEXT' => {
-        'DISTRIBUTION' => 'FLORA/NEXT-0.65.tar.gz',
+        'DISTRIBUTION' => 'NEILB/NEXT-0.67.tar.gz',
         'FILES'        => q[cpan/NEXT],
         'EXCLUDED'     => [qr{^demo/}],
     },
@@ -848,16 +896,6 @@ use File::Glob qw(:case);
         'FILES'        => q[cpan/parent],
     },
 
-    'Parse::CPAN::Meta' => {
-        'DISTRIBUTION' => 'DAGOLDEN/Parse-CPAN-Meta-1.4422.tar.gz',
-        'FILES'        => q[cpan/Parse-CPAN-Meta],
-        'EXCLUDED'     => [
-            qw[t/00-report-prereqs.dd],
-            qw[t/00-report-prereqs.t],
-            qr{^xt},
-        ],
-    },
-
     'PathTools' => {
         'DISTRIBUTION' => 'RJBS/PathTools-3.62.tar.gz',
         'FILES'        => q[dist/PathTools],
@@ -911,21 +949,22 @@ use File::Glob qw(:case);
     },
 
     'Pod::Perldoc' => {
-        'DISTRIBUTION' => 'MALLEN/Pod-Perldoc-3.25.tar.gz',
+        'DISTRIBUTION' => 'MALLEN/Pod-Perldoc-3.27.tar.gz',
         'FILES'        => q[cpan/Pod-Perldoc],
 
         # Note that we use the CPAN-provided Makefile.PL, since it
         # contains special handling of the installation of perldoc.pod
 
-        # In blead, the perldoc executable is generated by perldoc.PL
-        # instead
-        # XXX We can and should fix this, but clean up the DRY-failure in utils
-        # first
-        'EXCLUDED' => ['perldoc'],
-
-        # https://rt.cpan.org/Ticket/Display.html?id=106798
-        # https://rt.cpan.org/Ticket/Display.html?id=110368
-        'CUSTOMIZED'   => [ qw[ lib/Pod/Perldoc.pm ] ],
+        'EXCLUDED' => [
+            # In blead, the perldoc executable is generated by perldoc.PL
+            # instead
+            # XXX We can and should fix this, but clean up the DRY-failure in
+            # utils first
+            'perldoc',
+
+            # https://rt.cpan.org/Ticket/Display.html?id=116827
+            't/02_module_pod_output.t'
+        ],
     },
 
     'Pod::Simple' => {
@@ -1013,6 +1052,10 @@ use File::Glob qw(:case);
                 win32/PerlLog.RES
                 ),
         ],
+        'CUSTOMIZED'   => [
+            # CVE-2016-1238
+            qw( Syslog.pm )
+        ],
     },
 
     'Term::ANSIColor' => {
@@ -1063,15 +1106,64 @@ use File::Glob qw(:case);
                 t/lib/if.pm
                 ),
         ],
+        'CUSTOMIZED'   => [
+            # CVE-2016-1238
+            qw(
+               bin/prove lib/App/Prove.pm lib/App/Prove/State.pm
+               lib/App/Prove/State/Result.pm
+               lib/App/Prove/State/Result/Test.pm
+               lib/TAP/Base.pm lib/TAP/Formatter/Base.pm
+               lib/TAP/Formatter/Color.pm
+               lib/TAP/Formatter/Console.pm
+               lib/TAP/Formatter/Console/ParallelSession.pm
+               lib/TAP/Formatter/Console/Session.pm
+               lib/TAP/Formatter/File.pm
+               lib/TAP/Formatter/File/Session.pm
+               lib/TAP/Formatter/Session.pm lib/TAP/Harness.pm
+               lib/TAP/Harness/Env.pm lib/TAP/Object.pm
+               lib/TAP/Parser.pm lib/TAP/Parser/Aggregator.pm
+               lib/TAP/Parser/Grammar.pm
+               lib/TAP/Parser/Iterator.pm
+               lib/TAP/Parser/Iterator/Array.pm
+               lib/TAP/Parser/Iterator/Process.pm
+               lib/TAP/Parser/Iterator/Stream.pm
+               lib/TAP/Parser/IteratorFactory.pm
+               lib/TAP/Parser/Multiplexer.pm
+               lib/TAP/Parser/Result.pm
+               lib/TAP/Parser/Result/Bailout.pm
+               lib/TAP/Parser/Result/Comment.pm
+               lib/TAP/Parser/Result/Plan.pm
+               lib/TAP/Parser/Result/Pragma.pm
+               lib/TAP/Parser/Result/Test.pm
+               lib/TAP/Parser/Result/Unknown.pm
+               lib/TAP/Parser/Result/Version.pm
+               lib/TAP/Parser/Result/YAML.pm
+               lib/TAP/Parser/ResultFactory.pm
+               lib/TAP/Parser/Scheduler.pm
+               lib/TAP/Parser/Scheduler/Job.pm
+               lib/TAP/Parser/Scheduler/Spinner.pm
+               lib/TAP/Parser/Source.pm
+               lib/TAP/Parser/SourceHandler.pm
+               lib/TAP/Parser/SourceHandler/Executable.pm
+               lib/TAP/Parser/SourceHandler/File.pm
+               lib/TAP/Parser/SourceHandler/Handle.pm
+               lib/TAP/Parser/SourceHandler/Perl.pm
+               lib/TAP/Parser/SourceHandler/RawTAP.pm
+               lib/TAP/Parser/YAMLish/Reader.pm
+               lib/TAP/Parser/YAMLish/Writer.pm
+               lib/Test/Harness.pm
+            )
+        ],
     },
 
     'Test::Simple' => {
-        'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302045.tar.gz',
+        'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302052.tar.gz',
         'FILES'        => q[cpan/Test-Simple],
         'EXCLUDED'     => [
             qr{^examples/},
             qr{^xt/},
-            qw( perltidyrc
+            qw( appveyor.yml
+                perltidyrc
                 t/00compile.t
                 t/00-report.t
                 t/zzz-check-breaks.t
@@ -1183,10 +1275,16 @@ use File::Glob qw(:case);
     },
 
     'Time::Local' => {
-        'DISTRIBUTION' => 'DROLSKY/Time-Local-1.2300.tar.gz',
+        'DISTRIBUTION' => 'DROLSKY/Time-Local-1.24.tar.gz',
         'FILES'        => q[cpan/Time-Local],
         'EXCLUDED'     => [
-            qr{^t/release-.*\.t},
+            qr{^xt/},
+            qw( perlcriticrc
+                perltidyrc
+                tidyall.ini
+                t/00-report-prereqs.t
+                t/00-report-prereqs.dd
+                ),
         ],
     },
 
@@ -1361,6 +1459,7 @@ use File::Glob qw(:case);
                 lib/FileHandle.{pm,t}
                 lib/FindBin.{pm,t}
                 lib/Getopt/Std.{pm,t}
+                lib/Internals.pod
                 lib/Internals.t
                 lib/meta_notation.{pm,t}
                 lib/Net/hostent.{pm,t}
@@ -1409,6 +1508,7 @@ use File::Glob qw(:case);
                 lib/integer.{pm,t}
                 lib/less.{pm,t}
                 lib/locale.{pm,t}
+                lib/locale_threads.t
                 lib/open.{pm,t}
                 lib/overload/numbers.pm
                 lib/overloading.{pm,t}
index 6b28ea7e58c5cd8f8467dff8254a52e35fd12569..ef56abb9121472eca644d6f636f1230146fd5e7c 100644 (file)
@@ -22,7 +22,7 @@ use vars qw(@ISA @EXPORT_OK $VERSION);
                show_results process_options files_to_modules
                finish_tap_output
                reload_manifest);
-$VERSION = 0.10;
+$VERSION = 0.11;
 
 require Exporter;
 
@@ -356,7 +356,7 @@ sub duplicated_maintainers {
 
 sub warn_maintainer {
     my $name = shift;
-    ok($files{$name}, "$name has a maintainer");
+    ok($files{$name}, "$name has a maintainer (see Porting/Maintainer.pl)");
 }
 
 sub missing_maintainers {
index 13791ca48150fb23c6221992f492ecc3714a833e..b185ff88a57540da24939c0ace81d4faa1392e17 100755 (executable)
@@ -731,6 +731,7 @@ marcel\100codewerk.com                  gr\100univie.ac.at
 +                                       hanekomu\100gmail.com
 marcgreen\100cpan.org                   marcgreen\100wpi.edu
 markleightonfisher\100gmail.com         fisherm\100tce.com
++                                       mark-fisher\100mindspring.com
 mark.p.lutz\100boeing.com               tecmpl1\100triton.ca.boeing.com
 marnix\100gmail.com                     pttesac!marnix!vanam
 marty+p5p\100kasei.com                  marty\100martian.org
index 5609a92b3424d8017cd63911af3b8ea222d0843c..4f6e6434bf2bd1e4d56992021c4db0761dde73a0 100644 (file)
@@ -39,12 +39,12 @@ alignbytes='8'
 ansi2knr=''
 aphostname='/bin/hostname'
 api_revision='5'
-api_subversion='3'
+api_subversion='4'
 api_version='25'
-api_versionstring='5.25.3'
+api_versionstring='5.25.4'
 ar='ar'
-archlib='/tmp/mblead/lib/perl5/5.25.3/darwin-2level'
-archlibexp='/tmp/mblead/lib/perl5/5.25.3/darwin-2level'
+archlib='/tmp/mblead/lib/perl5/5.25.4/darwin-2level'
+archlibexp='/tmp/mblead/lib/perl5/5.25.4/darwin-2level'
 archname64=''
 archname='darwin-2level'
 archobjs=''
@@ -242,6 +242,7 @@ d_fsync='define'
 d_ftello='define'
 d_ftime='undef'
 d_futimes='define'
+d_gai_strerror='undef'
 d_gdbm_ndbm_h_uses_prototypes='undef'
 d_gdbmndbm_h_uses_prototypes='undef'
 d_getaddrinfo='define'
@@ -831,7 +832,7 @@ incpath=''
 incpth='/usr/local/include /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/../lib/clang/6.0/include /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/include /usr/include /usr/local/include /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/../lib/clang/6.0/include /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/include /usr/include /usr/local/include /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin/../lib/clang/6.0/include /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/include /usr/include'
 inews=''
 initialinstalllocation='/tmp/mblead/bin'
-installarchlib='/tmp/mblead/lib/perl5/5.25.3/darwin-2level'
+installarchlib='/tmp/mblead/lib/perl5/5.25.4/darwin-2level'
 installbin='/tmp/mblead/bin'
 installhtml1dir=''
 installhtml3dir=''
@@ -839,13 +840,13 @@ installman1dir='/tmp/mblead/man/man1'
 installman3dir='/tmp/mblead/man/man3'
 installprefix='/tmp/mblead'
 installprefixexp='/tmp/mblead'
-installprivlib='/tmp/mblead/lib/perl5/5.25.3'
+installprivlib='/tmp/mblead/lib/perl5/5.25.4'
 installscript='/tmp/mblead/bin'
-installsitearch='/tmp/mblead/lib/perl5/site_perl/5.25.3/darwin-2level'
+installsitearch='/tmp/mblead/lib/perl5/site_perl/5.25.4/darwin-2level'
 installsitebin='/tmp/mblead/bin'
 installsitehtml1dir=''
 installsitehtml3dir=''
-installsitelib='/tmp/mblead/lib/perl5/site_perl/5.25.3'
+installsitelib='/tmp/mblead/lib/perl5/site_perl/5.25.4'
 installsiteman1dir='/tmp/mblead/man/man1'
 installsiteman3dir='/tmp/mblead/man/man3'
 installsitescript='/tmp/mblead/bin'
@@ -970,7 +971,7 @@ perl_patchlevel=''
 perl_static_inline='static __inline__'
 perladmin='aaron@daybreak.nonet'
 perllibs='-lpthread -ldl -lm -lutil -lc'
-perlpath='/tmp/mblead/bin/perl5.25.3'
+perlpath='/tmp/mblead/bin/perl5.25.4'
 pg='pg'
 phostname='hostname'
 pidtype='pid_t'
@@ -979,8 +980,8 @@ pmake=''
 pr=''
 prefix='/tmp/mblead'
 prefixexp='/tmp/mblead'
-privlib='/tmp/mblead/lib/perl5/5.25.3'
-privlibexp='/tmp/mblead/lib/perl5/5.25.3'
+privlib='/tmp/mblead/lib/perl5/5.25.4'
+privlibexp='/tmp/mblead/lib/perl5/5.25.4'
 procselfexe=''
 prototype='define'
 ptrsize='8'
@@ -1046,17 +1047,17 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 6, 0'
 sig_size='33'
 signal_t='void'
-sitearch='/tmp/mblead/lib/perl5/site_perl/5.25.3/darwin-2level'
-sitearchexp='/tmp/mblead/lib/perl5/site_perl/5.25.3/darwin-2level'
+sitearch='/tmp/mblead/lib/perl5/site_perl/5.25.4/darwin-2level'
+sitearchexp='/tmp/mblead/lib/perl5/site_perl/5.25.4/darwin-2level'
 sitebin='/tmp/mblead/bin'
 sitebinexp='/tmp/mblead/bin'
 sitehtml1dir=''
 sitehtml1direxp=''
 sitehtml3dir=''
 sitehtml3direxp=''
-sitelib='/tmp/mblead/lib/perl5/site_perl/5.25.3'
+sitelib='/tmp/mblead/lib/perl5/site_perl/5.25.4'
 sitelib_stem='/tmp/mblead/lib/perl5/site_perl'
-sitelibexp='/tmp/mblead/lib/perl5/site_perl/5.25.3'
+sitelibexp='/tmp/mblead/lib/perl5/site_perl/5.25.4'
 siteman1dir='/tmp/mblead/man/man1'
 siteman1direxp='/tmp/mblead/man/man1'
 siteman3dir='/tmp/mblead/man/man3'
@@ -1082,7 +1083,7 @@ src='.'
 ssizetype='ssize_t'
 st_ino_sign='1'
 st_ino_size='8'
-startperl='#!/tmp/mblead/bin/perl5.25.3'
+startperl='#!/tmp/mblead/bin/perl5.25.4'
 startsh='#!/bin/sh'
 static_ext=' '
 stdchar='char'
@@ -1095,7 +1096,7 @@ stdio_stream_array=''
 strerror_r_proto='0'
 strings='/usr/include/string.h'
 submit=''
-subversion='3'
+subversion='4'
 sysman='/usr/share/man/man1'
 sysroot=''
 tail=''
@@ -1194,8 +1195,8 @@ vendorprefix=''
 vendorprefixexp=''
 vendorscript=''
 vendorscriptexp=''
-version='5.25.3'
-version_patchlevel_string='version 25 subversion 3'
+version='5.25.4'
+version_patchlevel_string='version 25 subversion 4'
 versiononly='define'
 vi=''
 xlibpth='/usr/lib/386 /lib/386'
@@ -1205,9 +1206,9 @@ zcat=''
 zip='zip'
 PERL_REVISION=5
 PERL_VERSION=25
-PERL_SUBVERSION=3
+PERL_SUBVERSION=4
 PERL_API_REVISION=5
 PERL_API_VERSION=25
-PERL_API_SUBVERSION=3
+PERL_API_SUBVERSION=4
 PERL_PATCHLEVEL=''
 PERL_CONFIG_SH=true
index b90afc7193976745ad0eebddfd65ade656160a6a..2522426f674b8b93c4b31a09f52c1dc5ee22d0ba 100644 (file)
  *     This symbol contains the ~name expanded version of ARCHLIB, to be used
  *     in programs that are not prepared to deal with ~ expansion at run-time.
  */
-#define ARCHLIB "/pro/lib/perl5/5.25.3/i686-linux-64int-ld"            /**/
-#define ARCHLIB_EXP "/pro/lib/perl5/5.25.3/i686-linux-64int-ld"                /**/
+#define ARCHLIB "/pro/lib/perl5/5.25.4/i686-linux-64int-ld"            /**/
+#define ARCHLIB_EXP "/pro/lib/perl5/5.25.4/i686-linux-64int-ld"                /**/
 
 /* ARCHNAME:
  *     This symbol holds a string representing the architecture name.
  *     This symbol contains the ~name expanded version of PRIVLIB, to be used
  *     in programs that are not prepared to deal with ~ expansion at run-time.
  */
-#define PRIVLIB "/pro/lib/perl5/5.25.3"                /**/
-#define PRIVLIB_EXP "/pro/lib/perl5/5.25.3"            /**/
+#define PRIVLIB "/pro/lib/perl5/5.25.4"                /**/
+#define PRIVLIB_EXP "/pro/lib/perl5/5.25.4"            /**/
 
 /* PTRSIZE:
  *     This symbol contains the size of a pointer, so that the C preprocessor
  *     This symbol contains the ~name expanded version of SITEARCH, to be used
  *     in programs that are not prepared to deal with ~ expansion at run-time.
  */
-#define SITEARCH "/pro/lib/perl5/site_perl/5.25.3/i686-linux-64int-ld"         /**/
-#define SITEARCH_EXP "/pro/lib/perl5/site_perl/5.25.3/i686-linux-64int-ld"             /**/
+#define SITEARCH "/pro/lib/perl5/site_perl/5.25.4/i686-linux-64int-ld"         /**/
+#define SITEARCH_EXP "/pro/lib/perl5/site_perl/5.25.4/i686-linux-64int-ld"             /**/
 
 /* SITELIB:
  *     This symbol contains the name of the private library for this package.
  *     removed.  The elements in inc_version_list (inc_version_list.U) can
  *     be tacked onto this variable to generate a list of directories to search.
  */
-#define SITELIB "/pro/lib/perl5/site_perl/5.25.3"              /**/
-#define SITELIB_EXP "/pro/lib/perl5/site_perl/5.25.3"          /**/
+#define SITELIB "/pro/lib/perl5/site_perl/5.25.4"              /**/
+#define SITELIB_EXP "/pro/lib/perl5/site_perl/5.25.4"          /**/
 #define SITELIB_STEM "/pro/lib/perl5/site_perl"                /**/
 
 /* SSize_t:
  *     script to make sure (one hopes) that it runs with perl and not
  *     some shell.
  */
-#define STARTPERL "#!/pro/bin/perl5.25.3"              /**/
+#define STARTPERL "#!/pro/bin/perl5.25.4"              /**/
 
 /* HAS_STDIO_STREAM_ARRAY:
  *     This symbol, if defined, tells that there is an array
index 18a2fcb61c7d5cc48dce15312990c356ee82ab1c..7e77d717a482446668e16548b757ad075fe192ea 100644 (file)
@@ -36,17 +36,8 @@ __DEPARSE_FAILURES__
 ../cpan/autodie/t/internal.t
 ../cpan/AutoLoader/t/01AutoLoader.t
 ../cpan/CGI/t/utf8.t
-../cpan/Encode/t/enc_data.t
-../cpan/Encode/t/encoding.t
-../cpan/Encode/t/jperl.t
-../cpan/ExtUtils-Install/t/Installapi2.t
-../cpan/ExtUtils-Install/t/Packlist.t
 ../cpan/ExtUtils-MakeMaker/t/xs.t
-../cpan/ExtUtils-Manifest/t/Manifest.t
 ../cpan/File-Path/t/taint.t
-../cpan/File-Temp/t/object.t
-../cpan/IO-Compress/t/050interop-gzip.t
-../cpan/IO-Compress/t/cz-08encoding.t
 ../cpan/Module-Build/t/manifypods_with_utf8.t
 ../cpan/Socket/t/sockaddr.t
 ../cpan/Term-ANSIColor/t/taint.t
@@ -99,7 +90,6 @@ __DEPARSE_FAILURES__
 ../dist/Data-Dumper/t/dumper.t
 ../dist/Exporter/t/Exporter.t
 ../dist/Filter-Simple/t/data.t
-../dist/I18N-LangTags/t/50_super.t
 ../dist/IO/t/io_file_export.t
 ../dist/IO/t/io_multihomed.t
 ../dist/IO/t/io_sel.t
@@ -117,9 +107,7 @@ __DEPARSE_FAILURES__
 ../dist/PathTools/t/cwd.t
 ../dist/Storable/t/blessed.t
 ../dist/Storable/t/croak.t
-../dist/Term-ReadLine/t/ReadLine.t
 ../dist/Thread-Queue/t/08_nothreads.t
-../dist/Tie-File/t/42_offset.t
 ../dist/bignum/t/big_e_pi.t
 ../dist/bignum/t/bigexp.t
 ../dist/bignum/t/bigint.t
@@ -147,33 +135,20 @@ __DEPARSE_FAILURES__
 ../ext/B/t/optree_samples.t
 ../ext/B/t/xref.t
 ../ext/Devel-Peek/t/Peek.t
-../ext/File-Glob/t/basic.t
 ../ext/File-Glob/t/taint.t
 ../ext/Hash-Util/t/Util.t
 ../ext/IPC-Open3/t/IPC-Open2.t
 ../ext/IPC-Open3/t/IPC-Open3.t
-../ext/Opcode/t/Opcode.t
-../ext/PerlIO-via/t/via.t
 ../ext/XS-APItest/t/autoload.t
 ../ext/XS-APItest/t/blockhooks.t
 ../ext/XS-APItest/t/call_checker.t
 ../ext/XS-APItest/t/cleanup.t
 ../ext/XS-APItest/t/fetch_pad_names.t
-../ext/XS-APItest/t/overload.t
 ../ext/XS-APItest/t/svpeek.t
-../ext/XS-APItest/t/xsub_h.t
 ../lib/DB.t
-../lib/DBM_Filter/t/01error.t
-../lib/DBM_Filter/t/02core.t
-../lib/DBM_Filter/t/compress.t
-../lib/DBM_Filter/t/encode.t
-../lib/DBM_Filter/t/int32.t
-../lib/DBM_Filter/t/null.t
-../lib/DBM_Filter/t/utf8.t
 ../lib/English.t
 ../lib/File/Basename.t
 ../lib/charnames.t
-../lib/less.t
 ../lib/overload.t
 base/lex.t                # checks regexp stringification
 comp/final_line_num.t     # tests syntax error after BEGIN block
@@ -200,7 +175,6 @@ op/pack.t
 op/postfixderef.t
 op/range.t
 op/readline.t
-op/signatures.t
 op/split.t
 op/srand.t
 op/sub.t
@@ -225,10 +199,8 @@ run/switchI.t             # -I on #! line is not deparsed
 run/switchd-78586.t       # -I on #! line is not deparsed
 uni/attrs.t
 uni/bless.t
-uni/greek.t
 uni/gv.t
 uni/labels.t
-uni/latin2.t
 uni/lex_utf8.t
 uni/method.t
 uni/package.t
@@ -243,5 +215,4 @@ __DEPARSE_SKIPS__
 
 op/smartkve.t                        # Gobbles up all memory...
 comp/redef.t                         # Redefinition happens at compile time
-lib/Switch/t/                        # B::Deparse doesn't support source filtering
 ../lib/locale.t                      # Memory...
index beac79202d1f06da7d7814bd4afe0267f24fa455..fc7a18da3f9e3e03ba2e436c14ffd8f644aeefcf 100644 (file)
@@ -17,6 +17,38 @@ Consult your favorite dictionary for details.
 
 =head1 EPIGRAPHS
 
+=head2 v5.25.3 - Edward Lear, ed. Vivien Noakes, "The Complete Nonsense and Other Verse": The Dong with a Luminous Nose
+
+L<Announced on 2016-07-20 by Steve Hay|http://www.nntp.perl.org/group/perl.perl5.porters/2016/07/msg238158.html>
+
+  When awful darkness and silence reign
+    Over the great Gromboolian plain,
+      Through the long, long wintry nights; -
+  When the angry breakers roar
+  As they beat on the rocky shore; -
+      When Storm-clouds brood on the towering heights
+  Of the Hills of the Chankly Bore: -
+
+  Then, through the vast and gloomy dark,
+  There moves what seems a fiery spark,
+      A lonely spark with silvery rays
+      Piercing the coal-black night, -
+      A Meteor strange and bright: -
+  Hither and thither the vision strays,
+      A single lurid light.
+
+  Slowly it wanders, - pauses, - creeps, -
+  Anon it sparkles, - flashes and leaps;
+  And ever as onward it gleaming goes
+  A light on the Bong-tree stems it throws.
+  And those who watch at that midnight hour
+  From Hall or Terrace, or lofty Tower,
+  Cry, as the wild light passes along, -
+        'The Dong! - the Dong!
+      The wandering Dong through the forest goes!
+        The Dong! the Dong!
+      The Dong with a luminous Nose!'
+
 =head2 v5.25.2 - Dan le Sac Vs Scroobius Pip "Waiting For The Beat To Kick In"
 
 L<Announced on 2016-06-20 by Matthew Horsfall|http://www.nntp.perl.org/group/perl.perl5.porters/2016/06/msg237274.html>
@@ -62,6 +94,42 @@ L<Announced on 2016-05-09 by Ricardo Signes|http://www.nntp.perl.org/group/perl.
   To find that the utmost reward
     Of daring should be still to dare.
 
+=head2 v5.24.1-RC3 - Dante Alighieri, trans. Dorothy L. Sayers and Barbara Reynolds, "The Divine Comedy", Cantica III: Paradise, Canto XXIII
+
+L<Announced on 2016-08-11 by Steve Hay|http://www.nntp.perl.org/group/perl.perl5.porters/2016/08/msg238909.html>
+
+  A bird within the bower of her delight,
+    Quiet upon the nest with her sweet brood
+    Throughout the dark concealment of the night,
+
+  Anxious to look on them and gather food -
+    No weary task for her, for as at play
+    Blithely she toils to seek her fledglings' good -
+
+  Before the time, upon the topmost spray
+    Eager awaits the sun and on the East
+    Fixes her wakeful eye till break of day.
+
+=head2 v5.24.1-RC2 - Dante Alighieri, trans. Dorothy L. Sayers, "The Divine Comedy", Cantica II: Purgatory, Canto X
+
+L<Announced on 2016-07-25 by Steve Hay|http://www.nntp.perl.org/group/perl.perl5.porters/2016/07/msg238269.html>
+
+  When we had crossed the threshold of that gate
+    Which the soul's evil loves put out of use,
+    Because they make the crooked path seem straight,
+
+  I heard its closing clang ring clamorous,
+    And had I then turned back my eyes to it
+    How could my fault have found the least excuse?
+
+  We had to climb now through a rocky slit
+    Which ran from side to side in many a swerve,
+    As runs the wave in onset and retreat.
+
+  "Now here," the master said, "we must observe
+    Some little caution, hugging now this wall,
+    Now that, upon the far side of the curve."
+
 =head2 v5.24.1-RC1 - Dante Alighieri, trans. Dorothy L. Sayers, "The Divine Comedy", Cantica I: Hell, Canto XX
 
 L<Announced on 2016-07-17 by Steve Hay|http://www.nntp.perl.org/group/perl.perl5.porters/2016/07/msg238072.html>
@@ -462,6 +530,42 @@ L<Announced on 2015-06-20 by Ricardo Signes|http://www.nntp.perl.org/group/perl.
   They sing while you slave and I just get bored
   I ain't gonna work on Maggie's farm no more
 
+=head2 v5.22.3-RC3 - Dante Alighieri, trans. Dorothy L. Sayers and Barbara Reynolds, "The Divine Comedy", Cantica III: Paradise, Canto IV
+
+L<Announced on 2016-08-11 by Steve Hay|http://www.nntp.perl.org/group/perl.perl5.porters/2016/08/msg238908.html>
+
+  Between two dishes, equally attractive
+    And near to him, a free man, I suppose,
+    Would starve to death before his teeth got active;
+
+  So would a lamb 'twixt two fierce wolfish foes,
+    Fearing the fangs both ways, not stir a foot;
+    So would a deerhound halt between two does;
+
+  So I can't blame myself for standing mute,
+    Nor praise myself: for I must needs so do,
+    Suspended 'twixt two doubts, alike acute.
+
+=head2 v5.22.3-RC2 - Dante Alighieri, trans. Dorothy L. Sayers, "The Divine Comedy", Cantica II: Purgatory, Canto I
+
+L<Announced on 2016-07-25 by Steve Hay|http://www.nntp.perl.org/group/perl.perl5.porters/2016/07/msg238270.html>
+
+  For better waters heading with the wind
+    My ship of genius now shakes out her sail
+    And leaves that ocean of despair behind;
+
+  For to the second realm I tune my tale,
+    Where human spirits purge themselves, and train
+    To leap up into joy celestial.
+
+  Now from the grave wake poetry again,
+    O sacred Muses I have served so long!
+    Now let Calliope uplift her strain
+
+  And lift my voice up on the mighty song
+    That smote the miserable Magpies nine
+    Out of all hope of pardon for their wrong!
+
 =head2 v5.22.3-RC1 - Dante Alighieri, trans. Dorothy L. Sayers, "The Divine Comedy", Cantica I: Hell, Canto XII
 
 L<Announced on 2016-07-17 by Steve Hay|http://www.nntp.perl.org/group/perl.perl5.porters/2016/07/msg238071.html>
index cb6944e24a2c2f4744f5ab207c544e212f8be2a9..9259b20fb082f64c83f7274f6be5f2755c1b0e6d 100644 (file)
@@ -8,6 +8,10 @@ use strict;
 use warnings;
 use Getopt::Std;
 
+# avoid unnecessary churn in x_serialization_backend in META.*
+$ENV{PERL_JSON_BACKEND} = $ENV{CPAN_META_JSON_BACKEND} = 'JSON::PP';
+$ENV{PERL_YAML_BACKEND} = 'CPAN::Meta::YAML';
+
 my $opts = {
   'META.yml'  => { version => '1.4' },
   'META.json' => { version => '2' },
index 3cbf8cfc8faa7c771d8b285493c24607487b3dbe..41099210646fed7b92606bfd31e7e254637c4a9a 100644 (file)
@@ -378,7 +378,7 @@ here.
 
 XXX Generate this with:
 
-  perl Porting/acknowledgements.pl v5.25.3..HEAD
+  perl Porting/acknowledgements.pl v5.25.4..HEAD
 
 =head1 Reporting Bugs
 
index fb1c6088ebcc51405c66dafa700c8a256823dade..f294bf4edece4168d83415a9692ab299044e84ea 100644 (file)
@@ -51,7 +51,7 @@ you should reset the version numbers to the next blead series.
   2016-04-08  5.25.0 ✓        Ricardo Signes
   2016-05-20  5.25.1 ✓        Sawyer X
   2016-06-20  5.25.2 ✓        Matthew Horsfall
-  2016-07-20  5.25.3          Steve Hay
+  2016-07-20  5.25.3         Steve Hay
   2016-08-20  5.25.4          BinGOs
   2016-09-20  5.25.5          Stevan Little
   2016-10-20  5.25.6          Chad Granum
index b0ca21fc108492ebbccb2c0ece5c4f59ad515024..67ed3870a156c771286fea6d1f2bf943121a9d06 100644 (file)
@@ -485,7 +485,7 @@ Natively 64-bit systems need neither -Duse64bitint nor -Duse64bitall.
 On these systems, it might be the default compilation mode, and there
 is currently no guarantee that passing no use64bitall option to the
 Configure process will build a 32bit perl. Implementing -Duse32bit*
-options would be nice for perl 5.25.3.
+options would be nice for perl 5.25.4.
 
 =head2 Profile Perl - am I hot or not?
 
@@ -1205,7 +1205,7 @@ L<http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2013-01/msg00339.html>
 =head1 Big projects
 
 Tasks that will get your name mentioned in the description of the "Highlights
-of 5.25.3"
+of 5.25.4"
 
 =head2 make ithreads more robust
 
index a6a0e192b70acebe7154345a2deaca81a42679a6..dddc7a09916ec5378d5e7a58a0e255f9e4f15535 100644 (file)
@@ -22,9 +22,9 @@ The build procedure is completely standard:
 Make perl executable and create a symlink for libperl:
 
   chmod a+x /boot/common/bin/perl
-  cd /boot/common/lib; ln -s perl5/5.25.3/BePC-haiku/CORE/libperl.so .
+  cd /boot/common/lib; ln -s perl5/5.25.4/BePC-haiku/CORE/libperl.so .
 
-Replace C<5.25.3> with your respective version of Perl.
+Replace C<5.25.4> with your respective version of Perl.
 
 =head1 KNOWN PROBLEMS
 
index 4dba4f057ad09ea9a3386b5b986f61b99ad43127..ac7cad65bbca80ba53190f709f178f332a975362 100644 (file)
@@ -10,9 +10,9 @@ perlmacosx - Perl under Mac OS X
 
 This document briefly describes Perl under Mac OS X.
 
-  curl -O http://www.cpan.org/src/perl-5.25.3.tar.gz
-  tar -xzf perl-5.25.3.tar.gz
-  cd perl-5.25.3
+  curl -O http://www.cpan.org/src/perl-5.25.4.tar.gz
+  tar -xzf perl-5.25.4.tar.gz
+  cd perl-5.25.4
   ./Configure -des -Dprefix=/usr/local/
   make
   make test
@@ -20,7 +20,7 @@ This document briefly describes Perl under Mac OS X.
 
 =head1 DESCRIPTION
 
-The latest Perl release (5.25.3 as of this writing) builds without changes
+The latest Perl release (5.25.4 as of this writing) builds without changes
 under all versions of Mac OS X from 10.3 "Panther" onwards. 
 
 In order to build your own version of Perl you will need 'make',
index b33ca6edfc7f8026fa92dd5f41134b2692ee80bc..9ae8f062b74c059de2e7629eec28c07a60de8332 100644 (file)
@@ -619,7 +619,7 @@ C<set PERLLIB_PREFIX> in F<Config.sys>, see L</"C<PERLLIB_PREFIX>">.
 
 =item Additional Perl modules
 
-  unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.25.3/
+  unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.25.4/
 
 Same remark as above applies.  Additionally, if this directory is not
 one of directories on @INC (and @INC is influenced by C<PERLLIB_PREFIX>), you
index 232a5af9599645f90f96a88a8062e02130021320..7bf599549fcf3640d3873126fd5ac902375cc74d 100644 (file)
@@ -142,11 +142,11 @@ You may need to set up a foreign symbol for the unpacking utility of
 choice.  Once you have done so, use a command like the following to
 unpack the archive:
 
-    vmstar -xvf perl-5^.25^.3.tar
+    vmstar -xvf perl-5^.25^.4.tar
 
 Then set default to the top-level source directory like so:
 
-    set default [.perl-5^.25^.3]
+    set default [.perl-5^.25^.4]
 
 and proceed with configuration as described in the next section.
 
@@ -470,7 +470,7 @@ If you come across what you think might be a bug in Perl, please report
 it. There's a script in PERL_ROOT:[UTILS], perlbug, that walks you through
 the process of creating a bug report. This script includes details of your
 installation, and is very handy. Completed bug reports should go to
-perlbug@perl.com.
+perlbug@perl.org.
 
 =head1 CAVEATS
 
diff --git a/av.c b/av.c
index fc2004ee43e3bc47bd47177912a7b84ef9d25e68..21828a9254b5ebd9bc5a2dfc05d9af1313d9c136 100644 (file)
--- a/av.c
+++ b/av.c
@@ -244,10 +244,13 @@ S_adjust_index(pTHX_ AV *av, const MAGIC *mg, SSize_t *keyp)
 SV**
 Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
 {
+    SSize_t neg;
+    SSize_t size;
+
     PERL_ARGS_ASSERT_AV_FETCH;
     assert(SvTYPE(av) == SVt_PVAV);
 
-    if (SvRMAGICAL(av)) {
+    if (UNLIKELY(SvRMAGICAL(av))) {
         const MAGIC * const tied_magic
            = mg_find((const SV *)av, PERL_MAGIC_tied);
         if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) {
@@ -268,23 +271,23 @@ Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval)
         }
     }
 
-    if (key < 0) {
-       key += AvFILL(av) + 1;
-       if (key < 0)
+    neg  = (key < 0);
+    size = AvFILLp(av) + 1;
+    key += neg * size; /* handle negative index without using branch */
+
+    /* the cast from SSize_t to Size_t allows both (key < 0) and (key >= size)
+     * to be tested as a single condition */
+    if ((Size_t)key >= (Size_t)size) {
+       if (UNLIKELY(neg))
            return NULL;
+        goto emptyness;
     }
 
-    if (key > AvFILLp(av) || !AvARRAY(av)[key]) {
+    if (!AvARRAY(av)[key]) {
       emptyness:
        return lval ? av_store(av,key,newSV(0)) : NULL;
     }
 
-    if (AvREIFY(av)
-            && (!AvARRAY(av)[key]      /* eg. @_ could have freed elts */
-                || SvIS_FREED(AvARRAY(av)[key]))) {
-       AvARRAY(av)[key] = NULL;        /* 1/2 reify */
-       goto emptyness;
-    }
     return &AvARRAY(av)[key];
 }
 
index a50044eb9a93a0d617e26b6f5bd06649176909e9..bd32840407ba318e10c70194cb3b3c1e610835e3 100755 (executable)
--- a/cflags.SH
+++ b/cflags.SH
@@ -226,33 +226,31 @@ Intel*) ;; # # Is that you, Intel C++?
                    ;;
                  esac
                  ;;
-               *) case "$opt" in
-                  -W)
-                    # -Wextra is the modern form of -W, so add
-                    # -W only if -Wextra is not there already.
-                    case " $warn " in
-                    *-Wextra*) ;;
-                    *)
-                      echo "cflags.SH: Adding $opt."
-                      warn="$warn $opt"
-                      ;;
-                    esac
-                    ;;
-                 -Werror=declaration-after-statement)
-                    # -pedantic* (with -std=c89) covers -Werror=d-a-s.
-                    case "$stdflags$warn" in
-                    *-std=c89*-pedantic*|*-pedantic*-std=c89*) ;;
-                    *)
-                      echo "cflags.SH: Adding $opt."
-                      warn="$warn $opt"
-                      ;;
-                    esac
-                   ;;
+               -W)
+                 # -Wextra is the modern form of -W, so add
+                 # -W only if -Wextra is not there already.
+                 case " $warn " in
+                 *-Wextra*) ;;
+                 *)
+                   echo "cflags.SH: Adding $opt."
+                   warn="$warn $opt"
+                   ;;
+                 esac
+                 ;;
+               -Werror=declaration-after-statement)
+                  # -pedantic* (with -std=c89) covers -Werror=d-a-s.
+                  case "$stdflags$warn" in
+                  *-std=c89*-pedantic*|*-pedantic*-std=c89*) ;;
                   *)
                      echo "cflags.SH: Adding $opt."
                      warn="$warn $opt"
                      ;;
                   esac
+                  ;;
+               *)
+                  echo "cflags.SH: Adding $opt."
+                  warn="$warn $opt"
+                  ;;
                esac
              fi
              ;;
index a748d00ac3fd6055760357ecf041969769589d59..390e8a0158aa85bf1733a36e1bce4446fbfed94f 100644 (file)
@@ -91558,7 +91558,7 @@ static const U8 WB_table[24][24] = {
  * 37f6186253da9824bdb27f4ad867bfe8c25d4dc6bdb2f05585e40a034675a348 lib/unicore/extracted/DLineBreak.txt
  * ef24061b5a5dc93d7e90c2e34530ec757180ee75d872cba65ffc946e52624ae8 lib/unicore/extracted/DNumType.txt
  * a197371fec9a1b517058b440841f60f9378d81682084eef8db22a88cb2f96e90 lib/unicore/extracted/DNumValues.txt
- * 0cc006e22469cee3db1a55a4df1ac656c9d26a70ba920985883eb77198931c1a lib/unicore/mktables
+ * 5c7eb94310e2aaa15702fd6bed24ff0e7ab5448f9a8231d8c49ca96c9e941089 lib/unicore/mktables
  * cdecb300baad839a6f62791229f551a4fa33f3cbdca08e378dc976466354e778 lib/unicore/version
  * 913d2f93f3cb6cdf1664db888bf840bc4eb074eef824e082fceda24a9445e60c regen/charset_translations.pl
  * 11011bc761487f5a63c8135e67248394d4cdff6f8f204a41cdfbdc8131e79406 regen/mk_invlists.pl
index 9d3b5d8eae5955f16cc84a9c33e9b4f0dc7a15dd..099f92ab02377d157472f6ce4eeff4708253035b 100755 (executable)
@@ -1942,6 +1942,7 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
  *     LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE
  *     LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE
  *     LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE
+ *     LONG_DOUBLE_IS_VAX_H_FLOAT
  *     LONG_DOUBLE_IS_UNKNOWN_FORMAT
  *     It is only defined if the system supports long doubles.
  */
@@ -1959,6 +1960,7 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
 #define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE      6
 #define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE      7
 #define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE      8
+#define LONG_DOUBLE_IS_VAX_H_FLOAT                     9
 #define LONG_DOUBLE_IS_UNKNOWN_FORMAT                  -1
 #define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN      LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE /* back-compat */
 #define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE /* back-compat */
@@ -2880,6 +2882,13 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
  */
 #$d_futimes HAS_FUTIMES                /**/
 
+/* HAS_GAI_STRERROR:
+ *     This symbol, if defined, indicates that the gai_strerror routine
+ *     is available to translate error codes returned by getaddrinfo()
+ *     into human readable strings.
+ */
+#$d_gai_strerror HAS_GAI_STRERROR      /**/
+
 /* HAS_GETADDRINFO:
  *     This symbol, if defined, indicates that the getaddrinfo() function
  *     is available for use.
@@ -3250,10 +3259,15 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
  *     This symbol, if defined, indicates that the querylocale routine is
  *     available to return the name of the locale for a category mask.
  */
+/* I_XLOCALE:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <xlocale.h> to get uselocale() and its friends.
+ */
 #$d_newlocale  HAS_NEWLOCALE   /**/
 #$d_freelocale HAS_FREELOCALE  /**/
 #$d_uselocale  HAS_USELOCALE   /**/
 #$d_querylocale        HAS_QUERYLOCALE /**/
+#$i_xlocale    I_XLOCALE               /**/
 
 /* HAS_NEXTAFTER:
  *     This symbol, if defined, indicates that the nextafter routine is
index f7d002e14bf4b4f72a898982a889dbf4ceb1f2b7..1d11fe1228d3d4582fbb1c1a4d7c80a218f01750 100644 (file)
@@ -1892,7 +1892,7 @@ $   DECK
 If you or somebody else will be maintaining perl at your site, please
 fill in the correct e-mail address here so that they may be contacted
 if necessary. Currently, the "perlbug" program included with perl
-will send mail to this address in addition to perlbug@perl.com. You may
+will send mail to this address in addition to perlbug@perl.org. You may
 enter "none" for no administrator.
 $   EOD
 $ ENDIF
@@ -6577,6 +6577,7 @@ $ WC "i_values='undef'"
 $ WC "i_varargs='undef'"
 $ WC "i_varhdr='stdarg.h'"
 $ WC "i_vfork='undef'"
+$ WC "i_xlocale='undef'"
 $ WC "inc_version_list='0'"
 $ WC "inc_version_list_init='0'"
 $ WC "installarchlib='" + installarchlib + "'"
@@ -6868,6 +6869,7 @@ $ WC "d_endprotoent_r='undef'"
 $ WC "d_endpwent_r='undef'"
 $ WC "d_endservent_r='undef'"
 $ WC "d_freelocale='undef'"
+$ WC "d_gai_strerror='undef'"
 $ WC "d_getgrent_r='undef'"
 $ WC "d_getgrgid_r='" + d_getgrgid_r + "'"
 $ WC "d_getgrnam_r='" + d_getgrnam_r + "'"
index 0eaffa7ccb7d6c4259500022f94b43d21c8b62f0..9dc6402c6663ca3d0e419f8974ddf00582f3dc7a 100644 (file)
@@ -1,6 +1,7 @@
 #!/usr/bin/perl
 use strict;
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use File::Find;
 use Getopt::Std;
 use Archive::Tar;
index 66bd859d06002480b09e1349e3ba2c74d0606bd4..4668fa6be079a7dcd7c65854050ede01f98b39c4 100644 (file)
@@ -1,5 +1,6 @@
 #!/usr/bin/perl
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use strict;
 use Archive::Tar;
 use Getopt::Std;
index 1a320f198534c13a001f14418ede007a6aee38c0..8dc6b4f896f4d65982e329eaf3a8f369fdf071a7 100644 (file)
@@ -4,6 +4,7 @@
 # archive.  See 'ptargrep --help' for more documentation.
 #
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use strict;
 use warnings;
 
index adbb548520808072da1281407451988956d27962..11582704bb3e8860961b27de994a4fa40978901b 100644 (file)
@@ -31,7 +31,7 @@ use vars qw[$DEBUG $error $VERSION $WARN $FOLLOW_SYMLINK $CHOWN $CHMOD
 $DEBUG                  = 0;
 $WARN                   = 1;
 $FOLLOW_SYMLINK         = 0;
-$VERSION                = "2.08";
+$VERSION                = "2.10";
 $CHOWN                  = 1;
 $CHMOD                  = 1;
 $SAME_PERMISSIONS       = $> == 0 ? 1 : 0;
index ac91400b6a7474223a927175057383b14a26418c..3727bc32a1c99c17442b592aafda182fda91db8e 100644 (file)
@@ -3,7 +3,7 @@ package Archive::Tar::Constant;
 BEGIN {
     require Exporter;
 
-    $VERSION    = '2.08';
+    $VERSION    = '2.10';
     @ISA        = qw[Exporter];
 
     require Time::Local if $^O eq "MacOS";
index 5821304194b4e605237e3fbce38d3ba4f847da50..3acc4f80f5fc550a4128b6ab70775626550b235a 100644 (file)
@@ -13,7 +13,7 @@ use Archive::Tar::Constant;
 
 use vars qw[@ISA $VERSION];
 #@ISA        = qw[Archive::Tar];
-$VERSION    = '2.08';
+$VERSION    = '2.10';
 
 ### set value to 1 to oct() it during the unpack ###
 
diff --git a/cpan/CPAN-Meta/corpus/BadMETA.yml b/cpan/CPAN-Meta/corpus/BadMETA.yml
new file mode 100644 (file)
index 0000000..ef0b0f8
--- /dev/null
@@ -0,0 +1,24 @@
+---
+abstract: ~
+author:
+  - 'Olivier Mengué'
+build_requires:
+  ExtUtils::MakeMaker: 6.36
+configure_requires:
+  ExtUtils::MakeMaker: 6.36
+distribution_type: module
+dynamic_config: 1
+generated_by: 'Module::Install version 1.06'
+license: perl
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: 1.4
+name: Foo
+no_index:
+  directory:
+    - inc
+requires:
+  perl: 5.005
+resources:
+  license: http://dev.perl.org/licenses/
+version: 0.01
diff --git a/cpan/CPAN-Meta/corpus/CL018_yaml.meta b/cpan/CPAN-Meta/corpus/CL018_yaml.meta
new file mode 100644 (file)
index 0000000..4bbac95
--- /dev/null
@@ -0,0 +1,75 @@
+{
+   "abstract" : "Lexical Analyzer for Perl5",
+   "author" : [
+      "Masaaki Goshima (goccy) <goccy(at)cpan.org>"
+   ],
+   "dynamic_config" : 0,
+   "generated_by" : "Module::Build version 0.4205",
+   "license" : [
+      "perl_5"
+   ],
+   "meta-spec" : {
+      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+      "version" : "2"
+   },
+   "name" : "Compiler-Lexer",
+   "no_index" : {
+      "directory" : [
+         "t",
+         "examples",
+         "builder"
+      ]
+   },
+   "prereqs" : {
+      "build" : {
+         "requires" : {
+            "ExtUtils::CBuilder" : "0"
+         }
+      },
+      "configure" : {
+         "requires" : {
+            "Module::Build" : "0.38",
+            "Module::Build::XSUtil" : "0.06"
+         }
+      }
+   },
+   "provides" : {
+      "Compiler::Lexer" : {
+         "file" : "lib/Compiler/Lexer.pm",
+         "version" : "0.18"
+      },
+      "Compiler::Lexer::Kind" : {
+         "file" : "lib/Compiler/Lexer/Constants.pm"
+      },
+      "Compiler::Lexer::SyntaxType" : {
+         "file" : "lib/Compiler/Lexer/Constants.pm"
+      },
+      "Compiler::Lexer::Token" : {
+         "file" : "lib/Compiler/Lexer/Token.pm"
+      },
+      "Compiler::Lexer::TokenType" : {
+         "file" : "lib/Compiler/Lexer/Constants.pm"
+      }
+   },
+   "release_status" : "stable",
+   "resources" : {
+      "bugtracker" : {
+         "web" : "https://github.com/goccy/p5-Compiler-Lexer/issues"
+      },
+      "homepage" : "https://github.com/goccy/p5-Compiler-Lexer",
+      "repository" : {
+         "type" : "git",
+         "url" : "git://github.com/goccy/p5-Compiler-Lexer.git"
+      }
+   },
+   "version" : "0.18",
+   "x_contributors" : [
+      "tokuhirom <tokuhirom@gmail.com>",
+      "Reini Urban <rurban@cpanel.net>",
+      "Fumihiro Itoh <fmhrit@gmail.com>",
+      "Masaaki Goshima <masaaki.goshima@mixi.co.jp>",
+      "moznion <moznion@gmail.com>",
+      "Olivier Mengué <dolmen@cpan.org>",
+      "Masaaki Goshima <goccy54@gmail.com>"
+   ]
+}
diff --git a/cpan/CPAN-Meta/corpus/META-VR.json b/cpan/CPAN-Meta/corpus/META-VR.json
new file mode 100644 (file)
index 0000000..71bb249
--- /dev/null
@@ -0,0 +1,33 @@
+{
+   "abstract" : "a set of version requirements for a CPAN dist",
+   "author" : [
+      "Ricardo Signes <rjbs@cpan.org>"
+   ],
+   "build_requires" : {
+      "Test::More" : "0.88"
+   },
+   "configure_requires" : {
+      "ExtUtils::MakeMaker" : "6.31"
+   },
+   "generated_by" : "Dist::Zilla version 2.100991",
+   "license" : "perl",
+   "meta-spec" : {
+      "url" : "http://module-build.sourceforge.net/META-spec-v1.4.html",
+      "version" : 1.4
+   },
+   "name" : "Version-Requirements",
+   "recommends" : {},
+   "requires" : {
+      "Carp" : "0",
+      "Scalar::Util" : "0",
+      "version" : "0.77"
+   },
+   "resources" : {
+      "repository" : "git://git.codesimply.com/Version-Requirements.git"
+   },
+   "version" : "0.101010",
+   "x_contributors" : [
+      "Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>"
+   ]
+}
+
diff --git a/cpan/CPAN-Meta/corpus/META-VR.yml b/cpan/CPAN-Meta/corpus/META-VR.yml
new file mode 100644 (file)
index 0000000..18b2350
--- /dev/null
@@ -0,0 +1,24 @@
+---
+abstract: 'a set of version requirements for a CPAN dist'
+author:
+  - 'Ricardo Signes <rjbs@cpan.org>'
+build_requires:
+  Test::More: 0.88
+configure_requires:
+  ExtUtils::MakeMaker: 6.31
+generated_by: 'Dist::Zilla version 2.100991'
+license: perl
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: 1.4
+name: Version-Requirements
+recommends: {}
+requires:
+  Carp: 0
+  Scalar::Util: 0
+  version: 0.77
+resources:
+  repository: git://git.codesimply.com/Version-Requirements.git
+version: 0.101010
+x_contributors:
+  - 'Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>'
diff --git a/cpan/CPAN-Meta/corpus/bareyaml.meta b/cpan/CPAN-Meta/corpus/bareyaml.meta
new file mode 100644 (file)
index 0000000..85c4f1d
--- /dev/null
@@ -0,0 +1,23 @@
+abstract: 'a set of version requirements for a CPAN dist'
+author:
+  - 'Ricardo Signes <rjbs@cpan.org>'
+build_requires:
+  Test::More: 0.88
+configure_requires:
+  ExtUtils::MakeMaker: 6.31
+generated_by: 'Dist::Zilla version 2.100991'
+license: perl
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: 1.4
+name: Version-Requirements
+recommends: {}
+requires:
+  Carp: 0
+  Scalar::Util: 0
+  version: 0.77
+resources:
+  repository: git://git.codesimply.com/Version-Requirements.git
+version: 0.101010
+x_contributors:
+  - 'Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>'
diff --git a/cpan/CPAN-Meta/corpus/json.meta b/cpan/CPAN-Meta/corpus/json.meta
new file mode 100644 (file)
index 0000000..71bb249
--- /dev/null
@@ -0,0 +1,33 @@
+{
+   "abstract" : "a set of version requirements for a CPAN dist",
+   "author" : [
+      "Ricardo Signes <rjbs@cpan.org>"
+   ],
+   "build_requires" : {
+      "Test::More" : "0.88"
+   },
+   "configure_requires" : {
+      "ExtUtils::MakeMaker" : "6.31"
+   },
+   "generated_by" : "Dist::Zilla version 2.100991",
+   "license" : "perl",
+   "meta-spec" : {
+      "url" : "http://module-build.sourceforge.net/META-spec-v1.4.html",
+      "version" : 1.4
+   },
+   "name" : "Version-Requirements",
+   "recommends" : {},
+   "requires" : {
+      "Carp" : "0",
+      "Scalar::Util" : "0",
+      "version" : "0.77"
+   },
+   "resources" : {
+      "repository" : "git://git.codesimply.com/Version-Requirements.git"
+   },
+   "version" : "0.101010",
+   "x_contributors" : [
+      "Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>"
+   ]
+}
+
diff --git a/cpan/CPAN-Meta/corpus/yaml.meta b/cpan/CPAN-Meta/corpus/yaml.meta
new file mode 100644 (file)
index 0000000..18b2350
--- /dev/null
@@ -0,0 +1,24 @@
+---
+abstract: 'a set of version requirements for a CPAN dist'
+author:
+  - 'Ricardo Signes <rjbs@cpan.org>'
+build_requires:
+  Test::More: 0.88
+configure_requires:
+  ExtUtils::MakeMaker: 6.31
+generated_by: 'Dist::Zilla version 2.100991'
+license: perl
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: 1.4
+name: Version-Requirements
+recommends: {}
+requires:
+  Carp: 0
+  Scalar::Util: 0
+  version: 0.77
+resources:
+  repository: git://git.codesimply.com/Version-Requirements.git
+version: 0.101010
+x_contributors:
+  - 'Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>'
index afbb221855adf8f344e4770892521ffdff251432..4a8e65c0fc1f878df401b7bb308db54f06ae356c 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 package CPAN::Meta;
 
-our $VERSION = '2.150005';
+our $VERSION = '2.150010';
 
 #pod =head1 SYNOPSIS
 #pod
@@ -650,7 +650,7 @@ CPAN::Meta - the distribution metadata for a CPAN dist
 
 =head1 VERSION
 
-version 2.150005
+version 2.150010
 
 =head1 SYNOPSIS
 
@@ -1031,11 +1031,15 @@ David Golden <dagolden@cpan.org>
 
 Ricardo Signes <rjbs@cpan.org>
 
+=item *
+
+Adam Kennedy <adamk@cpan.org>
+
 =back
 
 =head1 CONTRIBUTORS
 
-=for stopwords Ansgar Burchardt Avar Arnfjord Bjarmason Christopher J. Madsen Chuck Adams Cory G Watson Damyan Ivanov Eric Wilhelm Graham Knop Gregor Hermann Karen Etheridge Kenichi Ishigaki Ken Williams Lars Dieckow Leon Timmermans majensen Mark Fowler Matt S Trout Michael G. Schwern mohawk2 moznion Niko Tyni Olaf Alders Olivier Mengué Randy Sims Tomohiro Hosaka
+=for stopwords Ansgar Burchardt Avar Arnfjord Bjarmason Benjamin Noggle Christopher J. Madsen Chuck Adams Cory G Watson Damyan Ivanov David Golden Eric Wilhelm Graham Knop Gregor Hermann Karen Etheridge Kenichi Ishigaki Kent Fredric Ken Williams Lars Dieckow Leon Timmermans majensen Mark Fowler Matt S Trout Michael G. Schwern Mohammad Anwar mohawk2 moznion Niko Tyni Olaf Alders Olivier Mengué Randy Sims Tomohiro Hosaka
 
 =over 4
 
@@ -1049,6 +1053,10 @@ Avar Arnfjord Bjarmason <avar@cpan.org>
 
 =item *
 
+Benjamin Noggle <agwind@users.noreply.github.com>
+
+=item *
+
 Christopher J. Madsen <cjm@cpan.org>
 
 =item *
@@ -1065,6 +1073,10 @@ Damyan Ivanov <dam@cpan.org>
 
 =item *
 
+David Golden <xdg@xdg.me>
+
+=item *
+
 Eric Wilhelm <ewilhelm@cpan.org>
 
 =item *
@@ -1085,6 +1097,10 @@ Kenichi Ishigaki <ishigaki@cpan.org>
 
 =item *
 
+Kent Fredric <kentfredric@gmail.com>
+
+=item *
+
 Ken Williams <kwilliams@cpan.org>
 
 =item *
@@ -1113,6 +1129,10 @@ Michael G. Schwern <mschwern@cpan.org>
 
 =item *
 
+Mohammad S Anwar <mohammad.anwar@yahoo.com>
+
+=item *
+
 mohawk2 <mohawk2@users.noreply.github.com>
 
 =item *
@@ -1143,7 +1163,7 @@ Tomohiro Hosaka <bokutin@bokut.in>
 
 =head1 COPYRIGHT AND LICENSE
 
-This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.
 
 This is free software; you can redistribute it and/or modify it under
 the same terms as the Perl 5 programming language system itself.
index 03806bc82bf095b3acd014191905bb6befc753d0..0a52dcc2e6e6a6f9ada283b7c6153c94be33f9fc 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 package CPAN::Meta::Converter;
 
-our $VERSION = '2.150005';
+our $VERSION = '2.150010';
 
 #pod =head1 SYNOPSIS
 #pod
@@ -43,22 +43,36 @@ BEGIN {
 # Perl 5.10.0 didn't have "is_qv" in version.pm
 *_is_qv = version->can('is_qv') ? sub { $_[0]->is_qv } : sub { exists $_[0]->{qv} };
 
+# We limit cloning to a maximum depth to bail out on circular data
+# structures.  While actual cycle detection might be technically better,
+# we expect circularity in META data structures to be rare and generally
+# the result of user error.  Therefore, a depth counter is lower overhead.
+our $DCLONE_MAXDEPTH = 1024;
+our $_CLONE_DEPTH;
+
 sub _dclone {
-  my $ref = shift;
-
-  # if an object is in the data structure and doesn't specify how to
-  # turn itself into JSON, we just stringify the object.  That does the
-  # right thing for typical things that might be there, like version objects,
-  # Path::Class objects, etc.
-  no warnings 'once';
-  no warnings 'redefine';
-  local *UNIVERSAL::TO_JSON = sub { "$_[0]" };
-
-  my $json = Parse::CPAN::Meta->json_backend()->new
-      ->utf8
-      ->allow_blessed
-      ->convert_blessed;
-  $json->decode($json->encode($ref))
+  my ( $ref  ) = @_;
+  return $ref unless my $reftype = ref $ref;
+
+  local $_CLONE_DEPTH = defined $_CLONE_DEPTH ? $_CLONE_DEPTH - 1 : $DCLONE_MAXDEPTH;
+  die "Depth Limit $DCLONE_MAXDEPTH Exceeded" if $_CLONE_DEPTH == 0;
+
+  return [ map { _dclone( $_ ) } @{$ref} ] if 'ARRAY' eq $reftype;
+  return { map { $_ => _dclone( $ref->{$_} ) } keys %{$ref} } if 'HASH' eq $reftype;
+
+  if ( 'SCALAR' eq $reftype ) {
+    my $new = _dclone(${$ref});
+    return \$new;
+  }
+
+  # We can't know if TO_JSON gives us cloned data, so refs must recurse
+  if ( eval { $ref->can('TO_JSON') } ) {
+    my $data = $ref->TO_JSON;
+    return ref $data ? _dclone( $data ) : $data;
+  }
+
+  # Just stringify everything else
+  return "$ref";
 }
 
 my %known_specs = (
@@ -333,7 +347,7 @@ sub _no_index_directory {
   my ($element, $key, $meta, $version) = @_;
   return unless $element;
 
-  # cleanup wrong format
+  # clean up wrong format
   if ( ! ref $element ) {
     my $item = $element;
     $element = { directory => [ $item ], file => [ $item ] };
@@ -421,7 +435,7 @@ sub _version_map {
   }
   elsif ( ref $element eq 'ARRAY' ) {
     my $hashref = { map { $_ => 0 } @$element };
-    return _version_map($hashref); # cleanup any weird stuff
+    return _version_map($hashref); # clean up any weird stuff
   }
   elsif ( ref $element eq '' && length $element ) {
     return { $element => 0 }
@@ -1499,7 +1513,7 @@ CPAN::Meta::Converter - Convert CPAN distribution metadata structures
 
 =head1 VERSION
 
-version 2.150005
+version 2.150010
 
 =head1 SYNOPSIS
 
@@ -1622,11 +1636,15 @@ David Golden <dagolden@cpan.org>
 
 Ricardo Signes <rjbs@cpan.org>
 
+=item *
+
+Adam Kennedy <adamk@cpan.org>
+
 =back
 
 =head1 COPYRIGHT AND LICENSE
 
-This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.
 
 This is free software; you can redistribute it and/or modify it under
 the same terms as the Perl 5 programming language system itself.
index 9dac4f421852e6674917eb9142f2ebe99ad6a382..f6103495c72ab2768b7524f45350c230ac95b662 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 package CPAN::Meta::Feature;
 
-our $VERSION = '2.150005';
+our $VERSION = '2.150010';
 
 use CPAN::Meta::Prereqs;
 
@@ -77,7 +77,7 @@ CPAN::Meta::Feature - an optional feature provided by a CPAN distribution
 
 =head1 VERSION
 
-version 2.150005
+version 2.150010
 
 =head1 DESCRIPTION
 
@@ -132,11 +132,15 @@ David Golden <dagolden@cpan.org>
 
 Ricardo Signes <rjbs@cpan.org>
 
+=item *
+
+Adam Kennedy <adamk@cpan.org>
+
 =back
 
 =head1 COPYRIGHT AND LICENSE
 
-This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.
 
 This is free software; you can redistribute it and/or modify it under
 the same terms as the Perl 5 programming language system itself.
index f4cac5e59a9d66440a057f4de033fef6c290d046..aeeade94a37ef7e74b304dda86257dda544233b2 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 package CPAN::Meta::History;
 
-our $VERSION = '2.150005';
+our $VERSION = '2.150010';
 
 1;
 
@@ -22,7 +22,7 @@ CPAN::Meta::History - history of CPAN Meta Spec changes
 
 =head1 VERSION
 
-version 2.150005
+version 2.150010
 
 =head1 DESCRIPTION
 
@@ -304,11 +304,15 @@ David Golden <dagolden@cpan.org>
 
 Ricardo Signes <rjbs@cpan.org>
 
+=item *
+
+Adam Kennedy <adamk@cpan.org>
+
 =back
 
 =head1 COPYRIGHT AND LICENSE
 
-This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.
 
 This is free software; you can redistribute it and/or modify it under
 the same terms as the Perl 5 programming language system itself.
index cd3bb9c3f68e95587d729d683f2e4baacde1eedc..5932f5a6e74b319a7d45d3b6a56c81c34ae7e5df 100644 (file)
@@ -21,7 +21,12 @@ Conversion from the original HTML to POD format
 =item *
 
 Include list of valid licenses from L<Module::Build> 0.17 rather than
-linking to the module.
+linking to the module, with minor updates to text and links to reflect
+versions at the time of publication.
+
+=item *
+
+Fixed some dead links to point to active resources.
 
 =back
 
@@ -43,16 +48,17 @@ install it.
 
 F<META.yml> files are written in the L<YAML|http://www.yaml.org/> format.  The
 reasons we chose YAML instead of, say, XML or Data::Dumper are discussed in
-L<this thread|http://archive.develooper.com/makemaker@perl.org/msg00405.html>
+L<this thread|http://www.nntp.perl.org/group/perl.makemaker/2002/04/msg406.html>
 on the MakeMaker mailing list.
 
-The first line of a F<META.yml> file should be a valid L<YAML document header|http://www.yaml.org/spec/#.Document>
+The first line of a F<META.yml> file should be a valid
+L<YAML document header|http://yaml.org/spec/history/2002-10-31.html#syntax-document>
 like C<"--- #YAML:1.0">
 
 =head1 Fields
 
 The rest of the META.yml file is one big YAML
-L<mapping|http://www.yaml.org/spec/#.-syntax-mapping-Mapping->,
+L<mapping|http://yaml.org/spec/history/2002-10-31.html#syntax-mapping>,
 whose keys are described here.
 
 =over 4
@@ -87,28 +93,29 @@ Must be one of the following licenses:
 
 The distribution may be copied and redistributed under the same terms as perl
 itself (this is by far the most common licensing option for modules on CPAN).
-This is a dual license, in which the user may choose between either the GPL or
-the Artistic license.
+This is a dual license, in which the user may choose between either the GPL
+version 1 or the Artistic version 1 license.
 
 =item gpl
 
-The distribution is distributed under the terms of the Gnu General Public
-License (L<http://www.opensource.org/licenses/gpl-license.php>).
+The distribution is distributed under the terms of the GNU General Public
+License version 2 (L<http://opensource.org/licenses/GPL-2.0>).
 
 =item lgpl
 
-The distribution is distributed under the terms of the Gnu Lesser General
-Public License (L<http://www.opensource.org/licenses/lgpl-license.php>).
+The distribution is distributed under the terms of the GNU Lesser General
+Public License version 2 (L<http://opensource.org/licenses/LGPL-2.1>).
 
 =item artistic
 
-The distribution is licensed under the Artistic License, as specified by the
-Artistic file in the standard perl distribution.
+The distribution is licensed under the Artistic License version 1, as specified
+by the Artistic file in the standard perl distribution
+(L<http://opensource.org/licenses/Artistic-Perl-1.0>).
 
 =item bsd
 
-The distribution is licensed under the BSD License
-(L<http://www.opensource.org/licenses/bsd-license.php>).
+The distribution is licensed under the BSD 3-Clause License
+(L<http://opensource.org/licenses/BSD-3-Clause>).
 
 =item open_source
 
@@ -118,7 +125,7 @@ license listed at L<http://www.opensource.org/licenses/>.
 =item unrestricted
 
 The distribution is licensed under a license that is B<not> approved by
-L<www.opensource.org|http://www.opensource.org> but that allows distribution
+L<www.opensource.org|http://www.opensource.org/> but that allows distribution
 without restrictions.
 
 =item restrictive
@@ -143,10 +150,11 @@ Example:
   Data::Dumper: 0
   File::Find: 1.03
 
-A YAML L<mapping|http://www.yaml.org/spec/#.-syntax-mapping-Mapping->
+A YAML L<mapping|http://yaml.org/spec/history/2002-10-31.html#syntax-mapping>
 indicating the Perl modules this distribution requires for proper
 operation.  The keys are the module names, and the values are version
-specifications as described in the L<Module::Build|documentation for Module::Build's "requires" parameter>.
+specifications as described in the
+L<documentation for Module::Build's "requires" parameter|Module::Build::API/requires>.
 
 I<Note: the exact nature of the fancy specifications like
 C<< ">= 1.2, != 1.5, < 2.0" >> is subject to
@@ -160,7 +168,7 @@ Example:
   Data::Dumper: 0
   File::Find: 1.03
 
-A YAML L<mapping|http://www.yaml.org/spec/#.-syntax-mapping-Mapping->
+A YAML L<mapping|http://yaml.org/spec/history/2002-10-31.html#syntax-mapping>
 indicating the Perl modules this distribution recommends for enhanced
 operation.
 
@@ -171,7 +179,7 @@ Example:
   Data::Dumper: 0
   File::Find: 1.03
 
-A YAML L<mapping|http://www.yaml.org/spec/#.-syntax-mapping-Mapping->
+A YAML L<mapping|http://yaml.org/spec/history/2002-10-31.html#syntax-mapping>
 indicating the Perl modules required for building and/or testing of
 this distribution.  These dependencies are not required after the
 module is installed.
@@ -183,7 +191,7 @@ Example:
   Data::Dumper: 0
   File::Find: 1.03
 
-A YAML L<mapping|http://www.yaml.org/spec/#.-syntax-mapping-Mapping->
+A YAML L<mapping|http://yaml.org/spec/history/2002-10-31.html#syntax-mapping>
 indicating the Perl modules that cannot be installed while this
 distribution is installed.  This is a pretty uncommon situation.
 
@@ -200,7 +208,7 @@ sensing the environment, etc.) as part of its build/install process.
 
 Currently L<Module::Build> doesn't actually do anything with
 this flag - it's probably going to be up to higher-level tools like
-L<CPAN|CPAN.pm> to do something useful with it.  It can potentially
+L<CPAN.pm|CPAN> to do something useful with it.  It can potentially
 bring lots of security, packaging, and convenience improvements.
 
 =item generated_by
index 7b4b2f41ce6590581a865dae35513aa30b9da933..e0428a5e83cfd6011d233f2786f728af3147d023 100644 (file)
@@ -21,7 +21,12 @@ Conversion from the original HTML to POD format
 =item *
 
 Include list of valid licenses from L<Module::Build> 0.18 rather than
-linking to the module.
+linking to the module, with minor updates to text and links to reflect
+versions at the time of publication.
+
+=item *
+
+Fixed some dead links to point to active resources.
 
 =back
 
@@ -43,16 +48,17 @@ install it.
 
 F<META.yml> files are written in the L<YAML|http://www.yaml.org/> format.  The
 reasons we chose YAML instead of, say, XML or Data::Dumper are discussed in
-L<this thread|http://archive.develooper.com/makemaker@perl.org/msg00405.html>
+L<this thread|http://www.nntp.perl.org/group/perl.makemaker/2002/04/msg406.html>
 on the MakeMaker mailing list.
 
-The first line of a F<META.yml> file should be a valid L<YAML document header|http://www.yaml.org/spec/#.Document>
+The first line of a F<META.yml> file should be a valid
+L<YAML document header|http://yaml.org/spec/history/2002-10-31.html#syntax-document>
 like C<"--- #YAML:1.0">
 
 =head1 Fields
 
 The rest of the META.yml file is one big YAML
-L<mapping|http://www.yaml.org/spec/#.-syntax-mapping-Mapping->,
+L<mapping|http://yaml.org/spec/history/2002-10-31.html#syntax-mapping>,
 whose keys are described here.
 
 =over 4
@@ -102,28 +108,29 @@ Must be one of the following licenses:
 
 The distribution may be copied and redistributed under the same terms as perl
 itself (this is by far the most common licensing option for modules on CPAN).
-This is a dual license, in which the user may choose between either the GPL or
-the Artistic license.
+This is a dual license, in which the user may choose between either the GPL
+version 1 or the Artistic version 1 license.
 
 =item gpl
 
-The distribution is distributed under the terms of the Gnu General Public
-License (L<http://www.opensource.org/licenses/gpl-license.php>).
+The distribution is distributed under the terms of the GNU General Public
+License version 2 (L<http://opensource.org/licenses/GPL-2.0>).
 
 =item lgpl
 
-The distribution is distributed under the terms of the Gnu Lesser General
-Public License (L<http://www.opensource.org/licenses/lgpl-license.php>).
+The distribution is distributed under the terms of the GNU Lesser General
+Public License version 2 (L<http://opensource.org/licenses/LGPL-2.1>).
 
 =item artistic
 
-The distribution is licensed under the Artistic License, as specified by the
-Artistic file in the standard perl distribution.
+The distribution is licensed under the Artistic License version 1, as specified
+by the Artistic file in the standard perl distribution
+(L<http://opensource.org/licenses/Artistic-Perl-1.0>).
 
 =item bsd
 
-The distribution is licensed under the BSD License
-(L<http://www.opensource.org/licenses/bsd-license.php>).
+The distribution is licensed under the BSD 3-Clause License
+(L<http://opensource.org/licenses/BSD-3-Clause>).
 
 =item open_source
 
@@ -133,7 +140,7 @@ license listed at L<http://www.opensource.org/licenses/>.
 =item unrestricted
 
 The distribution is licensed under a license that is B<not> approved by
-L<www.opensource.org|http://www.opensource.org> but that allows distribution
+L<www.opensource.org|http://www.opensource.org/> but that allows distribution
 without restrictions.
 
 =item restrictive
@@ -175,10 +182,11 @@ Example:
   Data::Dumper: 0
   File::Find: 1.03
 
-A YAML L<mapping|http://www.yaml.org/spec/#.-syntax-mapping-Mapping->
+A YAML L<mapping|http://yaml.org/spec/history/2002-10-31.html#syntax-mapping>
 indicating the Perl modules this distribution requires for proper
 operation.  The keys are the module names, and the values are version
-specifications as described in the L<Module::Build|documentation for Module::Build's "requires" parameter>.
+specifications as described in the
+L<documentation for Module::Build's "requires" parameter|Module::Build::API/requires>.
 
 I<Note: the exact nature of the fancy specifications like
 C<< ">= 1.2, != 1.5, < 2.0" >> is subject to
@@ -192,7 +200,7 @@ Example:
   Data::Dumper: 0
   File::Find: 1.03
 
-A YAML L<mapping|http://www.yaml.org/spec/#.-syntax-mapping-Mapping->
+A YAML L<mapping|http://yaml.org/spec/history/2002-10-31.html#syntax-mapping>
 indicating the Perl modules this distribution recommends for enhanced
 operation.
 
@@ -203,7 +211,7 @@ Example:
   Data::Dumper: 0
   File::Find: 1.03
 
-A YAML L<mapping|http://www.yaml.org/spec/#.-syntax-mapping-Mapping->
+A YAML L<mapping|http://yaml.org/spec/history/2002-10-31.html#syntax-mapping>
 indicating the Perl modules required for building and/or testing of
 this distribution.  These dependencies are not required after the
 module is installed.
@@ -215,7 +223,7 @@ Example:
   Data::Dumper: 0
   File::Find: 1.03
 
-A YAML L<mapping|http://www.yaml.org/spec/#.-syntax-mapping-Mapping->
+A YAML L<mapping|http://yaml.org/spec/history/2002-10-31.html#syntax-mapping>
 indicating the Perl modules that cannot be installed while this
 distribution is installed.  This is a pretty uncommon situation.
 
@@ -239,7 +247,7 @@ sensing the environment, etc.) as part of its build/install process.
 
 Currently L<Module::Build> doesn't actually do anything with
 this flag - it's probably going to be up to higher-level tools like
-L<CPAN|CPAN.pm> to do something useful with it.  It can potentially
+L<CPAN.pm|CPAN> to do something useful with it.  It can potentially
 bring lots of security, packaging, and convenience improvements.
 
 =item generated_by
index 48867b2b3507710f4afb83600b84e58dac7f82ea..1cb471fd2f22d40c5956551d3730ca450e967e24 100644 (file)
@@ -21,7 +21,12 @@ Various spelling corrections
 =item *
 
 Include list of valid licenses from L<Module::Build> 0.2611 rather than
-linking to the module.
+linking to the module, with minor updates to text and links to reflect
+versions at the time of publication.
+
+=item *
+
+Fixed some dead links to point to active resources.
 
 =back
 
@@ -96,21 +101,15 @@ XML or Data::Dumper:
 
 =item *
 
-Module::Build design plans
-
-L<http://nntp.x.perl.org/group/perl.makemaker/406>
+L<Module::Build design plans|http://www.nntp.perl.org/group/perl.makemaker/2002/04/msg407.html>
 
 =item *
 
-Not keen on YAML
-
-L<http://nntp.x.perl.org/group/perl.module-authors/1353>
+L<Not keen on YAML|http://www.nntp.perl.org/group/perl.module-authors/2003/11/msg1353.html>
 
 =item *
 
-META Concerns
-
-L<http://nntp.x.perl.org/group/perl.module-authors/1385>
+L<META Concerns|http://www.nntp.perl.org/group/perl.module-authors/2003/11/msg1385.html>
 
 =back
 
@@ -136,8 +135,8 @@ well (ex. python, ruby).
 
 =head1 VERSION SPECIFICATIONS
 
-Some fields require a version specification (ex. L<"requires">,
-L<"recommends">, L<"build_requires">, etc.).  This section details the
+Some fields require a version specification (ex. L</requires>,
+L</recommends>, L</build_requires>, etc.).  This section details the
 version specifications that are currently supported.
 
 If a single version is listed, then that version is considered to be
@@ -242,28 +241,29 @@ Must be one of the following licenses:
 
 The distribution may be copied and redistributed under the same terms as perl
 itself (this is by far the most common licensing option for modules on CPAN).
-This is a dual license, in which the user may choose between either the GPL or
-the Artistic license.
+This is a dual license, in which the user may choose between either the GPL
+version 1 or the Artistic version 1 license.
 
 =item gpl
 
-The distribution is distributed under the terms of the Gnu General Public
-License (L<http://www.opensource.org/licenses/gpl-license.php>).
+The distribution is distributed under the terms of the GNU General Public
+License version 2 (L<http://opensource.org/licenses/GPL-2.0>).
 
 =item lgpl
 
-The distribution is distributed under the terms of the Gnu Lesser General
-Public License (L<http://www.opensource.org/licenses/lgpl-license.php>).
+The distribution is distributed under the terms of the GNU Lesser General
+Public License version 2 (L<http://opensource.org/licenses/LGPL-2.1>).
 
 =item artistic
 
-The distribution is licensed under the Artistic License, as specified by the
-Artistic file in the standard perl distribution.
+The distribution is licensed under the Artistic License version 1, as specified
+by the Artistic file in the standard perl distribution
+(L<http://opensource.org/licenses/Artistic-Perl-1.0>).
 
 =item bsd
 
-The distribution is licensed under the BSD License
-(L<http://www.opensource.org/licenses/bsd-license.php>).
+The distribution is licensed under the BSD 3-Clause License
+(L<http://opensource.org/licenses/BSD-3-Clause>).
 
 =item open_source
 
@@ -273,7 +273,7 @@ license listed at L<http://www.opensource.org/licenses/>.
 =item unrestricted
 
 The distribution is licensed under a license that is B<not> approved by
-L<www.opensource.org|http://www.opensource.org> but that allows distribution
+L<www.opensource.org|http://www.opensource.org/> but that allows distribution
 without restrictions.
 
 =item restrictive
@@ -341,9 +341,9 @@ Example:
 
 I<(Spec 1.1) [optional] {map} A YAML sequence of names for optional features
 which are made available when its requirements are met. For each
-feature a description is provided along with any of L<"requires">,
-L<"build_requires">, L<"conflicts">, L<"requires_packages">,
-L<"requires_os">, and L<"excludes_os"> which have the same meaning in
+feature a description is provided along with any of L</requires>,
+L</build_requires>, L</conflicts>, C<requires_packages>,
+C<requires_os>, and C<excludes_os> which have the same meaning in
 this subcontext as described elsewhere in this document.>
 
 =head2 build_requires
@@ -394,7 +394,7 @@ If this field is omitted, it defaults to 1 (true).
 =head2 private
 
 I<(Deprecated)> (Spec 1.0) [optional] {map} This field has been renamed to
-L</"no_index">.  See below.
+L</no_index>.  See below.
 
 =head2 provides
 
@@ -416,7 +416,7 @@ cases, is) used by distribution and automation mechanisms like PAUSE,
 CPAN, and search.cpan.org to build indexes saying in which
 distribution various packages can be found.
 
-When using tools like C<Module::Build> that can generate the
+When using tools like L<Module::Build> that can generate the
 C<provides> mapping for your distribution automatically, make sure you
 examine what it generates to make sure it makes sense - indexers will
 usually trust the C<provides> field if it's present, rather than
@@ -536,23 +536,23 @@ tool. RWS]
 
 =head1 SEE ALSO
 
-CPAN, L<http://www.cpan.org/>
+L<CPAN|http://www.cpan.org/>
 
-CPAN.pm, L<http://search.cpan.org/author/ANDK/CPAN/>
+L<CPAN.pm|CPAN>
 
-CPANPLUS, L<http://search.cpan.org/author/KANE/CPANPLUS/>
+L<CPANPLUS>
 
-Data::Dumper, L<http://search.cpan.org/author/ILYAM/Data-Dumper/>
+L<Data::Dumper>
 
-ExtUtils::MakeMaker, L<http://search.cpan.org/author/MSCHWERN/ExtUtils-MakeMaker/>
+L<ExtUtils::MakeMaker>
 
-Module::Build, L<http://search.cpan.org/author/KWILLIAMS/Module-Build/>
+L<Module::Build>
 
-Module::Install, L<http://search.cpan.org/author/KWILLIAMS/Module-Install/>
+L<Module::Install>
 
-XML, L<http://www.w3.org/XML/>
+L<XML|http://www.w3.org/XML/>
 
-YAML, L<http://www.yaml.org/>
+L<YAML|http://www.yaml.org/>
 
 =head1 HISTORY
 
@@ -574,7 +574,7 @@ Created version 1.0 of this document.
 
 =item *
 
-Added the L</"dynamic_config"> field, which was missing from the initial
+Added the L</dynamic_config> field, which was missing from the initial
 version.
 
 =back
@@ -594,12 +594,12 @@ L<http://nntp.x.perl.org/group/> site.
 
 =item *
 
-Added and deprecated the L<"private"> field.
+Added and deprecated the L</private> field.
 
 =item *
 
-Added L<"abstract">, L<"configure">, L<"requires_packages">,
-L<"requires_os">, L<"excludes_os">, and L<"no_index"> fields.
+Added L</abstract>, C<configure>, C<requires_packages>,
+C<requires_os>, C<excludes_os>, and L</no_index> fields.
 
 =item *
 
@@ -613,15 +613,15 @@ Bumped version.
 
 =item *
 
-Added L<"generation">, L<"authored_by"> fields.
+Added C<generation>, C<authored_by> fields.
 
 =item *
 
-Add alternative proposal to the L<"recommends"> field.
+Add alternative proposal to the L</recommends> field.
 
 =item *
 
-Add proposal for a L<"requires_build_tools"> field.
+Add proposal for a C<requires_build_tools> field.
 
 =back
 
@@ -635,7 +635,7 @@ Added link to latest version of this specification on CPAN.
 
 =item *
 
-Added section L<"VERSION SPECIFICATIONS">.
+Added section L</"VERSION SPECIFICATIONS">.
 
 =item *
 
@@ -643,7 +643,7 @@ Chang name from Module::Build::META-spec to CPAN::META::Specification.
 
 =item *
 
-Add proposal for L<"auto_regenerate"> field.
+Add proposal for C<auto_regenerate> field.
 
 =back
 
@@ -653,15 +653,15 @@ Add proposal for L<"auto_regenerate"> field.
 
 =item *
 
-Add L<"index"> field as a compliment to L<"no_index">
+Add C<index> field as a compliment to L</no_index>
 
 =item *
 
-Add L<"keywords"> field as a means to aid searching distributions.
+Add L</keywords> field as a means to aid searching distributions.
 
 =item *
 
-Add L<"TERMINOLOGY"> section to explain certain terms that may be
+Add L</TERMINOLOGY> section to explain certain terms that may be
 ambiguous.
 
 =back
@@ -679,7 +679,7 @@ more like records of brainstorming.
 
 =item *
 
-Changed C<authored_by> to C<author>, since that's always been what
+Changed C<authored_by> to L</author>, since that's always been what
 it's actually called in actual F<META.yml> files.
 
 =item *
@@ -689,12 +689,12 @@ operators.
 
 =item *
 
-Noted that the C<distribution_type> field is basically meaningless,
+Noted that the L</distribution_type> field is basically meaningless,
 and shouldn't really be used.
 
 =item *
 
-Clarified C<dynamic_config> a bit.
+Clarified L</dynamic_config> a bit.
 
 =back
 
index b075adccde69e2973df15bc47bcac2d9a0d3879b..9e889cd5970a73b7cb739258981e6ce9fbe80645 100644 (file)
@@ -21,7 +21,12 @@ Various spelling corrections
 =item *
 
 Include list of valid licenses from L<Module::Build> 0.2805 rather than
-linking to the module.
+linking to the module, with minor updates to text and links to reflect
+versions at the time of publication.
+
+=item *
+
+Fixed some dead links to point to active resources.
 
 =back
 
@@ -94,17 +99,17 @@ XML or Data::Dumper:
 
 =over 4
 
-=item Module::Build design plans
+=item *
 
-L<http://nntp.x.perl.org/group/perl.makemaker/406>
+L<Module::Build design plans|http://www.nntp.perl.org/group/perl.makemaker/2002/04/msg407.html>
 
-=item Not keen on YAML
+=item *
 
-L<http://nntp.x.perl.org/group/perl.module-authors/1353>
+L<Not keen on YAML|http://www.nntp.perl.org/group/perl.module-authors/2003/11/msg1353.html>
 
-=item META Concerns
+=item *
 
-L<http://nntp.x.perl.org/group/perl.module-authors/1385>
+L<META Concerns|http://www.nntp.perl.org/group/perl.module-authors/2003/11/msg1385.html>
 
 =back
 
@@ -206,39 +211,40 @@ Must be one of the following licenses:
 
 =item apache
 
-The distribution is licensed under the Apache Software License
-(L<http://opensource.org/licenses/apachepl.php>).
+The distribution is licensed under the Apache Software License version 1.1
+(L<http://opensource.org/licenses/Apache-1.1>).
 
 =item artistic
 
-The distribution is licensed under the Artistic License, as specified by the
-Artistic file in the standard perl distribution.
+The distribution is licensed under the Artistic License version 1, as specified
+by the Artistic file in the standard perl distribution
+(L<http://opensource.org/licenses/Artistic-Perl-1.0>).
 
 =item bsd
 
-The distribution is licensed under the BSD License
-(L<http://www.opensource.org/licenses/bsd-license.php>).
+The distribution is licensed under the BSD 3-Clause License
+(L<http://opensource.org/licenses/BSD-3-Clause>).
 
 =item gpl
 
-The distribution is licensed under the terms of the Gnu General Public License
-(L<http://www.opensource.org/licenses/gpl-license.php>).
+The distribution is distributed under the terms of the GNU General Public
+License version 2 (L<http://opensource.org/licenses/GPL-2.0>).
 
 =item lgpl
 
-The distribution is licensed under the terms of the Gnu Lesser General Public
-License (L<http://www.opensource.org/licenses/lgpl-license.php>).
+The distribution is distributed under the terms of the GNU Lesser General
+Public License version 2 (L<http://opensource.org/licenses/LGPL-2.1>).
 
 =item mit
 
 The distribution is licensed under the MIT License
-(L<http://opensource.org/licenses/mit-license.php>).
+(L<http://opensource.org/licenses/MIT>).
 
 =item mozilla
 
 The distribution is licensed under the Mozilla Public License.
-(L<http://opensource.org/licenses/mozilla1.0.php> or
-L<http://opensource.org/licenses/mozilla1.1.php>)
+(L<http://opensource.org/licenses/MPL-1.0> or
+L<http://opensource.org/licenses/MPL-1.1>)
 
 =item open_source
 
@@ -249,8 +255,8 @@ license listed at L<http://www.opensource.org/licenses/>.
 
 The distribution may be copied and redistributed under the same terms as perl
 itself (this is by far the most common licensing option for modules on CPAN).
-This is a dual license, in which the user may choose between either the GPL or
-the Artistic license.
+This is a dual license, in which the user may choose between either the GPL
+version 1 or the Artistic version 1 license.
 
 =item restrictive
 
@@ -292,7 +298,7 @@ Example:
 (Spec 1.0) [optional] {map} A YAML mapping indicating the Perl modules this
 distribution requires for proper operation.  The keys are the module
 names, and the values are version specifications as described in
-L<VERSION SPECIFICATIONS>.
+L</"VERSION SPECIFICATIONS">.
 
 =head2 recommends
 
@@ -305,7 +311,7 @@ Example:
 (Spec 1.0) [optional] {map} A YAML mapping indicating the Perl modules
 this distribution recommends for enhanced operation.  The keys are the
 module names, and the values are version specifications as described
-in L<VERSION SPECIFICATIONS>.
+in L</"VERSION SPECIFICATIONS">.
 
 
 
@@ -327,9 +333,9 @@ Example:
 
 I<(Spec 1.1) [optional] {map} A YAML sequence of names for optional features
 which are made available when its requirements are met. For each
-feature a description is provided along with any of L<"requires">,
-L<"build_requires">, L<"conflicts">, L<"requires_packages">,
-L<"requires_os">, and L<"excludes_os"> which have the same meaning in
+feature a description is provided along with any of L</requires>,
+L</build_requires>, L</conflicts>, C<requires_packages>,
+C<requires_os>, and C<excludes_os> which have the same meaning in
 this subcontext as described elsewhere in this document.>
 
 =head2 build_requires
@@ -343,7 +349,7 @@ Example:
 (Spec 1.0) [optional] {map} A YAML mapping indicating the Perl modules
 required for building and/or testing of this distribution.  The keys
 are the module names, and the values are version specifications as
-described in L<VERSION SPECIFICATIONS>.  These dependencies are not
+described in L</"VERSION SPECIFICATIONS">.  These dependencies are not
 required after the module is installed.
 
 =head2 conflicts
@@ -358,7 +364,7 @@ Example:
 cannot be installed while this distribution is installed.  This is a
 pretty uncommon situation.  The keys for C<conflicts> are the module
 names, and the values are version specifications as described in
-L<VERSION SPECIFICATIONS>.
+L</"VERSION SPECIFICATIONS">.
 
 
 =head2 dynamic_config
@@ -385,7 +391,7 @@ If this field is omitted, it defaults to 1 (true).
 =head2 private
 
 I<(Deprecated)> (Spec 1.0) [optional] {map} This field has been renamed to
-L</"no_index">.  See below.
+L</no_index>.  See below.
 
 =head2 provides
 
@@ -407,7 +413,7 @@ cases, is) used by distribution and automation mechanisms like PAUSE,
 CPAN, and search.cpan.org to build indexes saying in which
 distribution various packages can be found.
 
-When using tools like C<Module::Build> that can generate the
+When using tools like L<Module::Build> that can generate the
 C<provides> mapping for your distribution automatically, make sure you
 examine what it generates to make sure it makes sense - indexers will
 usually trust the C<provides> field if it's present, rather than
@@ -437,7 +443,7 @@ directories, packages, and namespaces that are private
 and indexing tools.  This is useful when no C<provides> field is
 present.
 
-For example, C<search.cpan.org> excludes items listed in C<no_index>
+For example, L<http://search.cpan.org/> excludes items listed in C<no_index>
 when searching for POD, meaning files in these directories will not
 converted to HTML and made public - which is useful if you have
 example or test PODs that you don't want the search engine to go
@@ -534,8 +540,8 @@ tool. RWS]
 
 =head1 VERSION SPECIFICATIONS
 
-Some fields require a version specification (ex. L<"requires">,
-L<"recommends">, L<"build_requires">, etc.) to indicate the particular
+Some fields require a version specification (ex. L</requires>,
+L</recommends>, L</build_requires>, etc.) to indicate the particular
 versionZ<>(s) of some other module that may be required as a
 prerequisite.  This section details the version specification formats
 that are currently supported.
@@ -559,23 +565,23 @@ together using commas.  The specification C<E<gt>= 1.2, != 1.5, E<lt>
 
 =head1 SEE ALSO
 
-CPAN, L<http://www.cpan.org/>
+L<CPAN|http://www.cpan.org/>
 
-CPAN.pm, L<http://search.cpan.org/dist/CPAN/>
+L<CPAN.pm|CPAN>
 
-CPANPLUS, L<http://search.cpan.org/dist/CPANPLUS/>
+L<CPANPLUS>
 
-Data::Dumper, L<http://search.cpan.org/dist/Data-Dumper/>
+L<Data::Dumper>
 
-ExtUtils::MakeMaker, L<http://search.cpan.org/dist/ExtUtils-MakeMaker/>
+L<ExtUtils::MakeMaker>
 
-Module::Build, L<http://search.cpan.org/dist/Module-Build/>
+L<Module::Build>
 
-Module::Install, L<http://search.cpan.org/dist/Module-Install/>
+L<Module::Install>
 
-XML, L<http://www.w3.org/XML/>
+L<XML|http://www.w3.org/XML/>
 
-YAML, L<http://www.yaml.org/>
+L<YAML|http://www.yaml.org/>
 
 =head1 HISTORY
 
@@ -597,7 +603,7 @@ Created version 1.0 of this document.
 
 =item *
 
-Added the L</"dynamic_config"> field, which was missing from the initial
+Added the L</dynamic_config> field, which was missing from the initial
 version.
 
 =back
@@ -617,12 +623,12 @@ L<http://nntp.x.perl.org/group/> site.
 
 =item *
 
-Added and deprecated the L<"private"> field.
+Added and deprecated the L</private> field.
 
 =item *
 
-Added L<"abstract">, L<"configure">, L<"requires_packages">,
-L<"requires_os">, L<"excludes_os">, and L<"no_index"> fields.
+Added L</abstract>, C<configure>, C<requires_packages>,
+C<requires_os>, C<excludes_os>, and L</no_index> fields.
 
 =item *
 
@@ -636,15 +642,15 @@ Bumped version.
 
 =item *
 
-Added L<"generation">, L<"authored_by"> fields.
+Added C<generation>, C<authored_by> fields.
 
 =item *
 
-Add alternative proposal to the L<"recommends"> field.
+Add alternative proposal to the L</recommends> field.
 
 =item *
 
-Add proposal for a L<"requires_build_tools"> field.
+Add proposal for a C<requires_build_tools> field.
 
 =back
 
@@ -658,7 +664,7 @@ Added link to latest version of this specification on CPAN.
 
 =item *
 
-Added section L<"VERSION SPECIFICATIONS">.
+Added section L</"VERSION SPECIFICATIONS">.
 
 =item *
 
@@ -666,7 +672,7 @@ Chang name from Module::Build::META-spec to CPAN::META::Specification.
 
 =item *
 
-Add proposal for L<"auto_regenerate"> field.
+Add proposal for C<auto_regenerate> field.
 
 =back
 
@@ -676,15 +682,15 @@ Add proposal for L<"auto_regenerate"> field.
 
 =item *
 
-Add L<"index"> field as a compliment to L<"no_index">
+Add C<index> field as a compliment to L</no_index>
 
 =item *
 
-Add L<"keywords"> field as a means to aid searching distributions.
+Add L</keywords> field as a means to aid searching distributions.
 
 =item *
 
-Add L<"TERMINOLOGY"> section to explain certain terms that may be
+Add L</TERMINOLOGY> section to explain certain terms that may be
 ambiguous.
 
 =back
@@ -702,7 +708,7 @@ more like records of brainstorming.
 
 =item *
 
-Changed C<authored_by> to C<author>, since that's always been what
+Changed C<authored_by> to L</author>, since that's always been what
 it's actually called in actual F<META.yml> files.
 
 =item *
@@ -712,12 +718,12 @@ operators.
 
 =item *
 
-Noted that the C<distribution_type> field is basically meaningless,
+Noted that the L</distribution_type> field is basically meaningless,
 and shouldn't really be used.
 
 =item *
 
-Clarified C<dynamic_config> a bit.
+Clarified L</dynamic_config> a bit.
 
 =back
 
index 471296ce291b85215ffee26b3496ac5373acada4..932f1ed94b326133c69179e9ebbae3cb8b4273cd 100644 (file)
@@ -21,7 +21,12 @@ Various spelling corrections
 =item *
 
 Include list of valid licenses from L<Module::Build> 0.2807 rather than
-linking to the module.
+linking to the module, with minor updates to text and links to reflect
+versions at the time of publication.
+
+=item *
+
+Fixed some dead links to point to active resources.
 
 =back
 
@@ -84,35 +89,6 @@ and the latest development version (which may include things that
 won't make it into the stable version) can always be found at
 L<http://module-build.sourceforge.net/META-spec-blead.html>.>
 
-=begin MAINTAINER
-
-The master source for the META spec is META-spec.pod.  META-spec.html
-is built (manually) from META-spec.pod whenever there are changes, and
-the two files should generally be checked in together.  Ideally it
-would happen through a trigger or something, but it doesn't.
-
-Ken has a cron job that copies the latest bleeding-edge version of the
-spec (HTML version) to Sourceforge whenever his laptop is turned on:
-
-  21 * * * * svn cat http://svn.perl.org/modules/Module-Build/trunk/website/META-spec.html \
-       | ssh kwilliams@shell.sourceforge.net \
-       'cat > /home/groups/m/mo/module-build/htdocs/META-spec-blead.html'
-
-The numbered revisions of the spec at
-L<"http://module-build.sourceforge.net/"> are captures of the spec at
-opportune moments.  A couple of symlinks also exist for convenience:
-
- -rw-r--r--  1 kwilliams 24585 Oct 10 17:21 META-spec-blead.html
- lrwxrwxrwx  1 kwilliams    19 Jan 19  2007 META-spec-current.html -> META-spec-v1.3.html
- lrwxrwxrwx  1 kwilliams    22 Jan 19  2007 META-spec.html -> META-spec-current.html
- -rw-r--r--  1 kwilliams  5830 Jul 25  2005 META-spec-v1.0.html
- -rw-r--r--  1 kwilliams  7847 Jul 25  2005 META-spec-v1.1.html
- -rw-r--r--  1 kwilliams 22635 Aug 23  2005 META-spec-v1.2.html
- -rw-r--r--  1 kwilliams 24086 Nov  4  2006 META-spec-v1.3.html
-
-=end MAINTAINER
-
-
 =head1 FORMAT
 
 F<META.yml> files are written in the YAML format (see
@@ -123,17 +99,17 @@ XML or Data::Dumper:
 
 =over 4
 
-=item Module::Build design plans
+=item *
 
-L<http://nntp.x.perl.org/group/perl.makemaker/406>
+L<Module::Build design plans|http://www.nntp.perl.org/group/perl.makemaker/2002/04/msg407.html>
 
-=item Not keen on YAML
+=item *
 
-L<http://nntp.x.perl.org/group/perl.module-authors/1353>
+L<Not keen on YAML|http://www.nntp.perl.org/group/perl.module-authors/2003/11/msg1353.html>
 
-=item META Concerns
+=item *
 
-L<http://nntp.x.perl.org/group/perl.module-authors/1385>
+L<META Concerns|http://www.nntp.perl.org/group/perl.module-authors/2003/11/msg1385.html>
 
 =back
 
@@ -235,39 +211,40 @@ Must be one of the following licenses:
 
 =item apache
 
-The distribution is licensed under the Apache Software License
-(L<http://opensource.org/licenses/apachepl.php>).
+The distribution is licensed under the Apache Software License version 1.1
+(L<http://opensource.org/licenses/Apache-1.1>).
 
 =item artistic
 
-The distribution is licensed under the Artistic License, as specified by the
-Artistic file in the standard perl distribution.
+The distribution is licensed under the Artistic License version 1, as specified
+by the Artistic file in the standard perl distribution
+(L<http://opensource.org/licenses/Artistic-Perl-1.0>).
 
 =item bsd
 
-The distribution is licensed under the BSD License
-(L<http://www.opensource.org/licenses/bsd-license.php>).
+The distribution is licensed under the BSD 3-Clause License
+(L<http://opensource.org/licenses/BSD-3-Clause>).
 
 =item gpl
 
-The distribution is licensed under the terms of the Gnu General Public License
-(L<http://www.opensource.org/licenses/gpl-license.php>).
+The distribution is distributed under the terms of the GNU General Public
+License version 2 (L<http://opensource.org/licenses/GPL-2.0>).
 
 =item lgpl
 
-The distribution is licensed under the terms of the Gnu Lesser General Public
-License (L<http://www.opensource.org/licenses/lgpl-license.php>).
+The distribution is distributed under the terms of the GNU Lesser General
+Public License version 2 (L<http://opensource.org/licenses/LGPL-2.1>).
 
 =item mit
 
 The distribution is licensed under the MIT License
-(L<http://opensource.org/licenses/mit-license.php>).
+(L<http://opensource.org/licenses/MIT>).
 
 =item mozilla
 
 The distribution is licensed under the Mozilla Public License.
-(L<http://opensource.org/licenses/mozilla1.0.php> or
-L<http://opensource.org/licenses/mozilla1.1.php>)
+(L<http://opensource.org/licenses/MPL-1.0> or
+L<http://opensource.org/licenses/MPL-1.1>)
 
 =item open_source
 
@@ -355,8 +332,8 @@ Example:
 
 I<(Spec 1.1) [optional] {map} A YAML mapping of names for optional features
 which are made available when its requirements are met. For each
-feature a description is provided along with any of L<"requires">,
-L<"build_requires">, and L<"conflicts">, which have the same meaning in
+feature a description is provided along with any of L</requires>,
+L</build_requires>, and L</conflicts>, which have the same meaning in
 this subcontext as described elsewhere in this document.>
 
 =head2 build_requires
@@ -371,7 +348,7 @@ Example:
 prerequisites required for building and/or testing of this
 distribution.  The keys are the names of the prerequisites (module
 names or 'perl'), and the values are version specifications as
-described in L<VERSION SPECIFICATIONS>.  These dependencies are not
+described in L</"VERSION SPECIFICATIONS">.  These dependencies are not
 required after the distribution is installed.
 
 =head2 configure_requires
@@ -385,9 +362,9 @@ Example:
 
 (Spec 1.4) [optional] {map} A YAML mapping indicating the Perl prerequisites
 required before configuring this distribution.  The keys are the
-names of the prerequisites (module names or 'perl'), and the values are version specifications as described
-in L<VERSION SPECIFICATIONS>.  These dependencies are not required
-after the distribution is installed.
+names of the prerequisites (module names or 'perl'), and the values are version
+specifications as described in L</"VERSION SPECIFICATIONS">.  These
+dependencies are not required after the distribution is installed.
 
 =head2 conflicts
 
@@ -401,7 +378,7 @@ Example:
 cannot be installed while this distribution is installed.  This is a
 pretty uncommon situation.  The keys for C<conflicts> are the item
 names (module names or 'perl'), and the values are version
-specifications as described in L<VERSION SPECIFICATIONS>.
+specifications as described in L</"VERSION SPECIFICATIONS">.
 
 
 =head2 dynamic_config
@@ -428,7 +405,7 @@ If this field is omitted, it defaults to 1 (true).
 =head2 private
 
 I<(Deprecated)> (Spec 1.0) [optional] {map} This field has been renamed to
-L</"no_index">.  See below.
+L</no_index>.  See below.
 
 =head2 provides
 
@@ -450,7 +427,7 @@ cases, is) used by distribution and automation mechanisms like PAUSE,
 CPAN, and search.cpan.org to build indexes saying in which
 distribution various packages can be found.
 
-When using tools like C<Module::Build> that can generate the
+When using tools like L<Module::Build> that can generate the
 C<provides> mapping for your distribution automatically, make sure you
 examine what it generates to make sure it makes sense - indexers will
 usually trust the C<provides> field if it's present, rather than
@@ -480,7 +457,7 @@ directories, packages, and namespaces that are private
 and indexing tools.  This is useful when no C<provides> field is
 present.
 
-For example, C<search.cpan.org> excludes items listed in C<no_index>
+For example, L<http://search.cpan.org/> excludes items listed in C<no_index>
 when searching for POD, meaning files in these directories will not
 converted to HTML and made public - which is useful if you have
 example or test PODs that you don't want the search engine to go
@@ -577,8 +554,8 @@ tool. RWS]
 
 =head1 VERSION SPECIFICATIONS
 
-Some fields require a version specification (ex. L<"requires">,
-L<"recommends">, L<"build_requires">, etc.) to indicate the particular
+Some fields require a version specification (ex. L</requires>,
+L</recommends>, L</build_requires>, etc.) to indicate the particular
 versionZ<>(s) of some other module that may be required as a
 prerequisite.  This section details the version specification formats
 that are currently supported.
@@ -602,23 +579,23 @@ together using commas.  The specification C<E<gt>= 1.2, != 1.5, E<lt>
 
 =head1 SEE ALSO
 
-CPAN, L<http://www.cpan.org/>
+L<CPAN|http://www.cpan.org/>
 
-CPAN.pm, L<http://search.cpan.org/dist/CPAN/>
+L<CPAN.pm|CPAN>
 
-CPANPLUS, L<http://search.cpan.org/dist/CPANPLUS/>
+L<CPANPLUS>
 
-Data::Dumper, L<http://search.cpan.org/dist/Data-Dumper/>
+L<Data::Dumper>
 
-ExtUtils::MakeMaker, L<http://search.cpan.org/dist/ExtUtils-MakeMaker/>
+L<ExtUtils::MakeMaker>
 
-Module::Build, L<http://search.cpan.org/dist/Module-Build/>
+L<Module::Build>
 
-Module::Install, L<http://search.cpan.org/dist/Module-Install/>
+L<Module::Install>
 
-XML, L<http://www.w3.org/XML/>
+L<XML|http://www.w3.org/XML/>
 
-YAML, L<http://www.yaml.org/>
+L<YAML|http://www.yaml.org/>
 
 =head1 HISTORY
 
@@ -640,7 +617,7 @@ Created version 1.0 of this document.
 
 =item *
 
-Added the L</"dynamic_config"> field, which was missing from the initial
+Added the L</dynamic_config> field, which was missing from the initial
 version.
 
 =back
@@ -660,12 +637,12 @@ L<http://nntp.x.perl.org/group/> site.
 
 =item *
 
-Added and deprecated the L<"private"> field.
+Added and deprecated the L</private> field.
 
 =item *
 
-Added L<"abstract">, L<"configure">, L<"requires_packages">,
-L<"requires_os">, L<"excludes_os">, and L<"no_index"> fields.
+Added L</abstract>, C<configure>, C<requires_packages>,
+C<requires_os>, C<excludes_os>, and L</no_index> fields.
 
 =item *
 
@@ -679,15 +656,15 @@ Bumped version.
 
 =item *
 
-Added L<"generation">, L<"authored_by"> fields.
+Added C<generation>, C<authored_by> fields.
 
 =item *
 
-Add alternative proposal to the L<"recommends"> field.
+Add alternative proposal to the L</recommends> field.
 
 =item *
 
-Add proposal for a L<"requires_build_tools"> field.
+Add proposal for a C<requires_build_tools> field.
 
 =back
 
@@ -701,7 +678,7 @@ Added link to latest version of this specification on CPAN.
 
 =item *
 
-Added section L<"VERSION SPECIFICATIONS">.
+Added section L</"VERSION SPECIFICATIONS">.
 
 =item *
 
@@ -709,7 +686,7 @@ Chang name from Module::Build::META-spec to CPAN::META::Specification.
 
 =item *
 
-Add proposal for L<"auto_regenerate"> field.
+Add proposal for C<auto_regenerate> field.
 
 =back
 
@@ -719,15 +696,15 @@ Add proposal for L<"auto_regenerate"> field.
 
 =item *
 
-Add L<"index"> field as a compliment to L<"no_index">
+Add C<index> field as a compliment to L</no_index>
 
 =item *
 
-Add L<"keywords"> field as a means to aid searching distributions.
+Add L</keywords> field as a means to aid searching distributions.
 
 =item *
 
-Add L<"TERMINOLOGY"> section to explain certain terms that may be
+Add L</TERMINOLOGY> section to explain certain terms that may be
 ambiguous.
 
 =back
@@ -745,7 +722,7 @@ more like records of brainstorming.
 
 =item *
 
-Changed C<authored_by> to C<author>, since that's always been what
+Changed C<authored_by> to L</author>, since that's always been what
 it's actually called in actual F<META.yml> files.
 
 =item *
@@ -755,12 +732,12 @@ operators.
 
 =item *
 
-Noted that the C<distribution_type> field is basically meaningless,
+Noted that the L</distribution_type> field is basically meaningless,
 and shouldn't really be used.
 
 =item *
 
-Clarified C<dynamic_config> a bit.
+Clarified L</dynamic_config> a bit.
 
 =back
 
@@ -781,7 +758,7 @@ module that doesn't actually exist.
 
 =item *
 
-Added C<configure_requires>.
+Added L</configure_requires>.
 
 =back
 
index 05a18ea97327529f3b51cc0756559012e35d9776..3604eae4022af4bd33288128a55a6b6a66eda3c7 100644 (file)
@@ -3,7 +3,7 @@ use warnings;
 
 package CPAN::Meta::Merge;
 
-our $VERSION = '2.150005';
+our $VERSION = '2.150010';
 
 use Carp qw/croak/;
 use Scalar::Util qw/blessed/;
@@ -73,7 +73,7 @@ sub _uniq_map {
   return $left;
 }
 
-sub _improvize {
+sub _improvise {
   my ($left, $right, $path) = @_;
   my ($name) = reverse @{$path};
   if ($name =~ /^x_/) {
@@ -154,9 +154,9 @@ my %default = (
     homepage   => \&_identical,
     bugtracker => \&_uniq_map,
     repository => \&_uniq_map,
-    ':default' => \&_improvize,
+    ':default' => \&_improvise,
   },
-  ':default' => \&_improvize,
+  ':default' => \&_improvise,
 );
 
 sub new {
@@ -182,7 +182,8 @@ my %coderef_for = (
   set_addition => \&_set_addition,
   uniq_map     => \&_uniq_map,
   identical    => \&_identical,
-  improvize    => \&_improvize,
+  improvise    => \&_improvise,
+  improvize    => \&_improvise, # [sic] for backwards compatibility
 );
 
 sub _coerce_mapping {
@@ -250,7 +251,7 @@ CPAN::Meta::Merge - Merging CPAN Meta fragments
 
 =head1 VERSION
 
-version 2.150005
+version 2.150010
 
 =head1 SYNOPSIS
 
@@ -268,11 +269,60 @@ argument, C<version>, declaring the version of the meta-spec that must be
 used for the merge. It can optionally take an C<extra_mappings> argument
 that allows one to add additional merging functions for specific elements.
 
+The C<extra_mappings> arguments takes a hash ref with the same type of
+structure as described in L<CPAN::Meta::Spec>, except with its values as
+one of the L<defined merge strategies|/"MERGE STRATEGIES"> or a code ref
+to a merging function.
+
+  my $merger = CPAN::Meta::Merge->new(
+      default_version => '2',
+      extra_mappings => {
+          'optional_features' => \&custom_merge_function,
+          'x_custom' => 'set_addition',
+          'x_meta_meta' => {
+              name => 'identical',
+              tags => 'set_addition',
+          }
+      }
+  );
+
 =head2 merge(@fragments)
 
 Merge all C<@fragments> together. It will accept both CPAN::Meta objects and
 (possibly incomplete) hashrefs of metadata.
 
+=head1 MERGE STRATEGIES
+
+C<merge> uses various strategies to combine different elements of the CPAN::Meta objects.  The following strategies can be used with the extra_mappings argument of C<new>:
+
+=over
+
+=item identical
+
+The elements must be identical
+
+=item set_addition
+
+The union of two array refs
+
+  [ a, b ] U [ a, c]  = [ a, b, c ]
+
+=item uniq_map
+
+Key value pairs from the right hash are merged to the left hash.  Key
+collisions are only allowed if their values are the same.  This merge
+function will recurse into nested hash refs following the same merge
+rules.
+
+=item improvise
+
+This merge strategy will try to pick the appropriate predefined strategy
+based on what element type.  Array refs will try to use the
+C<set_addition> strategy,  Hash refs will try to use the C<uniq_map>
+strategy, and everything else will try the C<identical> strategy.
+
+=back
+
 =head1 AUTHORS
 
 =over 4
@@ -285,11 +335,15 @@ David Golden <dagolden@cpan.org>
 
 Ricardo Signes <rjbs@cpan.org>
 
+=item *
+
+Adam Kennedy <adamk@cpan.org>
+
 =back
 
 =head1 COPYRIGHT AND LICENSE
 
-This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.
 
 This is free software; you can redistribute it and/or modify it under
 the same terms as the Perl 5 programming language system itself.
index 8a13eb13c81f4c08b3aa612f605765829d8bf488..d4e93fd8a5c01000d441c8bc7f1925b4f06a6b21 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 package CPAN::Meta::Prereqs;
 
-our $VERSION = '2.150005';
+our $VERSION = '2.150010';
 
 #pod =head1 DESCRIPTION
 #pod
@@ -45,6 +45,7 @@ use CPAN::Meta::Requirements 2.121;
 #pod
 #pod =cut
 
+# note we also accept anything matching /\Ax_/i
 sub __legal_phases { qw(configure build test runtime develop)   }
 sub __legal_types  { qw(requires recommends suggests conflicts) }
 
@@ -114,6 +115,40 @@ sub requirements_for {
   return $req;
 }
 
+#pod =method phases
+#pod
+#pod   my @phases = $prereqs->phases;
+#pod
+#pod This method returns the list of all phases currently populated in the prereqs
+#pod object, suitable for iterating.
+#pod
+#pod =cut
+
+sub phases {
+  my ($self) = @_;
+
+  my %is_legal_phase = map {; $_ => 1 } $self->__legal_phases;
+  grep { /\Ax_/i or $is_legal_phase{$_} } keys %{ $self->{prereqs} };
+}
+
+#pod =method types_in
+#pod
+#pod   my @runtime_types = $prereqs->types_in('runtime');
+#pod
+#pod This method returns the list of all types currently populated in the prereqs
+#pod object for the provided phase, suitable for iterating.
+#pod
+#pod =cut
+
+sub types_in {
+  my ($self, $phase) = @_;
+
+  return unless $phase =~ /\Ax_/i or grep { $phase eq $_ } $self->__legal_phases;
+
+  my %is_legal_type  = map {; $_ => 1 } $self->__legal_types;
+  grep { /\Ax_/i or $is_legal_type{$_} } keys %{ $self->{prereqs}{$phase} };
+}
+
 #pod =method with_merged_prereqs
 #pod
 #pod   my $new_prereqs = $prereqs->with_merged_prereqs( $other_prereqs );
@@ -139,8 +174,9 @@ sub with_merged_prereqs {
 
   my %new_arg;
 
-  for my $phase ($self->__legal_phases) {
-    for my $type ($self->__legal_types) {
+  for my $phase (__uniq(map { $_->phases } @prereq_objs)) {
+    for my $type (__uniq(map { $_->types_in($phase) } @prereq_objs)) {
+
       my $req = CPAN::Meta::Requirements->new;
 
       for my $prereq (@prereq_objs) {
@@ -215,8 +251,8 @@ sub as_string_hash {
 
   my %hash;
 
-  for my $phase ($self->__legal_phases) {
-    for my $type ($self->__legal_types) {
+  for my $phase ($self->phases) {
+    for my $type ($self->types_in($phase)) {
       my $req = $self->requirements_for($phase, $type);
       next unless $req->required_modules;
 
@@ -271,6 +307,11 @@ sub clone {
   my $clone = (ref $self)->new( $self->as_string_hash );
 }
 
+sub __uniq {
+  my (%s, $u);
+  grep { defined($_) ? !$s{$_}++ : !$u++ } @_;
+}
+
 1;
 
 # ABSTRACT: a set of distribution prerequisites by phase and type
@@ -285,7 +326,7 @@ CPAN::Meta::Prereqs - a set of distribution prerequisites by phase and type
 
 =head1 VERSION
 
-version 2.150005
+version 2.150010
 
 =head1 DESCRIPTION
 
@@ -333,6 +374,20 @@ be added to as needed.
 If C<$phase> or C<$type> are undefined or otherwise invalid, an exception will
 be raised.
 
+=head2 phases
+
+  my @phases = $prereqs->phases;
+
+This method returns the list of all phases currently populated in the prereqs
+object, suitable for iterating.
+
+=head2 types_in
+
+  my @runtime_types = $prereqs->types_in('runtime');
+
+This method returns the list of all types currently populated in the prereqs
+object for the provided phase, suitable for iterating.
+
 =head2 with_merged_prereqs
 
   my $new_prereqs = $prereqs->with_merged_prereqs( $other_prereqs );
@@ -405,11 +460,15 @@ David Golden <dagolden@cpan.org>
 
 Ricardo Signes <rjbs@cpan.org>
 
+=item *
+
+Adam Kennedy <adamk@cpan.org>
+
 =back
 
 =head1 COPYRIGHT AND LICENSE
 
-This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.
 
 This is free software; you can redistribute it and/or modify it under
 the same terms as the Perl 5 programming language system itself.
index 9056940b51a26a9d91cb5537726d08b0bb4ec140..16e7495938d80d2424aea5196bee7af6889ba6ad 100644 (file)
@@ -8,7 +8,7 @@ use strict;
 use warnings;
 package CPAN::Meta::Spec;
 
-our $VERSION = '2.150005';
+our $VERSION = '2.150010';
 
 1;
 
@@ -29,7 +29,7 @@ CPAN::Meta::Spec - specification for CPAN distribution metadata
 
 =head1 VERSION
 
-version 2.150005
+version 2.150010
 
 =head1 SYNOPSIS
 
@@ -159,7 +159,8 @@ constraints on the values of a data element.
 =head2 Boolean
 
 A I<Boolean> is used to provide a true or false value.  It B<must> be
-represented as a defined value.
+represented as a defined value that is either "1" or "0" or stringifies
+to those values.
 
 =head2 String
 
@@ -1196,6 +1197,10 @@ L<Module::Build>
 
 L<Module::Install>
 
+=item *
+
+L<CPAN::Meta::History::Meta_1_4>
+
 =back
 
 =head1 HISTORY
@@ -1223,11 +1228,15 @@ David Golden <dagolden@cpan.org>
 
 Ricardo Signes <rjbs@cpan.org>
 
+=item *
+
+Adam Kennedy <adamk@cpan.org>
+
 =back
 
 =head1 COPYRIGHT AND LICENSE
 
-This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.
 
 This is free software; you can redistribute it and/or modify it under
 the same terms as the Perl 5 programming language system itself.
index eddaa1073025ed5170f32fb100f4c3340a483ed2..a2256dea66267a864a1c5b3eeea597fe964d5fb5 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 package CPAN::Meta::Validator;
 
-our $VERSION = '2.150005';
+our $VERSION = '2.150010';
 
 #pod =head1 SYNOPSIS
 #pod
@@ -669,8 +669,8 @@ sub check_list {
 #pod
 #pod boolean($self,$key,$value)
 #pod
-#pod Validates for a boolean value. Currently these values are '1', '0', 'true',
-#pod 'false', however the latter 2 may be removed.
+#pod Validates for a boolean value: a defined value that is either "1" or "0" or
+#pod stringifies to those values.
 #pod
 #pod =item *
 #pod
@@ -833,7 +833,7 @@ sub version {
 sub boolean {
     my ($self,$key,$value) = @_;
     if(defined $value) {
-        return 1    if($value =~ /^(0|1|true|false)$/);
+        return 1    if($value =~ /^(0|1)$/);
     } else {
         $value = '<undef>';
     }
@@ -996,7 +996,7 @@ CPAN::Meta::Validator - validate CPAN distribution metadata structures
 
 =head1 VERSION
 
-version 2.150005
+version 2.150010
 
 =head1 SYNOPSIS
 
@@ -1124,8 +1124,8 @@ are both valid. A leading 'v' like 'v1.2.3' is also valid.
 
 boolean($self,$key,$value)
 
-Validates for a boolean value. Currently these values are '1', '0', 'true',
-'false', however the latter 2 may be removed.
+Validates for a boolean value: a defined value that is either "1" or "0" or
+stringifies to those values.
 
 =item *
 
@@ -1193,11 +1193,15 @@ David Golden <dagolden@cpan.org>
 
 Ricardo Signes <rjbs@cpan.org>
 
+=item *
+
+Adam Kennedy <adamk@cpan.org>
+
 =back
 
 =head1 COPYRIGHT AND LICENSE
 
-This software is copyright (c) 2010 by David Golden and Ricardo Signes.
+This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.
 
 This is free software; you can redistribute it and/or modify it under
 the same terms as the Perl 5 programming language system itself.
diff --git a/cpan/CPAN-Meta/lib/Parse/CPAN/Meta.pm b/cpan/CPAN-Meta/lib/Parse/CPAN/Meta.pm
new file mode 100644 (file)
index 0000000..688bcfe
--- /dev/null
@@ -0,0 +1,370 @@
+use 5.008001;
+use strict;
+use warnings;
+package Parse::CPAN::Meta;
+# ABSTRACT: Parse META.yml and META.json CPAN metadata files
+
+our $VERSION = '2.150010';
+
+use Exporter;
+use Carp 'croak';
+
+our @ISA = qw/Exporter/;
+our @EXPORT_OK = qw/Load LoadFile/;
+
+sub load_file {
+  my ($class, $filename) = @_;
+
+  my $meta = _slurp($filename);
+
+  if ($filename =~ /\.ya?ml$/) {
+    return $class->load_yaml_string($meta);
+  }
+  elsif ($filename =~ /\.json$/) {
+    return $class->load_json_string($meta);
+  }
+  else {
+    $class->load_string($meta); # try to detect yaml/json
+  }
+}
+
+sub load_string {
+  my ($class, $string) = @_;
+  if ( $string =~ /^---/ ) { # looks like YAML
+    return $class->load_yaml_string($string);
+  }
+  elsif ( $string =~ /^\s*\{/ ) { # looks like JSON
+    return $class->load_json_string($string);
+  }
+  else { # maybe doc-marker-free YAML
+    return $class->load_yaml_string($string);
+  }
+}
+
+sub load_yaml_string {
+  my ($class, $string) = @_;
+  my $backend = $class->yaml_backend();
+  my $data = eval { no strict 'refs'; &{"$backend\::Load"}($string) };
+  croak $@ if $@;
+  return $data || {}; # in case document was valid but empty
+}
+
+sub load_json_string {
+  my ($class, $string) = @_;
+  require Encode;
+  # load_json_string takes characters, decode_json expects bytes
+  my $encoded = Encode::encode('UTF-8', $string, Encode::PERLQQ());
+  my $data = eval { $class->json_decoder()->can('decode_json')->($encoded) };
+  croak $@ if $@;
+  return $data || {};
+}
+
+sub yaml_backend {
+  if ($ENV{PERL_CORE} or not defined $ENV{PERL_YAML_BACKEND} ) {
+    _can_load( 'CPAN::Meta::YAML', 0.011 )
+      or croak "CPAN::Meta::YAML 0.011 is not available\n";
+    return "CPAN::Meta::YAML";
+  }
+  else {
+    my $backend = $ENV{PERL_YAML_BACKEND};
+    _can_load( $backend )
+      or croak "Could not load PERL_YAML_BACKEND '$backend'\n";
+    $backend->can("Load")
+      or croak "PERL_YAML_BACKEND '$backend' does not implement Load()\n";
+    return $backend;
+  }
+}
+
+sub json_decoder {
+  if ($ENV{PERL_CORE}) {
+    _can_load( 'JSON::PP' => 2.27300 )
+      or croak "JSON::PP 2.27300 is not available\n";
+    return 'JSON::PP';
+  }
+  if (my $decoder = $ENV{CPAN_META_JSON_DECODER}) {
+    _can_load( $decoder )
+      or croak "Could not load CPAN_META_JSON_DECODER '$decoder'\n";
+    $decoder->can('decode_json')
+      or croak "No decode_json sub provided by CPAN_META_JSON_DECODER '$decoder'\n";
+    return $decoder;
+  }
+  return $_[0]->json_backend;
+}
+
+sub json_backend {
+  if ($ENV{PERL_CORE}) {
+    _can_load( 'JSON::PP' => 2.27300 )
+      or croak "JSON::PP 2.27300 is not available\n";
+    return 'JSON::PP';
+  }
+  if (my $backend = $ENV{CPAN_META_JSON_BACKEND}) {
+    _can_load( $backend )
+      or croak "Could not load CPAN_META_JSON_BACKEND '$backend'\n";
+    $backend->can('new')
+      or croak "No constructor provided by CPAN_META_JSON_BACKEND '$backend'\n";
+    return $backend;
+  }
+  if (! $ENV{PERL_JSON_BACKEND} or $ENV{PERL_JSON_BACKEND} eq 'JSON::PP') {
+    _can_load( 'JSON::PP' => 2.27300 )
+      or croak "JSON::PP 2.27300 is not available\n";
+    return 'JSON::PP';
+  }
+  else {
+    _can_load( 'JSON' => 2.5 )
+      or croak  "JSON 2.5 is required for " .
+                "\$ENV{PERL_JSON_BACKEND} = '$ENV{PERL_JSON_BACKEND}'\n";
+    return "JSON";
+  }
+}
+
+sub _slurp {
+  require Encode;
+  open my $fh, "<:raw", "$_[0]" ## no critic
+    or die "can't open $_[0] for reading: $!";
+  my $content = do { local $/; <$fh> };
+  $content = Encode::decode('UTF-8', $content, Encode::PERLQQ());
+  return $content;
+}
+
+sub _can_load {
+  my ($module, $version) = @_;
+  (my $file = $module) =~ s{::}{/}g;
+  $file .= ".pm";
+  return 1 if $INC{$file};
+  return 0 if exists $INC{$file}; # prior load failed
+  eval { require $file; 1 }
+    or return 0;
+  if ( defined $version ) {
+    eval { $module->VERSION($version); 1 }
+      or return 0;
+  }
+  return 1;
+}
+
+# Kept for backwards compatibility only
+# Create an object from a file
+sub LoadFile ($) { ## no critic
+  return Load(_slurp(shift));
+}
+
+# Parse a document from a string.
+sub Load ($) { ## no critic
+  require CPAN::Meta::YAML;
+  my $object = eval { CPAN::Meta::YAML::Load(shift) };
+  croak $@ if $@;
+  return $object;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Parse::CPAN::Meta - Parse META.yml and META.json CPAN metadata files
+
+=head1 VERSION
+
+version 2.150010
+
+=head1 SYNOPSIS
+
+    #############################################
+    # In your file
+
+    ---
+    name: My-Distribution
+    version: 1.23
+    resources:
+      homepage: "http://example.com/dist/My-Distribution"
+
+
+    #############################################
+    # In your program
+
+    use Parse::CPAN::Meta;
+
+    my $distmeta = Parse::CPAN::Meta->load_file('META.yml');
+
+    # Reading properties
+    my $name     = $distmeta->{name};
+    my $version  = $distmeta->{version};
+    my $homepage = $distmeta->{resources}{homepage};
+
+=head1 DESCRIPTION
+
+B<Parse::CPAN::Meta> is a parser for F<META.json> and F<META.yml> files, using
+L<JSON::PP> and/or L<CPAN::Meta::YAML>.
+
+B<Parse::CPAN::Meta> provides three methods: C<load_file>, C<load_json_string>,
+and C<load_yaml_string>.  These will read and deserialize CPAN metafiles, and
+are described below in detail.
+
+B<Parse::CPAN::Meta> provides a legacy API of only two functions,
+based on the YAML functions of the same name. Wherever possible,
+identical calling semantics are used.  These may only be used with YAML sources.
+
+All error reporting is done with exceptions (die'ing).
+
+Note that META files are expected to be in UTF-8 encoding, only.  When
+converted string data, it must first be decoded from UTF-8.
+
+=begin Pod::Coverage
+
+
+
+
+=end Pod::Coverage
+
+=head1 METHODS
+
+=head2 load_file
+
+  my $metadata_structure = Parse::CPAN::Meta->load_file('META.json');
+
+  my $metadata_structure = Parse::CPAN::Meta->load_file('META.yml');
+
+This method will read the named file and deserialize it to a data structure,
+determining whether it should be JSON or YAML based on the filename.
+The file will be read using the ":utf8" IO layer.
+
+=head2 load_yaml_string
+
+  my $metadata_structure = Parse::CPAN::Meta->load_yaml_string($yaml_string);
+
+This method deserializes the given string of YAML and returns the first
+document in it.  (CPAN metadata files should always have only one document.)
+If the source was UTF-8 encoded, the string must be decoded before calling
+C<load_yaml_string>.
+
+=head2 load_json_string
+
+  my $metadata_structure = Parse::CPAN::Meta->load_json_string($json_string);
+
+This method deserializes the given string of JSON and the result.
+If the source was UTF-8 encoded, the string must be decoded before calling
+C<load_json_string>.
+
+=head2 load_string
+
+  my $metadata_structure = Parse::CPAN::Meta->load_string($some_string);
+
+If you don't know whether a string contains YAML or JSON data, this method
+will use some heuristics and guess.  If it can't tell, it assumes YAML.
+
+=head2 yaml_backend
+
+  my $backend = Parse::CPAN::Meta->yaml_backend;
+
+Returns the module name of the YAML serializer. See L</ENVIRONMENT>
+for details.
+
+=head2 json_backend
+
+  my $backend = Parse::CPAN::Meta->json_backend;
+
+Returns the module name of the JSON serializer.  If C<CPAN_META_JSON_BACKEND>
+is set, this will be whatever that's set to.  If not, this will either
+be L<JSON::PP> or L<JSON>.  If C<PERL_JSON_BACKEND> is set,
+this will return L<JSON> as further delegation is handled by
+the L<JSON> module.  See L</ENVIRONMENT> for details.
+
+=head2 json_decoder
+
+  my $decoder = Parse::CPAN::Meta->json_decoder;
+
+Returns the module name of the JSON decoder.  Unlike L</json_backend>, this
+is not necessarily a full L<JSON>-style module, but only something that will
+provide a C<decode_json> subroutine.  If C<CPAN_META_JSON_DECODER> is set,
+this will be whatever that's set to.  If not, this will be whatever has
+been selected as L</json_backend>.  See L</ENVIRONMENT> for more notes.
+
+=head1 FUNCTIONS
+
+For maintenance clarity, no functions are exported by default.  These functions
+are available for backwards compatibility only and are best avoided in favor of
+C<load_file>.
+
+=head2 Load
+
+  my @yaml = Parse::CPAN::Meta::Load( $string );
+
+Parses a string containing a valid YAML stream into a list of Perl data
+structures.
+
+=head2 LoadFile
+
+  my @yaml = Parse::CPAN::Meta::LoadFile( 'META.yml' );
+
+Reads the YAML stream from a file instead of a string.
+
+=head1 ENVIRONMENT
+
+=head2 CPAN_META_JSON_DECODER
+
+By default, L<JSON::PP> will be used for deserializing JSON data.  If the
+C<CPAN_META_JSON_DECODER> environment variable exists, this is expected to
+be the name of a loadable module that provides a C<decode_json> subroutine,
+which will then be used for deserialization.  Relying only on the existence
+of said subroutine allows for maximum compatibility, since this API is
+provided by all of L<JSON::PP>, L<JSON::XS>, L<Cpanel::JSON::XS>,
+L<JSON::MaybeXS>, L<JSON::Tiny>, and L<Mojo::JSON>.
+
+=head2 CPAN_META_JSON_BACKEND
+
+By default, L<JSON::PP> will be used for deserializing JSON data.  If the
+C<CPAN_META_JSON_BACKEND> environment variable exists, this is expected to
+be the name of a loadable module that provides the L<JSON> API, since
+downstream code expects to be able to call C<new> on this class.  As such,
+while L<JSON::PP>, L<JSON::XS>, L<Cpanel::JSON::XS> and L<JSON::MaybeXS> will
+work for this, to use L<Mojo::JSON> or L<JSON::Tiny> for decoding requires
+setting L</CPAN_META_JSON_DECODER>.
+
+=head2 PERL_JSON_BACKEND
+
+If the C<CPAN_META_JSON_BACKEND> environment variable does not exist, and if
+C<PERL_JSON_BACKEND> environment variable exists, is true and is not
+"JSON::PP", then the L<JSON> module (version 2.5 or greater) will be loaded and
+used to interpret C<PERL_JSON_BACKEND>.  If L<JSON> is not installed or is too
+old, an exception will be thrown.  Note that at the time of writing, the only
+useful values are 1, which will tell L<JSON> to guess, or L<JSON::XS> - if
+you want to use a newer JSON module, see L</CPAN_META_JSON_BACKEND>.
+
+=head2 PERL_YAML_BACKEND
+
+By default, L<CPAN::Meta::YAML> will be used for deserializing YAML data. If
+the C<PERL_YAML_BACKEND> environment variable is defined, then it is interpreted
+as a module to use for deserialization.  The given module must be installed,
+must load correctly and must implement the C<Load()> function or an exception
+will be thrown.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+David Golden <dagolden@cpan.org>
+
+=item *
+
+Ricardo Signes <rjbs@cpan.org>
+
+=item *
+
+Adam Kennedy <adamk@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut
diff --git a/cpan/CPAN-Meta/t/README-data.txt b/cpan/CPAN-Meta/t/README-data.txt
new file mode 100644 (file)
index 0000000..9c665e4
--- /dev/null
@@ -0,0 +1,15 @@
+There are three test data directories:
+
+- 'data-test': These files are valid META files that test *specific*
+  conversions and are expected to have specific data in them during
+  testing. Do not put new test data here unless you are sure it meets all
+  requirements needed to pass.
+
+- 'data-valid': These files are valid META files.  Some may be improved by
+  the Converter (particularly upconverting from ancient specs).
+
+- 'data-fixable': These files are bad META files that fail validation, but
+  can be fixed via the Converter.
+
+- 'data-fail': These files are bad META files that fail validation and
+  can't be fixed.
index 7cce934fa2ea3560258b2a9c0b6d8ff149adb41a..2c0742317b8c9d223f598e1f126d808a90841026 100644 (file)
@@ -7,9 +7,12 @@ use CPAN::Meta::Validator;
 use CPAN::Meta::Converter;
 use File::Spec;
 use IO::Dir;
-use Parse::CPAN::Meta 1.4400;
+use Parse::CPAN::Meta;
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 my @data_dirs = qw( t/data-valid t/data-fixable );
 my @files = sort map {
index dfda1ae46af7d181c281a3254437582786670314..1c1b1df5d67c597afea383ac45152f42e707f9fd 100644 (file)
@@ -7,9 +7,12 @@ use CPAN::Meta::Validator;
 use CPAN::Meta::Converter;
 use File::Spec;
 use IO::Dir;
-use Parse::CPAN::Meta 1.4400;
+use Parse::CPAN::Meta;
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 my $data_dir = IO::Dir->new( 't/data-fail' );
 my @files = sort grep { /^\w/ } $data_dir->read;
index a9b78def9eaf85be64aaf79bcd0aec1f9f2df9d0..8f8697d5f1bb522198991951358da7cb7c9356f7 100644 (file)
@@ -4,7 +4,10 @@ use Test::More 0.88;
 
 use CPAN::Meta::Converter;
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 my $spec2 = {
     version => '2',
index 87cdbd6985acea56ff75aff8c425b71378285689..9f01244b15afab7cefa456ae9946e85951a222db 100644 (file)
@@ -9,9 +9,12 @@ use CPAN::Meta::Converter;
 use File::Spec;
 use File::Basename qw/basename/;
 use IO::Dir;
-use Parse::CPAN::Meta 1.4400;
+use Parse::CPAN::Meta;
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 # mock file object
 package
diff --git a/cpan/CPAN-Meta/t/data-test/x_deprecated-META.json b/cpan/CPAN-Meta/t/data-test/x_deprecated-META.json
new file mode 100644 (file)
index 0000000..07a42e4
--- /dev/null
@@ -0,0 +1,148 @@
+{
+   "abstract" : "Author tests making sure correct line endings are used",
+   "author" : [
+      "Florian Ragwitz <rafl@debian.org>",
+      "Caleb Cushing <xenoterracide@gmail.com>",
+      "Karen Etheridge <ether@cpan.org>"
+   ],
+   "dynamic_config" : 0,
+   "generated_by" : "Dist::Zilla version 5.035, CPAN::Meta::Converter version 2.150002",
+   "keywords" : [
+      "plugin",
+      "test",
+      "testing",
+      "author",
+      "development",
+      "whitespace",
+      "newline",
+      "linefeed",
+      "formatting"
+   ],
+   "license" : [
+      "perl_5"
+   ],
+   "meta-spec" : {
+      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+      "version" : 2
+   },
+   "name" : "Dist-Zilla-Plugin-Test-EOL",
+   "no_index" : {
+      "directory" : [
+         "t",
+         "xt"
+      ]
+   },
+   "prereqs" : {
+      "configure" : {
+         "requires" : {
+            "Module::Build::Tiny" : "0.039",
+            "perl" : "5.006"
+         }
+      },
+      "develop" : {
+         "recommends" : {
+            "Dist::Zilla::PluginBundle::Author::ETHER" : "0.092"
+         },
+         "requires" : {
+            "Dist::Zilla" : "5"
+         }
+      },
+      "runtime" : {
+         "requires" : {
+            "Data::Section" : "0.004",
+            "Dist::Zilla::File::InMemory" : "0",
+            "Dist::Zilla::Role::FileFinderUser" : "0",
+            "Dist::Zilla::Role::FileGatherer" : "0",
+            "Dist::Zilla::Role::FileMunger" : "0",
+            "Dist::Zilla::Role::PrereqSource" : "0",
+            "Dist::Zilla::Role::TextTemplate" : "0",
+            "Moose" : "0",
+            "Moose::Util::TypeConstraints" : "0",
+            "Path::Tiny" : "0",
+            "Sub::Exporter::ForMethods" : "0",
+            "namespace::autoclean" : "0",
+            "perl" : "5.006",
+            "strict" : "0",
+            "warnings" : "0"
+         }
+      },
+      "build" : {
+         "requires" : {
+            "Build::Requires": "1.1",
+            "Test::More" : "0"
+         }
+      },
+      "test" : {
+         "recommends" : {
+            "CPAN::Meta" : "2.120900"
+         },
+         "requires" : {
+            "Test::More" : "0.88",
+            "Test::Requires" : "1.2"
+         }
+      }
+   },
+   "provides" : {
+      "Dist::Zilla::Plugin::EOLTests" : {
+         "file" : "lib/Dist/Zilla/Plugin/EOLTests.pm",
+         "version" : "0.18",
+         "x_deprecated" : 1
+      },
+      "Dist::Zilla::Plugin::Test::EOL" : {
+         "file" : "lib/Dist/Zilla/Plugin/Test/EOL.pm",
+         "version" : "0.18"
+      }
+   },
+   "release_status" : "stable",
+   "resources" : {
+      "bugtracker" : {
+         "mailto" : "bug-Dist-Zilla-Plugin-Test-EOL@rt.cpan.org",
+         "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Dist-Zilla-Plugin-Test-EOL"
+      },
+      "homepage" : "https://github.com/karenetheridge/Dist-Zilla-Plugin-Test-EOL",
+      "repository" : {
+         "type" : "git",
+         "url" : "https://github.com/karenetheridge/Dist-Zilla-Plugin-Test-EOL.git",
+         "web" : "https://github.com/karenetheridge/Dist-Zilla-Plugin-Test-EOL"
+      },
+      "x_IRC" : "irc://irc.perl.org/#distzilla",
+      "x_MailingList" : "http://dzil.org/#mailing-list"
+   },
+   "version" : "0.18",
+   "x_Dist_Zilla" : {
+      "perl" : {
+         "version" : "5.021010"
+      },
+      "plugins" : [
+         {
+            "class" : "Dist::Zilla::Plugin::Bootstrap::lib",
+            "config" : {
+               "Dist::Zilla::Role::Bootstrap" : {
+                  "try_built" : null
+               }
+            },
+            "name" : "Bootstrap::lib",
+            "version" : "1.001000"
+         },
+         {
+            "class" : "Dist::Zilla::Plugin::VerifyPhases",
+            "name" : "@Author::ETHER/PHASE VERIFICATION",
+            "version" : "0.010"
+         }
+      ],
+      "zilla" : {
+         "class" : "Dist::Zilla::Dist::Builder",
+         "config" : {
+            "is_trial" : ""
+         },
+         "version" : "5.035"
+      }
+   },
+   "x_authority" : "cpan:FLORA",
+   "x_authority_from_module" : "Dist::Zilla::Plugin::Test::EOL",
+   "x_contributors" : [
+      "Olivier Mengue <dolmen@cpan.org>",
+      "Shlomi Fish <shlomif@shlomifish.org>"
+   ],
+   "x_permissions_from_module" : "Dist::Zilla::Plugin::Test::EOL"
+}
diff --git a/cpan/CPAN-Meta/t/data-valid/META-1_4.yml b/cpan/CPAN-Meta/t/data-valid/META-1_4.yml
new file mode 100644 (file)
index 0000000..fa2dd8e
--- /dev/null
@@ -0,0 +1,49 @@
+---
+X_deep:
+  deep: structure
+abstract: 'Build and install Perl modules'
+author:
+  - 'Ken Williams <kwilliams@cpan.org>'
+  - 'Module-Build List <module-build@perl.org>'
+build_requires:
+  Test::More: '0'
+dynamic_config: 1
+generated_by: 'Module::Build version 0.36, CPAN::Meta::Converter version $VERSION'
+keywords:
+  - toolchain
+  - cpan
+  - dual-life
+license: perl
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: '1.4'
+name: Module-Build
+optional_features:
+  domination:
+    description: 'Take over the world'
+    requires:
+      Machine::Weather: '2.0'
+recommends:
+  Archive::Tar: '1.00'
+  ExtUtils::Install: '0.3'
+  ExtUtils::ParseXS: '2.02'
+  Pod::Text: '0'
+  YAML: '0.35'
+requires:
+  Config: '0'
+  Cwd: '0'
+  Data::Dumper: '0'
+  ExtUtils::Install: '0'
+  File::Basename: '0'
+  File::Compare: '0'
+  File::Copy: '0'
+  File::Find: '0'
+  File::Path: '0'
+  File::Spec: '0'
+  IO::File: '0'
+  perl: '5.006'
+resources:
+  license: http://dev.perl.org/licenses/
+version: '0.36'
+x_authority: cpan:FLORA
+x_serialization_backend: 'CPAN::Meta::YAML version 0.015'
diff --git a/cpan/CPAN-Meta/t/data-valid/META-2.json b/cpan/CPAN-Meta/t/data-valid/META-2.json
new file mode 100644 (file)
index 0000000..a2b6656
--- /dev/null
@@ -0,0 +1,82 @@
+{
+   "X_deep" : {
+      "deep" : "structure"
+   },
+   "abstract" : "Build and install Perl modules",
+   "author" : [
+      "Ken Williams <kwilliams@cpan.org>",
+      "Module-Build List <module-build@perl.org>"
+   ],
+   "description" : "Module::Build is a system for building, testing, and installing Perl modules.  It is meant to be an alternative to ExtUtils::MakeMaker... blah blah blah",
+   "dynamic_config" : 1,
+   "generated_by" : "Module::Build version 0.36",
+   "keywords" : [
+      "toolchain",
+      "cpan",
+      "dual-life"
+   ],
+   "license" : [
+      "perl_5"
+   ],
+   "meta-spec" : {
+      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+      "version" : "2"
+   },
+   "name" : "Module-Build",
+   "optional_features" : {
+      "domination" : {
+         "description" : "Take over the world",
+         "prereqs" : {
+            "develop" : {
+               "requires" : {
+                  "Genius::Evil" : "1.234"
+               }
+            },
+            "runtime" : {
+               "requires" : {
+                  "Machine::Weather" : "2.0"
+               }
+            }
+         }
+      }
+   },
+   "prereqs" : {
+      "build" : {
+         "requires" : {
+            "Test::More" : "0"
+         }
+      },
+      "runtime" : {
+         "recommends" : {
+            "Archive::Tar" : "1.00",
+            "ExtUtils::Install" : "0.3",
+            "ExtUtils::ParseXS" : "2.02",
+            "Pod::Text" : "0",
+            "YAML" : "0.35"
+         },
+         "requires" : {
+            "Config" : "0",
+            "Cwd" : "0",
+            "Data::Dumper" : "0",
+            "ExtUtils::Install" : "0",
+            "File::Basename" : "0",
+            "File::Compare" : "0",
+            "File::Copy" : "0",
+            "File::Find" : "0",
+            "File::Path" : "0",
+            "File::Spec" : "0",
+            "IO::File" : "0",
+            "perl" : "5.006"
+         }
+      }
+   },
+   "release_status" : "stable",
+   "resources" : {
+      "license" : [
+         "http://dev.perl.org/licenses/"
+      ]
+   },
+   "version" : "0.36",
+   "x_authority" : "cpan:FLORA",
+   "x_serialization_backend" : "JSON::PP version 2.27300"
+}
diff --git a/cpan/CPAN-Meta/t/data-valid/x_deprecated-META.yml b/cpan/CPAN-Meta/t/data-valid/x_deprecated-META.yml
new file mode 100644 (file)
index 0000000..ac05fde
--- /dev/null
@@ -0,0 +1,91 @@
+---
+abstract: 'Author tests making sure correct line endings are used'
+author:
+  - 'Florian Ragwitz <rafl@debian.org>'
+  - 'Caleb Cushing <xenoterracide@gmail.com>'
+  - 'Karen Etheridge <ether@cpan.org>'
+build_requires:
+  Build::Requires: '1.1'
+  Test::More: '0.88'
+  Test::Requires: '1.2'
+configure_requires:
+  Module::Build::Tiny: '0.039'
+  perl: '5.006'
+dynamic_config: 0
+generated_by: 'Dist::Zilla version 5.035, CPAN::Meta::Converter version 2.150002'
+keywords:
+  - plugin
+  - test
+  - testing
+  - author
+  - development
+  - whitespace
+  - newline
+  - linefeed
+  - formatting
+license: perl
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: '1.4'
+name: Dist-Zilla-Plugin-Test-EOL
+no_index:
+  directory:
+    - t
+    - xt
+provides:
+  Dist::Zilla::Plugin::EOLTests:
+    file: lib/Dist/Zilla/Plugin/EOLTests.pm
+    version: '0.18'
+    x_deprecated: 1
+  Dist::Zilla::Plugin::Test::EOL:
+    file: lib/Dist/Zilla/Plugin/Test/EOL.pm
+    version: '0.18'
+requires:
+  Data::Section: '0.004'
+  Dist::Zilla::File::InMemory: '0'
+  Dist::Zilla::Role::FileFinderUser: '0'
+  Dist::Zilla::Role::FileGatherer: '0'
+  Dist::Zilla::Role::FileMunger: '0'
+  Dist::Zilla::Role::PrereqSource: '0'
+  Dist::Zilla::Role::TextTemplate: '0'
+  Moose: '0'
+  Moose::Util::TypeConstraints: '0'
+  Path::Tiny: '0'
+  Sub::Exporter::ForMethods: '0'
+  namespace::autoclean: '0'
+  perl: '5.006'
+  strict: '0'
+  warnings: '0'
+resources:
+  IRC: irc://irc.perl.org/#distzilla
+  MailingList: http://dzil.org/#mailing-list
+  bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Dist-Zilla-Plugin-Test-EOL
+  homepage: https://github.com/karenetheridge/Dist-Zilla-Plugin-Test-EOL
+  repository: https://github.com/karenetheridge/Dist-Zilla-Plugin-Test-EOL.git
+version: '0.18'
+x_Dist_Zilla:
+  perl:
+    version: '5.021010'
+  plugins:
+    -
+      class: Dist::Zilla::Plugin::Bootstrap::lib
+      config:
+        Dist::Zilla::Role::Bootstrap:
+          try_built: ~
+      name: Bootstrap::lib
+      version: '1.001000'
+    -
+      class: Dist::Zilla::Plugin::VerifyPhases
+      name: '@Author::ETHER/PHASE VERIFICATION'
+      version: '0.010'
+  zilla:
+    class: Dist::Zilla::Dist::Builder
+    config:
+      is_trial: ''
+    version: '5.035'
+x_authority: cpan:FLORA
+x_authority_from_module: Dist::Zilla::Plugin::Test::EOL
+x_contributors:
+  - 'Olivier Mengue <dolmen@cpan.org>'
+  - 'Shlomi Fish <shlomif@shlomifish.org>'
+x_permissions_from_module: Dist::Zilla::Plugin::Test::EOL
diff --git a/cpan/CPAN-Meta/t/lib/Parse/CPAN/Meta/Test.pm b/cpan/CPAN-Meta/t/lib/Parse/CPAN/Meta/Test.pm
new file mode 100644 (file)
index 0000000..e63920b
--- /dev/null
@@ -0,0 +1,85 @@
+package Parse::CPAN::Meta::Test;
+
+use strict;
+use Test::More ();
+use Parse::CPAN::Meta;
+use File::Spec;
+
+use vars qw{@ISA @EXPORT};
+BEGIN {
+       require Exporter;
+       @ISA    = qw{ Exporter };
+       @EXPORT = qw{
+               tests  yaml_ok  yaml_error  slurp  load_ok
+               test_data_directory
+       };
+}
+
+sub test_data_directory {
+       return( "corpus" );
+}
+
+# 22 tests per call to yaml_ok
+# 4  tests per call to load_ok
+sub tests {
+       return ( tests => count(@_) );
+}
+
+sub count {
+       my $yaml_ok = shift || 0;
+       my $load_ok = shift || 0;
+       my $single  = shift || 0;
+       my $count   = $yaml_ok * 3 + $load_ok * 4 + $single;
+       return $count;
+}
+
+sub yaml_ok {
+       my $string  = shift;
+       my $array   = shift;
+       my $name    = shift || 'unnamed';
+
+       # Does the string parse to the structure
+       my $yaml_copy = $string;
+       my @yaml      = eval { Parse::CPAN::Meta::Load( $yaml_copy ); };
+       Test::More::is( $@, '', "$name: Parse::CPAN::Meta parses without error" );
+       Test::More::is( $yaml_copy, $string, "$name: Parse::CPAN::Meta does not modify the input string" );
+       SKIP: {
+               Test::More::skip( "Shortcutting after failure", 1 ) if $@;
+               Test::More::is_deeply( \@yaml, $array, "$name: Parse::CPAN::Meta parses correctly" );
+       }
+
+       # Return true as a convenience
+       return 1;
+}
+
+sub yaml_error {
+       my $string = shift;
+       my $yaml   = eval { Parse::CPAN::Meta::Load( $string ); };
+       Test::More::like( $@, qr/$_[0]/, "CPAN::Meta::YAML throws expected error" );
+}
+
+sub slurp {
+       my $file = shift;
+       my $layer = shift;
+       $layer = "" unless defined $layer;
+       local $/ = undef;
+       open my $fh, "<$layer", $file or die "open($file) failed: $!";
+       my $source = <$fh>;
+       close( $fh ) or die "close($file) failed: $!";
+       $source;
+}
+
+sub load_ok {
+       my $name = shift;
+       my $file = shift;
+       my $size = shift;
+       my $layer = shift;
+       Test::More::ok( -f $file, "Found $name" ) or Test::More::diag("Searched at '$file'");
+       Test::More::ok( -r $file, "Can read $name" );
+       my $content = slurp( $file, $layer );
+       Test::More::ok( (defined $content and ! ref $content), "Loaded $name" );
+       Test::More::ok( ($size < length $content), "Content of $name larger than $size bytes" );
+       return $content;
+}
+
+1;
index 7cae168807908878d72b07409ffe88cf6b13ac5b..f22ca3e870d8e8648a4b411d901a5b3f717d1478 100644 (file)
@@ -8,7 +8,10 @@ use IO::Dir;
 
 sub _slurp { do { local(@ARGV,$/)=shift(@_); <> } }
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 my $data_dir = IO::Dir->new( 't/data-fixable' );
 my @files = sort grep { /^\w/ } $data_dir->read;
index 39e8124550d085fc13a722d2bb9719eb7e6a0003..73e8c3eec96eabe14cbf6ff124011005d3de3121 100644 (file)
@@ -5,6 +5,11 @@ use Test::More;
 use CPAN::Meta;
 use CPAN::Meta::Merge;
 
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
+
 my %base = (
        abstract => 'This is a test',
        author => ['A.U. Thor'],
@@ -139,7 +144,7 @@ is_deeply($merger->merge(\%base, { abstract => 'This is a test' }), \%base, 'Can
 is(
     eval { $merger->merge(\%base, { abstract => 'And now for something else' }) },
     undef,
-    'Trying to merge different author gives an exception',
+    'Trying to merge different abstract gives an exception',
 );
 like $@, qr/^Can't merge attribute abstract/, 'Exception looks right';
 
@@ -164,6 +169,55 @@ is_deeply(
        'Trying to merge a new key for provides.$module is permitted; identical values are preserved',
 );
 
+my $extra_merger = CPAN::Meta::Merge->new(
+       default_version => '2',
+       extra_mappings => {
+               'x_toolkit' => 'set_addition',
+               'x_meta_meta' => {
+                       name => 'identical',
+                       tags => 'set_addition',
+               }
+       }
+);
+
+my $extra_results = $extra_merger->merge(\%base, {
+               x_toolkit => [ 'marble' ],
+               x_meta_meta => {
+                       name => 'Test',
+                       tags => [ 'Testing' ],
+               }
+       },
+       { x_toolkit => [ 'trike'],
+               x_meta_meta => {
+                       name => 'Test',
+                       tags => [ 'TDD' ],
+               }
+       }
+);
+
+my $expected_nested_extra = {
+       name => 'Test',
+       tags => [ 'Testing', 'TDD' ],
+};
+is_deeply($extra_results->{x_toolkit}, [ 'marble', 'trike' ], 'Extra mapping fields are merged');
+is_deeply($extra_results->{x_meta_meta}, $expected_nested_extra, 'Nested extra mapping fields are merged' );
+
+my $adds_to = sub {
+  my ($left, $right, $path) = @_;
+  if ($right !~ /^\Q$left\E/) {
+    die sprintf "Can't merge attribute %s: '%s' does not start with '%s'", join('.', @{$path}), $right, $left;
+  }
+  return $right;
+};
+
+$extra_merger = CPAN::Meta::Merge->new(default_version => '2', extra_mappings => { 'abstract' => \&$adds_to } );
+my $extra_results2 = $extra_merger->merge({ abstract => 'This is a test.'}, { abstract => 'This is a test.  Includes more detail..' } );
+is($extra_results2->{abstract}, 'This is a test.  Includes more detail..', 'Extra mapping fields overwrite existing mappings');
+my $extra_failure = eval { $extra_merger->merge({ abstract => 'This is a test.'}, { abstract => 'This is a better test.' } ) };
+is($extra_failure, undef, 'Extra mapping produces a failure');
+like $@, qr/does not start with/, 'Exception looks right';
+
+
 
 # issue 67
 @base{qw/name version release_status/} = qw/Foo-Bar 0.01 testing/;
index fa3c703a439af1a63a9fb053354a2eb6812db879..57b918541cd57e112627c1c8f04d6e5771d901a2 100644 (file)
@@ -3,10 +3,13 @@ use warnings;
 use Test::More 0.88;
 
 use CPAN::Meta;
-
+use Storable qw(dclone);
 use Scalar::Util qw(blessed);
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 my $distmeta = {
   name     => 'Module-Build',
@@ -74,7 +77,7 @@ my $distmeta = {
   X_deep => { deep => 'structure' },
 };
 
-my $meta = CPAN::Meta->new($distmeta);
+my $meta = CPAN::Meta->new(dclone $distmeta);
 
 is(
   blessed($meta->as_struct),
@@ -239,5 +242,40 @@ $chk_feature->($features[0]);
 
 $chk_feature->( $meta->feature('domination') );
 
+
+sub read_file {
+  my $filename = shift;
+  open my $fh, '<', $filename;
+  local $/;
+  my $string = <$fh>;
+  $string =~ s/\$VERSION/$CPAN::Meta::VERSION/g;
+  $string;
+}
+
+sub clean_backends {
+  my $string = shift;
+  $string =~ s{"?generated_by.*}{};
+  $string =~ s{"?x_serialization_backend.*}{};
+  return $string;
+}
+
+is(
+  clean_backends($meta->as_string()),
+  clean_backends(read_file('t/data-valid/META-2.json')),
+  'as_string with no arguments defaults to version 2 and JSON',
+);
+
+is(
+  clean_backends($meta->as_string({ version => 2 })),
+  clean_backends(read_file('t/data-valid/META-2.json')),
+  'as_string using version 2 defaults to JSON',
+);
+
+is(
+  clean_backends($meta->as_string({ version => 1.4 })),
+  clean_backends(read_file('t/data-valid/META-1_4.yml')),
+  'as_string using version 1.4 defaults to YAML',
+);
+
 done_testing;
 # vim: ts=2 sts=2 sw=2 et :
index 554e9214b08b98e13d08ba0b3ce32f94db893194..0927ad2254b7c90f860a9aa1b776c53acf2b342a 100644 (file)
@@ -4,7 +4,10 @@ use Test::More 0.88;
 
 use CPAN::Meta;
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 my %distmeta = (
   name     => 'Module-Billed',
index 76ea9640d5f5343f77de174bed3f73675018a986..7036cdc4efc15675156d0c08e9192a9c974f5328 100644 (file)
@@ -5,6 +5,11 @@ use Test::More;
 use CPAN::Meta;
 use CPAN::Meta::Merge;
 
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
+
 my %base = (
        abstract => 'This is a test',
        author => ['A.U. Thor'],
diff --git a/cpan/CPAN-Meta/t/parse-cpan-meta/02_api.t b/cpan/CPAN-Meta/t/parse-cpan-meta/02_api.t
new file mode 100644 (file)
index 0000000..c0ee52d
--- /dev/null
@@ -0,0 +1,220 @@
+#!/usr/bin/perl
+
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
+
+# Testing of a known-bad file from an editor
+
+use strict;
+BEGIN {
+       $|  = 1;
+       $^W = 1;
+}
+
+use lib 't/lib';
+use File::Spec::Functions ':ALL';
+use Parse::CPAN::Meta;
+use Parse::CPAN::Meta::Test;
+# use Test::More skip_all => 'Temporarily ignoring failing test';
+use Test::More 'no_plan';
+use utf8;
+
+#####################################################################
+# Testing that Perl::Smith config files work
+
+my $want = {
+  "abstract" => "a set of version requirements for a CPAN dist",
+  "author"   => [ 'Ricardo Signes <rjbs@cpan.org>' ],
+  "build_requires" => {
+     "Test::More" => "0.88"
+  },
+  "configure_requires" => {
+     "ExtUtils::MakeMaker" => "6.31"
+  },
+  "generated_by" => "Dist::Zilla version 2.100991",
+  "license" => "perl",
+  "meta-spec" => {
+     "url" => "http://module-build.sourceforge.net/META-spec-v1.4.html",
+     "version" => 1.4
+  },
+  "name" => "Version-Requirements",
+  "recommends" => {},
+  "requires" => {
+     "Carp" => "0",
+     "Scalar::Util" => "0",
+     "version" => "0.77"
+  },
+  "resources" => {
+     "repository" => "git://git.codesimply.com/Version-Requirements.git"
+  },
+  "version" => "0.101010",
+  "x_contributors" => [
+    "Dagfinn Ilmari Mannsåker <ilmari\@ilmari.org>",
+  ],
+};
+
+my $meta_json = catfile( test_data_directory(), 'META-VR.json' );
+my $meta_yaml = catfile( test_data_directory(), 'META-VR.yml' );
+my $bare_yaml_meta = catfile( test_data_directory(), 'bareyaml.meta' );
+my $bad_yaml_meta = catfile( test_data_directory(), 'BadMETA.yml' );
+my $CL018_yaml_meta = catfile( test_data_directory(), 'CL018_yaml.meta' );
+
+# These test YAML/JSON detection without the typical file name suffix
+my $yaml_meta = catfile( test_data_directory(), 'yaml.meta' );
+my $json_meta = catfile( test_data_directory(), 'json.meta' );
+
+### YAML tests
+{
+  local $ENV{PERL_YAML_BACKEND} if not $ENV{PERL_CORE}; # ensure we always get CPAN::META::YAML
+
+  is(Parse::CPAN::Meta->yaml_backend(), 'CPAN::Meta::YAML', 'yaml_backend(): CPAN::Meta::YAML');
+  my $from_yaml = Parse::CPAN::Meta->load_file( $meta_yaml );
+  is_deeply($from_yaml, $want, "load from YAML file results in expected data");
+}
+
+{
+  local $ENV{PERL_YAML_BACKEND} if not $ENV{PERL_CORE}; # ensure we always get CPAN::META::YAML
+
+  note '';
+  is(Parse::CPAN::Meta->yaml_backend(), 'CPAN::Meta::YAML', 'yaml_backend(): CPAN::Meta::YAML');
+  my $from_yaml = Parse::CPAN::Meta->load_file( $yaml_meta );
+  is_deeply($from_yaml, $want, "load from YAML .meta file results in expected data");
+}
+
+{
+  local $ENV{PERL_YAML_BACKEND} if not $ENV{PERL_CORE}; # ensure we always get CPAN::META::YAML
+
+  note '';
+  is(Parse::CPAN::Meta->yaml_backend(), 'CPAN::Meta::YAML', 'yaml_backend(): CPAN::Meta::YAML');
+  my $from_yaml = Parse::CPAN::Meta->load_file( $bare_yaml_meta );
+  is_deeply($from_yaml, $want, "load from bare YAML .meta file results in expected data");
+}
+
+{
+  local $ENV{PERL_YAML_BACKEND} if not $ENV{PERL_CORE}; # ensure we always get CPAN::META::YAML
+
+  note '';
+  is(Parse::CPAN::Meta->yaml_backend(), 'CPAN::Meta::YAML', 'yaml_backend(): CPAN::Meta::YAML');
+  my $from_yaml = Parse::CPAN::Meta->load_file( $CL018_yaml_meta );
+  like($from_yaml->{x_contributors}[5], qr/Olivier Mengu/, "Open question: what to expect from double encoded UTF-8");
+}
+
+{
+  local $ENV{PERL_YAML_BACKEND} if not $ENV{PERL_CORE}; # ensure we always get CPAN::META::YAML
+
+  note '';
+  is(Parse::CPAN::Meta->yaml_backend(), 'CPAN::Meta::YAML', 'yaml_backend(): CPAN::Meta::YAML');
+  my $yaml   = load_ok( $meta_yaml, $meta_yaml, 100, ":encoding(UTF-8)");
+  my $from_yaml = Parse::CPAN::Meta->load_yaml_string( $yaml );
+  is_deeply($from_yaml, $want, "load from YAML str results in expected data");
+}
+
+{
+  local $ENV{PERL_YAML_BACKEND} if not $ENV{PERL_CORE}; # ensure we always get CPAN::META::YAML
+
+  note '';
+  is(Parse::CPAN::Meta->yaml_backend(), 'CPAN::Meta::YAML', 'yaml_backend(): CPAN::Meta::YAML');
+  my @yaml   = Parse::CPAN::Meta::LoadFile( $bad_yaml_meta );
+  is($yaml[0]{author}[0], 'Olivier Mengu\xE9', "Bad UTF-8 is replaced");
+}
+
+
+SKIP: {
+  note '';
+  skip 'these tests are for cpan builds only', 2 if $ENV{PERL_CORE};
+  skip "YAML module not installed", 2
+    unless eval "require YAML; 1";
+  local $ENV{PERL_YAML_BACKEND} = 'YAML';
+
+  is(Parse::CPAN::Meta->yaml_backend(), 'YAML', 'yaml_backend(): YAML');
+  my $yaml   = load_ok( $meta_yaml, $meta_yaml, 100, ":encoding(UTF-8)");
+  my $from_yaml = Parse::CPAN::Meta->load_yaml_string( $yaml );
+  is_deeply($from_yaml, $want, "load_yaml_string using PERL_YAML_BACKEND");
+}
+
+### JSON tests
+{
+  # JSON tests with JSON::PP
+  local $ENV{PERL_JSON_BACKEND} if not $ENV{PERL_CORE}; # ensure we always get JSON::PP
+
+  note '';
+  is(Parse::CPAN::Meta->json_backend(), 'JSON::PP', 'json_backend(): JSON::PP');
+  my $from_json = Parse::CPAN::Meta->load_file( $meta_json );
+  is_deeply($from_json, $want, "load from JSON file results in expected data");
+}
+
+{
+  # JSON tests with JSON::PP
+  local $ENV{PERL_JSON_BACKEND} if not $ENV{PERL_CORE}; # ensure we always get JSON::PP
+
+  note '';
+  is(Parse::CPAN::Meta->json_backend(), 'JSON::PP', 'json_backend(): JSON::PP');
+  my $from_json = Parse::CPAN::Meta->load_file( $json_meta );
+  is_deeply($from_json, $want, "load from JSON .meta file results in expected data");
+}
+
+{
+  # JSON tests with JSON::PP
+  local $ENV{PERL_JSON_BACKEND} if not $ENV{PERL_CORE}; # ensure we always get JSON::PP
+
+  note '';
+  is(Parse::CPAN::Meta->json_backend(), 'JSON::PP', 'json_backend(): JSON::PP');
+  my $json   = load_ok( $meta_json, $meta_json, 100, "encoding(UTF-8)");
+  my $from_json = Parse::CPAN::Meta->load_json_string( $json );
+  is_deeply($from_json, $want, "load from JSON str results in expected data");
+}
+
+{
+  # JSON tests with JSON::PP, take 2
+  local $ENV{PERL_JSON_BACKEND} = 0 if not $ENV{PERL_CORE}; # request JSON::PP
+
+  note '';
+  is(Parse::CPAN::Meta->json_backend(), 'JSON::PP', 'json_backend(): JSON::PP');
+  my $json   = load_ok( $meta_json, $meta_json, 100, ":encoding(UTF-8)");
+  my $from_json = Parse::CPAN::Meta->load_json_string( $json );
+  is_deeply($from_json, $want, "load_json_string with PERL_JSON_BACKEND = 0");
+}
+
+{
+  # JSON tests with JSON::PP, take 3
+  local $ENV{PERL_JSON_BACKEND} = 'JSON::PP' if not $ENV{PERL_CORE}; # request JSON::PP
+
+  note '';
+  is(Parse::CPAN::Meta->json_backend(), 'JSON::PP', 'json_backend(): JSON::PP');
+  my $json   = load_ok( $meta_json, $meta_json, 100, ":encoding(UTF-8)");
+  my $from_json = Parse::CPAN::Meta->load_json_string( $json );
+  is_deeply($from_json, $want, "load_json_string with PERL_JSON_BACKEND = 'JSON::PP'");
+}
+
+SKIP: {
+  # JSON tests with fake backend
+
+  note '';
+  skip 'these tests are for cpan builds only', 2 if $ENV{PERL_CORE};
+
+  { package MyJSONThingy; $INC{'MyJSONThingy.pm'} = __FILE__; require JSON::PP;
+    sub decode_json { JSON::PP::decode_json(@_) } }
+
+  local $ENV{CPAN_META_JSON_DECODER} = 'MyJSONThingy'; # request fake backend
+
+  is(Parse::CPAN::Meta->json_decoder(), 'MyJSONThingy', 'json_decoder(): MyJSONThingy');
+  my $json   = load_ok( $meta_json, $meta_json, 100, ":encoding(UTF-8)");
+  my $from_json = Parse::CPAN::Meta->load_json_string( $json );
+  is_deeply($from_json, $want, "load_json_string with PERL_JSON_DECODER = 'MyJSONThingy'");
+}
+
+SKIP: {
+  note '';
+  skip 'these tests are for cpan builds only', 2 if $ENV{PERL_CORE};
+  skip "JSON module version 2.5 not installed", 2
+    unless eval "require JSON; JSON->VERSION(2.5); 1";
+  local $ENV{PERL_JSON_BACKEND} = 1;
+
+  is(Parse::CPAN::Meta->json_backend(), 'JSON', 'json_backend(): JSON');
+  my $json   = load_ok( $meta_json, $meta_json, 100, ":encoding(UTF-8)");
+  my $from_json = Parse::CPAN::Meta->load_json_string( $json );
+  is_deeply($from_json, $want, "load_json_string with PERL_JSON_BACKEND = 1");
+}
+
diff --git a/cpan/CPAN-Meta/t/parse-cpan-meta/03_functions.t b/cpan/CPAN-Meta/t/parse-cpan-meta/03_functions.t
new file mode 100644 (file)
index 0000000..5f6d1d8
--- /dev/null
@@ -0,0 +1,33 @@
+#!/usr/bin/perl
+
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+
+# Testing of basic document structures
+
+use strict;
+BEGIN {
+       $|  = 1;
+       $^W = 1;
+}
+
+use Test::More tests => 2;
+use Parse::CPAN::Meta ();
+
+my $one = <<'END_YAML';
+---
+- foo
+END_YAML
+
+my $two = <<'END_YAML';
+---
+- foo
+---
+- bar
+END_YAML
+
+my $one_scalar_tiny = Parse::CPAN::Meta::Load( $one );
+my $two_scalar_tiny = Parse::CPAN::Meta::Load( $two );
+
+is_deeply( $one_scalar_tiny, [ 'foo' ], 'one: Parsed correctly' );
+is_deeply( $two_scalar_tiny, [ 'bar' ], 'two: Parsed correctly' );
diff --git a/cpan/CPAN-Meta/t/parse-cpan-meta/04_export.t b/cpan/CPAN-Meta/t/parse-cpan-meta/04_export.t
new file mode 100644 (file)
index 0000000..b4766aa
--- /dev/null
@@ -0,0 +1,22 @@
+#!/usr/bin/perl
+
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+
+# Testing of basic document structures
+
+use strict;
+BEGIN {
+       $|  = 1;
+       $^W = 1;
+}
+
+use Test::More tests => 4;
+use Parse::CPAN::Meta;
+
+
+
+ok not(defined &main::Load), 'Load is not exported';
+ok not(defined &main::Dump), 'Dump is not exported';
+ok not(defined &main::LoadFile), 'LoadFile is not exported';
+ok not(defined &main::DumpFile), 'DumpFile is not exported';
diff --git a/cpan/CPAN-Meta/t/parse-cpan-meta/05_errors.t b/cpan/CPAN-Meta/t/parse-cpan-meta/05_errors.t
new file mode 100644 (file)
index 0000000..671d73b
--- /dev/null
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+
+# Testing of basic document structures
+
+use strict;
+BEGIN {
+       $|  = 1;
+       $^W = 1;
+}
+
+use Test::More tests => 1;
+use Parse::CPAN::Meta ();
+
+my $one = <<'END_YAML';
+---
+- foo: - bar
+END_YAML
+
+my $one_scalar_tiny = eval { Parse::CPAN::Meta->load_yaml_string( $one ) };
+like( $@, '/illegal characters/', "error causes exception");
+
index ac4aea837e5cfd8828f6920948f8bdf20cc0a013..8ace4942cb0f925afb2af562096c466d8010731a 100644 (file)
@@ -4,7 +4,10 @@ use Test::More 0.88;
 
 use CPAN::Meta::Prereqs;
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 sub dies_ok (&@) {
   my ($code, $qr, $comment) = @_;
index e15c9f2c2513d9f5fc78da1d9ebcf556c3fa0ee1..4e1baf2f9af32b6866a709c148139558b1dbac78 100644 (file)
@@ -4,7 +4,10 @@ use Test::More 0.88;
 
 use CPAN::Meta::Prereqs;
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 my $prereq_struct_1 = {
   runtime => {
@@ -22,7 +25,15 @@ my $prereq_struct_1 = {
     requires => {
       'Test' => 0,
     },
-  }
+    x_type => {
+      'Config' => 1,
+    },
+  },
+  x_phase => {
+    x_type => {
+      'POSIX' => '1.23',
+    },
+  },
 };
 
 my $prereq_1 = CPAN::Meta::Prereqs->new($prereq_struct_1);
@@ -50,7 +61,12 @@ my $prereq_struct_2 = {
     suggests => {
       'Module::Build::Bob' => '20100101',
     },
-  }
+  },
+  x_phase => {
+    requires => {
+      'JSON::PP' => '2.34',
+    },
+  },
 };
 
 my $prereq_2 = CPAN::Meta::Prereqs->new($prereq_struct_2);
@@ -88,6 +104,17 @@ my $want = {
     suggests => {
       'Module::Build::Bob' => '20100101',
     },
+    x_type => {
+      'Config' => 1,
+    },
+  },
+  x_phase => {
+    requires => {
+      'JSON::PP' => '2.34',
+    },
+    x_type => {
+      'POSIX' => '1.23',
+    },
   },
 };
 
index b4a3c957aecf04f6ae366d56a49a3ef8e36d2c8f..01ca00357c7527e6de03dc9c26041f466d81aa20 100644 (file)
@@ -4,7 +4,10 @@ use Test::More 0.88;
 
 use CPAN::Meta::Prereqs;
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 my $prereq_struct = {
   runtime => {
@@ -34,7 +37,18 @@ my $prereq_struct = {
     requires => {
       'Test' => 0,
     },
-  }
+    x_type => {
+      'Config' => 1,
+    },
+  },
+  x_phase => {
+    requires => {
+      'JSON::PP' => '2.34',
+    },
+    x_type => {
+      'POSIX' => '1.23',
+    },
+  },
 };
 
 my $prereq = CPAN::Meta::Prereqs->new($prereq_struct);
index 0cd2c249c0689bd240827fb419188d8029e8b94e..cf18affed845338783b90819c12f3992520f5844 100644 (file)
@@ -4,7 +4,10 @@ use Test::More 0.88;
 
 use CPAN::Meta;
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 # 1.4 repository upgrade
 {
index 8093344e3265a36d5e9106e2dd68f7865e0787ab..ef596f87ed023d55083a2fe789f32505168269b1 100644 (file)
@@ -4,9 +4,12 @@ use Test::More 0.88;
 
 use CPAN::Meta;
 use File::Temp 0.20 ();
-use Parse::CPAN::Meta 1.4400;
+use Parse::CPAN::Meta;
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 my $distmeta = {
   name     => 'Module-Build',
index 01450731724060db024512c1bca55388a934a776..99a00c3c138d9d0014e0def5dc03936a77fa6b74 100644 (file)
@@ -6,9 +6,12 @@ use CPAN::Meta;
 use CPAN::Meta::Validator;
 use File::Spec;
 use IO::Dir;
-use Parse::CPAN::Meta 1.4400;
+use Parse::CPAN::Meta;
 
-delete $ENV{$_} for qw/PERL_JSON_BACKEND PERL_YAML_BACKEND/; # use defaults
+delete $ENV{PERL_YAML_BACKEND};
+delete $ENV{PERL_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_BACKEND};
+delete $ENV{CPAN_META_JSON_DECODER};
 
 {
   my @data_dirs = qw( t/data-test t/data-valid );
index 59642ed86f60fcbc8c41ef5f200d52f52ea8bdfb..4856018c9c781f075ad9de0f3c62d19b0161ec55 100644 (file)
@@ -6,7 +6,7 @@ use vars qw($VERSION);
 
 use if $] < 5.008 => 'IO::Scalar';
 
-$VERSION = '1.64';
+$VERSION = '1.64_01';
 
 =head1 NAME
 
@@ -549,9 +549,20 @@ sub AUTOLOAD { 1 }
 sub DESTROY { 1 }
 }
 
+# load a module without searching the default entry for the current
+# directory
+sub _safe_load_module {
+  my $name = shift;
+
+  local @INC = @INC;
+  pop @INC if $INC[-1] eq '.';
+
+  eval "require $name; 1";
+}
+
 sub _init_logger
        {
-       my $log4perl_loaded = eval "require Log::Log4perl; 1";
+       my $log4perl_loaded = _safe_load_module("Log::Log4perl");
 
     unless( $log4perl_loaded )
         {
@@ -1020,7 +1031,7 @@ sub _load_local_lib # -I
        {
        $logger->debug( "Loading local::lib" );
 
-       my $rc = eval { require local::lib; 1; };
+       my $rc = _safe_load_module("local::lib");
        unless( $rc ) {
                $logger->die( "Could not load local::lib" );
                }
@@ -1160,7 +1171,7 @@ sub _get_file
        {
        my $path = shift;
 
-       my $loaded = eval "require LWP::Simple; 1;";
+       my $loaded = _safe_load_module("LWP::Simple");
        croak "You need LWP::Simple to use features that fetch files from CPAN\n"
                unless $loaded;
 
@@ -1182,7 +1193,7 @@ sub _gitify
        {
        my $args = shift;
 
-       my $loaded = eval "require Archive::Extract; 1;";
+       my $loaded = _safe_load_module("Archive::Extract");
        croak "You need Archive::Extract to use features that gitify distributions\n"
                unless $loaded;
 
@@ -1245,7 +1256,7 @@ sub _show_Changes
 sub _get_changes_file
        {
        croak "Reading Changes files requires LWP::Simple and URI\n"
-               unless eval "require LWP::Simple; require URI; 1";
+               unless _safe_load_module("LWP::Simple") && _safe_load_module("URI");
 
     my $url = shift;
 
index ab2d00f06ae87769382eb06f523d83ae174fad7f..49e335249c1679d420af1e7a54f7aaee37dd0f5a 100644 (file)
@@ -2,7 +2,7 @@
 # vim: ts=4 sts=4 sw=4:
 use strict;
 package CPAN;
-$CPAN::VERSION = '2.14';
+$CPAN::VERSION = '2.14_01';
 $CPAN::VERSION =~ s/_//;
 
 # we need to run chdir all over and we would get at wrong libraries
@@ -1118,6 +1118,8 @@ sub has_usable {
                                ]
               };
     if ($usable->{$mod}) {
+        local @INC = @INC;
+        pop @INC if $INC[-1] eq '.';
         for my $c (0..$#{$usable->{$mod}}) {
             my $code = $usable->{$mod}[$c];
             my $ret = eval { &$code() };
@@ -1160,6 +1162,8 @@ sub has_inst {
       $CPAN::META->{dontload_hash}{$mod}||=1; # unsafe meta access, ok
       return 0;
     }
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
     my $file = $mod;
     my $obj;
     $file =~ s|::|/|g;
index 55550902b1f9c1887d868c60e2fea1248f4280b7..cceab30e070f873248bfa31713b5f9591a2aaa3c 100644 (file)
@@ -1,5 +1,6 @@
 #!/usr/local/bin/perl
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use strict;
 use vars qw($VERSION);
 
index 3a45afa55c7e67fd9efa8abfa0bdcdb7c2b41d3b..c396f318545f172f99fc754d247275b8cbc1dfe6 100644 (file)
@@ -8,7 +8,7 @@ use warnings;
 use Config;
 use Exporter;
 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
-$VERSION     = "0.26";
+$VERSION     = "0.27";
 @ISA         = ("Exporter");
 @EXPORT_OK   = qw( plv2hash summary myconfig signature );
 %EXPORT_TAGS = (
@@ -54,6 +54,7 @@ my %BTD = map { $_ => 0 } qw(
     PERL_MEM_LOG_STDERR
     PERL_MEM_LOG_TIMESTAMP
     PERL_NEW_COPY_ON_WRITE
+    PERL_OP_PARENT
     PERL_PERTURB_KEYS_DETERMINISTIC
     PERL_PERTURB_KEYS_DISABLED
     PERL_PERTURB_KEYS_RANDOM
index 1a6a8df05161921b9ecb6056c590467a715f186c..445531b15ca194b2c2ff4f5a3e0dc13f4f2f8a8a 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 96;
+    my $tests = 97;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index d28981a402d2d1416ba323d296622d323a03db32..39f035233341e9e445cf404a3061390767722259 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 96;
+    my $tests = 97;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index dde2d240e68545843d59a817702076d7ab520e91..430410c0396b9502634e650625b50221fff420d4 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 95;
+    my $tests = 96;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index 4fe5e615da5316261265127d3f90e0917a905cc0..572fef074004306ce372f27f2bab53ae36973fd1 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 97;
+    my $tests = 98;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index 7c261864251586aa30cf39d83b4d9582012ba490..abaceb122517458c881ce5f72094889d52066efc 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 97;
+    my $tests = 98;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index 32638d0b67ba7a81f9156d6049a1f800155dbc48..f91279ac67e75c8d726442c8dddcce2e80e56909 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 96;
+    my $tests = 97;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index 6c19ae58c002003dc9ba440e3af31e5772ad9e49..2bab6643fbcaccfbb9a37cb5b8b07c326a142056 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 154;
+    my $tests = 155;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index dcecf1542fef1234c52e317542724cdd3ca0ada0..08f275b15c8c21df125a5173080c05671c9a7aa1 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 115;
+    my $tests = 116;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index cdb370edb7a07845a94f327f93658ba4a118e1ad..f25e42e97663656db92bcd9595092a1ee10f7180 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 115;
+    my $tests = 116;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index faee42bfe67022e0f4c658a00030c64e07bac798..8e8ce8ecb99f8a373f8039fc1b9988ee25ebc7a3 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 115;
+    my $tests = 116;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index 04c31964b0e4799de38453a8efe236d849e3ce1d..9faf121711bedb3ed6dc2ce132b4322b01e62a3d 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 116;
+    my $tests = 117;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index 9a1c2f8566c0b33229e8d0222d2af0661eff175f..e9a07c4e8ad4b2d20322abb57e9c58a16583c76b 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 116;
+    my $tests = 117;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index cec9d54c4d37b9fe9957b9a74f57aec9c9b92640..1043dfa0cee093c20221aea2cbde2a2e45b8b2ef 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 116;
+    my $tests = 117;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index 37118944a6936d13fabfbd288bbaa539b441e2f7..2c23e42362c4414a7d0c5da4d69e91af439df74f 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 116;
+    my $tests = 117;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index e10d2b06b43ee561f47d1b4e65773fbe7b086219..a730d240f03aed059d33b0506385002e772f15af 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 BEGIN {
     use Test::More;
-    my $tests = 116;
+    my $tests = 117;
     unless ($ENV{PERL_CORE}) {
        require Test::NoWarnings;
        Test::NoWarnings->import ();
index 3abca3d32c1e7ef2792cb5ffcaa49371c921a9b1..e2c58f66e19c45a0b104815493851534bd721214 100644 (file)
@@ -4,11 +4,11 @@ require 5.003000;
 
 use strict;
 use warnings;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-use Fcntl;
+use vars qw($VERSION @ISA @EXPORT_OK);
+use Fcntl qw(O_RDONLY);
 use integer;
 
-$VERSION = '5.95';
+$VERSION = '5.96';
 
 require Exporter;
 require DynaLoader;
@@ -813,7 +813,7 @@ darkness and moored it in so perfect a calm and in so brilliant a light"
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright (C) 2003-2015 Mark Shelor
+Copyright (C) 2003-2016 Mark Shelor
 
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
index 14ddd606af618aaa675195fec44216a8e554bb73..2721117151b10d68fc05c11f8a70e1f3e04f7d3d 100644 (file)
@@ -2,10 +2,10 @@
 
        ## shasum: filter for computing SHA digests (ref. sha1sum/md5sum)
        ##
-       ## Copyright (C) 2003-2015 Mark Shelor, All Rights Reserved
+       ## Copyright (C) 2003-2016 Mark Shelor, All Rights Reserved
        ##
-       ## Version: 5.95
-       ## Sat Jan 10 12:15:36 MST 2015
+       ## Version: 5.96
+       ## Wed Jul 27 20:04:34 MST 2016
 
        ## shasum SYNOPSIS adapted from GNU Coreutils sha1sum. Add
        ## "-a" option for algorithm selection,
@@ -13,6 +13,8 @@
        ## "-0" option for reading bit strings, and
        ## "-p" option for portable digests (to be deprecated).
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
+
 use strict;
 use warnings;
 use Fcntl;
@@ -90,7 +92,7 @@ the 7-bit message I<0001100>:
 
 =head1 AUTHOR
 
-Copyright (c) 2003-2015 Mark Shelor <mshelor@cpan.org>.
+Copyright (c) 2003-2016 Mark Shelor <mshelor@cpan.org>.
 
 =head1 SEE ALSO
 
@@ -101,7 +103,7 @@ L<Digest::SHA::PurePerl>.
 
 END_OF_POD
 
-my $VERSION = "5.95";
+my $VERSION = "5.96";
 
 sub usage {
        my($err, $msg) = @_;
index ea0d41ba0775cec5ca2460616b3d8407ff464371..fae9bb4f6e2c1ff87941d781455aacfd62e4a060 100644 (file)
@@ -3,10 +3,10 @@
  *
  * Ref: NIST FIPS PUB 180-4 Secure Hash Standard
  *
- * Copyright (C) 2003-2015 Mark Shelor, All Rights Reserved
+ * Copyright (C) 2003-2016 Mark Shelor, All Rights Reserved
  *
- * Version: 5.95
- * Sat Jan 10 12:15:36 MST 2015
+ * Version: 5.96
+ * Wed Jul 27 20:04:34 MST 2016
  *
  */
 
@@ -364,10 +364,10 @@ static ULNG shabits(UCHR *bitstr, ULNG bitcnt, SHA *s)
 
        for (i = 0UL; i < bitcnt; i++) {
                if (BITSET(bitstr, i))
-                       SETBIT(s->block, s->blockcnt), s->blockcnt++;
+                       SETBIT(s->block, s->blockcnt);
                else
-                       CLRBIT(s->block, s->blockcnt), s->blockcnt++;
-               if (s->blockcnt == s->blocksize)
+                       CLRBIT(s->block, s->blockcnt);
+               if (++s->blockcnt == s->blocksize)
                        s->sha(s, s->block), s->blockcnt = 0;
        }
        return(bitcnt);
index e63d4b743b3c0b80ec7ffdbf40011f78f3af907a..ca34741342efbf714a7b66ae29092009f9ba14b0 100644 (file)
@@ -3,10 +3,10 @@
  *
  * Ref: NIST FIPS PUB 180-4 Secure Hash Standard
  *
- * Copyright (C) 2003-2015 Mark Shelor, All Rights Reserved
+ * Copyright (C) 2003-2016 Mark Shelor, All Rights Reserved
  *
- * Version: 5.95
- * Sat Jan 10 12:15:36 MST 2015
+ * Version: 5.96
+ * Wed Jul 27 20:04:34 MST 2016
  *
  */
 
index 2fa0ddaf445e1a9a97cba430bfe9564787bc2f7c..860b52c0ef48997aaa2f5ce30a32be2609d86991 100644 (file)
@@ -3,10 +3,10 @@
  *
  * Ref: NIST FIPS PUB 180-4 Secure Hash Standard
  *
- * Copyright (C) 2003-2015 Mark Shelor, All Rights Reserved
+ * Copyright (C) 2003-2016 Mark Shelor, All Rights Reserved
  *
- * Version: 5.95
- * Sat Jan 10 12:15:36 MST 2015
+ * Version: 5.96
+ * Wed Jul 27 20:04:34 MST 2016
  *
  */
 
index ce89548cf38ab4782194a8d31203ced43def56e1..aef4426efe7f0448e4957505f8303b2e8e6419bd 100644 (file)
@@ -3,10 +3,10 @@
  *
  * Ref: NIST FIPS PUB 180-4 Secure Hash Standard
  *
- * Copyright (C) 2003-2015 Mark Shelor, All Rights Reserved
+ * Copyright (C) 2003-2016 Mark Shelor, All Rights Reserved
  *
- * Version: 5.95
- * Sat Jan 10 12:15:36 MST 2015
+ * Version: 5.96
+ * Wed Jul 27 20:04:34 MST 2016
  *
  * The following macros supply placeholder values that enable the
  * sha.c module to successfully compile when 64-bit integer types
index c3355a8bd44c0fe8fcc6a156542a81477ddc3610..16dae9d16e51219bb43f632bc6ed4a680a7e64cb 100644 (file)
@@ -3,7 +3,7 @@ package Digest;
 use strict;
 use vars qw($VERSION %MMAP $AUTOLOAD);
 
-$VERSION = "1.17";
+$VERSION = "1.17_01";
 
 %MMAP = (
   "SHA-1"      => [["Digest::SHA", 1], "Digest::SHA1", ["Digest::SHA2", 1]],
@@ -38,7 +38,11 @@ sub new
         unless (exists ${"$class\::"}{"VERSION"}) {
             my $pm_file = $class . ".pm";
             $pm_file =~ s{::}{/}g;
-            eval { require $pm_file };
+            eval {
+                local @INC = @INC;
+                pop @INC if $INC[-1] eq '.';
+                require $pm_file
+           };
             if ($@) {
                 $err ||= $@;
                 next;
index ff868a57943ffa48b5400ba443ae16e9013eb256..bda8e1b31638e35c5fe327e06c9df830d9d33325 100644 (file)
@@ -1,10 +1,10 @@
 #
-# $Id: Encode.pm,v 2.84 2016/04/11 07:16:52 dankogai Exp $
+# $Id: Encode.pm,v 2.86 2016/08/10 18:08:01 dankogai Exp $
 #
 package Encode;
 use strict;
 use warnings;
-our $VERSION = sprintf "%d.%02d", q$Revision: 2.84 $ =~ /(\d+)/g;
+our $VERSION = sprintf "%d.%02d", q$Revision: 2.86 $ =~ /(\d+)/g;
 use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
 use XSLoader ();
 XSLoader::load( __PACKAGE__, $VERSION );
@@ -56,6 +56,8 @@ require Encode::Config;
 eval {
     local $SIG{__DIE__};
     local $SIG{__WARN__};
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
     require Encode::ConfigLocal;
 };
 
@@ -218,8 +220,34 @@ sub from_to($$$;$) {
         require Carp;
         Carp::croak("Unknown encoding '$to'");
     }
-    my $uni = $f->decode($string);
-    $_[0] = $string = $t->encode( $uni, $check );
+
+    # For Unicode, warnings need to be caught and re-issued at this level
+    # so that callers can disable utf8 warnings lexically.
+    my $uni;
+    if ( ref($f) eq 'Encode::Unicode' ) {
+        my $warn = '';
+        {
+            local $SIG{__WARN__} = sub { $warn = shift };
+            $uni = $f->decode($string);
+        }
+        warnings::warnif('utf8', $warn) if length $warn;
+    }
+    else {
+        $uni = $f->decode($string);
+    }
+
+    if ( ref($t) eq 'Encode::Unicode' ) {
+        my $warn = '';
+        {
+            local $SIG{__WARN__} = sub { $warn = shift };
+            $_[0] = $string = $t->encode( $uni, $check );
+        }
+        warnings::warnif('utf8', $warn) if length $warn;
+    }
+    else {
+        $_[0] = $string = $t->encode( $uni, $check );
+    }
+
     return undef if ( $check && length($uni) );
     return defined( $_[0] ) ? length($string) : undef;
 }
@@ -468,6 +496,10 @@ I<ENCODING> and returns a sequence of octets.  I<ENCODING> can be either a
 canonical name or an alias.  For encoding names and aliases, see
 L</"Defining Aliases">.  For CHECK, see L</"Handling Malformed Data">.
 
+B<CAVEAT>: the input scalar I<STRING> might be modified in-place depending
+on what is set in CHECK. See L</LEAVE_SRC> if you want your inputs to be
+left unchanged.
+
 For example, to convert a string from Perl's internal format into
 ISO-8859-1, also known as Latin1:
 
@@ -492,6 +524,10 @@ I<ENCODING> can be either a canonical name or an alias. For encoding names
 and aliases, see L</"Defining Aliases">; for I<CHECK>, see L</"Handling
 Malformed Data">.
 
+B<CAVEAT>: the input scalar I<OCTETS> might be modified in-place depending
+on what is set in CHECK. See L</LEAVE_SRC> if you want your inputs to be
+left unchanged.
+
 For example, to convert ISO-8859-1 data into a string in Perl's
 internal format:
 
@@ -607,6 +643,10 @@ Because not all sequences of octets are valid UTF-8,
 it is quite possible for this function to fail.
 For CHECK, see L</"Handling Malformed Data">.
 
+B<CAVEAT>: the input I<$octets> might be modified in-place depending on
+what is set in CHECK. See L</LEAVE_SRC> if you want your inputs to be
+left unchanged.
+
 =head2 Listing available encodings
 
   use Encode;
index cd7f7d1050b96b10fa048d49fe21646c13ed1d42..222f39b2ea8df79f3839ee4a50473be6d7a224cb 100644 (file)
@@ -1,5 +1,5 @@
 /*
- $Id: Encode.xs,v 2.35 2016/01/22 06:33:07 dankogai Exp $
+ $Id: Encode.xs,v 2.37 2016/08/10 18:08:45 dankogai Exp dankogai $
  */
 
 #define PERL_NO_GET_CONTEXT
@@ -326,6 +326,8 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv,
     STRLEN ulen;
     SV *fallback_cb;
     int check;
+    U8 *d;
+    STRLEN dlen;
 
     if (SvROK(check_sv)) {
        /* croak("UTF-8 decoder doesn't support callback CHECK"); */
@@ -340,10 +342,12 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv,
     SvPOK_only(dst);
     SvCUR_set(dst,0);
 
+    dlen = (s && e && s < e) ? e-s+1 : 1;
+    d = (U8 *) SvGROW(dst, dlen);
+
     while (s < e) {
         if (UTF8_IS_INVARIANT(*s)) {
-            sv_catpvn(dst, (char *)s, 1);
-            s++;
+            *d++ = *s++;
             continue;
         }
 
@@ -383,7 +387,8 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv,
 
 
              /* Whole char is good */
-             sv_catpvn(dst,(char *)s,skip);
+             memcpy(d, s, skip);
+             d += skip;
              s += skip;
              continue;
         }
@@ -422,13 +427,25 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv,
            if (encode){
                SvUTF8_off(subchar); /* make sure no decoded string gets in */
            }
+            dlen += SvCUR(subchar) - ulen;
+            SvCUR_set(dst, d-(U8 *)SvPVX(dst));
+            *SvEND(dst) = '\0';
             sv_catsv(dst, subchar);
             SvREFCNT_dec(subchar);
+            d = (U8 *) SvGROW(dst, dlen) + SvCUR(dst);
         } else {
-            sv_catpv(dst, FBCHAR_UTF8);
+            STRLEN fbcharlen = strlen(FBCHAR_UTF8);
+            dlen += fbcharlen - ulen;
+            if (SvLEN(dst) < dlen) {
+                SvCUR_set(dst, d-(U8 *)SvPVX(dst));
+                d = (U8 *) sv_grow(dst, dlen) + SvCUR(dst);
+            }
+            memcpy(d, FBCHAR_UTF8, fbcharlen);
+            d += fbcharlen;
         }
         s += ulen;
     }
+    SvCUR_set(dst, d-(U8 *)SvPVX(dst));
     *SvEND(dst) = '\0';
 
     return s;
@@ -439,6 +456,10 @@ MODULE = Encode            PACKAGE = Encode::utf8  PREFIX = Method_
 
 PROTOTYPES: DISABLE
 
+#ifndef SvIsCOW
+# define SvIsCOW(sv) (SvREADONLY(sv) && SvFAKE(sv))
+#endif
+
 void
 Method_decode_xs(obj,src,check_sv = &PL_sv_no)
 SV *   obj
@@ -455,9 +476,16 @@ CODE:
 {
     dSP; ENTER; SAVETMPS;
     if (src == &PL_sv_undef || SvROK(src)) src = sv_2mortal(newSV(0));
+    check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvIV(check_sv);
+    if (!(check & ENCODE_LEAVE_SRC) && SvIsCOW(src)) {
+        /*
+         * disassociate from any other scalars before doing
+         * in-place modifications
+         */
+        sv_force_normal(src);
+    }
     s = (U8 *) SvPV(src, slen);
     e = (U8 *) SvEND(src);
-    check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvIV(check_sv);
     /* 
      * PerlIO check -- we assume the object is of PerlIO if renewed
      */
@@ -647,8 +675,14 @@ CODE:
     int check;
     SV *fallback_cb = &PL_sv_undef;
     encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
+    if (SvREADONLY(src) || SvSMAGICAL(src) || SvGMAGICAL(src) || !SvPOK(src)) {
+        SV *tmp;
+        tmp = sv_newmortal();
+        sv_copypv(tmp, src);
+        src = tmp;
+    }
     if (SvUTF8(src)) {
-       sv_utf8_downgrade(src, FALSE);
+        sv_utf8_downgrade(src, FALSE);
     }
     if (SvROK(check_sv)){
        fallback_cb = check_sv;
@@ -662,6 +696,17 @@ CODE:
     XSRETURN(1);
 }
 
+
+#ifndef SvPV_force_nolen
+#   define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
+#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, &PL_na, flags))
+#endif
+
 void
 Method_encode(obj,src,check_sv = &PL_sv_no)
 SV *   obj
@@ -672,6 +717,16 @@ CODE:
     int check;
     SV *fallback_cb = &PL_sv_undef;
     encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
+    if (SvREADONLY(src) || SvSMAGICAL(src) || SvGMAGICAL(src) || !SvPOK(src)) {
+        /*
+        SV *tmp;
+        tmp = sv_newmortal();
+        sv_copypv(tmp, src);
+        src = tmp;
+        */
+        src = sv_mortalcopy(src);
+        SvPV_force_nolen(src);
+    }
     sv_utf8_upgrade(src);
     if (SvROK(check_sv)){
        fallback_cb = check_sv;
@@ -863,10 +918,6 @@ CODE:
 OUTPUT:
     RETVAL
 
-#ifndef SvIsCOW
-# define SvIsCOW(sv) (SvREADONLY(sv) && SvFAKE(sv))
-#endif
-
 SV *
 _utf8_on(sv)
 SV *   sv
index e0372ca28327ae31b9bb37b677dd59446c41b1d5..c87153bbb320eb8c547a512905cfb6d737b484fa 100644 (file)
@@ -1,5 +1,5 @@
 #
-# $Id: Makefile.PL,v 2.16 2015/09/24 02:19:21 dankogai Exp $
+# $Id: Makefile.PL,v 2.17 2016/08/04 03:15:58 dankogai Exp $
 #
 use 5.007003;
 use strict;
@@ -51,6 +51,9 @@ WriteMakefile(
         Exporter   => '5.57',   # use Exporter 'import';
        parent     => '0.221',  # version bundled with 5.10.1
     },
+    TEST_REQUIRES => {
+        'Test::More' => '0.81_01',
+    },
     PMLIBDIRS   => \@pmlibdirs,
     INSTALLDIRS => ($] < 5.011 ? 'perl' : 'site'),
     META_MERGE        => {
index ec4732cc7c92e438785dc3ee114af0f9e61703ed..f2a228f68bd18b657532e3ada1650522fd934e49 100644 (file)
@@ -4,13 +4,14 @@ BEGIN {
     # with $ENV{PERL_CORE} set
     # In case we need it in future...
     require Config; import Config;
+    pop @INC if $INC[-1] eq '.';
 }
 use strict;
 use warnings;
 use Getopt::Std;
 use Config;
 my @orig_ARGV = @ARGV;
-our $VERSION  = do { my @r = (q$Revision: 2.18 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+our $VERSION  = do { my @r = (q$Revision: 2.19 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
 
 # These may get re-ordered.
 # RAW is a do_now as inserted by &enter
index 5d7ac80aac842184476ad173ff43ed49166970de..0f344ea3fc03d7a996bd485f3ce05dbc9c3176c6 100644 (file)
@@ -1,5 +1,6 @@
 #!./perl
 use 5.008001;
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use strict;
 use warnings;
 use Encode;
@@ -60,7 +61,7 @@ encguess - guess character encodings of files
 
 =head1 VERSION
 
-$Id: encguess,v 0.1 2015/02/05 10:34:19 dankogai Exp $
+$Id: encguess,v 0.2 2016/08/04 03:15:58 dankogai Exp $
 
 =head1 SYNOPSIS
 
index c1dad9ee04dd69cb59ac1cb0487ddf7948f5bc01..2218d16f396804153f0fc8cbed109114fd031cd4 100644 (file)
@@ -1,6 +1,7 @@
 #!./perl
-# $Id: piconv,v 2.7 2014/05/31 09:48:48 dankogai Exp $
+# $Id: piconv,v 2.8 2016/08/04 03:15:58 dankogai Exp $
 #
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use 5.8.0;
 use strict;
 use Encode ;
index 622376d885103b6026bb4ad9fc977e04a682db04..a240f2c75ec61bf3de129746aff9ddcfeb86ac6a 100644 (file)
@@ -1,10 +1,11 @@
 #!/usr/local/bin/perl
 #
-# $Id: ucmlint,v 2.2 2008/03/12 09:51:11 dankogai Exp $
+# $Id: ucmlint,v 2.3 2016/08/04 03:15:58 dankogai Exp $
 #
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use strict;
-our  $VERSION = do { my @r = (q$Revision: 2.2 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+our  $VERSION = do { my @r = (q$Revision: 2.3 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
 
 use Getopt::Std;
 our %Opt;
index ae0da30852b3d1702cbe45189768d0cd23425151..f19082744fae891e31b5e4829d64503dd5c0f8d9 100644 (file)
@@ -1,5 +1,6 @@
 #!./perl
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use strict;
 use Encode;
 use Getopt::Std;
index fffcaf78ef970473b481a15fc23d2402e242ec8c..754b3acb030a75b62e711a6931e5de5d847d9473 100644 (file)
@@ -1,6 +1,6 @@
-# $Id: encoding.pm,v 2.17 2015/09/15 13:53:27 dankogai Exp dankogai $
+# $Id: encoding.pm,v 2.18 2016/08/10 18:08:45 dankogai Exp dankogai $
 package encoding;
-our $VERSION = '2.17_01';
+our $VERSION = sprintf "%d.%02d", q$Revision: 2.18 $ =~ /(\d+)/g;
 
 use Encode;
 use strict;
@@ -160,10 +160,12 @@ sub import {
                 ${^E_NCODING} = $enc;
             }
         }
-        HAS_PERLIO or return 1;
+        if (! HAS_PERLIO ) {
+            return 1;
+        }
     }
     else {
-        warnings::warnif("deprecate",$deprecate) if $deprecate;
+        warnings::warnif("deprecated",$deprecate) if $deprecate;
 
         defined( ${^ENCODING} ) and undef ${^ENCODING};
         undef ${^E_NCODING} if PERL_5_21_7;
index d4902550b61538d25bb35a868c60740db73eda4f..d12b2fa2327e337b72287b9b8651528f133055fe 100644 (file)
@@ -14,7 +14,7 @@ BEGIN {
     }
 }
 use strict;
-use Test;
+use Test::More;
 use Encode qw(from_to encode decode
           encode_utf8 decode_utf8
           find_encoding is_utf8);
@@ -25,33 +25,34 @@ my @character_set = ('0'..'9', 'A'..'Z', 'a'..'z');
 my @source = qw(ascii iso8859-1 cp1250);
 my @destiny = qw(cp1047 cp37 posix-bc);
 my @ebcdic_sets = qw(cp1047 cp37 posix-bc);
-plan test => 38+$n*@encodings + 2*@source*@destiny*@character_set + 2*@ebcdic_sets*256 + 6 + 5;
+plan tests => 38+$n*@encodings + 2*@source*@destiny*@character_set + 2*@ebcdic_sets*256 + 6 + 5 + 2;
+
 my $str = join('',map(chr($_),0x20..0x7E));
 my $cpy = $str;
-ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong");
-ok($cpy,$str,"ASCII mangled by translating from iso8859-1 to Unicode");
+is length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong";
+is $cpy,$str,"ASCII mangled by translating from iso8859-1 to Unicode";
 $cpy = $str;
-ok(from_to($cpy,'Unicode','iso8859-1'),length($str),"Length wrong");
-ok($cpy,$str,"ASCII mangled by translating from Unicode to iso8859-1");
+is from_to($cpy,'Unicode','iso8859-1'),length($str),"Length wrong";
+is $cpy,$str,"ASCII mangled by translating from Unicode to iso8859-1";
 
 $str = join('',map(chr($_),0xa0..0xff));
 $cpy = $str;
-ok(length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong");
+is length($str),from_to($cpy,'iso8859-1','Unicode'),"Length Wrong";
 
 my $sym = Encode->getEncoding('symbol');
 my $uni = $sym->decode(encode(ascii => 'a'));
-ok("\N{alpha}",substr($uni,0,1),"alpha does not map to symbol 'a'");
+is "\N{alpha}",substr($uni,0,1),"alpha does not map to symbol 'a'";
 $str = $sym->encode("\N{Beta}");
-ok("B",decode(ascii => substr($str,0,1)),"Symbol 'B' does not map to Beta");
+is "B",decode(ascii => substr($str,0,1)),"Symbol 'B' does not map to Beta";
 
 foreach my $enc (qw(symbol dingbats ascii),@encodings)
  {
   my $tab = Encode->getEncoding($enc);
-  ok(1,defined($tab),"Could not load $enc");
+  is 1,defined($tab),"Could not load $enc";
   $str = join('',map(chr($_),0x20..0x7E));
   $uni = $tab->decode($str);
   $cpy = $tab->encode($uni);
-  ok($cpy,$str,"$enc mangled translating to Unicode and back");
+  is $cpy,$str,"$enc mangled translating to Unicode and back";
  }
 
 # On ASCII based machines see if we can map several codepoints from
@@ -78,8 +79,8 @@ foreach my $to (@destiny)
       my $native_chr = $chr;
       my $cpy = $chr;
       my $rc = from_to($cpy,$from,$to);
-      ok(1,$rc,"Could not translate from $from to $to");
-      ok(ord($cpy),shift(@expected),"mangled translating $native_chr from $from to $to");
+      is 1,$rc,"Could not translate from $from to $to";
+      is ord($cpy),shift(@expected),"mangled translating $native_chr from $from to $to";
      }
    }
  }
@@ -95,27 +96,27 @@ foreach my $enc_eb (@ebcdic_sets)
     $str = chr($ord);
     my $rc = from_to($str,$enc_as,$enc_eb);
     $rc += from_to($str,$enc_eb,$enc_as);
-    ok($rc,2,"return code for $ord $enc_eb -> $enc_as -> $enc_eb was not obtained");
-    ok($ord,ord($str),"$enc_as mangled translating $ord to $enc_eb and back");
+    is $rc,2,"return code for $ord $enc_eb -> $enc_as -> $enc_eb was not obtained";
+    is $ord,ord($str),"$enc_as mangled translating $ord to $enc_eb and back";
    }
  }
 
 my $mime = find_encoding('iso-8859-2');
-ok(defined($mime),1,"Cannot find MIME-ish'iso-8859-2'");
+is defined($mime),1,"Cannot find MIME-ish'iso-8859-2'";
 my $x11 = find_encoding('iso8859-2');
-ok(defined($x11),1,"Cannot find X11-ish 'iso8859-2'");
-ok($mime,$x11,"iso8598-2 and iso-8859-2 not same");
+is defined($x11),1,"Cannot find X11-ish 'iso8859-2'";
+is $mime,$x11,"iso8598-2 and iso-8859-2 not same";
 my $spc = find_encoding('iso 8859-2');
-ok(defined($spc),1,"Cannot find 'iso 8859-2'");
-ok($spc,$mime,"iso 8859-2 and iso-8859-2 not same");
+is defined($spc),1,"Cannot find 'iso 8859-2'";
+is $spc,$mime,"iso 8859-2 and iso-8859-2 not same";
 
 for my $i (256,128,129,256)
  {
   my $c = chr($i);
   my $s = "$c\n".sprintf("%02X",$i);
-  ok(utf8::valid($s),1,"concat of $i botched");
+  is utf8::valid($s),1,"concat of $i botched";
   utf8::upgrade($s);
-  ok(utf8::valid($s),1,"concat of $i botched");
+  is utf8::valid($s),1,"concat of $i botched";
  }
 
 # Spot check a few points in/out of utf8
@@ -123,9 +124,9 @@ for my $i (ord('A'),128,256,0x20AC)
  {
   my $c = chr($i);
   my $o = encode_utf8($c);
-  ok(decode_utf8($o),$c,"decode_utf8 not inverse of encode_utf8 for $i");
-  ok(encode('utf8',$c),$o,"utf8 encode by name broken for $i");
-  ok(decode('utf8',$o),$c,"utf8 decode by name broken for $i");
+  is decode_utf8($o),$c,"decode_utf8 not inverse of encode_utf8 for $i";
+  is encode('utf8',$c),$o,"utf8 encode by name broken for $i";
+  is decode('utf8',$o),$c,"utf8 decode by name broken for $i";
  }
 
 
@@ -158,9 +159,19 @@ ok(decode_utf8(*1), "*main::1");
 my $key = (keys %{{ "whatever\x{100}" => '' }})[0];
 my $kopy = $key;
 encode("UTF-16LE", $kopy, Encode::FB_CROAK);
-ok $key, "whatever\x{100}", 'encode with shared hash key scalars';
+is $key, "whatever\x{100}", 'encode with shared hash key scalars';
 undef $key;
 $key = (keys %{{ "whatever" => '' }})[0];
 $kopy = $key;
 decode("UTF-16LE", $kopy, Encode::FB_CROAK);
-ok $key, "whatever", 'decode with shared hash key scalars';
+is $key, "whatever", 'decode with shared hash key scalars';
+
+my $latin1 = find_encoding('latin1');
+my $orig = "\316";
+$orig =~ /(.)/;
+is $latin1->encode($1), $orig, '[cpan #115168] passing magic regex globals to encode';
+SKIP: {
+    skip "Perl Version ($]) is older than v5.16", 1 if $] < 5.016;
+    *a = $orig;
+    is $latin1->encode(*a), '*main::'.$orig, '[cpan #115168] passing typeglobs to encode';
+}
index 985e268fe2c7b996e1c3b110b5dd7c606c4c6607..9932e9d17030c07ba37434e4ceb4e6a8a2ea8f3d 100644 (file)
@@ -1,9 +1,9 @@
 #
-# $Id: cow.t,v 1.1 2013/08/29 16:47:39 dankogai Exp $
+# $Id: cow.t,v 1.2 2016/08/04 03:15:58 dankogai Exp $
 #
 use strict;
 use Encode ();
-use Test::More tests => 2;
+use Test::More tests => 4;
 
 
 my %a = ( "L\x{c3}\x{a9}on" => "acme" );
@@ -18,3 +18,10 @@ is $h{"L\x{e9}on"} => 'acme';
 # use Devel::Peek;
 # Dump(\%h);
 
+{ # invalid input to encode/decode/from_to should not affect COW-shared scalars
+       my $x = Encode::decode('UTF-8', "\303\244" x 4);
+       my $orig = "$x"; # non-COW copy
+       is($x, $orig, "copy of original string matches");
+       { my $y = $x; Encode::from_to($y, "UTF-8", "iso-8859-1"); }
+       is($x, $orig, "original scalar unmodified after from_to() call");
+}
index 77cdaba389de36b82e50cae82e746d57d897ac6b..6b24a8fa8c820bc242124da9fbefe30cfd6cefc9 100644 (file)
@@ -1,9 +1,9 @@
 #
-# $Id: decode.t,v 1.1 2013/08/29 16:47:39 dankogai Exp $
+# $Id: decode.t,v 1.2 2016/08/04 03:15:58 dankogai Exp $
 #
 use strict;
-use Encode qw(decode_utf8 FB_CROAK);
-use Test::More tests => 3;
+use Encode qw(decode_utf8 FB_CROAK find_encoding decode);
+use Test::More tests => 5;
 
 sub croak_ok(&) {
     my $code = shift;
@@ -23,3 +23,12 @@ croak_ok { Encode::decode('utf-8', $orig2, FB_CROAK) };
 chop(my $new = $bytes . $pad);
 croak_ok { Encode::decode_utf8($new, FB_CROAK) };
 
+my $latin1 = find_encoding('latin1');
+$orig = "\N{U+0080}";
+$orig =~ /(.)/;
+is($latin1->decode($1), $orig, '[cpan #115168] passing magic regex globals to decode');
+SKIP: {
+    skip "Perl Version ($]) is older than v5.16", 1 if $] < 5.016;
+    *a = $orig;
+    is($latin1->decode(*a), '*main::'.$orig, '[cpan #115168] passing typeglobs to decode');
+}
index b4015955bb2df7cbda17db1da13da7646701e273..99ea78d94ca52163f8e39415d284ad357151d519 100644 (file)
@@ -1,4 +1,4 @@
-# $Id: enc_data.t,v 2.2 2013/02/18 02:23:56 dankogai Exp $
+# $Id: enc_data.t,v 2.3 2016/08/10 18:08:45 dankogai Exp dankogai $
 
 BEGIN {
     require Config; import Config;
index 37fccba2673fb9f7dcae351ab1606c67427951b8..952a8ae7bcf8d2c64806a927a66ffd9bb9c8b0aa 100644 (file)
@@ -1,4 +1,4 @@
-# $Id: enc_eucjp.t,v 2.2 2013/02/18 02:23:56 dankogai Exp $
+# $Id: enc_eucjp.t,v 2.3 2016/08/10 18:08:45 dankogai Exp dankogai $
 # This is the twin of enc_utf8.t .
 
 BEGIN {
index 3004ed2bacc474173af90a68b840d1a8eda4fed8..8796a9b3433f190fd8ebd740631ef3271e979940 100644 (file)
@@ -1,4 +1,4 @@
-# $Id: enc_module.t,v 2.2 2013/02/18 02:23:56 dankogai Exp $
+# $Id: enc_module.t,v 2.3 2016/08/10 18:08:45 dankogai Exp dankogai $
 # This file is in euc-jp
 BEGIN {
     require Config; import Config;
index 047452fb33a06858b1d40356fc8174ce45473288..7ffaac0f3f03fe1a10295a47eb68512cc834845c 100644 (file)
@@ -1,4 +1,4 @@
-# $Id: enc_utf8.t,v 2.2 2013/02/18 02:23:56 dankogai Exp $
+# $Id: enc_utf8.t,v 2.3 2016/08/10 18:08:45 dankogai Exp dankogai $
 # This is the twin of enc_eucjp.t .
 
 BEGIN {
index 5f437fff103423a5d2ccb68a825ce1c98b9e365c..475d8bc0db6d14da16518ad3faecca6a364c857d 100644 (file)
@@ -1,5 +1,5 @@
 #
-# $Id: jperl.t,v 2.2 2013/02/18 02:23:56 dankogai Exp $
+# $Id: jperl.t,v 2.3 2016/08/10 18:08:45 dankogai Exp dankogai $
 #
 # This script is written in euc-jp
 
index a9e6086129ccb18f8bf8a9e99a1c5d04b65fb0a9..4477a4eb874bbb94da61c0120866ae2e06509680 100644 (file)
@@ -1,5 +1,5 @@
 #
-# $Id: mime-header.t,v 2.12 2016/04/11 07:17:02 dankogai Exp dankogai $
+# $Id: mime-header.t,v 2.12 2016/04/11 07:17:02 dankogai Exp $
 # This script is written in utf8
 #
 BEGIN {
index 9d93ecea54a409c12d1cdaa955a844129168d19c..0d1ac6dece2bd99ed6ad9a7ca285ade5ed6ec758 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
 }
 
 use Encode;
-use Test::More tests => 7;
+use Test::More tests => 10;
 
 my $valid   = "\x61\x00\x00\x00";
 my $invalid = "\x78\x56\x34\x12";
@@ -24,6 +24,8 @@ my $enc = find_encoding("UTF32-LE");
     is("@warnings", "", "Calling decode in Encode::Unicode on valid string produces no warnings");
 }
 
+
+
 {
     @warnings = ();
     my $ret = Encode::Unicode::decode( $enc, $invalid );
@@ -44,6 +46,8 @@ my $enc = find_encoding("UTF32-LE");
     is("@warnings", "", "Warning from decode in Encode::Unicode can be silenced via no warnings");
 }
 
+
+
 {
     @warnings = ();
     my $ret = Encode::decode( $enc, $invalid );
@@ -61,6 +65,30 @@ my $enc = find_encoding("UTF32-LE");
     no warnings;
     @warnings = ();
     my $ret = Encode::decode( $enc, $invalid );
-    is("@warnings", "", "Warning from decode in Encode can be silenced via no warnings 'utf8'");
+    is("@warnings", "", "Warning from decode in Encode can be silenced via no warnings");
+};
+
+
+
+{
+    @warnings = ();
+    my $inplace = $invalid;
+    Encode::from_to( $inplace, "UTF32-LE", "UTF-8" );
+    like("@warnings", qr/is not Unicode/, "Calling from_to in Encode on invalid string warns");
+}
+
+{
+    no warnings 'utf8';
+    @warnings = ();
+    my $inplace = $invalid;
+    Encode::from_to( $inplace, "UTF32-LE", "UTF-8" );
+    is("@warnings", "", "Warning from from_to in Encode can be silenced via no warnings 'utf8'");
 };
 
+{
+    no warnings;
+    @warnings = ();
+    my $inplace = $invalid;
+    Encode::from_to( $inplace, "UTF32-LE", "UTF-8" );
+    is("@warnings", "", "Warning from from_to in Encode can be silenced via no warnings");
+};
index 8b9aa95ae74dec01b80637304585c311901e82ec..ab0f9d1ffef7b81ed908a44171794202dc51269a 100644 (file)
@@ -1,5 +1,6 @@
 #!/usr/bin/perl -w
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use strict;
 use IO::File;
 use ExtUtils::Packlist;
index 98395d2a5fbca6e79320af74ab5414e53210e4ff..c9ff022f0336ddbe5a713690e19da20cf741f350 100644 (file)
@@ -7,7 +7,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 @ISA       = qw(Exporter);
 @EXPORT    = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod
                 dos2unix);
-$VERSION = '7.18';
+$VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 my $Is_VMS   = $^O eq 'VMS';
@@ -20,7 +20,10 @@ if( $Is_VMS ) {
     my $vms_efs;
     my $vms_case;
 
-    if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+    if (eval { local $SIG{__DIE__};
+               local @INC = @INC;
+               pop @INC if $INC[-1] eq '.';
+               require VMS::Feature; }) {
         $vms_unix_rpt = VMS::Feature::current("filename_unix_report");
         $vms_efs = VMS::Feature::current("efs_charset");
         $vms_case = VMS::Feature::current("efs_case_preserve");
index d9fbb5d7a8b7bb078dfbb8a5981ef57953d21d10..69779b2912e44d4dd148dd711f9ae6d414ac7173 100644 (file)
@@ -10,7 +10,7 @@ our @ISA = qw(Exporter);
 
 our @EXPORT  = qw(test_harness pod2man perllocal_install uninstall
                   warn_if_old_packlist test_s cp_nonempty);
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 my $Is_VMS = $^O eq 'VMS';
index 56fc3553b700af6b8314c554d8d706de6901c7e9..7b2ca535ce77bd2d91469e7d26017b8b2570c531 100644 (file)
@@ -2,7 +2,7 @@ package ExtUtils::Liblist;
 
 use strict;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 use File::Spec;
index 23708e2b3c08e69ef66aa0f0a051077db756fcbc..a7fae86276dec1f47cbbf1a48ac41e4b5cf431e4 100644 (file)
@@ -11,7 +11,7 @@ use 5.006;
 
 use strict;
 use warnings;
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 use ExtUtils::MakeMaker::Config;
index 0b2835caacc9595c76a0d51d8c5a64268b5f9ca7..b32793238813bc752bd63ddc201446594d8265f9 100644 (file)
@@ -3,7 +3,7 @@ package ExtUtils::MM;
 use strict;
 use ExtUtils::MakeMaker::Config;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 require ExtUtils::Liblist;
index 0db269b8ec597a07db587aea578171f21c9fc5a4..ea646606fc44203df1e1428ca379dc99a65e6770 100644 (file)
@@ -1,7 +1,7 @@
 package ExtUtils::MM_AIX;
 
 use strict;
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 require ExtUtils::MM_Unix;
index 7320aee6e71563815d87309d6e9b8153203c434b..433a8dd7a31db7b63255c4977498e1f9b92efac5 100644 (file)
@@ -1,7 +1,7 @@
 package ExtUtils::MM_Any;
 
 use strict;
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 use Carp;
index 1a910d949c901a3a08b3dae887f8c9a70e952ddc..9ede7971464250834ccad85f2a23e1116dd45922 100644 (file)
@@ -26,7 +26,7 @@ require ExtUtils::MM_Any;
 require ExtUtils::MM_Unix;
 
 our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 
index e8e9d3dc6acbf0f129647069be7fb8a2595f59e5..e180a44530e3d55db2c5bd9581e75fa1f6921e33 100644 (file)
@@ -9,7 +9,7 @@ require ExtUtils::MM_Unix;
 require ExtUtils::MM_Win32;
 our @ISA = qw( ExtUtils::MM_Unix );
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 
@@ -87,7 +87,7 @@ sub init_linker {
     if ($Config{useshrplib} eq 'true') {
         my $libperl = '$(PERL_INC)' .'/'. "$Config{libperl}";
         if( $] >= 5.006002 ) {
-            $libperl =~ s/a$/dll.a/;
+            $libperl =~ s/(dll\.)?a$/dll.a/;
         }
         $self->{PERL_ARCHIVE} = $libperl;
     } else {
index 6bbd02e8f252fc79b2e181b21288d4706d3c39a5..a453278b2fd7ae1399533230099f696ee70f1c18 100644 (file)
@@ -2,7 +2,7 @@ package ExtUtils::MM_DOS;
 
 use strict;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 require ExtUtils::MM_Any;
index a6490db34444bc943c113c9989bc8748ffac53b5..03dfe27376c3d27f755868510035de929e569b46 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     our @ISA = qw( ExtUtils::MM_Unix );
 }
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 
index 5cee011ab9db14139a4a896e11932500c44364e3..8207502f71a6e4483795acb8795d0bfd9ffe06f0 100644 (file)
@@ -2,7 +2,7 @@ package ExtUtils::MM_MacOS;
 
 use strict;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 sub new {
index 48b0b46e35e5585c934a82bd654ecdd6d23f9187..6ec9b7cb8ff47f2a9a5054c81cfdbf8f6f64ad33 100644 (file)
@@ -22,7 +22,7 @@ use strict;
 use ExtUtils::MakeMaker::Config;
 use File::Basename;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 require ExtUtils::MM_Win32;
index 4dc8bcce6eeaeed602484ed2bf91c2db70c03eef..f23ec5a2a6cde02b26048fab11c6a10d6c77aa75 100644 (file)
@@ -5,7 +5,7 @@ use strict;
 use ExtUtils::MakeMaker qw(neatvalue);
 use File::Spec;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 require ExtUtils::MM_Any;
index 9a604a1f282c2cea7315b7c0740a1bc26980c7ac..6475983eb86627366b7558bda58faa9932d34d5f 100644 (file)
@@ -1,7 +1,7 @@
 package ExtUtils::MM_QNX;
 
 use strict;
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 require ExtUtils::MM_Unix;
index 38c1042129dd57d2b3aff731fbe1f080b257ec81..e7e65ef2adeac6654a4b34c7f37bbb3d50ec99ba 100644 (file)
@@ -1,7 +1,7 @@
 package ExtUtils::MM_UWIN;
 
 use strict;
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 require ExtUtils::MM_Unix;
index fe0ff54633899c5f3d8d3cf4bfcb4bd3250f3437..66a24d7838ba781a8b65d270c337be47f99f0a2e 100644 (file)
@@ -14,7 +14,7 @@ use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562);
 
 # If we make $VERSION an our variable parse_version() breaks
 use vars qw($VERSION);
-$VERSION = '7.18';
+$VERSION = '7.24';
 $VERSION = eval $VERSION;  ## no critic [BuiltinFunctions::ProhibitStringyEval]
 
 require ExtUtils::MM_Any;
@@ -1043,7 +1043,7 @@ sub xs_make_dynamic_lib {
         $ld_run_path_shell = 'LD_RUN_PATH="$(LD_RUN_PATH)" ';
     }
 
-    push @m, sprintf <<'MAKE', $ld_run_path_shell, $ldrun, $self->xs_obj_opt('$@'), $ldfrom, $libs, $exportlist;
+    push @m, sprintf <<'MAKE', $ld_run_path_shell, $ldrun, $ldfrom, $self->xs_obj_opt('$@'), $libs, $exportlist;
        %s$(LD) %s $(LDDLFLAGS) %s $(OTHERLDFLAGS) %s $(MYEXTLIB) \
          $(PERL_ARCHIVE) %s $(PERL_ARCHIVE_AFTER) %s \
          $(INST_DYNAMIC_FIX)
@@ -2065,7 +2065,7 @@ sub init_PERL {
 
     # Make sure perl can find itself before it's installed.
     my $lib_paths = $self->{UNINSTALLED_PERL} || $self->{PERL_CORE}
-        ? $self->{PERL_ARCHLIB} ne $self->{PERL_LIB} ?
+        ? ( $self->{PERL_ARCHLIB} && $self->{PERL_LIB} && $self->{PERL_ARCHLIB} ne $self->{PERL_LIB} ) ?
             q{ "-I$(PERL_LIB)" "-I$(PERL_ARCHLIB)"} : q{ "-I$(PERL_LIB)"}
         : undef;
     my $inst_lib_paths = $self->{INST_ARCHLIB} ne $self->{INST_LIB}
@@ -2658,7 +2658,7 @@ $(INST_ARCHAUTODIR)/extralibs.all : $(INST_ARCHAUTODIR)$(DFSEP).exists '.join("
 
     my $ldfrom = $self->{XSMULTI} ? '' : '$(LDFROM)';
     #                             1     2                        3        4
-    push @m, _sprintf562 <<'EOF', $tmp, $self->xs_obj_opt('$@'), $ldfrom, $makefilename;
+    push @m, _sprintf562 <<'EOF', $tmp, $ldfrom, $self->xs_obj_opt('$@'), $makefilename;
 $(MAP_TARGET) :: %1$s/perlmain$(OBJ_EXT) $(MAP_LIBPERLDEP) $(MAP_STATICDEP) $(INST_ARCHAUTODIR)/extralibs.all
        $(MAP_LINKCMD) %2$s $(OPTIMIZE) %1$s/perlmain$(OBJ_EXT) %3$s $(MAP_STATIC) "$(LLIBPERL)" `cat $(INST_ARCHAUTODIR)/extralibs.all` $(MAP_PRELIBS)
        $(NOECHO) $(ECHO) "To install the new '$(MAP_TARGET)' binary, call"
index 8565dc2af438de7262b083f9d04c6f78ffd5e200..ed3ec8cab0880b61426917fef6408d36a976154c 100644 (file)
@@ -15,7 +15,7 @@ BEGIN {
 
 use File::Basename;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 require ExtUtils::MM_Any;
index dde190219cf2bd0be6b4c83b3d1894f949ee601c..c176118d4d3ef845824482879df45926befe4e36 100644 (file)
@@ -1,7 +1,7 @@
 package ExtUtils::MM_VOS;
 
 use strict;
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 require ExtUtils::MM_Unix;
index d8efc66ad9461b3ebe7b88636ac4518bd5e996fe..9844d837b7b54c8e99699d38647605fa25343df0 100644 (file)
@@ -27,7 +27,7 @@ use ExtUtils::MakeMaker qw(neatvalue _sprintf562);
 require ExtUtils::MM_Any;
 require ExtUtils::MM_Unix;
 our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 $ENV{EMXSHELL} = 'sh'; # to run `commands`
index f9a4f9da2037c02206a93a83538d33a1e6f27178..0d6f0e31bfcec8cb3971cfc94aa03070a5437fe7 100644 (file)
@@ -2,7 +2,7 @@ package ExtUtils::MM_Win95;
 
 use strict;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 require ExtUtils::MM_Win32;
index be4c708809cfb388e55e0ea8dbceee59d956c85d..779c791297c2521b44218967ef16968f7cf639d0 100644 (file)
@@ -3,7 +3,7 @@ package ExtUtils::MY;
 use strict;
 require ExtUtils::MM;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 our @ISA = qw(ExtUtils::MM);
 
index e8404102dbd148166b8c727f15b11f2c2fb75162..d579256e86e5c01016f42e8bc2a0cbcded04466e 100644 (file)
@@ -12,7 +12,7 @@ use Carp;
 use File::Path;
 my $CAN_DECODE = eval { require ExtUtils::MakeMaker::Locale; }; # 2 birds, 1 stone
 eval { ExtUtils::MakeMaker::Locale::reinit('UTF-8') }
-  if $CAN_DECODE and $ExtUtils::MakeMaker::Locale::ENCODING_LOCALE eq 'US-ASCII';
+  if $CAN_DECODE and Encode::find_encoding('locale')->name eq 'ascii';
 
 our $Verbose = 0;       # exported
 our @Parent;            # needs to be localized
@@ -24,7 +24,7 @@ my %Recognized_Att_Keys;
 our %macro_fsentity; # whether a macro is a filesystem name
 our %macro_dep; # whether a macro is a dependency
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;  ## no critic [BuiltinFunctions::ProhibitStringyEval]
 
 # Emulate something resembling CVS $Revision$
@@ -1466,6 +1466,23 @@ MakeMaker also checks for any files matching glob("t/*.t"). It will
 execute all matching files in alphabetical order via the
 L<Test::Harness> module with the C<-I> switches set correctly.
 
+You can also organize your tests within subdirectories in the F<t/> directory.
+To do so, use the F<test> directive in your I<Makefile.PL>. For example, if you
+had tests in:
+
+    t/foo
+    t/foo/bar
+
+You could tell make to run tests in both of those directories with the
+following directives:
+
+    test => {TESTS => 't/*/*.t t/*/*/*.t'}
+    test => {TESTS => 't/foo/*.t t/foo/bar/*.t'}
+
+The first will run all test files in all first-level subdirectories and all
+subdirectories they contain. The second will run tests in only the F<t/foo>
+and F<t/foo/bar>.
+
 If you'd like to see the raw output of your tests, set the
 C<TEST_VERBOSE> variable to true.
 
index 7259f34fd1dcfb22de90b85fbde65b624ae72802..bce9c66dee6e7ea1b05fac463e7775c4d2a58f17 100644 (file)
@@ -2,7 +2,7 @@ package ExtUtils::MakeMaker::Config;
 
 use strict;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 use Config ();
index 6f59192ab01a50123edeb119213cd2fac1b3d6b9..179c9d6f30a9122472da7f046e3e9c1bcc32ada2 100644 (file)
@@ -1,6 +1,6 @@
 package ExtUtils::MakeMaker::FAQ;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 1;
@@ -120,6 +120,29 @@ have multiple modules to work with.  It also ensures that the module
 goes through its full installation process which may modify it.
 Again, L<local::lib> may assist you here.
 
+=item How can I organize tests into subdirectories and have them run?
+
+Let's take the following test directory structure:
+
+    t/foo/sometest.t
+    t/bar/othertest.t
+    t/bar/baz/anothertest.t
+
+Now, inside of the C<WriteMakeFile()> function in your F<Makefile.PL>, specify
+where your tests are located with the C<test> directive:
+
+    test => {TESTS => 't/*.t t/*/*.t t/*/*/*.t'}
+
+The first entry in the string will run all tests in the top-level F<t/> 
+directory. The second will run all test files located in any subdirectory under
+F<t/>. The third, runs all test files within any subdirectory within any other
+subdirectory located under F<t/>.
+
+Note that you do not have to use wildcards. You can specify explicitly which
+subdirectories to run tests in:
+
+    test => {TESTS => 't/*.t t/foo/*.t t/bar/baz/*.t'}
+
 =item PREFIX vs INSTALL_BASE from Module::Build::Cookbook
 
 The behavior of PREFIX is complicated and depends closely on how your
index 21f59749853dad89d50f437a450ab6ff3ec7de10..bec2cc15a4811238f34794f3a2e890c11c376958 100644 (file)
@@ -1,7 +1,7 @@
 package ExtUtils::MakeMaker::Locale;
 
 use strict;
-our $VERSION = "7.18";
+our $VERSION = "7.24";
 $VERSION = eval $VERSION;
 
 use base 'Exporter';
@@ -28,11 +28,8 @@ sub _init {
            eval {
                unless (defined &GetConsoleCP) {
                    require Win32;
-                    # no point falling back to Win32::GetConsoleCP from this
-                    # as added same time, 0.45
-                    eval { Win32::GetConsoleCP() };
                     # manually "import" it since Win32->import refuses
-                   *GetConsoleCP = sub { &Win32::GetConsoleCP } unless $@;
+                   *GetConsoleCP = sub { &Win32::GetConsoleCP } if defined &Win32::GetConsoleCP;
                }
                unless (defined &GetConsoleCP) {
                    require Win32::API;
@@ -52,18 +49,17 @@ sub _init {
                     require Win32;
                     eval { Win32::GetConsoleCP() };
                     # manually "import" it since Win32->import refuses
-                    *GetInputCP = sub { &Win32::GetConsoleCP } unless $@;
-                    *GetOutputCP = sub { &Win32::GetConsoleOutputCP } unless $@;
+                    *GetInputCP = sub { &Win32::GetConsoleCP } if defined &Win32::GetConsoleCP;
+                    *GetOutputCP = sub { &Win32::GetConsoleOutputCP } if defined &Win32::GetConsoleOutputCP;
                 };
                 unless (defined &GetInputCP) {
                     eval {
                         # try Win32::Console module for codepage to use
                         require Win32::Console;
-                        eval { Win32::Console::InputCP() };
                         *GetInputCP = sub { &Win32::Console::InputCP }
-                            unless $@;
+                            if defined &Win32::Console::InputCP;
                         *GetOutputCP = sub { &Win32::Console::OutputCP }
-                            unless $@;
+                            if defined &Win32::Console::OutputCP;
                     };
                 }
                 unless (defined &GetInputCP) {
index 976345f356bd8b192aaea853137e8e89b336dc46..76c08d1bed9979fa504cbec344acbf8366f2195e 100644 (file)
@@ -1,6 +1,6 @@
 package ExtUtils::MakeMaker::Tutorial;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 
@@ -104,8 +104,39 @@ is F<lib/Foo/Bar.pm>.
 =item t/
 
 Tests for your modules go here.  Each test filename ends with a .t.
-So F<t/foo.t>/  'make test' will run these tests.  The directory is flat,
-you cannot, for example, have t/foo/bar.t run by 'make test'.
+So F<t/foo.t>  'make test' will run these tests.
+
+Typically, the F<t/> test directory is flat, with all test files located
+directly within it. However, you can nest tests within subdirectories, for
+example:
+
+    t/foo/subdir_test.t
+
+To do this, you need to inform C<WriteMakeFile()> in your I<Makefile.PL> file
+in the following fashion:
+
+    test => {TESTS => 't/*.t t/*/*.t'}
+
+That will run all tests in F<t/>, as well as all tests in all subdirectories
+that reside under F<t/>. You can nest as deeply as makes sense for your project. 
+Simply add another entry in the test location string. For example, to test:
+
+    t/foo/bar/subdir_test.t
+
+You would use the following C<test> directive:
+
+    test => {TESTS => 't/*.t t/*/*/*.t}
+
+Note that in the above example, tests in the first subdirectory will not be
+run. To run all tests in the intermediary subdirectory preceeding the one
+the test files are in, you need to explicitly note it:
+
+    test => {TESTS => 't/*.t t/*/*.t t/*/*/*.t'}
+
+You don't need to specify wildcards if you only want to test within specific
+subdirectories. The following example will only run tests in F<t/foo>:
+
+    test => {TESTS => 't/foo/*.t'}
 
 Tests are run from the top level of your distribution.  So inside a test
 you would refer to ./lib to enter the lib directory, for example.
index a6584c7eb8033664c0c3946907742771fcc5e635..bcfaaa342c52ac12fd1f03b176a420872abb4840 100644 (file)
@@ -15,7 +15,7 @@ use strict;
 
 use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv);
 
-$VERSION = '7.18';
+$VERSION = '7.24';
 $VERSION = eval $VERSION;
 $CLASS = 'version';
 
index 896998e91a224ad01633529876c839252e9c8f59..025590956135406edb4b643c82c7576b16017a9d 100644 (file)
@@ -10,7 +10,7 @@ use strict;
 
 use vars qw($VERSION $CLASS $STRICT $LAX);
 
-$VERSION = '7.18';
+$VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 #--------------------------------------------------------------------------#
index 2a0d463641d4866ce587e2a3137c07410a8fe7b9..5eea8bc67e4ccc9117541718a1024f10bca6823b 100644 (file)
@@ -3,7 +3,7 @@ package ExtUtils::Mkbootstrap;
 # There's just too much Dynaloader incest here to turn on strict vars.
 use strict 'refs';
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 require Exporter;
index 582b290046206abe05802e9b80b5f482e2e49ce0..0cfb22ac28f423cb1467d710703e8e9b6c893490 100644 (file)
@@ -10,7 +10,7 @@ use Config;
 
 our @ISA = qw(Exporter);
 our @EXPORT = qw(&Mksymlists);
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 sub Mksymlists {
index 3f2795b1131511840bc913bdd9381e86dfbfbd9b..0e774664ffa84afa93d010b828ad984f2b19ecf5 100644 (file)
@@ -3,7 +3,7 @@ package ExtUtils::testlib;
 use strict;
 use warnings;
 
-our $VERSION = '7.18';
+our $VERSION = '7.24';
 $VERSION = eval $VERSION;
 
 use Cwd;
index 6bff1bfd0fe55afce2955ad6f5597635317b9671..8c8f801d0ebd83a9e1bdec9c0ec566cfcf20cea3 100644 (file)
@@ -52,6 +52,7 @@ END
 );
 
 # avoid environment variables interfering with our make runs
+delete @ENV{qw(PERL_JSON_BACKEND CPAN_META_JSON_BACKEND PERL_YAML_BACKEND)} if $ENV{PERL_CORE};
 delete @ENV{qw(LIB MAKEFLAGS PERL_CORE)};
 
 my $perl     = which_perl();
index 027393ccca61ef8baa13c76799f407efe6418bc7..f1b0f1ebebacef7dbd2203d3f6c660e2f085922b 100644 (file)
@@ -52,6 +52,7 @@ END
 );
 
 # avoid environment variables interfering with our make runs
+delete @ENV{qw(PERL_JSON_BACKEND CPAN_META_JSON_BACKEND PERL_YAML_BACKEND)} if $ENV{PERL_CORE};
 delete @ENV{qw(LIB MAKEFLAGS PERL_CORE)};
 
 my $perl     = which_perl();
index 7d6a263e2bffb0a353ac7204db01f68cef1ea3ff..acfa442841af7493afec1f3c888600050c0399b7 100644 (file)
@@ -22,7 +22,7 @@ use vars    qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT
                 $FTP_PASSIVE $TIMEOUT $DEBUG $WARN $FORCEIPV4
             ];
 
-$VERSION        = '0.48';
+$VERSION        = '0.52';
 $VERSION        = eval $VERSION;    # avoid warnings with development releases
 $PREFER_BIN     = 0;                # XXX TODO implement
 $FROM_EMAIL     = 'File-Fetch@example.com';
@@ -39,6 +39,7 @@ $FORCEIPV4      = 0;
 ### methods available to fetch the file depending on the scheme
 $METHODS = {
     http    => [ qw|lwp httptiny wget curl lftp fetch httplite lynx iosock| ],
+    https   => [ qw|lwp wget curl| ],
     ftp     => [ qw|lwp netftp wget curl lftp fetch ncftp ftp| ],
     file    => [ qw|lwp lftp file| ],
     rsync   => [ qw|rsync| ],
@@ -51,6 +52,9 @@ local $Params::Check::VERBOSE               = 1;
 local $Module::Load::Conditional::VERBOSE   = 0;
 local $Module::Load::Conditional::VERBOSE   = 0;
 
+### Fix CVE-2016-1238 ###
+local $Module::Load::Conditional::FORCE_SAFE_INC = 1;
+
 ### see what OS we are on, important for file:// uris ###
 use constant ON_WIN     => ($^O eq 'MSWin32');
 use constant ON_VMS     => ($^O eq 'VMS');
@@ -164,6 +168,7 @@ http://www.abc.net.au/ the contents retrieved may be from a remote file called
         path            => { default => '/' },
         file            => { required => 1 },
         uri             => { required => 1 },
+        userinfo        => { default => '' },
         vol             => { default => '' }, # windows for file:// uris
         share           => { default => '' }, # windows for file:// uris
         file_default    => { default => 'file_default' },
@@ -401,7 +406,7 @@ sub _parse_uri {
     } else {
         ### using anything but qw() in hash slices may produce warnings
         ### in older perls :-(
-        @{$href}{ qw(host path) } = $uri =~ m|([^/]*)(/.*)$|s;
+        @{$href}{ qw(userinfo host path) } = $uri =~ m|(?:([^\@:]*:[^\:\@]*)@)?([^/]*)(/.*)$|s;
     }
 
     ### split the path into file + dir ###
@@ -567,6 +572,10 @@ sub _lwp_fetch {
 
     };
 
+    if ($self->scheme eq 'https') {
+        $use_list->{'LWP::Protocol::https'} = '0';
+    }
+
     unless( can_load( modules => $use_list ) ) {
         $METHOD_FAIL->{'lwp'} = 1;
         return;
@@ -580,7 +589,12 @@ sub _lwp_fetch {
     ### special rules apply for file:// uris ###
     $uri->scheme( $self->scheme );
     $uri->host( $self->scheme eq 'file' ? '' : $self->host );
-    $uri->userinfo("anonymous:$FROM_EMAIL") if $self->scheme ne 'file';
+
+    if ($self->userinfo) {
+        $uri->userinfo($self->userinfo);
+    } elsif ($self->scheme ne 'file') {
+        $uri->userinfo("anonymous:$FROM_EMAIL");
+    }
 
     ### set up the useragent object
     my $ua = LWP::UserAgent->new();
@@ -655,7 +669,7 @@ sub _httplite_fetch {
     ### modules required to download with lwp ###
     my $use_list = {
         'HTTP::Lite'    => '2.2',
-
+        'MIME::Base64'  => '0',
     };
 
     unless( can_load(modules => $use_list) ) {
@@ -673,6 +687,11 @@ sub _httplite_fetch {
       $http->{timeout} = $TIMEOUT if $TIMEOUT;
       $http->http11_mode(1);
 
+      if ($self->userinfo) {
+          my $encoded = MIME::Base64::encode($self->userinfo, '');
+          $http->add_req_header("Authorization", "Basic $encoded");
+      }
+
       my $fh = FileHandle->new;
 
       unless ( $fh->open($to,'>') ) {
@@ -1502,7 +1521,7 @@ Below is a mapping of what utilities will be used in what order
 for what schemes, if available:
 
     file    => LWP, lftp, file
-    http    => LWP, HTTP::Lite, wget, curl, lftp, fetch, lynx, iosock
+    http    => LWP, HTTP::Tiny, wget, curl, lftp, fetch, HTTP::Lite, lynx, iosock
     ftp     => LWP, Net::FTP, wget, curl, lftp, fetch, ncftp, ftp
     rsync   => rsync
     git     => git
index b4443e658b03fc51ede58bd9e3dfe3198e32b0a0..379ada9ebeff19e2d23ba762e7909d08929070b4 100644 (file)
@@ -65,10 +65,10 @@ my @map = (
         path   => '/CPAN/',
         file   => 'MIRRORING.FROM',
     },
-    {  uri         => 'git://github.com/jib/file-fetch.git',
+    {  uri         => 'git://github.com/Perl-Toolchain-Gang/file-fetch.git',
         scheme => 'git',
         host   => 'github.com',
-        path   => '/jib/',
+        path   => '/Perl-Toolchain-Gang/',
         file   => 'file-fetch.git',
     },
     {   uri     => 'http://localhost/tmp/index.txt',
@@ -176,13 +176,13 @@ for my $entry (@map) {
 ### Heuristics
 {
   require IO::Socket::INET;
-  my $sock = IO::Socket::INET->new( PeerAddr => 'ftp.funet.fi', PeerPort => 21, Timeout => 20 )
+  my $sock = IO::Socket::INET->new( PeerAddr => 'mirror.bytemark.co.uk', PeerPort => 21, Timeout => 20 )
      or $heuristics{ftp} = 0;
 }
 
 ### ftp:// tests ###
-{   my $uri = 'ftp://ftp.funet.fi/pub/CPAN/index.html';
-    for (qw[lwp netftp wget curl lftp fetch ncftp]) {
+{   my $uri = 'ftp://mirror.bytemark.co.uk/CPAN/index.html';
+    for (qw[wget curl lftp fetch ncftp]) {
 
         ### STUPID STUPID warnings ###
         next if $_ eq 'ncftp' and $File::Fetch::FTP_PASSIVE
@@ -203,6 +203,7 @@ for my $entry (@map) {
 {   for my $uri ( 'http://www.cpan.org/index.html',
                   'http://www.cpan.org/index.html?q=1',
                   'http://www.cpan.org/index.html?q=1&y=2',
+                  #'http://user:passwd@httpbin.org/basic-auth/user/passwd',
     ) {
         for (qw[lwp httptiny wget curl lftp fetch lynx httplite iosock]) {
             _fetch_uri( http => $uri, $_ );
@@ -233,9 +234,12 @@ for my $entry (@map) {
 }
 
 ### git:// tests ###
-{   my $uri = 'git://github.com/jib/file-fetch.git';
+{   my $uri = 'git://github.com/Perl-Toolchain-Gang/file-fetch.git';
 
     for (qw[git]) {
+        local $ENV{GIT_CONFIG_NOSYSTEM} = 1;
+        local $ENV{XDG_CONFIG_HOME};
+        local $ENV{HOME};
         _fetch_uri( git => $uri, $_ );
     }
 }
index 42653e0ecb4bdc058533c53237d27e95c181abad..de07e2abce266ba1900b68685e7238d46fc28fd1 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use warnings;
 # ABSTRACT: A small, simple, correct HTTP/1.1 client
 
-our $VERSION = '0.058';
+our $VERSION = '0.064';
 
 use Carp ();
 
@@ -110,7 +110,7 @@ sub new {
 
     my $self = {
         max_redirect => 5,
-        timeout      => 60,
+        timeout      => defined $args{timeout} ? $args{timeout} : 60,
         keep_alive   => 1,
         verify_SSL   => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
         no_proxy     => $ENV{no_proxy},
@@ -282,6 +282,15 @@ sub mirror {
     my ($self, $url, $file, $args) = @_;
     @_ == 3 || (@_ == 4 && ref $args eq 'HASH')
       or Carp::croak(q/Usage: $http->mirror(URL, FILE, [HASHREF])/ . "\n");
+
+    if ( exists $args->{headers} ) {
+        my $headers = {};
+        while ( my ($key, $value) = each %{$args->{headers} || {}} ) {
+            $headers->{lc $key} = $value;
+        }
+        $args->{headers} = $headers;
+    }
+
     if ( -e $file and my $mtime = (stat($file))[9] ) {
         $args->{headers}{'if-modified-since'} ||= $self->_http_date($mtime);
     }
@@ -504,6 +513,8 @@ sub can_ssl {
     my($ok, $reason) = (1, '');
 
     # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
     unless (eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)}) {
         $ok = 0;
         $reason .= qq/IO::Socket::SSL 1.42 must be installed for https support\n/;
@@ -1451,8 +1462,12 @@ sub write_chunked_body {
         $self->write($chunk);
     }
     $self->write("0\x0D\x0A");
-    $self->write_header_lines($request->{trailer_cb}->())
-        if ref $request->{trailer_cb} eq 'CODE';
+    if ( ref $request->{trailer_cb} eq 'CODE' ) {
+        $self->write_header_lines($request->{trailer_cb}->())
+    }
+    else {
+        $self->write("\x0D\x0A");
+    }
     return $len;
 }
 
@@ -1568,6 +1583,8 @@ sub _find_CA_file {
         return $ca_file;
     }
 
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
     return Mozilla::CA::SSL_ca_file()
         if eval { require Mozilla::CA; 1 };
 
@@ -1639,7 +1656,7 @@ HTTP::Tiny - A small, simple, correct HTTP/1.1 client
 
 =head1 VERSION
 
-version 0.058
+version 0.064
 
 =head1 SYNOPSIS
 
@@ -2262,7 +2279,7 @@ David Golden <dagolden@cpan.org>
 
 =head1 CONTRIBUTORS
 
-=for stopwords Alan Gardner Alessandro Ghedini A. Sinan Unur Brad Gilbert brian m. carlson Chris Nehren Weyl Claes Jakobsson Clinton Gormley David Golden Dean Pearce Edward Zborowski James Raspass Jeremy Mates Jess Robinson Lukas Eklund Martin J. Evans Martin-Louis Bright Mike Doherty Olaf Alders Olivier Mengué Petr Písař SkyMarshal Sören Kornetzki Syohei YOSHIDA Tatsuhiko Miyagawa Tom Hukins Tony Cook
+=for stopwords Alan Gardner Alessandro Ghedini A. Sinan Unur Brad Gilbert brian m. carlson Chris Nehren Weyl Claes Jakobsson Clinton Gormley David Golden Dean Pearce Edward Zborowski James Raspass Jeremy Mates Jess Robinson Karen Etheridge Lukas Eklund Martin J. Evans Martin-Louis Bright Mike Doherty Olaf Alders Olivier Mengué Petr Písař SkyMarshal Sören Kornetzki Steve Grazzini Syohei YOSHIDA Tatsuhiko Miyagawa Tom Hukins Tony Cook
 
 =over 4
 
@@ -2328,6 +2345,10 @@ Jess Robinson <castaway@desert-island.me.uk>
 
 =item *
 
+Karen Etheridge <ether@cpan.org>
+
+=item *
+
 Lukas Eklund <leklund@gmail.com>
 
 =item *
@@ -2364,6 +2385,10 @@ Sören Kornetzki <soeren.kornetzki@delti.com>
 
 =item *
 
+Steve Grazzini <steve.grazzini@grantstreet.com>
+
+=item *
+
 Syohei YOSHIDA <syohex@gmail.com>
 
 =item *
index 9e51b5d4edf59926c7a2f92ce14adedeb71942c2..ac3c8b93e449cff0edc497e6165f2bcd072c1929 100644 (file)
@@ -4,7 +4,8 @@ use strict;
 use warnings;
 
 use Test::More;
-use t::Util qw[tmpfile monkey_patch set_socket_source];
+use lib 't';
+use Util qw[tmpfile monkey_patch set_socket_source];
 
 use HTTP::Tiny;
 
diff --git a/cpan/HTTP-Tiny/t/004_timeout.t b/cpan/HTTP-Tiny/t/004_timeout.t
new file mode 100644 (file)
index 0000000..95f9bd4
--- /dev/null
@@ -0,0 +1,38 @@
+#!perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+use HTTP::Tiny;
+
+# Just make sure timeout is handled correctly as a constructor param,
+# and that it works as expected as an "attribute".
+
+my $default = 60;
+
+{
+    my $ua = HTTP::Tiny->new();
+    is $ua->timeout, $default, 'default timeout is as expected';
+}
+
+{
+    my $ua = HTTP::Tiny->new(timeout => 10);
+    is $ua->timeout, 10, 'timeout is handled as a constructor param';
+}
+
+{
+    my $ua = HTTP::Tiny->new(timeout => 0);
+    is $ua->timeout, 0, 'constructor arg of timeout=0 is passed through';
+}
+
+{
+    my $ua = HTTP::Tiny->new(timeout => undef);
+    is $ua->timeout, $default, 'constructor arg of timeout=undef is ignored';
+}
+
+{
+    my $ua = HTTP::Tiny->new();
+    $ua->timeout(15);
+    is $ua->timeout, 15, 'timeout works as expected as a r/w attribute';
+}
index c10e075a68687b18d75aa8d4719febf003c06ac9..a4254e5709fdd0320c024f9b9f42b1768b16794e 100644 (file)
@@ -4,7 +4,8 @@ use strict;
 use warnings;
 
 use Test::More qw[no_plan];
-use t::Util    qw[tmpfile rewind $CRLF $LF];
+use lib 't';
+use Util    qw[tmpfile rewind $CRLF $LF];
 use HTTP::Tiny;
 
 {
index fc72a3afc04d7db3e5803980ec694d31e7d2484c..e519a620704fadd6b38f40192fefea7cfcee43bd 100644 (file)
@@ -4,7 +4,8 @@ use strict;
 use warnings;
 
 use Test::More qw[no_plan];
-use t::Util    qw[tmpfile rewind $CRLF $LF];
+use lib 't';
+use Util    qw[tmpfile rewind $CRLF $LF];
 use HTTP::Tiny;
 
 sub _header {
index 64e432e9e1f14907f358d316adf0c420bbe6a931..b7406de39fd759a24fea9305d9f064f7ee90d47b 100644 (file)
@@ -4,7 +4,8 @@ use strict;
 use warnings;
 
 use Test::More qw[no_plan];
-use t::Util    qw[tmpfile rewind $CRLF $LF];
+use lib 't';
+use Util    qw[tmpfile rewind $CRLF $LF];
 use HTTP::Tiny;
 
 {
index b555b00a727d7b85472941468f0c494cc7413c5c..7aff9e07e4314cefe4186e6593fdb2df242367ae 100644 (file)
@@ -4,7 +4,8 @@ use strict;
 use warnings;
 
 use Test::More qw[no_plan];
-use t::Util    qw[tmpfile rewind $CRLF];
+use lib 't';
+use Util    qw[tmpfile rewind $CRLF];
 use HTTP::Tiny;
 
 {
@@ -14,16 +15,29 @@ use HTTP::Tiny;
 }
 
 {
-    my $body    = join($CRLF, map { sprintf('%x', length $_) . $CRLF . $_ } 'A'..'Z', '') . $CRLF;
-    my $fh      = tmpfile($body);
+    my $fh      = tmpfile();
     my $handle  = HTTP::Tiny::Handle->new(fh => $fh);
-    my $exp     = ['A'..'Z'];
-    my $got     = [];
-    my $cb      = sub { push @$got, $_[0] };
-    my $response = { headers => {} };
-    $handle->read_chunked_body($cb, $response);
-    is_deeply($response->{headers}, {}, 'chunked trailers');
-    is_deeply($got, $exp, "chunked chunks");
+
+    my $exp      = ['A'..'Z'];
+    my $got      = [];
+
+    {
+        my @chunks = @$exp;
+        my $request = {
+          cb => sub { shift @chunks },
+        };
+        $handle->write_chunked_body($request);
+    }
+
+    rewind($fh);
+
+    {
+        my $cb = sub { push @$got, $_[0] };
+        my $response = { headers => {} };
+        $handle->read_chunked_body($cb, $response);
+    }
+
+    is_deeply($got, $exp, "roundtrip chunked chunks w/o trailers");
 }
 
 {
@@ -52,7 +66,7 @@ use HTTP::Tiny;
         is_deeply($response->{headers}, $trailers, 'roundtrip chunked trailers');
     }
 
-    is_deeply($got, $exp, "roundtrip chunked chunks");
+    is_deeply($got, $exp, "roundtrip chunked chunks (with trailers)");
 }
 
 
index bd09a54fb57964ca625e66cf23c6663abdcd899c..f62c481cb10bb3b68c8214cc30eed8ce3eb9cef0 100644 (file)
@@ -4,8 +4,9 @@ use strict;
 use warnings;
 
 use Test::More tests => 4;
-use t::SimpleCookieJar;
-use t::BrokenCookieJar;
+use lib 't';
+use SimpleCookieJar;
+use BrokenCookieJar;
 use HTTP::Tiny;
 
 ### a couple tests to ensure that:
@@ -15,9 +16,9 @@ use HTTP::Tiny;
 
 
 my $default = undef;
-my $jar = t::SimpleCookieJar->new();
-my $mug = t::BrokenCookieJar->new();
-my $dog = t::BrokenCookieJar2->new();
+my $jar = SimpleCookieJar->new();
+my $mug = BrokenCookieJar->new();
+my $dog = BrokenCookieJar2->new();
 
 {
     my $ua = HTTP::Tiny->new();
index 43cf52e1da4f5d624c9ecdfbc58a1649746eaa18..5dbf3e8a6c97263681439382a977b4849e543b45 100644 (file)
@@ -5,7 +5,8 @@ use warnings;
 
 use File::Basename;
 use Test::More 0.88;
-use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+use lib 't';
+use Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
   hashify connect_args set_socket_source sort_headers $CRLF $LF];
 
 use HTTP::Tiny;
index 7a2e6ce138ef4c37ed8ecebeeee38f192b6a3626..ace074566cc8210b76c9ee5e0b31b6496b15b952 100644 (file)
@@ -5,7 +5,8 @@ use warnings;
 
 use File::Basename;
 use Test::More 0.88;
-use t::Util    qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+use lib 't';
+use Util    qw[tmpfile rewind slurp monkey_patch dir_list parse_case
                   set_socket_source sort_headers $CRLF $LF];
 use HTTP::Tiny;
 BEGIN { monkey_patch() }
index 42f3ed9a11a806f4e8fe4da38f4760523d1bf722..2fe3626dbc93a29d76c32e21ba719bbf2f2619c2 100644 (file)
@@ -5,7 +5,8 @@ use warnings;
 
 use File::Basename;
 use Test::More 0.88;
-use t::Util    qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+use lib 't';
+use Util    qw[tmpfile rewind slurp monkey_patch dir_list parse_case
                   set_socket_source sort_headers $CRLF $LF];
 use HTTP::Tiny;
 BEGIN { monkey_patch() }
index cbda117452ed671bd54ee66415f08bf3d7aff916..66d345b698e9eb837b16300dc04c3bd472596911 100644 (file)
@@ -5,7 +5,8 @@ use warnings;
 
 use File::Basename;
 use Test::More 0.88;
-use t::Util    qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+use lib 't';
+use Util    qw[tmpfile rewind slurp monkey_patch dir_list parse_case
                   set_socket_source sort_headers $CRLF $LF];
 use HTTP::Tiny;
 BEGIN { monkey_patch() }
index 5dc518aa1f2da1cc416168ce7d192711da6f6373..9c765bd56bb9d2bf8fed58c64030f9c10deb90a9 100644 (file)
@@ -5,7 +5,8 @@ use warnings;
 
 use File::Basename;
 use Test::More 0.88;
-use t::Util    qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+use lib 't';
+use Util    qw[tmpfile rewind slurp monkey_patch dir_list parse_case
                   set_socket_source sort_headers $CRLF $LF];
 use HTTP::Tiny;
 BEGIN { monkey_patch() }
index 1fb400f478a8c17c1489aa2a92de155d81a93616..de38fd128adfbc626c2b33293c29d9506968cc15 100644 (file)
@@ -5,7 +5,8 @@ use warnings;
 
 use File::Basename;
 use Test::More 0.88;
-use t::Util    qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+use lib 't';
+use Util    qw[tmpfile rewind slurp monkey_patch dir_list parse_case
                   set_socket_source sort_headers $CRLF $LF];
 use HTTP::Tiny;
 use File::Temp qw/tempdir/;
index 0f8f98df7fb1a0a59482b175fdbf50b64b693cbc..cc8c15cd89ce1c7db22ada1ee4da9d6515bff886 100644 (file)
@@ -5,7 +5,8 @@ use warnings;
 
 use File::Basename;
 use Test::More 0.88;
-use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+use lib 't';
+use Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
   hashify connect_args clear_socket_source set_socket_source sort_headers
   $CRLF $LF];
 
index eda3d6f33a6aa4731cf1295cb35f56c399d11870..c57977db8c5dd4a8b11aaa7baefa957e5dce3ebe 100644 (file)
@@ -6,7 +6,8 @@ use warnings;
 use File::Basename;
 use Test::More 0.88;
 
-use t::Util qw[ monkey_patch ];
+use lib 't';
+use Util qw[ monkey_patch ];
 use HTTP::Tiny;
 
 BEGIN {
index edb0601f73b0ec4f03ea725a25f61903e391b994..790cbc0481bfb6be3a827dc1d69483c3b4b1012c 100644 (file)
@@ -6,13 +6,15 @@ use open IN => ':raw';
 
 use File::Basename;
 use Test::More 0.88;
-use t::Util    qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+use lib 't';
+use Util    qw[tmpfile rewind slurp monkey_patch dir_list parse_case
                   set_socket_source sort_headers $CRLF $LF];
 use HTTP::Tiny;
 BEGIN { monkey_patch() }
 
 for my $file ( dir_list("corpus", qr/^form/ ) ) {
   my $data = do { local (@ARGV,$/) = $file; <> };
+  $data =~ s/$CRLF/$LF/gm if $^O eq 'MSWin32';
   my ($params, $expect_req, $give_res) = split /--+\n/, $data;
   # cleanup source data
   my $version = HTTP::Tiny->VERSION || 0;
index 1702fa32c41dda5c6c0c90e701fbfdd595dd9c52..03b9184fe1a5abf3e9fd7e2c40b0a2f33e309360 100644 (file)
@@ -5,14 +5,15 @@ use warnings;
 
 use File::Basename;
 use Test::More 0.96;
-use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+use lib 't';
+use Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
   hashify connect_args clear_socket_source set_socket_source sort_headers
   $CRLF $LF];
 
 use HTTP::Tiny;
 BEGIN { monkey_patch() }
 
-SKIP: for my $class ( qw/t::SimpleCookieJar HTTP::CookieJar/ ) {
+SKIP: for my $class ( qw/SimpleCookieJar HTTP::CookieJar/ ) {
 
     subtest $class => sub {
         eval "require $class; 1"
@@ -23,7 +24,7 @@ SKIP: for my $class ( qw/t::SimpleCookieJar HTTP::CookieJar/ ) {
             my $data = do { local (@ARGV,$/) = $file; <> };
             my @cases = split /--+\n/, $data;
 
-            my $jar = t::SimpleCookieJar->new();
+            my $jar = SimpleCookieJar->new();
             my $http = undef;
             while (@cases) {
                 my ($params, $expect_req, $give_res) = splice( @cases, 0, 3 );
index 3fd233da1d40a1b3de8f135c35f659cf93e38d23..379c5cca9e76c588a1625387373db07d35359c17 100644 (file)
@@ -5,7 +5,8 @@ use warnings;
 
 use File::Basename;
 use Test::More 0.88;
-use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+use lib 't';
+use Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
   hashify connect_args clear_socket_source set_socket_source sort_headers
   $CRLF $LF];
 
index 400c9d91ee5df632bd36daf257991dc36815e2a0..cf12e8873fecb19e0c4ebef075ea421973fbd0f3 100644 (file)
@@ -5,7 +5,8 @@ use warnings;
 
 use File::Basename;
 use Test::More 0.88;
-use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+use lib 't';
+use Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
   hashify connect_args clear_socket_source set_socket_source sort_headers
   $CRLF $LF];
 
index 8b265120fec45158f5f665ef98a7a070e075cab0..02162ae1757c0caf25849f9772157cf399cf9c2b 100644 (file)
@@ -4,7 +4,8 @@ use strict;
 use warnings;
 use File::Basename;
 use Test::More 0.88;
-use t::Util qw[
+use lib 't';
+use Util qw[
     tmpfile monkey_patch dir_list clear_socket_source set_socket_source
     $CRLF
 ];
index f638e2033653936e4ce238fc34f0d44f35c375cc..3b7d45793ca7718839bfce5f9baff15ca6191300 100644 (file)
@@ -1,4 +1,4 @@
-package t::BrokenCookieJar;
+package BrokenCookieJar;
 
 use strict;
 use warnings;
@@ -8,7 +8,7 @@ sub new {
     return bless {} => $class;
 }
 
-package t::BrokenCookieJar2;
+package BrokenCookieJar2;
 
 use strict;
 use warnings;
index 4c8fe083127058a7bf6e6ae12df3ebb6b72ad21c..a4ffed465e1ded85f2bab9a319a8a649d3b1d728 100644 (file)
@@ -1,4 +1,4 @@
-package t::SimpleCookieJar;
+package SimpleCookieJar;
 
 use strict;
 use warnings;
index f75ca55ef62bf90e6a21184de937b0463c89f245..2e85b04823d127f0eca39bb23c33f46983005f6b 100644 (file)
@@ -1,4 +1,4 @@
-package t::Util;
+package Util;
 
 use strict;
 use warnings;
index 02498504575e496e190368f67378fb1322043597..1b9c70a8f4ceefe81b7db7847b16a7be38652c0e 100644 (file)
@@ -5,6 +5,7 @@
 # Display info on the contents of a Zip file
 #
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use strict;
 use warnings ;
 
index 36070c7cf3445971b7a3a7243a9dfca05df424a9..092740cc6dded4f07d128a0568c3ecbe13712933 100644 (file)
@@ -17,7 +17,7 @@ use warnings ;
 use bytes ;
 our ($VERSION, $XS_VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 $XS_VERSION = $VERSION; 
 $VERSION = eval $VERSION;
 
index 74757a9d731466a610711043b18f551242fa1e25..84e5615a59f119dfad2a43a1470956861a00b1ac 100644 (file)
@@ -9,7 +9,7 @@ use IO::Compress::Base::Common  2.069 qw(:Status);
 use Compress::Raw::Bzip2  2.069 ;
 
 our ($VERSION);
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 sub mkCompObject
 {
index 7c616bfc70040bfb74792563ecddf9fc0bbd0937..e71ef38fbb8a9a05665fa586485c27f7fcc84d83 100644 (file)
@@ -10,7 +10,7 @@ use Compress::Raw::Zlib  2.069 qw( !crc32 !adler32 ) ;
 require Exporter;                                     
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 @ISA = qw(Exporter);
 @EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS;
 %EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS;
index b09897ab110c060d7b918ac2b5149ef7fcb6958d..9d414937ce3f8ecfe1ea26c52252dc38b3888e8e 100644 (file)
@@ -7,7 +7,7 @@ use bytes;
 use IO::Compress::Base::Common  2.069 qw(:Status);
 our ($VERSION);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 sub mkCompObject
 {
index 2a0dd799bbae6ed2b4d27036e57c1d387d050938..20760bb1de7a11c675ba0de6d8b019d73f8c8b42 100644 (file)
@@ -20,7 +20,7 @@ use Symbol();
 our (@ISA, $VERSION);
 @ISA    = qw(Exporter IO::File);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 #Can't locate object method "SWASHNEW" via package "utf8" (perhaps you forgot to load "utf8"?) at .../ext/Compress-Zlib/Gzip/blib/lib/Compress/Zlib/Common.pm line 16.
 
index fc983db17d28786d14c37a02168aac94829009be..0e92f751561464bb966d76d9070094464c5749ae 100644 (file)
@@ -11,7 +11,7 @@ use File::GlobMapper;
 require Exporter;
 our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE);
 @ISA = qw(Exporter);
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 @EXPORT = qw( isaFilehandle isaFilename isaScalar
               whatIsInput whatIsOutput 
index fbb9aed8908314e4a6e40fdbcdc346a0972b5ac7..d61d7235e57de238b08d27b978ab295a191200c1 100644 (file)
@@ -14,7 +14,7 @@ use IO::Compress::Adapter::Bzip2 2.069 ;
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 $Bzip2Error = '';
 
 @ISA    = qw(Exporter IO::Compress::Base);
index c79b33698f659c836d48ad4c73f2a5050582f9da..8e1d26341a360b6ab2a285d964cbe186b7ca1292 100644 (file)
@@ -17,7 +17,7 @@ use IO::Compress::Base::Common  2.069 qw();
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $DeflateError);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 $DeflateError = '';
 
 @ISA    = qw(Exporter IO::Compress::RawDeflate);
index 1aa5447f72807a38cb1ef24280d2161232b0f2cc..9b1d81450cb90a383430a851b2add7a67064a953 100644 (file)
@@ -25,7 +25,7 @@ BEGIN
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 $GzipError = '' ;
 
 @ISA    = qw(Exporter IO::Compress::RawDeflate);
index 293905ca1dc0481e47e5246600d97c45cc04ba2e..7964379cc1987bcd6d242e68de529f878b80af3c 100644 (file)
@@ -9,7 +9,7 @@ require Exporter;
 our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names);
 our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 @ISA = qw(Exporter);
 
index 7eabff9cb82bcec538b11e3d6bed8b57797f1122..9d55c88b8cd1879df5ebe78b77578d7379ce4838 100644 (file)
@@ -14,7 +14,7 @@ require Exporter ;
 
 our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 $RawDeflateError = '';
 
 @ISA = qw(Exporter IO::Compress::Base);
index 9e0d1c9b217074b7a2061a5c0e96d14b9e6848fb..4ebcc172730c2999ecc7dc42ce61177028b6bd93 100644 (file)
@@ -36,7 +36,7 @@ require Exporter ;
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 $ZipError = '';
 
 @ISA = qw(Exporter IO::Compress::RawDeflate);
index 40ad06050fabb035cda9f5ef435bb2cd919af538..976663ffd35b1a460793b1df1ad16e1d4d206522 100644 (file)
@@ -7,7 +7,7 @@ require Exporter;
 
 our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 @ISA = qw(Exporter);
 
index 13fd7d246897593060cf80153a3d81118f42927f..4d2441e981e37577f20232f7fa6e3b343fa8c400 100644 (file)
@@ -9,7 +9,7 @@ require Exporter;
 
 our ($VERSION, @ISA, @EXPORT);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 @ISA = qw(Exporter);
 
index ecec7a9dd2377c5d272b0d0dd1de7878cdef2112..9541c5eb9d405e5c245d8697aa3bc336e56cf9fa 100644 (file)
@@ -8,7 +8,7 @@ use bytes;
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 use IO::Compress::Gzip::Constants 2.069 ;
 
index 6086cd8a72c7e95ce27e6e96b4d4b400f719a8c4..5d02208aabbd48a56433a601bbc9c59b7bde1350 100644 (file)
@@ -9,7 +9,7 @@ use IO::Compress::Base::Common 2.069 qw(:Status);
 use Compress::Raw::Bzip2 2.069 ;
 
 our ($VERSION, @ISA);
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 sub mkUncompObject
 {
index 5ce67149875cd2ff8aba76081b1abd9bfe5502a5..e89f4bb045a20b89d9f671dead35ee9a8ee6ef97 100644 (file)
@@ -9,7 +9,7 @@ use IO::Compress::Zip::Constants ;
 
 our ($VERSION);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 use Compress::Raw::Zlib  2.069 ();
 
index fafa385e2642fde46a3f249d6bc6237f4793c3d4..68713b34e291035b7ed275dcac1c34c0c2e42421 100644 (file)
@@ -8,7 +8,7 @@ use IO::Compress::Base::Common  2.069 qw(:Status);
 use Compress::Raw::Zlib  2.069 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS);
 
 our ($VERSION);
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 
 
index 50e586e7223e7f3bf05636e6812dc8f295fb274a..30394cb8e2fed9056ba3a27f1e5ce6d5bc66fe8a 100644 (file)
@@ -21,7 +21,7 @@ require Exporter ;
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 $AnyInflateError = '';
 
 @ISA = qw( Exporter IO::Uncompress::Base );
index d44b225d6f21399c24ec52833fd6a28abe41351f..0760fc59cb7e61156aac52cfb5dca6c547e13ef6 100644 (file)
@@ -13,7 +13,7 @@ require Exporter ;
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 $AnyUncompressError = '';
 
 @ISA = qw( Exporter IO::Uncompress::Base );
@@ -27,6 +27,8 @@ Exporter::export_ok_tags('all');
 
 BEGIN
 {
+   local @INC = @INC;
+   pop @INC if $INC[-1] eq '.';
    eval ' use IO::Uncompress::Adapter::Inflate 2.069 ;';
    eval ' use IO::Uncompress::Adapter::Bunzip2 2.069 ;';
    eval ' use IO::Uncompress::Adapter::LZO 2.069 ;';
index 93c05de163c95db7071a8f2e5035aeb0fcb9a7c1..86a8040763ed286719529dfb3738e90180c8dd32 100644 (file)
@@ -9,7 +9,7 @@ our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS);
 @ISA    = qw(Exporter IO::File);
 
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 use constant G_EOF => 0 ;
 use constant G_ERR => -1 ;
index 46b5ea1ddaeaeada6732500f6830f345de618832..655a381f4d12ae89052d7cff72eccc7dbbfb7f80 100644 (file)
@@ -12,7 +12,7 @@ use IO::Uncompress::Adapter::Bunzip2 2.069 ;
 require Exporter ;
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bunzip2Error);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 $Bunzip2Error = '';
 
 @ISA    = qw( Exporter IO::Uncompress::Base );
index bd698f4dc50603e3826786174f5f9668bc737e35..b8be7f04f1e44f03de577cd77708c95647f72529 100644 (file)
@@ -28,7 +28,7 @@ Exporter::export_ok_tags('all');
 
 $GunzipError = '';
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 
 sub new
 {
index f62cfaceadc13beff39fece0b1c90b5a53c2faf7..5683b37c0ebcf005d81e0fa1f3288c6b0c536ab7 100644 (file)
@@ -13,7 +13,7 @@ use IO::Uncompress::RawInflate  2.069 ;
 require Exporter ;
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 $InflateError = '';
 
 @ISA    = qw( Exporter IO::Uncompress::RawInflate );
index c052971f24e4655e53f057feab424d5c170725be..5f7ad9f4cd0752ca044df2a43bb4cc31b099a451 100644 (file)
@@ -14,7 +14,7 @@ use IO::Uncompress::Adapter::Inflate  2.069 ;
 require Exporter ;
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 $RawInflateError = '';
 
 @ISA    = qw( Exporter IO::Uncompress::Base );
index 0ee6df42fe49fdaba522e0a28b966b7b7645f84a..ef7abbc67068f52b7eae8353d0ed65fb13f7ddcb 100644 (file)
@@ -31,7 +31,7 @@ require Exporter ;
 
 our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup);
 
-$VERSION = '2.069';
+$VERSION = '2.069_01';
 $UnzipError = '';
 
 @ISA    = qw(Exporter IO::Uncompress::RawInflate);
index 3266fab792a66a662c085126424e188d1b3ee56e..1bf6b0ea89bc94c2caf2ba943971d4ff5d75f4a1 100644 (file)
@@ -7,7 +7,7 @@ package IO::Socket::IP;
 # $VERSION needs to be set before  use base 'IO::Socket'
 #  - https://rt.cpan.org/Ticket/Display.html?id=92107
 BEGIN {
-   $VERSION = '0.37';
+   $VERSION = '0.38';
 }
 
 use strict;
@@ -265,6 +265,22 @@ If true, set the C<SO_REUSEPORT> sockopt (not all OSes implement this sockopt)
 
 If true, set the C<SO_BROADCAST> sockopt
 
+=item Sockopts => ARRAY
+
+An optional array of other socket options to apply after the three listed
+above. The value is an ARRAY containing 2- or 3-element ARRAYrefs. Each inner
+array relates to a single option, giving the level and option name, and an
+optional value. If the value element is missing, it will be given the value of
+a platform-sized integer 1 constant (i.e. suitable to enable most of the
+common boolean options).
+
+For example, both options given below are equivalent to setting C<ReuseAddr>.
+
+ Sockopts => [
+    [ SOL_SOCKET, SO_REUSEADDR ],
+    [ SOL_SOCKET, SO_REUSEADDR, pack( "i", 1 ) ],
+ ]
+
 =item V6Only => BOOL
 
 If defined, set the C<IPV6_V6ONLY> sockopt when creating C<PF_INET6> sockets
@@ -504,10 +520,27 @@ sub _io_socket_ip__configure
       }
    }
 
+   my $INT_1 = pack "i", 1;
+
    my @sockopts_enabled;
-   push @sockopts_enabled, SO_REUSEADDR if $arg->{ReuseAddr};
-   push @sockopts_enabled, SO_REUSEPORT if $arg->{ReusePort};
-   push @sockopts_enabled, SO_BROADCAST if $arg->{Broadcast};
+   push @sockopts_enabled, [ SOL_SOCKET, SO_REUSEADDR, $INT_1 ] if $arg->{ReuseAddr};
+   push @sockopts_enabled, [ SOL_SOCKET, SO_REUSEPORT, $INT_1 ] if $arg->{ReusePort};
+   push @sockopts_enabled, [ SOL_SOCKET, SO_BROADCAST, $INT_1 ] if $arg->{Broadcast};
+
+   if( my $sockopts = $arg->{Sockopts} ) {
+      ref $sockopts eq "ARRAY" or croak "Expected 'Sockopts' to be an ARRAY ref";
+      foreach ( @$sockopts ) {
+         ref $_ eq "ARRAY" or croak "Bad Sockopts item - expected ARRAYref";
+         @$_ >= 2 and @$_ <= 3 or
+            croak "Bad Sockopts item - expected 2 or 3 elements";
+
+         my ( $level, $optname, $value ) = @$_;
+         # TODO: consider more sanity checking on argument values
+
+         defined $value or $value = $INT_1;
+         push @sockopts_enabled, [ $level, $optname, $value ];
+      }
+   }
 
    my $blocking = $arg->{Blocking};
    defined $blocking or $blocking = 1;
@@ -607,7 +640,8 @@ sub setup
       $self->blocking( 0 ) unless ${*$self}{io_socket_ip_blocking};
 
       foreach my $sockopt ( @{ ${*$self}{io_socket_ip_sockopts} } ) {
-         $self->setsockopt( SOL_SOCKET, $sockopt, pack "i", 1 ) or ( $@ = "$!", return undef );
+         my ( $level, $optname, $value ) = @$sockopt;
+         $self->setsockopt( $level, $optname, $value ) or ( $@ = "$!", return undef );
       }
 
       if( defined ${*$self}{io_socket_ip_v6only} and defined $AF_INET6 and $info->{family} == $AF_INET6 ) {
@@ -685,6 +719,7 @@ sub connect :method
       }
       elsif( not( $err == EINPROGRESS or $err == EWOULDBLOCK ) ) {
          # Failed for some other reason
+         $self->blocking( $was_blocking );
          return undef;
       }
       elsif( !$was_blocking ) {
@@ -694,6 +729,7 @@ sub connect :method
 
       my $vec = ''; vec( $vec, $self->fileno, 1 ) = 1;
       if( !select( undef, $vec, $vec, $timeout ) ) {
+         $self->blocking( $was_blocking );
          $! = ETIMEDOUT;
          return undef;
       }
index 90f92ae7bd8b92206f64a83ef2c23f86638b8b52..5b850924dd526dc115cc11499271c297b1a6cc41 100644 (file)
@@ -24,6 +24,17 @@ TODO: {
    ) or die "Cannot socket() - $@";
 
    ok( $sock->getsockopt( SOL_SOCKET, SO_REUSEADDR ), 'SO_REUSEADDR set' );
+
+   $sock = IO::Socket::IP->new(
+      LocalHost => "127.0.0.1",
+      Type      => SOCK_STREAM,
+      Listen    => 1,
+      Sockopts  => [
+         [ SOL_SOCKET, SO_REUSEADDR ],
+      ],
+   ) or die "Cannot socket() - $@";
+
+   ok( $sock->getsockopt( SOL_SOCKET, SO_REUSEADDR ), 'SO_REUSEADDR set via Sockopts' );
 }
 
 SKIP: {
index 13f3c6bed03de79a533cafd1ca9574a5f6df38cb..c0e25a22fb367b265ea932a1a5033c835259a252 100644 (file)
@@ -18,7 +18,7 @@ BEGIN {
                         $HAVE_MONOTONIC
                     ];
 
-    $VERSION        = '0.94';
+    $VERSION        = '0.96';
     $VERBOSE        = 0;
     $DEBUG          = 0;
     $WARN           = 1;
@@ -60,6 +60,8 @@ use Text::ParseWords            ();             # import ONLY if needed!
 use Module::Load::Conditional   qw[can_load];
 use Locale::Maketext::Simple    Style => 'gettext';
 
+local $Module::Load::Conditional::FORCE_SAFE_INC = 1;
+
 =pod
 
 =head1 NAME
index 3362decb901130f43dc73063eb2b498287ae8f5f..39bed4d7cf5727d71fa5817c2ea4b87523313678 100644 (file)
@@ -1,5 +1,6 @@
 #!/usr/bin/perl
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use strict;
 use Getopt::Long;
 
index 28ea2d757e456392573e5e48ed40c252c0556b0c..bbfb244aa1bad660efb2341775e3ebbf9353661c 100644 (file)
@@ -11,7 +11,7 @@ use Carp ();
 use B ();
 #use Devel::Peek;
 
-$JSON::PP::VERSION = '2.27400';
+$JSON::PP::VERSION = '2.27400_01';
 
 @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json);
 
index 30760f3c26da456eb1339d0c1fb943c37beefa01..9e61670802ef44c024de45594817175b82b60ebf 100644 (file)
@@ -1,5 +1,5 @@
 package Locale::Maketext::Simple;
-$Locale::Maketext::Simple::VERSION = '0.21';
+$Locale::Maketext::Simple::VERSION = '0.21_01';
 
 use strict;
 use 5.005;
@@ -134,7 +134,12 @@ sub load_loc {
     my $pkg = join('::', grep { defined and length } $args{Class}, $args{Subclass});
     return $Loc{$pkg} if exists $Loc{$pkg};
 
-    eval { require Locale::Maketext::Lexicon; 1 }   or return;
+    eval {
+        local @INC = @INC;
+        pop @INC if $INC[-1] eq '.';
+        require Locale::Maketext::Lexicon;
+        1
+    } or return;
     $Locale::Maketext::Lexicon::VERSION > 0.20     or return;
     eval { require File::Spec; 1 }                 or return;
 
index 9a58c4ac7430fbe2d5f7904c39c5237b48a727a0..f4e6522d483e0a95e9bd8ea6335d5f8270364b58 100644 (file)
@@ -9,7 +9,7 @@
 # write to mjd-perl-memoize+@plover.com for a license.
 
 package Memoize;
-$VERSION = '1.03';
+$VERSION = '1.03_01';
 
 # Compile-time constants
 sub SCALAR () { 0 } 
@@ -184,7 +184,11 @@ sub _my_tie {
   }
   my $modulefile = $module . '.pm';
   $modulefile =~ s{::}{/}g;
-  eval { require $modulefile };
+  eval {
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
+    require $modulefile
+  };
   if ($@) {
     croak "Memoize: Couldn't load hash tie module `$module': $@; aborting";
   }
index ace55ad845d90fe1e57f39a8b726f06337af58fa..89e22b572072fceb7618e2e80827589bff872e2b 100644 (file)
@@ -19,14 +19,15 @@ use constant QUOTE    => do { ON_WIN32 ? q["] : q['] };
 
 BEGIN {
     use vars        qw[ $VERSION @ISA $VERBOSE $CACHE @EXPORT_OK $DEPRECATED
-                        $FIND_VERSION $ERROR $CHECK_INC_HASH];
+                        $FIND_VERSION $ERROR $CHECK_INC_HASH $FORCE_SAFE_INC ];
     use Exporter;
     @ISA            = qw[Exporter];
-    $VERSION        = '0.64';
+    $VERSION        = '0.68';
     $VERBOSE        = 0;
     $DEPRECATED     = 0;
     $FIND_VERSION   = 1;
     $CHECK_INC_HASH = 0;
+    $FORCE_SAFE_INC = 0;
     @EXPORT_OK      = qw[check_install can_load requires];
 }
 
@@ -201,6 +202,8 @@ sub check_install {
     ### so scan the dirs
     unless( $filename ) {
 
+        local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.';
+
         DIR: for my $dir ( @INC ) {
 
             my $fh;
@@ -307,6 +310,7 @@ sub check_install {
     }
 
     if ( $DEPRECATED and "$]" >= 5.011 ) {
+        local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.';
         require Module::CoreList;
         require Config;
 
@@ -444,6 +448,8 @@ sub can_load {
 
             if ( $CACHE->{$mod}->{uptodate} ) {
 
+                local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.';
+
                 if ( $args->{autoload} ) {
                     my $who = (caller())[0];
                     eval { autoload_remote $who, $mod };
@@ -509,6 +515,8 @@ sub requires {
         return undef;
     }
 
+    local @INC = @INC[0..$#INC-1] if $FORCE_SAFE_INC && $INC[-1] eq '.';
+
     my $lib = join " ", map { qq["-I$_"] } @INC;
     my $oneliner = 'print(join(qq[\n],map{qq[BONG=$_]}keys(%INC)),qq[\n])';
     my $cmd = join '', qq["$^X" $lib -M$who -e], QUOTE, $oneliner, QUOTE;
@@ -562,6 +570,12 @@ you.
 
 The default is 0;
 
+=head2 $Module::Load::Conditional::FORCE_SAFE_INC
+
+This controls whether C<Module::Load::Conditional> sanitises C<@INC>
+by removing "C<.>". The current default setting is C<0>, but this
+may change in a future release.
+
 =head2 $Module::Load::Conditional::CACHE
 
 This holds the cache of the C<can_load> function. If you explicitly
index e8c2b25399ba5d7e059f704997e464ba1c630808..7f49da6d59aa0c7418cf7555c9fe63779e7c015d 100644 (file)
@@ -1,6 +1,6 @@
 # -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*-
 # vim:ts=8:sw=2:et:sta:sts=2:tw=78
-package Module::Metadata; # git description: v1.000031-13-g7c061c9
+package Module::Metadata; # git description: v1.000032-7-gb4e8a3f
 # ABSTRACT: Gather package and POD information from perl module files
 
 # Adapted from Perl-licensed code originally distributed with
@@ -14,7 +14,7 @@ sub __clean_eval { eval $_[0] }
 use strict;
 use warnings;
 
-our $VERSION = '1.000032'; # TRIAL
+our $VERSION = '1.000033';
 
 use Carp qw/croak/;
 use File::Spec;
@@ -841,7 +841,7 @@ Module::Metadata - Gather package and POD information from perl module files
 
 =head1 VERSION
 
-version 1.000032
+version 1.000033
 
 =head1 SYNOPSIS
 
@@ -1070,7 +1070,7 @@ assistance from David Golden (xdg) <dagolden@cpan.org>.
 
 =head1 CONTRIBUTORS
 
-=for stopwords Karen Etheridge David Golden Vincent Pit Matt S Trout Chris Nehren Graham Knop Olivier Mengué Tomas Doran Tatsuhiko Miyagawa tokuhirom Peter Rabbitson Steve Hay Josh Jore Craig A. Berry Mitchell Steinbrunner Edward Zborowski Gareth Harper James Raspass Jerry D. Hedden 'BinGOs' Williams Kent Fredric
+=for stopwords Karen Etheridge David Golden Vincent Pit Matt S Trout Chris Nehren Graham Knop Olivier Mengué Tomas Doran Tatsuhiko Miyagawa tokuhirom Kent Fredric Peter Rabbitson Steve Hay Jerry D. Hedden Craig A. Berry Mitchell Steinbrunner Edward Zborowski Gareth Harper James Raspass 'BinGOs' Williams Josh Jore
 
 =over 4
 
@@ -1116,6 +1116,10 @@ tokuhirom <tokuhirom@gmail.com>
 
 =item *
 
+Kent Fredric <kentnl@cpan.org>
+
+=item *
+
 Peter Rabbitson <ribasushi@cpan.org>
 
 =item *
@@ -1124,7 +1128,7 @@ Steve Hay <steve.m.hay@googlemail.com>
 
 =item *
 
-Josh Jore <jjore@cpan.org>
+Jerry D. Hedden <jdhedden@cpan.org>
 
 =item *
 
@@ -1132,6 +1136,10 @@ Craig A. Berry <cberry@cpan.org>
 
 =item *
 
+Craig A. Berry <craigberry@mac.com>
+
+=item *
+
 David Mitchell <davem@iabyn.com>
 
 =item *
@@ -1152,15 +1160,11 @@ James Raspass <jraspass@gmail.com>
 
 =item *
 
-Jerry D. Hedden <jdhedden@cpan.org>
-
-=item *
-
 Chris 'BinGOs' Williams <chris@bingosnet.co.uk>
 
 =item *
 
-Kent Fredric <kentnl@cpan.org>
+Josh Jore <jjore@cpan.org>
 
 =back
 
index 016e7844adee3a704b043de217bdfef283c209bb..d2b7c501d3d8523fbb9a87cfce6212ede798001c 100644 (file)
@@ -4,7 +4,7 @@ use Test::More tests => 3;
 use Module::Metadata;
 
 BEGIN {
-  *fh_from_string = $] < 5.008
+  *fh_from_string = "$]" < 5.008
     ? require IO::Scalar && sub ($) {
       IO::Scalar->new(\$_[0]);
     }
index b1b776c6f10535224f1c5d7e7c48947572178efe..44f4de9b21bc029def4a0b243c5859e281c3a1ef 100644 (file)
@@ -142,7 +142,7 @@ foreach my $test_case (@pkg_names) {
     my $warnings = '';
     local $SIG{__WARN__} = sub { $warnings .= $_ for @_ };
 
-    my $pm_info = Module::Metadata->new_from_file(generate_file(File::Spec->catdir($tmpdir, "Simple${test_num}"), 'Simple.pm', $code));
+    my $pm_info = Module::Metadata->new_from_file(generate_file(File::Spec->catfile($tmpdir, "Simple${test_num}"), 'Simple.pm', $code));
 
     # whenever we drop support for 5.6, we can do this:
     # open my $fh, '<', \(encode('UTF-8', $code, Encode::FB_CROAK))
index 16266e8136f28193c808fa10445b9f00aa4104a5..1a49be1a129b39331dd33aa8a67c9935a66ceb62 100644 (file)
@@ -626,14 +626,14 @@ foreach my $test_case (@modules) {
 
   SKIP: {
     skip( "No our() support until perl 5.6", (defined $expected_version ? 3 : 2) )
-        if $] < 5.006 && $code =~ /\bour\b/;
+        if "$]" < 5.006 && $code =~ /\bour\b/;
     skip( "No package NAME VERSION support until perl 5.11.1", (defined $expected_version ? 3 : 2) )
-        if $] < 5.011001 && $code =~ /package\s+[\w\:\']+\s+v?[0-9._]+/;
+        if "$]" < 5.011001 && $code =~ /package\s+[\w\:\']+\s+v?[0-9._]+/;
 
     my $warnings = '';
     local $SIG{__WARN__} = sub { $warnings .= $_ for @_ };
 
-    my $pm_info = Module::Metadata->new_from_file(generate_file(File::Spec->catdir($tmpdir, "Simple${test_num}"), 'Simple.pm', $code));
+    my $pm_info = Module::Metadata->new_from_file(generate_file(File::Spec->catfile($tmpdir, "Simple${test_num}"), 'Simple.pm', $code));
 
     # whenever we drop support for 5.6, we can do this:
     # open my $fh, '<', \(encode('UTF-8', $code, Encode::FB_CROAK))
index a77bb3874335993a47187da8d9a7ae9fcda46ac6..cb87fb659b0c66872e5afff14247dc96a78b329c 100644 (file)
@@ -1,9 +1,12 @@
 package NEXT;
-$VERSION = '0.65';
+
 use Carp;
 use strict;
+use warnings;
 use overload ();
 
+our $VERSION = '0.67';
+
 sub NEXT::ELSEWHERE::ancestors
 {
        my @inlist = shift;
@@ -108,7 +111,8 @@ package NEXT::ACTUAL::DISTINCT;     @ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
 package NEXT::UNSEEN::ACTUAL;  @ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
 package NEXT::DISTINCT::ACTUAL;        @ISA = 'NEXT'; NEXT::ELSEWHERE::buildAUTOLOAD();
 
-package EVERY;
+package
+    EVERY;
 
 sub EVERY::ELSEWHERE::buildAUTOLOAD {
     my $autoload_name = caller() . '::AUTOLOAD';
@@ -182,7 +186,8 @@ sub EVERY::ELSEWHERE::buildAUTOLOAD {
 }
 
 package EVERY::LAST;   @ISA = 'EVERY';   EVERY::ELSEWHERE::buildAUTOLOAD();
-package EVERY;         @ISA = 'NEXT';    EVERY::ELSEWHERE::buildAUTOLOAD();
+package
+    EVERY;             @ISA = 'NEXT';    EVERY::ELSEWHERE::buildAUTOLOAD();
 
 1;
 
@@ -190,50 +195,54 @@ __END__
 
 =head1 NAME
 
-NEXT.pm - Provide a pseudo-class NEXT (et al) that allows method redispatch
-
+NEXT - Provide a pseudo-class NEXT (et al) that allows method redispatch
 
 =head1 SYNOPSIS
 
     use NEXT;
 
-    package A;
-    sub A::method   { print "$_[0]: A method\n";   $_[0]->NEXT::method() }
-    sub A::DESTROY  { print "$_[0]: A dtor\n";     $_[0]->NEXT::DESTROY() }
+    package P;
+    sub P::method   { print "$_[0]: P method\n";   $_[0]->NEXT::method() }
+    sub P::DESTROY  { print "$_[0]: P dtor\n";     $_[0]->NEXT::DESTROY() }
 
-    package B;
-    use base qw( A );
-    sub B::AUTOLOAD { print "$_[0]: B AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
-    sub B::DESTROY  { print "$_[0]: B dtor\n";     $_[0]->NEXT::DESTROY() }
+    package Q;
+    use base qw( P );
+    sub Q::AUTOLOAD { print "$_[0]: Q AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
+    sub Q::DESTROY  { print "$_[0]: Q dtor\n";     $_[0]->NEXT::DESTROY() }
 
-    package C;
-    sub C::method   { print "$_[0]: C method\n";   $_[0]->NEXT::method() }
-    sub C::AUTOLOAD { print "$_[0]: C AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
-    sub C::DESTROY  { print "$_[0]: C dtor\n";     $_[0]->NEXT::DESTROY() }
+    package R;
+    sub R::method   { print "$_[0]: R method\n";   $_[0]->NEXT::method() }
+    sub R::AUTOLOAD { print "$_[0]: R AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
+    sub R::DESTROY  { print "$_[0]: R dtor\n";     $_[0]->NEXT::DESTROY() }
 
-    package D;
-    use base qw( B C );
-    sub D::method   { print "$_[0]: D method\n";   $_[0]->NEXT::method() }
-    sub D::AUTOLOAD { print "$_[0]: D AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
-    sub D::DESTROY  { print "$_[0]: D dtor\n";     $_[0]->NEXT::DESTROY() }
+    package S;
+    use base qw( Q R );
+    sub S::method   { print "$_[0]: S method\n";   $_[0]->NEXT::method() }
+    sub S::AUTOLOAD { print "$_[0]: S AUTOLOAD\n"; $_[0]->NEXT::AUTOLOAD() }
+    sub S::DESTROY  { print "$_[0]: S dtor\n";     $_[0]->NEXT::DESTROY() }
 
     package main;
 
-    my $obj = bless {}, "D";
+    my $obj = bless {}, "S";
 
-    $obj->method();            # Calls D::method, A::method, C::method
-    $obj->missing_method(); # Calls D::AUTOLOAD, B::AUTOLOAD, C::AUTOLOAD
+    $obj->method();            # Calls S::method, P::method, R::method
+    $obj->missing_method(); # Calls S::AUTOLOAD, Q::AUTOLOAD, R::AUTOLOAD
 
-    # Clean-up calls D::DESTROY, B::DESTROY, A::DESTROY, C::DESTROY
+    # Clean-up calls S::DESTROY, Q::DESTROY, P::DESTROY, R::DESTROY
 
 
 
 =head1 DESCRIPTION
 
-NEXT.pm adds a pseudoclass named C<NEXT> to any program
+The C<NEXT> module adds a pseudoclass named C<NEXT> to any program
 that uses it. If a method C<m> calls C<$self-E<gt>NEXT::m()>, the call to
 C<m> is redispatched as if the calling method had not originally been found.
 
+B<Note:> before using this module,
+you should look at L<next::method|https://metacpan.org/pod/mro#next::method>
+in the core L<mro> module.
+C<mro> has been a core module since Perl 5.9.5.
+
 In other words, a call to C<$self-E<gt>NEXT::m()> resumes the depth-first,
 left-to-right search of C<$self>'s class hierarchy that resulted in the
 original call to C<m>.
@@ -245,10 +254,10 @@ past the current class -- to look for a suitable method in other
 ancestors of C<$self> -- whereas C<$self-E<gt>SUPER::m()> cannot.
 
 A typical use would be in the destructors of a class hierarchy,
-as illustrated in the synopsis above. Each class in the hierarchy
+as illustrated in the SYNOPSIS above. Each class in the hierarchy
 has a DESTROY method that performs some class-specific action
 and then redispatches the call up the hierarchy. As a result,
-when an object of class D is destroyed, the destructors of I<all>
+when an object of class S is destroyed, the destructors of I<all>
 its parent classes are called (in depth-first, left-to-right order).
 
 Another typical use of redispatch would be in C<AUTOLOAD>'ed methods.
@@ -267,7 +276,7 @@ Note that it is a fatal error for any method (including C<AUTOLOAD>)
 to attempt to redispatch any method that does not have the
 same name. For example:
 
-        sub D::oops { print "oops!\n"; $_[0]->NEXT::other_method() }
+        sub S::oops { print "oops!\n"; $_[0]->NEXT::other_method() }
 
 
 =head2 Enforcing redispatch
@@ -384,7 +393,7 @@ previous example were rewritten:
         E->foo();
 
 then it would print:
-        
+
         called E::foo
         called C::foo
         called A::foo
@@ -410,7 +419,7 @@ C<NEXT::UNSEEN> instead of C<NEXT::DISTINCT>.
 
 =head2 Invoking all versions of a method with a single call
 
-Yet another pseudo-class that NEXT.pm provides is C<EVERY>.
+Yet another pseudo-class that C<NEXT> provides is C<EVERY>.
 Its behaviour is considerably simpler than that of the C<NEXT> family.
 A call to:
 
@@ -540,6 +549,11 @@ behaviour simply adds its own C<Init> method (I<not> a C<new> method),
 which the call to C<EVERY::LAST::Init> in the inherited constructor
 then correctly picks up.
 
+=head1 SEE ALSO
+
+L<mro>
+(in particular L<next::method|https://metacpan.org/pod/mro#next::method>),
+which has been a core module since Perl 5.9.5.
 
 =head1 AUTHOR
 
@@ -547,7 +561,7 @@ Damian Conway (damian@conway.org)
 
 =head1 BUGS AND IRRITATIONS
 
-Because it's a module, not an integral part of the interpreter, NEXT.pm
+Because it's a module, not an integral part of the interpreter, C<NEXT>
 has to guess where the surrounding call was found in the method
 look-up sequence. In the presence of diamond inheritance patterns
 it occasionally guesses wrong.
diff --git a/cpan/Parse-CPAN-Meta/corpus/BadMETA.yml b/cpan/Parse-CPAN-Meta/corpus/BadMETA.yml
deleted file mode 100644 (file)
index 79fece3..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
----\r
-abstract: ~\r
-author:\r
-  - 'Olivier Mengué'\r
-build_requires:\r
-  ExtUtils::MakeMaker: 6.36\r
-configure_requires:\r
-  ExtUtils::MakeMaker: 6.36\r
-distribution_type: module\r
-dynamic_config: 1\r
-generated_by: 'Module::Install version 1.06'\r
-license: perl\r
-meta-spec:\r
-  url: http://module-build.sourceforge.net/META-spec-v1.4.html\r
-  version: 1.4\r
-name: Foo\r
-no_index:\r
-  directory:\r
-    - inc\r
-requires:\r
-  perl: 5.005\r
-resources:\r
-  license: http://dev.perl.org/licenses/\r
-version: 0.01\r
diff --git a/cpan/Parse-CPAN-Meta/corpus/CL018_yaml.meta b/cpan/Parse-CPAN-Meta/corpus/CL018_yaml.meta
deleted file mode 100644 (file)
index 4bbac95..0000000
+++ /dev/null
@@ -1,75 +0,0 @@
-{
-   "abstract" : "Lexical Analyzer for Perl5",
-   "author" : [
-      "Masaaki Goshima (goccy) <goccy(at)cpan.org>"
-   ],
-   "dynamic_config" : 0,
-   "generated_by" : "Module::Build version 0.4205",
-   "license" : [
-      "perl_5"
-   ],
-   "meta-spec" : {
-      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
-      "version" : "2"
-   },
-   "name" : "Compiler-Lexer",
-   "no_index" : {
-      "directory" : [
-         "t",
-         "examples",
-         "builder"
-      ]
-   },
-   "prereqs" : {
-      "build" : {
-         "requires" : {
-            "ExtUtils::CBuilder" : "0"
-         }
-      },
-      "configure" : {
-         "requires" : {
-            "Module::Build" : "0.38",
-            "Module::Build::XSUtil" : "0.06"
-         }
-      }
-   },
-   "provides" : {
-      "Compiler::Lexer" : {
-         "file" : "lib/Compiler/Lexer.pm",
-         "version" : "0.18"
-      },
-      "Compiler::Lexer::Kind" : {
-         "file" : "lib/Compiler/Lexer/Constants.pm"
-      },
-      "Compiler::Lexer::SyntaxType" : {
-         "file" : "lib/Compiler/Lexer/Constants.pm"
-      },
-      "Compiler::Lexer::Token" : {
-         "file" : "lib/Compiler/Lexer/Token.pm"
-      },
-      "Compiler::Lexer::TokenType" : {
-         "file" : "lib/Compiler/Lexer/Constants.pm"
-      }
-   },
-   "release_status" : "stable",
-   "resources" : {
-      "bugtracker" : {
-         "web" : "https://github.com/goccy/p5-Compiler-Lexer/issues"
-      },
-      "homepage" : "https://github.com/goccy/p5-Compiler-Lexer",
-      "repository" : {
-         "type" : "git",
-         "url" : "git://github.com/goccy/p5-Compiler-Lexer.git"
-      }
-   },
-   "version" : "0.18",
-   "x_contributors" : [
-      "tokuhirom <tokuhirom@gmail.com>",
-      "Reini Urban <rurban@cpanel.net>",
-      "Fumihiro Itoh <fmhrit@gmail.com>",
-      "Masaaki Goshima <masaaki.goshima@mixi.co.jp>",
-      "moznion <moznion@gmail.com>",
-      "Olivier Mengué <dolmen@cpan.org>",
-      "Masaaki Goshima <goccy54@gmail.com>"
-   ]
-}
diff --git a/cpan/Parse-CPAN-Meta/corpus/META-VR.json b/cpan/Parse-CPAN-Meta/corpus/META-VR.json
deleted file mode 100644 (file)
index 71bb249..0000000
+++ /dev/null
@@ -1,33 +0,0 @@
-{
-   "abstract" : "a set of version requirements for a CPAN dist",
-   "author" : [
-      "Ricardo Signes <rjbs@cpan.org>"
-   ],
-   "build_requires" : {
-      "Test::More" : "0.88"
-   },
-   "configure_requires" : {
-      "ExtUtils::MakeMaker" : "6.31"
-   },
-   "generated_by" : "Dist::Zilla version 2.100991",
-   "license" : "perl",
-   "meta-spec" : {
-      "url" : "http://module-build.sourceforge.net/META-spec-v1.4.html",
-      "version" : 1.4
-   },
-   "name" : "Version-Requirements",
-   "recommends" : {},
-   "requires" : {
-      "Carp" : "0",
-      "Scalar::Util" : "0",
-      "version" : "0.77"
-   },
-   "resources" : {
-      "repository" : "git://git.codesimply.com/Version-Requirements.git"
-   },
-   "version" : "0.101010",
-   "x_contributors" : [
-      "Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>"
-   ]
-}
-
diff --git a/cpan/Parse-CPAN-Meta/corpus/META-VR.yml b/cpan/Parse-CPAN-Meta/corpus/META-VR.yml
deleted file mode 100644 (file)
index 18b2350..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
----
-abstract: 'a set of version requirements for a CPAN dist'
-author:
-  - 'Ricardo Signes <rjbs@cpan.org>'
-build_requires:
-  Test::More: 0.88
-configure_requires:
-  ExtUtils::MakeMaker: 6.31
-generated_by: 'Dist::Zilla version 2.100991'
-license: perl
-meta-spec:
-  url: http://module-build.sourceforge.net/META-spec-v1.4.html
-  version: 1.4
-name: Version-Requirements
-recommends: {}
-requires:
-  Carp: 0
-  Scalar::Util: 0
-  version: 0.77
-resources:
-  repository: git://git.codesimply.com/Version-Requirements.git
-version: 0.101010
-x_contributors:
-  - 'Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>'
diff --git a/cpan/Parse-CPAN-Meta/corpus/bareyaml.meta b/cpan/Parse-CPAN-Meta/corpus/bareyaml.meta
deleted file mode 100644 (file)
index 85c4f1d..0000000
+++ /dev/null
@@ -1,23 +0,0 @@
-abstract: 'a set of version requirements for a CPAN dist'
-author:
-  - 'Ricardo Signes <rjbs@cpan.org>'
-build_requires:
-  Test::More: 0.88
-configure_requires:
-  ExtUtils::MakeMaker: 6.31
-generated_by: 'Dist::Zilla version 2.100991'
-license: perl
-meta-spec:
-  url: http://module-build.sourceforge.net/META-spec-v1.4.html
-  version: 1.4
-name: Version-Requirements
-recommends: {}
-requires:
-  Carp: 0
-  Scalar::Util: 0
-  version: 0.77
-resources:
-  repository: git://git.codesimply.com/Version-Requirements.git
-version: 0.101010
-x_contributors:
-  - 'Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>'
diff --git a/cpan/Parse-CPAN-Meta/corpus/json.meta b/cpan/Parse-CPAN-Meta/corpus/json.meta
deleted file mode 100644 (file)
index 71bb249..0000000
+++ /dev/null
@@ -1,33 +0,0 @@
-{
-   "abstract" : "a set of version requirements for a CPAN dist",
-   "author" : [
-      "Ricardo Signes <rjbs@cpan.org>"
-   ],
-   "build_requires" : {
-      "Test::More" : "0.88"
-   },
-   "configure_requires" : {
-      "ExtUtils::MakeMaker" : "6.31"
-   },
-   "generated_by" : "Dist::Zilla version 2.100991",
-   "license" : "perl",
-   "meta-spec" : {
-      "url" : "http://module-build.sourceforge.net/META-spec-v1.4.html",
-      "version" : 1.4
-   },
-   "name" : "Version-Requirements",
-   "recommends" : {},
-   "requires" : {
-      "Carp" : "0",
-      "Scalar::Util" : "0",
-      "version" : "0.77"
-   },
-   "resources" : {
-      "repository" : "git://git.codesimply.com/Version-Requirements.git"
-   },
-   "version" : "0.101010",
-   "x_contributors" : [
-      "Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>"
-   ]
-}
-
diff --git a/cpan/Parse-CPAN-Meta/corpus/yaml.meta b/cpan/Parse-CPAN-Meta/corpus/yaml.meta
deleted file mode 100644 (file)
index 18b2350..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
----
-abstract: 'a set of version requirements for a CPAN dist'
-author:
-  - 'Ricardo Signes <rjbs@cpan.org>'
-build_requires:
-  Test::More: 0.88
-configure_requires:
-  ExtUtils::MakeMaker: 6.31
-generated_by: 'Dist::Zilla version 2.100991'
-license: perl
-meta-spec:
-  url: http://module-build.sourceforge.net/META-spec-v1.4.html
-  version: 1.4
-name: Version-Requirements
-recommends: {}
-requires:
-  Carp: 0
-  Scalar::Util: 0
-  version: 0.77
-resources:
-  repository: git://git.codesimply.com/Version-Requirements.git
-version: 0.101010
-x_contributors:
-  - 'Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>'
diff --git a/cpan/Parse-CPAN-Meta/lib/Parse/CPAN/Meta.pm b/cpan/Parse-CPAN-Meta/lib/Parse/CPAN/Meta.pm
deleted file mode 100644 (file)
index 027b1fa..0000000
+++ /dev/null
@@ -1,418 +0,0 @@
-use 5.008001;
-use strict;
-package Parse::CPAN::Meta;
-# ABSTRACT: Parse META.yml and META.json CPAN metadata files
-
-our $VERSION = '1.4422';
-
-use Exporter;
-use Carp 'croak';
-
-our @ISA = qw/Exporter/;
-our @EXPORT_OK = qw/Load LoadFile/;
-
-sub load_file {
-  my ($class, $filename) = @_;
-
-  my $meta = _slurp($filename);
-
-  if ($filename =~ /\.ya?ml$/) {
-    return $class->load_yaml_string($meta);
-  }
-  elsif ($filename =~ /\.json$/) {
-    return $class->load_json_string($meta);
-  }
-  else {
-    $class->load_string($meta); # try to detect yaml/json
-  }
-}
-
-sub load_string {
-  my ($class, $string) = @_;
-  if ( $string =~ /^---/ ) { # looks like YAML
-    return $class->load_yaml_string($string);
-  }
-  elsif ( $string =~ /^\s*\{/ ) { # looks like JSON
-    return $class->load_json_string($string);
-  }
-  else { # maybe doc-marker-free YAML
-    return $class->load_yaml_string($string);
-  }
-}
-
-sub load_yaml_string {
-  my ($class, $string) = @_;
-  my $backend = $class->yaml_backend();
-  my $data = eval { no strict 'refs'; &{"$backend\::Load"}($string) };
-  croak $@ if $@;
-  return $data || {}; # in case document was valid but empty
-}
-
-sub load_json_string {
-  my ($class, $string) = @_;
-  require Encode;
-  # load_json_string takes characters, decode_json expects bytes
-  my $encoded = Encode::encode('UTF-8', $string, Encode::PERLQQ());
-  my $data = eval { $class->json_decoder()->can('decode_json')->($encoded) };
-  croak $@ if $@;
-  return $data || {};
-}
-
-sub yaml_backend {
-  if (! defined $ENV{PERL_YAML_BACKEND} ) {
-    _can_load( 'CPAN::Meta::YAML', 0.011 )
-      or croak "CPAN::Meta::YAML 0.011 is not available\n";
-    return "CPAN::Meta::YAML";
-  }
-  else {
-    my $backend = $ENV{PERL_YAML_BACKEND};
-    _can_load( $backend )
-      or croak "Could not load PERL_YAML_BACKEND '$backend'\n";
-    $backend->can("Load")
-      or croak "PERL_YAML_BACKEND '$backend' does not implement Load()\n";
-    return $backend;
-  }
-}
-
-sub json_decoder {
-  if (my $decoder = $ENV{CPAN_META_JSON_DECODER}) {
-    _can_load( $decoder )
-      or croak "Could not load CPAN_META_JSON_DECODER '$decoder'\n";
-    $decoder->can('decode_json')
-      or croak "No decode_json sub provided by CPAN_META_JSON_DECODER '$decoder'\n";
-    return $decoder;
-  }
-  return $_[0]->json_backend;
-}
-
-sub json_backend {
-  if (my $backend = $ENV{CPAN_META_JSON_BACKEND}) {
-    _can_load( $backend )
-      or croak "Could not load CPAN_META_JSON_BACKEND '$backend'\n";
-    $backend->can('new')
-      or croak "No constructor provided by CPAN_META_JSON_BACKEND '$backend'\n";
-    return $backend;
-  }
-  if (! $ENV{PERL_JSON_BACKEND} or $ENV{PERL_JSON_BACKEND} eq 'JSON::PP') {
-    _can_load( 'JSON::PP' => 2.27300 )
-      or croak "JSON::PP 2.27300 is not available\n";
-    return 'JSON::PP';
-  }
-  else {
-    _can_load( 'JSON' => 2.5 )
-      or croak  "JSON 2.5 is required for " .
-                "\$ENV{PERL_JSON_BACKEND} = '$ENV{PERL_JSON_BACKEND}'\n";
-    return "JSON";
-  }
-}
-
-sub _slurp {
-  require Encode;
-  open my $fh, "<:raw", "$_[0]" ## no critic
-    or die "can't open $_[0] for reading: $!";
-  my $content = do { local $/; <$fh> };
-  $content = Encode::decode('UTF-8', $content, Encode::PERLQQ());
-  return $content;
-}
-  
-sub _can_load {
-  my ($module, $version) = @_;
-  (my $file = $module) =~ s{::}{/}g;
-  $file .= ".pm";
-  return 1 if $INC{$file};
-  return 0 if exists $INC{$file}; # prior load failed
-  eval { require $file; 1 }
-    or return 0;
-  if ( defined $version ) {
-    eval { $module->VERSION($version); 1 }
-      or return 0;
-  }
-  return 1;
-}
-
-# Kept for backwards compatibility only
-# Create an object from a file
-sub LoadFile ($) { ## no critic
-  return Load(_slurp(shift));
-}
-
-# Parse a document from a string.
-sub Load ($) { ## no critic
-  require CPAN::Meta::YAML;
-  my $object = eval { CPAN::Meta::YAML::Load(shift) };
-  croak $@ if $@;
-  return $object;
-}
-
-1;
-
-__END__
-
-=pod
-
-=encoding UTF-8
-
-=head1 NAME
-
-Parse::CPAN::Meta - Parse META.yml and META.json CPAN metadata files
-
-=head1 VERSION
-
-version 1.4422
-
-=head1 SYNOPSIS
-
-    #############################################
-    # In your file
-    
-    ---
-    name: My-Distribution
-    version: 1.23
-    resources:
-      homepage: "http://example.com/dist/My-Distribution"
-    
-    
-    #############################################
-    # In your program
-    
-    use Parse::CPAN::Meta;
-    
-    my $distmeta = Parse::CPAN::Meta->load_file('META.yml');
-    
-    # Reading properties
-    my $name     = $distmeta->{name};
-    my $version  = $distmeta->{version};
-    my $homepage = $distmeta->{resources}{homepage};
-
-=head1 DESCRIPTION
-
-B<Parse::CPAN::Meta> is a parser for F<META.json> and F<META.yml> files, using
-L<JSON::PP> and/or L<CPAN::Meta::YAML>.
-
-B<Parse::CPAN::Meta> provides three methods: C<load_file>, C<load_json_string>,
-and C<load_yaml_string>.  These will read and deserialize CPAN metafiles, and
-are described below in detail.
-
-B<Parse::CPAN::Meta> provides a legacy API of only two functions,
-based on the YAML functions of the same name. Wherever possible,
-identical calling semantics are used.  These may only be used with YAML sources.
-
-All error reporting is done with exceptions (die'ing).
-
-Note that META files are expected to be in UTF-8 encoding, only.  When
-converted string data, it must first be decoded from UTF-8.
-
-=begin Pod::Coverage
-
-
-
-
-=end Pod::Coverage
-
-=head1 METHODS
-
-=head2 load_file
-
-  my $metadata_structure = Parse::CPAN::Meta->load_file('META.json');
-
-  my $metadata_structure = Parse::CPAN::Meta->load_file('META.yml');
-
-This method will read the named file and deserialize it to a data structure,
-determining whether it should be JSON or YAML based on the filename.
-The file will be read using the ":utf8" IO layer.
-
-=head2 load_yaml_string
-
-  my $metadata_structure = Parse::CPAN::Meta->load_yaml_string($yaml_string);
-
-This method deserializes the given string of YAML and returns the first
-document in it.  (CPAN metadata files should always have only one document.)
-If the source was UTF-8 encoded, the string must be decoded before calling
-C<load_yaml_string>.
-
-=head2 load_json_string
-
-  my $metadata_structure = Parse::CPAN::Meta->load_json_string($json_string);
-
-This method deserializes the given string of JSON and the result.  
-If the source was UTF-8 encoded, the string must be decoded before calling
-C<load_json_string>.
-
-=head2 load_string
-
-  my $metadata_structure = Parse::CPAN::Meta->load_string($some_string);
-
-If you don't know whether a string contains YAML or JSON data, this method
-will use some heuristics and guess.  If it can't tell, it assumes YAML.
-
-=head2 yaml_backend
-
-  my $backend = Parse::CPAN::Meta->yaml_backend;
-
-Returns the module name of the YAML serializer. See L</ENVIRONMENT>
-for details.
-
-=head2 json_backend
-
-  my $backend = Parse::CPAN::Meta->json_backend;
-
-Returns the module name of the JSON serializer.  If C<CPAN_META_JSON_BACKEND>
-is set, this will be whatever that's set to.  If not, this will either
-be L<JSON::PP> or L<JSON>.  If C<PERL_JSON_BACKEND> is set,
-this will return L<JSON> as further delegation is handled by
-the L<JSON> module.  See L</ENVIRONMENT> for details.
-
-=head2 json_decoder
-
-  my $decoder = Parse::CPAN::Meta->json_decoder;
-
-Returns the module name of the JSON decoder.  Unlike L</json_backend>, this
-is not necessarily a full L<JSON>-style module, but only something that will
-provide a C<decode_json> subroutine.  If C<CPAN_META_JSON_DECODER> is set,
-this will be whatever that's set to.  If not, this will be whatever has
-been selected as L</json_backend>.  See L</ENVIRONMENT> for more notes.
-
-=head1 FUNCTIONS
-
-For maintenance clarity, no functions are exported by default.  These functions
-are available for backwards compatibility only and are best avoided in favor of
-C<load_file>.
-
-=head2 Load
-
-  my @yaml = Parse::CPAN::Meta::Load( $string );
-
-Parses a string containing a valid YAML stream into a list of Perl data
-structures.
-
-=head2 LoadFile
-
-  my @yaml = Parse::CPAN::Meta::LoadFile( 'META.yml' );
-
-Reads the YAML stream from a file instead of a string.
-
-=head1 ENVIRONMENT
-
-=head2 CPAN_META_JSON_DECODER
-
-By default, L<JSON::PP> will be used for deserializing JSON data.  If the
-C<CPAN_META_JSON_DECODER> environment variable exists, this is expected to
-be the name of a loadable module that provides a C<decode_json> subroutine,
-which will then be used for deserialization.  Relying only on the existence
-of said subroutine allows for maximum compatibility, since this API is
-provided by all of L<JSON::PP>, L<JSON::XS>, L<Cpanel::JSON::XS>,
-L<JSON::MaybeXS>, L<JSON::Tiny>, and L<Mojo::JSON>.
-
-=head2 CPAN_META_JSON_BACKEND
-
-By default, L<JSON::PP> will be used for deserializing JSON data.  If the
-C<CPAN_META_JSON_BACKEND> environment variable exists, this is expected to
-be the name of a loadable module that provides the L<JSON> API, since
-downstream code expects to be able to call C<new> on this class.  As such,
-while L<JSON::PP>, L<JSON::XS>, L<Cpanel::JSON::XS> and L<JSON::MaybeXS> will
-work for this, to use L<Mojo::JSON> or L<JSON::Tiny> for decoding requires
-setting L</CPAN_META_JSON_DECODER>.
-
-=head2 PERL_JSON_BACKEND
-
-If the C<CPAN_META_JSON_BACKEND> environment variable does not exist, and if
-C<PERL_JSON_BACKEND> environment variable exists, is true and is not
-"JSON::PP", then the L<JSON> module (version 2.5 or greater) will be loaded and
-used to interpret C<PERL_JSON_BACKEND>.  If L<JSON> is not installed or is too
-old, an exception will be thrown.  Note that at the time of writing, the only
-useful values are 1, which will tell L<JSON> to guess, or L<JSON::XS> - if
-you want to use a newer JSON module, see L</CPAN_META_JSON_BACKEND>.
-
-=head2 PERL_YAML_BACKEND
-
-By default, L<CPAN::Meta::YAML> will be used for deserializing YAML data. If
-the C<PERL_YAML_BACKEND> environment variable is defined, then it is interpreted
-as a module to use for deserialization.  The given module must be installed,
-must load correctly and must implement the C<Load()> function or an exception
-will be thrown.
-
-=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
-
-=head1 SUPPORT
-
-=head2 Bugs / Feature Requests
-
-Please report any bugs or feature requests through the issue tracker
-at L<https://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta/issues>.
-You will be notified automatically of any progress on your issue.
-
-=head2 Source Code
-
-This is open source software.  The code repository is available for
-public review and contribution under the terms of the license.
-
-L<https://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta>
-
-  git clone https://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta.git
-
-=head1 AUTHORS
-
-=over 4
-
-=item *
-
-Adam Kennedy <adamk@cpan.org>
-
-=item *
-
-David Golden <dagolden@cpan.org>
-
-=back
-
-=head1 CONTRIBUTORS
-
-=for stopwords Andreas Koenig David Golden Graham Knop Joshua ben Jore Karen Etheridge Matt S Trout Neil Bowers Ricardo Signes Steffen Mueller
-
-=over 4
-
-=item *
-
-Andreas Koenig <andk@cpan.org>
-
-=item *
-
-David Golden <xdg@xdg.me>
-
-=item *
-
-Graham Knop <haarg@haarg.org>
-
-=item *
-
-Joshua ben Jore <jjore@cpan.org>
-
-=item *
-
-Karen Etheridge <ether@cpan.org>
-
-=item *
-
-Matt S Trout <mst@shadowcat.co.uk>
-
-=item *
-
-Neil Bowers <neil@bowers.com>
-
-=item *
-
-Ricardo Signes <rjbs@cpan.org>
-
-=item *
-
-Steffen Mueller <smueller@cpan.org>
-
-=back
-
-=head1 COPYRIGHT AND LICENSE
-
-This software is copyright (c) 2016 by Adam Kennedy and Contributors.
-
-This is free software; you can redistribute it and/or modify it under
-the same terms as the Perl 5 programming language system itself.
-
-=cut
diff --git a/cpan/Parse-CPAN-Meta/t/02_api.t b/cpan/Parse-CPAN-Meta/t/02_api.t
deleted file mode 100644 (file)
index 3f82fc4..0000000
+++ /dev/null
@@ -1,215 +0,0 @@
-#!/usr/bin/perl
-
-delete $ENV{PERL_YAML_BACKEND};
-delete $ENV{PERL_JSON_BACKEND};
-delete $ENV{CPAN_META_JSON_BACKEND};
-delete $ENV{CPAN_META_JSON_DECODER};
-
-# Testing of a known-bad file from an editor
-
-use strict;
-BEGIN {
-       $|  = 1;
-       $^W = 1;
-}
-
-use lib 't/lib';
-use File::Spec::Functions ':ALL';
-use Parse::CPAN::Meta;
-use Parse::CPAN::Meta::Test;
-# use Test::More skip_all => 'Temporarily ignoring failing test';
-use Test::More 'no_plan';
-use utf8;
-
-#####################################################################
-# Testing that Perl::Smith config files work
-
-my $want = {
-  "abstract" => "a set of version requirements for a CPAN dist",
-  "author"   => [ 'Ricardo Signes <rjbs@cpan.org>' ],
-  "build_requires" => {
-     "Test::More" => "0.88"
-  },
-  "configure_requires" => {
-     "ExtUtils::MakeMaker" => "6.31"
-  },
-  "generated_by" => "Dist::Zilla version 2.100991",
-  "license" => "perl",
-  "meta-spec" => {
-     "url" => "http://module-build.sourceforge.net/META-spec-v1.4.html",
-     "version" => 1.4
-  },
-  "name" => "Version-Requirements",
-  "recommends" => {},
-  "requires" => {
-     "Carp" => "0",
-     "Scalar::Util" => "0",
-     "version" => "0.77"
-  },
-  "resources" => {
-     "repository" => "git://git.codesimply.com/Version-Requirements.git"
-  },
-  "version" => "0.101010",
-  "x_contributors" => [
-    "Dagfinn Ilmari Mannsåker <ilmari\@ilmari.org>",
-  ],
-};
-
-my $meta_json = catfile( test_data_directory(), 'META-VR.json' );
-my $meta_yaml = catfile( test_data_directory(), 'META-VR.yml' );
-my $bare_yaml_meta = catfile( test_data_directory(), 'bareyaml.meta' );
-my $bad_yaml_meta = catfile( test_data_directory(), 'BadMETA.yml' );
-my $CL018_yaml_meta = catfile( test_data_directory(), 'CL018_yaml.meta' );
-
-# These test YAML/JSON detection without the typical file name suffix
-my $yaml_meta = catfile( test_data_directory(), 'yaml.meta' );
-my $json_meta = catfile( test_data_directory(), 'json.meta' );
-
-### YAML tests
-{
-  local $ENV{PERL_YAML_BACKEND}; # ensure we get CPAN::META::YAML
-
-  is(Parse::CPAN::Meta->yaml_backend(), 'CPAN::Meta::YAML', 'yaml_backend(): CPAN::Meta::YAML');
-  my $from_yaml = Parse::CPAN::Meta->load_file( $meta_yaml );
-  is_deeply($from_yaml, $want, "load from YAML file results in expected data");
-}
-
-{
-  local $ENV{PERL_YAML_BACKEND}; # ensure we get CPAN::META::YAML
-
-  note '';
-  is(Parse::CPAN::Meta->yaml_backend(), 'CPAN::Meta::YAML', 'yaml_backend(): CPAN::Meta::YAML');
-  my $from_yaml = Parse::CPAN::Meta->load_file( $yaml_meta );
-  is_deeply($from_yaml, $want, "load from YAML .meta file results in expected data");
-}
-
-{
-  local $ENV{PERL_YAML_BACKEND}; # ensure we get CPAN::META::YAML
-
-  note '';
-  is(Parse::CPAN::Meta->yaml_backend(), 'CPAN::Meta::YAML', 'yaml_backend(): CPAN::Meta::YAML');
-  my $from_yaml = Parse::CPAN::Meta->load_file( $bare_yaml_meta );
-  is_deeply($from_yaml, $want, "load from bare YAML .meta file results in expected data");
-}
-
-{
-  local $ENV{PERL_YAML_BACKEND}; # ensure we get CPAN::META::YAML
-
-  note '';
-  is(Parse::CPAN::Meta->yaml_backend(), 'CPAN::Meta::YAML', 'yaml_backend(): CPAN::Meta::YAML');
-  my $from_yaml = Parse::CPAN::Meta->load_file( $CL018_yaml_meta );
-  like($from_yaml->{x_contributors}[5], qr/Olivier Mengu/, "Open question: what to expect from double encoded UTF-8");
-}
-
-{
-  local $ENV{PERL_YAML_BACKEND}; # ensure we get CPAN::META::YAML
-
-  note '';
-  is(Parse::CPAN::Meta->yaml_backend(), 'CPAN::Meta::YAML', 'yaml_backend(): CPAN::Meta::YAML');
-  my $yaml   = load_ok( $meta_yaml, $meta_yaml, 100, ":encoding(UTF-8)");
-  my $from_yaml = Parse::CPAN::Meta->load_yaml_string( $yaml );
-  is_deeply($from_yaml, $want, "load from YAML str results in expected data");
-}
-
-{
-  local $ENV{PERL_YAML_BACKEND}; # ensure we get CPAN::META::YAML
-
-  note '';
-  is(Parse::CPAN::Meta->yaml_backend(), 'CPAN::Meta::YAML', 'yaml_backend(): CPAN::Meta::YAML');
-  my @yaml   = Parse::CPAN::Meta::LoadFile( $bad_yaml_meta );
-  is($yaml[0]{author}[0], 'Olivier Mengu\xE9', "Bad UTF-8 is replaced");
-}
-
-
-SKIP: {
-  note '';
-  skip "YAML module not installed", 2
-    unless eval "require YAML; 1";
-  local $ENV{PERL_YAML_BACKEND} = 'YAML';
-
-  is(Parse::CPAN::Meta->yaml_backend(), 'YAML', 'yaml_backend(): YAML');
-  my $yaml   = load_ok( $meta_yaml, $meta_yaml, 100, ":encoding(UTF-8)");
-  my $from_yaml = Parse::CPAN::Meta->load_yaml_string( $yaml );
-  is_deeply($from_yaml, $want, "load_yaml_string using PERL_YAML_BACKEND");
-}
-
-### JSON tests
-{
-  # JSON tests with JSON::PP
-  local $ENV{PERL_JSON_BACKEND}; # ensure we get JSON::PP
-
-  note '';
-  is(Parse::CPAN::Meta->json_backend(), 'JSON::PP', 'json_backend(): JSON::PP');
-  my $from_json = Parse::CPAN::Meta->load_file( $meta_json );
-  is_deeply($from_json, $want, "load from JSON file results in expected data");
-}
-
-{
-  # JSON tests with JSON::PP
-  local $ENV{PERL_JSON_BACKEND}; # ensure we get JSON::PP
-
-  note '';
-  is(Parse::CPAN::Meta->json_backend(), 'JSON::PP', 'json_backend(): JSON::PP');
-  my $from_json = Parse::CPAN::Meta->load_file( $json_meta );
-  is_deeply($from_json, $want, "load from JSON .meta file results in expected data");
-}
-
-{
-  # JSON tests with JSON::PP
-  local $ENV{PERL_JSON_BACKEND}; # ensure we get JSON::PP
-
-  note '';
-  is(Parse::CPAN::Meta->json_backend(), 'JSON::PP', 'json_backend(): JSON::PP');
-  my $json   = load_ok( $meta_json, $meta_json, 100, "encoding(UTF-8)");
-  my $from_json = Parse::CPAN::Meta->load_json_string( $json );
-  is_deeply($from_json, $want, "load from JSON str results in expected data");
-}
-
-{
-  # JSON tests with JSON::PP, take 2
-  local $ENV{PERL_JSON_BACKEND} = 0; # request JSON::PP
-
-  note '';
-  is(Parse::CPAN::Meta->json_backend(), 'JSON::PP', 'json_backend(): JSON::PP');
-  my $json   = load_ok( $meta_json, $meta_json, 100, ":encoding(UTF-8)");
-  my $from_json = Parse::CPAN::Meta->load_json_string( $json );
-  is_deeply($from_json, $want, "load_json_string with PERL_JSON_BACKEND = 0");
-}
-
-{
-  # JSON tests with JSON::PP, take 3
-  local $ENV{PERL_JSON_BACKEND} = 'JSON::PP'; # request JSON::PP
-
-  note '';
-  is(Parse::CPAN::Meta->json_backend(), 'JSON::PP', 'json_backend(): JSON::PP');
-  my $json   = load_ok( $meta_json, $meta_json, 100, ":encoding(UTF-8)");
-  my $from_json = Parse::CPAN::Meta->load_json_string( $json );
-  is_deeply($from_json, $want, "load_json_string with PERL_JSON_BACKEND = 'JSON::PP'");
-}
-
-{
-  # JSON tests with fake backend
-  { package MyJSONThingy; $INC{'MyJSONThingy.pm'} = __FILE__; require JSON::PP;
-    sub decode_json { JSON::PP::decode_json(@_) } }
-
-  local $ENV{CPAN_META_JSON_DECODER} = 'MyJSONThingy'; # request fake backend
-
-  note '';
-  is(Parse::CPAN::Meta->json_decoder(), 'MyJSONThingy', 'json_decoder(): MyJSONThingy');
-  my $json   = load_ok( $meta_json, $meta_json, 100, ":encoding(UTF-8)");
-  my $from_json = Parse::CPAN::Meta->load_json_string( $json );
-  is_deeply($from_json, $want, "load_json_string with PERL_JSON_DECODER = 'MyJSONThingy'");
-}
-
-SKIP: {
-  note '';
-  skip "JSON module version 2.5 not installed", 2
-    unless eval "require JSON; JSON->VERSION(2.5); 1";
-  local $ENV{PERL_JSON_BACKEND} = 1;
-
-  is(Parse::CPAN::Meta->json_backend(), 'JSON', 'json_backend(): JSON');
-  my $json   = load_ok( $meta_json, $meta_json, 100, ":encoding(UTF-8)");
-  my $from_json = Parse::CPAN::Meta->load_json_string( $json );
-  is_deeply($from_json, $want, "load_json_string with PERL_JSON_BACKEND = 1");
-}
-
diff --git a/cpan/Parse-CPAN-Meta/t/03_functions.t b/cpan/Parse-CPAN-Meta/t/03_functions.t
deleted file mode 100644 (file)
index 5f6d1d8..0000000
+++ /dev/null
@@ -1,33 +0,0 @@
-#!/usr/bin/perl
-
-delete $ENV{PERL_YAML_BACKEND};
-delete $ENV{PERL_JSON_BACKEND};
-
-# Testing of basic document structures
-
-use strict;
-BEGIN {
-       $|  = 1;
-       $^W = 1;
-}
-
-use Test::More tests => 2;
-use Parse::CPAN::Meta ();
-
-my $one = <<'END_YAML';
----
-- foo
-END_YAML
-
-my $two = <<'END_YAML';
----
-- foo
----
-- bar
-END_YAML
-
-my $one_scalar_tiny = Parse::CPAN::Meta::Load( $one );
-my $two_scalar_tiny = Parse::CPAN::Meta::Load( $two );
-
-is_deeply( $one_scalar_tiny, [ 'foo' ], 'one: Parsed correctly' );
-is_deeply( $two_scalar_tiny, [ 'bar' ], 'two: Parsed correctly' );
diff --git a/cpan/Parse-CPAN-Meta/t/04_export.t b/cpan/Parse-CPAN-Meta/t/04_export.t
deleted file mode 100644 (file)
index b4766aa..0000000
+++ /dev/null
@@ -1,22 +0,0 @@
-#!/usr/bin/perl
-
-delete $ENV{PERL_YAML_BACKEND};
-delete $ENV{PERL_JSON_BACKEND};
-
-# Testing of basic document structures
-
-use strict;
-BEGIN {
-       $|  = 1;
-       $^W = 1;
-}
-
-use Test::More tests => 4;
-use Parse::CPAN::Meta;
-
-
-
-ok not(defined &main::Load), 'Load is not exported';
-ok not(defined &main::Dump), 'Dump is not exported';
-ok not(defined &main::LoadFile), 'LoadFile is not exported';
-ok not(defined &main::DumpFile), 'DumpFile is not exported';
diff --git a/cpan/Parse-CPAN-Meta/t/05_errors.t b/cpan/Parse-CPAN-Meta/t/05_errors.t
deleted file mode 100644 (file)
index 671d73b..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
-#!/usr/bin/perl
-
-delete $ENV{PERL_YAML_BACKEND};
-delete $ENV{PERL_JSON_BACKEND};
-
-# Testing of basic document structures
-
-use strict;
-BEGIN {
-       $|  = 1;
-       $^W = 1;
-}
-
-use Test::More tests => 1;
-use Parse::CPAN::Meta ();
-
-my $one = <<'END_YAML';
----
-- foo: - bar
-END_YAML
-
-my $one_scalar_tiny = eval { Parse::CPAN::Meta->load_yaml_string( $one ) };
-like( $@, '/illegal characters/', "error causes exception");
-
diff --git a/cpan/Parse-CPAN-Meta/t/lib/Parse/CPAN/Meta/Test.pm b/cpan/Parse-CPAN-Meta/t/lib/Parse/CPAN/Meta/Test.pm
deleted file mode 100644 (file)
index e63920b..0000000
+++ /dev/null
@@ -1,85 +0,0 @@
-package Parse::CPAN::Meta::Test;
-
-use strict;
-use Test::More ();
-use Parse::CPAN::Meta;
-use File::Spec;
-
-use vars qw{@ISA @EXPORT};
-BEGIN {
-       require Exporter;
-       @ISA    = qw{ Exporter };
-       @EXPORT = qw{
-               tests  yaml_ok  yaml_error  slurp  load_ok
-               test_data_directory
-       };
-}
-
-sub test_data_directory {
-       return( "corpus" );
-}
-
-# 22 tests per call to yaml_ok
-# 4  tests per call to load_ok
-sub tests {
-       return ( tests => count(@_) );
-}
-
-sub count {
-       my $yaml_ok = shift || 0;
-       my $load_ok = shift || 0;
-       my $single  = shift || 0;
-       my $count   = $yaml_ok * 3 + $load_ok * 4 + $single;
-       return $count;
-}
-
-sub yaml_ok {
-       my $string  = shift;
-       my $array   = shift;
-       my $name    = shift || 'unnamed';
-
-       # Does the string parse to the structure
-       my $yaml_copy = $string;
-       my @yaml      = eval { Parse::CPAN::Meta::Load( $yaml_copy ); };
-       Test::More::is( $@, '', "$name: Parse::CPAN::Meta parses without error" );
-       Test::More::is( $yaml_copy, $string, "$name: Parse::CPAN::Meta does not modify the input string" );
-       SKIP: {
-               Test::More::skip( "Shortcutting after failure", 1 ) if $@;
-               Test::More::is_deeply( \@yaml, $array, "$name: Parse::CPAN::Meta parses correctly" );
-       }
-
-       # Return true as a convenience
-       return 1;
-}
-
-sub yaml_error {
-       my $string = shift;
-       my $yaml   = eval { Parse::CPAN::Meta::Load( $string ); };
-       Test::More::like( $@, qr/$_[0]/, "CPAN::Meta::YAML throws expected error" );
-}
-
-sub slurp {
-       my $file = shift;
-       my $layer = shift;
-       $layer = "" unless defined $layer;
-       local $/ = undef;
-       open my $fh, "<$layer", $file or die "open($file) failed: $!";
-       my $source = <$fh>;
-       close( $fh ) or die "close($file) failed: $!";
-       $source;
-}
-
-sub load_ok {
-       my $name = shift;
-       my $file = shift;
-       my $size = shift;
-       my $layer = shift;
-       Test::More::ok( -f $file, "Found $name" ) or Test::More::diag("Searched at '$file'");
-       Test::More::ok( -r $file, "Can read $name" );
-       my $content = slurp( $file, $layer );
-       Test::More::ok( (defined $content and ! ref $content), "Loaded $name" );
-       Test::More::ok( ($size < length $content), "Content of $name larger than $size bytes" );
-       return $content;
-}
-
-1;
index 84f6624f36823e79554efb9f3636383061099aba..1999f018efd888ebacfc74004792d5f09c7d147a 100644 (file)
@@ -12,8 +12,7 @@ use File::Spec::Functions qw(catfile catdir splitdir);
 use vars qw($VERSION @Pagers $Bindir $Pod2man
   $Temp_Files_Created $Temp_File_Lifetime
 );
-$VERSION = '3.25_02'; # patched in perl5.git
-$VERSION =~ s/_//;
+$VERSION = '3.27';
 
 #..........................................................................
 
@@ -285,7 +284,8 @@ Options:
     -m   Display module's file in its entirety
     -n   Specify replacement for groff
     -l   Display the module's file name
-    -F   Arguments are file names, not modules
+    -U   Don't attempt to drop privs for security
+    -F   Arguments are file names, not modules (implies -U)
     -D   Verbosely describe what's going on
     -T   Send output to STDOUT without any pager
     -d output_filename_to_send_to
@@ -393,7 +393,7 @@ sub usage_brief {
   my $program_name = $self->program_name;
 
   CORE::die( <<"EOUSAGE" );
-Usage: $program_name [-hVriDtumFXlT] [-n nroffer_program]
+Usage: $program_name [-hVriDtumUFXlT] [-n nroffer_program]
     [-d output_filename] [-o output_format] [-M FormatterModule]
     [-w formatter_option:option_value] [-L translation_code]
     PageName|ModuleName|ProgramName
@@ -486,7 +486,8 @@ sub init_formatter_class_list {
 
   $self->opt_M_with('Pod::Perldoc::ToPod');   # the always-there fallthru
   $self->opt_o_with('text');
-  $self->opt_o_with('term') unless $self->is_mswin32 || $self->is_dos || $self->is_amigaos
+  $self->opt_o_with('term') 
+    unless $self->is_mswin32 || $self->is_dos || $self->is_amigaos
        || !($ENV{TERM} && (
               ($ENV{TERM} || '') !~ /dumb|emacs|none|unknown/i
            ));
@@ -521,7 +522,7 @@ sub process {
     $self->options_reading;
     $self->pagers_guessing;
     $self->aside(sprintf "$0 => %s v%s\n", ref($self), $self->VERSION);
-    $self->drop_privs_maybe unless $self->opt_U;
+    $self->drop_privs_maybe unless ($self->opt_U || $self->opt_F);
     $self->options_processing;
 
     # Hm, we have @pages and @found, but we only really act on one
@@ -575,6 +576,9 @@ sub find_good_formatter_class {
   my @class_list = @{ $self->{'formatter_classes'} || [] };
   $self->die( "WHAT?  Nothing in the formatter class list!?" ) unless @class_list;
 
+  local @INC = @INC;
+  pop @INC if $INC[-1] eq '.';
+
   my $good_class_found;
   foreach my $c (@class_list) {
     DEBUG > 4 and print "Trying to load $c...\n";
@@ -1006,6 +1010,8 @@ sub new_translator { # $tr = $self->new_translator($lang);
     my $self = shift;
     my $lang = shift;
 
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
     my $pack = 'POD2::' . uc($lang);
     eval "require $pack";
     if ( !$@ && $pack->can('new') ) {
@@ -1321,7 +1327,7 @@ sub search_perlfunc {
     local $_;
     while (<$fh>) {
         /^=encoding\s+(\S+)/ && $self->set_encoding($fh, $1);
-        last if /^=head2 $re/;
+        last if /^=head2 (?:$re|Alphabetical Listing of Perl Functions)/;
     }
 
     # Look for our function
@@ -1355,7 +1361,7 @@ sub search_perlfunc {
                 last if $found > 1 and $inlist < 2;
             }
         }
-        elsif (/^=item/) {
+        elsif (/^=item|^=back/) {
             last if $found > 1 and $inlist < 2;
         }
         elsif ($found and /^X<[^>]+>/) {
@@ -1664,9 +1670,9 @@ sub pagers_guessing {
         push @pagers, qw( less.exe more.com< );
         unshift @pagers, $ENV{PAGER}  if $ENV{PAGER};
     }
-    elsif ( $self->is_amigaos) {
-        push @pagers, qw( /SYS/Utilities/MultiView /SYS/Utilities/More /C/TYPE );
-        unshift @pagers, "$ENV{PAGER}"  if $ENV{PAGER};
+    elsif ( $self->is_amigaos) { 
+      push @pagers, qw( /SYS/Utilities/MultiView /SYS/Utilities/More /C/TYPE );
+      unshift @pagers, "$ENV{PAGER}" if $ENV{PAGER}; 
     }
     else {
         if ($self->is_os2) {
@@ -1918,19 +1924,21 @@ sub page {  # apply a pager to the output file
         #  many many corners of the OS don't like it.  So we
         #  have to force it to be "\" to make everyone happy.
 
-        # if we are on an amiga convert unix path to an amiga one
-        $output =~ s/^\/(.*)\/(.*)/$1:$2/ if $self->is_amigaos;
+       # if we are on an amiga convert unix path to an amiga one 
+       $output =~ s/^\/(.*)\/(.*)/$1:$2/ if $self->is_amigaos;
 
         foreach my $pager (@pagers) {
             $self->aside("About to try calling $pager $output\n");
             if ($self->is_vms) {
                 last if system("$pager $output") == 0;
-              } elsif($self->is_amigaos) {
+           } elsif($self->is_amigaos) { 
                 last if system($pager, $output) == 0;
             } else {
                 # fix visible escape codes in ToTerm output
                 # https://bugs.debian.org/758689
                 local $ENV{LESS} = defined $ENV{LESS} ? "$ENV{LESS} -R" : "-R";
+               # On FreeBSD, the default pager is more.
+                local $ENV{MORE} = defined $ENV{MORE} ? "$ENV{MORE} -R" : "-R";
                 last if system("$pager \"$output\"") == 0;
             }
         }
index 304da44ede2f77be47f91b4e38957aeafba33bb8..5bab1e3cbe682d756466429bda31e0850a3bf8a2 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 
 use vars qw($VERSION);
-$VERSION = '3.25';
+$VERSION = '3.27';
 
 use Carp                  qw(croak carp);
 use Config                qw(%Config);
@@ -33,6 +33,7 @@ BEGIN {
  *is_linux   = $^O eq 'linux'    ? \&TRUE : \&FALSE unless defined &is_linux;
  *is_hpux    = $^O =~ m/hpux/    ? \&TRUE : \&FALSE unless defined &is_hpux;
  *is_openbsd = $^O =~ m/openbsd/ ? \&TRUE : \&FALSE unless defined &is_openbsd;
+ *is_freebsd = $^O =~ m/freebsd/ ? \&TRUE : \&FALSE unless defined &is_freebsd;
  *is_bitrig = $^O =~ m/bitrig/ ? \&TRUE : \&FALSE unless defined &is_bitrig;
 }
 
index 71fcc7bc9a2c506dda6102be6c2f604e001c4c7b..e88f0d362e9ab90c9616766de017b171e4b06336 100644 (file)
@@ -2,7 +2,7 @@ package Pod::Perldoc::GetOptsOO;
 use strict;
 
 use vars qw($VERSION);
-$VERSION = '3.25';
+$VERSION = '3.27';
 
 BEGIN { # Make a DEBUG constant ASAP
   *DEBUG = defined( &Pod::Perldoc::DEBUG )
index 26a11d3c80901df28960b990c6dce0a04c7d77a2..aa41423bfe0a3bcd1f14ff7ae4be57eb353e60eb 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 use parent qw(Pod::Perldoc::BaseTo);
 
 use vars qw($VERSION);
-$VERSION = '3.25';
+$VERSION = '3.27';
 
 sub is_pageable        { 1 }
 sub write_with_binmode { 0 }
index 3d161acf51cfdc5b9a7ad516ac2293e1b0cbc37b..7420c454e90ba2cccc58ebf79b912f954d4e2adb 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 use vars qw(@ISA);
 
 use vars qw($VERSION);
-$VERSION = '3.25';
+$VERSION = '3.27';
 
 # Pick our superclass...
 #
index e22e05044d1985a37eb34993b387dc2dec68552f..6e18b3714d4bc1d55d598182caae6aef0f5cb62d 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 use parent qw(Pod::Perldoc::BaseTo);
 
 use vars qw($VERSION);
-$VERSION = '3.25';
+$VERSION = '3.27';
 
 use File::Spec::Functions qw(catfile);
 use Pod::Man 2.18;
@@ -63,7 +63,7 @@ sub init {
 sub _roffer_candidates {
        my( $self ) = @_;
 
-       if( $self->is_openbsd || $self->is_bitrig ) { qw( mandoc groff nroff ) }
+       if( $self->is_openbsd || $self->is_freebsd || $self->is_bitrig ) { qw( mandoc groff nroff ) }
        else                    { qw( groff nroff mandoc ) }
        }
 
index ac4a8aa17d4dda60d304a821f3d6edf1206d8f28..ec9dc2222f764a4022bca2a91eca6d133a799588 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 use parent qw(Pod::Perldoc::BaseTo);
 
 use vars qw($VERSION);
-$VERSION = '3.25';
+$VERSION = '3.27';
 
 # This is unlike ToMan.pm in that it emits the raw nroff source!
 
index 8433e8ca40936cc146d3fa28a76ec9f34f05b7b4..0eda0af43fd9c7dea1e995d588995e620d92e9d7 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 use parent qw(Pod::Perldoc::BaseTo);
 
 use vars qw($VERSION);
-$VERSION = '3.25';
+$VERSION = '3.27';
 
 sub is_pageable        { 1 }
 sub write_with_binmode { 0 }
index 81f019f8a20873f2c3356712bc5c1ddeaae45df0..69bc25426c1a4182ff0f98a9533bbd7134bfadd6 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 use parent qw( Pod::Simple::RTF );
 
 use vars qw($VERSION);
-$VERSION = '3.25';
+$VERSION = '3.27';
 
 sub is_pageable        { 0 }
 sub write_with_binmode { 0 }
index e97a775e10e69297b3cfdffab4c8276d13632646..64cfb0113552849d2583908eb86d873e43783aea 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 
 use vars qw($VERSION);
-$VERSION = '3.25';
+$VERSION = '3.27';
 
 use parent qw(Pod::Perldoc::BaseTo);
 
index dbd47438d3a37ac160267616af01da2b815a20fc..cdaaa4964da39e5e3b53791b43805ddc6cccce77 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 
 use vars qw($VERSION);
-$VERSION = '3.25';
+$VERSION = '3.27';
 
 use parent qw(Pod::Perldoc::BaseTo);
 
index 40b51c5b438f3cb81721be600000edd05a5b582e..727b31261494d5e8a99323a737cfe12135ccde26 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 
 use vars qw($VERSION);
-$VERSION = '3.25';
+$VERSION = '3.27';
 
 use parent qw(Pod::Perldoc::BaseTo);
 
index 9da514f7f6118b9d45ba1dd558b984ea86f13047..ca1ab3c05075ef1da339027ea7b27a0f73b6f6ba 100644 (file)
@@ -6,7 +6,7 @@ use vars qw($VERSION);
 use parent qw( Pod::Simple::XMLOutStream );
 
 use vars qw($VERSION);
-$VERSION = '3.25';
+$VERSION = '3.27';
 
 sub is_pageable        { 0 }
 sub write_with_binmode { 0 }
index 79d79cdce37b929bd34ed9ec24378538d916ff34..4cef8f5ef07d07e4523e1c677a5c8a94a92cce83 100644 (file)
@@ -5,7 +5,7 @@ perldoc - Look up Perl documentation in Pod format.
 
 =head1 SYNOPSIS
 
-    perldoc [-h] [-D] [-t] [-u] [-m] [-l] [-F]
+    perldoc [-h] [-D] [-t] [-u] [-m] [-l] [-U] [-F]
         [-i] [-V] [-T] [-r]
         [-d destination_file]
         [-o formatname]
@@ -34,11 +34,10 @@ See below for more description of the switches.
 
 =head1 DESCRIPTION
 
-B<perldoc> looks up a piece of documentation in .pod format that is
-embedded in the perl installation tree or in a perl script, and displays
-it via C<groff -man | $PAGER>. (In addition, if running under HP-UX,
-C<col -x> will be used.) This is primarily used for the documentation for
-the perl library modules.
+B<perldoc> looks up documentation in .pod format that is embedded in the perl
+installation tree or in a perl script, and displays it using a variety of
+formatters.  This is primarily used for the documentation for the perl library
+modules.
 
 Your system may also have man pages installed for those modules, in
 which case you can probably just use the man(1) command.
@@ -78,9 +77,17 @@ the file for you and simply hand it off for display.
 
 Display onB<l>y the file name of the module found.
 
+=item B<-U>
+
+When running as the superuser, don't attempt drop privileges for security.
+This option is implied with B<-F>.
+
+B<NOTE>: Please see the heading SECURITY below for more information.
+
 =item B<-F>
 
 Consider arguments as file names; no search in directories will be performed.
+Implies B<-U> if run as the superuser.
 
 =item B<-f> I<perlfunc>
 
@@ -229,6 +236,13 @@ drop privileges by setting the effective and real IDs to nobody's
 or nouser's account, or -2 if unavailable.  If it cannot relinquish
 its privileges, it will not run.
 
+See the C<-U> option if you do not want this behavior but B<beware>
+that there are significant security risks if you choose to use C<-U>.
+
+Since 3.26, using C<-F> as the superuser also implies C<-U> as opening
+most files and traversing directories requires privileges that are
+above the nobody/nogroup level.
+
 =head1 ENVIRONMENT
 
 Any switches in the C<PERLDOC> environment variable will be used before the
diff --git a/cpan/Pod-Perldoc/t/00_load.t b/cpan/Pod-Perldoc/t/00_load.t
new file mode 100644 (file)
index 0000000..936f8a4
--- /dev/null
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+my @classes = ('Pod::Perldoc', map { "Pod::Perldoc::$_" } qw(
+    BaseTo       ToChecker    ToNroff      ToRtf        
+    GetOptsOO    ToMan        ToPod        ToText       ToXml
+    ToANSI       ToTerm
+) );
+
+if( eval { require Tk; require Tk::Pod; 1 } ) { push @classes, 'Pod::Perldoc::ToTk' }
+else {
+       note "Skip testing Pod::Perldoc::ToTk because there's no Tk";
+       }
+
+plan tests => scalar @classes;
+
+foreach my $class ( @classes ) {
+       require_ok( $class );
+       my $version = do { no strict 'refs'; ${ '$' . $class . '::VERSION' } };
+       note( "$class $version" ) if defined $version
+       }
diff --git a/cpan/Pod-Perldoc/t/01_about_verbose.t b/cpan/Pod-Perldoc/t/01_about_verbose.t
new file mode 100644 (file)
index 0000000..de0fcad
--- /dev/null
@@ -0,0 +1,79 @@
+use Test::More tests => 1;
+
+pass();
+
+__END__
+
+BEGIN {
+    use_ok 'Pod::Perldoc';
+}
+
+{
+  my @out;
+  push @out,
+    "\n\nPerl v",
+    defined($^V) ? sprintf('%vd', $^V) : $],
+    " under $^O ",
+    (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber())
+      ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (),
+    (defined $MacPerl::Version)
+      ? ("(MacPerl version $MacPerl::Version)") : (),
+    "\n"
+  ;
+
+  # Ugly code to walk the symbol tables:
+  my %v;
+  my @stack = ('');  # start out in %::
+  my $this;
+  my $count = 0;
+  my $pref;
+  while(@stack) {
+    $this = shift @stack;
+    die "Too many packages?" if ++$count > 1000;
+    next if exists $v{$this};
+    next if $this eq 'main'; # %main:: is %::
+
+    #print "Peeking at $this => ${$this . '::VERSION'}\n";
+    
+    if(defined ${$this . '::VERSION'} ) {
+      $v{$this} = ${$this . '::VERSION'}
+    } elsif(
+       defined *{$this . '::ISA'} or defined &{$this . '::import'}
+       or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"})
+       # If it has an ISA, an import, or any subs...
+    ) {
+      # It's a class/module with no version.
+      $v{$this} = undef;
+    } else {
+      # It's probably an unpopulated package.
+      ## $v{$this} = '...';
+    }
+    
+    $pref = length($this) ? "$this\::" : '';
+    push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this . '::'};
+    #print "Stack: @stack\n";
+  }
+  push @out, " Modules in memory:\n";
+  delete @v{'', '[none]'};
+  foreach my $p (sort {lc($a) cmp lc($b)} keys %v) {
+    $indent = ' ' x (2 + ($p =~ tr/:/:/));
+    push @out,  '  ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n";
+  }
+  push @out, sprintf "[at %s (local) / %s (GMT)]\n",
+    scalar(gmtime), scalar(localtime);
+  my $x = join '', @out;
+  $x =~ s/^/#/mg;
+  print $x;
+}
+
+print "# Running",
+  (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n",
+  "#\n",
+;
+
+print "# \@INC:\n", map("#   [$_]\n", @INC), "#\n#\n";
+
+print "# \%INC:\n";
+foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) {
+  print "#   [$x] = [", $INC{$x} || '', "]\n";
+}
diff --git a/cpan/Pod-Perldoc/t/load.t b/cpan/Pod-Perldoc/t/load.t
deleted file mode 100644 (file)
index 936f8a4..0000000
+++ /dev/null
@@ -1,23 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-
-my @classes = ('Pod::Perldoc', map { "Pod::Perldoc::$_" } qw(
-    BaseTo       ToChecker    ToNroff      ToRtf        
-    GetOptsOO    ToMan        ToPod        ToText       ToXml
-    ToANSI       ToTerm
-) );
-
-if( eval { require Tk; require Tk::Pod; 1 } ) { push @classes, 'Pod::Perldoc::ToTk' }
-else {
-       note "Skip testing Pod::Perldoc::ToTk because there's no Tk";
-       }
-
-plan tests => scalar @classes;
-
-foreach my $class ( @classes ) {
-       require_ok( $class );
-       my $version = do { no strict 'refs'; ${ '$' . $class . '::VERSION' } };
-       note( "$class $version" ) if defined $version
-       }
index 0cfc7495383f83a74b3a7e5020a7543832f71390..549a56ad8bd24ca78101671e067e2e2867089a39 100644 (file)
@@ -15,7 +15,7 @@ require 5.005;
 
 
 {   no strict 'vars';
-    $VERSION = '0.34';
+    $VERSION = '0.34_01';
 
     %EXPORT_TAGS = (
         standard => [qw(openlog syslog closelog setlogmask)],
@@ -918,6 +918,8 @@ sub silent_eval (&) {
 sub can_load {
     my ($module, $verbose) = @_;
     local($SIG{__DIE__}, $SIG{__WARN__}, $@);
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
     my $loaded = eval "use $module; 1";
     warn $@ if not $loaded and $verbose;
     return $loaded
index 6637cc444622b60a2871bc2e3a1d82e3c0ae1b45..d71b2387d93b1fc34be6e12c589a669e7220953f 100644 (file)
@@ -1,5 +1,6 @@
 #!/usr/bin/perl -w
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use strict;
 use warnings;
 use App::Prove;
index c32165920fff3f2d95700b72ed0f212ca90c03a9..32eb59c2a5c80b83bc41bd2959e4547b013b32b7 100644 (file)
@@ -22,7 +22,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index fbd478688e225afba7c1629e56f3dba925c564c5..e352fb3f4a51a1bb5aa1a36ebbb889093e09211d 100644 (file)
@@ -29,7 +29,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 4d4b991d1d5c167117ac1f4bd14a0b48ce4037ed..931e52b1d958680faa65b06edd9f55aaaa35c491 100644 (file)
@@ -18,7 +18,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 3b2fc720c6ddc48df299363ac44f236a7b305ba1..4819ed8218321c54a2ca35f75cba80e1dacca44a 100644 (file)
@@ -13,7 +13,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index a02f60a66334511376881fdd425bb9e388a4c4d5..e6ea22d6ecd81fefbfc67a6f57d51a8d16329c5b 100644 (file)
@@ -16,7 +16,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 use constant GOT_TIME_HIRES => do {
     eval 'use Time::HiRes qw(time);';
index 9594a29928da2502cb789e9d7f283a42fa9f68bf..a2fa3ea765fb3fadf71cd263596a504a64405c76 100644 (file)
@@ -62,7 +62,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 43084d141a646475a2cdd337f672e59cd6fcc928..728247c07d7846f807984a33084d0f6425cb2839 100644 (file)
@@ -75,7 +75,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 90d092bcedace88c941bc0567fff2b19ce9448d3..8cc3060dac37ae2236afba0d0c70479fe9b7603c 100644 (file)
@@ -15,7 +15,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 80736fc083eb5de70ebedb347f82e1c3466b0dac..c8cdf7c998d452b987fa518744f9c23dc4c82a2e 100644 (file)
@@ -45,7 +45,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index c6a4fe3974f14c1239b9634e409bd1dc7ad076c9..8a15812f3d89b3497406b9856c34ffb023d4103a 100644 (file)
@@ -30,7 +30,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 455e7123e75b978661d5a239669f13db82c8ae5f..45d93a1860eca37466c673c379ac8e0ea3797b7a 100644 (file)
@@ -17,7 +17,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 7671fa9f2687fc352c7deedf92e059af5bb8c003..371d7d56c63eee968b010077a3c628fb263f6fdb 100644 (file)
@@ -14,7 +14,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index b5dc504e263005e91787b1872c108cf83f627c5c..2924276f331f44ff84e1db9014dbd7f20f619fc7 100644 (file)
@@ -27,7 +27,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 METHODS
 
index e66ffc77890a9d4c9f4cb495c8560b5a6cdb1e84..c916a32edd0fc71aaebe1f858a2179edd890390b 100644 (file)
@@ -20,7 +20,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 $ENV{HARNESS_ACTIVE}  = 1;
 $ENV{HARNESS_VERSION} = $VERSION;
index 4307179a0bcbca8eaca4e0c1a4e4c7055b6b0af2..0a328da76a74cb8eb890a86c30fcc38bd199d4aa 100644 (file)
@@ -7,7 +7,7 @@ use constant IS_VMS => ( $^O eq 'VMS' );
 use TAP::Object;
 use Text::ParseWords qw/shellwords/;
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 # Get the parts of @INC which are changed from the stock list AND
 # preserve reordering of stock directories.
index fd7044f524b29520dc27502d554e77b2083dac2d..5195bd7f26c7c7dd2e930189a42b264972100a4c 100644 (file)
@@ -13,7 +13,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index 53d5afee9f96000fc8c965dc67fe5b8e70ac0c4e..f688c722f06a95f8b363c1d36daca75e083e58a3 100644 (file)
@@ -31,7 +31,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 my $DEFAULT_TAP_VERSION = 12;
 my $MAX_TAP_VERSION     = 13;
index 099bcbbfb9665042c1891cebd4f1beba70d0dce7..94289a44c85c1217a636d83e24d3d2a3bbf7ebf1 100644 (file)
@@ -16,7 +16,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index a64064682c6eafddc6f41c2ca491ee6fedcec354..e4ab7b4ecc154c2b4cb7b8f4351b7fd9cb2ba51e 100644 (file)
@@ -18,7 +18,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index bfdb3e1d10b31bcd8900ed077c78a4086fc0bdf4..93b8a7f5d0884e348c1d82cc17d07aced3e3bb8d 100644 (file)
@@ -15,7 +15,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index a8467e69ef95e4ce9a21ab44aa11cd684df86ce0..ce7000beaa37794b36b1b9f31a0d130afdb0f061 100644 (file)
@@ -15,7 +15,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index a851737cc4551251124c453e639fb5b52164207c..cf842998d22446df671f2258fa836852e52b9143 100644 (file)
@@ -20,7 +20,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index bd319d2f7df7caf2399d8b86c16784c9a8254312..f98527969e037421384dac2bf103910bd06a3b6e 100644 (file)
@@ -15,7 +15,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index 3ee87a5c17280408c98432e5cd2162b8c445fbac..7a80031be033e5a15aef1397e7c0af73e6ffb979 100644 (file)
@@ -20,7 +20,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index a53f8304b3215169f9b7aad1f88c03f3423347cd..55701f84a2d86582c0b7cfea9729f3c50c57d2ca 100644 (file)
@@ -21,7 +21,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index 7a6e24e7cc8ee6496c22750ace4c7dfd916d3e3d..270a24a63c7c4e567b773cdd18953bc2fb24df62 100644 (file)
@@ -28,7 +28,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index 6a6eecfd145f14fb599e858f3314a876d35b10c6..d5c7e8cfdf9730ca9183aa6630ab36229db8d507 100644 (file)
@@ -15,7 +15,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index c9e3c0403c1b70b76684c02730e69bda13918538..a519634436c8394a28f0e198185081be449671e7 100644 (file)
@@ -15,7 +15,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 4a1dbbd8afab5b508554937b05cfdb02f64ab84e..0b2b3362457ef57a52ff0e8b5ec0019c50c3ea15 100644 (file)
@@ -15,7 +15,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 649b4b41caf989ac73aa77503bd4ed2f742a85d5..40380e7c603075223df4de0baaeaf108d5f072d3 100644 (file)
@@ -15,7 +15,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index d91391911de7b00f1f1f83df4ba63993621b55f2..46b63e9ef077355a321b367821119ab84edb77be 100644 (file)
@@ -15,7 +15,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 6b25f33244320dee691e73c83d382df73b725d10..89935239c19e93a377c82ea36aa7c5b4d8bed08e 100644 (file)
@@ -15,7 +15,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 4a1a73d6075ff6091f1315d2e5de631b0e648a9e..28bab595b9fe65dbc0aaf3955b7eb5d32cf7ce0b 100644 (file)
@@ -15,7 +15,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 51bc16ce5f9f787c77ff3ad6c646088cde675aa7..e93b43782dea3894bfc1bc590c597333bf26d309 100644 (file)
@@ -15,7 +15,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 DESCRIPTION
 
index 8c304bd75e3a754bda971223c02a1ec432de033b..c45074d08f876deff01b883b5c3dec89a299241a 100644 (file)
@@ -33,7 +33,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head2 DESCRIPTION
 
index 1f3ada52001a7f1684654ea0964cc80bc147846c..2eea054d5e0ee11d880568cc49d2494cfcde7ef9 100644 (file)
@@ -17,7 +17,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index 162d8a459be0dbb5b83d4765abeffa7fe6010f80..c5bb3544c5d39d8cfca814fdb19725c53b4e1b75 100644 (file)
@@ -14,7 +14,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index bf7fbcb64eec318ea4c2f4722d5dcb61d87e5845..768ade96ef83c16351bd11ee831e49023bea21c7 100644 (file)
@@ -14,7 +14,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index ff1ad24257f72422664320635823aae2a2ba49bd..1b4c2110fc32ae5b56ce04bc91eec4d11fe3e586 100644 (file)
@@ -18,7 +18,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index 1cbd0e804e66db6061b8deb87be6b22610ae1234..e2d1cf960aeeb1b8b5ebc00e4299ff5f061fdd0f 100644 (file)
@@ -16,7 +16,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index b7a9fbde4ec9eb9f0f754d128249fe9596d39ae4..a4df5dabbe2b26800cc8583cce9dc7692015e533 100644 (file)
@@ -20,7 +20,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index 26d0c03acb4d7a05191e5601530c36eab22a49f7..30187a028f3d2b4ab783304bf541579c4dd57e3c 100644 (file)
@@ -20,7 +20,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index a38841dc9feed177f3ced057acc4dde1df852a56..05b8dcb5a87c242ec2655cbd5a04c2be88967302 100644 (file)
@@ -20,7 +20,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index fd153f9d369e283b92f6a80da2a82e4453192707..7d238cd6249e42f3debd83980eade0b14dd8c1ca 100644 (file)
@@ -25,7 +25,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index dddb54bec075c0eccab58a50ec0dc6c7fe2c4da2..6dfc815c5acfe3b989fd14f7586a0d4aeb847eba 100644 (file)
@@ -20,7 +20,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 =head1 SYNOPSIS
 
index dc82d90d6488eadf2deaf6493a7cb9d5483bc68c..3381fa110e28048b7ea72f29086bc8c37f20a9bd 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use base 'TAP::Object';
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 # TODO:
 #   Handle blessed object syntax
index 0b4a744fcafce2d17eddd7dea6658db257ceb43f..4897aa88478ba720251a023bf1b4317029e47e57 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 
 use base 'TAP::Object';
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 my $ESCAPE_CHAR = qr{ [ \x00-\x1f \" ] }x;
 my $ESCAPE_KEY  = qr{ (?: ^\W ) | $ESCAPE_CHAR }x;
index 95d1b4bc887a4a8a31f054a97dd03685de250287..fe9d3049f9f9656c8721a4cd349d043ef20bac85 100644 (file)
@@ -35,7 +35,7 @@ Version 3.36
 
 =cut
 
-our $VERSION = '3.36';
+our $VERSION = '3.36_01';
 
 # Backwards compatibility for exportable variable names.
 *verbose  = *Verbose;
index 2a1be725fd035075c66a69c8db90f10929b23ad1..14804195a2eb9e42ca1e60fe3598fe5f66366a79 100644 (file)
@@ -4,7 +4,7 @@ use 5.006;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 BEGIN {
     if( $] < 5.008 ) {
@@ -1183,6 +1183,7 @@ sub diag {
     my $ctx = $self->ctx;
     $ctx->diag(join '' => map {defined($_) ? $_ : 'undef'} @_);
     $ctx->release;
+    return 0;
 }
 
 
@@ -1193,6 +1194,7 @@ sub note {
     my $ctx = $self->ctx;
     $ctx->note(join '' => map {defined($_) ? $_ : 'undef'} @_);
     $ctx->release;
+    return 0;
 }
 
 
index 389597f58dc360ab5b000cd3db436ca4de515abb..24e8daf9b27244ab1ab132bdb68357e495d21456 100644 (file)
@@ -2,7 +2,7 @@ package Test::Builder::Formatter;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 BEGIN { require Test2::Formatter::TAP; our @ISA = qw(Test2::Formatter::TAP) }
 
index a1434f5392504838d9383f37db1c5f8c20de91a0..f46a7b4d4c546c4f307ff81dac11ed586a962462 100644 (file)
@@ -7,7 +7,7 @@ use Test::Builder;
 require Exporter;
 our @ISA = qw(Exporter);
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 =head1 NAME
index de5e5e6f18648626e624b6e4c029f642d50c655b..4622d5f71bd2ac795270e98d5e3d4787b463f4cd 100644 (file)
@@ -1,7 +1,7 @@
 package Test::Builder::Tester;
 
 use strict;
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 use Test::Builder;
 use Symbol;
index c28e5ad62485d2e077d055b0ebb61fec62732bc8..3f151ff51bb1e8ee7672edc147f21a194a32bf17 100644 (file)
@@ -1,7 +1,7 @@
 package Test::Builder::Tester::Color;
 
 use strict;
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 require Test::Builder::Tester;
 
index b716af93564cc3d010408af4961d1f4e5221040d..4f7c85986d77afb6f61ca70342158522c9780473 100644 (file)
@@ -2,7 +2,7 @@ package Test::Builder::TodoDiag;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 BEGIN { require Test2::Event::Diag; our @ISA = qw(Test2::Event::Diag) }
 
index 66208c4f1ab73b135e3a9c083e94479820a6806d..2051993095616b3e7e4ea664659c836096ab0766 100644 (file)
@@ -17,7 +17,7 @@ sub _carp {
     return warn @_, " at $file line $line\n";
 }
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 use Test::Builder::Module;
 our @ISA    = qw(Test::Builder::Module);
index 273eee76dc602e0c79b1c73eca51497cf856538e..54f51a04e937a1c6faede3a5b4fdae8eeadfa412 100644 (file)
@@ -4,7 +4,7 @@ use 5.006;
 
 use strict;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 use Test::Builder::Module;
 our @ISA    = qw(Test::Builder::Module);
index adbaac91cd6707e2152936b675ceac5a5174c055..7efacdf3a3a42207cdee91757fa0b9556f61ded3 100644 (file)
@@ -18,7 +18,7 @@ require Exporter;
 
 use vars qw( @ISA @EXPORT );
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 @EXPORT = qw( run_tests check_tests check_test cmp_results show_space );
 @ISA = qw( Exporter );
index 5a440c7f3945103c955c51d8dd0d63de40e7b61e..abba76af86b8a7033151df817cdfd665b2400127 100644 (file)
@@ -2,7 +2,7 @@ use strict;
 
 package Test::Tester::Capture;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Test::Builder;
index 4c282bf608910562a1e347338fb66b27ae1f16e7..23c65850a541a7f0efe80defffc5b0746e008443 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 
 package Test::Tester::CaptureRunner;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Test::Tester::Capture;
index d3314968aabc22575b355b37917ee0be2eaec404..86f9ac45166c9651972a6a2e090945f037de0478 100644 (file)
@@ -3,7 +3,7 @@ use warnings;
 
 package Test::Tester::Delegate;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use vars '$AUTOLOAD';
index e1e4b98765b649601601f45eeac47b18cde577db..52194bc9820edbd5a01d2dc4487ccdb91859d319 100644 (file)
@@ -1,7 +1,7 @@
 package Test::use::ok;
 use 5.005;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 __END__
index c67ad194fb5c39717526859ea39fd067c70917da..e6c46bc6da878f11fc78dcb23f79bad5c4924384 100644 (file)
@@ -2,7 +2,7 @@ package Test2;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 1;
@@ -124,6 +124,14 @@ L<Test2::Event> - Events live in this namespace.
 L<Test2::Hub> - All events eventually funnel through a hub. Custom hubs are how
 C<intercept()> and C<run_subtest()> are implemented.
 
+=head1 CONTACTING US
+
+Many Test2 developers and users lurk on L<irc://irc.perl.org/#perl>. We also
+have a slack team that can be joined by anyone with an C<@cpan.org> email
+address L<https://perl-test2.slack.com/> If you do not have an C<@cpan.org>
+email you can ask for a slack invite by emailing Chad Granum
+E<lt>exodist@cpan.orgE<gt>.
+
 =head1 SOURCE
 
 The source code repository for Test2 can be found at
index 6f916674e1ae1302824defce0785e7c7edb0629e..23a62da3b25df98837b03c246b21c5fd8104aeca 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 my $INST;
@@ -217,7 +217,7 @@ sub context {
         unless defined wantarray;
 
     my $stack   = $params{stack} || $STACK;
-    my $hub     = $params{hub}   || @$stack ? $stack->[-1] : $stack->top;
+    my $hub     = $params{hub}   || (@$stack ? $stack->[-1] : $stack->top);
     my $hid     = $hub->{hid};
     my $current = $CONTEXTS->{$hid};
 
index 580e0914f79026d9b58ec8bd0e225f9489aaa712..ba633d5052b477d3772e2c084aa0e05d9ebdbb93 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Breakage;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Test2::Util qw/pkg_to_file/;
index 6e9362f8c286e6bb84d18f881c07e51f62a1d4bd..a9f217cd7f09be7749ac804b085155c64521b78a 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Context;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Carp qw/confess croak longmess/;
@@ -412,7 +412,7 @@ inherit it:
 =item you MUST always use the context() sub from Test2::API
 
 Creating your own context via C<< Test2::API::Context->new() >> will almost never
-produce a desirable result. Use C<context()> which is exported by L<Test2>.
+produce a desirable result. Use C<context()> which is exported by L<Test2::API>.
 
 There are a handful of cases where a tool author may want to create a new
 context by hand, which is why the C<new> method exists. Unless you really know
index 7275e18175816e1120d3b31d06d15b0292cf1544..4bf239610e9ceaf1347dda58ea51b2231abcb892 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Instance;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/;
index ec195537aca888c8e6c95ac7f12076990fc96d8f..a24a2a6e618ea7b9269b1afda6e99b9c61e5158a 100644 (file)
@@ -2,7 +2,7 @@ package Test2::API::Stack;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Test2::Hub();
index 83365b567a2f7cd9e3a64076165cb021c3586b6d..0d588027ba5660a5e81d8e327dafeb023126f3aa 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Test2::Util::HashBase qw/trace nested in_subtest subtest_id/;
index 44688b3ee95c85199583163cb3f887e31495b60f..47ce30916c1f29f36454676c269dcb8175277818 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Bail;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index afb4d6f62669da454df041603815fe575dd35f65..df5b702ac460a7d9bcad02b615f6bdce64298e22 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Diag;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 5e914fcc968ed7becf7713effc3e9e84638774bc..a1e9e093cf78352bdb93f5c1182c83010facd9dd 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Exception;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 4a7d332799b170ca1cee4c84c77819e55636fd4a..d7b7a0c45d1a993fe63dd5e25499078ab07e0837 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 use Carp qw/croak/;
 use Scalar::Util qw/reftype/;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
 use Test2::Util::HashBase;
index 029ab548f3aa567daa7bd7a691ba4b0eaac185d8..481f2eb8ce11027d628f492c39993dbb008b463f 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 
 use Scalar::Util qw/blessed/;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
 use Test2::Util::HashBase qw/diagnostics renderer/;
index c2772963b702022b9774bd7663f2a391a54117bd..9f7ad73c67a8d0d9741063f94fd6675ea386db3a 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Note;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 341dc0648fcc8547795a4cf310046955b54ef568..c9a43e7bf8cabf808fe3e2e042faa06c8c024314 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Ok;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 904f6e98670dd9fc489f6f886d2be2a304c9e768..63b222b03aa39f132fb1cfffefacad8f450bc3a8 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Plan;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 9b7aa64f12902ae38b663dedd6a6d22735c6eb14..0dd503768848a2d96e4c7d13ce1f09403386d85d 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Skip;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
index 45ba0f5eaa9acce7422c9d7807962b072e7abcfc..f28bb2f83ded89fe06f533c9261862007ac2df9e 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Subtest;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) }
index 15db583976b5dbf6e20b2a1051a3842dcdb1a3af..12774166e96b2fe48555d7e21afbdadbfbdbec90 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Event::Waiting;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) }
index 77d023d8c9e1cec1e8918a51610f622bb29a489a..aa667edc7e03308f006e25021a7ed0bb2e04f253 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Formatter;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 my %ADDED;
index 09211f05f96da9ff9054ab59374e39313ae9efaa..642821ebdb0180d8d44af2eb9d8c3f6f6dc10a76 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use warnings;
 require PerlIO;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Test2::Util::HashBase qw{
index 707c585ae0e9562b3eebeac801f62aad4f8d0110..c68f15fad1ba6da647acb58b7811814391856476 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Carp qw/carp croak confess/;
@@ -23,6 +23,7 @@ use Test2::Util::HashBase qw{
     _context_init
     _context_release
 
+    active
     count
     failed
     ended
@@ -329,9 +330,10 @@ sub finalize {
     my $plan   = $self->{+_PLAN};
     my $count  = $self->{+COUNT};
     my $failed = $self->{+FAILED};
+    my $active = $self->{+ACTIVE};
 
     # return if NOTHING was done.
-    return unless $do_plan || defined($plan) || $count || $failed;
+    return unless $active || $do_plan || defined($plan) || $count || $failed;
 
     unless ($self->{+ENDED}) {
         if ($self->{+_FOLLOW_UPS}) {
@@ -719,6 +721,15 @@ This can be used to disable auto-ending behavior for a hub. The auto-ending
 behavior is triggered by an end block and is used to cull IPC events, and
 output the final plan if the plan was 'no_plan'.
 
+=item $bool = $hub->active
+
+=item $hub->set_active($bool)
+
+These are used to get/set the 'active' attribute. When true this attribute will
+force C<< hub->finalize() >> to take action even if there is no plan, and no
+tests have been run. This flag is useful for plugins that add follow-up
+behaviors that need to run even if no events are seen.
+
 =back
 
 =head2 STATE METHODS
index f81284db7a005d9dce240d089425beaaf3475b41..2a6e47501a4915ac57c87c026a15f9b1455e4355 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub::Interceptor;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Test2::Hub::Interceptor::Terminator();
index 166627482ae7aedaff60a3869a4ec14dd6dcb5df..1cedfaeb31e2990b2f94c3f5cf775fbe762236e9 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub::Interceptor::Terminator;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 1;
index 835090a6d2ee2bac7549a31736051ee180a4e1c0..5a84e823968097d7681a9147465789cb749cb457 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Hub::Subtest;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) }
index c09293a050ff84ae9ea7af6509437483e3aef4b0..7e5af9cc013618e898838d90cb43b3faa3295685 100644 (file)
@@ -2,7 +2,7 @@ package Test2::IPC;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Test2::API::Instance;
index 521e4ce98f48e5873c9076f88bd89dd025647b40..e889cd97ce7af9d59f9902216dba7b0ec69fab15 100644 (file)
@@ -2,7 +2,7 @@ package Test2::IPC::Driver;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Carp qw/confess longmess/;
index 7cf62c8648ee5839f7d5ab96918a78c0af053c23..344e9e4d7a7dea0770f761893cb53375dcd8ef49 100644 (file)
@@ -2,7 +2,7 @@ package Test2::IPC::Driver::Files;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) }
index c44a752422c946f68e8e540c7813244d5c8794e8..268a4b0104ac7e4d5f763e758fe806cc73d79357 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Config qw/%Config/;
index e7555e3258eca81335b0c86297a3a86cac843670..31972c6ecd75b86ba4f62f2152852121679c384d 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util::ExternalMeta;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Carp qw/croak/;
index 112138503df2fb9b76ed27abf7b3a304ae186453..c91d1c7c72156068243aee19778e868221dfd343 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util::HashBase;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 require Carp;
index 0dc99fe6b1d63c05a543bc5354f08d56d1b4718d..6654589bd05825e20845429f6cbdf02ee9cfc83a 100644 (file)
@@ -2,7 +2,7 @@ package Test2::Util::Trace;
 use strict;
 use warnings;
 
-our $VERSION = '1.302045';
+our $VERSION = '1.302052';
 
 
 use Test2::Util qw/get_tid/;
index 5f3dd1cdfadf457ac235d0d7327bc985970ba48a..7ee3ae959975b52994890e2599b1a56452625d59 100644 (file)
@@ -1,5 +1,5 @@
 package ok;
-$ok::VERSION = '1.302045';
+$ok::VERSION = '1.302052';
 
 use strict;
 use Test::More ();
index c916d2a159156d202a1f80acaaa9599dc7c685d5..c206c04d6dafb25bf73bdb50c1e6f05f8dda1bd1 100644 (file)
@@ -236,6 +236,14 @@ sub {
 }->();
 
 
+sub {
+    my $hub = Test2::Hub->new();
+    my $ctx = context(hub => $hub);
+    is($ctx->hub,$hub, 'got the hub of context() argument');
+    $ctx->release;
+}->();
+
+
 my $sub = sub { };
 
 Test2::API::test2_add_callback_context_acquire($sub);
diff --git a/cpan/Test-Simple/t/regression/694_note_diag_return_values.t b/cpan/Test-Simple/t/regression/694_note_diag_return_values.t
new file mode 100644 (file)
index 0000000..0c72a6f
--- /dev/null
@@ -0,0 +1,20 @@
+use Test::More;
+use strict;
+use warnings;
+
+use Test2::API qw/intercept/;
+
+my @returns;
+intercept {
+    push @returns => diag('foo');
+    push @returns => note('foo');
+
+    my $tb = Test::Builder->new;
+    push @returns => $tb->diag('foo');
+    push @returns => $tb->note('foo');
+};
+
+is(@returns, 4, "4 return values");
+is_deeply(\@returns, [0, 0, 0, 0], "All note/diag returns are 0");
+
+done_testing;
index ecdedef3dd88e7461c9a8b3a7051f588b84d37ee..60739405893255316108bfeaec6886b70b300470 100644 (file)
@@ -1,16 +1,17 @@
 package Time::Local;
 
-require Exporter;
+use strict;
+
 use Carp;
 use Config;
-use strict;
+use Exporter;
+
+our $VERSION = '1.24';
 
-use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
-$VERSION   = '1.2300';
+use parent 'Exporter';
 
-@ISA       = qw( Exporter );
-@EXPORT    = qw( timegm timelocal );
-@EXPORT_OK = qw( timegm_nocheck timelocal_nocheck );
+our @EXPORT    = qw( timegm timelocal );
+our @EXPORT_OK = qw( timegm_nocheck timelocal_nocheck );
 
 my @MonthDays = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
 
@@ -29,9 +30,10 @@ use constant SECS_PER_HOUR   => 3600;
 use constant SECS_PER_DAY    => 86400;
 
 my $MaxDay;
-if ($] < 5.012000) {
+if ( $] < 5.012000 ) {
     my $MaxInt;
     if ( $^O eq 'MacOS' ) {
+
         # time_t is unsigned...
         $MaxInt = ( 1 << ( 8 * $Config{ivsize} ) ) - 1;
     }
@@ -43,22 +45,23 @@ if ($] < 5.012000) {
 }
 else {
     # recent localtime()'s limit is the year 2**31
-    $MaxDay = 365 * (2**31);
+    $MaxDay = 365 * ( 2**31 );
 }
 
 # Determine the EPOC day for this machine
 my $Epoc = 0;
 if ( $^O eq 'vos' ) {
+
     # work around posix-977 -- VOS doesn't handle dates in the range
     # 1970-1980.
     $Epoc = _daygm( 0, 0, 0, 1, 0, 70, 4, 0 );
 }
 elsif ( $^O eq 'MacOS' ) {
-    $MaxDay *=2 if $^O eq 'MacOS';  # time_t unsigned ... quick hack?
-    # MacOS time() is seconds since 1 Jan 1904, localtime
-    # so we need to calculate an offset to apply later
-    $Epoc = 693901;
-    $SecOff = timelocal( localtime(0)) - timelocal( gmtime(0) ) ;
+    $MaxDay *= 2 if $^O eq 'MacOS';    # time_t unsigned ... quick hack?
+          # MacOS time() is seconds since 1 Jan 1904, localtime
+          # so we need to calculate an offset to apply later
+    $Epoc   = 693901;
+    $SecOff = timelocal( localtime(0) ) - timelocal( gmtime(0) );
     $Epoc += _daygm( gmtime(0) );
 }
 else {
@@ -74,22 +77,23 @@ sub _daygm {
     return $_[3] + (
         $Cheat{ pack( 'ss', @_[ 4, 5 ] ) } ||= do {
             my $month = ( $_[4] + 10 ) % 12;
-            my $year  = $_[5] + 1900 - int($month / 10);
+            my $year  = $_[5] + 1900 - int( $month / 10 );
 
             ( ( 365 * $year )
-              + int( $year / 4 )
-              - int( $year / 100 )
-              + int( $year / 400 )
-              + int( ( ( $month * 306 ) + 5 ) / 10 )
-            )
-            - $Epoc;
-        }
+                + int( $year / 4 )
+                    - int( $year / 100 )
+                    + int( $year / 400 )
+                    + int( ( ( $month * 306 ) + 5 ) / 10 ) )
+                - $Epoc;
+            }
     );
 }
 
 sub _timegm {
-    my $sec =
-        $SecOff + $_[0] + ( SECS_PER_MINUTE * $_[1] ) + ( SECS_PER_HOUR * $_[2] );
+    my $sec
+        = $SecOff + $_[0]
+        + ( SECS_PER_MINUTE * $_[1] )
+        + ( SECS_PER_HOUR * $_[2] );
 
     return $sec + ( SECS_PER_DAY * &_daygm );
 }
@@ -109,7 +113,7 @@ sub timegm {
             if $month > 11
             or $month < 0;
 
-    my $md = $MonthDays[$month];
+        my $md = $MonthDays[$month];
         ++$md
             if $month == 1 && _is_leap_year( $year + 1900 );
 
@@ -121,21 +125,22 @@ sub timegm {
 
     my $days = _daygm( undef, undef, undef, $mday, $month, $year );
 
-    unless ($Options{no_range_check} or abs($days) < $MaxDay) {
-        my $msg = '';
+    unless ( $Options{no_range_check} or abs($days) < $MaxDay ) {
+        my $msg = q{};
         $msg .= "Day too big - $days > $MaxDay\n" if $days > $MaxDay;
 
         $year += 1900;
-        $msg .=  "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)";
+        $msg
+            .= "Cannot handle date ($sec, $min, $hour, $mday, $month, $year)";
 
         croak $msg;
     }
 
-    return $sec
-           + $SecOff
-           + ( SECS_PER_MINUTE * $min )
-           + ( SECS_PER_HOUR * $hour )
-           + ( SECS_PER_DAY * $days );
+    return
+          $sec + $SecOff
+        + ( SECS_PER_MINUTE * $min )
+        + ( SECS_PER_HOUR * $hour )
+        + ( SECS_PER_DAY * $days );
 }
 
 sub _is_leap_year {
@@ -152,7 +157,7 @@ sub timegm_nocheck {
 }
 
 sub timelocal {
-    my $ref_t = &timegm;
+    my $ref_t         = &timegm;
     my $loc_for_ref_t = _timegm( localtime($ref_t) );
 
     my $zone_off = $loc_for_ref_t - $ref_t
@@ -167,9 +172,11 @@ sub timelocal {
     # If this evaluates to true, it means that the value in $loc_t is
     # the _second_ hour after a DST change where the local time moves
     # backward.
-    if ( ! $dst_off &&
-         ( ( $ref_t - SECS_PER_HOUR ) - _timegm( localtime( $loc_t - SECS_PER_HOUR ) ) < 0 )
-       ) {
+    if (
+        !$dst_off
+        && ( ( $ref_t - SECS_PER_HOUR )
+            - _timegm( localtime( $loc_t - SECS_PER_HOUR ) ) < 0 )
+        ) {
         return $loc_t - SECS_PER_HOUR;
     }
 
@@ -193,47 +200,56 @@ sub timelocal_nocheck {
 
 1;
 
+# ABSTRACT: Efficiently compute time from local and GMT time
+
 __END__
 
+=pod
+
+=encoding UTF-8
+
 =head1 NAME
 
-Time::Local - efficiently compute time from local and GMT time
+Time::Local - Efficiently compute time from local and GMT time
+
+=head1 VERSION
+
+version 1.24
 
 =head1 SYNOPSIS
 
-    $time = timelocal( $sec, $min, $hour, $mday, $mon, $year );
-    $time = timegm( $sec, $min, $hour, $mday, $mon, $year );
+    use Time::Local;
+
+    my $time = timelocal( $sec, $min, $hour, $mday, $mon, $year );
+    my $time = timegm( $sec, $min, $hour, $mday, $mon, $year );
 
 =head1 DESCRIPTION
 
-This module provides functions that are the inverse of built-in perl
-functions C<localtime()> and C<gmtime()>. They accept a date as a
-six-element array, and return the corresponding C<time(2)> value in
-seconds since the system epoch (Midnight, January 1, 1970 GMT on Unix,
-for example). This value can be positive or negative, though POSIX
-only requires support for positive values, so dates before the
-system's epoch may not work on all operating systems.
+This module provides functions that are the inverse of built-in perl functions
+C<localtime()> and C<gmtime()>. They accept a date as a six-element array, and
+return the corresponding C<time(2)> value in seconds since the system epoch
+(Midnight, January 1, 1970 GMT on Unix, for example). This value can be
+positive or negative, though POSIX only requires support for positive values,
+so dates before the system's epoch may not work on all operating systems.
 
-It is worth drawing particular attention to the expected ranges for
-the values provided. The value for the day of the month is the actual
-day (ie 1..31), while the month is the number of months since January
-(0..11). This is consistent with the values returned from
-C<localtime()> and C<gmtime()>.
+It is worth drawing particular attention to the expected ranges for the values
+provided. The value for the day of the month is the actual day (i.e. 1..31),
+while the month is the number of months since January (0..11). This is
+consistent with the values returned from C<localtime()> and C<gmtime()>.
 
 =head1 FUNCTIONS
 
 =head2 C<timelocal()> and C<timegm()>
 
-This module exports two functions by default, C<timelocal()> and
-C<timegm()>.
+This module exports two functions by default, C<timelocal()> and C<timegm()>.
 
-The C<timelocal()> and C<timegm()> functions perform range checking on
-the input $sec, $min, $hour, $mday, and $mon values by default.
+The C<timelocal()> and C<timegm()> functions perform range checking on the
+input $sec, $min, $hour, $mday, and $mon values by default.
 
 =head2 C<timelocal_nocheck()> and C<timegm_nocheck()>
 
-If you are working with data you know to be valid, you can speed your
-code up by using the "nocheck" variants, C<timelocal_nocheck()> and
+If you are working with data you know to be valid, you can speed your code up
+by using the "nocheck" variants, C<timelocal_nocheck()> and
 C<timegm_nocheck()>. These variants must be explicitly imported.
 
     use Time::Local 'timelocal_nocheck';
@@ -241,144 +257,142 @@ C<timegm_nocheck()>. These variants must be explicitly imported.
     # The 365th day of 1999
     print scalar localtime timelocal_nocheck( 0, 0, 0, 365, 0, 99 );
 
-If you supply data which is not valid (month 27, second 1,000) the
-results will be unpredictable (so don't do that).
+If you supply data which is not valid (month 27, second 1,000) the results
+will be unpredictable (so don't do that).
 
 =head2 Year Value Interpretation
 
-Strictly speaking, the year should be specified in a form consistent
-with C<localtime()>, i.e. the offset from 1900. In order to make the
-interpretation of the year easier for humans, however, who are more
-accustomed to seeing years as two-digit or four-digit values, the
-following conventions are followed:
+Strictly speaking, the year should be specified in a form consistent with
+C<localtime()>, i.e. the offset from 1900. In order to make the interpretation
+of the year easier for humans, however, who are more accustomed to seeing
+years as two-digit or four-digit values, the following conventions are
+followed:
 
 =over 4
 
 =item *
 
-Years greater than 999 are interpreted as being the actual year,
-rather than the offset from 1900. Thus, 1964 would indicate the year
-Martin Luther King won the Nobel prize, not the year 3864.
+Years greater than 999 are interpreted as being the actual year, rather than
+the offset from 1900. Thus, 1964 would indicate the year Martin Luther King
+won the Nobel prize, not the year 3864.
 
 =item *
 
-Years in the range 100..999 are interpreted as offset from 1900, so
-that 112 indicates 2012. This rule also applies to years less than
-zero (but see note below regarding date range).
+Years in the range 100..999 are interpreted as offset from 1900, so that 112
+indicates 2012. This rule also applies to years less than zero (but see note
+below regarding date range).
 
 =item *
 
-Years in the range 0..99 are interpreted as shorthand for years in the
-rolling "current century," defined as 50 years on either side of the
-current year. Thus, today, in 1999, 0 would refer to 2000, and 45 to
-2045, but 55 would refer to 1955. Twenty years from now, 55 would
-instead refer to 2055. This is messy, but matches the way people
-currently think about two digit dates. Whenever possible, use an
-absolute four digit year instead.
+Years in the range 0..99 are interpreted as shorthand for years in the rolling
+"current century," defined as 50 years on either side of the current
+year. Thus, today, in 1999, 0 would refer to 2000, and 45 to 2045, but 55
+would refer to 1955. Twenty years from now, 55 would instead refer to
+2055. This is messy, but matches the way people currently think about two
+digit dates. Whenever possible, use an absolute four digit year instead.
 
 =back
 
-The scheme above allows interpretation of a wide range of dates,
-particularly if 4-digit years are used.
+The scheme above allows interpretation of a wide range of dates, particularly
+if 4-digit years are used.
 
 =head2 Limits of time_t
 
-On perl versions older than 5.12.0, the range of dates that can be
-actually be handled depends on the size of C<time_t> (usually a signed
-integer) on the given platform. Currently, this is 32 bits for most
-systems, yielding an approximate range from Dec 1901 to Jan 2038.
+On perl versions older than 5.12.0, the range of dates that can be actually be
+handled depends on the size of C<time_t> (usually a signed integer) on the
+given platform. Currently, this is 32 bits for most systems, yielding an
+approximate range from Dec 1901 to Jan 2038.
 
-Both C<timelocal()> and C<timegm()> croak if given dates outside the
-supported range.
+Both C<timelocal()> and C<timegm()> croak if given dates outside the supported
+range.
 
-As of version 5.12.0, perl has stopped using the underlying time
-library of the operating system it's running on and has its own
-implementation of those routines with a safe range of at least
-+/ 2**52 (about 142 million years).
+As of version 5.12.0, perl has stopped using the underlying time library of
+the operating system it's running on and has its own implementation of those
+routines with a safe range of at least +/ 2**52 (about 142 million years).
 
 =head2 Ambiguous Local Times (DST)
 
-Because of DST changes, there are many time zones where the same local
-time occurs for two different GMT times on the same day. For example,
-in the "Europe/Paris" time zone, the local time of 2001-10-28 02:30:00
-can represent either 2001-10-28 00:30:00 GMT, B<or> 2001-10-28
-01:30:00 GMT.
+Because of DST changes, there are many time zones where the same local time
+occurs for two different GMT times on the same day. For example, in the
+"Europe/Paris" time zone, the local time of 2001-10-28 02:30:00 can represent
+either 2001-10-28 00:30:00 GMT, B<or> 2001-10-28 01:30:00 GMT.
 
-When given an ambiguous local time, the timelocal() function should
-always return the epoch for the I<earlier> of the two possible GMT
-times.
+When given an ambiguous local time, the timelocal() function should always
+return the epoch for the I<earlier> of the two possible GMT times.
 
 =head2 Non-Existent Local Times (DST)
 
-When a DST change causes a locale clock to skip one hour forward,
-there will be an hour's worth of local times that don't exist. Again,
-for the "Europe/Paris" time zone, the local clock jumped from
-2001-03-25 01:59:59 to 2001-03-25 03:00:00.
+When a DST change causes a locale clock to skip one hour forward, there will
+be an hour's worth of local times that don't exist. Again, for the
+"Europe/Paris" time zone, the local clock jumped from 2001-03-25 01:59:59 to
+2001-03-25 03:00:00.
 
-If the C<timelocal()> function is given a non-existent local time, it
-will simply return an epoch value for the time one hour later.
+If the C<timelocal()> function is given a non-existent local time, it will
+simply return an epoch value for the time one hour later.
 
 =head2 Negative Epoch Values
 
-On perl version 5.12.0 and newer, negative epoch values are fully
-supported.
+On perl version 5.12.0 and newer, negative epoch values are fully supported.
 
-On older versions of perl, negative epoch (C<time_t>) values, which
-are not officially supported by the POSIX standards, are known not to
-work on some systems. These include MacOS (pre-OSX) and Win32.
+On older versions of perl, negative epoch (C<time_t>) values, which are not
+officially supported by the POSIX standards, are known not to work on some
+systems. These include MacOS (pre-OSX) and Win32.
 
-On systems which do support negative epoch values, this module should
-be able to cope with dates before the start of the epoch, down the
-minimum value of time_t for the system.
+On systems which do support negative epoch values, this module should be able
+to cope with dates before the start of the epoch, down the minimum value of
+time_t for the system.
 
 =head1 IMPLEMENTATION
 
-These routines are quite efficient and yet are always guaranteed to
-agree with C<localtime()> and C<gmtime()>. We manage this by caching
-the start times of any months we've seen before. If we know the start
-time of the month, we can always calculate any time within the month.
-The start times are calculated using a mathematical formula. Unlike
-other algorithms that do multiple calls to C<gmtime()>.
+These routines are quite efficient and yet are always guaranteed to agree with
+C<localtime()> and C<gmtime()>. We manage this by caching the start times of
+any months we've seen before. If we know the start time of the month, we can
+always calculate any time within the month.  The start times are calculated
+using a mathematical formula. Unlike other algorithms that do multiple calls
+to C<gmtime()>.
 
-The C<timelocal()> function is implemented using the same cache. We
-just assume that we're translating a GMT time, and then fudge it when
-we're done for the timezone and daylight savings arguments. Note that
-the timezone is evaluated for each date because countries occasionally
-change their official timezones. Assuming that C<localtime()> corrects
-for these changes, this routine will also be correct.
+The C<timelocal()> function is implemented using the same cache. We just
+assume that we're translating a GMT time, and then fudge it when we're done
+for the timezone and daylight savings arguments. Note that the timezone is
+evaluated for each date because countries occasionally change their official
+timezones. Assuming that C<localtime()> corrects for these changes, this
+routine will also be correct.
 
-=head1 BUGS
+=head1 AUTHORS EMERITUS
 
-The whole scheme for interpreting two-digit years can be considered a
-bug.
+This module is based on a Perl 4 library, timelocal.pl, that was
+included with Perl 4.036, and was most likely written by Tom
+Christiansen.
 
-=head1 SUPPORT
+The current version was written by Graham Barr.
 
-Support for this module is provided via the datetime@perl.org email
-list. See http://lists.perl.org/ for more details.
+=head1 BUGS
 
-Please submit bugs to the CPAN RT system at
-http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Time-Local or via email
-at bug-time-local@rt.cpan.org.
+The whole scheme for interpreting two-digit years can be considered a bug.
 
-=head1 COPYRIGHT
+Bugs may be submitted through L<the RT bug tracker|http://rt.cpan.org/Public/Dist/Display.html?Name=Time-Local>
+(or L<bug-time-local@rt.cpan.org|mailto:bug-time-local@rt.cpan.org>).
 
-Copyright (c) 1997-2003 Graham Barr, 2003-2007 David Rolsky.  All
-rights reserved.  This program is free software; you can redistribute
-it and/or modify it under the same terms as Perl itself.
+There is a mailing list available for users of this distribution,
+L<mailto:datetime@perl.org>.
 
-The full text of the license can be found in the LICENSE file included
-with this module.
+I am also usually active on IRC as 'drolsky' on C<irc://irc.perl.org>.
 
 =head1 AUTHOR
 
-This module is based on a Perl 4 library, timelocal.pl, that was
-included with Perl 4.036, and was most likely written by Tom
-Christiansen.
+Dave Rolsky <autarch@urth.org>
 
-The current version was written by Graham Barr.
+=head1 CONTRIBUTOR
+
+=for stopwords Florian Ragwitz
+
+Florian Ragwitz <rafl@debian.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1997 - 2016 by Graham Barr & Dave Rolsky.
 
-It is now being maintained separately from the Perl core by Dave
-Rolsky, <autarch@urth.org>.
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
 
 =cut
index 472e71a2df935ac9510fe3dcd2c2dfea76490d96..634139695f4ecb525dae4d2438721b65053aeeb2 100644 (file)
@@ -8,141 +8,152 @@ use Test::More 0.88;
 use Time::Local;
 
 # Set up time values to test
-my @time =
-  (
-   #year,mon,day,hour,min,sec
-   [1970,  1,  2, 00, 00, 00],
-   [1980,  2, 28, 12, 00, 00],
-   [1980,  2, 29, 12, 00, 00],
-   [1999, 12, 31, 23, 59, 59],
-   [2000,  1,  1, 00, 00, 00],
-   [2010, 10, 12, 14, 13, 12],
-   # leap day
-   [2020,  2, 29, 12, 59, 59],
-   [2030,  7,  4, 17, 07, 06],
-
-# The following test fails on a surprising number of systems
-# so it is commented out. The end of the Epoch for a 32-bit signed
-# implementation of time_t should be Jan 19, 2038  03:14:07 UTC.
-#  [2038,  1, 17, 23, 59, 59],     # last full day in any tz
-
-   [2010, 10, 12, 14, 13, 12.1],
-   [2010, 10, 12, 14, 13, 59.1],
-  );
+my @time = (
+
+    #year,mon,day,hour,min,sec
+    [ 1970, 1,  2,  0,  0,  0 ],
+    [ 1980, 2,  28, 12, 0,  0 ],
+    [ 1980, 2,  29, 12, 0,  0 ],
+    [ 1999, 12, 31, 23, 59, 59 ],
+    [ 2000, 1,  1,  0,  0,  0 ],
+    [ 2010, 10, 12, 14, 13, 12 ],
+
+    # leap day
+    [ 2020, 2, 29, 12, 59, 59 ],
+    [ 2030, 7, 4,  17, 7,  6 ],
+
+    # The following test fails on a surprising number of systems
+    # so it is commented out. The end of the Epoch for a 32-bit signed
+    # implementation of time_t should be Jan 19, 2038  03:14:07 UTC.
+    #  [2038,  1, 17, 23, 59, 59],     # last full day in any tz
+
+    [ 2010, 10, 12, 14, 13, 12.1 ],
+    [ 2010, 10, 12, 14, 13, 59.1 ],
+);
 
 # more than 2**31 time_t - requires a 64bit safe localtime/gmtime
-push @time, [2258,  8, 11,  1, 49, 17]
+push @time, [ 2258, 8, 11, 1, 49, 17 ]
     if $] >= 5.012000;
 
-my @bad_time =
-    (
-     # month too large
-     [1995, 13, 01, 01, 01, 01],
-     # day too large
-     [1995, 02, 30, 01, 01, 01],
-     # hour too large
-     [1995, 02, 10, 25, 01, 01],
-     # minute too large
-     [1995, 02, 10, 01, 60, 01],
-     # second too large
-     [1995, 02, 10, 01, 01, 60],
-    );
+my @bad_time = (
 
-my @neg_time =
-    (
-     # test negative epochs for systems that handle it
-     [ 1969, 12, 31, 16, 59, 59 ],
-     [ 1950, 04, 12, 9, 30, 31 ],
-    );
+    # month too large
+    [ 1995, 13, 1, 1, 1, 1 ],
+
+    # day too large
+    [ 1995, 2, 30, 1, 1, 1 ],
+
+    # hour too large
+    [ 1995, 2, 10, 25, 1, 1 ],
+
+    # minute too large
+    [ 1995, 2, 10, 1, 60, 1 ],
+
+    # second too large
+    [ 1995, 2, 10, 1, 1, 60 ],
+);
+
+my @neg_time = (
+
+    # test negative epochs for systems that handle it
+    [ 1969, 12, 31, 16, 59, 59 ],
+    [ 1950, 4,  12, 9,  30, 31 ],
+);
 
 # Leap year tests
-my @years =
-    (
-     [ 1900 => 0 ],
-     [ 1947 => 0 ],
-     [ 1996 => 1 ],
-     [ 2000 => 1 ],
-     [ 2100 => 0 ],
-    );
+my @years = (
+    [ 1900 => 0 ],
+    [ 1947 => 0 ],
+    [ 1996 => 1 ],
+    [ 2000 => 1 ],
+    [ 2100 => 0 ],
+);
 
 # Use 3 days before the start of the epoch because with Borland on
 # Win32 it will work for -3600 _if_ your time zone is +01:00 (or
 # greater).
-my $neg_epoch_ok = defined ((localtime(-259200))[0]) ? 1 : 0;
+my $neg_epoch_ok = defined( ( localtime(-259200) )[0] ) ? 1 : 0;
 
 # use vmsish 'time' makes for oddness around the Unix epoch
-if ($^O eq 'VMS') {
+if ( $^O eq 'VMS' ) {
     $time[0][2]++;
-    $neg_epoch_ok = 0; # time_t is unsigned
+    $neg_epoch_ok = 0;    # time_t is unsigned
 }
 
-my $epoch_is_64 = eval { $Config{ivsize} == 8 && ( gmtime 2**40 )[5] == 34912 };
+my $epoch_is_64
+    = eval { $Config{ivsize} == 8 && ( gmtime 2**40 )[5] == 34912 };
 
-for (@time, @neg_time) {
-    my($year, $mon, $mday, $hour, $min, $sec) = @$_;
+for ( @time, @neg_time ) {
+    my ( $year, $mon, $mday, $hour, $min, $sec ) = @$_;
     $year -= 1900;
     $mon--;
 
-    SKIP: {
+SKIP: {
         skip '1970 test on VOS fails.', 12
             if $^O eq 'vos' && $year == 70;
         skip 'this platform does not support negative epochs.', 12
-            if $year < 70 && ! $neg_epoch_ok;
+            if $year < 70 && !$neg_epoch_ok;
 
         # Test timelocal()
         {
             my $year_in = $year < 70 ? $year + 1900 : $year;
-            my $time = timelocal($sec,$min,$hour,$mday,$mon,$year_in);
+            my $time = timelocal( $sec, $min, $hour, $mday, $mon, $year_in );
 
-            my($s,$m,$h,$D,$M,$Y) = localtime($time);
+            my ( $s, $m, $h, $D, $M, $Y ) = localtime($time);
 
-            is($s, int($sec), "timelocal second for @$_");
-            is($m, $min, "timelocal minute for @$_");
-            is($h, $hour, "timelocal hour for @$_");
-            is($D, $mday, "timelocal day for @$_");
-            is($M, $mon, "timelocal month for @$_");
-            is($Y, $year, "timelocal year for @$_");
+            is( $s, int($sec), "timelocal second for @$_" );
+            is( $m, $min,      "timelocal minute for @$_" );
+            is( $h, $hour,     "timelocal hour for @$_" );
+            is( $D, $mday,     "timelocal day for @$_" );
+            is( $M, $mon,      "timelocal month for @$_" );
+            is( $Y, $year,     "timelocal year for @$_" );
         }
 
-
         # Test timegm()
         {
             my $year_in = $year < 70 ? $year + 1900 : $year;
-            my $time = timegm($sec,$min,$hour,$mday,$mon,$year_in);
+            my $time = timegm( $sec, $min, $hour, $mday, $mon, $year_in );
 
-            my($s,$m,$h,$D,$M,$Y) = gmtime($time);
+            my ( $s, $m, $h, $D, $M, $Y ) = gmtime($time);
 
-            is($s, int($sec), "timegm second for @$_");
-            is($m, $min, "timegm minute for @$_");
-            is($h, $hour, "timegm hour for @$_");
-            is($D, $mday, "timegm day for @$_");
-            is($M, $mon, "timegm month for @$_");
-            is($Y, $year, "timegm year for @$_");
+            is( $s, int($sec), "timegm second for @$_" );
+            is( $m, $min,      "timegm minute for @$_" );
+            is( $h, $hour,     "timegm hour for @$_" );
+            is( $D, $mday,     "timegm day for @$_" );
+            is( $M, $mon,      "timegm month for @$_" );
+            is( $Y, $year,     "timegm year for @$_" );
         }
     }
 }
 
-
 for (@bad_time) {
-    my($year, $mon, $mday, $hour, $min, $sec) = @$_;
+    my ( $year, $mon, $mday, $hour, $min, $sec ) = @$_;
     $year -= 1900;
     $mon--;
 
-    eval { timegm($sec,$min,$hour,$mday,$mon,$year) };
+    eval { timegm( $sec, $min, $hour, $mday, $mon, $year ) };
 
-    like($@, qr/.*out of range.*/, 'invalid time caused an error');
+    like( $@, qr/.*out of range.*/, 'invalid time caused an error' );
 }
 
 {
-    is(timelocal(0,0,1,1,0,90) - timelocal(0,0,0,1,0,90), 3600,
-       'one hour difference between two calls to timelocal');
+    is(
+        timelocal( 0, 0, 1, 1, 0, 90 ) - timelocal( 0, 0, 0, 1, 0, 90 ), 3600,
+        'one hour difference between two calls to timelocal'
+    );
 
-    is(timelocal(1,2,3,1,0,100) - timelocal(1,2,3,31,11,99), 24 * 3600,
-       'one day difference between two calls to timelocal');
+    is(
+        timelocal( 1, 2, 3, 1, 0, 100 ) - timelocal( 1, 2, 3, 31, 11, 99 ),
+        24 * 3600,
+        'one day difference between two calls to timelocal'
+    );
 
     # Diff beween Jan 1, 1980 and Mar 1, 1980 = (31 + 29 = 60 days)
-    is(timegm(0,0,0, 1, 2, 80) - timegm(0,0,0, 1, 0, 80), 60 * 24 * 3600,
-       '60 day difference between two calls to timegm');
+    is(
+        timegm( 0, 0, 0, 1, 2, 80 ) - timegm( 0, 0, 0, 1, 0, 80 ),
+        60 * 24 * 3600,
+        '60 day difference between two calls to timegm'
+    );
 }
 
 # bugid #19393
@@ -151,18 +162,22 @@ for (@bad_time) {
 # treated like 03:00:00 rather than 01:00:00 - negative zone offsets used
 # to do the latter
 {
-    my $hour = (localtime(timelocal(0, 0, 2, 7, 3, 102)))[2];
+    my $hour = ( localtime( timelocal( 0, 0, 2, 7, 3, 102 ) ) )[2];
+
     # testers in US/Pacific should get 3,
     # other testers should get 2
-    ok($hour == 2 || $hour == 3, 'hour should be 2 or 3');
+    ok( $hour == 2 || $hour == 3, 'hour should be 2 or 3' );
 }
 
 for my $p (@years) {
     my ( $year, $is_leap_year ) = @$p;
 
     my $string = $is_leap_year ? 'is' : 'is not';
-    is( Time::Local::_is_leap_year($year), $is_leap_year,
-        "$year $string a leap year" );
+    ## no critic (Subroutines::ProtectPrivateSubs)
+    is(
+        Time::Local::_is_leap_year($year), $is_leap_year,
+        "$year $string a leap year"
+    );
 }
 
 SKIP:
@@ -170,25 +185,29 @@ SKIP:
     skip 'this platform does not support negative epochs.', 6
         unless $neg_epoch_ok;
 
-    eval { timegm(0,0,0,29,1,1900) };
-    like($@, qr/Day '29' out of range 1\.\.28/,
-         'does not accept leap day in 1900');
+    eval { timegm( 0, 0, 0, 29, 1, 1900 ) };
+    like(
+        $@, qr/Day '29' out of range 1\.\.28/,
+        'does not accept leap day in 1900'
+    );
 
-    eval { timegm(0,0,0,29,1,200) };
-    like($@, qr/Day '29' out of range 1\.\.28/,
-         'does not accept leap day in 2100 (year passed as 200)');
+    eval { timegm( 0, 0, 0, 29, 1, 200 ) };
+    like(
+        $@, qr/Day '29' out of range 1\.\.28/,
+        'does not accept leap day in 2100 (year passed as 200)'
+    );
 
-    eval { timegm(0,0,0,29,1,0) };
-    is($@, '', 'no error with leap day of 2000 (year passed as 0)');
+    eval { timegm( 0, 0, 0, 29, 1, 0 ) };
+    is( $@, q{}, 'no error with leap day of 2000 (year passed as 0)' );
 
-    eval { timegm(0,0,0,29,1,1904) };
-    is($@, '', 'no error with leap day of 1904');
+    eval { timegm( 0, 0, 0, 29, 1, 1904 ) };
+    is( $@, q{}, 'no error with leap day of 1904' );
 
-    eval { timegm(0,0,0,29,1,4) };
-    is($@, '', 'no error with leap day of 2004 (year passed as 4)');
+    eval { timegm( 0, 0, 0, 29, 1, 4 ) };
+    is( $@, q{}, 'no error with leap day of 2004 (year passed as 4)' );
 
-    eval { timegm(0,0,0,29,1,96) };
-    is($@, '', 'no error with leap day of 1996 (year passed as 96)');
+    eval { timegm( 0, 0, 0, 29, 1, 96 ) };
+    is( $@, q{}, 'no error with leap day of 1996 (year passed as 96)' );
 }
 
 SKIP:
@@ -196,12 +215,18 @@ SKIP:
     skip 'These tests require a system with 64-bit time_t.', 3
         unless $epoch_is_64;
 
-    is( timegm( 8, 14, 3, 19, 0, ( 1900 + 138 ) ), 2**31,
-        'can call timegm for 2**31 epoch seconds' );
-    is( timegm( 16, 28, 6, 7, 1, ( 1900 + 206 ) ), 2**32,
-        'can call timegm for 2**32 epoch seconds (on a 64-bit system)' );
-    is( timegm( 16, 36, 0, 20, 1, ( 34912 + 1900 ) ), 2**40,
-        'can call timegm for 2**40 epoch seconds (on a 64-bit system)' );
+    is(
+        timegm( 8, 14, 3, 19, 0, ( 1900 + 138 ) ), 2**31,
+        'can call timegm for 2**31 epoch seconds'
+    );
+    is(
+        timegm( 16, 28, 6, 7, 1, ( 1900 + 206 ) ), 2**32,
+        'can call timegm for 2**32 epoch seconds (on a 64-bit system)'
+    );
+    is(
+        timegm( 16, 36, 0, 20, 1, ( 34912 + 1900 ) ), 2**40,
+        'can call timegm for 2**40 epoch seconds (on a 64-bit system)'
+    );
 }
 
 SKIP:
@@ -216,50 +241,67 @@ SKIP:
 
     # 2001-10-28 02:30:00 - could be either summer or standard time,
     # prefer earlier of the two, in this case summer
-    my $time = timelocal(0, 30, 2, 28, 9, 101);
-    is($time, 1004229000,
-       'timelocal prefers earlier epoch in the presence of a DST change');
+    my $time = timelocal( 0, 30, 2, 28, 9, 101 );
+    is(
+        $time, 1004229000,
+        'timelocal prefers earlier epoch in the presence of a DST change'
+    );
 
     local $ENV{TZ} = 'America/Chicago';
     POSIX::tzset();
 
     # Same local time in America/Chicago.  There is a transition here
     # as well.
-    $time = timelocal(0, 30, 1, 28, 9, 101);
-    is($time, 1004250600,
-       'timelocal prefers earlier epoch in the presence of a DST change');
+    $time = timelocal( 0, 30, 1, 28, 9, 101 );
+    is(
+        $time, 1004250600,
+        'timelocal prefers earlier epoch in the presence of a DST change'
+    );
 
-    $time = timelocal(0, 30, 2, 1, 3, 101);
-    is($time, 986113800,
-       'timelocal for non-existent time gives you the time one hour later');
+    $time = timelocal( 0, 30, 2, 1, 3, 101 );
+    is(
+        $time, 986113800,
+        'timelocal for non-existent time gives you the time one hour later'
+    );
 
     local $ENV{TZ} = 'Australia/Sydney';
     POSIX::tzset();
+
     # 2001-03-25 02:30:00 in Australia/Sydney.  This is the transition
     # _to_ summer time.  The southern hemisphere transitions are
     # opposite those of the northern.
-    $time = timelocal(0, 30, 2, 25, 2, 101);
-    is($time, 985447800,
-       'timelocal prefers earlier epoch in the presence of a DST change');
+    $time = timelocal( 0, 30, 2, 25, 2, 101 );
+    is(
+        $time, 985447800,
+        'timelocal prefers earlier epoch in the presence of a DST change'
+    );
 
-    $time = timelocal(0, 30, 2, 28, 9, 101);
-    is($time, 1004200200,
-       'timelocal for non-existent time gives you the time one hour later');
+    $time = timelocal( 0, 30, 2, 28, 9, 101 );
+    is(
+        $time, 1004200200,
+        'timelocal for non-existent time gives you the time one hour later'
+    );
 
     local $ENV{TZ} = 'Europe/London';
     POSIX::tzset();
     $time = timelocal( localtime(1111917720) );
-    is($time, 1111917720,
-       'timelocal for round trip bug on date of DST change for Europe/London');
+    is(
+        $time, 1111917720,
+        'timelocal for round trip bug on date of DST change for Europe/London'
+    );
 
     # There is no 1:00 AM on this date, as it leaps forward to
     # 2:00 on the DST change - this should return 2:00 per the
     # docs.
-    is( ( localtime( timelocal( 0, 0, 1, 27, 2, 2005 ) ) )[2], 2,
-        'hour is 2 when given 1:00 AM on Europe/London date change' );
+    is(
+        ( localtime( timelocal( 0, 0, 1, 27, 2, 2005 ) ) )[2], 2,
+        'hour is 2 when given 1:00 AM on Europe/London date change'
+    );
 
-    is( ( localtime( timelocal( 0, 0, 2, 27, 2, 2005 ) ) )[2], 2,
-        'hour is 2 when given 2:00 AM on Europe/London date change' );
+    is(
+        ( localtime( timelocal( 0, 0, 2, 27, 2, 2005 ) ) )[2], 2,
+        'hour is 2 when given 2:00 AM on Europe/London date change'
+    );
 }
 
 done_testing();
index c1aabce1abf863237882712b5b1dd91b3288641d..5f31ccc999dbea2003386f87b8472cac91d27d8c 100644 (file)
@@ -13,7 +13,7 @@ our ($PACKAGE, @EXPORT_OK, $accuracy, $precision, $round_mode, $div_scale);
 
 our @ISA = qw(Exporter Math::BigFloat);
 
-our $VERSION = '0.43';
+our $VERSION = '0.43_01';
 
 use overload;                   # inherit overload from BigFloat
 
index e780e66a60c32f550326414c6c52293f0536892f..0caec1104ebab25ab45026c5fd48f16faed2dbce 100644 (file)
@@ -13,7 +13,7 @@ our ($PACKAGE, @EXPORT_OK, $accuracy, $precision, $round_mode, $div_scale);
 
 our @ISA = qw(Exporter Math::BigInt);
 
-our $VERSION = '0.43';
+our $VERSION = '0.43_01';
 
 use overload;                   # inherit overload from BigInt
 
index fa30eb8122825ef5f9093bcb6d8635b8a8b68982..d04bd346387b0384bdd27bdeb99d1dc9800198fa 100644 (file)
@@ -4,7 +4,7 @@ use 5.006;
 use strict;
 use warnings;
 
-our $VERSION = '0.43';
+our $VERSION = '0.43_01';
 
 use Exporter;
 our @ISA            = qw( Exporter );
@@ -315,6 +315,8 @@ sub import {
     } else {
         # see if we can find Math::BigInt::Lite
         if (!defined $a && !defined $p) {       # rounding won't work to well
+            local @INC = @INC;
+            pop @INC if $INC[-1] eq '.';
             if (eval { require Math::BigInt::Lite; 1 }) {
                 @import = ();                   # :constant in Lite, not MBI
                 Math::BigInt::Lite->import(':constant');
index bf2881eb9064102d35369b2340dd05847bde8e7c..9445aba4437f564ab058937b4424b51b899585e2 100644 (file)
@@ -4,7 +4,7 @@ use 5.006;
 use strict;
 use warnings;
 
-our $VERSION = '0.43';
+our $VERSION = '0.43_01';
 
 use Exporter;
 our @ISA            = qw( bigint );
@@ -157,6 +157,8 @@ sub import {
     else {
         # see if we can find Math::BigInt::Lite
         if (!defined $a && !defined $p) {       # rounding won't work to well
+            local @INC = @INC;
+            pop @INC if $INC[-1] eq '.';
             if (eval { require Math::BigInt::Lite; 1 }) {
                 @import = ();                   # :constant in Lite, not MBI
                 Math::BigInt::Lite->import(':constant');
index 8557fc965a5882fabff0fd4836d5a9acaa6d6655..6425f09862b9e2aebcfca2eec246626e232e684a 100644 (file)
@@ -4,7 +4,7 @@ use 5.006;
 use strict;
 use warnings;
 
-our $VERSION = '0.43';
+our $VERSION = '0.43_01';
 
 use Exporter;
 our @ISA            = qw( bigint );
@@ -150,6 +150,8 @@ sub import {
     else {
         # see if we can find Math::BigInt::Lite
         if (!defined $a && !defined $p) {       # rounding won't work to well
+            local @INC = @INC;
+            pop @INC if $INC[-1] eq '.';
             if (eval { require Math::BigInt::Lite; 1 }) {
                 @import = ();                   # :constant in Lite, not MBI
                 Math::BigInt::Lite->import(':constant');
index 6efc003357514fa440499c3bd62695dc4654d4a5..3eb29858b74e028fcbf104bccf49d1e444db101a 100644 (file)
@@ -66,7 +66,7 @@ MAIN: {
         ABSTRACT => 'Collection of network protocol modules',
         AUTHOR   => 'Graham Barr <gbarr@pobox.com>, Steve Hay <shay@cpan.org>',
         LICENSE  => 'perl_5',
-        VERSION  => '3.09',
+        VERSION  => '3.10',
 
         META_MERGE => {
             'meta-spec' => {
index 3f102b92436886c4181eb267aa31b90ad0c5a035..38054c41247f276bd4c00372df0207d5bbc77525 100644 (file)
@@ -28,7 +28,7 @@ BEGIN {
   }
 }
 
-our $VERSION = "3.09";
+our $VERSION = "3.10";
 our @ISA     = qw(Exporter);
 our @EXPORT  = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING);
 
@@ -190,8 +190,6 @@ sub set_status {
   1;
 }
 
-sub timeout { 0 }
-
 sub _syswrite_with_timeout {
   my $cmd = shift;
   my $line = shift;
@@ -656,10 +654,15 @@ Net::Cmd - Network Command class (as used by FTP, SMTP etc)
 
 =head1 DESCRIPTION
 
-C<Net::Cmd> is a collection of methods that can be inherited by a sub class
-of C<IO::Handle>. These methods implement the functionality required for a
+C<Net::Cmd> is a collection of methods that can be inherited by a sub-class
+of C<IO::Socket::INET>. These methods implement the functionality required for a
 command based protocol, for example FTP and SMTP.
 
+If your sub-class does not also derive from C<IO::Socket::INET> or similar (e.g.
+C<IO::Socket::IP>, C<IO::Socket::INET6> or C<IO::Socket::SSL>) then you must
+provide the following methods by other means yourself: C<close()> and
+C<timeout()>.
+
 =head1 USER METHODS
 
 These methods provide a user interface to the C<Net::Cmd> object.
@@ -750,12 +753,6 @@ command server.
 
 Returns undef upon failure.
 
-=item timeout ()
-
-Returns the timeout value for this class, in seconds. The timeout provided
-by the default implementation is 0; subclasses may override this if they
-choose.
-
 =item unsupported ()
 
 Sets the status code to 580 and the response text to 'Unsupported command'.
index ff2b8417fb41b9cdd4dc4fd618b68635075df71f..a5935382bc4b94568ada421739b321aabdc30b18 100644 (file)
@@ -20,11 +20,16 @@ use Socket qw(inet_aton inet_ntoa);
 
 our @EXPORT  = qw(%NetConfig);
 our @ISA     = qw(Net::LocalCfg Exporter);
-our $VERSION = "3.09";
+our $VERSION = "3.10";
 
 our($CONFIGURE, $LIBNET_CFG);
 
-eval { local $SIG{__DIE__}; require Net::LocalCfg };
+eval {
+  local @INC = @INC;
+  pop @INC if $INC[-1] eq '.';
+  local $SIG{__DIE__};
+  require Net::LocalCfg;
+};
 
 our %NetConfig = (
   nntp_hosts      => [],
index 6b650b8a0e63e81adab13676d8819a336ac57dd9..796bbaf81f19ade37a729caac6c99d29033651d9 100644 (file)
@@ -21,7 +21,7 @@ use Net::Config;
 
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);
-our $VERSION = "3.09";
+our $VERSION = "3.10";
 
 my ($host, $domain, $fqdn) = (undef, undef, undef);
 
index 2bf6fc9c52f8aaa65a146e8cd7c1fcc9958e6225..905d83019cbf78d4feee85305dff62dc38d39f8e 100644 (file)
@@ -25,7 +25,7 @@ use Net::Config;
 use Socket;
 use Time::Local;
 
-our $VERSION = '3.09';
+our $VERSION = '3.10';
 
 our $IOCLASS;
 my $family_key;
index 5dc16faf2fba54faecee32bea45afd94f11be348..c889687b158453462c1b71205a62c640d32756cb 100644 (file)
@@ -13,7 +13,7 @@ use Carp;
 use Net::FTP::dataconn;
 
 our @ISA     = qw(Net::FTP::dataconn);
-our $VERSION = "3.09";
+our $VERSION = "3.10";
 
 our $buf;
 
index 5f776659b5d42aedc93a7c405beb95a126bc8a4f..8ebec64345d2e2e0462e391bc0f40d3830e72f01 100644 (file)
@@ -8,6 +8,6 @@ use warnings;
 use Net::FTP::I;
 
 our @ISA = qw(Net::FTP::I);
-our $VERSION = "3.09";
+our $VERSION = "3.10";
 
 1;
index 25d14c0efcb78d1c6785097a2b7a81123464c846..b55002f8d60f34e527e8fa3a8ef40eb7087a115d 100644 (file)
@@ -13,7 +13,7 @@ use Carp;
 use Net::FTP::dataconn;
 
 our @ISA     = qw(Net::FTP::dataconn);
-our $VERSION = "3.09";
+our $VERSION = "3.10";
 
 our $buf;
 
index 1809194589534876a3e2664b675406e651c0da69..e4ab31efd7400fe76f2ece944fb9baf8c487cb2e 100644 (file)
@@ -8,6 +8,6 @@ use warnings;
 use Net::FTP::I;
 
 our @ISA = qw(Net::FTP::I);
-our $VERSION = "3.09";
+our $VERSION = "3.10";
 
 1;
index 24b2ac72a5fc6238ad682d390279669665ca4041..6f5d8b3108d1fdeb510bc5187af9bffbc12f749e 100644 (file)
@@ -13,7 +13,7 @@ use Carp;
 use Errno;
 use Net::Cmd;
 
-our $VERSION = '3.09';
+our $VERSION = '3.10';
 
 $Net::FTP::IOCLASS or die "please load Net::FTP before Net::FTP::dataconn";
 our @ISA = $Net::FTP::IOCLASS;
index 803692bea61a0c80d312efc122a5be14ab7570da..764d5805634ecc65ad817ec2b25607c7075ffd74 100644 (file)
@@ -21,7 +21,7 @@ use Net::Cmd;
 use Net::Config;
 use Time::Local;
 
-our $VERSION = "3.09";
+our $VERSION = "3.10";
 
 # Code for detecting if we can use SSL
 my $ssl_class = eval {
index 5988606e84ec86378006b94d2c903252d62e1966..c075e1433ccaac50bb56c05086fc0c1254138a84 100644 (file)
@@ -18,7 +18,7 @@ use warnings;
 use Carp;
 use FileHandle;
 
-our $VERSION = "3.09";
+our $VERSION = "3.10";
 
 our $TESTING;
 
index eaff5115b792a338fecb9745b132a80de3808cc6..bb18aafec3454f84ba22592737ef79f0a4500508 100644 (file)
@@ -20,7 +20,7 @@ use IO::Socket;
 use Net::Cmd;
 use Net::Config;
 
-our $VERSION = "3.09";
+our $VERSION = "3.10";
 
 # Code for detecting if we can use SSL
 my $ssl_class = eval {
index 726035d8c1beac4dc1052988f70d8ecce0e77656..0dd966fdf6fd8ea35eb8e8bfb145d530f961c509 100644 (file)
@@ -21,7 +21,7 @@ use Net::Cmd;
 use Net::Config;
 use Socket;
 
-our $VERSION = "3.09";
+our $VERSION = "3.10";
 
 # Code for detecting if we can use SSL
 my $ssl_class = eval {
index a8f0b430d43987d728c52a7cf3915c1ef1e9ffd9..9a7f3b244a482aa39a4c673ed1f9119a7a089aee 100644 (file)
@@ -24,7 +24,7 @@ use Net::Config;
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw(inet_time inet_daytime);
 
-our $VERSION = "3.09";
+our $VERSION = "3.10";
 
 our $TIMEOUT = 120;
 
index 05903fb90a011c79162f096d2bdb20198b1a8012..0aea9d4a39d898873a93a4db6911f77e97857571 100644 (file)
@@ -21,6 +21,8 @@ BEGIN {
   use Net::Cmd;
   our @ISA = qw(Net::Cmd IO::File);
 
+  sub timeout { 0 }
+
   sub new {
     my $fh = shift->new_tmpfile;
     binmode($fh);
index 8e61752cbab004d9f6031bf3f4f5a1d4a4111a94..05052b9ef6e81ff374b5dc5d48c0760ebf7a2946 100644 (file)
@@ -87,7 +87,7 @@ BEGIN {
     }
 }
 
-our $VERSION = '1.41';
+our $VERSION = '1.42';
 $VERSION =~ tr/_//d;
 
 our $MaxEvalLen = 0;
@@ -636,7 +636,7 @@ Carp - alternative warn and die for modules
 
     # cluck, longmess and shortmess not exported by default
     use Carp qw(cluck longmess shortmess);
-    cluck "This is how we got here!";
+    cluck "This is how we got here!"; # warn with stack backtrace
     $long_message   = longmess( "message from cluck() or confess()" );
     $short_message  = shortmess( "message from carp() or croak()" );
 
index 7b4de47450fd0f4eb6a46b8e3b6fdd6c76de5fbf..f9c584a42b5b1ae02a03ffc3d883cb98e3a57378 100644 (file)
@@ -2,7 +2,7 @@ package Carp::Heavy;
 
 use Carp ();
 
-our $VERSION = '1.41';
+our $VERSION = '1.42';
 $VERSION =~ tr/_//d;
 
 # Carp::Heavy was merged into Carp in version 1.12.  Any mismatched versions
index e2ac71a32349aa11457b85fa6bb085dd843fc8e3..d596cdff42aa1b369be5b43d2985b3b0270095b3 100644 (file)
@@ -1,5 +1,6 @@
 #!perl
 use 5.006;
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use strict;
 eval {
   require ExtUtils::ParseXS;
index 9bac7077e70f0d3de2f1097141f24b0bdd6ce194..2193208d628220b9c025618724f1a2e58eb508fb 100644 (file)
@@ -19,7 +19,7 @@ require Exporter;
                );
 %EXPORT_TAGS = ('ALL' => \@EXPORT_OK);
 
-$VERSION = "0.40";
+$VERSION = "0.41";
 
 sub uniq { my %seen; return grep(!($seen{$_}++), @_); } # a util function
 
index f13d5460b320851d1ba96bd42cf7bdbaae4cc7af..a0f3d1db8d220b5c5506c2604658136617cebb81 100644 (file)
@@ -11,7 +11,7 @@ use vars qw( @ISA $VERSION $MATCH_SUPERS $USING_LANGUAGE_TAGS
 BEGIN { unless(defined &DEBUG) { *DEBUG = sub () {0} } }
  # define the constant 'DEBUG' at compile-time
 
-$VERSION = "1.05";
+$VERSION = "1.06";
 @ISA = ();
 use I18N::LangTags qw(alternate_language_tags locale2language_tag);
 
@@ -145,6 +145,8 @@ sub _try_use {   # Basically a wrapper around "require Modulename"
   print " About to use $module ...\n" if DEBUG;
   {
     local $SIG{'__DIE__'};
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
     eval "require $module"; # used to be "use $module", but no point in that.
   }
   if($@) {
index de3e991a902161b040522e21c924f958986d76fb..07a5e51cf34a4eee88153d27c7e38ce3d8bc82ff 100644 (file)
@@ -7,7 +7,7 @@ use Carp;
 use strict;
 use warnings;
 
-our $VERSION = "1.36";
+our $VERSION = "1.37";
 XSLoader::load 'IO', $VERSION;
 
 sub import {
@@ -18,6 +18,8 @@ sub import {
     
     my @l = @_ ? @_ : qw(Handle Seekable File Pipe Socket Dir);
 
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
     eval join("", map { "require IO::" . (/(\w+)/)[0] . ";\n" } @l)
        or croak $@;
 }
index 62f6b878a862532968c7c4c8c2da3d57010cc88b..ac25aa6a8e3edc53b3ed5477f754eea3f8e5eefa 100644 (file)
@@ -1,5 +1,9 @@
 Revision history for Perl suite Locale::Maketext
 
+2016-07-25
+    * Release of 1.28 to CPAN
+    * Fix optional runtime load for CVE-2016-1238
+
 2016-06-22
     * Release of 1.27 to CPAN
 
index 823c8d76477a17e30978d19c25a59f382dc5c367..36d0c0556616b968a6ba0e76713ab913a0e837b8 100644 (file)
@@ -26,7 +26,7 @@ BEGIN {
 }
 
 
-$VERSION = '1.27';
+$VERSION = '1.28';
 @ISA = ();
 
 $MATCH_SUPERS = 1;
@@ -499,6 +499,8 @@ sub _try_use {   # Basically a wrapper around "require Modulename"
 
     local $SIG{'__DIE__'};
     local $@;
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
     eval "require $module"; # used to be "use $module", but no point in that.
 
     if($@) {
index 1d4dc7c0522ee5706a10fbd0f82805a5c1d6ae47..b50cf892be120fd1339554f71cc2744ac261d42e 100644 (file)
@@ -1,3 +1,6 @@
+5.20160820
+  - Updated for v5.25.4
+
 5.20160720
   - Updated for v5.25.3
 
index aa4a94571a308f88b64469d7e036e023786a7eb1..bbe61ccee41c515190589250e433800264a0f00c 100644 (file)
@@ -130,6 +130,7 @@ requested perl versions.
 
 =cut
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use Module::CoreList;
 use Getopt::Long qw(:config no_ignore_case);
 use Pod::Usage;
index 93904f2f1a2a174541cc8990db732b27ba971810..a4e56ea5aa431a4b9748806c3ef8c156bfa4cafd 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use vars qw/$VERSION %released %version %families %upstream
            %bug_tracker %deprecated %delta/;
 use version;
-$VERSION = '5.20160720';
+$VERSION = '5.20160820';
 
 sub _undelta {
     my ($delta) = @_;
@@ -312,6 +312,7 @@ sub changes_between {
     5.025001 => '2016-05-20',
     5.025002 => '2016-06-20',
     5.025003 => '2016-07-20',
+    5.025004 => '2016-08-20',
   );
 
 for my $version ( sort { $a <=> $b } keys %released ) {
@@ -12828,6 +12829,262 @@ for my $version ( sort { $a <=> $b } keys %released ) {
         removed => {
         }
     },
+    5.025004 => {
+        delta_from => 5.025003,
+        changed => {
+            'App::Cpan'             => '1.64_01',
+            'App::Prove'            => '3.36_01',
+            'App::Prove::State'     => '3.36_01',
+            'App::Prove::State::Result'=> '3.36_01',
+            'App::Prove::State::Result::Test'=> '3.36_01',
+            'Archive::Tar'          => '2.10',
+            'Archive::Tar::Constant'=> '2.10',
+            'Archive::Tar::File'    => '2.10',
+            'B'                     => '1.63',
+            'B::Concise'            => '0.998',
+            'B::Deparse'            => '1.38',
+            'B::Op_private'         => '5.025004',
+            'CPAN'                  => '2.14_01',
+            'CPAN::Meta'            => '2.150010',
+            'CPAN::Meta::Converter' => '2.150010',
+            'CPAN::Meta::Feature'   => '2.150010',
+            'CPAN::Meta::History'   => '2.150010',
+            'CPAN::Meta::Merge'     => '2.150010',
+            'CPAN::Meta::Prereqs'   => '2.150010',
+            'CPAN::Meta::Spec'      => '2.150010',
+            'CPAN::Meta::Validator' => '2.150010',
+            'Carp'                  => '1.42',
+            'Carp::Heavy'           => '1.42',
+            'Compress::Zlib'        => '2.069_01',
+            'Config'                => '5.025004',
+            'Config::Perl::V'       => '0.27',
+            'Cwd'                   => '3.65',
+            'Digest'                => '1.17_01',
+            'Digest::SHA'           => '5.96',
+            'Encode'                => '2.86',
+            'Errno'                 => '1.26',
+            'ExtUtils::Command'     => '7.24',
+            'ExtUtils::Command::MM' => '7.24',
+            'ExtUtils::Liblist'     => '7.24',
+            'ExtUtils::Liblist::Kid'=> '7.24',
+            'ExtUtils::MM'          => '7.24',
+            'ExtUtils::MM_AIX'      => '7.24',
+            'ExtUtils::MM_Any'      => '7.24',
+            'ExtUtils::MM_BeOS'     => '7.24',
+            'ExtUtils::MM_Cygwin'   => '7.24',
+            'ExtUtils::MM_DOS'      => '7.24',
+            'ExtUtils::MM_Darwin'   => '7.24',
+            'ExtUtils::MM_MacOS'    => '7.24',
+            'ExtUtils::MM_NW5'      => '7.24',
+            'ExtUtils::MM_OS2'      => '7.24',
+            'ExtUtils::MM_QNX'      => '7.24',
+            'ExtUtils::MM_UWIN'     => '7.24',
+            'ExtUtils::MM_Unix'     => '7.24',
+            'ExtUtils::MM_VMS'      => '7.24',
+            'ExtUtils::MM_VOS'      => '7.24',
+            'ExtUtils::MM_Win32'    => '7.24',
+            'ExtUtils::MM_Win95'    => '7.24',
+            'ExtUtils::MY'          => '7.24',
+            'ExtUtils::MakeMaker'   => '7.24',
+            'ExtUtils::MakeMaker::Config'=> '7.24',
+            'ExtUtils::MakeMaker::Locale'=> '7.24',
+            'ExtUtils::MakeMaker::version'=> '7.24',
+            'ExtUtils::MakeMaker::version::regex'=> '7.24',
+            'ExtUtils::Mkbootstrap' => '7.24',
+            'ExtUtils::Mksymlists'  => '7.24',
+            'ExtUtils::testlib'     => '7.24',
+            'File::Fetch'           => '0.52',
+            'File::Spec'            => '3.65',
+            'File::Spec::AmigaOS'   => '3.65',
+            'File::Spec::Cygwin'    => '3.65',
+            'File::Spec::Epoc'      => '3.65',
+            'File::Spec::Functions' => '3.65',
+            'File::Spec::Mac'       => '3.65',
+            'File::Spec::OS2'       => '3.65',
+            'File::Spec::Unix'      => '3.65',
+            'File::Spec::VMS'       => '3.65',
+            'File::Spec::Win32'     => '3.65',
+            'HTTP::Tiny'            => '0.064',
+            'Hash::Util'            => '0.21',
+            'I18N::LangTags'        => '0.41',
+            'I18N::LangTags::Detect'=> '1.06',
+            'IO'                    => '1.37',
+            'IO::Compress::Adapter::Bzip2'=> '2.069_01',
+            'IO::Compress::Adapter::Deflate'=> '2.069_01',
+            'IO::Compress::Adapter::Identity'=> '2.069_01',
+            'IO::Compress::Base'    => '2.069_01',
+            'IO::Compress::Base::Common'=> '2.069_01',
+            'IO::Compress::Bzip2'   => '2.069_01',
+            'IO::Compress::Deflate' => '2.069_01',
+            'IO::Compress::Gzip'    => '2.069_01',
+            'IO::Compress::Gzip::Constants'=> '2.069_01',
+            'IO::Compress::RawDeflate'=> '2.069_01',
+            'IO::Compress::Zip'     => '2.069_01',
+            'IO::Compress::Zip::Constants'=> '2.069_01',
+            'IO::Compress::Zlib::Constants'=> '2.069_01',
+            'IO::Compress::Zlib::Extra'=> '2.069_01',
+            'IO::Socket::IP'        => '0.38',
+            'IO::Uncompress::Adapter::Bunzip2'=> '2.069_01',
+            'IO::Uncompress::Adapter::Identity'=> '2.069_01',
+            'IO::Uncompress::Adapter::Inflate'=> '2.069_01',
+            'IO::Uncompress::AnyInflate'=> '2.069_01',
+            'IO::Uncompress::AnyUncompress'=> '2.069_01',
+            'IO::Uncompress::Base'  => '2.069_01',
+            'IO::Uncompress::Bunzip2'=> '2.069_01',
+            'IO::Uncompress::Gunzip'=> '2.069_01',
+            'IO::Uncompress::Inflate'=> '2.069_01',
+            'IO::Uncompress::RawInflate'=> '2.069_01',
+            'IO::Uncompress::Unzip' => '2.069_01',
+            'IPC::Cmd'              => '0.96',
+            'JSON::PP'              => '2.27400_01',
+            'Locale::Maketext'      => '1.28',
+            'Locale::Maketext::Simple'=> '0.21_01',
+            'Math::BigFloat::Trace' => '0.43_01',
+            'Math::BigInt::Trace'   => '0.43_01',
+            'Memoize'               => '1.03_01',
+            'Module::CoreList'      => '5.20160820',
+            'Module::CoreList::TieHashDelta'=> '5.20160820',
+            'Module::CoreList::Utils'=> '5.20160820',
+            'Module::Load::Conditional'=> '0.68',
+            'Module::Metadata'      => '1.000033',
+            'NEXT'                  => '0.67',
+            'Net::Cmd'              => '3.10',
+            'Net::Config'           => '3.10',
+            'Net::Domain'           => '3.10',
+            'Net::FTP'              => '3.10',
+            'Net::FTP::A'           => '3.10',
+            'Net::FTP::E'           => '3.10',
+            'Net::FTP::I'           => '3.10',
+            'Net::FTP::L'           => '3.10',
+            'Net::FTP::dataconn'    => '3.10',
+            'Net::NNTP'             => '3.10',
+            'Net::Netrc'            => '3.10',
+            'Net::POP3'             => '3.10',
+            'Net::Ping'             => '2.44',
+            'Net::SMTP'             => '3.10',
+            'Net::Time'             => '3.10',
+            'Opcode'                => '1.37',
+            'POSIX'                 => '1.71',
+            'Parse::CPAN::Meta'     => '2.150010',
+            'Pod::Html'             => '1.2201',
+            'Pod::Perldoc'          => '3.27',
+            'Pod::Perldoc::BaseTo'  => '3.27',
+            'Pod::Perldoc::GetOptsOO'=> '3.27',
+            'Pod::Perldoc::ToANSI'  => '3.27',
+            'Pod::Perldoc::ToChecker'=> '3.27',
+            'Pod::Perldoc::ToMan'   => '3.27',
+            'Pod::Perldoc::ToNroff' => '3.27',
+            'Pod::Perldoc::ToPod'   => '3.27',
+            'Pod::Perldoc::ToRtf'   => '3.27',
+            'Pod::Perldoc::ToTerm'  => '3.27',
+            'Pod::Perldoc::ToText'  => '3.27',
+            'Pod::Perldoc::ToTk'    => '3.27',
+            'Pod::Perldoc::ToXml'   => '3.27',
+            'Storable'              => '2.57',
+            'Sys::Syslog'           => '0.34_01',
+            'TAP::Base'             => '3.36_01',
+            'TAP::Formatter::Base'  => '3.36_01',
+            'TAP::Formatter::Color' => '3.36_01',
+            'TAP::Formatter::Console'=> '3.36_01',
+            'TAP::Formatter::Console::ParallelSession'=> '3.36_01',
+            'TAP::Formatter::Console::Session'=> '3.36_01',
+            'TAP::Formatter::File'  => '3.36_01',
+            'TAP::Formatter::File::Session'=> '3.36_01',
+            'TAP::Formatter::Session'=> '3.36_01',
+            'TAP::Harness'          => '3.36_01',
+            'TAP::Harness::Env'     => '3.36_01',
+            'TAP::Object'           => '3.36_01',
+            'TAP::Parser'           => '3.36_01',
+            'TAP::Parser::Aggregator'=> '3.36_01',
+            'TAP::Parser::Grammar'  => '3.36_01',
+            'TAP::Parser::Iterator' => '3.36_01',
+            'TAP::Parser::Iterator::Array'=> '3.36_01',
+            'TAP::Parser::Iterator::Process'=> '3.36_01',
+            'TAP::Parser::Iterator::Stream'=> '3.36_01',
+            'TAP::Parser::IteratorFactory'=> '3.36_01',
+            'TAP::Parser::Multiplexer'=> '3.36_01',
+            'TAP::Parser::Result'   => '3.36_01',
+            'TAP::Parser::Result::Bailout'=> '3.36_01',
+            'TAP::Parser::Result::Comment'=> '3.36_01',
+            'TAP::Parser::Result::Plan'=> '3.36_01',
+            'TAP::Parser::Result::Pragma'=> '3.36_01',
+            'TAP::Parser::Result::Test'=> '3.36_01',
+            'TAP::Parser::Result::Unknown'=> '3.36_01',
+            'TAP::Parser::Result::Version'=> '3.36_01',
+            'TAP::Parser::Result::YAML'=> '3.36_01',
+            'TAP::Parser::ResultFactory'=> '3.36_01',
+            'TAP::Parser::Scheduler'=> '3.36_01',
+            'TAP::Parser::Scheduler::Job'=> '3.36_01',
+            'TAP::Parser::Scheduler::Spinner'=> '3.36_01',
+            'TAP::Parser::Source'   => '3.36_01',
+            'TAP::Parser::SourceHandler'=> '3.36_01',
+            'TAP::Parser::SourceHandler::Executable'=> '3.36_01',
+            'TAP::Parser::SourceHandler::File'=> '3.36_01',
+            'TAP::Parser::SourceHandler::Handle'=> '3.36_01',
+            'TAP::Parser::SourceHandler::Perl'=> '3.36_01',
+            'TAP::Parser::SourceHandler::RawTAP'=> '3.36_01',
+            'TAP::Parser::YAMLish::Reader'=> '3.36_01',
+            'TAP::Parser::YAMLish::Writer'=> '3.36_01',
+            'Test'                  => '1.29',
+            'Test2'                 => '1.302052',
+            'Test2::API'            => '1.302052',
+            'Test2::API::Breakage'  => '1.302052',
+            'Test2::API::Context'   => '1.302052',
+            'Test2::API::Instance'  => '1.302052',
+            'Test2::API::Stack'     => '1.302052',
+            'Test2::Event'          => '1.302052',
+            'Test2::Event::Bail'    => '1.302052',
+            'Test2::Event::Diag'    => '1.302052',
+            'Test2::Event::Exception'=> '1.302052',
+            'Test2::Event::Generic' => '1.302052',
+            'Test2::Event::Info'    => '1.302052',
+            'Test2::Event::Note'    => '1.302052',
+            'Test2::Event::Ok'      => '1.302052',
+            'Test2::Event::Plan'    => '1.302052',
+            'Test2::Event::Skip'    => '1.302052',
+            'Test2::Event::Subtest' => '1.302052',
+            'Test2::Event::Waiting' => '1.302052',
+            'Test2::Formatter'      => '1.302052',
+            'Test2::Formatter::TAP' => '1.302052',
+            'Test2::Hub'            => '1.302052',
+            'Test2::Hub::Interceptor'=> '1.302052',
+            'Test2::Hub::Interceptor::Terminator'=> '1.302052',
+            'Test2::Hub::Subtest'   => '1.302052',
+            'Test2::IPC'            => '1.302052',
+            'Test2::IPC::Driver'    => '1.302052',
+            'Test2::IPC::Driver::Files'=> '1.302052',
+            'Test2::Util'           => '1.302052',
+            'Test2::Util::ExternalMeta'=> '1.302052',
+            'Test2::Util::HashBase' => '1.302052',
+            'Test2::Util::Trace'    => '1.302052',
+            'Test::Builder'         => '1.302052',
+            'Test::Builder::Formatter'=> '1.302052',
+            'Test::Builder::Module' => '1.302052',
+            'Test::Builder::Tester' => '1.302052',
+            'Test::Builder::Tester::Color'=> '1.302052',
+            'Test::Builder::TodoDiag'=> '1.302052',
+            'Test::Harness'         => '3.36_01',
+            'Test::More'            => '1.302052',
+            'Test::Simple'          => '1.302052',
+            'Test::Tester'          => '1.302052',
+            'Test::Tester::Capture' => '1.302052',
+            'Test::Tester::CaptureRunner'=> '1.302052',
+            'Test::Tester::Delegate'=> '1.302052',
+            'Test::use::ok'         => '1.302052',
+            'Tie::Hash::NamedCapture'=> '0.10',
+            'Time::Local'           => '1.24',
+            'XS::APItest'           => '0.83',
+            'arybase'               => '0.12',
+            'base'                  => '2.24',
+            'bigint'                => '0.43_01',
+            'bignum'                => '0.43_01',
+            'bigrat'                => '0.43_01',
+            'encoding'              => '2.18',
+            'ok'                    => '1.302052',
+        },
+        removed => {
+        }
+    },
 );
 
 sub is_core
@@ -13503,6 +13760,13 @@ sub is_core
         removed => {
         }
     },
+    5.025004 => {
+        delta_from => 5.025003,
+        changed => {
+        },
+        removed => {
+        }
+    },
 );
 
 %deprecated = _undelta(\%deprecated);
@@ -14187,7 +14451,7 @@ sub is_core
     'Net::SMTP'             => undef,
     'Net::Time'             => undef,
     'Params::Check'         => undef,
-    'Parse::CPAN::Meta'     => 'https://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta/issues',
+    'Parse::CPAN::Meta'     => 'https://github.com/Perl-Toolchain-Gang/CPAN-Meta/issues',
     'Perl::OSType'          => 'https://github.com/Perl-Toolchain-Gang/Perl-OSType/issues',
     'PerlIO::via::QuotedPrint'=> undef,
     'Pod::Checker'          => undef,
@@ -14347,7 +14611,7 @@ sub is_core
     'Text::Tabs'            => undef,
     'Text::Wrap'            => undef,
     'Tie::RefHash'          => undef,
-    'Time::Local'           => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=Time-Local',
+    'Time::Local'           => 'http://rt.cpan.org/Public/Dist/Display.html?Name=Time-Local',
     'Time::Piece'           => undef,
     'Time::Seconds'         => undef,
     'Unicode::Collate'      => undef,
index 2bfae681deddcba6f1e4ece52325712d3edf41d0..d9b2bc65b6871f48dfd0444efc33cb95ee743632 100644 (file)
@@ -3,7 +3,7 @@ package Module::CoreList::TieHashDelta;
 use strict;
 use vars qw($VERSION);
 
-$VERSION = '5.20160720';
+$VERSION = '5.20160820';
 
 sub TIEHASH {
     my ($class, $changed, $removed, $parent) = @_;
index 60442925a5464249d0692093ac8329a1af08afd9..36dfc6ec6f5a6ca55dbefa92f35c3861240f0e1a 100644 (file)
@@ -5,7 +5,7 @@ use warnings;
 use vars qw[$VERSION %utilities];
 use Module::CoreList;
 
-$VERSION = '5.20160720';
+$VERSION = '5.20160820';
 
 sub utilities {
     my $perl = shift;
@@ -1177,6 +1177,13 @@ my %delta = (
         removed => {
         }
     },
+    5.025004 => {
+        delta_from => 5.025003,
+        changed => {
+        },
+        removed => {
+        }
+    },
 );
 
 %utilities = Module::CoreList::_undelta(\%delta);
index 2766c9edbb5ee07bed93a81ac1cc849b9fb9b9fd..73d2a83f94bae27c9ae77625bfead2305d632414 100644 (file)
@@ -17,7 +17,7 @@ use Time::HiRes;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(pingecho);
-$VERSION = "2.43";
+$VERSION = "2.44";
 
 # Constants
 
@@ -410,7 +410,11 @@ sub ping_external {
       $timeout            # Seconds after which ping times out
      ) = @_;
 
-  eval { require Net::Ping::External; }
+  eval {
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
+    require Net::Ping::External;
+  }
     or croak('Protocol "external" not supported on your system: Net::Ping::External not found');
   return Net::Ping::External::ping(ip => $ip, timeout => $timeout);
 }
index e181219be567e0f5951c39ebc0a7690f34e3f5c0..60383779e4eac9f01f00d85346dca3683e3e630f 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 use Exporter;
 use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
 
-$VERSION = '3.64';
+$VERSION = '3.65';
 my $xs_version = $VERSION;
 $VERSION =~ tr/_//d;
 
@@ -40,7 +40,10 @@ if ($^O eq 'os2') {
 my $use_vms_feature;
 BEGIN {
     if ($^O eq 'VMS') {
-        if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+        if (eval { local $SIG{__DIE__};
+                   local @INC = @INC;
+                   pop @INC if $INC[-1] eq '.';
+                   require VMS::Feature; }) {
             $use_vms_feature = 1;
         }
     }
index 41b0936c61c2128f0cf5db89fc79cce7d857b9c1..8691a3658285fbdfa017dcd628cbc6899897be31 100644 (file)
@@ -3,7 +3,7 @@ package File::Spec;
 use strict;
 use vars qw(@ISA $VERSION);
 
-$VERSION = '3.64';
+$VERSION = '3.65';
 $VERSION =~ tr/_//d;
 
 my %module = (MacOS   => 'Mac',
index 7a5889cec49e9affb3a905927f9f16cfb3bc9ad4..cc95294543b1b011eda969a5ff28692b4c1b7ee9 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.64';
+$VERSION = '3.65';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
index d8d532eeae3bbb578105d0b32d1552f7b570d865..85ce95ed30468fa24cca2d12a1c9c3d9aff58709 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.64';
+$VERSION = '3.65';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
@@ -137,7 +137,11 @@ sub case_tolerant {
   if ($mntopts and ($mntopts =~ /,managed/)) {
     return 0;
   }
-  eval { require Win32API::File; } or return 1;
+  eval {
+      local @INC = @INC;
+      pop @INC if $INC[-1] eq '.';
+      require Win32API::File;
+  } or return 1;
   my $osFsType = "\0"x256;
   my $osVolName = "\0"x256;
   my $ouFsFlags = 0;
index 422cc44abe235870c82e07b55d88c14ef03bcbc8..6a3dc9ff74883985782352047caab025f3ad72fb 100644 (file)
@@ -3,7 +3,7 @@ package File::Spec::Epoc;
 use strict;
 use vars qw($VERSION @ISA);
 
-$VERSION = '3.64';
+$VERSION = '3.65';
 $VERSION =~ tr/_//d;
 
 require File::Spec::Unix;
index 896de3f046a804e0828ccf00eefdc85a2737c2a6..45f662a67b7ba0382a2cdb4ef573788933fb3d13 100644 (file)
@@ -5,7 +5,7 @@ use strict;
 
 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
 
-$VERSION = '3.64';
+$VERSION = '3.65';
 $VERSION =~ tr/_//d;
 
 require Exporter;
index 0d969f235a7ae0799f03c4f5cd80612486aaa9ad..3cd4553c35f59850908e2c15f8038c668c88d199 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.64';
+$VERSION = '3.65';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
index d5bf5c672b7c97797e51872398d41d1325aae066..5d8aec37653d9bc18ec0140016a09e59864636a8 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.64';
+$VERSION = '3.65';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
index 4fb58d09d18c10b7d893da3c502d51309c607191..02b4eeb3a03082e34fbd660e29d7a8df265d8d4b 100644 (file)
@@ -3,7 +3,7 @@ package File::Spec::Unix;
 use strict;
 use vars qw($VERSION);
 
-$VERSION = '3.64';
+$VERSION = '3.65';
 my $xs_version = $VERSION;
 $VERSION =~ tr/_//d;
 
index a4b1d89a98d1c3d8473cd98d96675a123c6638c5..d836cbe6abd6e8fad3c1a0e2760e8dadbcdb4a17 100644 (file)
@@ -4,7 +4,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.64';
+$VERSION = '3.65';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
@@ -39,7 +39,10 @@ via the C<DECC$FILENAME_UNIX_REPORT> CRTL feature.
 
 my $use_feature;
 BEGIN {
-    if (eval { local $SIG{__DIE__}; require VMS::Feature; }) {
+    if (eval { local $SIG{__DIE__};
+               local @INC = @INC;
+               pop @INC if $INC[-1] eq '.';
+               require VMS::Feature; }) {
         $use_feature = 1;
     }
 }
@@ -94,7 +97,7 @@ sub canonpath {
                                                # [-.-.         ==> [--.
                                                # .-.-]         ==> .--]
                                                # [-.-]         ==> [--]
-    1 while ($path =~ s/(?<!\^)([\[\.])[^\]\.]+\.-(-+)([\]\.])/$1$2$3/);
+    1 while ($path =~ s/(?<!\^)([\[\.])(?:\^.|[^\]\.])+\.-(-+)([\]\.])/$1$2$3/);
                                                # That loop does the following
                                                # with any amount (minimum 2)
                                                # of dashes:
@@ -105,11 +108,11 @@ sub canonpath {
                                                #
                                                # And then, the remaining cases
     $path =~ s/(?<!\^)\[\.-/[-/;               # [.-           ==> [-
-    $path =~ s/(?<!\^)\.[^\]\.]+\.-\./\./g;    # .foo.-.       ==> .
-    $path =~ s/(?<!\^)\[[^\]\.]+\.-\./\[/g;    # [foo.-.       ==> [
-    $path =~ s/(?<!\^)\.[^\]\.]+\.-\]/\]/g;    # .foo.-]       ==> ]
+    $path =~ s/(?<!\^)\.(?:\^.|[^\]\.])+\.-\./\./g;    # .foo.-.       ==> .
+    $path =~ s/(?<!\^)\[(?:\^.|[^\]\.])+\.-\./\[/g;    # [foo.-.       ==> [
+    $path =~ s/(?<!\^)\.(?:\^.|[^\]\.])+\.-\]/\]/g;    # .foo.-]       ==> ]
                                                # [foo.-]       ==> [000000]
-    $path =~ s/(?<!\^)\[[^\]\.]+\.-\]/\[000000\]/g;
+    $path =~ s/(?<!\^)\[(?:\^.|[^\]\.])+\.-\]/\[000000\]/g;
                                                # []            ==>
     $path =~ s/(?<!\^)\[\]// unless $path eq '[]';
     return $unix_rpt ? unixify($path) : $path;
index 280e8ec986cd97091344b97d1dbc5d1549f2a4c9..4d9c68d0ec950a292d6a2e11c2508e19038fe50a 100644 (file)
@@ -5,7 +5,7 @@ use strict;
 use vars qw(@ISA $VERSION);
 require File::Spec::Unix;
 
-$VERSION = '3.64';
+$VERSION = '3.65';
 $VERSION =~ tr/_//d;
 
 @ISA = qw(File::Spec::Unix);
@@ -90,7 +90,11 @@ Default: 1
 =cut
 
 sub case_tolerant {
-  eval { require Win32API::File; } or return 1;
+  eval {
+    local @INC = @INC;
+    pop @INC if $INC[-1] eq '.';
+    require Win32API::File;
+  } or return 1;
   my $drive = shift || "C:";
   my $osFsType = "\0"x256;
   my $osVolName = "\0"x256;
index 150c8d487355488a111890a422e39922cc93b91c..0255bdb1bfc8420fa0bcd622e20175955198869e 100644 (file)
@@ -448,6 +448,13 @@ my @tests = (
 # During the Perl 5.8 era, FS::Unix stopped eliminating redundant path elements, so mimic that here.
 [ "VMS->canonpath('a/../../b/c.dat')",                  $vms_unix_rpt ? 'a/../../b/c.dat'              : '[-.b]c.dat'                      ],
 [ "VMS->canonpath('^<test^.new.-.caret^ escapes^>')",   $vms_unix_rpt ? '/<test.new.-.caret escapes>' : '^<test^.new.-.caret^ escapes^>'                                                   ],
+# Check that directory specs with caret-dot component is treated correctly
+[ "VMS->canonpath('foo:[bar.coo.kie.--]file.txt')",     $vms_unix_rpt ? '/foo/bar/file.txt'            : "foo:[bar]file.txt" ],
+[ "VMS->canonpath('foo:[bar^.coo.kie.--]file.txt')",    $vms_unix_rpt ? '/foo/file.txt'                : "foo:[000000]file.txt" ],
+[ "VMS->canonpath('foo:[bar.coo^.kie.--]file.txt')",    $vms_unix_rpt ? '/foo/file.txt'                : "foo:[000000]file.txt" ],
+[ "VMS->canonpath('foo:[bar.coo.kie.-]file.txt')",      $vms_unix_rpt ? '/foo/bar/coo/file.txt'        : "foo:[bar.coo]file.txt" ],
+[ "VMS->canonpath('foo:[bar^.coo.kie.-]file.txt')",     $vms_unix_rpt ? '/foo/bar.coo/file.txt'        : "foo:[bar^.coo]file.txt" ],
+[ "VMS->canonpath('foo:[bar.coo^.kie.-]file.txt')",     $vms_unix_rpt ? '/foo/bar/file.txt'            : "foo:[bar]file.txt" ],
 
 [ "VMS->splitdir('')",            ''          ],
 [ "VMS->splitdir('[]')",          ''          ],
index c8f6db107d6bc7e0d5a4b1acf0eeb5bb0f46dac7..c2a6a480026e5613569af28072a308b468379773 100644 (file)
@@ -22,10 +22,16 @@ package Storable; @ISA = qw(Exporter);
 
 use vars qw($canonical $forgive_me $VERSION);
 
-$VERSION = '2.56';
+$VERSION = '2.57';
 
 BEGIN {
-    if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) {
+    if (eval {
+        local $SIG{__DIE__};
+        local @INC = @INC;
+        pop @INC if $INC[-1] eq '.';
+        require Log::Agent;
+        1;
+    }) {
         Log::Agent->import;
     }
     #
index 1e852a3ca5fc38d60471f6f9863488ab7fbcb606..af3d7f6abfd9cc76a9055d4e11aebbc59f65f746 100644 (file)
@@ -68,7 +68,7 @@ is($$cloned{''}[0], \$$cloned{a});
 $$cloned{a} = "blah";
 is($$cloned{''}[0], \$$cloned{a});
 
-# [ID 20020221.007] SEGV in Storable with empty string scalar object
+# [ID 20020221.007 (#8624)] SEGV in Storable with empty string scalar object
 package TestString;
 sub new {
     my ($type, $string) = @_;
index 930a2242ebc0bcc296797b5ea2390f5059bbbd12..399101cc4a14367a9dc1c559fc2b14a1ccca7084 100644 (file)
@@ -272,7 +272,7 @@ sub set_c2 { $_[0]->{c2} = $_[1] }
 
 #
 # Is the reference count of the extra references returned from a
-# STORABLE_freeze hook correct? [ID 20020601.005]
+# STORABLE_freeze hook correct? [ID 20020601.005 (#9436)]
 #
 package Foo2;
 
index de20922194b764a0bb824d8406fa7d1f4770d7c7..84db5f3ff496ca0e557a498e3057047aed26584e 100644 (file)
@@ -20,7 +20,7 @@ sub _reset_globals {
     $planned    = 0;
 }
 
-$VERSION = '1.28';
+$VERSION = '1.29';
 require Exporter;
 @ISA=('Exporter');
 
@@ -505,7 +505,12 @@ sub _diff_complain {
     my($result, $expected, $detail, $prefix) = @_;
     return _diff_complain_external(@_) if $ENV{PERL_TEST_DIFF};
     return _diff_complain_algdiff(@_)
-     if eval { require Algorithm::Diff; Algorithm::Diff->VERSION(1.15); 1; };
+      if eval {
+          local @INC = @INC;
+          pop @INC if $INC[-1] eq '.';
+          require Algorithm::Diff; Algorithm::Diff->VERSION(1.15);
+          1;
+      };
 
     $told_about_diff++ or print $TESTERR <<"EOT";
 # $prefix   (Install the Algorithm::Diff module to have differences in multiline
index 899cc89a3140ecfb721ec7bf1f3f8c378e0a0e84..6186a382c2a23b620be54c8c11e329c3d73be972 100644 (file)
@@ -42,16 +42,35 @@ WriteMakefile(
     PL_FILES        => { 'XSLoader_pm.PL'  => 'XSLoader.pm' },
     PM              => { 'XSLoader.pm' => '$(INST_ARCHLIB)/XSLoader.pm' },
     PREREQ_PM       => {
+        # NOTE: If we should require a Test::More version higher than 0.98
+        # (that included with perl 5.14), we need to remove the meta-spec
+        # entry below for EUMM 6.57_02 to 6.57_06 (the buggy versions
+        # included with perl 5.14).  Otherwise installation will break.
+        # See https://github.com/Perl-Toolchain-Gang/CPAN-Meta/issues/118
+        # for details.
         'Test::More' => '0.47',
     },
     META_MERGE      => {
-        resources   => {
-            repository  => 'git://perl5.git.perl.org/perl.git',
-            license     => 'http://dev.perl.org/licenses/',
+        'meta-spec'     => { version => 2 },
+        dynamic_config  => 0,
+        resources       => {
+            repository  => {
+                type        => 'git',
+                url         => 'git://perl5.git.perl.org/perl.git',
+            },
             homepage    => 'https://metacpan.org/module/XSLoader',
-            irc         => 'irc://irc.perl.org/#p5p',
-            mailinglist => 'http://lists.perl.org/list/perl5-porters.html',
-            bugtracker  => "https://rt.perl.org/rt3/Search/Results.html?Query=Queue='perl5' AND Content LIKE 'module=XSLoader' AND (Status='open' OR Status='new' OR Status='stalled')",
+            x_IRC       => 'irc://irc.perl.org/#p5p',
+            x_MailingList => 'http://lists.perl.org/list/perl5-porters.html',
+            bugtracker => {
+                mailto      => 'perlbug@perl.org',
+                web         => "https://rt.perl.org/rt3/Search/Results.html?Query=Queue='perl5' AND Content LIKE 'module=XSLoader' AND (Status='open' OR Status='new' OR Status='stalled')",
+            },
+        },
+        provides    => {
+            'XSLoader'  => {
+                file        => 'XSLoader_pm.PL',
+                version     => ${$PACKAGE.'::VERSION'},
+            },
         },
     },
     dist            => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
index 44d579f76800a48db961599d5db3c6a96b1c6bda..07755298acb5f44c981310444f13acbd5db44e0e 100644 (file)
@@ -70,7 +70,7 @@
       pseudohashes
     * Fixing inheritance from classes which have only private fields
     * Fixing inheritance when an intermediate class has no fields.
-      [perlbug 20020326.004]
+      [perlbug 20020326.004 (#8884)]
     - Removing uses of 'our' from tests for backwards compat.
 
 2.02 Wed Sep  3 20:40:13 PDT 2003
index 6fee6008fc20785ca2be6db7bbf6146caa92fd56..38c91c731c58787017892f0b7c9b61b1f950af7f 100644 (file)
@@ -3,7 +3,7 @@ package base;
 
 use strict 'vars';
 use vars qw($VERSION);
-$VERSION = '2.23';
+$VERSION = '2.24';
 $VERSION =~ tr/_//d;
 
 # constant.pm is slow
@@ -97,7 +97,11 @@ sub import {
             {
                 local $SIG{__DIE__};
                 my $fn = _module_to_filename($base);
-                eval { require $fn };
+                local @INC = @INC;
+                pop @INC if my $dotty = $INC[-1] eq '.';
+                eval {
+                    require $fn
+                };
                 # Only ignore "Can't locate" errors from our eval require.
                 # Other fatal errors (syntax etc) must be reported.
                 #
@@ -111,11 +115,24 @@ sub import {
                 unless (%{"$base\::"}) {
                     require Carp;
                     local $" = " ";
-                    Carp::croak(<<ERROR);
+                    my $e = <<ERROR;
 Base class package "$base" is empty.
     (Perhaps you need to 'use' the module which defines that package first,
     or make that module available in \@INC (\@INC contains: @INC).
 ERROR
+                    if ($dotty && -e $fn) {
+                        $e .= <<ERROS;
+    The file $fn does exist in the current directory.  But note
+    that base.pm, when loading a module, now ignores the current working
+    directory if it is the last entry in \@INC.  If your software worked on
+    previous versions of Perl, the best solution is to use FindBin to
+    detect the path properly and to add that path to \@INC.  As a last
+    resort, you can re-enable looking in the current working directory by
+    adding "use lib '.'" to your code.
+ERROS
+                    }
+                    $e =~ s/\n\z/)\n/;
+                    Carp::croak($e);
                 }
                 $sigdie = $SIG{__DIE__} || undef;
             }
diff --git a/dist/base/t/incdot.t b/dist/base/t/incdot.t
new file mode 100644 (file)
index 0000000..1619492
--- /dev/null
@@ -0,0 +1,19 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use base ();
+
+use Test::More tests => 2;
+
+if ($INC[-1] ne '.') { push @INC, '.' }
+
+my $inc = quotemeta "@INC[0..$#INC-1]";
+
+eval { 'base'->import("foo") };
+like $@, qr/\@INC contains: $inc\).\)/,
+    'Error does not list final dot in @INC (or mention use lib)';
+eval { 'base'->import('t::lib::Dummy') };
+like $@, qr<\@INC contains: $inc\).\n(?x:
+           )    The file t/lib/Dummy\.pm does exist in the current direct>,
+    'special cur dir message for existing files in . that are ignored';
diff --git a/doio.c b/doio.c
index 856b19a12a2b0ca048cded9604d5a414485729ab..b8f3c2803f748eba5e5b3b10a58b5313b8b6e052 100644 (file)
--- a/doio.c
+++ b/doio.c
@@ -1845,18 +1845,8 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp)
                         int fd = PerlIO_fileno(IoIFP(GvIOn(gv)));
                        APPLY_TAINT_PROPER();
                         if (fd < 0) {
-                           SETERRNO(EBADF,RMS_IFI);
-                           tot--;
-#if Uid_t_sign == 1
-                       } else if (val < 0) {
-                           SETERRNO(EINVAL,LIB_INVARG);
-                           tot--;
-#endif
-#if Gid_t_sign == 1
-                       } else if (val2 < 0) {
-                           SETERRNO(EINVAL,LIB_INVARG);
+                            SETERRNO(EBADF,RMS_IFI);
                            tot--;
-#endif
                         } else if (fchown(fd, val, val2))
                            tot--;
 #else
@@ -2608,14 +2598,11 @@ Perl_vms_start_glob
 #endif /* !CSH */
 #endif /* !DOSISH */
     {
-       GV * const envgv = gv_fetchpvs("ENV", 0, SVt_PVHV);
-       SV ** const home = hv_fetchs(GvHV(envgv), "HOME", 0);
-       SV ** const path = hv_fetchs(GvHV(envgv), "PATH", 0);
-       if (home && *home) SvGETMAGIC(*home);
-       if (path && *path) SvGETMAGIC(*path);
-       save_hash(gv_fetchpvs("ENV", 0, SVt_PVHV));
-       if (home && *home) SvSETMAGIC(*home);
-       if (path && *path) SvSETMAGIC(*path);
+        SV ** const svp = hv_fetchs(GvHVn(PL_envgv), "LS_COLORS", 0);
+        if (svp && *svp)
+            save_helem_flags(GvHV(PL_envgv),
+                             newSVpvs_flags("LS_COLORS", SVs_TEMP), svp,
+                             SAVEf_SETMAGIC);
     }
     (void)do_open6(PL_last_in_gv, SvPVX_const(tmpcmd), SvCUR(tmpcmd),
                    NULL, NULL, 0);
diff --git a/dump.c b/dump.c
index c168162791b1573938cc37e11c4447555f2927ab..fd3d7ccfb716762d4359fea729256394326c2e73 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -1672,14 +1672,16 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo
        if (AvREIFY(sv))        sv_catpv(d, ",REIFY");
        Perl_dump_indent(aTHX_ level, file, "  FLAGS = (%s)\n",
                         SvCUR(d) ? SvPVX_const(d) + 1 : "");
-       if (nest < maxnest && av_tindex(MUTABLE_AV(sv)) >= 0) {
+       if (nest < maxnest && AvARRAY(MUTABLE_AV(sv))) {
            SSize_t count;
-           for (count = 0; count <=  av_tindex(MUTABLE_AV(sv)) && count < maxnest; count++) {
-               SV** const elt = av_fetch(MUTABLE_AV(sv),count,0);
-
+            SV **svp = AvARRAY(MUTABLE_AV(sv));
+           for (count = 0;
+                 count <= AvFILLp(MUTABLE_AV(sv)) && count < maxnest;
+                 count++, svp++)
+            {
+               SV* const elt = *svp;
                Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count);
-               if (elt)
-                   do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim);
+                do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim);
            }
        }
        break;
@@ -2514,6 +2516,7 @@ Perl_debop(pTHX_ const OP *o)
     case OP_PADSV:
     case OP_PADAV:
     case OP_PADHV:
+    case OP_ARGELEM:
         S_deb_padvar(aTHX_ o->op_targ, 1, 1);
         break;
 
index abc11873abc8fdb3223d173bb1cc68495379b598..38e8cf9347d160c0eea301325a62f4fb896fb2b4 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
 :      If the function is only exported for use in a public
 :      macro, see X.
 :
-:   a  Allocates memory a la malloc/calloc.  Also implies "R":
+:   a  Allocates memory a la malloc/calloc.  Also implies "R".
+:      This should only be on functions which returns 'empty' memory
+:      which has no other pointers to it, and which does not contain
+:      any pointers to other things. So for example realloc() can't be
+:      'a'.
 :
 :         proto.h: add __attribute__malloc__
 :
@@ -202,7 +206,7 @@ Ano |PerlInterpreter*|perl_clone_using \
 
 Aanop  |Malloc_t|malloc        |MEM_SIZE nbytes
 Aanop  |Malloc_t|calloc        |MEM_SIZE elements|MEM_SIZE size
-Aanop  |Malloc_t|realloc       |Malloc_t where|MEM_SIZE nbytes
+ARnop  |Malloc_t|realloc       |Malloc_t where|MEM_SIZE nbytes
 Anop   |Free_t |mfree          |Malloc_t where
 #if defined(MYMALLOC)
 npR    |MEM_SIZE|malloced_size |NN void *p
@@ -298,6 +302,7 @@ Anprd       |void   |croak_xs_usage |NN const CV *const cv \
                                |NN const char *const params
 npr    |void   |croak_no_mem
 nprX   |void   |croak_popstack
+fnrp   |void   |croak_caller|NULLOK const char* pat|...
 fnprx  |void   |noperl_die|NN const char* pat|...
 #if defined(WIN32)
 norx   |void   |win32_croak_not_implemented|NN const char * fname
@@ -475,7 +480,6 @@ Apd |void   |fbm_compile    |NN SV* sv|U32 flags
 ApdR   |char*  |fbm_instr      |NN unsigned char* big|NN unsigned char* bigend \
                                |NN SV* littlestr|U32 flags
 p      |CV *   |find_lexical_cv|PADOFFSET off
-pR     |OP *   |parse_subsignature
 : Defined in util.c, used only in perl.c
 p      |char*  |find_script    |NN const char *scriptname|bool dosearch \
                                |NULLOK const char *const *const search_ext|I32 flags
@@ -986,27 +990,28 @@ Afp       |char * |my_strftime    |NN const char *fmt|int sec|int min|int hour|int mday|i
 p      |void   |my_unexec
 AbDMnPR        |UV     |NATIVE_TO_NEED |const UV enc|const UV ch
 AbDMnPR        |UV     |ASCII_TO_NEED  |const UV enc|const UV ch
-Apa    |OP*    |newANONLIST    |NULLOK OP* o
-Apa    |OP*    |newANONHASH    |NULLOK OP* o
+ApR    |OP*    |newANONLIST    |NULLOK OP* o
+ApR    |OP*    |newANONHASH    |NULLOK OP* o
 Ap     |OP*    |newANONSUB     |I32 floor|NULLOK OP* proto|NULLOK OP* block
-Apda   |OP*    |newASSIGNOP    |I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right
-Apda   |OP*    |newCONDOP      |I32 flags|NN OP* first|NULLOK OP* trueop|NULLOK OP* falseop
+ApdR   |OP*    |newASSIGNOP    |I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right
+ApdR   |OP*    |newCONDOP      |I32 flags|NN OP* first|NULLOK OP* trueop|NULLOK OP* falseop
 Apd    |CV*    |newCONSTSUB    |NULLOK HV* stash|NULLOK const char* name|NULLOK SV* sv
 Apd    |CV*    |newCONSTSUB_flags|NULLOK HV* stash \
                                  |NULLOK const char* name|STRLEN len \
                                  |U32 flags|NULLOK SV* sv
 Ap     |void   |newFORM        |I32 floor|NULLOK OP* o|NULLOK OP* block
-Apda   |OP*    |newFOROP       |I32 flags|NULLOK OP* sv|NN OP* expr|NULLOK OP* block|NULLOK OP* cont
-Apda   |OP*    |newGIVENOP     |NN OP* cond|NN OP* block|PADOFFSET defsv_off
-Apda   |OP*    |newLOGOP       |I32 optype|I32 flags|NN OP *first|NN OP *other
-Apda   |OP*    |newLOOPEX      |I32 type|NN OP* label
-Apda   |OP*    |newLOOPOP      |I32 flags|I32 debuggable|NULLOK OP* expr|NULLOK OP* block
-Apda   |OP*    |newNULLLIST
-Apda   |OP*    |newOP          |I32 optype|I32 flags
+ApdR   |OP*    |newFOROP       |I32 flags|NULLOK OP* sv|NN OP* expr|NULLOK OP* block|NULLOK OP* cont
+ApdR   |OP*    |newGIVENOP     |NN OP* cond|NN OP* block|PADOFFSET defsv_off
+ApdR   |OP*    |newLOGOP       |I32 optype|I32 flags|NN OP *first|NN OP *other
+pM     |LOGOP* |alloc_LOGOP    |I32 type|NULLOK OP *first|NULLOK OP *other
+ApdR   |OP*    |newLOOPEX      |I32 type|NN OP* label
+ApdR   |OP*    |newLOOPOP      |I32 flags|I32 debuggable|NULLOK OP* expr|NULLOK OP* block
+ApdR   |OP*    |newNULLLIST
+ApdR   |OP*    |newOP          |I32 optype|I32 flags
 Ap     |void   |newPROG        |NN OP* o
-Apda   |OP*    |newRANGE       |I32 flags|NN OP* left|NN OP* right
-Apda   |OP*    |newSLICEOP     |I32 flags|NULLOK OP* subscript|NULLOK OP* listop
-Apda   |OP*    |newSTATEOP     |I32 flags|NULLOK char* label|NULLOK OP* o
+ApdR   |OP*    |newRANGE       |I32 flags|NN OP* left|NN OP* right
+ApdR   |OP*    |newSLICEOP     |I32 flags|NULLOK OP* subscript|NULLOK OP* listop
+ApdR   |OP*    |newSTATEOP     |I32 flags|NULLOK char* label|NULLOK OP* o
 Apbm   |CV*    |newSUB         |I32 floor|NULLOK OP* o|NULLOK OP* proto \
                                |NULLOK OP* block
 p      |CV *   |newXS_len_flags|NULLOK const char *name|STRLEN len \
@@ -1021,56 +1026,56 @@ ApM     |CV *   |newXS_flags    |NULLOK const char *name|NN XSUBADDR_t subaddr\
 Apd    |CV*    |newXS          |NULLOK const char *name|NN XSUBADDR_t subaddr\
                                |NN const char *filename
 ApmdbR |AV*    |newAV
-Apa    |OP*    |newAVREF       |NN OP* o
-Apda   |OP*    |newBINOP       |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last
-Apa    |OP*    |newCVREF       |I32 flags|NULLOK OP* o
-Apda   |OP*    |newGVOP        |I32 type|I32 flags|NN GV* gv
+ApR    |OP*    |newAVREF       |NN OP* o
+ApdR   |OP*    |newBINOP       |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last
+ApR    |OP*    |newCVREF       |I32 flags|NULLOK OP* o
+ApdR   |OP*    |newGVOP        |I32 type|I32 flags|NN GV* gv
 Am     |GV*    |newGVgen       |NN const char* pack
-Apa    |GV*    |newGVgen_flags |NN const char* pack|U32 flags
-Apa    |OP*    |newGVREF       |I32 type|NULLOK OP* o
-ApaR   |OP*    |newHVREF       |NN OP* o
+ApR    |GV*    |newGVgen_flags |NN const char* pack|U32 flags
+ApR    |OP*    |newGVREF       |I32 type|NULLOK OP* o
+Ap   |OP*    |newHVREF       |NN OP* o
 ApmdbR |HV*    |newHV
-ApaR   |HV*    |newHVhv        |NULLOK HV *hv
-Apabm  |IO*    |newIO
-Apda   |OP*    |newLISTOP      |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last
-AMpdan |PADNAME *|newPADNAMEouter|NN PADNAME *outer
-AMpdan |PADNAME *|newPADNAMEpvn|NN const char *s|STRLEN len
-AMpdan |PADNAMELIST *|newPADNAMELIST|size_t max
+Ap   |HV*    |newHVhv        |NULLOK HV *hv
+ApRbm  |IO*    |newIO
+ApdR   |OP*    |newLISTOP      |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last
+AMpdRn |PADNAME *|newPADNAMEouter|NN PADNAME *outer
+AMpdRn |PADNAME *|newPADNAMEpvn|NN const char *s|STRLEN len
+AMpdRn |PADNAMELIST *|newPADNAMELIST|size_t max
 #ifdef USE_ITHREADS
-Apda   |OP*    |newPADOP       |I32 type|I32 flags|NN SV* sv
-#endif
-Apda   |OP*    |newPMOP        |I32 type|I32 flags
-Apda   |OP*    |newPVOP        |I32 type|I32 flags|NULLOK char* pv
-Apa    |SV*    |newRV          |NN SV *const sv
-Apda   |SV*    |newRV_noinc    |NN SV *const tmpRef
-Apda   |SV*    |newSV          |const STRLEN len
-Apa    |OP*    |newSVREF       |NN OP* o
-Apda   |OP*    |newSVOP        |I32 type|I32 flags|NN SV* sv
+ApdR   |OP*    |newPADOP       |I32 type|I32 flags|NN SV* sv
+#endif
+ApdR   |OP*    |newPMOP        |I32 type|I32 flags
+ApdR   |OP*    |newPVOP        |I32 type|I32 flags|NULLOK char* pv
+ApR    |SV*    |newRV          |NN SV *const sv
+ApdR   |SV*    |newRV_noinc    |NN SV *const tmpRef
+ApdR   |SV*    |newSV          |const STRLEN len
+ApR    |OP*    |newSVREF       |NN OP* o
+ApdR   |OP*    |newSVOP        |I32 type|I32 flags|NN SV* sv
 ApdR   |OP*    |newDEFSVOP
-pa     |SV*    |newSVavdefelem |NN AV *av|SSize_t ix|bool extendible
-Apda   |SV*    |newSViv        |const IV i
-Apda   |SV*    |newSVuv        |const UV u
-Apda   |SV*    |newSVnv        |const NV n
-Apda   |SV*    |newSVpv        |NULLOK const char *const s|const STRLEN len
-Apda   |SV*    |newSVpvn       |NULLOK const char *const s|const STRLEN len
-Apda   |SV*    |newSVpvn_flags |NULLOK const char *const s|const STRLEN len|const U32 flags
-Apda   |SV*    |newSVhek       |NULLOK const HEK *const hek
-Apda   |SV*    |newSVpvn_share |NULLOK const char* s|I32 len|U32 hash
-Apda   |SV*    |newSVpv_share  |NULLOK const char* s|U32 hash
-Afpda  |SV*    |newSVpvf       |NN const char *const pat|...
-Apa    |SV*    |vnewSVpvf      |NN const char *const pat|NULLOK va_list *const args
+pR     |SV*    |newSVavdefelem |NN AV *av|SSize_t ix|bool extendible
+ApdR   |SV*    |newSViv        |const IV i
+ApdR   |SV*    |newSVuv        |const UV u
+ApdR   |SV*    |newSVnv        |const NV n
+ApdR   |SV*    |newSVpv        |NULLOK const char *const s|const STRLEN len
+ApdR   |SV*    |newSVpvn       |NULLOK const char *const s|const STRLEN len
+ApdR   |SV*    |newSVpvn_flags |NULLOK const char *const s|const STRLEN len|const U32 flags
+ApdR   |SV*    |newSVhek       |NULLOK const HEK *const hek
+ApdR   |SV*    |newSVpvn_share |NULLOK const char* s|I32 len|U32 hash
+ApdR   |SV*    |newSVpv_share  |NULLOK const char* s|U32 hash
+AfpdR  |SV*    |newSVpvf       |NN const char *const pat|...
+ApR    |SV*    |vnewSVpvf      |NN const char *const pat|NULLOK va_list *const args
 Apd    |SV*    |newSVrv        |NN SV *const rv|NULLOK const char *const classname
-Apda   |SV*    |newSVsv        |NULLOK SV *const old
-Apda   |SV*    |newSV_type     |const svtype type
-Apda   |OP*    |newUNOP        |I32 type|I32 flags|NULLOK OP* first
-Apda   |OP*    |newUNOP_AUX    |I32 type|I32 flags|NULLOK OP* first \
+ApdR   |SV*    |newSVsv        |NULLOK SV *const old
+ApdR   |SV*    |newSV_type     |const svtype type
+ApdR   |OP*    |newUNOP        |I32 type|I32 flags|NULLOK OP* first
+ApdR   |OP*    |newUNOP_AUX    |I32 type|I32 flags|NULLOK OP* first \
                                |NULLOK UNOP_AUX_item *aux
-Apda   |OP*    |newWHENOP      |NULLOK OP* cond|NN OP* block
-Apda   |OP*    |newWHILEOP     |I32 flags|I32 debuggable|NULLOK LOOP* loop \
+ApdR   |OP*    |newWHENOP      |NULLOK OP* cond|NN OP* block
+ApdR   |OP*    |newWHILEOP     |I32 flags|I32 debuggable|NULLOK LOOP* loop \
                                |NULLOK OP* expr|NULLOK OP* block|NULLOK OP* cont \
                                |I32 has_my
-Apda   |OP*    |newMETHOP      |I32 type|I32 flags|NN OP* dynamic_meth
-Apda   |OP*    |newMETHOP_named|I32 type|I32 flags|NN SV* const_meth
+ApdR   |OP*    |newMETHOP      |I32 type|I32 flags|NN OP* dynamic_meth
+ApdR   |OP*    |newMETHOP_named|I32 type|I32 flags|NN SV* const_meth
 Apd    |CV*    |rv2cv_op_cv    |NN OP *cvop|U32 flags
 Apd    |OP*    |ck_entersub_args_list|NN OP *entersubop
 Apd    |OP*    |ck_entersub_args_proto|NN OP *entersubop|NN GV *namegv|NN SV *protosv
@@ -1083,7 +1088,7 @@ Apd       |void   |cv_set_call_checker_flags|NN CV *cv \
                                          |NN Perl_call_checker ckfun \
                                          |NN SV *ckobj|U32 flags
 Apd    |void   |wrap_op_checker|Optype opcode|NN Perl_check_t new_checker|NN Perl_check_t *old_checker_p
-Apa    |PERL_SI*|new_stackinfo|I32 stitems|I32 cxitems
+ApR    |PERL_SI*|new_stackinfo|I32 stitems|I32 cxitems
 Ap     |char*  |scan_vstring   |NN const char *s|NN const char *const e \
                                |NN SV *sv
 Apd    |const char*    |scan_version   |NN const char *s|NN SV *rv|bool qv
@@ -1480,8 +1485,8 @@ Ein       |bool   |sv_only_taint_gmagic|NN SV *sv
 #endif
 : exported for re.pm
 EXp    |MAGIC *|sv_magicext_mglob|NN SV *sv
-ApdbamR        |SV*    |sv_mortalcopy  |NULLOK SV *const oldsv
-XpaR   |SV*    |sv_mortalcopy_flags|NULLOK SV *const oldsv|U32 flags
+ApdbmR |SV*    |sv_mortalcopy  |NULLOK SV *const oldsv
+Xp   |SV*    |sv_mortalcopy_flags|NULLOK SV *const oldsv|U32 flags
 ApdR   |SV*    |sv_newmortal
 Apd    |SV*    |sv_newref      |NULLOK SV *const sv
 Ap     |char*  |sv_peek        |NULLOK SV* sv
@@ -1546,11 +1551,11 @@ ApRM    |SV*    |swash_init     |NN const char* pkg|NN const char* name|NN SV* listsv|I32
 ApM    |UV     |swash_fetch    |NN SV *swash|NN const U8 *ptr|bool do_utf8
 #ifdef PERL_IN_REGCOMP_C
 EiMR   |SV*    |add_cp_to_invlist      |NULLOK SV* invlist|const UV cp
-EiMRn  |UV*    |_invlist_array_init    |NN SV* const invlist|const bool will_have_0
-EiMRn  |UV     |invlist_max    |NN SV* const invlist
 EiM    |void   |invlist_set_len|NN SV* const invlist|const UV len|const bool offset
 EiMRn  |bool   |invlist_is_iterating|NN SV* const invlist
 #ifndef PERL_EXT_RE_BUILD
+EiMRn  |UV*    |_invlist_array_init    |NN SV* const invlist|const bool will_have_0
+EiMRn  |UV     |invlist_max    |NN SV* const invlist
 EsM    |void   |_append_range_to_invlist   |NN SV* const invlist|const UV start|const UV end
 EsM    |void   |invlist_extend    |NN SV* const invlist|const UV len
 EsM    |void   |invlist_replace_list_destroys_src|NN SV *dest|NN SV *src
@@ -1770,7 +1775,7 @@ Ap        |int    |get_mstats     |NN perl_mstats_t *buf|int buflen|int level
 #endif
 Anpa   |Malloc_t|safesysmalloc |MEM_SIZE nbytes
 Anpa   |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size
-Anpa   |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes
+AnpR   |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes
 Anp    |Free_t |safesysfree    |Malloc_t where
 Asrnx  |void   |croak_memory_wrap
 #if defined(PERL_GLOBAL_STRUCT)
@@ -1857,7 +1862,7 @@ p |OP *   |my_attrs       |NN OP *o|NULLOK OP *attrs
 #if defined(USE_ITHREADS)
 ApR    |PERL_CONTEXT*|cx_dup   |NULLOK PERL_CONTEXT* cx|I32 ix|I32 max|NN CLONE_PARAMS* param
 ApR    |PERL_SI*|si_dup        |NULLOK PERL_SI* si|NN CLONE_PARAMS* param
-Apa    |ANY*   |ss_dup         |NN PerlInterpreter* proto_perl|NN CLONE_PARAMS* param
+ApR    |ANY*   |ss_dup         |NN PerlInterpreter* proto_perl|NN CLONE_PARAMS* param
 ApR    |void*  |any_dup        |NULLOK void* v|NN const PerlInterpreter* proto_perl
 ApR    |HE*    |he_dup         |NULLOK const HE* e|bool shared|NN CLONE_PARAMS* param
 ApR    |HEK*   |hek_dup        |NULLOK HEK* e|NN CLONE_PARAMS* param
@@ -1879,7 +1884,7 @@ ApR       |SV*    |sv_dup_inc     |NULLOK const SV *const sstr \
 Ap     |void   |rvpv_dup       |NN SV *const dstr|NN const SV *const sstr|NN CLONE_PARAMS *const param
 Ap     |yy_parser*|parser_dup  |NULLOK const yy_parser *const proto|NN CLONE_PARAMS *const param
 #endif
-Apa    |PTR_TBL_t*|ptr_table_new
+ApR    |PTR_TBL_t*|ptr_table_new
 ApR    |void*  |ptr_table_fetch|NN PTR_TBL_t *const tbl|NULLOK const void *const sv
 Ap     |void   |ptr_table_store|NN PTR_TBL_t *const tbl|NULLOK const void *const oldsv \
                                |NN void *const newsv
@@ -1928,13 +1933,14 @@ s  |bool|find_default_stash|NN HV **stash|NN const char *name \
                      |STRLEN len|const U32 is_utf8|const I32 add \
                      |const svtype sv_type
 s  |bool|gv_magicalize|NN GV *gv|NN HV *stash|NN const char *name \
-                     |STRLEN len|bool addmg \
+                     |STRLEN len \
                      |const svtype sv_type
 s  |void|maybe_multimagic_gv|NN GV *gv|NN const char *name|const svtype sv_type
 s  |bool|gv_is_in_main|NN const char *name|STRLEN len \
                       |const U32 is_utf8
-s      |HV*    |require_tie_mod|NN GV *gv|NN const char *varpv|NN SV* namesv \
-                               |NN const char *methpv|const U32 flags
+s      |void   |require_tie_mod|NN GV *gv|NN const char varname \
+                               |NN const char * name|STRLEN len \
+                               |const U32 flags
 #endif
 
 #if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
@@ -1945,7 +1951,7 @@ po        |SV*    |hfree_next_entry       |NN HV *hv|NN STRLEN *indexp
 s      |void   |hsplit         |NN HV *hv|STRLEN const oldsize|STRLEN newsize
 s      |void   |hfreeentries   |NN HV *hv
 s      |SV*    |hv_free_ent_ret|NN HV *hv|NN HE *entry
-sa     |HE*    |new_he
+sR     |HE*    |new_he
 sanR   |HEK*   |save_hek_flags |NN const char *str|I32 len|U32 hash|int flags
 sn     |void   |hv_magic_check |NN HV *hv|NN bool *needs_copy|NN bool *needs_store
 s      |void   |unshare_hek_or_pvn|NULLOK const HEK* hek|NULLOK const char* str|I32 len|U32 hash
@@ -2005,7 +2011,7 @@ s |bool   |process_special_blocks |I32 floor \
 s      |void   |clear_special_blocks   |NN const char *const fullname\
                                        |NN GV *const gv|NN CV *const cv
 #endif
-Xpa    |void*  |Slab_Alloc     |size_t sz
+XpR    |void*  |Slab_Alloc     |size_t sz
 Xp     |void   |Slab_Free      |NN void *op
 #if defined(PERL_DEBUG_READONLY_OPS)
 #    if defined(PERL_CORE)
@@ -2132,7 +2138,7 @@ s |OP*    |doform         |NN CV *cv|NN GV *gv|NULLOK OP *retop
 #  if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
 sR     |int    |dooneliner     |NN const char *cmd|NN const char *filename
 #  endif
-s      |SV *   |space_join_names_mortal|NN char *const *array
+s      |SV *   |space_join_names_mortal|NULLOK char *const *array
 #endif
 p      |OP *   |tied_method|NN SV *methname|NN SV **sp \
                                |NN SV *const sv|NN const MAGIC *const mg \
@@ -2567,6 +2573,13 @@ s        |bool   |isa_lookup     |NN HV *stash|NN const char * const name \
 
 #if defined(USE_LOCALE) && defined(PERL_IN_LOCALE_C)
 s      |char*  |stdize_locale  |NN char* locs
+#   ifdef DEBUGGING
+s      |void   |print_collxfrm_input_and_return                \
+                           |NN const char * const s            \
+                           |NN const char * const e            \
+                           |NULLOK const STRLEN * const xlen   \
+                           |const bool is_utf8
+#   endif
 #endif
 
 #if defined(USE_LOCALE) \
@@ -2631,7 +2644,7 @@ Apd       |void   |sv_catsv_flags |NN SV *const dsv|NULLOK SV *const ssv|const I32 flags
 Apmd   |STRLEN |sv_utf8_upgrade_flags|NN SV *const sv|const I32 flags
 Ap     |STRLEN |sv_utf8_upgrade_flags_grow|NN SV *const sv|const I32 flags|STRLEN extra
 Apd    |char*  |sv_pvn_force_flags|NN SV *const sv|NULLOK STRLEN *const lp|const I32 flags
-pmb    |void   |sv_copypv      |NN SV *const dsv|NN SV *const ssv
+Apmb   |void   |sv_copypv      |NN SV *const dsv|NN SV *const ssv
 Apmd   |void   |sv_copypv_nomg |NN SV *const dsv|NN SV *const ssv
 Apd    |void   |sv_copypv_flags        |NN SV *const dsv|NN SV *const ssv|const I32 flags
 Ap     |char*  |my_atof2       |NN const char *s|NN NV* value
@@ -2685,7 +2698,7 @@ s |void   |deb_stack_n    |NN SV** stack_base|I32 stack_min \
 #endif
 
 : pad API
-Apda   |PADLIST*|pad_new       |int flags
+ApdR   |PADLIST*|pad_new       |int flags
 #ifdef DEBUGGING
 pnX    |void|set_padlist| NN CV * cv | NULLOK PADLIST * padlist
 #endif
@@ -2825,7 +2838,7 @@ s |bool   |ckwarn_common  |U32 w
 Apo    |bool   |ckwarn         |U32 w
 Apo    |bool   |ckwarn_d       |U32 w
 : FIXME - exported for ByteLoader - public or private?
-XEopMa |STRLEN *|new_warnings_bitfield|NULLOK STRLEN *buffer \
+XEopMR |STRLEN *|new_warnings_bitfield|NULLOK STRLEN *buffer \
                                |NN const char *const bits|STRLEN size
 
 #ifndef SPRINTF_RETURNS_STRLEN
@@ -2927,7 +2940,7 @@ xpo       |int    |keyword_plugin_standard|NN char* keyword_ptr|STRLEN keyword_len|NN OP*
 #  if defined(PERL_IN_SV_C)
 s      |void   |unreferenced_to_tmp_stack|NN AV *const unreferenced
 #  endif
-Aanop  |CLONE_PARAMS *|clone_params_new|NN PerlInterpreter *const from \
+ARnop  |CLONE_PARAMS *|clone_params_new|NN PerlInterpreter *const from \
                |NN PerlInterpreter *const to
 Anop   |void   |clone_params_del|NN CLONE_PARAMS *param
 #endif
diff --git a/embed.h b/embed.h
index b4405090aed568720bf5515b16205a69362a2bda..f3a855e9e483497dc1d7bc6f15925f4e9db326c8 100644 (file)
--- a/embed.h
+++ b/embed.h
 #  if !defined(PERL_EXT_RE_BUILD)
 #    if defined(PERL_IN_REGCOMP_C)
 #define _append_range_to_invlist(a,b,c)        S__append_range_to_invlist(aTHX_ a,b,c)
+#define _invlist_array_init    S__invlist_array_init
 #define get_invlist_previous_index_addr        S_get_invlist_previous_index_addr
 #define invlist_clear(a)       S_invlist_clear(aTHX_ a)
 #define invlist_extend(a,b)    S_invlist_extend(aTHX_ a,b)
+#define invlist_max            S_invlist_max
 #define invlist_previous_index S_invlist_previous_index
 #define invlist_replace_list_destroys_src(a,b) S_invlist_replace_list_destroys_src(aTHX_ a,b)
 #define invlist_set_previous_index     S_invlist_set_previous_index
 #define sv_or_pv_pos_u2b(a,b,c,d)      S_sv_or_pv_pos_u2b(aTHX_ a,b,c,d)
 #  endif
 #  if defined(PERL_IN_REGCOMP_C)
-#define _invlist_array_init    S__invlist_array_init
 #define _make_exactf_invlist(a,b)      S__make_exactf_invlist(aTHX_ a,b)
 #define add_above_Latin1_folds(a,b,c)  S_add_above_Latin1_folds(aTHX_ a,b,c)
 #define add_cp_to_invlist(a,b) S_add_cp_to_invlist(aTHX_ a,b)
 #define invlist_iterfinish     S_invlist_iterfinish
 #define invlist_iterinit       S_invlist_iterinit
 #define invlist_iternext       S_invlist_iternext
-#define invlist_max            S_invlist_max
 #define invlist_set_len(a,b,c) S_invlist_set_len(aTHX_ a,b,c)
 #define is_ssc_worth_it                S_is_ssc_worth_it
 #define join_exact(a,b,c,d,e,f,g)      S_join_exact(aTHX_ a,b,c,d,e,f,g)
 #ifdef PERL_CORE
 #define Slab_Alloc(a)          Perl_Slab_Alloc(aTHX_ a)
 #define Slab_Free(a)           Perl_Slab_Free(aTHX_ a)
+#define alloc_LOGOP(a,b,c)     Perl_alloc_LOGOP(aTHX_ a,b,c)
 #define allocmy(a,b,c)         Perl_allocmy(aTHX_ a,b,c)
 #define amagic_is_enabled(a)   Perl_amagic_is_enabled(aTHX_ a)
 #define apply(a,b,c)           Perl_apply(aTHX_ a,b,c)
 #define core_prototype(a,b,c,d)        Perl_core_prototype(aTHX_ a,b,c,d)
 #define coresub_op(a,b,c)      Perl_coresub_op(aTHX_ a,b,c)
 #define create_eval_scope(a,b) Perl_create_eval_scope(aTHX_ a,b)
+#define croak_caller           Perl_croak_caller
 #define croak_no_mem           Perl_croak_no_mem
 #define croak_popstack         Perl_croak_popstack
 #define custom_op_get_field(a,b)       Perl_custom_op_get_field(aTHX_ a,b)
 #define pad_push(a,b)          Perl_pad_push(aTHX_ a,b)
 #define pad_swipe(a,b)         Perl_pad_swipe(aTHX_ a,b)
 #define padlist_store(a,b,c)   Perl_padlist_store(aTHX_ a,b,c)
-#define parse_subsignature()   Perl_parse_subsignature(aTHX)
 #define parse_unicode_opts(a)  Perl_parse_unicode_opts(aTHX_ a)
 #define parser_free(a)         Perl_parser_free(aTHX_ a)
 #define peep(a)                        Perl_peep(aTHX_ a)
 #define printbuf(a,b)          S_printbuf(aTHX_ a,b)
 #define tokereport(a,b)                S_tokereport(aTHX_ a,b)
 #    endif
+#    if defined(USE_LOCALE) && defined(PERL_IN_LOCALE_C)
+#define print_collxfrm_input_and_return(a,b,c,d)       S_print_collxfrm_input_and_return(aTHX_ a,b,c,d)
+#    endif
 #  endif
 #  if defined(DEBUG_LEAKING_SCALARS_FORK_DUMP)
 #define dump_sv_child(a)       Perl_dump_sv_child(aTHX_ a)
 #define gv_fetchmeth_internal(a,b,c,d,e,f)     S_gv_fetchmeth_internal(aTHX_ a,b,c,d,e,f)
 #define gv_init_svtype(a,b)    S_gv_init_svtype(aTHX_ a,b)
 #define gv_is_in_main(a,b,c)   S_gv_is_in_main(aTHX_ a,b,c)
-#define gv_magicalize(a,b,c,d,e,f)     S_gv_magicalize(aTHX_ a,b,c,d,e,f)
+#define gv_magicalize(a,b,c,d,e)       S_gv_magicalize(aTHX_ a,b,c,d,e)
 #define gv_magicalize_isa(a)   S_gv_magicalize_isa(aTHX_ a)
 #define gv_stashpvn_internal(a,b,c)    S_gv_stashpvn_internal(aTHX_ a,b,c)
 #define gv_stashsvpvn_cached(a,b,c,d)  S_gv_stashsvpvn_cached(aTHX_ a,b,c,d)
index ec0b7b182d2213485d6a36753a89c9787f1fdc31..18f2c99547f7c396fd8e81013f5af687bcd840bf 100644 (file)
 #define PL_markstack_max       (vTHX->Imarkstack_max)
 #define PL_markstack_ptr       (vTHX->Imarkstack_ptr)
 #define PL_max_intro_pending   (vTHX->Imax_intro_pending)
-#define PL_maxo                        (vTHX->Imaxo)
 #define PL_maxsysfd            (vTHX->Imaxsysfd)
 #define PL_memory_debug_header (vTHX->Imemory_debug_header)
 #define PL_mess_sv             (vTHX->Imess_sv)
 
 #if defined(PERL_GLOBAL_STRUCT)
 
+#define PL_C_locale_obj                (my_vars->GC_locale_obj)
+#define PL_GC_locale_obj       (my_vars->GC_locale_obj)
 #define PL_appctx              (my_vars->Gappctx)
 #define PL_Gappctx             (my_vars->Gappctx)
 #define PL_check               (my_vars->Gcheck)
index 5c1e5997b837b422d798dd58f3bb9bdddb94512f..ffe97248d6422ce6fdb6506f978db143299d79d9 100644 (file)
@@ -15,7 +15,7 @@ require Exporter;
 # walkoptree comes from B.xs
 
 BEGIN {
-    $B::VERSION = '1.62';
+    $B::VERSION = '1.63';
     @B::EXPORT_OK = ();
 
     # Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
index b4b6a40ac5341a207935e62d828e7ea092d10ac5..fb42954541027bf4f4fd5a0ebfb5f53068a5a1f3 100644 (file)
@@ -1325,14 +1325,30 @@ string(o, cv)
        B::CV  cv
     PREINIT:
        SV *ret;
+        UNOP_AUX_item *aux;
     PPCODE:
+        aux = cUNOP_AUXo->op_aux;
         switch (o->op_type) {
         case OP_MULTIDEREF:
             ret = multideref_stringify(o, cv);
             break;
+
+        case OP_ARGELEM:
+            ret = sv_2mortal(Perl_newSVpvf(aTHX_ "%"IVdf,
+                            PTR2IV(aux)));
+            break;
+
+        case OP_ARGCHECK:
+            ret = Perl_newSVpvf(aTHX_ "%"IVdf",%"IVdf, aux[0].iv, aux[1].iv);
+            if (aux[2].iv)
+                Perl_sv_catpvf(aTHX_ ret, ",%c", (char)aux[2].iv);
+            ret = sv_2mortal(ret);
+            break;
+
         default:
             ret = sv_2mortal(newSVpvn("", 0));
         }
+
        ST(0) = ret;
        XSRETURN(1);
 
@@ -1346,12 +1362,28 @@ void
 aux_list(o, cv)
        B::OP  o
        B::CV  cv
+    PREINIT:
+        UNOP_AUX_item *aux;
     PPCODE:
         PERL_UNUSED_VAR(cv); /* not needed on unthreaded builds */
+        aux = cUNOP_AUXo->op_aux;
         switch (o->op_type) {
         default:
             XSRETURN(0); /* by default, an empty list */
 
+        case OP_ARGELEM:
+            XPUSHs(sv_2mortal(newSViv(PTR2IV(aux))));
+            XSRETURN(1);
+            break;
+
+        case OP_ARGCHECK:
+            EXTEND(SP, 3);
+            PUSHs(sv_2mortal(newSViv(aux[0].iv)));
+            PUSHs(sv_2mortal(newSViv(aux[1].iv)));
+            PUSHs(sv_2mortal(aux[2].iv ? Perl_newSVpvf(aTHX_ "%c",
+                                (char)aux[2].iv) : &PL_sv_no));
+            break;
+
         case OP_MULTIDEREF:
 #ifdef USE_ITHREADS
 #  define ITEM_SV(item) *av_fetch(comppad, (item)->pad_offset, FALSE);
index 311e0e738a991581c2f546cf049081652e0c7cfa..34efc2c3032f2e5c05346f8524a54a57f89a8408 100644 (file)
@@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp
 
 use Exporter (); # use #5
 
-our $VERSION   = "0.996";
+our $VERSION   = "0.998";
 our @ISA       = qw(Exporter);
 our @EXPORT_OK = qw( set_style set_style_standard add_callback
                     concise_subref concise_cv concise_main
@@ -595,31 +595,43 @@ require B::Op_private;
 our %hints; # used to display each COP's op_hints values
 
 # strict refs, subs, vars
-@hints{2,512,1024,32,64,128} = ('$', '&', '*', 'x$', 'x&', 'x*');
+@hints{0x2,0x200,0x400,0x20,0x40,0x80} = ('$', '&', '*', 'x$', 'x&', 'x*');
 # integers, locale, bytes
-@hints{1,4,8,16} = ('i', 'l', 'b');
+@hints{0x1,0x4,0x8,0x10} = ('i', 'l', 'b');
 # block scope, localise %^H, $^OPEN (in), $^OPEN (out)
-@hints{256,131072,262144,524288} = ('{','%','<','>');
+@hints{0x100,0x20000,0x40000,0x80000} = ('{','%','<','>');
 # overload new integer, float, binary, string, re
-@hints{4096,8192,16384,32768,65536} = ('I', 'F', 'B', 'S', 'R');
+@hints{0x1000,0x2000,0x4000,0x8000,0x10000} = ('I', 'F', 'B', 'S', 'R');
 # taint and eval
-@hints{1048576,2097152} = ('T', 'E');
-# filetest access, UTF-8
-@hints{4194304,8388608} = ('X', 'U');
+@hints{0x100000,0x200000} = ('T', 'E');
+# filetest access, use utf8, unicode_strings feature
+@hints{0x400000,0x800000,0x800} = ('X', 'U', 'us');
 
-sub _flags {
-    my($hash, $x) = @_;
+# pick up the feature hints constants.
+# Note that we're relying on non-API parts of feature.pm,
+# but its less naughty than just blindly copying those constants into
+# this src file.
+#
+require feature;
+
+sub hints_flags {
+    my($x) = @_;
     my @s;
-    for my $flag (sort {$b <=> $a} keys %$hash) {
-       if ($hash->{$flag} and $x & $flag and $x >= $flag) {
+    for my $flag (sort {$b <=> $a} keys %hints) {
+       if ($hints{$flag} and $x & $flag and $x >= $flag) {
            $x -= $flag;
-           push @s, $hash->{$flag};
+           push @s, $hints{$flag};
        }
     }
-    push @s, $x if $x;
+    if ($x & $feature::hint_mask) {
+        push @s, "fea=" . (($x & $feature::hint_mask) >> $feature::hint_shift);
+        $x &= ~$feature::hint_mask;
+    }
+    push @s, sprintf "0x%x", $x if $x;
     return join(",", @s);
 }
 
+
 # return a string like 'LVINTRO,1' for the op $name with op_private
 # value $x
 
@@ -677,11 +689,6 @@ sub private_flags {
     return join ",", @flags;
 }
 
-sub hints_flags {
-    my($x) = @_;
-    _flags(\%hints, $x);
-}
-
 sub concise_sv {
     my($sv, $hr, $preferpv) = @_;
     $hr->{svclass} = class($sv);
@@ -820,6 +827,7 @@ sub concise_op {
        $h{targarg}     = join '; ', @targarg;
        $h{targarglife} = join '; ', @targarglife;
     }
+
     $h{arg} = "";
     $h{svclass} = $h{svaddr} = $h{svval} = "";
     if ($h{class} eq "PMOP") {
@@ -884,6 +892,11 @@ sub concise_op {
        undef $lastnext;
        $h{arg} = "(other->" . seq($op->other) . ")";
        $h{otheraddr} = sprintf("%#x", $ {$op->other});
+        if ($h{name} eq "argdefelem") {
+            # targ used for element index
+            $h{targarglife} = $h{targarg} = "";
+            $h{arg} .= "[" . $op->targ . "]";
+        }
     }
     elsif ($h{class} eq "SVOP" or $h{class} eq "PADOP") {
        unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) {
@@ -1591,6 +1604,9 @@ string if this is not a COP. Here are the symbols used:
     X filetest access
     U utf-8
 
+    us      use feature 'unicode_strings'
+    fea=NNN feature bundle number
+
 =item B<#hintsval>
 
 The numeric value of the COP's hint flags, or an empty string if this is not
index bb1056fe5c21e6af569c2be213bd48db74f603d9..fe955d166eaa9cc87b0b8b17251f06cf57eb8445 100644 (file)
@@ -10,7 +10,7 @@ BEGIN {
     require 'test.pl';         # we use runperl from 'test.pl', so can't use Test::More
 }
 
-plan tests => 163;
+plan tests => 167;
 
 require_ok("B::Concise");
 
@@ -502,4 +502,22 @@ $end =~ s/<NEXT>/$next/;
 
 like $out, qr/$end/, 'OP_AND->op_other points correctly';
 
+# test nextstate hints display
+
+{
+
+    $out = runperl(
+        switches => ["-MO=Concise"],
+        prog => q{my $x; use strict; use warnings; $x++; use feature q(:5.11); $x++},
+        stderr => 1,
+    );
+
+    my @hints = $out =~ /nextstate\([^)]+\) (.*) ->/g;
+
+    is(scalar(@hints), 3, "3 hints");
+    is($hints[0], 'v:{',                           "hints[0]");
+    is($hints[1], 'v:*,&,{,x*,x&,x$,$',            "hints[1]");
+    is($hints[2], 'v:%,us,*,&,{,x*,x&,x$,$,fea=7', "hints[2]");
+}
+
 __END__
index 6251a3cf33bb6655a00fb439a0853f1d6ce0a255..3c5c443c03dbe20aa5a9cb8510ad48d144cf6838 100644 (file)
@@ -2,7 +2,7 @@ use ExtUtils::MakeMaker;
 use Config;
 use strict;
 
-our $VERSION = "1.25";
+our $VERSION = "1.26";
 
 my %err = ();
 
@@ -391,6 +391,7 @@ sub STORE {
     Carp::confess("ERRNO hash is read only!");
 }
 
+# This is the true return value
 *CLEAR = *DELETE = \*STORE; # Typeglob aliasing uses less space
 
 sub NEXTKEY {
@@ -407,7 +408,9 @@ sub EXISTS {
     exists $err{$errname};
 }
 
-tie %!, __PACKAGE__; # Returns an object, objects are true.
+sub _tie_it {
+    tie %{$_[0]}, __PACKAGE__;
+}
 
 __END__
 
index 01f52bfe44ea9a7d7cfa6b1401564212a5e17976..f419c6d76e6d9f2a9c2ccac57ada771e4f8afcd4 100644 (file)
@@ -6,6 +6,16 @@
 
 MODULE = Hash::Util            PACKAGE = Hash::Util
 
+void
+_clear_placeholders(hashref)
+        HV *hashref
+    PROTOTYPE: \%
+    PREINIT:
+        HV *hv;
+    CODE:
+        hv = MUTABLE_HV(hashref);
+        hv_clear_placeholders(hv);
+
 void
 all_keys(hash,keys,placeholder)
        HV *hash
@@ -264,8 +274,7 @@ bucket_array(rhv)
     XSRETURN(0);
 }
 
-#if PERL_VERSION < 25
-SV*
+void
 bucket_ratio(rhv)
         SV* rhv
     PROTOTYPE: \%
@@ -274,7 +283,11 @@ bucket_ratio(rhv)
     if (SvROK(rhv)) {
         rhv= SvRV(rhv);
         if ( SvTYPE(rhv)==SVt_PVHV ) {
+#if PERL_VERSION < 25
             SV *ret= Perl_hv_scalar(aTHX_ (HV*)rhv);
+#else
+            SV *ret= Perl_hv_bucket_ratio(aTHX_ (HV*)rhv);
+#endif
             ST(0)= ret;
             XSRETURN(1);
         }
@@ -282,7 +295,7 @@ bucket_ratio(rhv)
     XSRETURN_UNDEF;
 }
 
-SV*
+void
 num_buckets(rhv)
         SV* rhv
     PROTOTYPE: \%
@@ -297,7 +310,7 @@ num_buckets(rhv)
     XSRETURN_UNDEF;
 }
 
-SV*
+void
 used_buckets(rhv)
         SV* rhv
     PROTOTYPE: \%
@@ -312,4 +325,3 @@ used_buckets(rhv)
     XSRETURN_UNDEF;
 }
 
-#endif
index ff6b3b8d55cb26019423543d94cec49e9b6440ad..6dbc707b4c77ee4cb4f0c65e7a3dcdec20f4e3bb 100644 (file)
@@ -39,9 +39,13 @@ our @EXPORT_OK  = qw(
                      used_buckets
                      num_buckets
                     );
-our $VERSION = '0.20';
-require XSLoader;
-XSLoader::load();
+BEGIN {
+    # make sure all our XS routines are available early so their prototypes
+    # are correctly applied in the following code.
+    our $VERSION = '0.21';
+    require XSLoader;
+    XSLoader::load();
+}
 
 sub import {
     my $class = shift;
@@ -172,7 +176,7 @@ Both routines return a reference to the hash operated on.
 sub lock_ref_keys {
     my($hash, @keys) = @_;
 
-    Internals::hv_clear_placeholders %$hash;
+    _clear_placeholders(%$hash);
     if( @keys ) {
         my %keys = map { ($_ => 1) } @keys;
         my %original_keys = map { ($_ => 1) } keys %$hash;
@@ -207,6 +211,19 @@ sub unlock_ref_keys {
 sub   lock_keys (\%;@) {   lock_ref_keys(@_) }
 sub unlock_keys (\%)   { unlock_ref_keys(@_) }
 
+#=item B<_clear_placeholders>
+#
+# This function removes any placeholder keys from a hash. See Perl_hv_clear_placeholders()
+# in hv.c for what it does exactly. It is currently exposed as XS by universal.c and
+# injected into the Hash::Util namespace.
+#
+# It is not intended for use outside of this module, and may be changed
+# or removed without notice or deprecation cycle.
+#
+#=cut
+#
+# sub _clear_placeholders {} # just in case someone searches...
+
 =item B<lock_keys_plus>
 
   lock_keys_plus(%hash,@additional_keys)
@@ -225,7 +242,7 @@ Returns a reference to %hash
 sub lock_ref_keys_plus {
     my ($hash,@keys) = @_;
     my @delete;
-    Internals::hv_clear_placeholders(%$hash);
+    _clear_placeholders(%$hash);
     foreach my $key (@keys) {
         unless (exists($hash->{$key})) {
             $hash->{$key}=undef;
index 9d667c276bd799e2f0d0717e4d5c398cd7052cbb..912aa4dfeeda0d0996427b76251a66f9411bf609 100644 (file)
@@ -6,7 +6,7 @@ use strict;
 
 our($VERSION, @ISA, @EXPORT_OK);
 
-$VERSION = "1.35";
+$VERSION = "1.37";
 
 use Carp;
 use Exporter ();
@@ -312,7 +312,7 @@ invert_opset function.
     av2arylen
 
     rv2hv helem hslice kvhslice each values keys exists delete
-    aeach akeys avalues multideref
+    aeach akeys avalues multideref argelem argdefelem argcheck
 
     preinc i_preinc predec i_predec postinc i_postinc
     postdec i_postdec int hex oct abs pow multiply i_multiply
index 936ffba25ee6f1dce77c819b09677f8933ff88a1..5c8e22de8267cde37324f5a94f031438d1da3ffc 100644 (file)
@@ -51,7 +51,7 @@ op_names_init(pTHX)
     int i;
     STRLEN len;
     char **op_names;
-    char *bitmap;
+    U8 *bitmap;
     dMY_CXT;
 
     op_named_bits = newHV();
@@ -65,10 +65,11 @@ op_names_init(pTHX)
     put_op_bitspec(aTHX_ STR_WITH_LEN(":none"), sv_2mortal(new_opset(aTHX_ Nullsv)));
 
     opset_all = new_opset(aTHX_ Nullsv);
-    bitmap = SvPV(opset_all, len);
+    bitmap = (U8*)SvPV(opset_all, len);
     memset(bitmap, 0xFF, len-1); /* deal with last byte specially, see below */
     /* Take care to set the right number of bits in the last byte */
-    bitmap[len-1] = (PL_maxo & 0x07) ? ~(0xFF << (PL_maxo & 0x07)) : 0xFF;
+    bitmap[len-1] = (PL_maxo & 0x07) ? ((~(0xFF << (PL_maxo & 0x07))) & 0xFF)
+                                     : 0xFF;
     put_op_bitspec(aTHX_ STR_WITH_LEN(":all"), opset_all); /* don't mortalise */
 }
 
index 3820026a4d466ca3948f0e3fe9de39262f58e0a4..bb121c3da7824f526baad13d9128c0a47e9a013f 100644 (file)
@@ -1153,10 +1153,12 @@ static NV my_trunc(NV x)
 #  define NV_PAYLOAD_TYPE NV
 #endif
 
-#ifdef LONGDOUBLE_DOUBLEDOUBLE
-#  define NV_PAYLOAD_SIZEOF_ASSERT(a) assert(sizeof(a) == NVSIZE / 2)
+#if defined(USE_LONG_DOUBLE) && defined(LONGDOUBLE_DOUBLEDOUBLE)
+#  define NV_PAYLOAD_SIZEOF_ASSERT(a) \
+    STATIC_ASSERT_STMT(sizeof(a) == NVSIZE / 2)
 #else
-#  define NV_PAYLOAD_SIZEOF_ASSERT(a) assert(sizeof(a) == NVSIZE)
+#  define NV_PAYLOAD_SIZEOF_ASSERT(a) \
+    STATIC_ASSERT_STMT(sizeof(a) == NVSIZE)
 #endif
 
 static void S_setpayload(NV* nvp, NV_PAYLOAD_TYPE payload, bool signaling)
index 1bf8e621362d21a7d48e557ba81c9b38c21a1bfe..9960b2c72c6af9bb815daf18d6dbdfcb4eacec59 100644 (file)
@@ -4,7 +4,7 @@ use warnings;
 
 our ($AUTOLOAD, %SIGRT);
 
-our $VERSION = '1.70';
+our $VERSION = '1.71';
 
 require XSLoader;
 
index b0228591907a6321a5be486feb3158ad08c98e9b..7d1d23268b9a0fba39f672b36ec924514a1ebb1f 100644 (file)
@@ -216,6 +216,7 @@ This program is distributed under the Artistic License.
 
 =cut
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use Pod::Html;
 
 pod2html @ARGV;
index 34729a9c2410d1f60c05d4ec97fe272db2dae3eb..cef329e1ef90b0e46a4322251af165630a846177 100644 (file)
@@ -3,7 +3,7 @@ use strict;
 require Exporter;
 
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = 1.22;
+$VERSION = 1.2201;
 @ISA = qw(Exporter);
 @EXPORT = qw(pod2html htmlify);
 @EXPORT_OK = qw(anchorify);
index 9702666799c8262a4e3f674f08a808c6fe73b129..32a0029ceed39a3c7057e788afa57e79dcc595e0 100644 (file)
@@ -1,7 +1,7 @@
 use strict;
 package Tie::Hash::NamedCapture;
 
-our $VERSION = "0.09";
+our $VERSION = "0.10";
 
 require XSLoader;
 XSLoader::load(); # This returns true, which makes require happy.
index 04cc4638e64b8d3ad381bd051f385ef456e82221..7eaae5614d0761220194158f0a92b9b469d0acea 100644 (file)
 #define EXISTS_ALIAS (RXapif_EXISTS | (2 << EXPECT_SHIFT))
 #define SCALAR_ALIAS (RXapif_SCALAR | (1 << EXPECT_SHIFT))
 
-static void
-tie_it(pTHX_ const char name, UV flag, HV *const stash)
-{
-    GV *const gv = gv_fetchpvn(&name, 1, GV_ADDMULTI|GV_NOTQUAL, SVt_PVHV);
-    HV *const hv = GvHV(gv);
-    SV *rv = newSV_type(SVt_RV);
+MODULE = Tie::Hash::NamedCapture       PACKAGE = Tie::Hash::NamedCapture
+PROTOTYPES: DISABLE
 
-    SvRV_set(rv, newSVuv(flag));
+void
+_tie_it(SV *sv)
+  INIT:
+    GV * const gv = (GV *)sv;
+    HV * const hv = GvHVn(gv);
+    SV *rv = newSV_type(SVt_RV);
+  CODE:
+    SvRV_set(rv, newSVuv(*GvNAME(gv) == '-' ? RXapif_ALL : RXapif_ONE));
     SvROK_on(rv);
-    sv_bless(rv, stash);
+    sv_bless(rv, GvSTASH(CvGV(cv)));
 
     sv_unmagic((SV *)hv, PERL_MAGIC_tied);
     sv_magic((SV *)hv, rv, PERL_MAGIC_tied, NULL, 0);
     SvREFCNT_dec(rv); /* As sv_magic increased it by one.  */
-}
-
-MODULE = Tie::Hash::NamedCapture       PACKAGE = Tie::Hash::NamedCapture
-PROTOTYPES: DISABLE
-
-BOOT:
-       {
-           HV *const stash = GvSTASH(CvGV(cv));
-           tie_it(aTHX_ '-', RXapif_ALL, stash);
-           tie_it(aTHX_ '+', RXapif_ONE, stash);
-       }
 
 SV *
 TIEHASH(package, ...)
index c75241e39182d0335ccb66ffd9229a10b5916cde..09cfe221ebcd1516afb5a83030932a8c192455fa 100644 (file)
@@ -5,7 +5,7 @@ use strict;
 use warnings;
 use Carp;
 
-our $VERSION = '0.82';
+our $VERSION = '0.83';
 
 require XSLoader;
 
index f73a71519e8367f65be7fdd0e48c20f40ef420ee..992b6a5e33dea2b80e26ec1f92bad2e1c8d27bc4 100644 (file)
@@ -3,6 +3,9 @@
 /* We want to be able to test things that aren't API yet. */
 #define PERL_EXT
 
+/* Do *not* define PERL_NO_GET_CONTEXT.  This is the one place where we get
+   to test implicit Perl_get_context().  */
+
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -2395,6 +2398,23 @@ call_pv(subname, flags, ...)
        EXTEND(SP, 1);
        PUSHs(sv_2mortal(newSViv(i)));
 
+void
+call_argv(subname, flags, ...)
+    char* subname
+    I32 flags
+    PREINIT:
+       I32 i;
+       char *tmpary[4];
+    PPCODE:
+       for (i=0; i<items-2; i++)
+           tmpary[i] = SvPV_nolen(ST(i+2)); /* ignore first two args */
+       tmpary[i] = NULL;
+       PUTBACK;
+       i = call_argv(subname, flags, tmpary);
+       SPAGAIN;
+       EXTEND(SP, 1);
+       PUSHs(sv_2mortal(newSViv(i)));
+
 void
 call_method(methname, flags, ...)
     char* methname
@@ -4690,6 +4710,20 @@ test_isDIGIT_LC(UV ord)
     OUTPUT:
         RETVAL
 
+bool
+test_isOCTAL_A(UV ord)
+    CODE:
+        RETVAL = isOCTAL_A(ord);
+    OUTPUT:
+        RETVAL
+
+bool
+test_isOCTAL_L1(UV ord)
+    CODE:
+        RETVAL = isOCTAL_L1(ord);
+    OUTPUT:
+        RETVAL
+
 bool
 test_isIDFIRST_uni(UV ord)
     CODE:
index 15b09653edbaab56f1efcc798aab560ec1a0350c..355e49886e83c321f5c48935d5951b4ff36dafe1 100644 (file)
@@ -11,7 +11,7 @@ use strict;
 
 BEGIN {
     require '../../t/test.pl';
-    plan(455);
+    plan(527);
     use_ok('XS::APItest')
 };
 
@@ -80,6 +80,9 @@ for my $test (
     ok(eq_array( [ call_pv('f', $flags, @$args) ], $expected),
        "$description call_pv('f')");
 
+    ok(eq_array( [ call_argv('f', $flags, @$args) ], $expected),
+       "$description call_argv('f')") or warn "@{[call_argv('f', $flags, @$args)]}";
+
     ok(eq_array( [ eval_sv('f(' . join(',',map"'$_'",@$args) . ')', $flags) ],
         $expected), "$description eval_sv('f(args)')");
 
@@ -111,6 +114,14 @@ for my $test (
        is($@, $exp_err, "$desc G_EVAL call_pv('d') - \$@");
        is($warn, $exp_warn, "$desc G_EVAL call_pv('d') - warning");
 
+       $@ = "before\n";
+       $warn = "";
+       ok(eq_array( [ call_argv('d', $flags|G_EVAL|$keep, @$args) ], 
+                   $returnval),
+                   "$desc G_EVAL call_argv('d')");
+       is($@, $exp_err, "$desc G_EVAL call_argv('d') - \$@");
+       is($warn, $exp_warn, "$desc G_EVAL call_argv('d') - warning");
+
        $@ = "before\n";
        $warn = "";
        ok(eq_array( [ eval_sv('d()', $flags|$keep) ],
@@ -134,6 +145,9 @@ for my $test (
     ok(eq_array( [ sub { call_pv('f', $flags|G_NOARGS, "bad") }->(@$args) ],
        $expected), "$description G_NOARGS call_pv('f')");
 
+    ok(eq_array( [ sub { call_argv('f', $flags|G_NOARGS, "bad") }->(@$args) ],
+       $expected), "$description G_NOARGS call_argv('f')");
+
     ok(eq_array( [ sub { eval_sv('f(@_)', $flags|G_NOARGS) }->(@$args) ],
         $expected), "$description G_NOARGS eval_sv('f(@_)')");
 
@@ -146,6 +160,9 @@ for my $test (
     ok(eq_array( [ eval { call_pv('d', $flags, @$args) }, $@ ],
        [ "its_dead_jim\n" ]), "$description eval { call_pv('d') }");
 
+    ok(eq_array( [ eval { call_argv('d', $flags, @$args) }, $@ ],
+       [ "its_dead_jim\n" ]), "$description eval { call_argv('d') }");
+
     ok(eq_array( [ eval { eval_sv('d', $flags), $@ }, $@ ],
        [ @$returnval,
                "its_dead_jim\n", '' ]),
index 359769a1993838793b50981cc2fa0fbced134e47..b6eaa3e8cd51e16c7497c12377479572abf98852 100644 (file)
@@ -260,6 +260,19 @@ foreach my $name (sort keys %properties) {
     }
 }
 
+# Test isOCTAL()
+for my $i (0 .. 256, 0x110000) {
+    my $char_name = charnames::viacode($i) // "No name";
+    my $display_name = sprintf "\\N{U+%02X, %s}", $i, $char_name;
+    my $truth = truth($i >= ord('0') && $i <= ord('7'));
+
+    my $ret = truth test_isOCTAL_A($i);
+    is($ret, $truth, "isOCTAL_A( $display_name ) == $truth");
+
+    $ret = truth test_isOCTAL_L1($i);
+    is($ret, $truth, "isOCTAL_L1( $display_name ) == $truth");
+}
+
 my %to_properties = (
                 FOLD => 'Case_Folding',
                 LOWER => 'Lowercase_Mapping',
index a519a4b3927ecad356b9d949efc5f1bcc2bfcfb7..64efe3e5d6794fb4efadaf4b2865d9f556402169 100644 (file)
@@ -1,6 +1,6 @@
 package arybase;
 
-our $VERSION = "0.11";
+our $VERSION = "0.12";
 
 require XSLoader;
 XSLoader::load(); # This returns true, which makes require happy.
index 4ff6cbd68aaca623f5584357798004f4ca2681bf..880bbe3a99f965d6b93933e3bb8654fc7a871c3b 100644 (file)
@@ -410,10 +410,6 @@ PROTOTYPES: DISABLE
 
 BOOT:
 {
-    GV *const gv = gv_fetchpvn("[", 1, GV_ADDMULTI|GV_NOTQUAL, SVt_PV);
-    sv_unmagic(GvSV(gv), PERL_MAGIC_sv); /* This is *our* scalar now! */
-    tie(aTHX_ GvSV(gv), NULL, GvSTASH(CvGV(cv)));
-
     if (!ab_initialized++) {
        ab_op_map = ptable_new();
 #ifdef USE_ITHREADS
@@ -437,6 +433,16 @@ BOOT:
     }
 }
 
+void
+_tie_it(SV *sv)
+    INIT:
+       GV * const gv = (GV *)sv;
+    CODE:
+       if (GvSV(gv))
+           /* This is *our* scalar now!  */
+           sv_unmagic(GvSV(gv), PERL_MAGIC_sv);
+       tie(aTHX_ GvSVn(gv), NULL, GvSTASH(CvGV(cv)));
+
 void
 FETCH(...)
     PREINIT:
diff --git a/gv.c b/gv.c
index 46eb079b8f55c49798195b2684bbd569aae32db5..1bc8bf2d9d199020ff1c8120c52baa92e2f0ea16 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1294,49 +1294,63 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags)
 
 /* require_tie_mod() internal routine for requiring a module
  * that implements the logic of automatic ties like %! and %-
+ * It loads the module and then calls the _tie_it subroutine
+ * with the passed gv as an argument.
  *
  * The "gv" parameter should be the glob.
- * "varpv" holds the name of the var, used for error messages.
+ * "varname" holds the 1-char name of the var, used for error messages.
  * "namesv" holds the module name. Its refcount will be decremented.
- * "methpv" holds the method name to test for to check that things
- *   are working reasonably close to as expected.
  * "flags": if flag & 1 then save the scalar before loading.
  * For the protection of $! to work (it is set by this routine)
  * the sv slot must already be magicalized.
  */
-STATIC HV*
-S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methpv,const U32 flags)
+STATIC void
+S_require_tie_mod(pTHX_ GV *gv, const char varname, const char * name,
+                        STRLEN len, const U32 flags)
 {
-    HV* stash = gv_stashsv(namesv, 0);
+    const SV * const target = varname == '[' ? GvSV(gv) : (SV *)GvHV(gv);
 
     PERL_ARGS_ASSERT_REQUIRE_TIE_MOD;
 
-    if (!stash || !(gv_fetchmethod_autoload(stash, methpv, FALSE))) {
-       SV *module = newSVsv(namesv);
-       char varname = *varpv; /* varpv might be clobbered by load_module,
-                                 so save it. For the moment it's always
-                                 a single char. */
+    /* If it is not tied */
+    if (!target || !SvRMAGICAL(target)
+     || !mg_find(target,
+                 varname == '[' ? PERL_MAGIC_tiedscalar : PERL_MAGIC_tied))
+    {
+      HV *stash;
+      GV **gvp;
+      dSP;
+
+      ENTER;
+
+#define HV_FETCH_TIE_FUNC (GV **)hv_fetch(stash, "_tie_it", 7, 0)
+
+      /* Load the module if it is not loaded.  */
+      if (!(stash = gv_stashpvn(name, len, 0))
+       || !(gvp = HV_FETCH_TIE_FUNC) || !*gvp || !GvCV(*gvp))
+      {
+       SV * const module = newSVpvn(name, len);
        const char type = varname == '[' ? '$' : '%';
-#ifdef DEBUGGING
-       dSP;
-#endif
-       ENTER;
-       SAVEFREESV(namesv);
        if ( flags & 1 )
            save_scalar(gv);
        Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL);
        assert(sp == PL_stack_sp);
-       stash = gv_stashsv(namesv, 0);
+       stash = gv_stashpvn(name, len, 0);
        if (!stash)
-           Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" is not available",
-                   type, varname, SVfARG(namesv));
-       else if (!gv_fetchmethod(stash, methpv))
-           Perl_croak(aTHX_ "panic: Can't use %c%c because %"SVf" does not support method %s",
-                   type, varname, SVfARG(namesv), methpv);
-       LEAVE;
+           Perl_croak(aTHX_ "panic: Can't use %c%c because %s is not available",
+                   type, varname, name);
+       else if (!(gvp = HV_FETCH_TIE_FUNC) || !*gvp || !GvCV(*gvp))
+           Perl_croak(aTHX_ "panic: Can't use %c%c because %s does not define _tie_it",
+                   type, varname, name);
+      }
+      /* Now call the tie function.  It should be in *gvp.  */
+      assert(gvp); assert(*gvp); assert(GvCV(*gvp));
+      PUSHMARK(SP);
+      XPUSHs((SV *)gv);
+      PUTBACK;
+      call_sv((SV *)*gvp, G_VOID|G_DISCARD);
+      LEAVE;
     }
-    else SvREFCNT_dec_NN(namesv);
-    return stash;
 }
 
 /*
@@ -1432,7 +1446,7 @@ S_gv_stashpvn_internal(pTHX_ const char *name, U32 namelen, I32 flags)
 gv_stashsvpvn_cached
 
 Returns a pointer to the stash for a specified package, possibly
-cached.  Implements both C<gv_stashpvn> and C<gc_stashsv>.
+cached.  Implements both C<gv_stashpvn> and C<gv_stashsv>.
 
 Requires one of either namesv or namepv to be non-null.
 
@@ -1797,15 +1811,14 @@ S_find_default_stash(pTHX_ HV **stash, const char *name, STRLEN len,
  * Note that it does not insert the GV into the stash prior to
  * magicalization, which some variables require need in order
  * to work (like $[, %+, %-, %!), so callers must take care of
- * that beforehand.
+ * that.
  * 
- * The return value has a specific meaning for gv_fetchpvn_flags:
- * If it returns true, and the gv is empty, it indicates that its
- * refcount should be decreased.
+ * It returns true if the gv did turn out to be magical one; i.e.,
+ * if gv_magicalize actually did something.
  */
 PERL_STATIC_INLINE bool
 S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
-               bool addmg, const svtype sv_type)
+                      const svtype sv_type)
 {
     SSize_t paren;
 
@@ -1831,6 +1844,10 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
                    GvMULTI_on(gv);
                break;
            case 'a':
+               if (stash == PL_debstash && len==4 && strEQ(name2,"rgs")) {
+                   GvMULTI_on(gv_AVadd(gv));
+                   break;
+               }
            case 'b':
                if (len == 1 && sv_type == SVt_PV)
                    GvMULTI_on(gv);
@@ -1838,7 +1855,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
            default:
                goto try_core;
            }
-           return addmg;
+           goto ret;
        }
       try_core:
        if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4) {
@@ -1989,7 +2006,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
                   this test  */
                 UV uv;
                 if (!grok_atoUV(name, &uv, NULL) || uv > I32_MAX)
-                    return addmg;
+                    goto ret;
                 /* XXX why are we using a SSize_t? */
                 paren = (SSize_t)(I32)uv;
                 goto storeparen;
@@ -2060,10 +2077,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
 
             /* magicalization must be done before require_tie_mod is called */
            if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-           {
-               require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
-                addmg = FALSE;
-           }
+               require_tie_mod(gv, '!', "Errno", 5, 1);
 
            break;
        case '-':               /* $- */
@@ -2080,10 +2094,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
             SvREADONLY_on(av);
 
             if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
-           {
-                require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
-                addmg = FALSE;
-           }
+                require_tie_mod(gv, *name, "Tie::Hash::NamedCapture",23,0);
 
             break;
        }
@@ -2103,8 +2114,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
        case '[':               /* $[ */
            if ((sv_type == SVt_PV || sv_type == SVt_PVGV)
             && FEATURE_ARYBASE_IS_ENABLED) {
-               require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
-                addmg = FALSE;
+               require_tie_mod(gv,'[',"arybase",7,0);
            }
            else goto magicalize;
             break;
@@ -2172,7 +2182,13 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
        }
     }
 
-    return addmg;
+   ret:
+    /* Return true if we actually did something.  */
+    return GvAV(gv) || GvHV(gv) || GvIO(gv) || GvCV(gv)
+        || ( GvSV(gv) && (
+                           SvOK(GvSV(gv)) || SvMAGICAL(GvSV(gv))
+                         )
+           );
 }
 
 /* If we do ever start using this later on in the file, we need to make
@@ -2192,9 +2208,9 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type)
 
     if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) {
         if (*name == '!')
-            require_tie_mod(gv, "!", newSVpvs("Errno"), "TIEHASH", 1);
+            require_tie_mod(gv, '!', "Errno", 5, 1);
         else if (*name == '-' || *name == '+')
-            require_tie_mod(gv, name, newSVpvs("Tie::Hash::NamedCapture"), "TIEHASH", 0);
+            require_tie_mod(gv, *name, "Tie::Hash::NamedCapture", 23, 0);
     } else if (sv_type == SVt_PV) {
         if (*name == '*' || *name == '#') {
             /* diag_listed_as: $* is no longer supported */
@@ -2206,7 +2222,7 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type)
     if (sv_type==SVt_PV || sv_type==SVt_PVGV) {
       switch (*name) {
       case '[':
-          require_tie_mod(gv,name,newSVpvs("arybase"),"FETCH",0);
+          require_tie_mod(gv,'[',"arybase",7,0);
           break;
 #ifdef PERL_SAWAMPERSAND
       case '`':
@@ -2335,33 +2351,22 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags,
     if ( isIDFIRST_lazy_if(name, is_utf8) && !ckWARN(WARN_ONCE) )
         GvMULTI_on(gv) ;
 
-    /* First, store the gv in the symtab if we're adding magic,
-     * but only for non-empty GVs
-     */
-#define GvEMPTY(gv)      !(GvAV(gv) || GvHV(gv) || GvIO(gv) \
-                        || GvCV(gv) || (GvSV(gv) && SvOK(GvSV(gv))))
-    
-    if ( addmg && !GvEMPTY(gv) ) {
-        (void)hv_store(stash,name,len,(SV *)gv,0);
-    }
-
     /* set up magic where warranted */
-    if ( gv_magicalize(gv, stash, name, len, addmg, sv_type) ) {
+    if ( gv_magicalize(gv, stash, name, len, sv_type) ) {
         /* See 23496c6 */
-        if (GvEMPTY(gv)) {
-            if ( GvSV(gv) && SvMAGICAL(GvSV(gv)) ) {
-                /* The GV was and still is "empty", except that now
-                 * it has the magic flags turned on, so we want it
+        if (addmg) {
+                /* gv_magicalize magicalised this gv, so we want it
                  * stored in the symtab.
+                 * Effectively the caller is asking, ‘Does this gv exist?’ 
+                 * And we respond, ‘Er, *now* it does!’
                  */
                 (void)hv_store(stash,name,len,(SV *)gv,0);
-            }
-            else {
-                /* Most likely the temporary GV created above */
+        }
+    }
+    else if (addmg) {
+                /* The temporary GV created above */
                 SvREFCNT_dec_NN(gv);
                 gv = NULL;
-            }
-        }
     }
     
     if (gv) gv_init_svtype(gv, faking_it ? SVt_PVCV : sv_type);
diff --git a/handy.h b/handy.h
index b1b50ff6370c7cdb2e6b74f00d8c01fcebba8023..fc68736e4b175e7011b237efeef2bcfa2ae91d3d 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -910,7 +910,10 @@ patched there.  The file as of this writing is cpan/Devel-PPPort/parts/inc/misc
  * of operands.  Well, they are, but that is kind of the point.
  */
 #ifndef __COVERITY__
-#define FITS_IN_8_BITS(c) ((sizeof(c) == 1) || !(((WIDEST_UTYPE)(c)) & ~0xFF))
+  /* The '| 0' part ensures a compiler error if c is not integer (like e.g., a
+   * pointer) */
+#define FITS_IN_8_BITS(c) (   (sizeof(c) == 1)                      \
+                           || !(((WIDEST_UTYPE)((c) | 0)) & ~0xFF))
 #else
 #define FITS_IN_8_BITS(c) (1)
 #endif
@@ -925,14 +928,23 @@ patched there.  The file as of this writing is cpan/Devel-PPPort/parts/inc/misc
     /* There is a simple definition of ASCII for ASCII platforms.  But the
      * EBCDIC one isn't so simple, so is defined using table look-up like the
      * other macros below.
-     * The '| 0' part ensures that c is an integer (and not e.g. a pointer) */
+     *
+     * The cast here is used instead of '(c) >= 0', because some compilers emit
+     * a warning that that test is always true when the parameter is an
+     * unsigned type.  khw supposes that it could be written as
+     *      && ((c) == '\0' || (c) > 0)
+     * to avoid the message, but the cast will likely avoid extra branches even
+     * with stupid compilers.
+     *
+     * The '| 0' part ensures a compiler error if c is not integer (like e.g.,
+     * a pointer) */
 #   define isASCII(c)    ((WIDEST_UTYPE)((c) | 0) < 128)
 #endif
 
-/* The lower 3 bits in both the ASCII and EBCDIC representations of '0' are 0,
- * and the 8 possible permutations of those bits exactly comprise the 8 octal
- * digits */
-#define isOCTAL_A(c)  cBOOL(FITS_IN_8_BITS(c) && (0xF8 & (c)) == '0')
+/* Take the eight possible bit patterns of the lower 3 bits and you get the
+ * lower 3 bits of the 8 octal digits, in both ASCII and EBCDIC, so those bits
+ * can be ignored.  If the rest match '0', we have an octal */
+#define isOCTAL_A(c)  (((WIDEST_UTYPE)((c) | 0) & ~7) == '0')
 
 #ifdef H_PERL       /* If have access to perl.h, lookup in its table */
 
@@ -955,7 +967,7 @@ patched there.  The file as of this writing is cpan/Devel-PPPort/parts/inc/misc
 #  define _CC_PRINT              6      /* [:print:] */
 #  define _CC_ALPHANUMERIC       7      /* [:alnum:] */
 #  define _CC_GRAPH              8      /* [:graph:] */
-#  define _CC_CASED              9      /* [:lower:] and [:upper:] under /i */
+#  define _CC_CASED              9      /* [:lower:] or [:upper:] under /i */
 
 #define _FIRST_NON_SWASH_CC     10
 /* The character classes above are implemented with swashes.  The second group
@@ -1141,82 +1153,75 @@ END_EXTERN_C
 
     /* If we don't have perl.h, we are compiling a utility program.  Below we
      * hard-code various macro definitions that wouldn't otherwise be available
-     * to it. Most are coded based on first principals.  First some ones common
-     * to both ASCII and EBCDIC */
+     * to it. Most are coded based on first principles.  These are written to
+     * avoid EBCDIC vs. ASCII #ifdef's as much as possible. */
 #   define isDIGIT_A(c)  ((c) <= '9' && (c) >= '0')
 #   define isBLANK_A(c)  ((c) == ' ' || (c) == '\t')
-#   define isSPACE_A(c)  (isBLANK_A(c)                                       \
-                          || (c) == '\n'                                     \
-                          || (c) == '\r'                                     \
-                          || (c) == '\v'                                     \
+#   define isSPACE_A(c)  (isBLANK_A(c)                                   \
+                          || (c) == '\n'                                 \
+                          || (c) == '\r'                                 \
+                          || (c) == '\v'                                 \
                           || (c) == '\f')
-#   ifdef EBCDIC    /* There are gaps between 'i' and 'j'; 'r' and 's'.  Same
-                       for uppercase.  This is ordered to exclude most things
-                       early */
-#       define isLOWER_A(c)  ((c) >= 'a' && (c) <= 'z'                       \
-                               && ((c) <= 'i'                                \
-                                   || ((c) >= 'j' && (c) <= 'r')             \
-                                   || (c) >= 's'))
-#       define isUPPER_A(c)  ((c) >= 'A' && (c) <= 'Z'                       \
-                               && ((c) <= 'I'                                \
-                                   || ((c) >= 'J' && (c) <= 'R')             \
-                                   || (c) >= 'S'))
-#   else   /* ASCII platform. */
-#       define isLOWER_A(c)  ((c) >= 'a' && (c) <= 'z')
-#       define isUPPER_A(c)  ((c) <= 'Z' && (c) >= 'A')
-#   endif
-
-    /* Some more ASCII, non-ASCII common definitions */
+    /* On EBCDIC, there are gaps between 'i' and 'j'; 'r' and 's'.  Same for
+     * uppercase.  The tests for those aren't necessary on ASCII, but hurt only
+     * performance (if optimization isn't on), and allow the same code to be
+     * used for both platform types */
+#   define isLOWER_A(c)  ((c) >= 'a' && (c) <= 'z'                      \
+                  && (    (c) <= 'i'                                    \
+                      || ((c) >= 'j' && (c) <= 'r')                     \
+                      ||  (c) >= 's'))
+#   define isUPPER_A(c)  ((c) >= 'A' && (c) <= 'Z'                      \
+                  && (    (c) <= 'I'                                    \
+                      || ((c) >= 'J' && (c) <= 'R')                     \
+                      ||  (c) >= 'S'))
 #   define isALPHA_A(c)  (isUPPER_A(c) || isLOWER_A(c))
 #   define isALPHANUMERIC_A(c) (isALPHA_A(c) || isDIGIT_A(c))
 #   define isWORDCHAR_A(c)   (isALPHANUMERIC_A(c) || (c) == '_')
 #   define isIDFIRST_A(c)    (isALPHA_A(c) || (c) == '_')
-#   define isXDIGIT_A(c) (isDIGIT_A(c)                                      \
-                          || ((c) >= 'a' && (c) <= 'f')                     \
+#   define isXDIGIT_A(c) (isDIGIT_A(c)                                  \
+                          || ((c) >= 'a' && (c) <= 'f')                 \
                           || ((c) <= 'F' && (c) >= 'A'))
+#   define isPUNCT_A(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) == '~')
+#   define isGRAPH_A(c)  (isALPHANUMERIC_A(c) || isPUNCT_A(c))
+#   define isPRINT_A(c)  (isGRAPH_A(c) || (c) == ' ')
 
 #   ifdef EBCDIC
-#       define isPUNCT_A(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) == '~')
-#       define isGRAPH_A(c)  (isALPHANUMERIC_A(c) || isPUNCT_A(c))
-#       define isPRINT_A(c)  (isGRAPH_A(c) || (c) == ' ')
-
-#       ifdef QUESTION_MARK_CTRL
-#           define _isQMC(c) ((c) == QUESTION_MARK_CTRL)
-#       else
-#           define _isQMC(c) 0
-#       endif
-
-        /* I (khw) can't think of a way to define all the ASCII controls
-         * without resorting to a libc (locale-sensitive) call.  But we know
-         * that all controls but the question-mark one are in the range 0-0x3f.
-         * This makes sure that all the controls that have names are included,
-         * and all controls that are also considered ASCII in the locale.  This
-         * may include more or fewer than what it actually should, but the
-         * wrong ones are less-important controls, so likely won't impact
-         * things (keep in mind that this is compiled only if perl.h isn't
-         * available).  The question mark control is included if available */
-#       define isCNTRL_A(c)  (((c) < 0x40 && isascii(c))                    \
-                            || (c) == '\0' || (c) == '\a' || (c) == '\b'    \
-                            || (c) == '\f' || (c) == '\n' || (c) == '\r'    \
-                            || (c) == '\t' || (c) == '\v' || _isQMC(c))
-
+        /* The below is accurate for the 3 EBCDIC code pages traditionally
+         * supported by perl.  The only difference between them in the controls
+         * is the position of \n, and that is represented symbolically below */
+#       define isCNTRL_A(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 */
 #       define isASCII(c)    (isCNTRL_A(c) || isPRINT_A(c))
-#   else    /* ASCII platform; things are simpler, and  isASCII has already
-               been defined */
-#       define isGRAPH_A(c)  (((c) > ' ' && (c) < 127))
-#       define isPRINT_A(c)  (isGRAPH_A(c) || (c) == ' ')
-#       define isPUNCT_A(c)  (isGRAPH_A(c) && (! isALPHANUMERIC_A(c)))
-#       define isCNTRL_A(c)  (isASCII(c) && (! isPRINT_A(c)))
+#   else /* isASCII is already defined for ASCII platforms, so can use that to
+            define isCNTRL */
+#       define isCNTRL_A(c)  (isASCII(c) && ! isPRINT_A(c))
 #   endif
 
     /* The _L1 macros may be unnecessary for the utilities; I (khw) added them
index 230eb6de08d0d98249729e891c4742cb6e16ca57..2a177c662c41e480a813591208ddcd41dab3c340 100644 (file)
 # mkdir -p /opt/perl-catamount
 # mkdir -p /opt/perl-catamount/include
 # mkdir -p /opt/perl-catamount/lib
-# mkdir -p /opt/perl-catamount/lib/perl5/5.25.3
+# mkdir -p /opt/perl-catamount/lib/perl5/5.25.4
 # mkdir -p /opt/perl-catamount/bin
 # cp *.h /opt/perl-catamount/include
 # cp libperl.a /opt/perl-catamount/lib
-# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.25.3
+# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.25.4
 # cp miniperl perl run.sh cc.sh /opt/perl-catamount/lib
 #
 # With the headers and the libperl.a you can embed Perl to your Catamount
index 8d436a19e16d1d241586adf546ed041ce36cd7c7..135129f66f097589b7eada1a167dafb6548b9984 100644 (file)
@@ -310,3 +310,5 @@ esac
 # of FreeBSD.
 d_printf_format_null='undef'
 
+# As of 10.3-RELEASE FreeBSD.  See [perl #128867]
+d_uselocale='undef'
index 8ec9470183bbe8ff576b71f53c1e79f72bf54a5e..32672db941e207fd6d6a77c788e306426f6bfbaa 100644 (file)
@@ -10,6 +10,18 @@ libswanted="$*"
 # Debian 4.0 puts ndbm in the -lgdbm_compat library.
 libswanted="$libswanted gdbm_compat"
 
+# malloc wrap works
+case "$usemallocwrap" in
+'') usemallocwrap='define' ;;
+esac
+
+# The system malloc() is about as fast and as frugal as perl's.
+# Since the system malloc() has been the default since at least
+# 5.001, we might as well leave it that way.  --AD  10 Jan 2002
+case "$usemymalloc" in
+'') usemymalloc='n' ;;
+esac
+
 case "$optimize" in
 '') optimize='-O2' ;;
 esac
@@ -23,6 +35,32 @@ case "$plibpth" in
     ;;
 esac
 
+case "$libc" in
+'')
+# If you have glibc, then report the version for ./myconfig bug reporting.
+# (Configure doesn't need to know the specific version since it just uses
+# gcc to load the library for all tests.)
+# We don't use __GLIBC__ and  __GLIBC_MINOR__ because they
+# are insufficiently precise to distinguish things like
+# libc-2.0.6 and libc-2.0.7.
+    for p in $plibpth
+    do
+        for trylib in libc.so.0.3 libc.so
+        do
+            if $test -e $p/$trylib; then
+                libc=`ls -l $p/$trylib | awk '{print $NF}'`
+                if $test "X$libc" != X; then
+                    break
+                fi
+            fi
+        done
+        if $test "X$libc" != X; then
+            break
+        fi
+    done
+    ;;
+esac
+
 # Flags needed to produce shared libraries.
 lddlflags='-shared'
 
index 14e9dbe4c22c8134f56aea140c705bf040de6433..4cc6a74e3b3011fe9b9d5b248b8702b2d76d8aee 100644 (file)
--- a/inline.h
+++ b/inline.h
@@ -125,6 +125,29 @@ PadnameIN_SCOPE(const PADNAME * const pn, const U32 seq)
 }
 #endif
 
+/* ------------------------------- pp.h ------------------------------- */
+
+PERL_STATIC_INLINE I32
+S_TOPMARK(pTHX)
+{
+    DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
+                                "MARK top  %p %"IVdf"\n",
+                                 PL_markstack_ptr,
+                                 (IV)*PL_markstack_ptr)));
+    return *PL_markstack_ptr;
+}
+
+PERL_STATIC_INLINE I32
+S_POPMARK(pTHX)
+{
+    DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,
+                                "MARK pop  %p %"IVdf"\n",
+                                 (PL_markstack_ptr-1),
+                                 (IV)*(PL_markstack_ptr-1))));
+    assert((PL_markstack_ptr > PL_markstack) || !"MARK underflow");
+    return *PL_markstack_ptr--;
+}
+
 /* ----------------------------- regexp.h ----------------------------- */
 
 PERL_STATIC_INLINE struct regexp *
index 756b1dc9b4b92b6c79c9029642c58e1a531d7614..3f43fd9c63ba6f666b8d3167b3b5b6a562865631 100644 (file)
@@ -543,7 +543,7 @@ PERLVARA(I, body_roots,     PERL_ARENA_ROOTS_SIZE, void*) /* array of body roots */
 
 PERLVAR(I, debug,      VOL U32)        /* flags given to -D switch */
 
-PERLVARI(I, maxo,      int,    MAXO)   /* maximum number of ops */
+PERLVARI(I, padlist_generation, U32, 1)        /* id to identify padlist clones */
 
 PERLVARI(I, runops,    runops_proc_t, RUNOPS_DEFAULT)
 
@@ -762,8 +762,6 @@ PERLVAR(I, debug_pad,       struct perl_debug_pad)  /* always needed because of the re
 /* Hook for File::Glob */
 PERLVARI(I, globhook,  globhook_t, NULL)
 
-PERLVARI(I, padlist_generation, U32, 1)        /* id to identify padlist clones */
-
 /* The last unconditional member of the interpreter structure when 5.18.0 was
    released. The offset of the end of this is baked into a global variable in 
    any shared perl library which will allow a sanity test in future perl
index b42ad0a9022034ee736520a4f40536f523b81159..247869cf32e788c0ead0105b9f424b2a7444285b 100644 (file)
@@ -102,9 +102,11 @@ sub testit {
 
        unless ($got_text =~ /
     package (?:lexsub)?test;
-    use strict 'refs', 'subs';
+(?:    BEGIN \{\$\{\^WARNING_BITS\} = "[^"]+"\}
+)?    use strict 'refs', 'subs';
     use feature [^\n]+
-    \Q$vars\E\(\) = (.*)
+(?:    (?:CORE::)?state sub \w+;
+)?    \Q$vars\E\(\) = (.*)
 }/s) {
            ::fail($desc);
            ::diag("couldn't extract line from boilerplate\n");
index 9879d678b172890d287fbeb1e240b0a721c2d05d..5254f86d660019603d3805fa041e5a78df1cedfe 100644 (file)
@@ -46,7 +46,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
         MDEREF_SHIFT
     );
 
-$VERSION = '1.37';
+$VERSION = '1.38';
 use strict;
 use vars qw/$AUTOLOAD/;
 use warnings ();
@@ -460,6 +460,7 @@ sub _pessimise_walk_exe {
 sub pessimise {
     my ($self, $root, $start) = @_;
 
+    no warnings 'recursion';
     # walk tree in root-to-branch order
     $self->_pessimise_walk($root);
 
@@ -474,6 +475,9 @@ sub null {
     return class($op) eq "NULL";
 }
 
+
+# Add a CV to the list of subs that still need deparsing.
+
 sub todo {
     my $self = shift;
     my($cv, $is_form, $name) = @_;
@@ -490,55 +494,27 @@ sub todo {
     push @{$self->{'subs_todo'}}, [$seq, $cv, $is_form, $name];
 }
 
+
+# Pop the next sub from the todo list and deparse it
+
 sub next_todo {
     my $self = shift;
     my $ent = shift @{$self->{'subs_todo'}};
-    my $cv = $ent->[1];
-    if (ref $ent->[3]) { # lexical sub
-       my @text;
+    my ($seq, $cv, $is_form, $name) = @$ent;
 
-       # At this point, we may not yet have deparsed the hints that allow
-       # lexical subroutines to be recognized.  So adjust the current
-       # hints and deparse them.
-       # When lex subs cease being experimental, we should be able to
-       # remove this code.
-       {
-           local $^H = $self->{'hints'};
-           local %^H = %{ $self->{'hinthash'} || {} };
-           local ${^WARNING_BITS} = $self->{'warnings'};
-           feature->import("lexical_subs");
-           warnings->unimport("experimental::lexical_subs");
-           # Here we depend on the fact that individual features
-           # will always set the feature bundle to ‘custom’
-           # (== $feature::hint_mask).  If we had another specific bundle
-           # enabled previously, normalise it.
-           if (($self->{'hints'} & $feature::hint_mask)
-                   != $feature::hint_mask)
-           {
-               if ($self->{'hinthash'}) {
-                   delete $self->{'hinthash'}{$_}
-                       for grep /^feature_/, keys %{$self->{'hinthash'}};
-               }
-               else { $self->{'hinthash'} = {} }
-               $self->{'hinthash'}
-                   = _features_from_bundle(@$self{'hints','hinthash'});
-           }
-           push @text, $self->declare_hinthash($self->{'hinthash'}, \%^H,
-                                               $self->{indent_size}, $^H);
-           push @text, $self->declare_warnings($self->{'warnings'},
-                                               ${^WARNING_BITS})
-               unless ($self->{'warnings'} // 'u')
-                   eq (${^WARNING_BITS   } // 'u');
-           $self->{'warnings'} = ${^WARNING_BITS};
-           $self->{'hints'} = $^H;
-           $self->{'hinthash'} = {%^H};
-       }
+    # any 'use strict; package foo' that should come before the sub
+    # declaration to sync with the first COP of the sub
+    my $pragmata = '';
+    if ($cv and !null($cv->START) and is_state($cv->START))  {
+        $pragmata = $self->pragmata($cv->START);
+    }
 
-       # Now emit the sub itself.
-       my $padname = $ent->[3];
-       my $flags = $padname->FLAGS;
+    if (ref $name) { # lexical sub
+       # emit the sub.
+       my @text;
+       my $flags = $name->FLAGS;
        push @text,
-           !$cv || $ent->[0] <= $padname->COP_SEQ_RANGE_LOW
+           !$cv || $seq <= $name->COP_SEQ_RANGE_LOW
                ? $self->keyword($flags & SVpad_OUR
                                    ? "our"
                                    : $flags & SVpad_STATE
@@ -548,7 +524,7 @@ sub next_todo {
        # XXX We would do $self->keyword("sub"), but ‘my CORE::sub’
        #     doesn’t work and ‘my sub’ ignores a &sub in scope.  I.e.,
        #     we have a core bug here.
-       push @text, "sub " . substr $padname->PVX, 1;
+       push @text, "sub " . substr $name->PVX, 1;
        if ($cv) {
            # my sub foo { }
            push @text,  " " . $self->deparse_sub($cv);
@@ -558,19 +534,31 @@ sub next_todo {
            # my sub foo;
            push @text, ";\n";
        }
-       return join "", @text;
+       return $pragmata . join "", @text;
     }
+
     my $gv = $cv->GV;
-    my $name = $ent->[3] // $self->gv_name($gv);
-    if ($ent->[2]) {
-       return $self->keyword("format") . " $name =\n"
-           . $self->deparse_format($ent->[1]). "\n";
+    $name //= $self->gv_name($gv);
+    if ($is_form) {
+       return $pragmata . $self->keyword("format") . " $name =\n"
+           . $self->deparse_format($cv). "\n";
     } else {
        my $use_dec;
        if ($name eq "BEGIN") {
            $use_dec = $self->begin_is_use($cv);
            if (defined ($use_dec) and $self->{'expand'} < 5) {
-               return () if 0 == length($use_dec);
+               return $pragmata if 0 == length($use_dec);
+
+                #  XXX bit of a hack: Test::More's use_ok() method
+                #  builds a fake use statement which deparses as, e.g.
+                #      use Net::Ping (@{$args[0];});
+                #  As well as being superfluous (the use_ok() is deparsed
+                #  too) and ugly, it fails under use strict and otherwise
+                #  makes use of a lexical var that's not in scope.
+                #  So strip it out.
+                return $pragmata
+                            if $use_dec =~ /^use \S+ \(@\{\$args\[0\];}\);/;
+
                $use_dec =~ s/^(use|no)\b/$self->keyword($1)/e;
            }
        }
@@ -591,7 +579,7 @@ sub next_todo {
            }
        }
        if ($use_dec) {
-           return "$p$l$use_dec";
+           return "$pragmata$p$l$use_dec";
        }
         if ( $name !~ /::/ and $self->lex_in_scope("&$name")
                             || $self->lex_in_scope("&$name", 1) )
@@ -600,13 +588,14 @@ sub next_todo {
         } elsif (defined $stash) {
             $name =~ s/^\Q$stash\E::(?!\z|.*::)//;
         }
-       my $ret = "${p}${l}" . $self->keyword("sub") . " $name "
+       my $ret = "$pragmata${p}${l}" . $self->keyword("sub") . " $name "
              . $self->deparse_sub($cv);
        $self->{'subs_declared'}{$name} = 1;
        return $ret;
     }
 }
 
+
 # Return a "use" declaration for this BEGIN block, if appropriate
 sub begin_is_use {
     my ($self, $cv) = @_;
@@ -1221,22 +1210,132 @@ sub pad_subs {
        sort {$a->[0] <=> $b->[0]} @{$self->{'subs_todo'}}, @todo
 }
 
+
+# deparse_argops(): deparse, if possible, a sequence of argcheck + argelem
+# ops into a subroutine signature. If successful, return the first op
+# following the signature ops plus the signature string; else return the
+# empty list.
+#
+# Normally a bunch of argelem ops will have been generated by the
+# signature parsing, but it's possible that ops have been added manually
+# or altered. In this case we "return ()" and fall back to general
+# deparsing of the individual sigelems as 'my $x = $_[N]' etc.
+#
+# We're only called if the first two ops are nextstate and argcheck.
+
+sub deparse_argops {
+    my ($self, $firstop, $cv) = @_;
+
+    my @sig;
+    my $o = $firstop;
+    return if $o->label; #first nextstate;
+
+    # OP_ARGCHECK
+
+    $o = $o->sibling;
+    my ($params, $opt_params, $slurpy) = $o->aux_list($cv);
+    my $mandatory = $params - $opt_params;
+    my $seen_slurpy = 0;
+    my $last_ix = -1;
+
+    # keep looking for valid nextstate + argelem pairs
+
+    while (1) {
+        # OP_NEXTSTATE
+        $o = $o->sibling;
+        last unless $$o;
+        last unless $o->name =~ /^(next|db)state$/;
+        last if $o->label;
+
+        # OP_ARGELEM
+        my $o2 = $o->sibling;
+        last unless $$o2;
+
+        if ($o2->name eq 'argelem') {
+            my $ix  = $o2->string($cv);
+            while (++$last_ix < $ix) {
+                push @sig, $last_ix <  $mandatory ? '$' : '$=';
+            }
+            my $var = $self->padname($o2->targ);
+            if ($var =~ /^[@%]/) {
+                return if $seen_slurpy;
+                $seen_slurpy = 1;
+                return if $ix != $params or !$slurpy
+                            or substr($var,0,1) ne $slurpy;
+            }
+            else {
+                return if $ix >= $params;
+            }
+            if ($o2->flags & OPf_KIDS) {
+                my $kid = $o2->first;
+                return unless $$kid and $kid->name eq 'argdefelem';
+                my $def = $self->deparse($kid->first, 7);
+                $def = "($def)" if $kid->first->flags & OPf_PARENS;
+                $var .= " = $def";
+            }
+            push @sig, $var;
+        }
+        elsif ($o2->name eq 'null'
+               and ($o2->flags & OPf_KIDS)
+               and $o2->first->name eq 'argdefelem')
+        {
+            # special case - a void context default expression: $ = expr
+
+            my $defop = $o2->first;
+            my $ix = $defop->targ;
+            while (++$last_ix < $ix) {
+                push @sig, $last_ix <  $mandatory ? '$' : '$=';
+            }
+            return if $last_ix >= $params
+                    or $last_ix < $mandatory;
+            my $def = $self->deparse($defop->first, 7);
+            $def = "($def)" if $defop->first->flags & OPf_PARENS;
+            push @sig, '$ = ' . $def;
+        }
+        else {
+            last;
+        }
+
+        $o = $o2;
+    }
+
+    while (++$last_ix < $params) {
+        push @sig, $last_ix <  $mandatory ? '$' : '$=';
+    }
+    push @sig, $slurpy if $slurpy and !$seen_slurpy;
+
+    return ($o, join(', ', @sig));
+}
+
+# Deparse a sub. Returns everything except the 'sub foo',
+# e.g.  ($$) : method { ...; }
+# or    ($a, $b) : prototype($$) lvalue;
+
 sub deparse_sub {
     my $self = shift;
     my $cv = shift;
-    my $proto = "";
+    my @attrs;
+    my $protosig; # prototype or signature (what goes in the (....))
+
 Carp::confess("NULL in deparse_sub") if !defined($cv) || $cv->isa("B::NULL");
 Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
     local $self->{'curcop'} = $self->{'curcop'};
+
+    my $has_sig = $self->{hinthash}{feature_signatures};
     if ($cv->FLAGS & SVf_POK) {
-       $proto = "(". $cv->PV . ") ";
+       my $proto = $cv->PV;
+       if ($has_sig) {
+            push @attrs, "prototype($proto)";
+        }
+        else {
+            $protosig = $proto;
+        }
     }
     if ($cv->CvFLAGS & (CVf_METHOD|CVf_LOCKED|CVf_LVALUE|CVf_ANONCONST)) {
-        $proto .= ": ";
-        $proto .= "lvalue " if $cv->CvFLAGS & CVf_LVALUE;
-        $proto .= "locked " if $cv->CvFLAGS & CVf_LOCKED;
-        $proto .= "method " if $cv->CvFLAGS & CVf_METHOD;
-        $proto .= "const "  if $cv->CvFLAGS & CVf_ANONCONST;
+        push @attrs, "lvalue" if $cv->CvFLAGS & CVf_LVALUE;
+        push @attrs, "locked" if $cv->CvFLAGS & CVf_LOCKED;
+        push @attrs, "method" if $cv->CvFLAGS & CVf_METHOD;
+        push @attrs, "const"  if $cv->CvFLAGS & CVf_ANONCONST;
     }
 
     local($self->{'curcv'}) = $cv;
@@ -1251,11 +1350,36 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
        $self->pessimise($root, $cv->START);
        my $lineseq = $root->first;
        if ($lineseq->name eq "lineseq") {
-           my @ops;
-           for(my$o=$lineseq->first; $$o; $o=$o->sibling) {
+           my $firstop = $lineseq->first;
+
+            if ($has_sig) {
+                my $o2;
+                # try to deparse first few ops as a signature if possible
+                if (     $$firstop
+                     and $firstop->name =~  /^(next|db)state$/
+                     and (($o2 = $firstop->sibling))
+                     and $$o2)
+                {
+                    if ($o2->name eq 'argcheck') {
+                        my ($nexto, $sig) = $self->deparse_argops($firstop, $cv);
+                        if (defined $nexto) {
+                            $firstop = $nexto;
+                            $protosig = $sig;
+                        }
+                    }
+                }
+            }
+
+            my @ops;
+           for (my $o = $firstop; $$o; $o=$o->sibling) {
                push @ops, $o;
            }
            $body = $self->lineseq(undef, 0, @ops).";";
+            if (!$has_sig and $ops[-1]->name =~ /^(next|db)state$/) {
+                # this handles void context in
+                #   use feature signatures; sub ($=1) {}
+                $body .= "\n()";
+            }
            my $scope_en = $self->find_scope_en($lineseq);
            if (defined $scope_en) {
                my $subs = join"", $self->seq_subs($scope_en);
@@ -1265,17 +1389,21 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
        else {
            $body = $self->deparse($root->first, 0);
        }
+        $body = "{\n\t$body\n\b}";
     }
     else {
        my $sv = $cv->const_sv;
        if ($$sv) {
            # uh-oh. inlinable sub... format it differently
-           return $proto . "{ " . $self->const($sv, 0) . " }\n";
+           $body = "{ " . $self->const($sv, 0) . " }\n";
        } else { # XSUB? (or just a declaration)
-           return "$proto;\n";
+           $body = ';'
        }
     }
-    return $proto ."{\n\t$body\n\b}" ."\n";
+    $protosig = defined $protosig ? "($protosig) " : "";
+    my $attrs = '';
+    $attrs = ': ' . join('', map "$_ ", @attrs) if @attrs;
+    return "$protosig$attrs$body\n";
 }
 
 sub deparse_format {
@@ -1934,18 +2062,15 @@ sub _features_from_bundle {
     return $hh;
 }
 
-# Notice how subs and formats are inserted between statements here;
-# also $[ assignments and pragmas.
-sub pp_nextstate {
+# generate any pragmas, 'package foo' etc needed to synchronise
+# with the given cop
+
+sub pragmata {
     my $self = shift;
-    my($op, $cx) = @_;
-    $self->{'curcop'} = $op;
+    my($op) = @_;
+
     my @text;
-    push @text, $self->cop_subs($op);
-    if (@text) {
-       # Special marker to swallow up the semicolon
-       push @text, "\cK";
-    }
+
     my $stash = $op->stashpv;
     if ($stash ne $self->{'curstash'}) {
        push @text, $self->keyword("package") . " $stash;\n";
@@ -2024,6 +2149,29 @@ sub pp_nextstate {
        $self->{'hinthash'} = $newhh;
     }
 
+    return join("", @text);
+}
+
+
+# Notice how subs and formats are inserted between statements here;
+# also $[ assignments and pragmas.
+sub pp_nextstate {
+    my $self = shift;
+    my($op, $cx) = @_;
+    $self->{'curcop'} = $op;
+
+    my @text;
+
+    my @subs = $self->cop_subs($op);
+    if (@subs) {
+       # Special marker to swallow up the semicolon
+       push @subs, "\cK";
+    }
+    push @text, @subs;
+
+    push @text, $self->pragmata($op);
+
+
     # This should go after of any branches that add statements, to
     # increase the chances that it refers to the same line it did in
     # the original program.
@@ -4021,7 +4169,11 @@ sub pp_multideref {
 
     if ($op->first && ($op->first->flags & OPf_KIDS)) {
         # arbitrary initial expression, e.g. f(1,2,3)->[...]
-        $text .=  $self->deparse($op->first, 24);
+        my $expr = $self->deparse($op->first, 24);
+        # stop "exists (expr)->{...}" being interpreted as
+        #"(exists (expr))->{...}"
+        $expr = "+$expr" if $expr =~ /^\(/;
+        $text .=  $expr;
     }
 
     my @items = $op->aux_list($self->{curcv});
@@ -5772,6 +5924,63 @@ sub pp_lvavref {
                : &pp_padsv)  . ')'
 }
 
+
+sub pp_argcheck {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my ($params, $opt_params, $slurpy) = $op->aux_list($self->{curcv});
+    my $mandatory = $params - $opt_params;
+    my $check = '';
+
+    $check .= <<EOF if !$slurpy;
+die sprintf("Too many arguments for subroutine at %s line %d.\\n", (caller)[1, 2]) unless \@_ <= $params;
+EOF
+
+    $check .= <<EOF if $mandatory > 0;
+die sprintf("Too few arguments for subroutine at %s line %d.\\n", (caller)[1, 2]) unless \@_ >= $mandatory;
+EOF
+
+    my $cond = ($params & 1) ? 'unless' : 'if';
+    $check .= <<EOF if $slurpy eq '%';
+die sprintf("Odd name/value argument for subroutine at %s line %d.\\n", (caller)[1, 2]) if \@_ > $params && ((\@_ - $params) & 1);
+EOF
+
+    $check =~ s/;\n\z//;
+    return $check;
+}
+
+
+sub pp_argelem {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $var = $self->padname($op->targ);
+    my $ix  = $op->string($self->{curcv});
+    my $expr;
+    if ($op->flags & OPf_KIDS) {
+        $expr = $self->deparse($op->first, 7);
+    }
+    elsif ($var =~ /^[@%]/) {
+        $expr = $ix ? "\@_[$ix .. \$#_]" : '@_';
+    }
+    else {
+        $expr = "\$_[$ix]";
+    }
+    return "my $var = $expr";
+}
+
+
+sub pp_argdefelem {
+    my $self = shift;
+    my($op, $cx) = @_;
+    my $ix  = $op->targ;
+    my $expr = "\@_ >= " . ($ix+1) . " ? \$_[$ix] : ";
+    my $def = $self->deparse($op->first, 7);
+    $def = "($def)" if $op->first->flags & OPf_PARENS;
+    $expr .= $self->deparse($op->first, $cx);
+    return $expr;
+}
+
+
 1;
 __END__
 
@@ -6256,7 +6465,7 @@ which is not, consequently, deparsed correctly.
 =item *
 
 Lexical (my) variables declared in scopes external to a subroutine
-appear in code2ref output text as package variables.  This is a tricky
+appear in coderef2text output text as package variables.  This is a tricky
 problem, as perl has no native facility for referring to a lexical variable
 defined within a different scope, although L<PadWalker> is a good start.
 
index ba24c2717f38e6d46c1f7c3386048c4830d7621e..7d65d7458130f4935cff5ae0062b80316b5ac9c4 100644 (file)
@@ -87,7 +87,12 @@ EOC
        $regex =~ s/\s+/\\s+/g;
        $regex = '^\{\s*' . $regex . '\s*\}$';
 
-        like($deparsed, qr/$regex/, $desc);
+        like($deparsed, qr/$regex/, $desc)
+            or diag "=============================================\n"
+                  . "CODE:\n--------\n$input\n--------\n"
+                  . "EXPECTED:\n--------\n{\n$expected\n}\n--------\n"
+                  . "GOT:\n--------\n$deparsed\n--------\n"
+                  . "=============================================\n";
     }
 }
 
@@ -363,20 +368,20 @@ EOCODP
 # CORE::no
 $a = readpipe qq`$^X $path "-MO=Deparse" -Xe `
              .qq`"use feature q|:all|; my sub no; CORE::no less" 2>&1`;
-like($a, qr/my sub no;\nCORE::no less;/,
+like($a, qr/my sub no;\n.*CORE::no less;/s,
     'CORE::no after my sub no');
 
 # CORE::use
 $a = readpipe qq`$^X $path "-MO=Deparse" -Xe `
              .qq`"use feature q|:all|; my sub use; CORE::use less" 2>&1`;
-like($a, qr/my sub use;\nCORE::use less;/,
+like($a, qr/my sub use;\n.*CORE::use less;/s,
     'CORE::use after my sub use');
 
 # CORE::__DATA__
 $a = readpipe qq`$^X $path "-MO=Deparse" -Xe `
              .qq`"use feature q|:all|; my sub __DATA__; `
              .qq`CORE::__DATA__" 2>&1`;
-like($a, qr/my sub __DATA__;\n.*\nCORE::__DATA__/s,
+like($a, qr/my sub __DATA__;\n.*CORE::__DATA__/s,
     'CORE::__DATA__ after my sub __DATA__');
 
 # sub declarations
@@ -1946,12 +1951,10 @@ no warnings "experimental::lexical_subs";
 my sub f {}
 print f();
 >>>>
-BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55\x55"}
+BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"}
 my sub f {
-    BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"}
     
 }
-BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"}
 print f();
 ####
 # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version"
@@ -1961,12 +1964,10 @@ no warnings 'experimental::lexical_subs';
 state sub f {}
 print f();
 >>>>
-BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55\x55"}
+BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"}
 state sub f {
-    BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"}
     
 }
-BEGIN {${^WARNING_BITS} = "\x54\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x55\x54\x55\x55\x55"}
 print f();
 ####
 # SKIP ?$] < 5.017004 && "lexical subs not implemented on this Perl version"
@@ -2457,12 +2458,17 @@ my $e = delete $h{'foo'}[$i];
 ####
 # multideref with leading expression
 my $r;
-my $x = ($r // [])->{'foo'}[0];
+my $x = +($r // [])->{'foo'}[0];
 ####
 # multideref with complex middle index
 my(%h, $i, $j, $k);
 my $x = $h{'foo'}[$i + $j]{$k};
 ####
+# multideref with trailing non-simple index that initially looks simple
+# (i.e. the constant "3")
+my($r, $i, $j, $k);
+my $x = +($r || {})->{'foo'}[$i + $j]{3 + $k};
+####
 # chdir
 chdir 'file';
 chdir FH;
@@ -2484,3 +2490,97 @@ $_ ^= $_;
 $_ |.= $_;
 $_ &.= $_;
 $_ ^.= $_;
+####
+####
+# Should really use 'no warnings "experimental::signatures"',
+# but it doesn't yet deparse correctly.
+# anon subs used because this test framework doesn't deparse named subs
+# in the DATA code snippets.
+#
+# general signature
+no warnings;
+use feature 'signatures';
+my $x;
+sub ($a, $, $b = $glo::bal, $c = $a, $d = 'foo', $e = -37, $f = 0, $g = 1, $h = undef, $i = $a + 1, $j = /foo/, @) {
+    $x++;
+}
+;
+$x++;
+####
+# Signature and prototype
+no warnings;
+use feature 'signatures';
+my $x;
+sub ($a, $b) : prototype($$) {
+    $x++;
+}
+;
+$x++;
+####
+# Signature and prototype and attrs
+no warnings;
+use feature 'signatures';
+my $x;
+sub ($a, $b) : prototype($$) lvalue {
+    $x++;
+}
+;
+$x++;
+####
+# Signature and attrs
+no warnings;
+use feature 'signatures';
+my $x;
+sub ($a, $b) : lvalue method {
+    $x++;
+}
+;
+$x++;
+####
+# named array slurp, null body
+no warnings;
+use feature 'signatures';
+sub (@a) {
+    ;
+}
+;
+####
+# named hash slurp
+no warnings;
+use feature 'signatures';
+sub ($key, %h) {
+    $h{$key};
+}
+;
+####
+# anon hash slurp
+no warnings;
+use feature 'signatures';
+sub ($a, %) {
+    $a;
+}
+;
+####
+# parenthesised default arg
+no warnings;
+use feature 'signatures';
+sub ($a, $b = (/foo/), $c = 1) {
+    $a + $b + $c;
+}
+;
+####
+# parenthesised default arg with TARGMY
+no warnings;
+use feature 'signatures';
+sub ($a, $b = ($a + 1), $c = 1) {
+    $a + $b + $c;
+}
+;
+####
+# empty default
+no warnings;
+use feature 'signatures';
+sub ($a, $=) {
+    $a;
+}
+;
index bb2d573480b0b8ab06571941e91799efd189ef94..23ce78e6ee223ca9f9e2eef1ea85e9a18d006483 100644 (file)
@@ -118,7 +118,7 @@ package B::Op_private;
 our %bits;
 
 
-our $VERSION = "5.025003";
+our $VERSION = "5.025004";
 
 $bits{$_}{3} = 'OPpENTERSUB_AMPER' for qw(entersub rv2cv);
 $bits{$_}{6} = 'OPpENTERSUB_DB' for qw(entersub rv2cv);
@@ -207,6 +207,17 @@ my @bf = (
         bitmax    => 7,
         bitmask   => 255,
     },
+    {
+        mask_def  => 'OPpARGELEM_MASK',
+        bitmin    => 1,
+        bitmax    => 2,
+        bitmask   => 6,
+        enum      => [
+            0, 'OPpARGELEM_SV', 'SV',
+            1, 'OPpARGELEM_AV', 'AV',
+            2, 'OPpARGELEM_HV', 'HV',
+        ],
+    },
     {
         mask_def  => 'OPpDEREF',
         bitmin    => 4,
@@ -237,7 +248,7 @@ $bits{abs}{0} = $bf[0];
 @{$bits{accept}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 @{$bits{add}}{1,0} = ($bf[1], $bf[1]);
 $bits{aeach}{0} = $bf[0];
-@{$bits{aelem}}{5,4,1,0} = ($bf[7], $bf[7], $bf[1], $bf[1]);
+@{$bits{aelem}}{5,4,1,0} = ($bf[8], $bf[8], $bf[1], $bf[1]);
 @{$bits{aelemfast}}{7,6,5,4,3,2,1,0} = ($bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6]);
 @{$bits{aelemfast_lex}}{7,6,5,4,3,2,1,0} = ($bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6]);
 $bits{akeys}{0} = $bf[0];
@@ -247,6 +258,9 @@ $bits{andassign}{0} = $bf[0];
 $bits{anonconst}{0} = $bf[0];
 @{$bits{anonhash}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 @{$bits{anonlist}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
+$bits{argcheck}{0} = $bf[0];
+$bits{argdefelem}{0} = $bf[0];
+@{$bits{argelem}}{2,1,0} = ($bf[7], $bf[7], $bf[0]);
 @{$bits{atan2}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 $bits{av2arylen}{0} = $bf[0];
 $bits{avalues}{0} = $bf[0];
@@ -290,7 +304,7 @@ $bits{each}{0} = $bf[0];
 @{$bits{entereval}}{5,4,3,2,1,0} = ('OPpEVAL_RE_REPARSING', 'OPpEVAL_COPHH', 'OPpEVAL_BYTES', 'OPpEVAL_UNICODE', 'OPpEVAL_HAS_HH', $bf[0]);
 $bits{entergiven}{0} = $bf[0];
 $bits{enteriter}{3} = 'OPpITER_DEF';
-@{$bits{entersub}}{5,4,0} = ($bf[7], $bf[7], 'OPpENTERSUB_INARGS');
+@{$bits{entersub}}{5,4,0} = ($bf[8], $bf[8], 'OPpENTERSUB_INARGS');
 $bits{entertry}{0} = $bf[0];
 $bits{enterwhen}{0} = $bf[0];
 @{$bits{enterwrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@@ -361,7 +375,7 @@ $bits{grepwhile}{0} = $bf[0];
 @{$bits{gsockopt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 @{$bits{gt}}{1,0} = ($bf[1], $bf[1]);
 $bits{gv}{5} = 'OPpEARLY_CV';
-@{$bits{helem}}{5,4,1,0} = ($bf[7], $bf[7], $bf[1], $bf[1]);
+@{$bits{helem}}{5,4,1,0} = ($bf[8], $bf[8], $bf[1], $bf[1]);
 $bits{hex}{0} = $bf[0];
 @{$bits{i_add}}{1,0} = ($bf[1], $bf[1]);
 @{$bits{i_divide}}{1,0} = ($bf[1], $bf[1]);
@@ -409,7 +423,7 @@ $bits{log}{0} = $bf[0];
 $bits{lstat}{0} = $bf[0];
 @{$bits{lt}}{1,0} = ($bf[1], $bf[1]);
 $bits{lvavref}{0} = $bf[0];
-@{$bits{lvref}}{5,4,0} = ($bf[8], $bf[8], $bf[0]);
+@{$bits{lvref}}{5,4,0} = ($bf[9], $bf[9], $bf[0]);
 $bits{mapstart}{0} = $bf[0];
 $bits{mapwhile}{0} = $bf[0];
 $bits{method}{0} = $bf[0];
@@ -443,7 +457,7 @@ $bits{orassign}{0} = $bf[0];
 $bits{ord}{0} = $bf[0];
 @{$bits{pack}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 @{$bits{padrange}}{6,5,4,3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5]);
-@{$bits{padsv}}{5,4} = ($bf[7], $bf[7]);
+@{$bits{padsv}}{5,4} = ($bf[8], $bf[8]);
 @{$bits{pipe_op}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 $bits{pop}{0} = $bf[0];
 $bits{pos}{0} = $bf[0];
@@ -464,7 +478,7 @@ $bits{readlink}{0} = $bf[0];
 @{$bits{recv}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 $bits{redo}{0} = $bf[0];
 $bits{ref}{0} = $bf[0];
-@{$bits{refassign}}{5,4,1,0} = ($bf[8], $bf[8], $bf[1], $bf[1]);
+@{$bits{refassign}}{5,4,1,0} = ($bf[9], $bf[9], $bf[1], $bf[1]);
 $bits{refgen}{0} = $bf[0];
 $bits{regcmaybe}{0} = $bf[0];
 $bits{regcomp}{0} = $bf[0];
@@ -480,9 +494,9 @@ $bits{rewinddir}{0} = $bf[0];
 $bits{rmdir}{0} = $bf[0];
 $bits{rv2av}{0} = $bf[0];
 @{$bits{rv2cv}}{7,5,0} = ('OPpENTERSUB_NOPAREN', 'OPpMAY_RETURN_CONSTANT', $bf[0]);
-@{$bits{rv2gv}}{6,5,4,2,0} = ('OPpALLOW_FAKE', $bf[7], $bf[7], 'OPpDONT_INIT_GV', $bf[0]);
+@{$bits{rv2gv}}{6,5,4,2,0} = ('OPpALLOW_FAKE', $bf[8], $bf[8], 'OPpDONT_INIT_GV', $bf[0]);
 $bits{rv2hv}{0} = $bf[0];
-@{$bits{rv2sv}}{5,4,0} = ($bf[7], $bf[7], $bf[0]);
+@{$bits{rv2sv}}{5,4,0} = ($bf[8], $bf[8], $bf[0]);
 @{$bits{sassign}}{7,6,1,0} = ('OPpASSIGN_CV_TO_GV', 'OPpASSIGN_BACKWARDS', $bf[1], $bf[1]);
 @{$bits{sbit_and}}{1,0} = ($bf[1], $bf[1]);
 @{$bits{sbit_or}}{1,0} = ($bf[1], $bf[1]);
@@ -571,6 +585,10 @@ our %defines = (
     OPpARG2_MASK             =>   3,
     OPpARG3_MASK             =>   7,
     OPpARG4_MASK             =>  15,
+    OPpARGELEM_AV            =>   2,
+    OPpARGELEM_HV            =>   4,
+    OPpARGELEM_MASK          =>   6,
+    OPpARGELEM_SV            =>   0,
     OPpASSIGN_BACKWARDS      =>  64,
     OPpASSIGN_COMMON_AGG     =>  16,
     OPpASSIGN_COMMON_RC1     =>  32,
@@ -665,6 +683,9 @@ our %defines = (
 
 our %labels = (
     OPpALLOW_FAKE            => 'FAKE',
+    OPpARGELEM_AV            => 'AV',
+    OPpARGELEM_HV            => 'HV',
+    OPpARGELEM_SV            => 'SV',
     OPpASSIGN_BACKWARDS      => 'BKWARD',
     OPpASSIGN_COMMON_AGG     => 'COM_AGG',
     OPpASSIGN_COMMON_RC1     => 'COM_RC1',
diff --git a/lib/Internals.pod b/lib/Internals.pod
new file mode 100644 (file)
index 0000000..28f6711
--- /dev/null
@@ -0,0 +1,69 @@
+=head1 NAME
+
+Internals - Reserved special namespace for internals related functions
+
+=head1 SYNOPSIS
+
+    $is_ro= Internals::SvREADONLY($x)
+    $refcnt= Internals::SvREFCNT($x)
+
+=head1 DESCRIPTION
+
+The Internals namespace is used by the core Perl development team to
+expose certain low level internals routines for testing and other purposes.
+
+In theory these routines were not and are not intended to be used outside
+of the perl core, and are subject to change and removal at any time.
+
+In practice people have come to depend on these over the years, despite
+being historically undocumented, so we will provide some level of
+forward compatibility for some time. Nevertheless you can assume that any
+routine documented here is experimental or deprecated and you should find
+alternatives to their use.
+
+=head2 FUNCTIONS
+
+=over 4
+
+=item SvREFCNT(THING [, $value])
+
+Historically Perl has been a refcounted language. This means that each
+variable tracks how many things reference it, and when the variable is no
+longer referenced it will automatically free itself. In theory Perl code
+should not have to care about this, and in a future version Perl might
+change to some other strategy, although in practice this is unlikely.
+
+This function allows one to violate the abstraction of variables and get
+or set the refcount of a variable, and in generally is really only useful
+in code that is testing refcount behavior.
+
+*NOTE* You are strongly discouraged from using this function in non-test
+code and especially discouraged from using the set form of this function.
+The results of doing so may result in segmentation faults or other undefined
+behavior.
+
+=item SvREADONLY(THING, [, $value])
+
+Set or get whether a variable is readonly or not. Exactly what the
+readonly flag means depend on the type of the variable affected and the
+version of perl used.
+
+You are strongly discouraged from using this function directly. It is used
+by various core modules, like C<Hash::Util>, and the C<constant> pragma
+to implement higher-level behavior which should be used instead.
+
+See the core implementation for the exact meaning of the readonly flag for
+each internal variable type.
+
+=back
+
+=head1 AUTHOR
+
+Perl core development team.
+
+=head1 SEE ALSO
+
+L<perlguts>
+universal.c
+
+=cut
index d7ea6cc1dcc6f4742fc4ee91cc3eedb445bfb4fa..9c86c417b0f4281c7d70f38e4e298e937a81b241 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     push @INC, '../lib';
 }
 
-# bug id 20001020.002
+# bug id 20001020.002 (#4480)
 # -dlc 20001021
 
 use Tie::Array;
index 9a5400c87a22fdf03c5a62aec373f78720c03eea..14bdebddb05e587581ecf76f9c42d811b2b8074c 100644 (file)
@@ -188,7 +188,7 @@ sub test_vianame ($$$) {
 }
 
 {
-    # 20001114.001
+    # 20001114.001 (#4690)
 
     no utf8; # naked Latin-1
 
index 075b0e6ea4de63a02a49ed6716b5b531900db65e..e8cedbca5a95f2171d93a6a1095dc15a2047ad4a 100644 (file)
@@ -32,7 +32,7 @@ use strict;
 use feature 'fc', 'postderef';
 
 # =1 adds debugging output; =2 increases the verbosity somewhat
-my $debug = $ENV{PERL_DEBUG_FULL_TEST} // 0;
+our $debug = $ENV{PERL_DEBUG_FULL_TEST} // 0;
 
 # Certain tests have been shown to be problematical for a few locales.  Don't
 # fail them unless at least this percentage of the tested locales fail.
@@ -66,6 +66,7 @@ my $dumper = Dumpvalue->new(
                             quoteHighBit => 0,
                             unctrl => "quote"
                            );
+
 sub debug {
   return unless $debug;
   my($mess) = join "", '# ', @_;
@@ -73,6 +74,11 @@ sub debug {
   print STDERR $dumper->stringify($mess,1), "\n";
 }
 
+sub note {
+    local $debug = 1;
+    debug @_;
+}
+
 sub debug_more {
   return unless $debug > 1;
   return debug(@_);
@@ -973,7 +979,7 @@ foreach my $Locale (@Locale) {
         @{$posixes{'punct'}} = grep /[[:punct:]]/, map {chr } 0..255;
         @{$posixes{'upper'}} = grep /[[:upper:]]/, map {chr } 0..255;
         @{$posixes{'xdigit'}} = grep /[[:xdigit:]]/, map {chr } 0..255;
-        @{$posixes{'cased'}} = grep /[[:upper:]]/i, map {chr } 0..255;
+        @{$posixes{'cased'}} = grep /[[:upper:][:lower:]]/i, map {chr } 0..255;
 
         # Sieve the uppercase and the lowercase.
 
@@ -1004,7 +1010,7 @@ foreach my $Locale (@Locale) {
         @{$posixes{'punct'}} = grep /[[:punct:]]/, map {chr } 0..255;
         @{$posixes{'upper'}} = grep /[[:upper:]]/, map {chr } 0..255;
         @{$posixes{'xdigit'}} = grep /[[:xdigit:]]/, map {chr } 0..255;
-        @{$posixes{'cased'}} = grep /[[:upper:]]/i, map {chr } 0..255;
+        @{$posixes{'cased'}} = grep /[[:upper:][:lower:]]/i, map {chr } 0..255;
         for (@{$posixes{'word'}}) {
             if (/[^\d_]/) { # skip digits and the _
                 if (uc($_) eq $_) {
@@ -1024,13 +1030,13 @@ foreach my $Locale (@Locale) {
     debug ":cased:  = ", disp_chars(@{$posixes{'cased'}}), "\n";
     debug ":alpha:  = ", disp_chars(@{$posixes{'alpha'}}), "\n";
     debug ":alnum:  = ", disp_chars(@{$posixes{'alnum'}}), "\n";
-    debug " w       = ", disp_chars(@{$posixes{'word'}}), "\n";
+    debug ' \w      = ', disp_chars(@{$posixes{'word'}}), "\n";
     debug ":graph:  = ", disp_chars(@{$posixes{'graph'}}), "\n";
     debug ":print:  = ", disp_chars(@{$posixes{'print'}}), "\n";
-    debug " d       = ", disp_chars(@{$posixes{'digit'}}), "\n";
+    debug ' \d      = ', disp_chars(@{$posixes{'digit'}}), "\n";
     debug ":xdigit: = ", disp_chars(@{$posixes{'xdigit'}}), "\n";
     debug ":blank:  = ", disp_chars(@{$posixes{'blank'}}), "\n";
-    debug " s       = ", disp_chars(@{$posixes{'space'}}), "\n";
+    debug ' \s      = ', disp_chars(@{$posixes{'space'}}), "\n";
     debug ":punct:  = ", disp_chars(@{$posixes{'punct'}}), "\n";
     debug ":cntrl:  = ", disp_chars(@{$posixes{'cntrl'}}), "\n";
     debug ":ascii:  = ", disp_chars(@{$posixes{'ascii'}}), "\n";
@@ -1198,7 +1204,7 @@ foreach my $Locale (@Locale) {
                     (/[[:xdigit:]]/ xor /[[:^xdigit:]]/) ||
 
                     # effectively is what [:cased:] would be if it existed.
-                    (/[[:upper:]]/i xor /[[:^upper:]]/i);
+                    (/[[:upper:][:lower:]]/i xor /[^[:upper:][:lower:]]/i);
         }
         else {
             push @f, $_ unless   (/[[:alpha:]]/ xor /[[:^alpha:]]/)   ||
@@ -1214,7 +1220,7 @@ foreach my $Locale (@Locale) {
                     (/[[:upper:]]/ xor /[[:^upper:]]/)   ||
                     (/[[:word:]]/  xor /[[:^word:]]/)    ||
                     (/[[:xdigit:]]/ xor /[[:^xdigit:]]/) ||
-                    (/[[:upper:]]/i xor /[[:^upper:]]/i);
+                    (/[[:upper:][:lower:]]/i xor /[^[:upper:][:lower:]]/i);
         }
     }
     report_multi_result($Locale, $locales_test_number, \@f);
@@ -1739,7 +1745,11 @@ foreach my $Locale (@Locale) {
         use locale;
 
         my @sorted_controls = sort @{$posixes{'cntrl'}};
-        debug "sorted :cntrl: = ", disp_chars(@sorted_controls), "\n";
+        my $output = "";
+        for my $control (@sorted_controls) {
+            $output .= " " . disp_chars($control);
+        }
+        debug "sorted :cntrl: = $output\n";
 
         ++$locales_test_number;
         $test_names{$locales_test_number}
@@ -1978,11 +1988,15 @@ foreach my $Locale (@Locale) {
                 foreach my $err (keys %!) {
                     use Errno;
                     $! = eval "&Errno::$err";   # Convert to strerror() output
+                    my $errnum = 0+$!;
                     my $strerror = "$!";
                     if ("$strerror" =~ /\P{ASCII}/) {
                         $ok14 = utf8::is_utf8($strerror);
                         no locale;
                         $ok14_5 = "$!" !~ /\P{ASCII}/;
+                        debug( disp_str(
+                        "non-ASCII \$! for error $errnum='$strerror'"))
+                                                                   if ! $ok14_5;
                         last;
                     }
                 }
@@ -2028,8 +2042,9 @@ foreach my $Locale (@Locale) {
             use Errno;
             $! = eval "&Errno::$err";   # Convert to strerror() output
             my $strerror = "$!";
-            if ("$strerror" =~ /\P{ASCII}/) {
+            if ($strerror =~ /\P{ASCII}/) {
                 $ok21 = 0;
+                debug(disp_str("non-ASCII strerror=$strerror"));
                 last;
             }
         }
@@ -2148,7 +2163,7 @@ foreach my $Locale (@Locale) {
     debug "$first_f_test..$locales_test_number: \$f = $f, \$g = $g, back to locale = $Locale\n";
 
     # Does taking lc separately differ from taking
-    # the lc "in-line"?  (This was the bug 19990704.002, change #3568.)
+    # the lc "in-line"?  (This was the bug 19990704.002 (#965), change #3568.)
     # The bug was in the caching of the 'o'-magic.
     if (! $is_utf8_locale) {
        use locale;
@@ -2609,7 +2624,7 @@ foreach ($first_locales_test_number..$final_locales_test_number) {
        print <<EOW;
 #
 # If your users are not using these locales you are safe for the moment,
-# but please report this failure first to perlbug\@perl.com using the
+# but please report this failure first to perlbug\@perl.org using the
 # perlbug script (as described in the INSTALL file) so that the exact
 # details of the failures can be sorted out first and then your operating
 # system supplier can be alerted about these anomalies.
diff --git a/lib/locale_threads.t b/lib/locale_threads.t
new file mode 100644 (file)
index 0000000..5559f91
--- /dev/null
@@ -0,0 +1,53 @@
+use strict;
+use warnings;
+
+# This file tests interactions with locale and threads
+
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+    set_up_inc('../lib');
+    require './loc_tools.pl';
+    skip_all("No locales") unless locales_enabled();
+    skip_all_without_config('useithreads');
+    $| = 1;
+}
+
+SKIP: { # perl #127708
+    my @locales = grep { $_ !~ / ^ C \b | POSIX /x } find_locales('LC_MESSAGES',
+                                                        'non-problematic-only');
+    skip("No valid locale to test with", 1) unless @locales;
+
+    # reset the locale environment
+    local @ENV{'LANG', (grep /^LC_/, keys %ENV)};
+    local $ENV{LC_MESSAGES} = $locales[0];
+
+    # We're going to try with all possible error numbers on this platform
+    my $error_count = keys(%!) + 1;
+
+    print fresh_perl("
+        use threads;
+        use strict;
+        use warnings;
+
+        my \$errnum = 1;
+
+        my \@threads = map +threads->create(sub {
+            sleep 0.1;
+
+            for (1..5_000) {
+                \$errnum = (\$errnum + 1) % $error_count;
+                \$! = \$errnum;
+
+                # no-op to trigger stringification
+                next if \"\$!\" eq \"\";
+            }
+        }), (0..1);
+        \$_->join for splice \@threads;",
+    {}
+    );
+
+    pass("Didn't segfault");
+}
+
+done_testing;
index ef4ce4e593d5020a077b7afa8711d71c28a7b81d..d778776ef7f7bfd6d558154b9c6d189f96e11068 100644 (file)
@@ -1021,7 +1021,7 @@ unless ($aaa) {
   main::ok($x+0 =~ qr/Recurse=ARRAY/);
 }
 
-# BugID 20010422.003
+# BugID 20010422.003 (#6872)
 package Foo;
 
 use overload
index f26731bacf0a51c9976db0ff1943724c8c770ffb..07ee636c5860465c8f49833f03cac9f254f7a1a3 100644 (file)
@@ -528,7 +528,8 @@ BEGIN {
 # Debugger for Perl 5.00x; perl5db.pl patch level:
 use vars qw($VERSION $header);
 
-$VERSION = '1.49_04';
+# bump to X.XX in blead, only use X.XX_XX in maint
+$VERSION = '1.50';
 
 $header = "perl5db.pl version $VERSION";
 
@@ -1951,7 +1952,10 @@ sub _DB__handle_y_command {
         = $obj->cmd_args =~ /\A(?:(\d*)\s*(.*))?\z/) {
 
         # See if we've got the necessary support.
-        if (!eval { require PadWalker; PadWalker->VERSION(0.08) }) {
+        if (!eval {
+            local @INC = @INC;
+            pop @INC if $INC[-1] eq '.';
+            require PadWalker; PadWalker->VERSION(0.08) }) {
             my $Err = $@;
             _db_warn(
                 $Err =~ /locate/
@@ -9441,7 +9445,10 @@ if PadWalker could be loaded.
 
 =cut
 
-        if (not $text =~ /::/ and eval { require PadWalker } ) {
+        if (not $text =~ /::/ and eval {
+            local @INC = @INC;
+            pop @INC if $INC[-1] eq '.';
+            require PadWalker } ) {
             my $level = 1;
             while (1) {
                 my @info = caller($level);
index 0517938e4350d8977855d4881dcf991134df827f..d81fc63b08f747d82853177338c674cf70697d7b 100644 (file)
@@ -422,7 +422,7 @@ my $unicode_reference_url = 'http://www.unicode.org/reports/tr44/';
 #
 # A NOTE ON UNIHAN
 #
-# This program can generate tables from the Unihan database.  But that db
+# This program can generate tables from the Unihan database.  But that DB
 # isn't normally available, so it is marked as optional.  Prior to version
 # 5.2, this database was in a single file, Unihan.txt.  In 5.2 the database
 # was split into 8 different files, all beginning with the letters 'Unihan'.
@@ -651,7 +651,7 @@ sub stack_trace() {
 # by the code points introduced in the later version.  You probably also want
 # to use the -annotate option when using this.  Run this program on a unicore
 # containing the starting release you want to compare.  Save that output
-# structrue.  Then, switching to a unicore with the ending release, change the
+# structure.  Then, switching to a unicore with the ending release, change the
 # 0 in the $string_compare_versions definition just below to a string
 # containing a SINGLE dotted Unicode release number (e.g. "2.1") corresponding
 # to the starting release.  This program will then compile, but throw away all
@@ -731,7 +731,8 @@ while (@ARGV) {
         $verbosity = 0;
     }
     elsif ($arg eq '-w') {
-        $write_unchanged_files = 1; # update the files even if havent changed
+        # update the files even if they haven't changed
+        $write_unchanged_files = 1;
     }
     elsif ($arg eq '-check') {
         my $this = shift @ARGV;
@@ -1161,7 +1162,7 @@ my $run_on_code_point_re =
             qr/ (?: 10[0-9A-F]{4} | [1-9A-F][0-9A-F]{4} | [0-9A-F]{4} ) \b/x;
 my $code_point_re = qr/\b$run_on_code_point_re/;
 
-# This matches the beginning of the line in the Unicode db files that give the
+# This matches the beginning of the line in the Unicode DB files that give the
 # defaults for code points not listed (i.e., missing) in the file.  The code
 # depends on this ending with a semi-colon, so it can assume it is a valid
 # field when the line is split() by semi-colons
@@ -2104,7 +2105,7 @@ package Input_file;
 #   1) call before the first line is read, for pre processing
 #   2) call to adjust each line of the input before the main handler gets
 #      them.  This can be automatically generated, if appropriately simple
-#      enough, by specifiying a Properties parameter in the constructor.
+#      enough, by specifying a Properties parameter in the constructor.
 #   3) call upon EOF before the main handler exits its loop
 #   4) call at the end, for post processing
 #
@@ -2112,7 +2113,7 @@ package Input_file;
 # each_line_handler()s.  So, if the format of the line is not in the desired
 # format for the main handler, these are used to do that adjusting.  They can
 # be stacked (by enclosing them in an [ anonymous array ] in the constructor,
-# so the $_ output of one is used as the input to the next.  The eof handler
+# so the $_ output of one is used as the input to the next.  The EOF handler
 # is also stackable, but none of the others are, but could easily be changed
 # to be so.
 #
@@ -2196,7 +2197,7 @@ sub trace { return main::trace(@_); }
     # not otherwise be processed, and to not raise a warning about not being
     # handled.  In the constructor call, any value that evaluates to a numeric
     # 0 or undef means don't skip.  Any other value is a string giving the
-    # reason it is being skippped, and this will appear in generated pod.
+    # reason it is being skipped, and this will appear in generated pod.
     # However, an empty string reason will suppress the pod entry.
     # Internally, calls that evaluate to numeric 0 are changed into undef to
     # distinguish them from an empty string call.
@@ -2222,7 +2223,7 @@ sub trace { return main::trace(@_); }
     # meaningful line of the input file.  If present, an appropriate
     # each_line_handler() is automatically generated and pushed onto the stack
     # of such handlers.  This is useful when a file contains multiple
-    # proerties per line, but no other special considerations are necessary.
+    # properties per line, but no other special considerations are necessary.
     # The special value "<ignored>" means to discard the corresponding input
     # field.
     # Any @missing lines in the file should also match this syntax; no such
@@ -15420,7 +15421,7 @@ sub add_perl_synonyms() {
 
                 if (! defined $pre_existing) {
 
-                    # No name collision, so ok to add the perl synonym.
+                    # No name collision, so OK to add the perl synonym.
 
                     my $make_re_pod_entry;
                     my $ok_as_filename;
@@ -15515,7 +15516,7 @@ sub add_perl_synonyms() {
                     next;
                 }
 
-                # Here, there is a name collision, but it still could be ok if
+                # Here, there is a name collision, but it still could be OK if
                 # the tables match the identical set of code points, in which
                 # case, we can combine the names.  Compare each table's code
                 # point list to see if they are identical.
@@ -16481,7 +16482,7 @@ sub make_ucd_table_pod_entries {
                     Carp::my_carp("Bad news.  $property and $ucd_pod{$standard}->{'property'} have unexpected output status and perl-extension combinations.  Proceeding anyway.");
                 }
 
-                # We modifiy the info column of the one being output to
+                # We modify the info column of the one being output to
                 # indicate the ambiguity.  Set $which to point to that one's
                 # info.
                 my $which;
@@ -16736,7 +16737,7 @@ END
         push @bad_re_properties, "\n=back\n";
     }
 
-    # Similiarly, generate a list of files that we don't use, grouped by the
+    # Similarly, generate a list of files that we don't use, grouped by the
     # reasons why (Don't output if the reason is empty).  First, create a hash
     # whose keys are the reasons, and whose values are anonymous arrays of all
     # the files that share that reason.
@@ -17647,7 +17648,7 @@ sub make_UCD () {
             foreach my $prop_alias ($property->aliases) {
                 my $prop_alias_name = standardize($prop_alias->name);
 
-                # If no =value, there's just one combination possibe for this
+                # If no =value, there's just one combination possible for this
                 if (! $value_name) {
 
                     # The property may be suppressed, but there may be a proxy
@@ -18039,7 +18040,7 @@ sub write_all_tables() {
                     # the children.
                     make_re_pod_entries($table) if defined $pod_directory;
 
-                    # See if the the table matches identical code points with
+                    # See if the table matches identical code points with
                     # something that has already been output.  In that case,
                     # no need to have two files with the same code points in
                     # them.  We use the table's hash() method to store these
@@ -18202,7 +18203,7 @@ sub write_all_tables() {
                         # the table.  That is, all the property-values given
                         # by this table.  By agreement with Unicode::UCD,
                         # if the name and full name are identical, and there
-                        # are no other names, drop the duplcate entry to save
+                        # are no other names, drop the duplicate entry to save
                         # memory.
                         if (@values_list == 2
                             && $values_list[0] eq $values_list[1])
@@ -18366,14 +18367,14 @@ sub generate_separator($) {
 
 sub generate_tests($$$$$) {
     # This used only for making the test script.  It generates test cases that
-    # are expected to compile successfully in perl.  Note that the lhs and
-    # rhs are assumed to already be as randomized as the caller wants.
+    # are expected to compile successfully in perl.  Note that the LHS and
+    # RHS are assumed to already be as randomized as the caller wants.
 
     my $lhs = shift;           # The property: what's to the left of the colon
                                #  or equals separator
     my $rhs = shift;           # The property value; what's to the right
     my $valid_code = shift;    # A code point that's known to be in the
-                               # table given by lhs=rhs; undef if table is
+                               # table given by LHS=RHS; undef if table is
                                # empty
     my $invalid_code = shift;  # A code point known to not be in the table;
                                # undef if the table is all code points
@@ -18414,13 +18415,13 @@ sub generate_error($$$) {
                                     # colon or equals separator
     my $rhs = shift;                # The property value; what's to the right
     my $already_in_error = shift;   # Boolean; if true it's known that the
-                                # unmodified lhs and rhs will cause an error.
+                                # unmodified LHS and RHS will cause an error.
                                 # This routine should not force another one
     # Get the colon or equal
     my $separator = generate_separator($lhs);
 
     # Since this is an error only, don't bother to randomly decide whether to
-    # put the error on the left or right side; and assume that the rhs is
+    # put the error on the left or right side; and assume that the RHS is
     # loosely matched, again for convenience rather than rigor.
     $rhs = randomize_loose_name($rhs, 'ERROR') unless $already_in_error;
 
@@ -19189,7 +19190,7 @@ my @input_file_objects = (
                      # for the release it is.  To get it to actually mean
                      # something useful, someone would have to be using an
                      # earlier Unicode release, and copy it into the directory
-                     # for that release and recomplile.  So far there has been
+                     # for that release and recompile.  So far there has been
                      # no demand to do that, so this hasn't been implemented.
                     Skip => 'Documentation of corrections already '
                           . 'incorporated into the Unicode data base',
@@ -19812,7 +19813,7 @@ sub Expect($$$$) {
         $Tests++;
 
         # A string eval is needed because of the 'no warnings'.
-        # Assumes no parens in the regular expression
+        # Assumes no parentheses in the regular expression
         my $result = eval "$no_warnings
                             my \$RegObj = qr($regex);
                             $string =~ \$RegObj ? 1 : 0";
@@ -20158,7 +20159,7 @@ Expect(0, 0x2029, '\p{Print}', ""); # Bug # 71722
 Expect(1, 0xFF10, '\p{XDigit}', ""); # Bug # 71726
 
 # Make sure this gets tested; it was not part of the official test suite at
-# the time this was addded.  Note that this is as it would appear in the
+# the time this was added.  Note that this is as it would appear in the
 # official suite, and gets modified to check for the perl tailoring by
 # Test_WB()
 Test_WB("$breakable 0020 $breakable 0020 $breakable 0308 $breakable");
index d90361dbe025ef1c7a44371c76cf6bdf823e87a2..c9dbb6ee59081f19f552bd3c7b33770934d9b80d 100644 (file)
@@ -40,7 +40,7 @@ no utf8; # Ironic, no?
 #
 
 {
-    # bug id 20001009.001
+    # bug id 20001009.001 (#4409)
 
     my ($a, $b);
 
@@ -56,7 +56,7 @@ no utf8; # Ironic, no?
 
 
 {
-    # bug id 20000730.004
+    # bug id 20000730.004 (#3599)
 
     my $smiley = "\x{263a}";
 
index fb3e676308e8e725ec154be0320719a7fa35ab17..9f64d805cf9eccf4189d29f13f9a8b46cf50eb20 100644 (file)
--- a/locale.c
+++ b/locale.c
@@ -677,9 +677,9 @@ Perl_new_collate(pTHX_ const char *newcoll)
 #ifdef DEBUGGING
             if (DEBUG_L_TEST || debug_initialization) {
                 PerlIO_printf(Perl_debug_log,
-                    "%s:%d: ?UTF-8 locale=%d; x_len_shorter=%"UVuf", "
-                    "x_len_longer=%"UVuf","
-                    " collate multipler=%"UVuf", collate base=%"UVuf"\n",
+                    "%s:%d: ?UTF-8 locale=%d; x_len_shorter=%zu, "
+                    "x_len_longer=%zu,"
+                    " collate multipler=%zu, collate base=%zu\n",
                     __FILE__, __LINE__,
                     PL_in_utf8_COLLATE_locale,
                     x_len_shorter, x_len_longer,
@@ -1031,7 +1031,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn)
                        : NULL;
        sl_result = my_setlocale(LC_MESSAGES, locale_param);
         DEBUG_LOCALE_INIT(LC_MESSAGES, locale_param, sl_result);
-       if (! sl_result)
+       if (! sl_result) {
            setlocale_failure = TRUE;
         }
 #       endif /* USE_LOCALE_MESSAGES */
@@ -1453,6 +1453,8 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
 
     /* If this locale has defective collation, skip */
     if (PL_collxfrm_base == 0 && PL_collxfrm_mult == 0) {
+        DEBUG_L(PerlIO_printf(Perl_debug_log,
+                      "_mem_collxfrm: locale's collation is defective\n"));
         goto bad;
     }
 
@@ -1462,13 +1464,6 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
      * less-than-perfect results with that character and NUL.  This is
      * unavoidable unless we replace strxfrm with our own implementation.
      *
-     * XXX This code may be overkill.  khw wrote it before realizing that if
-     * you change a NUL into some other character, that that may change the
-     * strxfrm results if that character is part of a sequence with other
-     * characters for weight calculations.  To minimize the chances of this,
-     * now the replacement is restricted to another control (likely to be
-     * \001).  But the full generality has been retained.
-     *
      * This is one of the few places in the perl core, where we can use
      * standard functions like strlen() and strcat().  It's because we're
      * looking for NULs. */
@@ -1476,100 +1471,104 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
         char * e = s + len;
         char * sans_nuls;
         STRLEN cur_min_char_len;
+        int try_non_controls;
 
         /* If we don't know what control character sorts lowest for this
          * locale, find it */
         if (*PL_strxfrm_min_char == '\0') {
             int j;
 #ifdef DEBUGGING
-            U8     cur_min_cp = 1;  /* The code point that sorts lowest, so far */
+            U8     cur_min_cp = 1; /* The code point that sorts lowest, so far */
 #endif
             char * cur_min_x = NULL;    /* And its xfrm, (except it also
                                            includes the collation index
                                            prefixed. */
 
             DEBUG_Lv(PerlIO_printf(Perl_debug_log, "Looking to replace NUL\n"));
-            /* Look through all legal code points (NUL isn't) */
-            for (j = 1; j < 256; j++) {
-                char * x;       /* j's xfrm plus collation index */
-                STRLEN x_len;   /* length of 'x' */
-                STRLEN trial_len = 1;
-
-                /* Create a 1 byte string of the current code point, but with
-                 * room to be 2 bytes */
-                char cur_source[] = { (char) j, '\0' , '\0' };
-
-                if (PL_in_utf8_COLLATE_locale) {
-                    if (! isCNTRL_L1(j)) {
-                        continue;
-                    }
 
-                    /* If needs to be 2 bytes, find them */
-                    if (! UVCHR_IS_INVARIANT(j)) {
-                        char * d = cur_source;
-                        append_utf8_from_native_byte((U8) j, (U8 **) &d);
-                        trial_len = 2;
+            /* Unlikely, but it may be that no control will work to replace
+             * NUL, in which case we instead look for any character */
+            for (try_non_controls = 0;
+                 try_non_controls < 2;
+                 try_non_controls++)
+            {
+                /* Look through all legal code points (NUL isn't) */
+                for (j = 1; j < 256; j++) {
+                    char * x;       /* j's xfrm plus collation index */
+                    STRLEN x_len;   /* length of 'x' */
+                    STRLEN trial_len = 1;
+
+                    /* Create a 1 byte string of the current code point, but
+                     * with room to be 2 bytes */
+                    char cur_source[] = { (char) j, '\0' , '\0' };
+
+                    if (PL_in_utf8_COLLATE_locale) {
+                        if (! try_non_controls && ! isCNTRL_L1(j)) {
+                            continue;
+                        }
+
+                        /* If needs to be 2 bytes, find them */
+                        if (! UVCHR_IS_INVARIANT(j)) {
+                            char * d = cur_source;
+                            append_utf8_from_native_byte((U8) j, (U8 **) &d);
+                            trial_len = 2;
+                        }
+                    }
+                    else if (! try_non_controls && ! isCNTRL_LC(j)) {
+                        continue;
                     }
-                }
-                else if (! isCNTRL_LC(j)) {
-                    continue;
-                }
 
-                /* Then transform it */
-                x = _mem_collxfrm(cur_source, trial_len, &x_len,
-                                  PL_in_utf8_COLLATE_locale);
+                    /* Then transform it */
+                    x = _mem_collxfrm(cur_source, trial_len, &x_len,
+                                      PL_in_utf8_COLLATE_locale);
 
-                /* If something went wrong (which it shouldn't), just
-                 * ignore this code point */
-                if (   x_len == 0
-                    || strlen(x + COLLXFRM_HDR_LEN) < x_len)
-                {
-                    continue;
-                }
+                    /* Ignore any character that didn't successfully transform
+                     * */
+                    if (! x) {
+                        continue;
+                    }
 
-                /* If this character's transformation is lower than
-                 * the current lowest, this one becomes the lowest */
-                if (   cur_min_x == NULL
-                    || strLT(x         + COLLXFRM_HDR_LEN,
-                             cur_min_x + COLLXFRM_HDR_LEN))
-                {
-                    PL_strxfrm_min_char[0] = cur_source[0];
-                    PL_strxfrm_min_char[1] = cur_source[1];
-                    PL_strxfrm_min_char[2] = cur_source[2];
-                    cur_min_x = x;
+                    /* If this character's transformation is lower than
+                     * the current lowest, this one becomes the lowest */
+                    if (   cur_min_x == NULL
+                        || strLT(x         + COLLXFRM_HDR_LEN,
+                                 cur_min_x + COLLXFRM_HDR_LEN))
+                    {
+                        PL_strxfrm_min_char[0] = cur_source[0];
+                        PL_strxfrm_min_char[1] = cur_source[1];
+                        PL_strxfrm_min_char[2] = cur_source[2];
+                        cur_min_x = x;
 #ifdef DEBUGGING
-                    cur_min_cp = j;
+                        cur_min_cp = j;
 #endif
+                    }
+                    else {
+                        Safefree(x);
+                    }
+                } /* end of loop through all bytes */
+
+                if (cur_min_x) {
+                    break;
                 }
-                else {
-                    Safefree(x);
-                }
-            } /* end of loop through all bytes */
-
-            /* Unlikely, but possible, if there aren't any controls in the
-             * locale, arbitrarily use \001 */
-            if (cur_min_x == NULL) {
-                STRLEN x_len;   /* temporary */
-                cur_min_x = _mem_collxfrm("\001", 1, &x_len,
-                                          PL_in_utf8_COLLATE_locale);
-                /* cur_min_cp was already initialized to 1 */
+
+                /* Unlikely, but possible, if there aren't any controls that
+                 * work in the locale, repeat the loop, looking for any
+                 * character that works */
+                DEBUG_L(PerlIO_printf(Perl_debug_log,
+                "_mem_collxfrm: No control worked.  Trying non-controls\n"));
             }
 
-            DEBUG_L(PerlIO_printf(Perl_debug_log,
-                    "_mem_collxfrm: lowest collating non-NUL control in the "
-                    "0-255 range in locale %s is 0x%02X\n",
-                    PL_collation_name,
-                    cur_min_cp));
-            if (DEBUG_Lv_TEST) {
-                unsigned i;
-                PerlIO_printf(Perl_debug_log, "Its xfrm is");
-                for (i = 0; i < strlen(cur_min_x + COLLXFRM_HDR_LEN); i ++) {
-                    PerlIO_printf(Perl_debug_log, " %02x",
-                                (U8) *(cur_min_x + COLLXFRM_HDR_LEN + i));
-                }
-                PerlIO_printf(Perl_debug_log, "\n");
+            if (! cur_min_x) {
+                DEBUG_L(PerlIO_printf(Perl_debug_log,
+                    "_mem_collxfrm: Couldn't find any character to replace"
+                    " embedded NULs in locale %s with", PL_collation_name));
+                goto bad;
             }
 
+            DEBUG_L(PerlIO_printf(Perl_debug_log,
+                    "_mem_collxfrm: Replacing embedded NULs in locale %s with "
+                    "0x%02X\n", PL_collation_name, cur_min_cp));
+
             Safefree(cur_min_x);
         }
 
@@ -1580,7 +1579,6 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
         Newx(sans_nuls, (len * cur_min_char_len) + 1, char);
         *sans_nuls = '\0';
 
-
         /* Replace each NUL with the lowest collating control.  Loop until have
          * exhausted all the NULs */
         while (s + s_strlen < e) {
@@ -1668,8 +1666,7 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
 
                         /* If something went wrong (which it shouldn't), just
                          * ignore this code point */
-                        if (x_len == 0) {
-                            Safefree(x);
+                        if (! x) {
                             continue;
                         }
 
@@ -1687,23 +1684,19 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
                         }
                     }
 
+                    if (! cur_max_x) {
+                        DEBUG_L(PerlIO_printf(Perl_debug_log,
+                            "_mem_collxfrm: Couldn't find any character to"
+                            " replace above-Latin1 chars in locale %s with",
+                            PL_collation_name));
+                        goto bad;
+                    }
+
                     DEBUG_L(PerlIO_printf(Perl_debug_log,
                             "_mem_collxfrm: highest 1-byte collating character"
                             " in locale %s is 0x%02X\n",
                             PL_collation_name,
                             PL_strxfrm_max_cp));
-                    if (DEBUG_Lv_TEST) {
-                        unsigned i;
-                        PerlIO_printf(Perl_debug_log, "Its xfrm is ");
-                        for (i = 0;
-                             i < strlen(cur_max_x + COLLXFRM_HDR_LEN);
-                             i++)
-                        {
-                            PerlIO_printf(Perl_debug_log, " %02x",
-                                        (U8) cur_max_x[i + COLLXFRM_HDR_LEN]);
-                        }
-                        PerlIO_printf(Perl_debug_log, "\n");
-                    }
 
                     Safefree(cur_max_x);
                 }
@@ -1757,8 +1750,11 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
            + PL_collxfrm_base
            + (PL_collxfrm_mult * length_in_chars);
     Newx(xbuf, xAlloc, char);
-    if (UNLIKELY(! xbuf))
+    if (UNLIKELY(! xbuf)) {
+        DEBUG_L(PerlIO_printf(Perl_debug_log,
+                      "_mem_collxfrm: Couldn't malloc %zu bytes\n", xAlloc));
        goto bad;
+    }
 
     /* Store the collation id */
     *(U32*)xbuf = PL_collation_ix;
@@ -1766,6 +1762,7 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
     /* Then the transformation of the input.  We loop until successful, or we
      * give up */
     for (;;) {
+
         *xlen = strxfrm(xbuf + COLLXFRM_HDR_LEN, s, xAlloc - COLLXFRM_HDR_LEN);
 
         /* If the transformed string occupies less space than we told strxfrm()
@@ -1773,6 +1770,15 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
          * string. */
         if (*xlen < xAlloc - COLLXFRM_HDR_LEN) {
 
+            /* Some systems include a trailing NUL in the returned length.
+             * Ignore it, using a loop in case multiple trailing NULs are
+             * returned. */
+            while (   (*xlen) > 0
+                   && *(xbuf + COLLXFRM_HDR_LEN + (*xlen) - 1) == '\0')
+            {
+                (*xlen)--;
+            }
+
             /* If the first try didn't get it, it means our prediction was low.
              * Modify the coefficients so that we predict a larger value in any
              * future transformations */
@@ -1788,10 +1794,10 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
                                      : PL_collxfrm_mult;
 
                 DEBUG_Lv(PerlIO_printf(Perl_debug_log,
-                    "%s: %d: initial size of %"UVuf" bytes for a length "
-                    "%"UVuf" string was insufficient, %"UVuf" needed\n",
+                    "%s: %d: initial size of %zu bytes for a length "
+                    "%zu string was insufficient, %zu needed\n",
                     __FILE__, __LINE__,
-                    (UV) computed_guess, (UV) length_in_chars, (UV) needed));
+                    computed_guess, length_in_chars, needed));
 
                 /* If slope increased, use it, but discard this result for
                  * length 1 strings, as we can't be sure that it's a real slope
@@ -1810,20 +1816,20 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
                     }
 
                     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
-                        "%s: %d: slope is now %"UVuf"; was %"UVuf", base "
-                        "is now %"UVuf"; was %"UVuf"\n",
+                        "%s: %d: slope is now %zu; was %zu, base "
+                        "is now %zu; was %zu\n",
                         __FILE__, __LINE__,
-                        (UV) PL_collxfrm_mult, (UV) old_m,
-                        (UV) PL_collxfrm_base, (UV) old_b));
+                        PL_collxfrm_mult, old_m,
+                        PL_collxfrm_base, old_b));
                 }
                 else {  /* Slope didn't change, but 'b' did */
                     const STRLEN new_b = needed
                                         - computed_guess
                                         + PL_collxfrm_base;
                     DEBUG_Lv(PerlIO_printf(Perl_debug_log,
-                        "%s: %d: base is now %"UVuf"; was %"UVuf"\n",
+                        "%s: %d: base is now %zu; was %zu\n",
                         __FILE__, __LINE__,
-                        (UV) new_b, (UV) PL_collxfrm_base));
+                        new_b, PL_collxfrm_base));
                     PL_collxfrm_base = new_b;
                 }
             }
@@ -1831,13 +1837,17 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
             break;
         }
 
-        if (UNLIKELY(*xlen >= PERL_INT_MAX))
+        if (UNLIKELY(*xlen >= PERL_INT_MAX)) {
+            DEBUG_L(PerlIO_printf(Perl_debug_log,
+                  "_mem_collxfrm: Needed %zu bytes, max permissible is %u\n",
+                  *xlen, PERL_INT_MAX));
             goto bad;
+        }
 
         /* A well-behaved strxfrm() returns exactly how much space it needs
-         * (not including the trailing NUL) when it fails due to not enough
-         * space being provided.  Assume that this is the case unless it's been
-         * proven otherwise */
+         * (usually not including the trailing NUL) when it fails due to not
+         * enough space being provided.  Assume that this is the case unless
+         * it's been proven otherwise */
         if (LIKELY(PL_strxfrm_is_behaved) && first_time) {
             xAlloc = *xlen + COLLXFRM_HDR_LEN + 1;
         }
@@ -1850,7 +1860,8 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
                 *      (Many versions of cygwin fit this.  When the buffer size
                 *      isn't sufficient, they return the input size instead of
                 *      how much is needed.)
-                * Increase the buffer size by a fixed percentage and try again. */
+                * Increase the buffer size by a fixed percentage and try again.
+                * */
             xAlloc += (xAlloc / 4) + 1;
             PL_strxfrm_is_behaved = FALSE;
 
@@ -1858,16 +1869,19 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
             if (DEBUG_Lv_TEST || debug_initialization) {
                 PerlIO_printf(Perl_debug_log,
                 "_mem_collxfrm required more space than previously calculated"
-                " for locale %s, trying again with new guess=%d+%"UVuf"\n",
+                " for locale %s, trying again with new guess=%d+%zu\n",
                 PL_collation_name, (int) COLLXFRM_HDR_LEN,
-                (UV) xAlloc - COLLXFRM_HDR_LEN);
+                xAlloc - COLLXFRM_HDR_LEN);
             }
 #endif
         }
 
         Renew(xbuf, xAlloc, char);
-        if (UNLIKELY(! xbuf))
+        if (UNLIKELY(! xbuf)) {
+            DEBUG_L(PerlIO_printf(Perl_debug_log,
+                      "_mem_collxfrm: Couldn't realloc %zu bytes\n", xAlloc));
             goto bad;
+        }
 
         first_time = FALSE;
     }
@@ -1875,35 +1889,10 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
 
 #ifdef DEBUGGING
     if (DEBUG_Lv_TEST || debug_initialization) {
-        unsigned i;
-        char * t = s;
-        bool prev_was_printable = TRUE;
-        bool first_time = TRUE;
-        PerlIO_printf(Perl_debug_log,
-            "_mem_collxfrm[%d]: returning %"UVuf" for locale %s string '",
-            PL_collation_ix, *xlen, PL_collation_name);
-        while (t < s + len ) {
-            UV cp = (utf8)
-                    ?  utf8_to_uvchr_buf((U8 *) t, s + len, NULL)
-                    : * (U8 *) t;
-            if (isPRINT(cp)) {
-                if (! prev_was_printable) {
-                    PerlIO_printf(Perl_debug_log, " ");
-                }
-                PerlIO_printf(Perl_debug_log, "%c", (U8) cp);
-                prev_was_printable = TRUE;
-            }
-            else {
-                if (! first_time) {
-                    PerlIO_printf(Perl_debug_log, " ");
-                }
-                PerlIO_printf(Perl_debug_log, "%02"UVXf"", cp);
-                prev_was_printable = FALSE;
-            }
-            t += (utf8) ? UTF8SKIP(t) : 1;
-            first_time = FALSE;
-        }
-        PerlIO_printf(Perl_debug_log, "'\nIts xfrm is");
+        Size_t i;
+
+        print_collxfrm_input_and_return(s, s + len, xlen, utf8);
+        PerlIO_printf(Perl_debug_log, "Its xfrm is:");
         for (i = COLLXFRM_HDR_LEN; i < *xlen + COLLXFRM_HDR_LEN; i++) {
             PerlIO_printf(Perl_debug_log, " %02x", (U8) xbuf[i]);
         }
@@ -1928,13 +1917,65 @@ Perl__mem_collxfrm(pTHX_ const char *input_string,
     *xlen = 0;
 #ifdef DEBUGGING
     if (DEBUG_Lv_TEST || debug_initialization) {
-        PerlIO_printf(Perl_debug_log, "_mem_collxfrm[%d] returning NULL\n",
-                                      PL_collation_ix);
+        print_collxfrm_input_and_return(s, s + len, NULL, utf8);
     }
 #endif
     return NULL;
 }
 
+#ifdef DEBUGGING
+
+void
+S_print_collxfrm_input_and_return(pTHX_
+                                  const char * const s,
+                                  const char * const e,
+                                  const STRLEN * const xlen,
+                                  const bool is_utf8)
+{
+    const char * t = s;
+    bool prev_was_printable = TRUE;
+    bool first_time = TRUE;
+
+    PERL_ARGS_ASSERT_PRINT_COLLXFRM_INPUT_AND_RETURN;
+
+    PerlIO_printf(Perl_debug_log, "_mem_collxfrm[%d]: returning ",
+                                                            PL_collation_ix);
+    if (xlen) {
+        PerlIO_printf(Perl_debug_log, "%"UVuf"", (UV) *xlen);
+    }
+    else {
+        PerlIO_printf(Perl_debug_log, "NULL");
+    }
+    PerlIO_printf(Perl_debug_log, " for locale '%s', string='",
+                                                            PL_collation_name);
+
+    while (t < e) {
+        UV cp = (is_utf8)
+                ?  utf8_to_uvchr_buf((U8 *) t, e, NULL)
+                : * (U8 *) t;
+        if (isPRINT(cp)) {
+            if (! prev_was_printable) {
+                PerlIO_printf(Perl_debug_log, " ");
+            }
+            PerlIO_printf(Perl_debug_log, "%c", (U8) cp);
+            prev_was_printable = TRUE;
+        }
+        else {
+            if (! first_time) {
+                PerlIO_printf(Perl_debug_log, " ");
+            }
+            PerlIO_printf(Perl_debug_log, "%02"UVXf"", cp);
+            prev_was_printable = FALSE;
+        }
+        t += (is_utf8) ? UTF8SKIP(t) : 1;
+        first_time = FALSE;
+    }
+
+    PerlIO_printf(Perl_debug_log, "'\n");
+}
+
+#endif   /* #ifdef DEBUGGING */
+
 #endif /* USE_LOCALE_COLLATE */
 
 #ifdef USE_LOCALE
@@ -2464,47 +2505,112 @@ Perl__is_in_locale_category(pTHX_ const bool compiling, const int category)
 }
 
 char *
-Perl_my_strerror(pTHX_ const int errnum) {
+Perl_my_strerror(pTHX_ const int errnum)
+{
+    /* Returns a mortalized copy of the text of the error message associated
+     * with 'errnum'.  It uses the current locale's text unless the platform
+     * doesn't have the LC_MESSAGES category or we are not being called from
+     * within the scope of 'use locale'.  In the former case, it uses whatever
+     * strerror returns; in the latter case it uses the text from the C locale.
+     *
+     * The function just calls strerror(), but temporarily switches, if needed,
+     * to the C locale */
+
+    char *errstr;
+
+#ifdef USE_LOCALE_MESSAGES  /* If platform doesn't have messages category, we
+                               don't do any switching to the C locale; we just
+                               use whatever strerror() returns */
+    const bool within_locale_scope = IN_LC(LC_MESSAGES);
+
     dVAR;
 
-    /* Uses C locale for the error text unless within scope of 'use locale' for
-     * LC_MESSAGES */
+#  ifdef USE_THREAD_SAFE_LOCALE
+    locale_t save_locale;
+#  else
+    char * save_locale;
+    bool locale_is_C = FALSE;
 
-#ifdef USE_LOCALE_MESSAGES
-    if (! IN_LC(LC_MESSAGES)) {
-        char * save_locale;
+    /* We have a critical section to prevent another thread from changing the
+     * locale out from under us (or zapping the buffer returned from
+     * setlocale() ) */
+    LOCALE_LOCK;
 
-        /* We have a critical section to prevent another thread from changing
-         * the locale out from under us (or zapping the buffer returned from
-         * setlocale() ) */
-        LOCALE_LOCK;
+#  endif
+
+    if (! within_locale_scope) {
+        errno = 0;
+
+#  ifdef USE_THREAD_SAFE_LOCALE /* Use the thread-safe locale functions */
+
+        save_locale = uselocale(PL_C_locale_obj);
+        if (! save_locale) {
+            DEBUG_L(PerlIO_printf(Perl_debug_log,
+                                  "uselocale failed, errno=%d\n", errno));
+        }
+
+#  else    /* Not thread-safe build */
 
         save_locale = setlocale(LC_MESSAGES, NULL);
-        if (! isNAME_C_OR_POSIX(save_locale)) {
-            char *errstr;
+        if (! save_locale) {
+            DEBUG_L(PerlIO_printf(Perl_debug_log,
+                                  "setlocale failed, errno=%d\n", errno));
+        }
+        else {
+            locale_is_C = isNAME_C_OR_POSIX(save_locale);
 
-            /* The next setlocale likely will zap this, so create a copy */
-            save_locale = savepv(save_locale);
+            /* Switch to the C locale if not already in it */
+            if (! locale_is_C) {
 
-            setlocale(LC_MESSAGES, "C");
+                /* The setlocale() just below likely will zap 'save_locale', so
+                 * create a copy.  */
+                save_locale = savepv(save_locale);
+                setlocale(LC_MESSAGES, "C");
+            }
+        }
 
-            /* This points to the static space in Strerror, with all its
-             * limitations */
-            errstr = Strerror(errnum);
+#  endif
 
-            setlocale(LC_MESSAGES, save_locale);
-            Safefree(save_locale);
+    }   /* end of ! within_locale_scope */
+
+#endif
 
-            LOCALE_UNLOCK;
+    errstr = Strerror(errnum);
+    if (errstr) {
+        errstr = savepv(errstr);
+        SAVEFREEPV(errstr);
+    }
+
+#ifdef USE_LOCALE_MESSAGES
+
+    if (! within_locale_scope) {
+        errno = 0;
 
-            return errstr;
+#  ifdef USE_THREAD_SAFE_LOCALE
+
+        if (save_locale && ! uselocale(save_locale)) {
+            DEBUG_L(PerlIO_printf(Perl_debug_log,
+                          "uselocale restore failed, errno=%d\n", errno));
         }
+    }
 
-        LOCALE_UNLOCK;
+#  else
+
+        if (save_locale && ! locale_is_C) {
+            if (! setlocale(LC_MESSAGES, save_locale)) {
+                DEBUG_L(PerlIO_printf(Perl_debug_log,
+                      "setlocale restore failed, errno=%d\n", errno));
+            }
+            Safefree(save_locale);
+        }
     }
+
+    LOCALE_UNLOCK;
+
+#  endif
 #endif
 
-    return Strerror(errnum);
+    return errstr;
 }
 
 /*
index 956914e7ed3f2dc788dac4a069a9bb482ff2f17e..80723ca9ffd1fcf4eeaee5f9438b542f87c402e3 100644 (file)
@@ -398,6 +398,14 @@ unless ($define{'USE_ITHREADS'}) {
                         );
 }
 
+unless (   $define{'USE_ITHREADS'}
+        && $define{'HAS_NEWLOCALE'})
+{
+    ++$skip{$_} foreach qw(
+        PL_C_locale_obj
+    );
+}
+
 unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
     ++$skip{$_} foreach qw(
                    PL_my_cxt_index
index 4e203b6872dce95e75a7f57a8bde74a95d192a7d..e4efae52d6bd6206547e1f15d4b230297900eede 100755 (executable)
@@ -231,8 +231,9 @@ if $test -s .deptmp; then
         $sed 's|\.incl\.c|.h|' .deptmp >.deptmp.vos
         mv -f .deptmp.vos .deptmp
     fi
-    $sed 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \
-       >>$mf.new
+    $sed -e 's|^\(.*\$(OBJ_EXT):\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" \
+       -e 'h; s/mini\(perlmain\)/\1/p; g' \
+       .deptmp >>$mf.new
 else
     $MAKE hlist || ($echo "Searching for .h files..."; \
        $echo *.h | $tr ' ' $trnl | $egrep -v '\*' >.hlist)
index 82ee7784fb2493a9d48cf9a3e17e73b59012dff8..1480186f692a9a0ce0351d4cdf006e9b3f9eee4a 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -747,17 +747,6 @@ Perl_save_long(pTHX_ long int *longp)
     SSPUSHUV(SAVEt_LONG);
 }
 
-void
-Perl_save_iv(pTHX_ IV *ivp)
-{
-    PERL_ARGS_ASSERT_SAVE_IV;
-
-    SSCHECK(3);
-    SSPUSHIV(*ivp);
-    SSPUSHPTR(ivp);
-    SSPUSHUV(SAVEt_IV);
-}
-
 void
 Perl_save_nogv(pTHX_ GV *gv)
 {
@@ -1194,7 +1183,7 @@ Perl_sv_copypv(pTHX_ SV *const dsv, SV *const ssv)
 {
     PERL_ARGS_ASSERT_SV_COPYPV;
 
-    sv_copypv_flags(dsv, ssv, 0);
+    sv_copypv_flags(dsv, ssv, SV_GMAGIC);
 }
 
 UV      /* Made into a function, so can be deprecated */
index 94aae841ee7a6dcf9115886597fae6b635aa07d8..a5538d85348c77a5f834c9d61857351641be8fea 100644 (file)
@@ -20,6 +20,7 @@
  * HAS_FEGETROUND
  * HAS_FPCLASSIFY
  * HAS_FREELOCALE
+ * HAS_GAI_STRERROR
  * HAS_GMTIME64
  * HAS_ISFINITEL
  * HAS_ISINFL
@@ -35,6 +36,7 @@
  * HAS_STRERROR_L
  * HAS_TIMEGM
  * HAS_USELOCALE
+ * I_XLOCALE
  * I16SIZE
  * I64SIZE
  * I8SIZE
diff --git a/op.c b/op.c
index 18692e59d87a94f2e2af49307ec4315ea39ad5d1..693828f8ef01e99da1ecc48e9ef0eaa9031a8e47 100644 (file)
--- a/op.c
+++ b/op.c
@@ -929,6 +929,7 @@ Perl_op_clear(pTHX_ OP *o)
         /* FALLTHROUGH */
     case OP_ENTERTRY:
     case OP_ENTEREVAL: /* Was holding hints. */
+    case OP_ARGDEFELEM:        /* Was holding signature index. */
        o->op_targ = 0;
        break;
     default:
@@ -1052,6 +1053,10 @@ Perl_op_clear(pTHX_ OP *o)
 
        break;
 
+    case OP_ARGCHECK:
+        PerlMemShared_free(cUNOP_AUXo->op_aux);
+        break;
+
     case OP_MULTIDEREF:
         {
             UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
@@ -1488,8 +1493,8 @@ S_op_sibling_newUNOP(pTHX_ OP *parent, OP *start, I32 type, I32 flags)
  * being spread throughout this file.
  */
 
-STATIC LOGOP *
-S_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
+LOGOP *
+Perl_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
 {
     dVAR;
     LOGOP *logop;
@@ -3254,7 +3259,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
        goto nomod;
     }
 
-    /* [20011101.069] File test operators interpret OPf_REF to mean that
+    /* [20011101.069 (#7861)] File test operators interpret OPf_REF to mean that
        their argument is a filehandle; thus \stat(".") should not set
        it. AMS 20011102 */
     if (type == OP_REFGEN &&
@@ -5857,7 +5862,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor)
            expr = list(force_list(newUNOP(OP_ENTERSUB, 0, scalar(expr)), 1));
        }
 
-        rcop = S_alloc_LOGOP(aTHX_ OP_REGCOMP, scalar(expr), o);
+        rcop = alloc_LOGOP(OP_REGCOMP, scalar(expr), o);
        rcop->op_flags |=  ((PL_hints & HINT_RE_EVAL) ? OPf_SPECIAL : 0)
                           | (reglist ? OPf_STACKED : 0);
        rcop->op_targ = cv_targ;
@@ -5921,7 +5926,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor)
            op_prepend_elem(o->op_type, scalar(repl), o);
        }
        else {
-            rcop = S_alloc_LOGOP(aTHX_ OP_SUBSTCONT, scalar(repl), o);
+            rcop = alloc_LOGOP(OP_SUBSTCONT, scalar(repl), o);
            rcop->op_private = 1;
 
            /* establish postfix order */
@@ -6993,7 +6998,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
         }
     }
 
-    logop = S_alloc_LOGOP(aTHX_ type, first, LINKLIST(other));
+    logop = alloc_LOGOP(type, first, LINKLIST(other));
     logop->op_flags |= (U8)flags;
     logop->op_private = (U8)(1 | (flags >> 8));
 
@@ -7064,7 +7069,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
        live->op_folded = 1;
        return live;
     }
-    logop = S_alloc_LOGOP(aTHX_ OP_COND_EXPR, first, LINKLIST(trueop));
+    logop = alloc_LOGOP(OP_COND_EXPR, first, LINKLIST(trueop));
     logop->op_flags |= (U8)flags;
     logop->op_private = (U8)(1 | (flags >> 8));
     logop->op_next = LINKLIST(falseop);
@@ -7113,7 +7118,7 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
 
     PERL_ARGS_ASSERT_NEWRANGE;
 
-    range = S_alloc_LOGOP(aTHX_ OP_RANGE, left, LINKLIST(right));
+    range = alloc_LOGOP(OP_RANGE, left, LINKLIST(right));
     range->op_flags = OPf_KIDS;
     leftstart = LINKLIST(left);
     range->op_private = (U8)(1 | (flags >> 8));
@@ -7633,7 +7638,7 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block,
     PERL_ARGS_ASSERT_NEWGIVWHENOP;
     PERL_UNUSED_ARG(entertarg); /* used to indicate targ of lexical $_ */
 
-    enterop = S_alloc_LOGOP(aTHX_ enter_opcode, block, NULL);
+    enterop = alloc_LOGOP(enter_opcode, block, NULL);
     enterop->op_targ = 0;
     enterop->op_private = 0;
 
@@ -9674,7 +9679,7 @@ Perl_ck_eval(pTHX_ OP *o)
             op_sibling_splice(o, NULL, -1, NULL);
            op_free(o);
 
-            enter = S_alloc_LOGOP(aTHX_ OP_ENTERTRY, NULL, NULL);
+            enter = alloc_LOGOP(OP_ENTERTRY, NULL, NULL);
 
            /* establish postfix order */
            enter->op_next = (OP*)enter;
@@ -10246,7 +10251,7 @@ Perl_ck_grep(pTHX_ OP *o)
        Perl_croak(aTHX_ "panic: ck_grep, type=%u", (unsigned) kid->op_type);
     kid = kUNOP->op_first;
 
-    gwop = S_alloc_LOGOP(aTHX_ type, o, LINKLIST(kid));
+    gwop = alloc_LOGOP(type, o, LINKLIST(kid));
     kid->op_next = (OP*)gwop;
     o->op_private = gwop->op_private = 0;
     gwop->op_targ = pad_alloc(type, SVs_PADTMP);
@@ -12071,6 +12076,7 @@ Perl_ck_each(pTHX_ OP *o)
                    && SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVHV  )
                   )
                    goto bad;
+                /* FALLTHROUGH */
            default:
                 qerror(Perl_mess(aTHX_
                     "Experimental %s on scalar is now forbidden",
@@ -13039,6 +13045,8 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
                 is_last = TRUE;
                 index_skip = action_count;
                 action |= MDEREF_FLAG_last;
+                if (index_type != MDEREF_INDEX_none)
+                    arg--;
             }
 
             if (pass)
@@ -13668,7 +13676,7 @@ Perl_rpeep(pTHX_ OP *o)
            /* XXX: We avoid setting op_seq here to prevent later calls
               to rpeep() from mistakenly concluding that optimisation
               has already occurred. This doesn't fix the real problem,
-              though (See 20010220.007). AMS 20010719 */
+              though (See 20010220.007 (#5874)). AMS 20010719 */
            /* op_seq functionality is now replaced by op_opt */
            o->op_opt = 0;
            /* FALLTHROUGH */
@@ -14162,6 +14170,7 @@ Perl_rpeep(pTHX_ OP *o)
        case OP_DORASSIGN:
        case OP_RANGE:
        case OP_ONCE:
+       case OP_ARGDEFELEM:
            while (cLOGOP->op_other->op_type == OP_NULL)
                cLOGOP->op_other = cLOGOP->op_other->op_next;
            DEFER(cLOGOP->op_other);
@@ -15018,6 +15027,7 @@ const_av_xsub(pTHX_ CV* cv)
     XSRETURN(AvFILLp(av)+1);
 }
 
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */
index 0aaefb64a4c5599a2420292b6fbb9e8d9e3bc7af..24f5a672f619e04c5ae705d790d896b00504a44e 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -334,6 +334,9 @@ EXTCONST char* const PL_op_name[] = {
        "entersub",
        "leavesub",
        "leavesublv",
+       "argcheck",
+       "argelem",
+       "argdefelem",
        "caller",
        "warn",
        "die",
@@ -736,6 +739,9 @@ EXTCONST char* const PL_op_desc[] = {
        "subroutine entry",
        "subroutine exit",
        "lvalue subroutine return",
+       "check subroutine arguments",
+       "subroutine argument",
+       "subroutine argument default value",
        "caller",
        "warn",
        "die",
@@ -1152,6 +1158,9 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
        Perl_pp_entersub,
        Perl_pp_leavesub,
        Perl_pp_leavesublv,
+       Perl_pp_argcheck,
+       Perl_pp_argelem,
+       Perl_pp_argdefelem,
        Perl_pp_caller,
        Perl_pp_warn,
        Perl_pp_die,
@@ -1564,6 +1573,9 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
        Perl_ck_subr,           /* entersub */
        Perl_ck_null,           /* leavesub */
        Perl_ck_null,           /* leavesublv */
+       Perl_ck_null,           /* argcheck */
+       Perl_ck_null,           /* argelem */
+       Perl_ck_null,           /* argdefelem */
        Perl_ck_fun,            /* caller */
        Perl_ck_fun,            /* warn */
        Perl_ck_fun,            /* die */
@@ -1970,6 +1982,9 @@ EXTCONST U32 PL_opargs[] = {
        0x00002141,     /* entersub */
        0x00000100,     /* leavesub */
        0x00000100,     /* leavesublv */
+       0x00000f00,     /* argcheck */
+       0x00000f00,     /* argelem */
+       0x00000300,     /* argdefelem */
        0x00009b08,     /* caller */
        0x0000240d,     /* warn */
        0x0000240d,     /* die */
@@ -2184,12 +2199,14 @@ EXTCONST U32 PL_opargs[] = {
 END_EXTERN_C
 
 
+#define OPpARGELEM_SV           0x00
 #define OPpLVREF_SV             0x00
 #define OPpARG1_MASK            0x01
 #define OPpCOREARGS_DEREF1      0x01
 #define OPpENTERSUB_INARGS      0x01
 #define OPpSORT_NUMERIC         0x01
 #define OPpTRANS_FROM_UTF       0x01
+#define OPpARGELEM_AV           0x02
 #define OPpCONST_NOVER          0x02
 #define OPpCOREARGS_DEREF2      0x02
 #define OPpEVAL_HAS_HH          0x02
@@ -2199,6 +2216,7 @@ END_EXTERN_C
 #define OPpSORT_INTEGER         0x02
 #define OPpTRANS_TO_UTF         0x02
 #define OPpARG2_MASK            0x03
+#define OPpARGELEM_HV           0x04
 #define OPpCONST_SHORTCIRCUIT   0x04
 #define OPpDONT_INIT_GV         0x04
 #define OPpENTERSUB_HASTARG     0x04
@@ -2208,6 +2226,7 @@ END_EXTERN_C
 #define OPpSLICEWARNING         0x04
 #define OPpSORT_REVERSE         0x04
 #define OPpTRANS_IDENTICAL      0x04
+#define OPpARGELEM_MASK         0x06
 #define OPpARG3_MASK            0x07
 #define OPpPADRANGE_COUNTSHIFT  0x07
 #define OPpCONST_STRICT         0x08
@@ -2411,6 +2430,7 @@ EXTCONST I16 PL_op_private_bitfields[] = {
     0, 8, -1,
     0, 8, -1,
     0, 8, -1,
+    1, -1, 0, 507, 1, 26, 2, 276, -1,
     4, -1, 1, 157, 2, 164, 3, 171, -1,
     4, -1, 0, 507, 1, 26, 2, 276, 3, 103, -1,
 
@@ -2609,27 +2629,30 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
      137, /* entersub */
      144, /* leavesub */
      144, /* leavesublv */
-     146, /* caller */
+       0, /* argcheck */
+     146, /* argelem */
+       0, /* argdefelem */
+     148, /* caller */
       48, /* warn */
       48, /* die */
       48, /* reset */
       -1, /* lineseq */
-     148, /* nextstate */
-     148, /* dbstate */
+     150, /* nextstate */
+     150, /* dbstate */
       -1, /* unstack */
       -1, /* enter */
-     149, /* leave */
+     151, /* leave */
       -1, /* scope */
-     151, /* enteriter */
-     155, /* iter */
+     153, /* enteriter */
+     157, /* iter */
       -1, /* enterloop */
-     156, /* leaveloop */
+     158, /* leaveloop */
       -1, /* return */
-     158, /* last */
-     158, /* next */
-     158, /* redo */
-     158, /* dump */
-     158, /* goto */
+     160, /* last */
+     160, /* next */
+     160, /* redo */
+     160, /* dump */
+     160, /* goto */
       48, /* exit */
        0, /* method_named */
        0, /* method_super */
@@ -2641,7 +2664,7 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* leavewhen */
       -1, /* break */
       -1, /* continue */
-     160, /* open */
+     162, /* open */
       48, /* close */
       48, /* pipe_op */
       48, /* fileno */
@@ -2687,33 +2710,33 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* getpeername */
        0, /* lstat */
        0, /* stat */
-     165, /* ftrread */
-     165, /* ftrwrite */
-     165, /* ftrexec */
-     165, /* fteread */
-     165, /* ftewrite */
-     165, /* fteexec */
-     170, /* ftis */
-     170, /* ftsize */
-     170, /* ftmtime */
-     170, /* ftatime */
-     170, /* ftctime */
-     170, /* ftrowned */
-     170, /* fteowned */
-     170, /* ftzero */
-     170, /* ftsock */
-     170, /* ftchr */
-     170, /* ftblk */
-     170, /* ftfile */
-     170, /* ftdir */
-     170, /* ftpipe */
-     170, /* ftsuid */
-     170, /* ftsgid */
-     170, /* ftsvtx */
-     170, /* ftlink */
-     170, /* fttty */
-     170, /* fttext */
-     170, /* ftbinary */
+     167, /* ftrread */
+     167, /* ftrwrite */
+     167, /* ftrexec */
+     167, /* fteread */
+     167, /* ftewrite */
+     167, /* fteexec */
+     172, /* ftis */
+     172, /* ftsize */
+     172, /* ftmtime */
+     172, /* ftatime */
+     172, /* ftctime */
+     172, /* ftrowned */
+     172, /* fteowned */
+     172, /* ftzero */
+     172, /* ftsock */
+     172, /* ftchr */
+     172, /* ftblk */
+     172, /* ftfile */
+     172, /* ftdir */
+     172, /* ftpipe */
+     172, /* ftsuid */
+     172, /* ftsgid */
+     172, /* ftsvtx */
+     172, /* ftlink */
+     172, /* fttty */
+     172, /* fttext */
+     172, /* ftbinary */
       77, /* chdir */
       77, /* chown */
       71, /* chroot */
@@ -2733,17 +2756,17 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* rewinddir */
        0, /* closedir */
       -1, /* fork */
-     174, /* wait */
+     176, /* wait */
       77, /* waitpid */
       77, /* system */
       77, /* exec */
       77, /* kill */
-     174, /* getppid */
+     176, /* getppid */
       77, /* getpgrp */
       77, /* setpgrp */
       77, /* getpriority */
       77, /* setpriority */
-     174, /* time */
+     176, /* time */
       -1, /* tms */
        0, /* localtime */
       48, /* gmtime */
@@ -2763,7 +2786,7 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* require */
        0, /* dofile */
       -1, /* hintseval */
-     175, /* entereval */
+     177, /* entereval */
      144, /* leaveeval */
        0, /* entertry */
       -1, /* leavetry */
@@ -2802,18 +2825,18 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* lock */
        0, /* once */
       -1, /* custom */
-     181, /* coreargs */
-     185, /* avhvswitch */
+     183, /* coreargs */
+     187, /* avhvswitch */
        3, /* runcv */
        0, /* fc */
       -1, /* padcv */
       -1, /* introcv */
       -1, /* clonecv */
-     187, /* padrange */
-     189, /* refassign */
-     195, /* lvref */
-     201, /* lvrefslice */
-     202, /* lvavref */
+     189, /* padrange */
+     191, /* refassign */
+     197, /* lvref */
+     203, /* lvrefslice */
+     204, /* lvavref */
        0, /* anonconst */
 
 };
@@ -2833,19 +2856,19 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
  */
 
 EXTCONST U16  PL_op_private_bitdefs[] = {
-    0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, values, pop, shift, grepstart, grepwhile, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */
+    0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, values, pop, shift, grepstart, grepwhile, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, method, argcheck, argdefelem, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */
     0x2b5c, 0x3d59, /* pushmark */
     0x00bd, /* wantarray, runcv */
     0x03b8, 0x17f0, 0x3e0c, 0x38c8, 0x2f25, /* const */
     0x2b5c, 0x3079, /* gvsv */
     0x1655, /* gv */
     0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, lslice, xor */
-    0x2b5c, 0x3d58, 0x02b7, /* padsv */
+    0x2b5c, 0x3d58, 0x03d7, /* padsv */
     0x2b5c, 0x3d58, 0x2c4c, 0x3a49, /* padav */
     0x2b5c, 0x3d58, 0x0534, 0x05d0, 0x2c4c, 0x3a49, /* padhv */
     0x3819, /* pushre, match, qr, subst */
-    0x2b5c, 0x19d8, 0x02b6, 0x2c4c, 0x2e48, 0x3e04, 0x0003, /* rv2gv */
-    0x2b5c, 0x3078, 0x02b6, 0x3e04, 0x0003, /* rv2sv */
+    0x2b5c, 0x19d8, 0x03d6, 0x2c4c, 0x2e48, 0x3e04, 0x0003, /* rv2gv */
+    0x2b5c, 0x3078, 0x03d6, 0x3e04, 0x0003, /* rv2sv */
     0x2c4c, 0x0003, /* av2arylen, pos, akeys, keys */
     0x2dbc, 0x0e18, 0x0b74, 0x028c, 0x3fc8, 0x3e04, 0x0003, /* rv2cv */
     0x018f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */
@@ -2862,7 +2885,7 @@ EXTCONST U16  PL_op_private_bitdefs[] = {
     0x2c4c, 0x0067, /* vec */
     0x2b5c, 0x3078, 0x2c4c, 0x3a48, 0x3e04, 0x0003, /* rv2av */
     0x025f, /* aelemfast, aelemfast_lex */
-    0x2b5c, 0x2a58, 0x02b6, 0x2c4c, 0x0067, /* aelem, helem */
+    0x2b5c, 0x2a58, 0x03d6, 0x2c4c, 0x0067, /* aelem, helem */
     0x2b5c, 0x2c4c, 0x3a49, /* aslice, hslice */
     0x2c4d, /* kvaslice, kvhslice */
     0x2b5c, 0x3998, 0x0003, /* delete */
@@ -2875,8 +2898,9 @@ EXTCONST U16  PL_op_private_bitdefs[] = {
     0x26cc, 0x0003, /* reverse */
     0x28f8, 0x0003, /* flip, flop */
     0x2b5c, 0x0003, /* cond_expr */
-    0x2b5c, 0x0e18, 0x02b6, 0x028c, 0x3fc8, 0x3e04, 0x2481, /* entersub */
+    0x2b5c, 0x0e18, 0x03d6, 0x028c, 0x3fc8, 0x3e04, 0x2481, /* entersub */
     0x33d8, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
+    0x02aa, 0x0003, /* argelem */
     0x00bc, 0x018f, /* caller */
     0x21f5, /* nextstate, dbstate */
     0x29fc, 0x33d9, /* leave */
@@ -2892,8 +2916,8 @@ EXTCONST U16  PL_op_private_bitdefs[] = {
     0x2d1c, 0x0018, 0x1144, 0x1061, /* coreargs */
     0x2c4c, 0x00c7, /* avhvswitch */
     0x2b5c, 0x01fb, /* padrange */
-    0x2b5c, 0x3d58, 0x03d6, 0x284c, 0x1748, 0x0067, /* refassign */
-    0x2b5c, 0x3d58, 0x03d6, 0x284c, 0x1748, 0x0003, /* lvref */
+    0x2b5c, 0x3d58, 0x04f6, 0x284c, 0x1748, 0x0067, /* refassign */
+    0x2b5c, 0x3d58, 0x04f6, 0x284c, 0x1748, 0x0003, /* lvref */
     0x2b5d, /* lvrefslice */
     0x2b5c, 0x3d58, 0x0003, /* lvavref */
 
@@ -3092,6 +3116,9 @@ EXTCONST U8 PL_op_private_valid[] = {
     /* ENTERSUB   */ (OPpENTERSUB_INARGS|OPpHINT_STRICT_REFS|OPpENTERSUB_HASTARG|OPpENTERSUB_AMPER|OPpDEREF|OPpENTERSUB_DB|OPpLVAL_INTRO),
     /* LEAVESUB   */ (OPpARG1_MASK|OPpREFCOUNTED),
     /* LEAVESUBLV */ (OPpARG1_MASK|OPpREFCOUNTED),
+    /* ARGCHECK   */ (OPpARG1_MASK),
+    /* ARGELEM    */ (OPpARG1_MASK|OPpARGELEM_MASK),
+    /* ARGDEFELEM */ (OPpARG1_MASK),
     /* CALLER     */ (OPpARG4_MASK|OPpOFFBYONE),
     /* WARN       */ (OPpARG4_MASK),
     /* DIE        */ (OPpARG4_MASK),
index 99b19d0b99345db961b8374c2cf1afdb396d9bbf..e04d331a7ca73dcc03790308928aa84ee223aa47 100644 (file)
--- a/opnames.h
+++ b/opnames.h
@@ -202,216 +202,219 @@ typedef enum opcode {
        OP_ENTERSUB      = 185,
        OP_LEAVESUB      = 186,
        OP_LEAVESUBLV    = 187,
-       OP_CALLER        = 188,
-       OP_WARN          = 189,
-       OP_DIE           = 190,
-       OP_RESET         = 191,
-       OP_LINESEQ       = 192,
-       OP_NEXTSTATE     = 193,
-       OP_DBSTATE       = 194,
-       OP_UNSTACK       = 195,
-       OP_ENTER         = 196,
-       OP_LEAVE         = 197,
-       OP_SCOPE         = 198,
-       OP_ENTERITER     = 199,
-       OP_ITER          = 200,
-       OP_ENTERLOOP     = 201,
-       OP_LEAVELOOP     = 202,
-       OP_RETURN        = 203,
-       OP_LAST          = 204,
-       OP_NEXT          = 205,
-       OP_REDO          = 206,
-       OP_DUMP          = 207,
-       OP_GOTO          = 208,
-       OP_EXIT          = 209,
-       OP_METHOD_NAMED  = 210,
-       OP_METHOD_SUPER  = 211,
-       OP_METHOD_REDIR  = 212,
-       OP_METHOD_REDIR_SUPER = 213,
-       OP_ENTERGIVEN    = 214,
-       OP_LEAVEGIVEN    = 215,
-       OP_ENTERWHEN     = 216,
-       OP_LEAVEWHEN     = 217,
-       OP_BREAK         = 218,
-       OP_CONTINUE      = 219,
-       OP_OPEN          = 220,
-       OP_CLOSE         = 221,
-       OP_PIPE_OP       = 222,
-       OP_FILENO        = 223,
-       OP_UMASK         = 224,
-       OP_BINMODE       = 225,
-       OP_TIE           = 226,
-       OP_UNTIE         = 227,
-       OP_TIED          = 228,
-       OP_DBMOPEN       = 229,
-       OP_DBMCLOSE      = 230,
-       OP_SSELECT       = 231,
-       OP_SELECT        = 232,
-       OP_GETC          = 233,
-       OP_READ          = 234,
-       OP_ENTERWRITE    = 235,
-       OP_LEAVEWRITE    = 236,
-       OP_PRTF          = 237,
-       OP_PRINT         = 238,
-       OP_SAY           = 239,
-       OP_SYSOPEN       = 240,
-       OP_SYSSEEK       = 241,
-       OP_SYSREAD       = 242,
-       OP_SYSWRITE      = 243,
-       OP_EOF           = 244,
-       OP_TELL          = 245,
-       OP_SEEK          = 246,
-       OP_TRUNCATE      = 247,
-       OP_FCNTL         = 248,
-       OP_IOCTL         = 249,
-       OP_FLOCK         = 250,
-       OP_SEND          = 251,
-       OP_RECV          = 252,
-       OP_SOCKET        = 253,
-       OP_SOCKPAIR      = 254,
-       OP_BIND          = 255,
-       OP_CONNECT       = 256,
-       OP_LISTEN        = 257,
-       OP_ACCEPT        = 258,
-       OP_SHUTDOWN      = 259,
-       OP_GSOCKOPT      = 260,
-       OP_SSOCKOPT      = 261,
-       OP_GETSOCKNAME   = 262,
-       OP_GETPEERNAME   = 263,
-       OP_LSTAT         = 264,
-       OP_STAT          = 265,
-       OP_FTRREAD       = 266,
-       OP_FTRWRITE      = 267,
-       OP_FTREXEC       = 268,
-       OP_FTEREAD       = 269,
-       OP_FTEWRITE      = 270,
-       OP_FTEEXEC       = 271,
-       OP_FTIS          = 272,
-       OP_FTSIZE        = 273,
-       OP_FTMTIME       = 274,
-       OP_FTATIME       = 275,
-       OP_FTCTIME       = 276,
-       OP_FTROWNED      = 277,
-       OP_FTEOWNED      = 278,
-       OP_FTZERO        = 279,
-       OP_FTSOCK        = 280,
-       OP_FTCHR         = 281,
-       OP_FTBLK         = 282,
-       OP_FTFILE        = 283,
-       OP_FTDIR         = 284,
-       OP_FTPIPE        = 285,
-       OP_FTSUID        = 286,
-       OP_FTSGID        = 287,
-       OP_FTSVTX        = 288,
-       OP_FTLINK        = 289,
-       OP_FTTTY         = 290,
-       OP_FTTEXT        = 291,
-       OP_FTBINARY      = 292,
-       OP_CHDIR         = 293,
-       OP_CHOWN         = 294,
-       OP_CHROOT        = 295,
-       OP_UNLINK        = 296,
-       OP_CHMOD         = 297,
-       OP_UTIME         = 298,
-       OP_RENAME        = 299,
-       OP_LINK          = 300,
-       OP_SYMLINK       = 301,
-       OP_READLINK      = 302,
-       OP_MKDIR         = 303,
-       OP_RMDIR         = 304,
-       OP_OPEN_DIR      = 305,
-       OP_READDIR       = 306,
-       OP_TELLDIR       = 307,
-       OP_SEEKDIR       = 308,
-       OP_REWINDDIR     = 309,
-       OP_CLOSEDIR      = 310,
-       OP_FORK          = 311,
-       OP_WAIT          = 312,
-       OP_WAITPID       = 313,
-       OP_SYSTEM        = 314,
-       OP_EXEC          = 315,
-       OP_KILL          = 316,
-       OP_GETPPID       = 317,
-       OP_GETPGRP       = 318,
-       OP_SETPGRP       = 319,
-       OP_GETPRIORITY   = 320,
-       OP_SETPRIORITY   = 321,
-       OP_TIME          = 322,
-       OP_TMS           = 323,
-       OP_LOCALTIME     = 324,
-       OP_GMTIME        = 325,
-       OP_ALARM         = 326,
-       OP_SLEEP         = 327,
-       OP_SHMGET        = 328,
-       OP_SHMCTL        = 329,
-       OP_SHMREAD       = 330,
-       OP_SHMWRITE      = 331,
-       OP_MSGGET        = 332,
-       OP_MSGCTL        = 333,
-       OP_MSGSND        = 334,
-       OP_MSGRCV        = 335,
-       OP_SEMOP         = 336,
-       OP_SEMGET        = 337,
-       OP_SEMCTL        = 338,
-       OP_REQUIRE       = 339,
-       OP_DOFILE        = 340,
-       OP_HINTSEVAL     = 341,
-       OP_ENTEREVAL     = 342,
-       OP_LEAVEEVAL     = 343,
-       OP_ENTERTRY      = 344,
-       OP_LEAVETRY      = 345,
-       OP_GHBYNAME      = 346,
-       OP_GHBYADDR      = 347,
-       OP_GHOSTENT      = 348,
-       OP_GNBYNAME      = 349,
-       OP_GNBYADDR      = 350,
-       OP_GNETENT       = 351,
-       OP_GPBYNAME      = 352,
-       OP_GPBYNUMBER    = 353,
-       OP_GPROTOENT     = 354,
-       OP_GSBYNAME      = 355,
-       OP_GSBYPORT      = 356,
-       OP_GSERVENT      = 357,
-       OP_SHOSTENT      = 358,
-       OP_SNETENT       = 359,
-       OP_SPROTOENT     = 360,
-       OP_SSERVENT      = 361,
-       OP_EHOSTENT      = 362,
-       OP_ENETENT       = 363,
-       OP_EPROTOENT     = 364,
-       OP_ESERVENT      = 365,
-       OP_GPWNAM        = 366,
-       OP_GPWUID        = 367,
-       OP_GPWENT        = 368,
-       OP_SPWENT        = 369,
-       OP_EPWENT        = 370,
-       OP_GGRNAM        = 371,
-       OP_GGRGID        = 372,
-       OP_GGRENT        = 373,
-       OP_SGRENT        = 374,
-       OP_EGRENT        = 375,
-       OP_GETLOGIN      = 376,
-       OP_SYSCALL       = 377,
-       OP_LOCK          = 378,
-       OP_ONCE          = 379,
-       OP_CUSTOM        = 380,
-       OP_COREARGS      = 381,
-       OP_AVHVSWITCH    = 382,
-       OP_RUNCV         = 383,
-       OP_FC            = 384,
-       OP_PADCV         = 385,
-       OP_INTROCV       = 386,
-       OP_CLONECV       = 387,
-       OP_PADRANGE      = 388,
-       OP_REFASSIGN     = 389,
-       OP_LVREF         = 390,
-       OP_LVREFSLICE    = 391,
-       OP_LVAVREF       = 392,
-       OP_ANONCONST     = 393,
+       OP_ARGCHECK      = 188,
+       OP_ARGELEM       = 189,
+       OP_ARGDEFELEM    = 190,
+       OP_CALLER        = 191,
+       OP_WARN          = 192,
+       OP_DIE           = 193,
+       OP_RESET         = 194,
+       OP_LINESEQ       = 195,
+       OP_NEXTSTATE     = 196,
+       OP_DBSTATE       = 197,
+       OP_UNSTACK       = 198,
+       OP_ENTER         = 199,
+       OP_LEAVE         = 200,
+       OP_SCOPE         = 201,
+       OP_ENTERITER     = 202,
+       OP_ITER          = 203,
+       OP_ENTERLOOP     = 204,
+       OP_LEAVELOOP     = 205,
+       OP_RETURN        = 206,
+       OP_LAST          = 207,
+       OP_NEXT          = 208,
+       OP_REDO          = 209,
+       OP_DUMP          = 210,
+       OP_GOTO          = 211,
+       OP_EXIT          = 212,
+       OP_METHOD_NAMED  = 213,
+       OP_METHOD_SUPER  = 214,
+       OP_METHOD_REDIR  = 215,
+       OP_METHOD_REDIR_SUPER = 216,
+       OP_ENTERGIVEN    = 217,
+       OP_LEAVEGIVEN    = 218,
+       OP_ENTERWHEN     = 219,
+       OP_LEAVEWHEN     = 220,
+       OP_BREAK         = 221,
+       OP_CONTINUE      = 222,
+       OP_OPEN          = 223,
+       OP_CLOSE         = 224,
+       OP_PIPE_OP       = 225,
+       OP_FILENO        = 226,
+       OP_UMASK         = 227,
+       OP_BINMODE       = 228,
+       OP_TIE           = 229,
+       OP_UNTIE         = 230,
+       OP_TIED          = 231,
+       OP_DBMOPEN       = 232,
+       OP_DBMCLOSE      = 233,
+       OP_SSELECT       = 234,
+       OP_SELECT        = 235,
+       OP_GETC          = 236,
+       OP_READ          = 237,
+       OP_ENTERWRITE    = 238,
+       OP_LEAVEWRITE    = 239,
+       OP_PRTF          = 240,
+       OP_PRINT         = 241,
+       OP_SAY           = 242,
+       OP_SYSOPEN       = 243,
+       OP_SYSSEEK       = 244,
+       OP_SYSREAD       = 245,
+       OP_SYSWRITE      = 246,
+       OP_EOF           = 247,
+       OP_TELL          = 248,
+       OP_SEEK          = 249,
+       OP_TRUNCATE      = 250,
+       OP_FCNTL         = 251,
+       OP_IOCTL         = 252,
+       OP_FLOCK         = 253,
+       OP_SEND          = 254,
+       OP_RECV          = 255,
+       OP_SOCKET        = 256,
+       OP_SOCKPAIR      = 257,
+       OP_BIND          = 258,
+       OP_CONNECT       = 259,
+       OP_LISTEN        = 260,
+       OP_ACCEPT        = 261,
+       OP_SHUTDOWN      = 262,
+       OP_GSOCKOPT      = 263,
+       OP_SSOCKOPT      = 264,
+       OP_GETSOCKNAME   = 265,
+       OP_GETPEERNAME   = 266,
+       OP_LSTAT         = 267,
+       OP_STAT          = 268,
+       OP_FTRREAD       = 269,
+       OP_FTRWRITE      = 270,
+       OP_FTREXEC       = 271,
+       OP_FTEREAD       = 272,
+       OP_FTEWRITE      = 273,
+       OP_FTEEXEC       = 274,
+       OP_FTIS          = 275,
+       OP_FTSIZE        = 276,
+       OP_FTMTIME       = 277,
+       OP_FTATIME       = 278,
+       OP_FTCTIME       = 279,
+       OP_FTROWNED      = 280,
+       OP_FTEOWNED      = 281,
+       OP_FTZERO        = 282,
+       OP_FTSOCK        = 283,
+       OP_FTCHR         = 284,
+       OP_FTBLK         = 285,
+       OP_FTFILE        = 286,
+       OP_FTDIR         = 287,
+       OP_FTPIPE        = 288,
+       OP_FTSUID        = 289,
+       OP_FTSGID        = 290,
+       OP_FTSVTX        = 291,
+       OP_FTLINK        = 292,
+       OP_FTTTY         = 293,
+       OP_FTTEXT        = 294,
+       OP_FTBINARY      = 295,
+       OP_CHDIR         = 296,
+       OP_CHOWN         = 297,
+       OP_CHROOT        = 298,
+       OP_UNLINK        = 299,
+       OP_CHMOD         = 300,
+       OP_UTIME         = 301,
+       OP_RENAME        = 302,
+       OP_LINK          = 303,
+       OP_SYMLINK       = 304,
+       OP_READLINK      = 305,
+       OP_MKDIR         = 306,
+       OP_RMDIR         = 307,
+       OP_OPEN_DIR      = 308,
+       OP_READDIR       = 309,
+       OP_TELLDIR       = 310,
+       OP_SEEKDIR       = 311,
+       OP_REWINDDIR     = 312,
+       OP_CLOSEDIR      = 313,
+       OP_FORK          = 314,
+       OP_WAIT          = 315,
+       OP_WAITPID       = 316,
+       OP_SYSTEM        = 317,
+       OP_EXEC          = 318,
+       OP_KILL          = 319,
+       OP_GETPPID       = 320,
+       OP_GETPGRP       = 321,
+       OP_SETPGRP       = 322,
+       OP_GETPRIORITY   = 323,
+       OP_SETPRIORITY   = 324,
+       OP_TIME          = 325,
+       OP_TMS           = 326,
+       OP_LOCALTIME     = 327,
+       OP_GMTIME        = 328,
+       OP_ALARM         = 329,
+       OP_SLEEP         = 330,
+       OP_SHMGET        = 331,
+       OP_SHMCTL        = 332,
+       OP_SHMREAD       = 333,
+       OP_SHMWRITE      = 334,
+       OP_MSGGET        = 335,
+       OP_MSGCTL        = 336,
+       OP_MSGSND        = 337,
+       OP_MSGRCV        = 338,
+       OP_SEMOP         = 339,
+       OP_SEMGET        = 340,
+       OP_SEMCTL        = 341,
+       OP_REQUIRE       = 342,
+       OP_DOFILE        = 343,
+       OP_HINTSEVAL     = 344,
+       OP_ENTEREVAL     = 345,
+       OP_LEAVEEVAL     = 346,
+       OP_ENTERTRY      = 347,
+       OP_LEAVETRY      = 348,
+       OP_GHBYNAME      = 349,
+       OP_GHBYADDR      = 350,
+       OP_GHOSTENT      = 351,
+       OP_GNBYNAME      = 352,
+       OP_GNBYADDR      = 353,
+       OP_GNETENT       = 354,
+       OP_GPBYNAME      = 355,
+       OP_GPBYNUMBER    = 356,
+       OP_GPROTOENT     = 357,
+       OP_GSBYNAME      = 358,
+       OP_GSBYPORT      = 359,
+       OP_GSERVENT      = 360,
+       OP_SHOSTENT      = 361,
+       OP_SNETENT       = 362,
+       OP_SPROTOENT     = 363,
+       OP_SSERVENT      = 364,
+       OP_EHOSTENT      = 365,
+       OP_ENETENT       = 366,
+       OP_EPROTOENT     = 367,
+       OP_ESERVENT      = 368,
+       OP_GPWNAM        = 369,
+       OP_GPWUID        = 370,
+       OP_GPWENT        = 371,
+       OP_SPWENT        = 372,
+       OP_EPWENT        = 373,
+       OP_GGRNAM        = 374,
+       OP_GGRGID        = 375,
+       OP_GGRENT        = 376,
+       OP_SGRENT        = 377,
+       OP_EGRENT        = 378,
+       OP_GETLOGIN      = 379,
+       OP_SYSCALL       = 380,
+       OP_LOCK          = 381,
+       OP_ONCE          = 382,
+       OP_CUSTOM        = 383,
+       OP_COREARGS      = 384,
+       OP_AVHVSWITCH    = 385,
+       OP_RUNCV         = 386,
+       OP_FC            = 387,
+       OP_PADCV         = 388,
+       OP_INTROCV       = 389,
+       OP_CLONECV       = 390,
+       OP_PADRANGE      = 391,
+       OP_REFASSIGN     = 392,
+       OP_LVREF         = 393,
+       OP_LVREFSLICE    = 394,
+       OP_LVAVREF       = 395,
+       OP_ANONCONST     = 396,
        OP_max          
 } opcode;
 
-#define MAXO 394
+#define MAXO 397
 #define OP_FREED MAXO
 
 /* the OP_IS_* macros are optimized to a simple range check because
diff --git a/pad.c b/pad.c
index 9773a25e8d71789cdc93d16da285c589ae7492af..a41d2c7491f87517f06647149862188c9ab58be3 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -898,7 +898,10 @@ S_pad_check_dup(pTHX_ PADNAME *name, U32 flags, const HV *ourstash)
            /* diag_listed_as: "%s" variable %s masks earlier declaration in same %s */
            Perl_warner(aTHX_ packWARN(WARN_MISC),
                "\"%s\" %s %"PNf" masks earlier declaration in same %s",
-               (is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
+               (   is_our                         ? "our"   :
+                    PL_parser->in_my == KEY_my     ? "my"    :
+                    PL_parser->in_my == KEY_sigvar ? "my"    :
+                                                     "state" ),
                *PadnamePV(sv) == '&' ? "subroutine" : "variable",
                PNfARG(sv),
                (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
index 96ab4f5ff57b3465368ff76c8b2769aaa89ec7e7..9c2209459ea4186dfc73370e0427267ae794a92e 100644 (file)
--- a/parser.h
+++ b/parser.h
@@ -56,8 +56,8 @@ typedef struct yy_parser {
     U8         lex_defer;      /* state after determined token */
     U8         lex_dojoin;     /* doing an array interpolation
                                   1 = @{...}  2 = ->@ */
-    U8         lex_expect;     /* UNUSED */
     U8         expect;         /* how to interpret ambiguous tokens */
+    bool       preambled;
     I32                lex_formbrack;  /* bracket count at outer format level */
     OP         *lex_inpat;     /* in pattern $) and $| are special */
     OP         *lex_op;        /* extra info to pass back on op */
@@ -68,12 +68,14 @@ typedef struct yy_parser {
     SV         *lex_stuff;     /* runtime pattern from m// or s/// */
     I32                multi_start;    /* 1st line of multi-line string */
     I32                multi_end;      /* last line of multi-line string */
-    char       multi_open;     /* delimiter of said string */
-    char       multi_close;    /* delimiter of said string */
-    bool       preambled;
+    UV         multi_open;     /* delimiter of said string */
+    UV         multi_close;    /* delimiter of said string */
     bool        lex_re_reparsing; /* we're doing G_RE_REPARSING */
+    U8         lex_super_state;/* lexer state to save */
+    U16                lex_sub_inwhat; /* "lex_inwhat" to use in sublex_push */
     I32                lex_allbrackets;/* (), [], {}, ?: bracket count */
-    SUBLEXINFO sublex_info;
+    OP         *lex_sub_op;    /* current op in y/// or pattern */
+    SV         *lex_sub_repl;  /* repl of s/// used in sublex_push */
     LEXSHARED  *lex_shared;
     SV         *linestr;       /* current chunk of src text */
     char       *bufptr;        /* carries the cursor (current parsing
@@ -96,18 +98,23 @@ typedef struct yy_parser {
     HV         *in_my_stash;   /* declared class of this "my" declaration */
     PerlIO     *rsfp;          /* current source file pointer */
     AV         *rsfp_filters;  /* holds chain of active source filters */
-    U8         form_lex_state; /* remember lex_state when parsing fmt */
 
     YYSTYPE    nextval[5];     /* value of next token, if any */
     I32                nexttype[5];    /* type of next token */
-    U32                nexttoke;
-
+    U8         nexttoke;
+    U8         form_lex_state; /* remember lex_state when parsing fmt */
+    U8         lex_fakeeof;    /* precedence at which to fake EOF */
+    U8         lex_flags;
     COP                *saved_curcop;  /* the previous PL_curcop */
     char       tokenbuf[256];
     line_t     herelines;      /* number of lines in here-doc */
     line_t     preambling;     /* line # when processing $ENV{PERL5DB} */
-    U8         lex_fakeeof;    /* precedence at which to fake EOF */
-    U8         lex_flags;
+
+    /* these are valid while parsing a subroutine signature */
+    IV          sig_elems;      /* number of signature elements seen so far */
+    IV          sig_optelems;   /* number of optional signature elems seen */
+    char        sig_slurpy;     /* the sigil of the slurpy var (or null) */
+
     PERL_BITFIELD16    in_pod:1;      /* lexer is within a =pod section */
     PERL_BITFIELD16    filtered:1;    /* source filters in evalbytes */
     PERL_BITFIELD16    saw_infix_sigil:1; /* saw & or * or % operator */
index 77fad273473409e6137086afa01a9aa521b5928a..04c2fc80607667a4b89ebc88ce9d9b62cf5d3283 100644 (file)
@@ -15,7 +15,7 @@
 
 #define PERL_REVISION  5               /* age */
 #define PERL_VERSION   25              /* epoch */
-#define PERL_SUBVERSION        3               /* generation */
+#define PERL_SUBVERSION        4               /* generation */
 
 /* The following numbers describe the earliest compatible version of
    Perl ("compatibility" here being defined as sufficient binary/API
@@ -36,7 +36,7 @@
 */
 #define PERL_API_REVISION      5
 #define PERL_API_VERSION       25
-#define PERL_API_SUBVERSION    3
+#define PERL_API_SUBVERSION    4
 /*
    XXX Note:  The selection of non-default Configure options, such
    as -Duselonglong may invalidate these settings.  Currently, Configure
diff --git a/perl.c b/perl.c
index 98bfdcfd52db82bf7b3d2ea567a7720ccd1a77e5..1ceed1cd85ce4eb4b0a8e7928fa810e7439ce792 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -420,6 +420,9 @@ perl_construct(pTHXx)
     PL_SB_invlist = _new_invlist_C_array(_Perl_SB_invlist);
     PL_WB_invlist = _new_invlist_C_array(_Perl_WB_invlist);
     PL_LB_invlist = _new_invlist_C_array(_Perl_LB_invlist);
+#ifdef USE_THREAD_SAFE_LOCALE
+    PL_C_locale_obj = newlocale(LC_ALL_MASK, "C", NULL);
+#endif
 
     ENTER;
 }
@@ -618,8 +621,9 @@ perl_destruct(pTHXx)
         PerlIO *stdo = PerlIO_stdout();
         if (*stdo && PerlIO_flush(stdo)) {
             PerlIO_restore_errno(stdo);
-            PerlIO_printf(PerlIO_stderr(), "Unable to flush stdout: %s",
-                          Strerror(errno));
+            if (errno)
+                PerlIO_printf(PerlIO_stderr(), "Unable to flush stdout: %s",
+                    Strerror(errno));
             if (!STATUS_UNIX)
                 STATUS_ALL_FAILURE;
         }
@@ -2835,7 +2839,7 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
        (void)POPMARK;
         old_cxix = cxstack_ix;
        create_eval_scope(NULL, flags|G_FAKINGEVAL);
-       (void)INCMARK;
+       INCMARK;
 
        JMPENV_PUSH(ret);
 
@@ -3221,8 +3225,7 @@ Perl_moreswitches(pTHX_ const char *s)
                   s--;
              }
              PL_rs = newSVpvs("");
-             SvGROW(PL_rs, (STRLEN)(UVCHR_SKIP(rschar) + 1));
-             tmps = (U8*)SvPVX(PL_rs);
+             tmps = (U8*) SvGROW(PL_rs, (STRLEN)(UVCHR_SKIP(rschar) + 1));
              uvchr_to_utf8(tmps, rschar);
              SvCUR_set(PL_rs, UVCHR_SKIP(rschar));
              SvUTF8_on(PL_rs);
diff --git a/perl.h b/perl.h
index 0cd2e2a8bf3582a2c010bdc46741697eece3b02f..9509be2e9b878f2831225fd147b89dbe11a8522b 100644 (file)
--- a/perl.h
+++ b/perl.h
 #   include <locale.h>
 #endif
 
+#ifdef I_XLOCALE
+#   include <xlocale.h>
+#endif
+
 #if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
 #   define USE_LOCALE
 #   define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this
@@ -2018,6 +2022,12 @@ extern long double Perl_my_frexpl(long double x, int *e);
 #   define Perl_isinf(x) isinfq(x)
 #   define Perl_isnan(x) isnanq(x)
 #   define Perl_isfinite(x) !(isnanq(x) || isinfq(x))
+#   define Perl_fp_class(x) ((x) == 0.0Q ? 0 : isinfq(x) ? 3 : isnanq(x) ? 4 : PERL_ABS(x) < FLT128_MIN ? 2 : 1)
+#   define Perl_fp_class_inf(x)    (Perl_fp_class(x) == 3)
+#   define Perl_fp_class_nan(x)    (Perl_fp_class(x) == 4)
+#   define Perl_fp_class_norm(x)   (Perl_fp_class(x) == 1)
+#   define Perl_fp_class_denorm(x) (Perl_fp_class(x) == 2)
+#   define Perl_fp_class_zero(x)   (Perl_fp_class(x) == 0)
 #else
 #   define NV_DIG DBL_DIG
 #   ifdef DBL_MANT_DIG
@@ -3792,6 +3802,14 @@ UNION_ANY_DEFINITION;
 #else
 union any {
     void*      any_ptr;
+    SV*         any_sv;
+    SV**        any_svp;
+    GV*         any_gv;
+    AV*         any_av;
+    HV*         any_hv;
+    OP*         any_op;
+    char*       any_pv;
+    char**      any_pvp;
     I32                any_i32;
     U32                any_u32;
     IV         any_iv;
@@ -3915,14 +3933,6 @@ typedef        struct crypt_data {     /* straight from /usr/include/crypt.h */
 #undef _XPVMG_HEAD
 #undef _XPVCV_COMMON
 
-typedef struct _sublex_info SUBLEXINFO;
-struct _sublex_info {
-    U8 super_state;    /* lexer state to save */
-    U16 sub_inwhat;    /* "lex_inwhat" to use */
-    OP *sub_op;                /* "lex_op" to use */
-    SV *repl;          /* replacement of s/// or y/// */
-};
-
 #include "parser.h"
 
 typedef struct magic_state MGS;        /* struct magic_state defined in mg.c */
@@ -5285,6 +5295,7 @@ EXTCONST char *const PL_phase_names[];
 #endif /* !PERL_CORE */
 
 #define PL_hints PL_compiling.cop_hints
+#define PL_maxo  MAXO
 
 END_EXTERN_C
 
@@ -5320,6 +5331,8 @@ typedef enum {
     /* update exp_name[] in toke.c if adding to this enum */
 } expectation;
 
+#define KEY_sigvar 0xFFFF /* fake keyword representing a signature var */
+
 /* Hints are now stored in a dedicated U32, so the bottom 8 bits are no longer
    special and there is no need for HINT_PRIVATE_MASK for COPs
    However, bitops store HINT_INTEGER in their op_private.
@@ -5966,7 +5979,23 @@ typedef struct am_table_short AMTS;
 /* These locale things are all subject to change */
 
 #   define LOCALE_INIT   MUTEX_INIT(&PL_locale_mutex)
-#   define LOCALE_TERM   MUTEX_DESTROY(&PL_locale_mutex)
+
+#   ifdef USE_THREAD_SAFE_LOCALE
+#       define LOCALE_TERM                                                  \
+                    STMT_START {                                            \
+                        MUTEX_DESTROY(&PL_locale_mutex);                    \
+                        if (PL_C_locale_obj) {                              \
+                            /* Make sure we aren't using the locale         \
+                             * space we are about to free */                \
+                            uselocale(LC_GLOBAL_LOCALE);                    \
+                            freelocale(PL_C_locale_obj);                    \
+                            PL_C_locale_obj = (locale_t) NULL;              \
+                        }                                                   \
+                     } STMT_END
+    }
+#   else
+#       define LOCALE_TERM   MUTEX_DESTROY(&PL_locale_mutex)
+#   endif
 
 #   define LOCALE_LOCK   MUTEX_LOCK(&PL_locale_mutex)
 #   define LOCALE_UNLOCK MUTEX_UNLOCK(&PL_locale_mutex)
@@ -6053,6 +6082,20 @@ typedef struct am_table_short AMTS;
 
 #   endif   /* PERL_CORE or PERL_IN_XSUB_RE */
 
+#if      defined(USE_ITHREADS)              \
+    &&   defined(HAS_NEWLOCALE)             \
+    &&   defined(LC_ALL_MASK)               \
+    &&   defined(HAS_FREELOCALE)            \
+    &&   defined(HAS_USELOCALE)             \
+    && ! defined(NO_THREAD_SAFE_USELOCALE)
+
+    /* The code is written for simplicity to assume that any platform advanced
+     * enough to have the Posix 2008 locale functions has LC_ALL.  The test
+     * above makes sure that assumption is valid */
+
+#   define USE_THREAD_SAFE_LOCALE
+#endif
+
 #else   /* No locale usage */
 #   define LOCALE_INIT
 #   define LOCALE_TERM
@@ -6770,7 +6813,7 @@ extern void moncontrol(int);
 /* The VAX fp formats are neither consistently little-endian nor
  * big-endian, and neither are they really IEEE-mixed endian like
  * the mixed-endian ARM IEEE formats (with swapped bytes).
- * Ultimately, the VAX format ultimately came from the PDP.
+ * Ultimately, the VAX format came from the PDP-11.
  *
  * The ordering of the parts in VAX floats is quite vexing.
  * In the below the fraction_n are the mantissa bits.
@@ -6793,24 +6836,36 @@ extern void moncontrol(int);
  * (somebody at HP should be fired for the URLs)
  *
  * F   fraction_2:16 sign:1 exp:8  fraction_1:7
- *     (exponent bias 128)
+ *     (exponent bias 128, hidden first one-bit)
  *
  * D   fraction_2:16 sign:1 exp:8  fraction_1:7
  *     fraction_4:16               fraction_3:16
- *     (exponent bias 128)
+ *     (exponent bias 128, hidden first one-bit)
  *
  * G   fraction_2:16 sign:1 exp:11 fraction_1:4
  *     fraction_4:16               fraction_3:16
- *     (exponent bias 1024)
+ *     (exponent bias 1024, hidden first one-bit)
  *
  * H   fraction_1:16 sign:1 exp:15
  *     fraction_3:16               fraction_2:16
  *     fraction_5:16               fraction_4:16
  *     fraction_7:16               fraction_6:16
- *     (exponent bias 16384)
+ *     (exponent bias 16384, hidden first one-bit)
+ *     (available only on VAX, and only on Fortran?)
+ *
+ * The formats S, T and X are available on the Alpha (and Itanium,
+ * also known as I64/IA64) and are equivalent with the IEEE-754 formats
+ * binary32, binary64, and binary128 (commonly: float, double, long double).
+ *
+ * S   sign:1 exp:8 mantissa:23
+ *     (exponent bias 127, hidden first one-bit)
+ *
+ * T   sign:1 exp:11 mantissa:52
+ *     (exponent bias 1022, hidden first one-bit)
+ *
+ * X   sign:1 exp:15 mantissa:112
+ *     (exponent bias 16382, hidden first one-bit)
  *
- * The formats T and X are available on the Alpha (and IA64?)
- * and are equivalent with the IEEE 754 64 and 128 bit formats.
  */
 
 #ifdef DOUBLE_IS_VAX_FLOAT
@@ -6819,7 +6874,9 @@ extern void moncontrol(int);
 
 #ifdef DOUBLE_IS_IEEE_FORMAT
 /* All the basic IEEE formats have the implicit bit,
- * except for the 80-bit extended formats, which will undef this. */
+ * except for the x86 80-bit extended formats, which will undef this.
+ * Also note that the IEEE 754 subnormals (formerly known as denormals)
+ * do not have the implicit bit of one. */
 #  define NV_IMPLICIT_BIT
 #endif
 
@@ -6847,6 +6904,7 @@ extern void moncontrol(int);
 #    define LONGDOUBLE_X86_80_BIT
 #    ifdef USE_LONG_DOUBLE
 #      undef NV_IMPLICIT_BIT
+#      define NV_X86_80_BIT
 #    endif
 #  endif
 
@@ -6857,6 +6915,10 @@ extern void moncontrol(int);
 #    define LONGDOUBLE_DOUBLEDOUBLE
 #  endif
 
+#  if LONG_DOUBLEKIND == LONG_DOUBLE_IS_VAX_H_FLOAT
+#    define LONGDOUBLE_VAX_ENDIAN
+#  endif
+
 #endif /* LONG_DOUBLEKIND */
 
 #ifdef USE_QUADMATH /* assume quadmath endianness == native double endianness */
@@ -6890,6 +6952,9 @@ extern void moncontrol(int);
 #  ifdef LONGDOUBLE_MIX_ENDIAN
 #    define NV_MIX_ENDIAN
 #  endif
+#  ifdef LONGDOUBLE_VAX_ENDIAN
+#    define NV_VAX_ENDIAN
+#  endif
 #endif
 
 #ifdef DOUBLE_IS_IEEE_FORMAT
index 7aa445578e8fecca83ef2778af0248d50a62ca8e..960983d090287dcd29bf94643a5f38242f6ecac9 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -99,6 +99,8 @@ END_EXTERN_C
 
 #else  /* !PERL_CORE */
 
+#undef  PL_C_locale_obj
+#define PL_C_locale_obj                (*Perl_GC_locale_obj_ptr(NULL))
 #undef  PL_appctx
 #define PL_appctx              (*Perl_Gappctx_ptr(NULL))
 #undef  PL_check
index d44c67f90112e35ef32c804b4e20f21a0149e6a2..e60f3bb9cac5a63b01a4afbedc23b452f8c0e34f 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -350,11 +350,12 @@ PerlIO_debug(const char *fmt, ...)
 {
     va_list ap;
     dSYS;
-    va_start(ap, fmt);
 
     if (!DEBUG_i_TEST)
         return;
 
+    va_start(ap, fmt);
+
     if (!PL_perlio_debug_fd) {
        if (!TAINTING_get &&
            PerlProc_getuid() == PerlProc_geteuid() &&
index 5466294963d3944e3801d541fb0a36c078ebb8d1..89e2e1eb5249682c9593bbb3221ea21f14a0b2fa 100644 (file)
@@ -101,6 +101,10 @@ PERLVARI(G, mmap_page_size, IV, 0)
 PERLVAR(G, hints_mutex, perl_mutex)    /* Mutex for refcounted he refcounting */
 PERLVAR(G, locale_mutex, perl_mutex)   /* Mutex for setlocale() changing */
 
+#   ifdef HAS_NEWLOCALE
+PERLVAR(G, C_locale_obj, locale_t)
+#   endif
+
 #endif
 
 #ifdef DEBUGGING
index 63515d84c523a75a613d59e654a54f56e05786fe..56285e99aa844f779e34d009f0a73f4283a6533a 100644 (file)
--- a/perly.act
+++ b/perly.act
@@ -5,7 +5,7 @@
  */
 
 case 2:
-#line 115 "perly.y" /* yacc.c:1646  */
+#line 118 "perly.y" /* yacc.c:1646  */
     {
                          parser->expect = XSTATE;
                        }
@@ -13,7 +13,7 @@ case 2:
     break;
 
   case 3:
-#line 119 "perly.y" /* yacc.c:1646  */
+#line 122 "perly.y" /* yacc.c:1646  */
     {
                          newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval)));
                          PL_compiling.cop_seq = 0;
@@ -23,7 +23,7 @@ case 2:
     break;
 
   case 4:
-#line 125 "perly.y" /* yacc.c:1646  */
+#line 128 "perly.y" /* yacc.c:1646  */
     {
                          parser->expect = XTERM;
                        }
@@ -31,7 +31,7 @@ case 2:
     break;
 
   case 5:
-#line 129 "perly.y" /* yacc.c:1646  */
+#line 132 "perly.y" /* yacc.c:1646  */
     {
                          PL_eval_root = (ps[0].val.opval);
                          (yyval.ival) = 0;
@@ -40,7 +40,7 @@ case 2:
     break;
 
   case 6:
-#line 134 "perly.y" /* yacc.c:1646  */
+#line 137 "perly.y" /* yacc.c:1646  */
     {
                          parser->expect = XBLOCK;
                        }
@@ -48,7 +48,7 @@ case 2:
     break;
 
   case 7:
-#line 138 "perly.y" /* yacc.c:1646  */
+#line 141 "perly.y" /* yacc.c:1646  */
     {
                          PL_pad_reset_pending = TRUE;
                          PL_eval_root = (ps[0].val.opval);
@@ -60,7 +60,7 @@ case 2:
     break;
 
   case 8:
-#line 146 "perly.y" /* yacc.c:1646  */
+#line 149 "perly.y" /* yacc.c:1646  */
     {
                          parser->expect = XSTATE;
                        }
@@ -68,7 +68,7 @@ case 2:
     break;
 
   case 9:
-#line 150 "perly.y" /* yacc.c:1646  */
+#line 153 "perly.y" /* yacc.c:1646  */
     {
                          PL_pad_reset_pending = TRUE;
                          PL_eval_root = (ps[0].val.opval);
@@ -80,7 +80,7 @@ case 2:
     break;
 
   case 10:
-#line 158 "perly.y" /* yacc.c:1646  */
+#line 161 "perly.y" /* yacc.c:1646  */
     {
                          parser->expect = XSTATE;
                        }
@@ -88,7 +88,7 @@ case 2:
     break;
 
   case 11:
-#line 162 "perly.y" /* yacc.c:1646  */
+#line 165 "perly.y" /* yacc.c:1646  */
     {
                          PL_pad_reset_pending = TRUE;
                          PL_eval_root = (ps[0].val.opval);
@@ -100,7 +100,7 @@ case 2:
     break;
 
   case 12:
-#line 170 "perly.y" /* yacc.c:1646  */
+#line 173 "perly.y" /* yacc.c:1646  */
     {
                          parser->expect = XSTATE;
                        }
@@ -108,7 +108,7 @@ case 2:
     break;
 
   case 13:
-#line 174 "perly.y" /* yacc.c:1646  */
+#line 177 "perly.y" /* yacc.c:1646  */
     {
                          PL_eval_root = (ps[0].val.opval);
                          (yyval.ival) = 0;
@@ -117,7 +117,7 @@ case 2:
     break;
 
   case 14:
-#line 182 "perly.y" /* yacc.c:1646  */
+#line 185 "perly.y" /* yacc.c:1646  */
     { if (parser->copline > (line_t)(ps[-3].val.ival))
                              parser->copline = (line_t)(ps[-3].val.ival);
                          (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval));
@@ -126,7 +126,7 @@ case 2:
     break;
 
   case 15:
-#line 190 "perly.y" /* yacc.c:1646  */
+#line 193 "perly.y" /* yacc.c:1646  */
     { if (parser->copline > (line_t)(ps[-6].val.ival))
                              parser->copline = (line_t)(ps[-6].val.ival);
                          (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval));
@@ -135,14 +135,14 @@ case 2:
     break;
 
   case 16:
-#line 197 "perly.y" /* yacc.c:1646  */
+#line 200 "perly.y" /* yacc.c:1646  */
     { (yyval.ival) = block_start(TRUE);
                          parser->parsed_sub = 0; }
 
     break;
 
   case 17:
-#line 202 "perly.y" /* yacc.c:1646  */
+#line 205 "perly.y" /* yacc.c:1646  */
     { if (parser->copline > (line_t)(ps[-3].val.ival))
                              parser->copline = (line_t)(ps[-3].val.ival);
                          (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval));
@@ -151,20 +151,20 @@ case 2:
     break;
 
   case 18:
-#line 209 "perly.y" /* yacc.c:1646  */
+#line 212 "perly.y" /* yacc.c:1646  */
     { (yyval.ival) = block_start(FALSE);
                          parser->parsed_sub = 0; }
 
     break;
 
   case 19:
-#line 215 "perly.y" /* yacc.c:1646  */
+#line 218 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
   case 20:
-#line 217 "perly.y" /* yacc.c:1646  */
+#line 220 "perly.y" /* yacc.c:1646  */
     {   (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval));
                            PL_pad_reset_pending = TRUE;
                            if ((ps[-1].val.opval) && (ps[0].val.opval))
@@ -174,13 +174,13 @@ case 2:
     break;
 
   case 21:
-#line 226 "perly.y" /* yacc.c:1646  */
+#line 229 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
   case 22:
-#line 228 "perly.y" /* yacc.c:1646  */
+#line 231 "perly.y" /* yacc.c:1646  */
     {   (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval));
                            PL_pad_reset_pending = TRUE;
                            if ((ps[-1].val.opval) && (ps[0].val.opval))
@@ -190,7 +190,7 @@ case 2:
     break;
 
   case 23:
-#line 237 "perly.y" /* yacc.c:1646  */
+#line 240 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL;
                        }
@@ -198,13 +198,13 @@ case 2:
     break;
 
   case 24:
-#line 241 "perly.y" /* yacc.c:1646  */
+#line 244 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
   case 25:
-#line 245 "perly.y" /* yacc.c:1646  */
+#line 248 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = newSTATEOP(SVf_UTF8 * (ps[-1].val.pval)[strlen((ps[-1].val.pval))+1], (ps[-1].val.pval), (ps[0].val.opval));
                        }
@@ -212,7 +212,7 @@ case 2:
     break;
 
   case 26:
-#line 249 "perly.y" /* yacc.c:1646  */
+#line 252 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = newSTATEOP(SVf_UTF8 * (ps[-1].val.pval)[strlen((ps[-1].val.pval))+1], (ps[-1].val.pval), (ps[0].val.opval));
                        }
@@ -220,13 +220,13 @@ case 2:
     break;
 
   case 27:
-#line 256 "perly.y" /* yacc.c:1646  */
+#line 259 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
   case 28:
-#line 258 "perly.y" /* yacc.c:1646  */
+#line 261 "perly.y" /* yacc.c:1646  */
     {
                          CV *fmtcv = PL_compcv;
                          newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval));
@@ -240,7 +240,7 @@ case 2:
     break;
 
   case 29:
-#line 268 "perly.y" /* yacc.c:1646  */
+#line 271 "perly.y" /* yacc.c:1646  */
     {
                          if ((ps[-1].val.opval)->op_type == OP_CONST) {
                            const char *const name =
@@ -266,7 +266,7 @@ case 2:
     break;
 
   case 30:
-#line 290 "perly.y" /* yacc.c:1646  */
+#line 293 "perly.y" /* yacc.c:1646  */
     {
                          SvREFCNT_inc_simple_void(PL_compcv);
                          (ps[-5].val.opval)->op_type == OP_CONST
@@ -281,7 +281,7 @@ case 2:
     break;
 
   case 31:
-#line 301 "perly.y" /* yacc.c:1646  */
+#line 304 "perly.y" /* yacc.c:1646  */
     {
                          if ((ps[-1].val.opval)->op_type == OP_CONST) {
                            const char *const name =
@@ -307,7 +307,7 @@ case 2:
     break;
 
   case 32:
-#line 323 "perly.y" /* yacc.c:1646  */
+#line 326 "perly.y" /* yacc.c:1646  */
     {
                          OP *body;
                          if (parser->copline > (line_t)(ps[-2].val.ival))
@@ -328,7 +328,7 @@ case 2:
     break;
 
   case 33:
-#line 340 "perly.y" /* yacc.c:1646  */
+#line 343 "perly.y" /* yacc.c:1646  */
     {
                          package((ps[-1].val.opval));
                          if ((ps[-2].val.opval))
@@ -339,13 +339,13 @@ case 2:
     break;
 
   case 34:
-#line 347 "perly.y" /* yacc.c:1646  */
+#line 350 "perly.y" /* yacc.c:1646  */
     { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
 
     break;
 
   case 35:
-#line 349 "perly.y" /* yacc.c:1646  */
+#line 352 "perly.y" /* yacc.c:1646  */
     {
                          SvREFCNT_inc_simple_void(PL_compcv);
                          utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval));
@@ -356,7 +356,7 @@ case 2:
     break;
 
   case 36:
-#line 356 "perly.y" /* yacc.c:1646  */
+#line 359 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = block_end((ps[-4].val.ival),
                              newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval)));
@@ -366,7 +366,7 @@ case 2:
     break;
 
   case 37:
-#line 362 "perly.y" /* yacc.c:1646  */
+#line 365 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = block_end((ps[-4].val.ival),
                               newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval))));
@@ -376,7 +376,7 @@ case 2:
     break;
 
   case 38:
-#line 368 "perly.y" /* yacc.c:1646  */
+#line 371 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0));
                          parser->copline = (line_t)(ps[-5].val.ival);
@@ -385,19 +385,19 @@ case 2:
     break;
 
   case 39:
-#line 373 "perly.y" /* yacc.c:1646  */
+#line 376 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); }
 
     break;
 
   case 40:
-#line 375 "perly.y" /* yacc.c:1646  */
+#line 378 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); }
 
     break;
 
   case 41:
-#line 377 "perly.y" /* yacc.c:1646  */
+#line 380 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = block_end((ps[-5].val.ival),
                                  newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
@@ -408,7 +408,7 @@ case 2:
     break;
 
   case 42:
-#line 384 "perly.y" /* yacc.c:1646  */
+#line 387 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = block_end((ps[-5].val.ival),
                                  newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
@@ -419,19 +419,19 @@ case 2:
     break;
 
   case 43:
-#line 391 "perly.y" /* yacc.c:1646  */
+#line 394 "perly.y" /* yacc.c:1646  */
     { parser->expect = XTERM; }
 
     break;
 
   case 44:
-#line 393 "perly.y" /* yacc.c:1646  */
+#line 396 "perly.y" /* yacc.c:1646  */
     { parser->expect = XTERM; }
 
     break;
 
   case 45:
-#line 396 "perly.y" /* yacc.c:1646  */
+#line 399 "perly.y" /* yacc.c:1646  */
     {
                          OP *initop = (ps[-9].val.opval);
                          OP *forop = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
@@ -450,7 +450,7 @@ case 2:
     break;
 
   case 46:
-#line 411 "perly.y" /* yacc.c:1646  */
+#line 414 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval)));
                          parser->copline = (line_t)(ps[-8].val.ival);
@@ -459,7 +459,7 @@ case 2:
     break;
 
   case 47:
-#line 416 "perly.y" /* yacc.c:1646  */
+#line 419 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0,
                                      op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval)));
@@ -469,13 +469,13 @@ case 2:
     break;
 
   case 48:
-#line 422 "perly.y" /* yacc.c:1646  */
+#line 425 "perly.y" /* yacc.c:1646  */
     { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); }
 
     break;
 
   case 49:
-#line 424 "perly.y" /* yacc.c:1646  */
+#line 427 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = block_end(
                                (ps[-7].val.ival),
@@ -492,7 +492,7 @@ case 2:
     break;
 
   case 50:
-#line 437 "perly.y" /* yacc.c:1646  */
+#line 440 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(
                                0, op_lvalue(newUNOP(OP_REFGEN, 0,
@@ -504,7 +504,7 @@ case 2:
     break;
 
   case 51:
-#line 445 "perly.y" /* yacc.c:1646  */
+#line 448 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = block_end((ps[-4].val.ival),
                                  newFOROP(0, (OP*)NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval)));
@@ -514,7 +514,7 @@ case 2:
     break;
 
   case 52:
-#line 451 "perly.y" /* yacc.c:1646  */
+#line 454 "perly.y" /* yacc.c:1646  */
     {
                          /* a block is a loop that happens once */
                          (yyval.opval) = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
@@ -524,7 +524,7 @@ case 2:
     break;
 
   case 53:
-#line 457 "perly.y" /* yacc.c:1646  */
+#line 460 "perly.y" /* yacc.c:1646  */
     {
                          package((ps[-2].val.opval));
                          if ((ps[-3].val.opval)) {
@@ -535,7 +535,7 @@ case 2:
     break;
 
   case 54:
-#line 464 "perly.y" /* yacc.c:1646  */
+#line 467 "perly.y" /* yacc.c:1646  */
     {
                          /* a block is a loop that happens once */
                          (yyval.opval) = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
@@ -547,7 +547,7 @@ case 2:
     break;
 
   case 55:
-#line 472 "perly.y" /* yacc.c:1646  */
+#line 475 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = (ps[-1].val.opval);
                        }
@@ -555,7 +555,7 @@ case 2:
     break;
 
   case 56:
-#line 476 "perly.y" /* yacc.c:1646  */
+#line 479 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = (OP*)NULL;
                          parser->copline = NOLINE;
@@ -564,7 +564,7 @@ case 2:
     break;
 
   case 57:
-#line 484 "perly.y" /* yacc.c:1646  */
+#line 487 "perly.y" /* yacc.c:1646  */
     { OP *list;
                          if ((ps[0].val.opval)) {
                              OP *term = (ps[0].val.opval);
@@ -583,74 +583,74 @@ case 2:
     break;
 
   case 58:
-#line 501 "perly.y" /* yacc.c:1646  */
+#line 504 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = NULL; }
 
     break;
 
   case 59:
-#line 503 "perly.y" /* yacc.c:1646  */
+#line 506 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_unscope((ps[-1].val.opval)); }
 
     break;
 
   case 60:
-#line 508 "perly.y" /* yacc.c:1646  */
+#line 511 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
   case 61:
-#line 510 "perly.y" /* yacc.c:1646  */
+#line 513 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
   case 62:
-#line 512 "perly.y" /* yacc.c:1646  */
+#line 515 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); }
 
     break;
 
   case 63:
-#line 514 "perly.y" /* yacc.c:1646  */
+#line 517 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); }
 
     break;
 
   case 64:
-#line 516 "perly.y" /* yacc.c:1646  */
+#line 519 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); }
 
     break;
 
   case 65:
-#line 518 "perly.y" /* yacc.c:1646  */
+#line 521 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); }
 
     break;
 
   case 66:
-#line 520 "perly.y" /* yacc.c:1646  */
+#line 523 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newFOROP(0, (OP*)NULL, (ps[0].val.opval), (ps[-2].val.opval), (OP*)NULL);
                          parser->copline = (line_t)(ps[-1].val.ival); }
 
     break;
 
   case 67:
-#line 523 "perly.y" /* yacc.c:1646  */
+#line 526 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); }
 
     break;
 
   case 68:
-#line 528 "perly.y" /* yacc.c:1646  */
+#line 531 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
   case 69:
-#line 530 "perly.y" /* yacc.c:1646  */
+#line 533 "perly.y" /* yacc.c:1646  */
     {
                          ((ps[0].val.opval))->op_flags |= OPf_PARENS;
                          (yyval.opval) = op_scope((ps[0].val.opval));
@@ -659,7 +659,7 @@ case 2:
     break;
 
   case 70:
-#line 535 "perly.y" /* yacc.c:1646  */
+#line 538 "perly.y" /* yacc.c:1646  */
     { parser->copline = (line_t)(ps[-5].val.ival);
                            (yyval.opval) = newCONDOP(0,
                                newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)),
@@ -670,19 +670,19 @@ case 2:
     break;
 
   case 71:
-#line 545 "perly.y" /* yacc.c:1646  */
+#line 548 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
   case 72:
-#line 547 "perly.y" /* yacc.c:1646  */
+#line 550 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_scope((ps[0].val.opval)); }
 
     break;
 
   case 73:
-#line 552 "perly.y" /* yacc.c:1646  */
+#line 555 "perly.y" /* yacc.c:1646  */
     { (yyval.ival) = (PL_min_intro_pending &&
                            PL_max_intro_pending >=  PL_min_intro_pending);
                          intro_my(); }
@@ -690,13 +690,13 @@ case 2:
     break;
 
   case 74:
-#line 558 "perly.y" /* yacc.c:1646  */
+#line 561 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
   case 76:
-#line 564 "perly.y" /* yacc.c:1646  */
+#line 567 "perly.y" /* yacc.c:1646  */
     { YYSTYPE tmplval;
                          (void)scan_num("1", &tmplval);
                          (yyval.opval) = tmplval.opval; }
@@ -704,148 +704,347 @@ case 2:
     break;
 
   case 78:
-#line 572 "perly.y" /* yacc.c:1646  */
+#line 575 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = invert(scalar((ps[0].val.opval))); }
 
     break;
 
   case 79:
-#line 577 "perly.y" /* yacc.c:1646  */
+#line 580 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); intro_my(); }
 
     break;
 
   case 80:
-#line 581 "perly.y" /* yacc.c:1646  */
+#line 584 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); intro_my(); }
 
     break;
 
   case 81:
-#line 584 "perly.y" /* yacc.c:1646  */
+#line 587 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
   case 82:
-#line 585 "perly.y" /* yacc.c:1646  */
+#line 588 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
   case 83:
-#line 589 "perly.y" /* yacc.c:1646  */
+#line 592 "perly.y" /* yacc.c:1646  */
     { (yyval.ival) = start_subparse(FALSE, 0);
                            SAVEFREESV(PL_compcv); }
 
     break;
 
   case 84:
-#line 595 "perly.y" /* yacc.c:1646  */
+#line 598 "perly.y" /* yacc.c:1646  */
     { (yyval.ival) = start_subparse(FALSE, CVf_ANON);
                            SAVEFREESV(PL_compcv); }
 
     break;
 
   case 85:
-#line 600 "perly.y" /* yacc.c:1646  */
+#line 603 "perly.y" /* yacc.c:1646  */
     { (yyval.ival) = start_subparse(TRUE, 0);
                            SAVEFREESV(PL_compcv); }
 
     break;
 
   case 88:
-#line 611 "perly.y" /* yacc.c:1646  */
+#line 614 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
   case 90:
-#line 617 "perly.y" /* yacc.c:1646  */
+#line 620 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
   case 91:
-#line 619 "perly.y" /* yacc.c:1646  */
+#line 622 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
   case 92:
-#line 621 "perly.y" /* yacc.c:1646  */
+#line 624 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
   case 93:
-#line 626 "perly.y" /* yacc.c:1646  */
+#line 629 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
   case 94:
-#line 628 "perly.y" /* yacc.c:1646  */
+#line 631 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
   case 95:
-#line 633 "perly.y" /* yacc.c:1646  */
+#line 642 "perly.y" /* yacc.c:1646  */
+    { parser->in_my = 0; (yyval.opval) = (OP*)NULL; }
+
+    break;
+
+  case 96:
+#line 644 "perly.y" /* yacc.c:1646  */
+    { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); }
+
+    break;
+
+  case 97:
+#line 649 "perly.y" /* yacc.c:1646  */
+    { (yyval.ival) = '@'; }
+
+    break;
+
+  case 98:
+#line 651 "perly.y" /* yacc.c:1646  */
+    { (yyval.ival) = '%'; }
+
+    break;
+
+  case 99:
+#line 655 "perly.y" /* yacc.c:1646  */
     {
-                         /* We shouldn't get here otherwise */
-                         assert(FEATURE_SIGNATURES_IS_ENABLED);
+                            I32 sigil   = (ps[-2].val.ival);
+                            OP *var     = (ps[-1].val.opval);
+                            OP *defexpr = (ps[0].val.opval);
+
+                            if (parser->sig_slurpy)
+                                yyerror("Multiple slurpy parameters not allowed");
+                            parser->sig_slurpy = (char)sigil;
+
+                            if (defexpr)
+                                yyerror("A slurpy parameter may not have "
+                                        "a default value");
+
+                            (yyval.opval) = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
+                        }
+
+    break;
+
+  case 100:
+#line 674 "perly.y" /* yacc.c:1646  */
+    { (yyval.opval) = (OP*)NULL; }
+
+    break;
+
+  case 101:
+#line 676 "perly.y" /* yacc.c:1646  */
+    { (yyval.opval) = newOP(OP_NULL, 0); }
+
+    break;
+
+  case 102:
+#line 678 "perly.y" /* yacc.c:1646  */
+    { (yyval.opval) = (ps[0].val.opval); }
+
+    break;
+
+  case 103:
+#line 684 "perly.y" /* yacc.c:1646  */
+    {
+                            OP *var     = (ps[-1].val.opval);
+                            OP *defexpr = (ps[0].val.opval);
+
+                            if (parser->sig_slurpy)
+                                yyerror("Slurpy parameter not last");
+
+                            parser->sig_elems++;
+
+                            if (defexpr) {
+                                parser->sig_optelems++;
+
+                                if (   defexpr->op_type == OP_NULL
+                                    && !(defexpr->op_flags & OPf_KIDS))
+                                {
+                                    /* handle '$=' special case */
+                                    if (var)
+                                        yyerror("Optional parameter "
+                                                    "lacks default expression");
+                                    op_free(defexpr);
+                                }
+                                else { 
+                                    /* a normal '=default' expression */ 
+                                    OP *defop = (OP*)alloc_LOGOP(OP_ARGDEFELEM,
+                                                        defexpr,
+                                                        LINKLIST(defexpr));
+                                    /* re-purpose op_targ to hold @_ index */
+                                    defop->op_targ =
+                                        (PADOFFSET)(parser->sig_elems - 1);
+
+                                    if (var) {
+                                        var->op_flags |= OPf_STACKED;
+                                        (void)op_sibling_splice(var,
+                                                        NULL, 0, defop);
+                                        scalar(defop);
+                                    }
+                                    else
+                                        var = newUNOP(OP_NULL, 0, defop);
+
+                                    LINKLIST(var);
+                                    /* NB: normally the first child of a
+                                     * logop is executed before the logop,
+                                     * and it pushes a boolean result
+                                     * ready for the logop. For ARGDEFELEM,
+                                     * the op itself does the boolean
+                                     * calculation, so set the first op to
+                                     * it instead.
+                                     */
+                                    var->op_next = defop;
+                                    defexpr->op_next = var;
+                                }
+                            }
+                            else {
+                                if (parser->sig_optelems)
+                                    yyerror("Mandatory parameter "
+                                            "follows optional parameter");
+                            }
+
+                            (yyval.opval) = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
+                        }
+
+    break;
+
+  case 104:
+#line 749 "perly.y" /* yacc.c:1646  */
+    { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); }
+
+    break;
+
+  case 105:
+#line 751 "perly.y" /* yacc.c:1646  */
+    { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); }
+
+    break;
+
+  case 106:
+#line 757 "perly.y" /* yacc.c:1646  */
+    { (yyval.opval) = (ps[-1].val.opval); }
+
+    break;
 
-                         Perl_ck_warner_d(aTHX_
-                               packWARN(WARN_EXPERIMENTAL__SIGNATURES),
-                               "The signatures feature is experimental");
-                         (yyval.opval) = parse_subsignature();
+  case 107:
+#line 759 "perly.y" /* yacc.c:1646  */
+    {
+                         (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval));
                        }
 
     break;
 
-  case 96:
-#line 643 "perly.y" /* yacc.c:1646  */
+  case 108:
+#line 763 "perly.y" /* yacc.c:1646  */
+    { (yyval.opval) = (ps[0].val.opval); }
+
+    break;
+
+  case 109:
+#line 768 "perly.y" /* yacc.c:1646  */
+    { (yyval.opval) = (OP*)NULL; }
+
+    break;
+
+  case 110:
+#line 770 "perly.y" /* yacc.c:1646  */
+    { (yyval.opval) = (ps[0].val.opval); }
+
+    break;
+
+  case 111:
+#line 774 "perly.y" /* yacc.c:1646  */
     {
-                         (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval),
-                               newSTATEOP(0, NULL, sawparens(newNULLLIST())));
-                         parser->expect = XATTRBLOCK;
+                            ENTER;
+                            SAVEIV(parser->sig_elems);
+                            SAVEIV(parser->sig_optelems);
+                            SAVEI8(parser->sig_slurpy);
+                            parser->sig_elems    = 0;
+                            parser->sig_optelems = 0;
+                            parser->sig_slurpy   = 0;
+                            parser->in_my        = KEY_sigvar;
+                        }
+
+    break;
+
+  case 112:
+#line 786 "perly.y" /* yacc.c:1646  */
+    {
+                            OP            *sigops = (ps[-1].val.opval);
+                            UNOP_AUX_item *aux;
+                            OP            *check;
+
+                            assert(FEATURE_SIGNATURES_IS_ENABLED);
+
+                            /* We shouldn't get here otherwise */
+                            Perl_ck_warner_d(aTHX_
+                                packWARN(WARN_EXPERIMENTAL__SIGNATURES),
+                                "The signatures feature is experimental");
+
+                            aux = (UNOP_AUX_item*)PerlMemShared_malloc(
+                                sizeof(UNOP_AUX_item) * 3);
+                            aux[0].iv = parser->sig_elems;
+                            aux[1].iv = parser->sig_optelems;
+                            aux[2].iv = parser->sig_slurpy;
+                            check = newUNOP_AUX(OP_ARGCHECK, 0, NULL, aux);
+                            sigops = op_prepend_elem(OP_LINESEQ, check, sigops);
+                            sigops = op_prepend_elem(OP_LINESEQ,
+                                                newSTATEOP(0, NULL, NULL),
+                                                sigops);
+                            /* a nextstate at the end handles context
+                             * correctly for an empty sub body */
+                            (yyval.opval) = op_append_elem(OP_LINESEQ,
+                                                sigops,
+                                                newSTATEOP(0, NULL, NULL));
+
+                            parser->in_my = 0;
+                            parser->expect = XATTRBLOCK;
+                            LEAVE;
                        }
 
     break;
 
-  case 98:
-#line 652 "perly.y" /* yacc.c:1646  */
+  case 114:
+#line 824 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
-  case 99:
-#line 657 "perly.y" /* yacc.c:1646  */
+  case 115:
+#line 829 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
 
     break;
 
-  case 100:
-#line 659 "perly.y" /* yacc.c:1646  */
+  case 116:
+#line 831 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); }
 
     break;
 
-  case 101:
-#line 661 "perly.y" /* yacc.c:1646  */
+  case 117:
+#line 833 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
 
     break;
 
-  case 103:
-#line 667 "perly.y" /* yacc.c:1646  */
+  case 119:
+#line 839 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[-1].val.opval); }
 
     break;
 
-  case 104:
-#line 669 "perly.y" /* yacc.c:1646  */
+  case 120:
+#line 841 "perly.y" /* yacc.c:1646  */
     {
                          OP* term = (ps[0].val.opval);
                          (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term);
@@ -853,24 +1052,24 @@ case 2:
 
     break;
 
-  case 106:
-#line 678 "perly.y" /* yacc.c:1646  */
+  case 122:
+#line 850 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED,
                                op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) );
                        }
 
     break;
 
-  case 107:
-#line 682 "perly.y" /* yacc.c:1646  */
+  case 123:
+#line 854 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED,
                                op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) );
                        }
 
     break;
 
-  case 108:
-#line 686 "perly.y" /* yacc.c:1646  */
+  case 124:
+#line 858 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST,
                                    op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)),
@@ -879,8 +1078,8 @@ case 2:
 
     break;
 
-  case 109:
-#line 692 "perly.y" /* yacc.c:1646  */
+  case 125:
+#line 864 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST, scalar((ps[-2].val.opval)),
                                    newMETHOP(OP_METHOD, 0, (ps[0].val.opval))));
@@ -888,8 +1087,8 @@ case 2:
 
     break;
 
-  case 110:
-#line 697 "perly.y" /* yacc.c:1646  */
+  case 126:
+#line 869 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST,
                                    op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)),
@@ -898,8 +1097,8 @@ case 2:
 
     break;
 
-  case 111:
-#line 703 "perly.y" /* yacc.c:1646  */
+  case 127:
+#line 875 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST,
                                    op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)),
@@ -908,27 +1107,27 @@ case 2:
 
     break;
 
-  case 112:
-#line 709 "perly.y" /* yacc.c:1646  */
+  case 128:
+#line 881 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); }
 
     break;
 
-  case 113:
-#line 711 "perly.y" /* yacc.c:1646  */
+  case 129:
+#line 883 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); }
 
     break;
 
-  case 114:
-#line 713 "perly.y" /* yacc.c:1646  */
+  case 130:
+#line 885 "perly.y" /* yacc.c:1646  */
     { SvREFCNT_inc_simple_void(PL_compcv);
                          (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, (OP*)NULL, (ps[0].val.opval)); }
 
     break;
 
-  case 115:
-#line 716 "perly.y" /* yacc.c:1646  */
+  case 131:
+#line 888 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                 op_append_elem(OP_LIST,
                                   op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval)));
@@ -936,21 +1135,21 @@ case 2:
 
     break;
 
-  case 118:
-#line 731 "perly.y" /* yacc.c:1646  */
+  case 134:
+#line 903 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); }
 
     break;
 
-  case 119:
-#line 733 "perly.y" /* yacc.c:1646  */
+  case 135:
+#line 905 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval)));
                        }
 
     break;
 
-  case 120:
-#line 736 "perly.y" /* yacc.c:1646  */
+  case 136:
+#line 908 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP(OP_AELEM, 0,
                                        ref(newAVREF((ps[-4].val.opval)),OP_RV2AV),
                                        scalar((ps[-1].val.opval)));
@@ -958,8 +1157,8 @@ case 2:
 
     break;
 
-  case 121:
-#line 741 "perly.y" /* yacc.c:1646  */
+  case 137:
+#line 913 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP(OP_AELEM, 0,
                                        ref(newAVREF((ps[-3].val.opval)),OP_RV2AV),
                                        scalar((ps[-1].val.opval)));
@@ -967,91 +1166,91 @@ case 2:
 
     break;
 
-  case 122:
-#line 746 "perly.y" /* yacc.c:1646  */
+  case 138:
+#line 918 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval)));
                        }
 
     break;
 
-  case 123:
-#line 749 "perly.y" /* yacc.c:1646  */
+  case 139:
+#line 921 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP(OP_HELEM, 0,
                                        ref(newHVREF((ps[-5].val.opval)),OP_RV2HV),
                                        jmaybe((ps[-2].val.opval))); }
 
     break;
 
-  case 124:
-#line 753 "perly.y" /* yacc.c:1646  */
+  case 140:
+#line 925 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP(OP_HELEM, 0,
                                        ref(newHVREF((ps[-4].val.opval)),OP_RV2HV),
                                        jmaybe((ps[-2].val.opval))); }
 
     break;
 
-  case 125:
-#line 757 "perly.y" /* yacc.c:1646  */
+  case 141:
+#line 929 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                   newCVREF(0, scalar((ps[-3].val.opval)))); }
 
     break;
 
-  case 126:
-#line 760 "perly.y" /* yacc.c:1646  */
+  case 142:
+#line 932 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                   op_append_elem(OP_LIST, (ps[-1].val.opval),
                                       newCVREF(0, scalar((ps[-4].val.opval))))); }
 
     break;
 
-  case 127:
-#line 765 "perly.y" /* yacc.c:1646  */
+  case 143:
+#line 937 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                   op_append_elem(OP_LIST, (ps[-1].val.opval),
                                               newCVREF(0, scalar((ps[-3].val.opval))))); }
 
     break;
 
-  case 128:
-#line 769 "perly.y" /* yacc.c:1646  */
+  case 144:
+#line 941 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                   newCVREF(0, scalar((ps[-2].val.opval)))); }
 
     break;
 
-  case 129:
-#line 772 "perly.y" /* yacc.c:1646  */
+  case 145:
+#line 944 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); }
 
     break;
 
-  case 130:
-#line 774 "perly.y" /* yacc.c:1646  */
+  case 146:
+#line 946 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); }
 
     break;
 
-  case 131:
-#line 776 "perly.y" /* yacc.c:1646  */
+  case 147:
+#line 948 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (OP*)NULL); }
 
     break;
 
-  case 132:
-#line 781 "perly.y" /* yacc.c:1646  */
+  case 148:
+#line 953 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); }
 
     break;
 
-  case 133:
-#line 783 "perly.y" /* yacc.c:1646  */
+  case 149:
+#line 955 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
 
     break;
 
-  case 134:
-#line 785 "perly.y" /* yacc.c:1646  */
+  case 150:
+#line 957 "perly.y" /* yacc.c:1646  */
     {   if ((ps[-1].val.ival) != OP_REPEAT)
                                scalar((ps[-2].val.opval));
                            (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval)));
@@ -1059,112 +1258,112 @@ case 2:
 
     break;
 
-  case 135:
-#line 790 "perly.y" /* yacc.c:1646  */
+  case 151:
+#line 962 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
 
     break;
 
-  case 136:
-#line 792 "perly.y" /* yacc.c:1646  */
+  case 152:
+#line 964 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
 
     break;
 
-  case 137:
-#line 794 "perly.y" /* yacc.c:1646  */
+  case 153:
+#line 966 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
 
     break;
 
-  case 138:
-#line 796 "perly.y" /* yacc.c:1646  */
+  case 154:
+#line 968 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
 
     break;
 
-  case 139:
-#line 798 "perly.y" /* yacc.c:1646  */
+  case 155:
+#line 970 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
 
     break;
 
-  case 140:
-#line 800 "perly.y" /* yacc.c:1646  */
+  case 156:
+#line 972 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
 
     break;
 
-  case 141:
-#line 802 "perly.y" /* yacc.c:1646  */
+  case 157:
+#line 974 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
 
     break;
 
-  case 142:
-#line 804 "perly.y" /* yacc.c:1646  */
+  case 158:
+#line 976 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
 
     break;
 
-  case 143:
-#line 806 "perly.y" /* yacc.c:1646  */
+  case 159:
+#line 978 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
 
     break;
 
-  case 144:
-#line 808 "perly.y" /* yacc.c:1646  */
+  case 160:
+#line 980 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
 
     break;
 
-  case 145:
-#line 810 "perly.y" /* yacc.c:1646  */
+  case 161:
+#line 982 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); }
 
     break;
 
-  case 146:
-#line 815 "perly.y" /* yacc.c:1646  */
+  case 162:
+#line 987 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); }
 
     break;
 
-  case 147:
-#line 817 "perly.y" /* yacc.c:1646  */
+  case 163:
+#line 989 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 148:
-#line 820 "perly.y" /* yacc.c:1646  */
+  case 164:
+#line 992 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); }
 
     break;
 
-  case 149:
-#line 822 "perly.y" /* yacc.c:1646  */
+  case 165:
+#line 994 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); }
 
     break;
 
-  case 150:
-#line 824 "perly.y" /* yacc.c:1646  */
+  case 166:
+#line 996 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_POSTINC, 0,
                                        op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); }
 
     break;
 
-  case 151:
-#line 827 "perly.y" /* yacc.c:1646  */
+  case 167:
+#line 999 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_POSTDEC, 0,
                                        op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));}
 
     break;
 
-  case 152:
-#line 830 "perly.y" /* yacc.c:1646  */
+  case 168:
+#line 1002 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_convert_list(OP_JOIN, 0,
                                       op_append_elem(
                                        OP_LIST,
@@ -1178,53 +1377,53 @@ case 2:
 
     break;
 
-  case 153:
-#line 841 "perly.y" /* yacc.c:1646  */
+  case 169:
+#line 1013 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_PREINC, 0,
                                        op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); }
 
     break;
 
-  case 154:
-#line 844 "perly.y" /* yacc.c:1646  */
+  case 170:
+#line 1016 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_PREDEC, 0,
                                        op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); }
 
     break;
 
-  case 155:
-#line 851 "perly.y" /* yacc.c:1646  */
+  case 171:
+#line 1023 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newANONLIST((ps[-1].val.opval)); }
 
     break;
 
-  case 156:
-#line 853 "perly.y" /* yacc.c:1646  */
+  case 172:
+#line 1025 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newANONLIST((OP*)NULL);}
 
     break;
 
-  case 157:
-#line 855 "perly.y" /* yacc.c:1646  */
+  case 173:
+#line 1027 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newANONHASH((ps[-2].val.opval)); }
 
     break;
 
-  case 158:
-#line 857 "perly.y" /* yacc.c:1646  */
+  case 174:
+#line 1029 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newANONHASH((OP*)NULL); }
 
     break;
 
-  case 159:
-#line 859 "perly.y" /* yacc.c:1646  */
+  case 175:
+#line 1031 "perly.y" /* yacc.c:1646  */
     { SvREFCNT_inc_simple_void(PL_compcv);
                          (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); }
 
     break;
 
-  case 160:
-#line 862 "perly.y" /* yacc.c:1646  */
+  case 176:
+#line 1034 "perly.y" /* yacc.c:1646  */
     {
                          OP *body;
                          if (parser->copline > (line_t)(ps[-2].val.ival))
@@ -1237,104 +1436,104 @@ case 2:
 
     break;
 
-  case 161:
-#line 876 "perly.y" /* yacc.c:1646  */
+  case 177:
+#line 1048 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));}
 
     break;
 
-  case 162:
-#line 878 "perly.y" /* yacc.c:1646  */
+  case 178:
+#line 1050 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));}
 
     break;
 
-  case 167:
-#line 886 "perly.y" /* yacc.c:1646  */
+  case 183:
+#line 1058 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); }
 
     break;
 
-  case 168:
-#line 888 "perly.y" /* yacc.c:1646  */
+  case 184:
+#line 1060 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); }
 
     break;
 
-  case 169:
-#line 890 "perly.y" /* yacc.c:1646  */
+  case 185:
+#line 1062 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); }
 
     break;
 
-  case 170:
-#line 892 "perly.y" /* yacc.c:1646  */
+  case 186:
+#line 1064 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 171:
-#line 894 "perly.y" /* yacc.c:1646  */
+  case 187:
+#line 1066 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = localize((ps[0].val.opval),0); }
 
     break;
 
-  case 172:
-#line 896 "perly.y" /* yacc.c:1646  */
+  case 188:
+#line 1068 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = sawparens((ps[-1].val.opval)); }
 
     break;
 
-  case 173:
-#line 898 "perly.y" /* yacc.c:1646  */
+  case 189:
+#line 1070 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 174:
-#line 900 "perly.y" /* yacc.c:1646  */
+  case 190:
+#line 1072 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = sawparens(newNULLLIST()); }
 
     break;
 
-  case 175:
-#line 902 "perly.y" /* yacc.c:1646  */
+  case 191:
+#line 1074 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 176:
-#line 904 "perly.y" /* yacc.c:1646  */
+  case 192:
+#line 1076 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 177:
-#line 906 "perly.y" /* yacc.c:1646  */
+  case 193:
+#line 1078 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 178:
-#line 908 "perly.y" /* yacc.c:1646  */
+  case 194:
+#line 1080 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 179:
-#line 910 "perly.y" /* yacc.c:1646  */
+  case 195:
+#line 1082 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));}
 
     break;
 
-  case 180:
-#line 912 "perly.y" /* yacc.c:1646  */
+  case 196:
+#line 1084 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 181:
-#line 914 "perly.y" /* yacc.c:1646  */
+  case 197:
+#line 1086 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_prepend_elem(OP_ASLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_ASLICE, 0,
@@ -1347,8 +1546,8 @@ case 2:
 
     break;
 
-  case 182:
-#line 924 "perly.y" /* yacc.c:1646  */
+  case 198:
+#line 1096 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_prepend_elem(OP_KVASLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_KVASLICE, 0,
@@ -1361,8 +1560,8 @@ case 2:
 
     break;
 
-  case 183:
-#line 934 "perly.y" /* yacc.c:1646  */
+  case 199:
+#line 1106 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_prepend_elem(OP_HSLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_HSLICE, 0,
@@ -1375,8 +1574,8 @@ case 2:
 
     break;
 
-  case 184:
-#line 944 "perly.y" /* yacc.c:1646  */
+  case 200:
+#line 1116 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_prepend_elem(OP_KVHSLICE,
                                newOP(OP_PUSHMARK, 0),
                                    newLISTOP(OP_KVHSLICE, 0,
@@ -1389,27 +1588,27 @@ case 2:
 
     break;
 
-  case 185:
-#line 954 "perly.y" /* yacc.c:1646  */
+  case 201:
+#line 1126 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 186:
-#line 956 "perly.y" /* yacc.c:1646  */
+  case 202:
+#line 1128 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); }
 
     break;
 
-  case 187:
-#line 958 "perly.y" /* yacc.c:1646  */
+  case 203:
+#line 1130 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval)));
                        }
 
     break;
 
-  case 188:
-#line 961 "perly.y" /* yacc.c:1646  */
+  case 204:
+#line 1133 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
                                op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval))));
@@ -1417,153 +1616,153 @@ case 2:
 
     break;
 
-  case 189:
-#line 966 "perly.y" /* yacc.c:1646  */
+  case 205:
+#line 1138 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
                            op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval))));
                        }
 
     break;
 
-  case 190:
-#line 970 "perly.y" /* yacc.c:1646  */
+  case 206:
+#line 1142 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newSVREF((ps[-3].val.opval)); }
 
     break;
 
-  case 191:
-#line 972 "perly.y" /* yacc.c:1646  */
+  case 207:
+#line 1144 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newAVREF((ps[-3].val.opval)); }
 
     break;
 
-  case 192:
-#line 974 "perly.y" /* yacc.c:1646  */
+  case 208:
+#line 1146 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newHVREF((ps[-3].val.opval)); }
 
     break;
 
-  case 193:
-#line 976 "perly.y" /* yacc.c:1646  */
+  case 209:
+#line 1148 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_ENTERSUB, 0,
                                       scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); }
 
     break;
 
-  case 194:
-#line 979 "perly.y" /* yacc.c:1646  */
+  case 210:
+#line 1151 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); }
 
     break;
 
-  case 195:
-#line 981 "perly.y" /* yacc.c:1646  */
+  case 211:
+#line 1153 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL);
                            PL_hints |= HINT_BLOCK_SCOPE; }
 
     break;
 
-  case 196:
-#line 984 "perly.y" /* yacc.c:1646  */
+  case 212:
+#line 1156 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); }
 
     break;
 
-  case 197:
-#line 986 "perly.y" /* yacc.c:1646  */
+  case 213:
+#line 1158 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); }
 
     break;
 
-  case 198:
-#line 988 "perly.y" /* yacc.c:1646  */
+  case 214:
+#line 1160 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newOP((ps[0].val.ival), 0); }
 
     break;
 
-  case 199:
-#line 990 "perly.y" /* yacc.c:1646  */
+  case 215:
+#line 1162 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); }
 
     break;
 
-  case 200:
-#line 992 "perly.y" /* yacc.c:1646  */
+  case 216:
+#line 1164 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); }
 
     break;
 
-  case 201:
-#line 994 "perly.y" /* yacc.c:1646  */
+  case 217:
+#line 1166 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); }
 
     break;
 
-  case 202:
-#line 996 "perly.y" /* yacc.c:1646  */
+  case 218:
+#line 1168 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); }
 
     break;
 
-  case 203:
-#line 998 "perly.y" /* yacc.c:1646  */
+  case 219:
+#line 1170 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); }
 
     break;
 
-  case 204:
-#line 1000 "perly.y" /* yacc.c:1646  */
+  case 220:
+#line 1172 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
                            op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); }
 
     break;
 
-  case 205:
-#line 1003 "perly.y" /* yacc.c:1646  */
+  case 221:
+#line 1175 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newOP((ps[0].val.ival), 0); }
 
     break;
 
-  case 206:
-#line 1005 "perly.y" /* yacc.c:1646  */
+  case 222:
+#line 1177 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newOP((ps[-2].val.ival), 0);}
 
     break;
 
-  case 207:
-#line 1007 "perly.y" /* yacc.c:1646  */
+  case 223:
+#line 1179 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 208:
-#line 1009 "perly.y" /* yacc.c:1646  */
+  case 224:
+#line 1181 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[-2].val.opval); }
 
     break;
 
-  case 209:
-#line 1011 "perly.y" /* yacc.c:1646  */
+  case 225:
+#line 1183 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); }
 
     break;
 
-  case 210:
-#line 1013 "perly.y" /* yacc.c:1646  */
+  case 226:
+#line 1185 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT)
                           ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0)))
                           : newOP((ps[-2].val.ival), OPf_SPECIAL); }
 
     break;
 
-  case 211:
-#line 1017 "perly.y" /* yacc.c:1646  */
+  case 227:
+#line 1189 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); }
 
     break;
 
-  case 212:
-#line 1019 "perly.y" /* yacc.c:1646  */
+  case 228:
+#line 1191 "perly.y" /* yacc.c:1646  */
     {
                            if (   (ps[0].val.opval)->op_type != OP_TRANS
                                && (ps[0].val.opval)->op_type != OP_TRANSR
@@ -1577,14 +1776,14 @@ case 2:
 
     break;
 
-  case 213:
-#line 1030 "perly.y" /* yacc.c:1646  */
+  case 229:
+#line 1202 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); }
 
     break;
 
-  case 216:
-#line 1034 "perly.y" /* yacc.c:1646  */
+  case 232:
+#line 1206 "perly.y" /* yacc.c:1646  */
     {
                          (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0),
                                newSVOP(OP_CONST, 0, newSVpvs("Unimplemented")));
@@ -1592,180 +1791,180 @@ case 2:
 
     break;
 
-  case 218:
-#line 1043 "perly.y" /* yacc.c:1646  */
+  case 234:
+#line 1215 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); }
 
     break;
 
-  case 219:
-#line 1045 "perly.y" /* yacc.c:1646  */
+  case 235:
+#line 1217 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = localize((ps[0].val.opval),1); }
 
     break;
 
-  case 220:
-#line 1047 "perly.y" /* yacc.c:1646  */
+  case 236:
+#line 1219 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); }
 
     break;
 
-  case 221:
-#line 1052 "perly.y" /* yacc.c:1646  */
+  case 237:
+#line 1224 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = sawparens((ps[-1].val.opval)); }
 
     break;
 
-  case 222:
-#line 1054 "perly.y" /* yacc.c:1646  */
+  case 238:
+#line 1226 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = sawparens(newNULLLIST()); }
 
     break;
 
-  case 223:
-#line 1057 "perly.y" /* yacc.c:1646  */
+  case 239:
+#line 1229 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 224:
-#line 1059 "perly.y" /* yacc.c:1646  */
+  case 240:
+#line 1231 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 225:
-#line 1061 "perly.y" /* yacc.c:1646  */
+  case 241:
+#line 1233 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 226:
-#line 1066 "perly.y" /* yacc.c:1646  */
+  case 242:
+#line 1238 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
-  case 227:
-#line 1068 "perly.y" /* yacc.c:1646  */
+  case 243:
+#line 1240 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 228:
-#line 1072 "perly.y" /* yacc.c:1646  */
+  case 244:
+#line 1244 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
-  case 229:
-#line 1074 "perly.y" /* yacc.c:1646  */
+  case 245:
+#line 1246 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 230:
-#line 1078 "perly.y" /* yacc.c:1646  */
+  case 246:
+#line 1250 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (OP*)NULL; }
 
     break;
 
-  case 231:
-#line 1080 "perly.y" /* yacc.c:1646  */
+  case 247:
+#line 1252 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
 
-  case 232:
-#line 1086 "perly.y" /* yacc.c:1646  */
+  case 248:
+#line 1258 "perly.y" /* yacc.c:1646  */
     { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); }
 
     break;
 
-  case 240:
-#line 1103 "perly.y" /* yacc.c:1646  */
+  case 256:
+#line 1275 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); }
 
     break;
 
-  case 241:
-#line 1107 "perly.y" /* yacc.c:1646  */
+  case 257:
+#line 1279 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newSVREF((ps[0].val.opval)); }
 
     break;
 
-  case 242:
-#line 1111 "perly.y" /* yacc.c:1646  */
+  case 258:
+#line 1283 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newAVREF((ps[0].val.opval));
                          if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival);
                        }
 
     break;
 
-  case 243:
-#line 1117 "perly.y" /* yacc.c:1646  */
+  case 259:
+#line 1289 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newHVREF((ps[0].val.opval));
                          if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival);
                        }
 
     break;
 
-  case 244:
-#line 1123 "perly.y" /* yacc.c:1646  */
+  case 260:
+#line 1295 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newAVREF((ps[0].val.opval)); }
 
     break;
 
-  case 245:
-#line 1125 "perly.y" /* yacc.c:1646  */
+  case 261:
+#line 1297 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newAVREF((ps[-3].val.opval)); }
 
     break;
 
-  case 246:
-#line 1129 "perly.y" /* yacc.c:1646  */
+  case 262:
+#line 1301 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); }
 
     break;
 
-  case 248:
-#line 1134 "perly.y" /* yacc.c:1646  */
+  case 264:
+#line 1306 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newAVREF((ps[-2].val.opval)); }
 
     break;
 
-  case 250:
-#line 1139 "perly.y" /* yacc.c:1646  */
+  case 266:
+#line 1311 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newHVREF((ps[-2].val.opval)); }
 
     break;
 
-  case 252:
-#line 1144 "perly.y" /* yacc.c:1646  */
+  case 268:
+#line 1316 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); }
 
     break;
 
-  case 253:
-#line 1149 "perly.y" /* yacc.c:1646  */
+  case 269:
+#line 1321 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = scalar((ps[0].val.opval)); }
 
     break;
 
-  case 254:
-#line 1151 "perly.y" /* yacc.c:1646  */
+  case 270:
+#line 1323 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = scalar((ps[0].val.opval)); }
 
     break;
 
-  case 255:
-#line 1153 "perly.y" /* yacc.c:1646  */
+  case 271:
+#line 1325 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = op_scope((ps[0].val.opval)); }
 
     break;
 
-  case 256:
-#line 1156 "perly.y" /* yacc.c:1646  */
+  case 272:
+#line 1328 "perly.y" /* yacc.c:1646  */
     { (yyval.opval) = (ps[0].val.opval); }
 
     break;
@@ -1776,6 +1975,6 @@ case 2:
     
 
 /* Generated from:
- * fba24dfc68a3a84c9ae95cb9e14cc156ac487e6f3228cdf84c166d3cd820e59a perly.y
+ * 1a8fc0f841dee6e563463a6b91bf9c410b47437c760f485a16d87ade3d66bf1d perly.y
  * 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl
  * ex: set ro: */
diff --git a/perly.c b/perly.c
index 5aed62858c1d0b5b124e33189e561421d02d8b90..e8a9506433e55d40ea8f4c29e5b32a63552bedaa 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -25,6 +25,7 @@
 #define PERL_IN_PERLY_C
 #include "perl.h"
 #include "feature.h"
+#include "keywords.h"
 
 typedef unsigned char yytype_uint8;
 typedef signed char yytype_int8;
@@ -246,6 +247,7 @@ S_clear_yystack(pTHX_  const yy_parser *parser)
 int
 Perl_yyparse (pTHX_ int gramtype)
 {
+    dVAR;
     int yystate;
     int yyn;
     int yyresult;
diff --git a/perly.h b/perly.h
index 9184774a21fe4c6313ed42dadd6f189f397929bc..b6d3a3d28c38f4c8c9eb63e35e75e762ff0c8882 100644 (file)
--- a/perly.h
+++ b/perly.h
@@ -181,6 +181,6 @@ int yyparse (void);
 
 
 /* Generated from:
- * fba24dfc68a3a84c9ae95cb9e14cc156ac487e6f3228cdf84c166d3cd820e59a perly.y
+ * 1a8fc0f841dee6e563463a6b91bf9c410b47437c760f485a16d87ade3d66bf1d perly.y
  * 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl
  * ex: set ro: */
index a8fe5b53b66e985d6a2d472d9cbf7acfb9d727f7..ed00142a0673f419e4c273362d9d9fe48ed006f2 100644 (file)
--- a/perly.tab
+++ b/perly.tab
@@ -6,16 +6,16 @@
 
 #define YYFINAL  14
 /* YYLAST -- Last index in YYTABLE.  */
-#define YYLAST   3111
+#define YYLAST   3085
 
 /* YYNTOKENS -- Number of terminals.  */
 #define YYNTOKENS  105
 /* YYNNTS -- Number of nonterminals.  */
-#define YYNNTS  78
+#define YYNNTS  86
 /* YYNRULES -- Number of rules.  */
-#define YYNRULES  256
+#define YYNRULES  272
 /* YYNSTATES -- Number of states.  */
-#define YYNSTATES  521
+#define YYNSTATES  539
 
 /* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned
    by yylex, with out-of-bounds checking.  */
@@ -69,32 +69,34 @@ static const yytype_uint8 yytranslate[] =
   /* YYRLINE[YYN] -- Source line where rule number YYN was defined.  */
 static const yytype_uint16 yyrline[] =
 {
-       0,   115,   115,   114,   125,   124,   134,   133,   146,   145,
-     158,   157,   170,   169,   181,   189,   197,   201,   209,   215,
-     216,   226,   227,   236,   240,   244,   248,   255,   257,   268,
-     267,   301,   300,   339,   347,   346,   355,   361,   367,   372,
-     374,   376,   383,   391,   393,   390,   410,   415,   422,   421,
-     436,   444,   450,   457,   456,   471,   475,   483,   501,   502,
-     507,   509,   511,   513,   515,   517,   519,   522,   528,   529,
-     534,   545,   546,   552,   558,   559,   564,   567,   571,   576,
-     580,   584,   585,   589,   595,   600,   605,   606,   611,   612,
-     617,   618,   620,   625,   627,   633,   632,   651,   652,   656,
-     658,   660,   662,   666,   668,   673,   677,   681,   685,   691,
-     696,   702,   708,   710,   713,   712,   723,   724,   728,   732,
-     735,   740,   745,   748,   752,   756,   759,   764,   768,   771,
-     773,   775,   780,   782,   784,   789,   791,   793,   795,   797,
-     799,   801,   803,   805,   807,   809,   814,   816,   819,   821,
-     823,   826,   829,   840,   843,   850,   852,   854,   856,   858,
-     861,   875,   877,   881,   882,   883,   884,   885,   887,   889,
-     891,   893,   895,   897,   899,   901,   903,   905,   907,   909,
-     911,   913,   923,   933,   943,   953,   955,   957,   960,   965,
-     969,   971,   973,   975,   978,   980,   983,   985,   987,   989,
-     991,   993,   995,   997,   999,  1002,  1004,  1006,  1008,  1010,
-    1012,  1016,  1019,  1018,  1031,  1032,  1033,  1038,  1042,  1044,
-    1046,  1051,  1053,  1056,  1058,  1060,  1065,  1067,  1072,  1073,
-    1078,  1079,  1085,  1089,  1090,  1091,  1094,  1095,  1098,  1099,
-    1102,  1106,  1110,  1116,  1122,  1124,  1128,  1132,  1133,  1137,
-    1138,  1142,  1143,  1148,  1150,  1152,  1155
+       0,   118,   118,   117,   128,   127,   137,   136,   149,   148,
+     161,   160,   173,   172,   184,   192,   200,   204,   212,   218,
+     219,   229,   230,   239,   243,   247,   251,   258,   260,   271,
+     270,   304,   303,   342,   350,   349,   358,   364,   370,   375,
+     377,   379,   386,   394,   396,   393,   413,   418,   425,   424,
+     439,   447,   453,   460,   459,   474,   478,   486,   504,   505,
+     510,   512,   514,   516,   518,   520,   522,   525,   531,   532,
+     537,   548,   549,   555,   561,   562,   567,   570,   574,   579,
+     583,   587,   588,   592,   598,   603,   608,   609,   614,   615,
+     620,   621,   623,   628,   630,   642,   643,   648,   650,   654,
+     674,   675,   677,   683,   748,   750,   756,   758,   762,   768,
+     769,   774,   773,   823,   824,   828,   830,   832,   834,   838,
+     840,   845,   849,   853,   857,   863,   868,   874,   880,   882,
+     885,   884,   895,   896,   900,   904,   907,   912,   917,   920,
+     924,   928,   931,   936,   940,   943,   945,   947,   952,   954,
+     956,   961,   963,   965,   967,   969,   971,   973,   975,   977,
+     979,   981,   986,   988,   991,   993,   995,   998,  1001,  1012,
+    1015,  1022,  1024,  1026,  1028,  1030,  1033,  1047,  1049,  1053,
+    1054,  1055,  1056,  1057,  1059,  1061,  1063,  1065,  1067,  1069,
+    1071,  1073,  1075,  1077,  1079,  1081,  1083,  1085,  1095,  1105,
+    1115,  1125,  1127,  1129,  1132,  1137,  1141,  1143,  1145,  1147,
+    1150,  1152,  1155,  1157,  1159,  1161,  1163,  1165,  1167,  1169,
+    1171,  1174,  1176,  1178,  1180,  1182,  1184,  1188,  1191,  1190,
+    1203,  1204,  1205,  1210,  1214,  1216,  1218,  1223,  1225,  1228,
+    1230,  1232,  1237,  1239,  1244,  1245,  1250,  1251,  1257,  1261,
+    1262,  1263,  1266,  1267,  1270,  1271,  1274,  1278,  1282,  1288,
+    1294,  1296,  1300,  1304,  1305,  1309,  1310,  1314,  1315,  1320,
+    1322,  1324,  1327
 };
 #endif
 
@@ -124,12 +126,14 @@ static const char *const yytname[] =
   "$@13", "formline", "formarg", "sideff", "else", "cont", "mintro",
   "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", "startsub",
   "startanonsub", "startformsub", "subname", "proto", "subattrlist",
-  "myattrlist", "subsignature", "@14", "optsubbody", "expr", "listexpr",
-  "listop", "@15", "method", "subscripted", "termbinop", "termunop",
-  "anonymous", "termdo", "term", "@16", "myattrterm", "myterm",
-  "optlistexpr", "optexpr", "optrepl", "my_scalar", "my_var",
-  "refgen_topic", "my_refgen", "amper", "scalar", "ary", "hsh", "arylen",
-  "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR
+  "myattrlist", "sigvarname", "sigslurpsigil", "sigslurpelem",
+  "sigdefault", "sigscalarelem", "sigelem", "siglist", "siglistornull",
+  "subsignature", "$@14", "optsubbody", "expr", "listexpr", "listop",
+  "@15", "method", "subscripted", "termbinop", "termunop", "anonymous",
+  "termdo", "term", "@16", "myattrterm", "myterm", "optlistexpr",
+  "optexpr", "optrepl", "my_scalar", "my_var", "refgen_topic", "my_refgen",
+  "amper", "scalar", "ary", "hsh", "arylen", "star", "sliceme", "kvslice",
+  "gelem", "indirob", YY_NULLPTR
 };
 #endif
 
@@ -152,73 +156,74 @@ static const yytype_uint16 yytoknum[] =
 };
 # endif
 
-#define YYPACT_NINF -412
+#define YYPACT_NINF -440
 
 #define yypact_value_is_default(Yystate) \
-  (!!((Yystate) == (-412)))
+  (!!((Yystate) == (-440)))
 
-#define YYTABLE_NINF -252
+#define YYTABLE_NINF -268
 
 #define yytable_value_is_error(Yytable_value) \
-  (!!((Yytable_value) == (-252)))
+  (!!((Yytable_value) == (-268)))
 
   /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
      STATE-NUM.  */
 static const yytype_int16 yypact[] =
 {
-     903,  -412,  -412,  -412,  -412,  -412,  -412,     8,  -412,  2810,
-      16,  1502,  1407,  -412,  -412,  -412,  1973,  2810,  2810,    31,
-      31,    31,  -412,    31,    31,  -412,  -412,    46,   -66,  -412,
-    2810,  -412,  -412,  -412,  2810,  -412,   -54,   -20,   -19,  1880,
-    1785,    31,  1880,  2066,    35,  2810,    62,  2810,  2810,  2810,
-    2810,  2810,  2810,  2810,  2159,    31,    31,   341,   -13,  -412,
-       7,  -412,  -412,  -412,  -412,  2971,  -412,  -412,    -2,    73,
-      79,    82,  -412,    76,   123,   180,    92,  -412,  -412,  -412,
-    -412,  -412,    35,    90,  -412,    18,    28,    36,    47,   167,
-      88,   104,    16,  -412,    78,  -412,   102,  1971,  1407,  -412,
-    -412,  -412,   647,   742,  -412,    77,   731,   731,  -412,  -412,
-    -412,  -412,  -412,  -412,  -412,  2810,   117,   118,  2810,   122,
-     367,    16,    -4,  2971,   126,  2252,  1785,  -412,   367,   545,
-     -13,  -412,   438,  2810,  -412,  -412,   367,   212,   100,  -412,
-    -412,  2810,   367,  2903,  2345,   157,  -412,  -412,  -412,   367,
-     -13,   731,   731,   731,    71,    71,   219,   221,  -412,  -412,
-    2810,  2810,  2810,  2810,  2810,  2810,  2438,  2810,  2810,  2810,
-    2810,  2810,  2810,  2810,  2810,  2810,  2810,  2810,  2810,  2810,
-    2810,  2810,  -412,  -412,  -412,   245,  2531,  2810,  2810,  2810,
-    2810,  2810,  2810,  2810,  -412,   209,  -412,   213,  -412,  -412,
-    -412,  -412,  -412,   144,    55,  -412,  -412,   139,  -412,  -412,
-    -412,    16,  -412,  -412,  2810,  2810,  2810,  2810,  2810,  2810,
-    -412,  -412,  -412,  -412,  -412,  2810,  2810,    97,  -412,  -412,
-    -412,   141,   173,  -412,  -412,   256,   145,  2810,   -13,  -412,
-     242,  -412,  2624,   731,   157,    52,    57,    58,  -412,   312,
-     230,  -412,  2810,   244,   193,   193,  -412,  2971,   201,   103,
-    -412,   346,  1584,   483,  1768,   724,   502,  2971,  2929,   468,
-     468,  1675,   408,  1863,   630,   731,   731,  2810,  2810,   170,
-     177,   184,  -412,   186,  2717,    11,   187,   225,  -412,  -412,
-     473,   218,   119,   259,   125,   279,   132,   309,   837,  -412,
-     252,   235,     2,   288,  2810,  2810,  2810,  2810,  -412,   207,
-    -412,  -412,   236,  -412,  -412,  -412,  -412,  1596,    23,  -412,
-    2810,  2810,  -412,   341,  -412,   341,   341,   341,   341,   341,
-     222,   -30,  -412,  2810,  -412,   173,   323,    16,  -412,  -412,
-     534,  -412,    30,   540,  -412,  -412,  -412,   190,  2810,   340,
-    -412,  -412,  2810,   329,   208,  -412,  -412,  -412,  -412,  -412,
-     632,  -412,  -412,  2810,  -412,   352,  -412,   354,  -412,   380,
-    -412,   387,  -412,  -412,  -412,   328,  -412,  -412,  -412,   336,
-     301,   341,   302,   306,   341,   307,   308,  -412,  -412,  -412,
-    -412,   310,   325,   264,  -412,  2810,   334,   335,  -412,  2810,
-     338,  -412,   343,   426,  -412,  -412,  -412,    42,  -412,   211,
-    -412,  3013,   429,  -412,  -412,   344,  -412,  -412,  -412,  -412,
-     355,   173,   141,  -412,  2810,  -412,  -412,   435,   435,  2810,
-    2810,   435,  -412,   360,   356,   435,   435,   341,  -412,  -412,
-    -412,  -412,  -412,  -412,   390,     5,   173,  -412,   370,   435,
-     435,  -412,    32,    32,   373,   374,    78,  2810,  2810,   435,
-    -412,  -412,   932,  -412,  -412,  -412,  -412,   466,  1027,  -412,
-      78,    78,  -412,   435,   376,  -412,  -412,   435,   435,  -412,
-     382,   388,    78,  -412,    29,  -412,  -412,  -412,  -412,  1122,
-    -412,  2810,    78,    78,  -412,   435,  -412,   411,   471,  -412,
-    1217,  -412,   392,  -412,  -412,  -412,    78,  -412,  -412,  -412,
-    -412,   435,  1690,  -412,  1312,    32,   402,  -412,  -412,   435,
-    -412
+     824,  -440,  -440,  -440,  -440,  -440,  -440,    21,  -440,  2826,
+      44,  1518,  1423,  -440,  -440,  -440,  1989,  2826,  2826,    60,
+      60,    60,  -440,    60,    60,  -440,  -440,     8,   -68,  -440,
+    2826,  -440,  -440,  -440,  2826,  -440,   -46,   -29,   -18,  1896,
+    1801,    60,  1896,  2082,    16,  2826,   137,  2826,  2826,  2826,
+    2826,  2826,  2826,  2826,  2175,    60,    60,   170,    36,  -440,
+       7,  -440,  -440,  -440,  -440,  2945,  -440,  -440,    17,   126,
+     209,   221,  -440,    89,   239,   266,   113,  -440,  -440,  -440,
+    -440,  -440,    16,   106,  -440,    29,    32,    57,    61,   149,
+      66,    70,    44,  -440,   102,  -440,   116,   325,  1423,  -440,
+    -440,  -440,   663,   758,  -440,   195,   442,   442,  -440,  -440,
+    -440,  -440,  -440,  -440,  -440,  2826,    73,   122,  2826,   127,
+     318,    44,    -8,  2945,   142,  2268,  1801,  -440,   318,   561,
+      36,  -440,   485,  2826,  -440,  -440,   318,   215,    90,  -440,
+    -440,  2826,   318,  2919,  2361,   186,  -440,  -440,  -440,   318,
+      36,   442,   442,   442,   535,   535,   252,   256,  -440,  -440,
+    2826,  2826,  2826,  2826,  2826,  2826,  2454,  2826,  2826,  2826,
+    2826,  2826,  2826,  2826,  2826,  2826,  2826,  2826,  2826,  2826,
+    2826,  2826,  -440,  -440,  -440,    72,  2547,  2826,  2826,  2826,
+    2826,  2826,  2826,  2826,  -440,   244,  -440,   260,  -440,  -440,
+    -440,  -440,  -440,   190,    23,  -440,  -440,   184,  -440,  -440,
+    -440,    44,  -440,  -440,  2826,  2826,  2826,  2826,  2826,  2826,
+    -440,  -440,  -440,  -440,  -440,  2826,  2826,   217,  -440,  -440,
+    -440,   194,   227,  -440,  -440,   295,   187,  2826,    36,  -440,
+     296,  -440,  2640,   442,   186,    47,    52,    75,  -440,   309,
+     284,  -440,  2826,   301,   251,   251,  -440,  2945,   160,   230,
+    -440,   455,  1600,   518,  1879,   498,   646,  2945,   369,  1692,
+    1692,   419,  1786,  1972,   531,   442,   442,  2826,  2826,   224,
+     229,   231,  -440,   232,  2733,    48,   243,   274,  -440,  -440,
+     475,   192,   235,   370,   246,   399,   250,   408,   853,  -440,
+     338,   290,    -2,   355,  2826,  2826,  2826,  2826,  -440,   299,
+    -440,  -440,   297,  -440,  -440,  -440,  -440,  1612,    31,  -440,
+    2826,  2826,  -440,   170,  -440,   170,   170,   170,   170,   170,
+     303,    19,  -440,  2826,  -440,   227,   380,    44,  -440,  -440,
+     576,  -440,    98,   648,  -440,  -440,  -440,   264,  2826,   402,
+    -440,  -440,  2826,   418,   270,  -440,  -440,  -440,  -440,  -440,
+     661,  -440,  -440,  2826,  -440,   409,  -440,   412,  -440,   415,
+    -440,   416,  -440,  -440,  -440,   386,  -440,  -440,  -440,   411,
+     333,   170,   336,   337,   170,   339,   341,  -440,  -440,  -440,
+    -440,   340,   345,   312,  -440,  2826,   358,   359,  -440,  2826,
+     363,  -440,   112,   459,  -440,  -440,  -440,   107,  -440,   275,
+    -440,  2987,   465,  -440,  -440,   377,  -440,  -440,  -440,  -440,
+     368,   227,   194,  -440,  2826,  -440,  -440,   477,   477,  2826,
+    2826,   477,  -440,   384,   389,   477,   477,   170,  -440,  -440,
+    -440,   464,   464,  -440,  -440,  -440,   413,   396,  -440,  -440,
+    -440,  -440,   427,     5,   227,  -440,   398,   477,   477,  -440,
+     134,   134,   414,   421,   102,  2826,  2826,   477,  -440,  -440,
+    -440,   423,   423,   112,  -440,   948,  -440,  -440,  -440,  -440,
+     499,  1043,  -440,   102,   102,  -440,   477,   407,  -440,  -440,
+     477,   477,  -440,   422,   433,   102,  2826,  -440,  -440,  -440,
+    -440,     3,  -440,  -440,  -440,  -440,  1138,  -440,  2826,   102,
+     102,  -440,   477,  -440,  2945,   452,   493,  -440,  1233,  -440,
+     436,  -440,  -440,  -440,   102,  -440,  -440,  -440,  -440,   477,
+    1706,  -440,  1328,   134,   448,  -440,  -440,   477,  -440
 };
 
   /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM.
@@ -226,85 +231,88 @@ static const yytype_int16 yypact[] =
      means the default is an error.  */
 static const yytype_uint16 yydefact[] =
 {
-       0,     2,     4,     6,     8,    10,    12,     0,    16,   228,
+       0,     2,     4,     6,     8,    10,    12,     0,    16,   244,
        0,     0,     0,    19,     1,    19,     0,     0,     0,     0,
-       0,     0,   214,     0,     0,   185,   212,   173,   207,   209,
-     203,    84,   217,    84,   195,   216,   205,     0,     0,   198,
-     226,     0,     0,     0,     0,     0,     0,   201,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,   229,   102,   215,
-     180,   163,   164,   165,   166,   105,   170,     5,   186,   175,
-     178,   177,   179,   176,     0,     0,     0,    16,     7,    60,
+       0,     0,   230,     0,     0,   201,   228,   189,   223,   225,
+     219,    84,   233,    84,   211,   232,   221,     0,     0,   214,
+     242,     0,     0,     0,     0,     0,     0,   217,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,   245,   118,   231,
+     196,   179,   180,   181,   182,   121,   186,     5,   202,   191,
+     194,   193,   195,   192,     0,     0,     0,    16,     7,    60,
       27,    85,     0,     0,    83,     0,     0,     0,     0,     0,
        0,     0,     0,    56,    71,     9,     0,    61,     0,    11,
-      24,    23,     0,     0,   156,     0,   146,   147,   253,   256,
-     255,   254,   242,   243,   240,   226,     0,     0,     0,     0,
-     204,     0,    88,   196,     0,     0,   228,   199,   200,   253,
-     227,   112,   254,     0,   244,   162,   161,     0,     0,    86,
-      87,   226,   171,     0,     0,   219,   223,   225,   224,   202,
-     197,   148,   149,   168,   153,   154,   174,     0,   241,   246,
-       0,     0,     0,   103,     0,     0,     0,     0,     0,     0,
+      24,    23,     0,     0,   172,     0,   162,   163,   269,   272,
+     271,   270,   258,   259,   256,   242,     0,     0,     0,     0,
+     220,     0,    88,   212,     0,     0,   244,   215,   216,   269,
+     243,   128,   270,     0,   260,   178,   177,     0,     0,    86,
+      87,   242,   187,     0,     0,   235,   239,   241,   240,   218,
+     213,   164,   165,   184,   169,   170,   190,     0,   257,   262,
+       0,     0,     0,   119,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   150,   151,   152,     0,     0,     0,     0,     0,
+       0,     0,   166,   167,   168,     0,     0,     0,     0,     0,
        0,     0,     0,     0,    19,    82,    83,     0,    34,    16,
       16,    16,    16,    16,     0,    16,    16,     0,    16,    16,
       40,     0,    52,    55,     0,     0,     0,     0,     0,     0,
-      26,    25,    20,   155,   110,   228,     0,     0,   208,   114,
-      89,     0,    90,   206,   210,     0,     0,     0,   106,   158,
-       0,   189,     0,   169,     0,   175,   178,   177,   222,     0,
-      94,   218,     0,   172,   100,   101,    99,   104,     0,     0,
-     128,     0,   141,   137,   138,   134,   135,   132,     0,   143,
-     144,   142,   140,   139,   136,   145,   133,     0,     0,   248,
-     250,     0,   116,     0,     0,     0,   252,   109,   117,   187,
+      26,    25,    20,   171,   126,   244,     0,     0,   224,   130,
+      89,     0,    90,   222,   226,     0,     0,     0,   122,   174,
+       0,   205,     0,   185,     0,   191,   194,   193,   238,     0,
+      94,   234,     0,   188,   116,   117,   115,   120,     0,     0,
+     144,     0,   157,   153,   154,   150,   151,   148,     0,   159,
+     160,   158,   156,   155,   152,   161,   149,     0,     0,   264,
+     266,     0,   132,     0,     0,     0,   268,   125,   133,   203,
        0,     0,     0,     0,     0,     0,     0,     0,     0,    81,
-       0,    29,     0,     0,    76,     0,     0,     0,   238,     0,
-     239,   236,     0,   237,   233,   234,   235,     0,     0,    16,
+       0,    29,     0,     0,    76,     0,     0,     0,   254,     0,
+     255,   252,     0,   253,   249,   250,   251,     0,     0,    16,
        0,     0,    72,    64,    65,    78,    62,    63,    66,    67,
-       0,   230,   130,   226,    95,    90,    92,     0,   211,   113,
-       0,   157,   174,     0,   220,   221,    93,     0,     0,     0,
-     121,   127,     0,     0,     0,   191,   192,   193,   245,   125,
-       0,   190,   194,   228,   188,     0,   119,     0,   181,     0,
-     182,     0,    14,    16,    28,    88,    16,    16,    33,     0,
-       0,    77,     0,     0,    79,     0,     0,   232,    16,    75,
-      80,     0,     0,    61,    48,     0,     0,     0,   111,     0,
-       0,   115,     0,     0,    91,   159,   107,   172,   131,     0,
-     124,   167,     0,   120,   126,     0,   122,   183,   184,   118,
-       0,    90,     0,    53,   226,    73,    73,     0,     0,     0,
-       0,     0,    43,     0,     0,     0,     0,   231,   213,    96,
-      19,   129,   123,   108,     0,     0,    90,    19,     0,     0,
-       0,    18,    68,    68,     0,     0,    71,    76,     0,     0,
-      38,    39,     0,    21,    98,    97,    30,     0,     0,    35,
-      71,    71,    19,     0,     0,    36,    37,     0,     0,    51,
-       0,     0,    71,   160,     0,    19,    54,    41,    42,     0,
-      69,     0,    71,    71,    44,     0,    47,    58,     0,    22,
-       0,    17,     0,    46,    50,    73,    71,    19,    57,    15,
-      32,     0,     0,    49,     0,    68,     0,    59,    70,     0,
-      45
+       0,   246,   146,   242,   111,    90,    92,     0,   227,   129,
+       0,   173,   190,     0,   236,   237,    93,     0,     0,     0,
+     137,   143,     0,     0,     0,   207,   208,   209,   261,   141,
+       0,   206,   210,   244,   204,     0,   135,     0,   197,     0,
+     198,     0,    14,    16,    28,    88,    16,    16,    33,     0,
+       0,    77,     0,     0,    79,     0,     0,   248,    16,    75,
+      80,     0,     0,    61,    48,     0,     0,     0,   127,     0,
+       0,   131,   109,     0,    91,   175,   123,   188,   147,     0,
+     140,   183,     0,   136,   142,     0,   138,   199,   200,   134,
+       0,    90,     0,    53,   242,    73,    73,     0,     0,     0,
+       0,     0,    43,     0,     0,     0,     0,   247,   229,    97,
+      98,    95,    95,   105,   104,   108,   110,     0,    19,   145,
+     139,   124,     0,     0,    90,    19,     0,     0,     0,    18,
+      68,    68,     0,     0,    71,    76,     0,     0,    38,    39,
+      96,   100,   100,   106,   112,     0,    21,   114,   113,    30,
+       0,     0,    35,    71,    71,    19,     0,     0,    36,    37,
+       0,     0,    51,     0,     0,    71,   101,   103,    99,   107,
+     176,     0,    19,    54,    41,    42,     0,    69,     0,    71,
+      71,    44,     0,    47,   102,    58,     0,    22,     0,    17,
+       0,    46,    50,    73,    71,    19,    57,    15,    32,     0,
+       0,    49,     0,    68,     0,    59,    70,     0,    45
 };
 
   /* YYPGOTO[NTERM-NUM].  */
 static const yytype_int16 yypgoto[] =
 {
-    -412,  -412,  -412,  -412,  -412,  -412,  -412,  -412,     3,  -412,
-     -60,   -37,  -412,   -15,  -412,   490,   410,    10,  -412,  -412,
-    -412,  -412,  -412,  -412,  -412,  -412,  -412,  -315,  -399,   -75,
-    -411,  -412,    53,   204,  -234,    19,  -412,   318,   499,  -412,
-     456,   165,  -329,   305,   134,  -412,  -412,    -6,   -36,  -412,
-    -412,  -412,  -412,  -412,  -412,  -412,  -412,   198,  -412,  -412,
-     415,  -106,  -125,  -412,  -412,   241,  -412,  -412,   357,   303,
-     -41,   -39,  -412,  -412,  -412,  -412,  -412,     9
+    -440,  -440,  -440,  -440,  -440,  -440,  -440,  -440,    10,  -440,
+     -60,   -95,  -440,   -15,  -440,   529,   454,    -3,  -440,  -440,
+    -440,  -440,  -440,  -440,  -440,  -440,  -440,  -315,  -439,  -103,
+    -420,  -440,    88,   282,  -206,    26,  -440,   361,   522,  -440,
+     506,   200,  -330,   353,   156,  -440,  -440,   136,  -440,   133,
+    -440,  -440,   177,  -440,  -440,    -6,   -36,  -440,  -440,  -440,
+    -440,  -440,  -440,  -440,  -440,    25,  -440,  -440,   468,  -106,
+    -125,  -440,  -440,   306,  -440,  -440,   450,   233,   -35,   -33,
+    -440,  -440,  -440,  -440,  -440,     4
 };
 
   /* YYDEFGOTO[NTERM-NUM].  */
 static const yytype_int16 yydefgoto[] =
 {
       -1,     7,     8,     9,    10,    11,    12,    13,    94,   374,
-      15,   452,   472,   102,   484,   222,   100,   101,   375,   376,
-     303,   457,   505,   433,   447,   499,   508,    96,   475,   212,
-     449,   390,   380,   324,   383,   392,   300,   198,   121,   195,
-     141,   232,   337,   251,   335,   402,   466,    97,    58,    59,
-     333,   287,    60,    61,    62,    63,    64,    65,   117,    66,
-     145,   131,    67,   400,   386,   311,   312,   206,    68,    69,
-      70,    71,    72,    73,    74,    75,    76,   158
+      15,   460,   485,   102,   501,   222,   100,   101,   375,   376,
+     303,   465,   523,   433,   455,   517,   526,    96,   488,   212,
+     457,   390,   380,   324,   383,   392,   300,   198,   121,   195,
+     141,   232,   337,   251,   471,   442,   443,   497,   444,   445,
+     446,   447,   335,   402,   479,    97,    58,    59,   333,   287,
+      60,    61,    62,    63,    64,    65,   117,    66,   145,   131,
+      67,   400,   386,   311,   312,   206,    68,    69,    70,    71,
+      72,    73,    74,    75,    76,   158
 };
 
   /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM.  If
@@ -312,232 +320,215 @@ static const yytype_int16 yydefgoto[] =
      number is the opposite.  If YYTABLE_NINF, syntax error.  */
 static const yytype_int16 yytable[] =
 {
-     103,   236,   389,    57,   130,   147,   403,   148,    14,   224,
-     105,   377,   150,    78,    77,   450,   164,   194,   165,   230,
-      77,    95,   110,   110,   110,    77,   110,   110,   112,   113,
-     114,   108,   115,   116,   119,   241,   109,   138,    19,    20,
-      77,   252,   127,   110,   110,   135,   124,   163,   157,   133,
-     134,   108,   497,   348,   476,   139,   109,   118,   110,   110,
-     140,   187,   231,   188,   163,   159,  -247,  -249,  -247,  -249,
-      19,    20,    21,   385,   399,   473,   474,    19,    20,   130,
-     125,   126,   187,   391,   188,  -251,   396,   397,  -247,   223,
-    -247,  -249,   445,  -249,   512,   210,   -16,   238,   186,  -222,
-     330,   193,   246,   378,   247,   130,   464,   166,   221,   332,
-     197,  -221,   227,    55,   361,   350,   518,   467,   199,   235,
-      57,  -223,   310,   211,   229,    55,  -225,  -224,   200,   110,
-     498,   366,   189,    55,   190,   237,   201,   368,   249,   304,
-     305,   306,   307,   309,   370,   317,   318,   202,   320,   321,
-     160,   161,   162,   143,   254,   255,   256,    55,   258,   259,
-     261,   434,   144,   315,    55,   316,  -252,  -252,  -252,   185,
-     160,   161,   162,   160,   161,   162,   160,   161,   162,   298,
-     290,   291,   292,   293,   294,   295,   296,   297,   208,   191,
-     331,   192,   160,   161,   162,   454,   455,   389,   160,   161,
-     162,   240,   408,   213,   209,   160,   161,   162,   323,   325,
-     326,   327,   328,   329,   322,   106,   107,   225,   226,    57,
-     413,   228,   239,   441,   481,   233,   250,   401,   120,   299,
-     252,   340,   123,   302,   203,   308,   343,   128,   415,   319,
-     136,   334,   336,   142,   339,   149,   347,   151,   152,   153,
-     154,   155,   341,   346,   277,   348,   278,   502,   204,   395,
-     279,   280,   281,   160,   161,   162,   282,   205,   162,    55,
-     373,   353,   354,   355,   160,   161,   162,   315,   360,   316,
-     356,   160,   161,   162,   160,   161,   162,   357,   110,   358,
-     362,   160,   161,   162,   160,   161,   162,   130,   381,   325,
-     384,   384,   349,   214,   215,   216,   217,   283,   379,    55,
-     218,   393,   219,   420,   384,   384,   422,   423,   448,   365,
-     253,   398,   111,   111,   111,   363,   111,   111,   430,   160,
-     161,   162,   160,   161,   162,   -31,   388,   160,   161,   162,
-     405,   243,   409,   132,   111,   284,   404,   285,   286,   146,
-     410,   230,   160,   161,   162,   338,   424,    57,   111,   111,
-     367,   257,   416,   -79,   417,   262,   263,   264,   265,   266,
-     267,   268,   269,   270,   271,   272,   273,   274,   275,   276,
-     369,   479,   160,   161,   162,   160,   161,   162,   130,   384,
-     418,   453,   207,   437,   456,   487,   488,   419,   460,   461,
-     425,   426,   160,   161,   162,   427,   428,   496,   429,   431,
-     371,   345,   470,   471,   160,   161,   162,   503,   504,   160,
-     161,   162,   482,   384,   384,   462,   432,   170,   171,   132,
-     412,   513,   468,   435,   436,   440,   490,   438,  -175,   442,
-     492,   493,   439,   443,   451,   351,   245,   187,   465,   188,
-    -175,   381,   384,   179,   180,   459,   444,   489,   506,   181,
-     458,   463,   182,   183,   184,   185,   168,   169,   170,   171,
-     500,   469,   477,   478,   515,   485,   491,  -175,  -175,  -175,
-    -175,   507,   520,   494,  -175,   384,  -175,   495,   288,  -175,
-     509,   511,   514,   178,   179,   180,  -175,  -175,  -175,  -175,
-     181,   519,    99,   182,   183,   184,   185,   314,   220,   382,
-     480,  -175,  -175,  -175,   301,  -175,  -175,  -175,  -175,  -175,
-    -175,  -175,  -175,  -175,  -175,  -175,   168,   169,   170,   171,
-    -175,   516,   122,  -175,  -175,  -175,  -175,  -175,   196,  -175,
-     421,  -252,  -175,   170,   171,  -214,   160,   161,   162,   344,
-     411,   176,   177,   178,   179,   180,   446,  -214,   244,   394,
-     181,   313,   170,   182,   183,   184,   185,     0,     0,   179,
-     180,     0,   364,     0,     0,   181,     0,     0,   182,   183,
-     184,   185,     0,     0,  -214,  -214,  -214,  -214,   111,   180,
-       0,  -214,     0,  -214,   181,     0,  -214,   182,   183,   184,
-     185,     0,     0,  -214,  -214,  -214,  -214,   160,   161,   162,
-       0,     0,   387,   160,   161,   162,     0,     0,  -214,  -214,
-    -214,   314,  -214,  -214,  -214,  -214,  -214,  -214,  -214,  -214,
-    -214,  -214,  -214,   406,     0,     0,     0,  -214,     0,   407,
-    -214,  -214,  -214,  -214,  -214,     0,  -214,   -13,    79,  -214,
-       0,     0,     0,     0,     0,     0,    77,     0,    16,     0,
-      17,    18,    19,    20,    21,     0,     0,    22,    23,    24,
-      25,    26,     0,    27,    28,    29,    30,    31,    32,    80,
-      98,    81,    82,    33,    83,    84,    85,    86,    87,    88,
-     170,   171,     0,    89,    90,    91,    92,    34,     0,    35,
-      36,    37,    38,    39,    40,   160,   161,   162,     0,    41,
-      42,    43,    44,    45,    46,    47,     0,   180,     0,     0,
-       0,     0,   181,    48,     0,   182,   183,   184,   185,     0,
-       0,   414,     0,     0,     0,    49,    50,     0,    51,     0,
-      52,    53,    -3,    79,     0,     0,     0,    54,    93,    55,
-      56,    77,     0,    16,     0,    17,    18,    19,    20,    21,
-       0,     0,    22,    23,    24,    25,    26,     0,    27,    28,
-      29,    30,    31,    32,    80,    98,    81,    82,    33,    83,
-      84,    85,    86,    87,    88,     0,     0,     0,    89,    90,
-      91,    92,    34,     0,    35,    36,    37,    38,    39,    40,
-       0,     0,     0,     0,    41,    42,    43,    44,    45,    46,
-      47,   180,     0,     0,     0,     0,   181,     0,    48,   182,
-     183,   184,   185,   181,     0,     0,   182,   183,   184,   185,
-      49,    50,     0,    51,     0,    52,    53,     0,    79,     0,
-       0,     0,    54,    93,    55,    56,    77,   372,    16,     0,
-      17,    18,    19,    20,    21,     0,     0,    22,    23,    24,
-      25,    26,     0,    27,    28,    29,    30,    31,    32,    80,
-      98,    81,    82,    33,    83,    84,    85,    86,    87,    88,
-       0,     0,     0,    89,    90,    91,    92,    34,     0,    35,
-      36,    37,    38,    39,    40,     0,     0,     0,     0,    41,
-      42,    43,    44,    45,    46,    47,     1,     2,     3,     4,
-       5,     6,     0,    48,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,    49,    50,     0,    51,     0,
-      52,    53,     0,    79,     0,     0,     0,    54,    93,    55,
-      56,    77,   483,    16,     0,    17,    18,    19,    20,    21,
-       0,     0,    22,    23,    24,    25,    26,     0,    27,    28,
-      29,    30,    31,    32,    80,    98,    81,    82,    33,    83,
-      84,    85,    86,    87,    88,     0,     0,     0,    89,    90,
-      91,    92,    34,     0,    35,    36,    37,    38,    39,    40,
-       0,     0,     0,     0,    41,    42,    43,    44,    45,    46,
-      47,     0,     0,     0,     0,     0,     0,     0,    48,     0,
+     103,   236,   389,    57,   130,   403,   458,   377,    95,   224,
+     105,   147,   150,   148,    77,   230,   164,   194,   165,   118,
+      78,    14,   489,   112,   113,   114,   515,   115,   116,   110,
+     110,   110,   119,   110,   110,   241,   139,   138,    19,    20,
+      21,   140,   106,   107,   133,   134,    19,    20,   157,   127,
+     110,   110,   135,    77,   124,   120,   187,    77,   188,   123,
+     159,  -263,   231,  -263,   128,   110,   110,   136,   108,    77,
+     142,   125,   149,   109,   151,   152,   153,   154,   155,   130,
+     108,   277,   126,   278,  -265,   109,  -265,   279,   280,   281,
+     310,   453,   -16,   282,   536,   221,   163,   238,  -267,   378,
+     330,   385,   210,   530,   516,   130,   477,   166,   246,   252,
+     247,   391,   227,   163,   396,   397,  -239,   186,   348,   235,
+      57,  -241,   193,   399,   480,    55,   197,   439,   440,   199,
+     237,   229,   200,    55,   283,   187,   110,   188,   249,   304,
+     305,   306,   307,   309,  -240,   317,   318,   211,   320,   321,
+      55,   361,    19,    20,   254,   255,   256,   201,   258,   259,
+     261,   202,    55,   160,   161,   162,   208,  -238,   243,   315,
+     209,   316,   284,   225,   285,   286,  -237,   486,   487,   298,
+     290,   291,   292,   293,   294,   295,   296,   297,   257,   434,
+     331,   240,   262,   263,   264,   265,   266,   267,   268,   269,
+     270,   271,   272,   273,   274,   275,   276,   223,   323,   325,
+     326,   327,   328,   329,   441,   389,   203,   213,  -263,    57,
+    -263,   322,   226,   462,   463,   239,   228,   401,   143,   332,
+    -265,   340,  -265,   160,   161,   162,   343,   144,   415,    55,
+     204,   233,   350,   160,   161,   162,   347,   366,   189,   205,
+     190,    55,   111,   111,   111,   250,   111,   111,   368,   395,
+     494,   349,   370,   252,   299,   160,   161,   162,   160,   161,
+     162,   353,   354,   132,   111,   191,   408,   192,   360,   146,
+     302,   308,   413,   315,   319,   316,   339,   449,   111,   111,
+     160,   161,   162,   365,   334,   110,   336,   130,   381,   325,
+     384,   384,   520,   160,   161,   162,   341,   346,   160,   161,
+     162,   393,   348,   420,   384,   384,   422,   423,   456,   160,
+     161,   162,   207,   160,   161,   162,   162,   355,   430,   160,
+     161,   162,   356,   461,   357,   358,   464,   160,   161,   162,
+     468,   469,   409,   160,   161,   162,   362,   405,   160,   161,
+     162,   214,   215,   216,   217,   253,   373,    57,   218,   132,
+     219,   492,   483,   484,   214,   215,   216,   217,   160,   161,
+     162,   218,   495,   219,   363,   379,   245,   411,   170,   171,
+     504,   505,   160,   161,   162,   160,   161,   162,   130,   384,
+     -31,   507,   513,   437,   338,   509,   510,   388,   160,   161,
+     162,    55,   398,   404,   179,   180,   521,   522,   345,   230,
+     181,   -79,   410,   182,   183,   184,   185,   524,   288,   416,
+     167,   531,   417,   384,   384,   418,   419,   168,   169,   170,
+     171,   424,   425,   475,   533,   426,   427,   314,   428,   431,
+     481,   429,   538,   160,   161,   162,   432,   172,   173,   352,
+     174,   175,   176,   177,   178,   179,   180,   435,   436,   381,
+     384,   181,   438,   478,   182,   183,   184,   185,   448,   452,
+     506,   367,   160,   161,   162,   450,   451,   168,   169,   170,
+     171,   160,   161,   162,   466,  -191,   459,   518,   467,   470,
+     473,   160,   161,   162,   187,   474,   188,  -191,   476,   482,
+     369,   496,   384,   177,   178,   179,   180,   508,   502,   371,
+     532,   181,   527,   490,   182,   183,   184,   185,   111,   412,
+     491,   514,   525,   511,  -191,  -191,  -191,  -191,   160,   161,
+     162,  -191,   512,  -191,   181,   529,  -191,   182,   183,   184,
+     185,    99,   387,  -191,  -191,  -191,  -191,   537,   160,   161,
+     162,   314,   220,   493,   351,   122,   534,   301,  -191,  -191,
+    -191,  -230,  -191,  -191,  -191,  -191,  -191,  -191,  -191,  -191,
+    -191,  -191,  -191,  -230,   364,   421,  -268,  -191,   170,   171,
+    -191,  -191,  -191,  -191,  -191,   180,  -191,   382,   196,  -191,
+     181,   170,   171,   182,   183,   184,   185,   344,   472,   454,
+    -230,  -230,  -230,  -230,   179,   180,   499,  -230,   498,  -230,
+     181,   244,  -230,   182,   183,   184,   185,     0,   180,  -230,
+    -230,  -230,  -230,   181,   394,     0,   182,   183,   184,   185,
+    -268,  -268,  -268,   185,  -230,  -230,  -230,     0,  -230,  -230,
+    -230,  -230,  -230,  -230,  -230,  -230,  -230,  -230,  -230,   160,
+     161,   162,     0,  -230,   313,     0,  -230,  -230,  -230,  -230,
+    -230,     0,  -230,   -13,    79,  -230,     0,     0,     0,     0,
+       0,     0,    77,     0,    16,   406,    17,    18,    19,    20,
+      21,     0,     0,    22,    23,    24,    25,    26,     0,    27,
+      28,    29,    30,    31,    32,    80,    98,    81,    82,    33,
+      83,    84,    85,    86,    87,    88,   170,     0,     0,    89,
+      90,    91,    92,    34,     0,    35,    36,    37,    38,    39,
+      40,   160,   161,   162,     0,    41,    42,    43,    44,    45,
+      46,    47,     0,   180,   160,   161,   162,     0,   181,    48,
+       0,   182,   183,   184,   185,     0,     0,   407,     0,     0,
+       0,    49,    50,     0,    51,     0,    52,    53,    -3,    79,
+     414,     0,     0,    54,    93,    55,    56,    77,     0,    16,
+       0,    17,    18,    19,    20,    21,     0,     0,    22,    23,
+      24,    25,    26,     0,    27,    28,    29,    30,    31,    32,
+      80,    98,    81,    82,    33,    83,    84,    85,    86,    87,
+      88,     0,     0,     0,    89,    90,    91,    92,    34,     0,
+      35,    36,    37,    38,    39,    40,     0,     0,     0,     0,
+      41,    42,    43,    44,    45,    46,    47,     1,     2,     3,
+       4,     5,     6,     0,    48,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,    49,    50,     0,    51,
+       0,    52,    53,     0,    79,     0,     0,     0,    54,    93,
+      55,    56,    77,   372,    16,     0,    17,    18,    19,    20,
+      21,     0,     0,    22,    23,    24,    25,    26,     0,    27,
+      28,    29,    30,    31,    32,    80,    98,    81,    82,    33,
+      83,    84,    85,    86,    87,    88,     0,     0,     0,    89,
+      90,    91,    92,    34,     0,    35,    36,    37,    38,    39,
+      40,     0,     0,     0,     0,    41,    42,    43,    44,    45,
+      46,    47,     0,     0,     0,     0,     0,     0,     0,    48,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-      49,    50,     0,    51,     0,    52,    53,     0,    79,     0,
-       0,     0,    54,    93,    55,    56,    77,   486,    16,     0,
-      17,    18,    19,    20,    21,     0,     0,    22,    23,    24,
-      25,    26,     0,    27,    28,    29,    30,    31,    32,    80,
-      98,    81,    82,    33,    83,    84,    85,    86,    87,    88,
-       0,     0,     0,    89,    90,    91,    92,    34,     0,    35,
-      36,    37,    38,    39,    40,     0,     0,     0,     0,    41,
-      42,    43,    44,    45,    46,    47,     0,     0,     0,     0,
-       0,     0,     0,    48,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,    49,    50,     0,    51,     0,
-      52,    53,     0,    79,     0,     0,     0,    54,    93,    55,
-      56,    77,   501,    16,     0,    17,    18,    19,    20,    21,
-       0,     0,    22,    23,    24,    25,    26,     0,    27,    28,
-      29,    30,    31,    32,    80,    98,    81,    82,    33,    83,
-      84,    85,    86,    87,    88,     0,     0,     0,    89,    90,
-      91,    92,    34,     0,    35,    36,    37,    38,    39,    40,
-       0,     0,     0,     0,    41,    42,    43,    44,    45,    46,
-      47,     0,     0,     0,     0,     0,     0,     0,    48,     0,
+       0,    49,    50,     0,    51,     0,    52,    53,     0,    79,
+       0,     0,     0,    54,    93,    55,    56,    77,   500,    16,
+       0,    17,    18,    19,    20,    21,     0,     0,    22,    23,
+      24,    25,    26,     0,    27,    28,    29,    30,    31,    32,
+      80,    98,    81,    82,    33,    83,    84,    85,    86,    87,
+      88,     0,     0,     0,    89,    90,    91,    92,    34,     0,
+      35,    36,    37,    38,    39,    40,     0,     0,     0,     0,
+      41,    42,    43,    44,    45,    46,    47,     0,     0,     0,
+       0,     0,     0,     0,    48,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,    49,    50,     0,    51,
+       0,    52,    53,     0,    79,     0,     0,     0,    54,    93,
+      55,    56,    77,   503,    16,     0,    17,    18,    19,    20,
+      21,     0,     0,    22,    23,    24,    25,    26,     0,    27,
+      28,    29,    30,    31,    32,    80,    98,    81,    82,    33,
+      83,    84,    85,    86,    87,    88,     0,     0,     0,    89,
+      90,    91,    92,    34,     0,    35,    36,    37,    38,    39,
+      40,     0,     0,     0,     0,    41,    42,    43,    44,    45,
+      46,    47,     0,     0,     0,     0,     0,     0,     0,    48,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-      49,    50,     0,    51,     0,    52,    53,     0,    79,     0,
-       0,     0,    54,    93,    55,    56,    77,   510,    16,     0,
-      17,    18,    19,    20,    21,     0,     0,    22,    23,    24,
-      25,    26,     0,    27,    28,    29,    30,    31,    32,    80,
-      98,    81,    82,    33,    83,    84,    85,    86,    87,    88,
-       0,     0,     0,    89,    90,    91,    92,    34,     0,    35,
-      36,    37,    38,    39,    40,     0,     0,     0,     0,    41,
-      42,    43,    44,    45,    46,    47,     0,     0,     0,     0,
-       0,     0,     0,    48,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,    49,    50,     0,    51,     0,
-      52,    53,     0,    79,     0,     0,     0,    54,    93,    55,
-      56,    77,     0,    16,     0,    17,    18,    19,    20,    21,
-       0,     0,    22,    23,    24,    25,    26,     0,    27,    28,
-      29,    30,    31,    32,    80,    98,    81,    82,    33,    83,
-      84,    85,    86,    87,    88,     0,     0,     0,    89,    90,
-      91,    92,    34,     0,    35,    36,    37,    38,    39,    40,
-       0,     0,     0,     0,    41,    42,    43,    44,    45,    46,
-      47,     0,     0,   517,     0,     0,     0,     0,    48,     0,
+       0,    49,    50,     0,    51,     0,    52,    53,     0,    79,
+       0,     0,     0,    54,    93,    55,    56,    77,   519,    16,
+       0,    17,    18,    19,    20,    21,     0,     0,    22,    23,
+      24,    25,    26,     0,    27,    28,    29,    30,    31,    32,
+      80,    98,    81,    82,    33,    83,    84,    85,    86,    87,
+      88,     0,     0,     0,    89,    90,    91,    92,    34,     0,
+      35,    36,    37,    38,    39,    40,     0,     0,     0,     0,
+      41,    42,    43,    44,    45,    46,    47,     0,     0,     0,
+       0,     0,     0,     0,    48,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,    49,    50,     0,    51,
+       0,    52,    53,     0,    79,     0,     0,     0,    54,    93,
+      55,    56,    77,   528,    16,     0,    17,    18,    19,    20,
+      21,     0,     0,    22,    23,    24,    25,    26,     0,    27,
+      28,    29,    30,    31,    32,    80,    98,    81,    82,    33,
+      83,    84,    85,    86,    87,    88,     0,     0,     0,    89,
+      90,    91,    92,    34,     0,    35,    36,    37,    38,    39,
+      40,     0,     0,     0,     0,    41,    42,    43,    44,    45,
+      46,    47,     0,     0,     0,     0,     0,     0,     0,    48,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-      49,    50,     0,    51,     0,    52,    53,     0,    79,     0,
-       0,     0,    54,    93,    55,    56,    77,     0,    16,     0,
-      17,    18,    19,    20,    21,     0,     0,    22,    23,    24,
-      25,    26,     0,    27,    28,    29,    30,    31,    32,    80,
-      98,    81,    82,    33,    83,    84,    85,    86,    87,    88,
-       0,     0,     0,    89,    90,    91,    92,    34,     0,    35,
-      36,    37,    38,    39,    40,     0,     0,     0,     0,    41,
-      42,    43,    44,    45,    46,    47,     0,     0,     0,     0,
-       0,     0,     0,    48,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,    49,    50,     0,    51,     0,
-      52,    53,     0,    79,     0,     0,     0,    54,    93,    55,
-      56,    77,     0,    16,     0,    17,    18,    19,    20,    21,
+       0,    49,    50,     0,    51,     0,    52,    53,     0,    79,
+       0,     0,     0,    54,    93,    55,    56,    77,     0,    16,
+       0,    17,    18,    19,    20,    21,     0,     0,    22,    23,
+      24,    25,    26,     0,    27,    28,    29,    30,    31,    32,
+      80,    98,    81,    82,    33,    83,    84,    85,    86,    87,
+      88,     0,     0,     0,    89,    90,    91,    92,    34,     0,
+      35,    36,    37,    38,    39,    40,     0,     0,     0,     0,
+      41,    42,    43,    44,    45,    46,    47,     0,     0,   535,
+       0,     0,     0,     0,    48,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,    49,    50,     0,    51,
+       0,    52,    53,     0,    79,     0,     0,     0,    54,    93,
+      55,    56,    77,     0,    16,     0,    17,    18,    19,    20,
+      21,     0,     0,    22,    23,    24,    25,    26,     0,    27,
+      28,    29,    30,    31,    32,    80,    98,    81,    82,    33,
+      83,    84,    85,    86,    87,    88,     0,     0,     0,    89,
+      90,    91,    92,    34,     0,    35,    36,    37,    38,    39,
+      40,     0,     0,     0,     0,    41,    42,    43,    44,    45,
+      46,    47,     0,     0,     0,     0,     0,     0,     0,    48,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,    49,    50,     0,    51,     0,    52,    53,     0,    79,
+       0,     0,     0,    54,    93,    55,    56,    77,     0,    16,
+       0,    17,    18,    19,    20,    21,     0,     0,    22,    23,
+      24,    25,    26,     0,    27,    28,    29,    30,    31,    32,
+      80,     0,    81,    82,    33,    83,    84,    85,    86,    87,
+      88,     0,     0,     0,    89,    90,    91,    92,    34,     0,
+      35,    36,    37,    38,    39,    40,     0,     0,     0,     0,
+      41,    42,    43,    44,    45,    46,    47,     0,     0,     0,
+       0,     0,     0,     0,    48,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,    49,    50,     0,    51,
+       0,    52,    53,    79,     0,     0,     0,     0,    54,    93,
+      55,    56,     0,    16,     0,    17,    18,    19,    20,    21,
        0,     0,    22,    23,    24,    25,    26,     0,    27,    28,
-      29,    30,    31,    32,    80,     0,    81,    82,    33,    83,
-      84,    85,    86,    87,    88,     0,     0,     0,    89,    90,
-      91,    92,    34,     0,    35,    36,    37,    38,    39,    40,
+      29,    30,    31,    32,     0,     0,     0,     0,    33,     0,
+       0,  -268,     0,     0,     0,     0,     0,     0,   168,   169,
+     170,   171,    34,     0,    35,    36,    37,    38,    39,    40,
        0,     0,     0,     0,    41,    42,    43,    44,    45,    46,
-      47,     0,     0,     0,     0,     0,     0,     0,    48,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+      47,   174,   175,   176,   177,   178,   179,   180,    48,     0,
+       0,     0,   181,     0,     0,   182,   183,   184,   185,     0,
       49,    50,     0,    51,     0,    52,    53,    79,     0,     0,
-       0,     0,    54,    93,    55,    56,     0,    16,     0,    17,
+       0,     0,    54,   -74,    55,    56,     0,    16,     0,    17,
       18,    19,    20,    21,     0,     0,    22,    23,    24,    25,
       26,     0,    27,    28,    29,    30,    31,    32,     0,     0,
-       0,     0,    33,     0,     0,  -252,     0,     0,     0,     0,
-       0,     0,   168,   169,   170,   171,    34,     0,    35,    36,
+       0,     0,    33,     0,     0,     0,     0,     0,     0,     0,
+     168,   169,   170,   171,     0,     0,    34,     0,    35,    36,
       37,    38,    39,    40,     0,     0,     0,     0,    41,    42,
-      43,    44,    45,    46,    47,   174,   175,   176,   177,   178,
-     179,   180,    48,     0,     0,     0,   181,     0,     0,   182,
-     183,   184,   185,     0,    49,    50,     0,    51,     0,    52,
-      53,    79,     0,     0,     0,     0,    54,   -74,    55,    56,
-       0,    16,     0,    17,    18,    19,    20,    21,     0,     0,
-      22,    23,    24,    25,    26,     0,    27,    28,    29,    30,
-      31,    32,     0,     0,     0,     0,    33,     0,     0,     0,
-       0,     0,     0,   168,   169,   170,   171,     0,     0,     0,
-      34,     0,    35,    36,    37,    38,    39,    40,     0,     0,
-       0,     0,    41,    42,    43,    44,    45,    46,    47,   177,
-     178,   179,   180,     0,     0,     0,    48,   181,     0,     0,
-     182,   183,   184,   185,     0,     0,     0,     0,    49,    50,
-       0,    51,     0,    52,    53,     0,     0,     0,     0,   -74,
-      54,     0,    55,    56,    77,     0,    16,     0,    17,    18,
-      19,    20,    21,     0,     0,   129,    23,    24,    25,    26,
-     109,    27,    28,    29,    30,    31,    32,     0,     0,     0,
-       0,    33,     0,     0,     0,     0,   168,  -252,   170,   171,
-       0,     0,     0,     0,     0,    34,     0,    35,    36,    37,
-      38,    39,    40,     0,     0,     0,     0,    41,    42,    43,
-      44,    45,    46,    47,   179,   180,     0,     0,     0,     0,
-     181,    48,     0,   182,   183,   184,   185,     0,     0,     0,
-       0,     0,     0,    49,    50,     0,    51,     0,    52,    53,
-       0,     0,     0,     0,     0,    54,     0,    55,    56,    77,
-       0,    16,     0,    17,    18,    19,    20,    21,     0,     0,
-      22,    23,    24,    25,    26,     0,    27,    28,    29,    30,
-      31,    32,     0,     0,     0,     0,    33,     0,     0,     0,
-       0,   168,   169,   170,   171,     0,     0,     0,     0,     0,
-      34,     0,    35,    36,    37,    38,    39,    40,     0,     0,
-       0,     0,    41,    42,    43,    44,    45,    46,    47,   179,
-     180,     0,     0,     0,     0,   181,    48,     0,   182,   183,
-     184,   185,     0,     0,     0,     0,     0,     0,    49,    50,
-       0,    51,     0,    52,    53,     0,     0,     0,     0,     0,
-      54,     0,    55,    56,    16,   104,    17,    18,    19,    20,
-      21,     0,     0,    22,    23,    24,    25,    26,     0,    27,
-      28,    29,    30,    31,    32,     0,     0,     0,     0,    33,
-     214,   215,   216,   217,     0,     0,     0,   218,     0,   219,
-       0,     0,     0,    34,     0,    35,    36,    37,    38,    39,
-      40,     0,     0,     0,     0,    41,    42,    43,    44,    45,
-      46,    47,     0,     0,   160,   161,   162,     0,     0,    48,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,    49,    50,     0,    51,     0,    52,    53,     0,     0,
-       0,     0,     0,    54,     0,    55,    56,    16,     0,    17,
+      43,    44,    45,    46,    47,   176,   177,   178,   179,   180,
+       0,     0,    48,     0,   181,     0,     0,   182,   183,   184,
+     185,     0,     0,     0,    49,    50,     0,    51,     0,    52,
+      53,     0,     0,     0,     0,   -74,    54,     0,    55,    56,
+      77,     0,    16,     0,    17,    18,    19,    20,    21,     0,
+       0,   129,    23,    24,    25,    26,   109,    27,    28,    29,
+      30,    31,    32,     0,     0,     0,     0,    33,     0,     0,
+       0,     0,     0,     0,   168,   169,   170,   171,     0,     0,
+       0,    34,     0,    35,    36,    37,    38,    39,    40,     0,
+       0,     0,     0,    41,    42,    43,    44,    45,    46,    47,
+       0,   178,   179,   180,     0,     0,     0,    48,   181,     0,
+       0,   182,   183,   184,   185,     0,     0,     0,     0,    49,
+      50,     0,    51,     0,    52,    53,     0,     0,     0,     0,
+       0,    54,     0,    55,    56,    77,     0,    16,     0,    17,
       18,    19,    20,    21,     0,     0,    22,    23,    24,    25,
       26,     0,    27,    28,    29,    30,    31,    32,     0,     0,
-       0,     0,    33,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,    34,     0,    35,    36,
+       0,     0,    33,     0,     0,     0,     0,   168,  -268,   170,
+     171,     0,     0,     0,     0,     0,    34,     0,    35,    36,
       37,    38,    39,    40,     0,     0,     0,     0,    41,    42,
-      43,    44,    45,    46,    47,     0,     0,     0,     0,     0,
-       0,     0,    48,     0,     0,     0,     0,     0,     0,     0,
+      43,    44,    45,    46,    47,   179,   180,     0,     0,     0,
+       0,   181,    48,     0,   182,   183,   184,   185,     0,     0,
        0,     0,     0,     0,    49,    50,     0,    51,     0,    52,
-      53,     0,     0,     0,     0,     0,    54,   137,    55,    56,
-      16,     0,    17,    18,    19,    20,    21,     0,     0,    22,
+      53,     0,     0,     0,     0,     0,    54,     0,    55,    56,
+      16,   104,    17,    18,    19,    20,    21,     0,     0,    22,
       23,    24,    25,    26,     0,    27,    28,    29,    30,    31,
       32,     0,     0,     0,     0,    33,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,    34,
+     168,   169,   170,   171,     0,     0,     0,     0,     0,    34,
        0,    35,    36,    37,    38,    39,    40,     0,     0,     0,
-       0,    41,    42,    43,    44,    45,    46,    47,     0,     0,
-       0,     0,     0,     0,     0,    48,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,    49,    50,     0,
-      51,     0,    52,    53,     0,     0,     0,     0,   156,    54,
+       0,    41,    42,    43,    44,    45,    46,    47,   179,   180,
+       0,     0,     0,     0,   181,    48,     0,   182,   183,   184,
+     185,     0,     0,     0,     0,     0,     0,    49,    50,     0,
+      51,     0,    52,    53,     0,     0,     0,     0,     0,    54,
        0,    55,    56,    16,     0,    17,    18,    19,    20,    21,
        0,     0,    22,    23,    24,    25,    26,     0,    27,    28,
       29,    30,    31,    32,     0,     0,     0,     0,    33,     0,
@@ -547,7 +538,7 @@ static const yytype_int16 yytable[] =
       47,     0,     0,     0,     0,     0,     0,     0,    48,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
       49,    50,     0,    51,     0,    52,    53,     0,     0,     0,
-       0,   234,    54,     0,    55,    56,    16,     0,    17,    18,
+       0,     0,    54,   137,    55,    56,    16,     0,    17,    18,
       19,    20,    21,     0,     0,    22,    23,    24,    25,    26,
        0,    27,    28,    29,    30,    31,    32,     0,     0,     0,
        0,    33,     0,     0,     0,     0,     0,     0,     0,     0,
@@ -556,7 +547,7 @@ static const yytype_int16 yytable[] =
       44,    45,    46,    47,     0,     0,     0,     0,     0,     0,
        0,    48,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,     0,    49,    50,     0,    51,     0,    52,    53,
-       0,     0,     0,     0,   248,    54,     0,    55,    56,    16,
+       0,     0,     0,     0,   156,    54,     0,    55,    56,    16,
        0,    17,    18,    19,    20,    21,     0,     0,    22,    23,
       24,    25,    26,     0,    27,    28,    29,    30,    31,    32,
        0,     0,     0,     0,    33,     0,     0,     0,     0,     0,
@@ -565,7 +556,7 @@ static const yytype_int16 yytable[] =
       41,    42,    43,    44,    45,    46,    47,     0,     0,     0,
        0,     0,     0,     0,    48,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,    49,    50,     0,    51,
-       0,    52,    53,     0,     0,     0,     0,   260,    54,     0,
+       0,    52,    53,     0,     0,     0,     0,   234,    54,     0,
       55,    56,    16,     0,    17,    18,    19,    20,    21,     0,
        0,    22,    23,    24,    25,    26,     0,    27,    28,    29,
       30,    31,    32,     0,     0,     0,     0,    33,     0,     0,
@@ -575,7 +566,7 @@ static const yytype_int16 yytable[] =
        0,     0,     0,     0,     0,     0,     0,    48,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,    49,
       50,     0,    51,     0,    52,    53,     0,     0,     0,     0,
-     289,    54,     0,    55,    56,    16,     0,    17,    18,    19,
+     248,    54,     0,    55,    56,    16,     0,    17,    18,    19,
       20,    21,     0,     0,    22,    23,    24,    25,    26,     0,
       27,    28,    29,    30,    31,    32,     0,     0,     0,     0,
       33,     0,     0,     0,     0,     0,     0,     0,     0,     0,
@@ -584,7 +575,7 @@ static const yytype_int16 yytable[] =
       45,    46,    47,     0,     0,     0,     0,     0,     0,     0,
       48,     0,     0,     0,     0,     0,     0,     0,     0,     0,
        0,     0,    49,    50,     0,    51,     0,    52,    53,     0,
-       0,     0,     0,   342,    54,     0,    55,    56,    16,     0,
+       0,     0,     0,   260,    54,     0,    55,    56,    16,     0,
       17,    18,    19,    20,    21,     0,     0,    22,    23,    24,
       25,    26,     0,    27,    28,    29,    30,    31,    32,     0,
        0,     0,     0,    33,     0,     0,     0,     0,     0,     0,
@@ -593,7 +584,7 @@ static const yytype_int16 yytable[] =
       42,    43,    44,    45,    46,    47,     0,     0,     0,     0,
        0,     0,     0,    48,     0,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,    49,    50,     0,    51,     0,
-      52,    53,     0,     0,     0,     0,   359,    54,     0,    55,
+      52,    53,     0,     0,     0,     0,   289,    54,     0,    55,
       56,    16,     0,    17,    18,    19,    20,    21,     0,     0,
       22,    23,    24,    25,    26,     0,    27,    28,    29,    30,
       31,    32,     0,     0,     0,     0,    33,     0,     0,     0,
@@ -602,7 +593,7 @@ static const yytype_int16 yytable[] =
        0,     0,    41,    42,    43,    44,    45,    46,    47,     0,
        0,     0,     0,     0,     0,     0,    48,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,    49,    50,
-       0,    51,     0,    52,    53,     0,     0,     0,     0,     0,
+       0,    51,     0,    52,    53,     0,     0,     0,     0,   342,
       54,     0,    55,    56,    16,     0,    17,    18,    19,    20,
       21,     0,     0,    22,    23,    24,    25,    26,     0,    27,
       28,    29,    30,    31,    32,     0,     0,     0,     0,    33,
@@ -610,250 +601,247 @@ static const yytype_int16 yytable[] =
        0,     0,     0,    34,     0,    35,    36,    37,    38,    39,
       40,     0,     0,     0,     0,    41,    42,    43,    44,    45,
       46,    47,     0,     0,     0,     0,     0,     0,     0,    48,
-     167,     0,     0,     0,     0,     0,     0,   168,   169,   170,
-     171,    49,    50,     0,    51,     0,    52,    53,     0,     0,
-       0,     0,     0,   242,     0,    55,    56,   172,   173,   352,
-     174,   175,   176,   177,   178,   179,   180,     0,     0,     0,
-       0,   181,   167,     0,   182,   183,   184,   185,     0,   168,
-     169,   170,   171,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,     0,     0,     0,     0,     0,     0,     0,   172,
-     173,     0,   174,   175,   176,   177,   178,   179,   180,     0,
-       0,     0,     0,   181,   167,     0,   182,   183,   184,   185,
-       0,   168,   169,   170,   171,     0,     0,     0,     0,     0,
        0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
-       0,     0,   173,     0,   174,   175,   176,   177,   178,   179,
-     180,     0,     0,     0,     0,   181,     0,     0,   182,   183,
-     184,   185
+       0,    49,    50,     0,    51,     0,    52,    53,     0,     0,
+       0,     0,   359,    54,     0,    55,    56,    16,     0,    17,
+      18,    19,    20,    21,     0,     0,    22,    23,    24,    25,
+      26,     0,    27,    28,    29,    30,    31,    32,     0,     0,
+       0,     0,    33,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,    34,     0,    35,    36,
+      37,    38,    39,    40,     0,     0,     0,     0,    41,    42,
+      43,    44,    45,    46,    47,     0,     0,     0,     0,     0,
+       0,     0,    48,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,    49,    50,     0,    51,     0,    52,
+      53,     0,     0,     0,     0,     0,    54,     0,    55,    56,
+      16,     0,    17,    18,    19,    20,    21,     0,     0,    22,
+      23,    24,    25,    26,     0,    27,    28,    29,    30,    31,
+      32,     0,     0,     0,     0,    33,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,    34,
+       0,    35,    36,    37,    38,    39,    40,     0,     0,     0,
+       0,    41,    42,    43,    44,    45,    46,    47,     0,     0,
+       0,     0,     0,     0,     0,    48,   167,     0,     0,     0,
+       0,     0,     0,   168,   169,   170,   171,    49,    50,     0,
+      51,     0,    52,    53,     0,     0,     0,     0,     0,   242,
+       0,    55,    56,   172,   173,     0,   174,   175,   176,   177,
+     178,   179,   180,     0,     0,     0,     0,   181,   167,     0,
+     182,   183,   184,   185,     0,   168,   169,   170,   171,     0,
+       0,     0,     0,     0,     0,     0,     0,     0,     0,     0,
+       0,     0,     0,     0,     0,     0,   173,     0,   174,   175,
+     176,   177,   178,   179,   180,     0,     0,     0,     0,   181,
+       0,     0,   182,   183,   184,   185
 };
 
 static const yytype_int16 yycheck[] =
 {
-      15,   126,   317,     9,    40,    46,   335,    46,     0,   115,
-      16,     9,    48,    10,     9,   426,     9,    77,    11,    23,
-       9,    11,    19,    20,    21,     9,    23,    24,    19,    20,
-      21,    20,    23,    24,   100,   141,    25,    43,    15,    16,
-       9,    11,    39,    40,    41,    42,   100,    77,    54,    40,
-      41,    20,    23,    11,   453,    20,    25,    11,    55,    56,
-      25,     9,   122,    11,    77,    56,     9,     9,    11,    11,
-      15,    16,    17,   307,   104,    43,    44,    15,    16,   115,
-     100,   100,     9,   317,    11,     9,   320,   321,     9,    12,
-      11,     9,   421,    11,   505,    92,   100,   133,   100,    69,
-     225,     9,   143,   101,   143,   141,   101,   100,    98,    12,
-      20,    69,   118,   102,   103,    12,   515,   446,   100,   125,
-     126,    69,    67,    45,   121,   102,    69,    69,   100,   126,
-     101,    12,     9,   102,    11,   126,   100,    12,   144,   199,
-     200,   201,   202,   203,    12,   205,   206,   100,   208,   209,
-      73,    74,    75,    91,   160,   161,   162,   102,   164,   165,
-     166,   395,   100,   204,   102,   204,    95,    96,    97,    98,
-      73,    74,    75,    73,    74,    75,    73,    74,    75,   194,
-     186,   187,   188,   189,   190,   191,   192,   193,   100,     9,
-     226,    11,    73,    74,    75,   429,   430,   512,    73,    74,
-      75,   101,    12,   101,   100,    73,    74,    75,   214,   215,
-     216,   217,   218,   219,   211,    17,    18,   100,   100,   225,
-      12,    99,    10,    12,   458,    99,    69,   333,    30,    20,
-      11,   237,    34,    20,    67,    91,   242,    39,   363,   100,
-      42,   100,    69,    45,    99,    47,   252,    49,    50,    51,
-      52,    53,    10,    23,     9,    11,    11,   491,    91,   319,
-      15,    16,    17,    73,    74,    75,    21,   100,    75,   102,
-      18,   277,   278,   103,    73,    74,    75,   318,   284,   318,
-     103,    73,    74,    75,    73,    74,    75,   103,   285,   103,
-     103,    73,    74,    75,    73,    74,    75,   333,   304,   305,
-     306,   307,   101,    39,    40,    41,    42,    62,    20,   102,
-      46,   317,    48,   373,   320,   321,   376,   377,   424,   101,
-      99,    99,    19,    20,    21,   100,    23,    24,   388,    73,
-      74,    75,    73,    74,    75,   100,   100,    73,    74,    75,
-     337,   143,   348,    40,    41,   100,    23,   102,   103,    46,
-      10,    23,    73,    74,    75,    99,    20,   363,    55,    56,
-     101,   163,    10,    99,    10,   167,   168,   169,   170,   171,
-     172,   173,   174,   175,   176,   177,   178,   179,   180,   181,
-     101,   456,    73,    74,    75,    73,    74,    75,   424,   395,
-      10,   428,    89,   399,   431,   470,   471,    10,   435,   436,
-      99,    99,    73,    74,    75,    99,    99,   482,   100,    99,
-     101,    99,   449,   450,    73,    74,    75,   492,   493,    73,
-      74,    75,   459,   429,   430,   440,   101,    60,    61,   126,
-     101,   506,   447,    99,    99,     9,   473,    99,     0,    10,
-     477,   478,    99,    99,     9,    99,   143,     9,   445,    11,
-      12,   457,   458,    86,    87,    99,   101,   472,   495,    92,
-     100,    71,    95,    96,    97,    98,    58,    59,    60,    61,
-     485,   101,    99,    99,   511,     9,   100,    39,    40,    41,
-      42,    70,   519,   101,    46,   491,    48,    99,   185,    51,
-      19,    99,   507,    85,    86,    87,    58,    59,    60,    61,
-      92,    99,    12,    95,    96,    97,    98,   204,    98,   305,
-     457,    73,    74,    75,   196,    77,    78,    79,    80,    81,
-      82,    83,    84,    85,    86,    87,    58,    59,    60,    61,
-      92,   512,    33,    95,    96,    97,    98,    99,    82,   101,
-     375,    58,   104,    60,    61,     0,    73,    74,    75,   244,
-     352,    83,    84,    85,    86,    87,   422,    12,   143,   318,
-      92,   204,    60,    95,    96,    97,    98,    -1,    -1,    86,
-      87,    -1,    99,    -1,    -1,    92,    -1,    -1,    95,    96,
-      97,    98,    -1,    -1,    39,    40,    41,    42,   285,    87,
-      -1,    46,    -1,    48,    92,    -1,    51,    95,    96,    97,
-      98,    -1,    -1,    58,    59,    60,    61,    73,    74,    75,
-      -1,    -1,   309,    73,    74,    75,    -1,    -1,    73,    74,
-      75,   318,    77,    78,    79,    80,    81,    82,    83,    84,
-      85,    86,    87,    99,    -1,    -1,    -1,    92,    -1,    99,
-      95,    96,    97,    98,    99,    -1,   101,     0,     1,   104,
-      -1,    -1,    -1,    -1,    -1,    -1,     9,    -1,    11,    -1,
-      13,    14,    15,    16,    17,    -1,    -1,    20,    21,    22,
-      23,    24,    -1,    26,    27,    28,    29,    30,    31,    32,
-      33,    34,    35,    36,    37,    38,    39,    40,    41,    42,
-      60,    61,    -1,    46,    47,    48,    49,    50,    -1,    52,
-      53,    54,    55,    56,    57,    73,    74,    75,    -1,    62,
-      63,    64,    65,    66,    67,    68,    -1,    87,    -1,    -1,
-      -1,    -1,    92,    76,    -1,    95,    96,    97,    98,    -1,
-      -1,    99,    -1,    -1,    -1,    88,    89,    -1,    91,    -1,
-      93,    94,     0,     1,    -1,    -1,    -1,   100,   101,   102,
-     103,     9,    -1,    11,    -1,    13,    14,    15,    16,    17,
-      -1,    -1,    20,    21,    22,    23,    24,    -1,    26,    27,
-      28,    29,    30,    31,    32,    33,    34,    35,    36,    37,
-      38,    39,    40,    41,    42,    -1,    -1,    -1,    46,    47,
-      48,    49,    50,    -1,    52,    53,    54,    55,    56,    57,
-      -1,    -1,    -1,    -1,    62,    63,    64,    65,    66,    67,
-      68,    87,    -1,    -1,    -1,    -1,    92,    -1,    76,    95,
-      96,    97,    98,    92,    -1,    -1,    95,    96,    97,    98,
-      88,    89,    -1,    91,    -1,    93,    94,    -1,     1,    -1,
-      -1,    -1,   100,   101,   102,   103,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    -1,    -1,    20,    21,    22,
-      23,    24,    -1,    26,    27,    28,    29,    30,    31,    32,
-      33,    34,    35,    36,    37,    38,    39,    40,    41,    42,
-      -1,    -1,    -1,    46,    47,    48,    49,    50,    -1,    52,
-      53,    54,    55,    56,    57,    -1,    -1,    -1,    -1,    62,
-      63,    64,    65,    66,    67,    68,     3,     4,     5,     6,
-       7,     8,    -1,    76,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    88,    89,    -1,    91,    -1,
-      93,    94,    -1,     1,    -1,    -1,    -1,   100,   101,   102,
-     103,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      -1,    -1,    20,    21,    22,    23,    24,    -1,    26,    27,
-      28,    29,    30,    31,    32,    33,    34,    35,    36,    37,
-      38,    39,    40,    41,    42,    -1,    -1,    -1,    46,    47,
-      48,    49,    50,    -1,    52,    53,    54,    55,    56,    57,
-      -1,    -1,    -1,    -1,    62,    63,    64,    65,    66,    67,
-      68,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    76,    -1,
+      15,   126,   317,     9,    40,   335,   426,     9,    11,   115,
+      16,    46,    48,    46,     9,    23,     9,    77,    11,    11,
+      10,     0,   461,    19,    20,    21,    23,    23,    24,    19,
+      20,    21,   100,    23,    24,   141,    20,    43,    15,    16,
+      17,    25,    17,    18,    40,    41,    15,    16,    54,    39,
+      40,    41,    42,     9,   100,    30,     9,     9,    11,    34,
+      56,     9,   122,    11,    39,    55,    56,    42,    20,     9,
+      45,   100,    47,    25,    49,    50,    51,    52,    53,   115,
+      20,     9,   100,    11,     9,    25,    11,    15,    16,    17,
+      67,   421,   100,    21,   533,    98,    77,   133,     9,   101,
+     225,   307,    92,   523,   101,   141,   101,   100,   143,    11,
+     143,   317,   118,    77,   320,   321,    69,   100,    11,   125,
+     126,    69,     9,   104,   454,   102,    20,    15,    16,   100,
+     126,   121,   100,   102,    62,     9,   126,    11,   144,   199,
+     200,   201,   202,   203,    69,   205,   206,    45,   208,   209,
+     102,   103,    15,    16,   160,   161,   162,   100,   164,   165,
+     166,   100,   102,    73,    74,    75,   100,    69,   143,   204,
+     100,   204,   100,   100,   102,   103,    69,    43,    44,   194,
+     186,   187,   188,   189,   190,   191,   192,   193,   163,   395,
+     226,   101,   167,   168,   169,   170,   171,   172,   173,   174,
+     175,   176,   177,   178,   179,   180,   181,    12,   214,   215,
+     216,   217,   218,   219,   102,   530,    67,   101,     9,   225,
+      11,   211,   100,   429,   430,    10,    99,   333,    91,    12,
+       9,   237,    11,    73,    74,    75,   242,   100,   363,   102,
+      91,    99,    12,    73,    74,    75,   252,    12,     9,   100,
+      11,   102,    19,    20,    21,    69,    23,    24,    12,   319,
+     466,   101,    12,    11,    20,    73,    74,    75,    73,    74,
+      75,   277,   278,    40,    41,     9,    12,    11,   284,    46,
+      20,    91,    12,   318,   100,   318,    99,    12,    55,    56,
+      73,    74,    75,   101,   100,   285,    69,   333,   304,   305,
+     306,   307,   508,    73,    74,    75,    10,    23,    73,    74,
+      75,   317,    11,   373,   320,   321,   376,   377,   424,    73,
+      74,    75,    89,    73,    74,    75,    75,   103,   388,    73,
+      74,    75,   103,   428,   103,   103,   431,    73,    74,    75,
+     435,   436,   348,    73,    74,    75,   103,   337,    73,    74,
+      75,    39,    40,    41,    42,    99,    18,   363,    46,   126,
+      48,   464,   457,   458,    39,    40,    41,    42,    73,    74,
+      75,    46,   467,    48,   100,    20,   143,   352,    60,    61,
+     483,   484,    73,    74,    75,    73,    74,    75,   424,   395,
+     100,   486,   495,   399,    99,   490,   491,   100,    73,    74,
+      75,   102,    99,    23,    86,    87,   509,   510,    99,    23,
+      92,    99,    10,    95,    96,    97,    98,   512,   185,    10,
+      51,   524,    10,   429,   430,    10,    10,    58,    59,    60,
+      61,    20,    99,   448,   529,    99,    99,   204,    99,    99,
+     455,   100,   537,    73,    74,    75,   101,    78,    79,    80,
+      81,    82,    83,    84,    85,    86,    87,    99,    99,   465,
+     466,    92,    99,   453,    95,    96,    97,    98,     9,   101,
+     485,   101,    73,    74,    75,    10,    99,    58,    59,    60,
+      61,    73,    74,    75,   100,     0,     9,   502,    99,    25,
+      77,    73,    74,    75,     9,    99,    11,    12,    71,   101,
+     101,    78,   508,    84,    85,    86,    87,   100,     9,   101,
+     525,    92,    19,    99,    95,    96,    97,    98,   285,   101,
+      99,   496,    70,   101,    39,    40,    41,    42,    73,    74,
+      75,    46,    99,    48,    92,    99,    51,    95,    96,    97,
+      98,    12,   309,    58,    59,    60,    61,    99,    73,    74,
+      75,   318,    98,   465,    99,    33,   530,   196,    73,    74,
+      75,     0,    77,    78,    79,    80,    81,    82,    83,    84,
+      85,    86,    87,    12,    99,   375,    58,    92,    60,    61,
+      95,    96,    97,    98,    99,    87,   101,   305,    82,   104,
+      92,    60,    61,    95,    96,    97,    98,   244,   442,   422,
+      39,    40,    41,    42,    86,    87,   473,    46,   472,    48,
+      92,   143,    51,    95,    96,    97,    98,    -1,    87,    58,
+      59,    60,    61,    92,   318,    -1,    95,    96,    97,    98,
+      95,    96,    97,    98,    73,    74,    75,    -1,    77,    78,
+      79,    80,    81,    82,    83,    84,    85,    86,    87,    73,
+      74,    75,    -1,    92,   204,    -1,    95,    96,    97,    98,
+      99,    -1,   101,     0,     1,   104,    -1,    -1,    -1,    -1,
+      -1,    -1,     9,    -1,    11,    99,    13,    14,    15,    16,
+      17,    -1,    -1,    20,    21,    22,    23,    24,    -1,    26,
+      27,    28,    29,    30,    31,    32,    33,    34,    35,    36,
+      37,    38,    39,    40,    41,    42,    60,    -1,    -1,    46,
+      47,    48,    49,    50,    -1,    52,    53,    54,    55,    56,
+      57,    73,    74,    75,    -1,    62,    63,    64,    65,    66,
+      67,    68,    -1,    87,    73,    74,    75,    -1,    92,    76,
+      -1,    95,    96,    97,    98,    -1,    -1,    99,    -1,    -1,
+      -1,    88,    89,    -1,    91,    -1,    93,    94,     0,     1,
+      99,    -1,    -1,   100,   101,   102,   103,     9,    -1,    11,
+      -1,    13,    14,    15,    16,    17,    -1,    -1,    20,    21,
+      22,    23,    24,    -1,    26,    27,    28,    29,    30,    31,
+      32,    33,    34,    35,    36,    37,    38,    39,    40,    41,
+      42,    -1,    -1,    -1,    46,    47,    48,    49,    50,    -1,
+      52,    53,    54,    55,    56,    57,    -1,    -1,    -1,    -1,
+      62,    63,    64,    65,    66,    67,    68,     3,     4,     5,
+       6,     7,     8,    -1,    76,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    88,    89,    -1,    91,
+      -1,    93,    94,    -1,     1,    -1,    -1,    -1,   100,   101,
+     102,   103,     9,    10,    11,    -1,    13,    14,    15,    16,
+      17,    -1,    -1,    20,    21,    22,    23,    24,    -1,    26,
+      27,    28,    29,    30,    31,    32,    33,    34,    35,    36,
+      37,    38,    39,    40,    41,    42,    -1,    -1,    -1,    46,
+      47,    48,    49,    50,    -1,    52,    53,    54,    55,    56,
+      57,    -1,    -1,    -1,    -1,    62,    63,    64,    65,    66,
+      67,    68,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    76,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      88,    89,    -1,    91,    -1,    93,    94,    -1,     1,    -1,
-      -1,    -1,   100,   101,   102,   103,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    -1,    -1,    20,    21,    22,
-      23,    24,    -1,    26,    27,    28,    29,    30,    31,    32,
-      33,    34,    35,    36,    37,    38,    39,    40,    41,    42,
-      -1,    -1,    -1,    46,    47,    48,    49,    50,    -1,    52,
-      53,    54,    55,    56,    57,    -1,    -1,    -1,    -1,    62,
-      63,    64,    65,    66,    67,    68,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    76,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    88,    89,    -1,    91,    -1,
-      93,    94,    -1,     1,    -1,    -1,    -1,   100,   101,   102,
-     103,     9,    10,    11,    -1,    13,    14,    15,    16,    17,
-      -1,    -1,    20,    21,    22,    23,    24,    -1,    26,    27,
-      28,    29,    30,    31,    32,    33,    34,    35,    36,    37,
-      38,    39,    40,    41,    42,    -1,    -1,    -1,    46,    47,
-      48,    49,    50,    -1,    52,    53,    54,    55,    56,    57,
-      -1,    -1,    -1,    -1,    62,    63,    64,    65,    66,    67,
-      68,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    76,    -1,
+      -1,    88,    89,    -1,    91,    -1,    93,    94,    -1,     1,
+      -1,    -1,    -1,   100,   101,   102,   103,     9,    10,    11,
+      -1,    13,    14,    15,    16,    17,    -1,    -1,    20,    21,
+      22,    23,    24,    -1,    26,    27,    28,    29,    30,    31,
+      32,    33,    34,    35,    36,    37,    38,    39,    40,    41,
+      42,    -1,    -1,    -1,    46,    47,    48,    49,    50,    -1,
+      52,    53,    54,    55,    56,    57,    -1,    -1,    -1,    -1,
+      62,    63,    64,    65,    66,    67,    68,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    76,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    88,    89,    -1,    91,
+      -1,    93,    94,    -1,     1,    -1,    -1,    -1,   100,   101,
+     102,   103,     9,    10,    11,    -1,    13,    14,    15,    16,
+      17,    -1,    -1,    20,    21,    22,    23,    24,    -1,    26,
+      27,    28,    29,    30,    31,    32,    33,    34,    35,    36,
+      37,    38,    39,    40,    41,    42,    -1,    -1,    -1,    46,
+      47,    48,    49,    50,    -1,    52,    53,    54,    55,    56,
+      57,    -1,    -1,    -1,    -1,    62,    63,    64,    65,    66,
+      67,    68,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    76,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      88,    89,    -1,    91,    -1,    93,    94,    -1,     1,    -1,
-      -1,    -1,   100,   101,   102,   103,     9,    10,    11,    -1,
-      13,    14,    15,    16,    17,    -1,    -1,    20,    21,    22,
-      23,    24,    -1,    26,    27,    28,    29,    30,    31,    32,
-      33,    34,    35,    36,    37,    38,    39,    40,    41,    42,
-      -1,    -1,    -1,    46,    47,    48,    49,    50,    -1,    52,
-      53,    54,    55,    56,    57,    -1,    -1,    -1,    -1,    62,
-      63,    64,    65,    66,    67,    68,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    76,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    88,    89,    -1,    91,    -1,
-      93,    94,    -1,     1,    -1,    -1,    -1,   100,   101,   102,
-     103,     9,    -1,    11,    -1,    13,    14,    15,    16,    17,
-      -1,    -1,    20,    21,    22,    23,    24,    -1,    26,    27,
-      28,    29,    30,    31,    32,    33,    34,    35,    36,    37,
-      38,    39,    40,    41,    42,    -1,    -1,    -1,    46,    47,
-      48,    49,    50,    -1,    52,    53,    54,    55,    56,    57,
-      -1,    -1,    -1,    -1,    62,    63,    64,    65,    66,    67,
-      68,    -1,    -1,    71,    -1,    -1,    -1,    -1,    76,    -1,
+      -1,    88,    89,    -1,    91,    -1,    93,    94,    -1,     1,
+      -1,    -1,    -1,   100,   101,   102,   103,     9,    10,    11,
+      -1,    13,    14,    15,    16,    17,    -1,    -1,    20,    21,
+      22,    23,    24,    -1,    26,    27,    28,    29,    30,    31,
+      32,    33,    34,    35,    36,    37,    38,    39,    40,    41,
+      42,    -1,    -1,    -1,    46,    47,    48,    49,    50,    -1,
+      52,    53,    54,    55,    56,    57,    -1,    -1,    -1,    -1,
+      62,    63,    64,    65,    66,    67,    68,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    76,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    88,    89,    -1,    91,
+      -1,    93,    94,    -1,     1,    -1,    -1,    -1,   100,   101,
+     102,   103,     9,    10,    11,    -1,    13,    14,    15,    16,
+      17,    -1,    -1,    20,    21,    22,    23,    24,    -1,    26,
+      27,    28,    29,    30,    31,    32,    33,    34,    35,    36,
+      37,    38,    39,    40,    41,    42,    -1,    -1,    -1,    46,
+      47,    48,    49,    50,    -1,    52,    53,    54,    55,    56,
+      57,    -1,    -1,    -1,    -1,    62,    63,    64,    65,    66,
+      67,    68,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    76,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      88,    89,    -1,    91,    -1,    93,    94,    -1,     1,    -1,
-      -1,    -1,   100,   101,   102,   103,     9,    -1,    11,    -1,
-      13,    14,    15,    16,    17,    -1,    -1,    20,    21,    22,
-      23,    24,    -1,    26,    27,    28,    29,    30,    31,    32,
-      33,    34,    35,    36,    37,    38,    39,    40,    41,    42,
-      -1,    -1,    -1,    46,    47,    48,    49,    50,    -1,    52,
-      53,    54,    55,    56,    57,    -1,    -1,    -1,    -1,    62,
-      63,    64,    65,    66,    67,    68,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    76,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    88,    89,    -1,    91,    -1,
-      93,    94,    -1,     1,    -1,    -1,    -1,   100,   101,   102,
-     103,     9,    -1,    11,    -1,    13,    14,    15,    16,    17,
+      -1,    88,    89,    -1,    91,    -1,    93,    94,    -1,     1,
+      -1,    -1,    -1,   100,   101,   102,   103,     9,    -1,    11,
+      -1,    13,    14,    15,    16,    17,    -1,    -1,    20,    21,
+      22,    23,    24,    -1,    26,    27,    28,    29,    30,    31,
+      32,    33,    34,    35,    36,    37,    38,    39,    40,    41,
+      42,    -1,    -1,    -1,    46,    47,    48,    49,    50,    -1,
+      52,    53,    54,    55,    56,    57,    -1,    -1,    -1,    -1,
+      62,    63,    64,    65,    66,    67,    68,    -1,    -1,    71,
+      -1,    -1,    -1,    -1,    76,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    88,    89,    -1,    91,
+      -1,    93,    94,    -1,     1,    -1,    -1,    -1,   100,   101,
+     102,   103,     9,    -1,    11,    -1,    13,    14,    15,    16,
+      17,    -1,    -1,    20,    21,    22,    23,    24,    -1,    26,
+      27,    28,    29,    30,    31,    32,    33,    34,    35,    36,
+      37,    38,    39,    40,    41,    42,    -1,    -1,    -1,    46,
+      47,    48,    49,    50,    -1,    52,    53,    54,    55,    56,
+      57,    -1,    -1,    -1,    -1,    62,    63,    64,    65,    66,
+      67,    68,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    76,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    88,    89,    -1,    91,    -1,    93,    94,    -1,     1,
+      -1,    -1,    -1,   100,   101,   102,   103,     9,    -1,    11,
+      -1,    13,    14,    15,    16,    17,    -1,    -1,    20,    21,
+      22,    23,    24,    -1,    26,    27,    28,    29,    30,    31,
+      32,    -1,    34,    35,    36,    37,    38,    39,    40,    41,
+      42,    -1,    -1,    -1,    46,    47,    48,    49,    50,    -1,
+      52,    53,    54,    55,    56,    57,    -1,    -1,    -1,    -1,
+      62,    63,    64,    65,    66,    67,    68,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    76,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    88,    89,    -1,    91,
+      -1,    93,    94,     1,    -1,    -1,    -1,    -1,   100,   101,
+     102,   103,    -1,    11,    -1,    13,    14,    15,    16,    17,
       -1,    -1,    20,    21,    22,    23,    24,    -1,    26,    27,
-      28,    29,    30,    31,    32,    -1,    34,    35,    36,    37,
-      38,    39,    40,    41,    42,    -1,    -1,    -1,    46,    47,
-      48,    49,    50,    -1,    52,    53,    54,    55,    56,    57,
+      28,    29,    30,    31,    -1,    -1,    -1,    -1,    36,    -1,
+      -1,    51,    -1,    -1,    -1,    -1,    -1,    -1,    58,    59,
+      60,    61,    50,    -1,    52,    53,    54,    55,    56,    57,
       -1,    -1,    -1,    -1,    62,    63,    64,    65,    66,    67,
-      68,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    76,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      68,    81,    82,    83,    84,    85,    86,    87,    76,    -1,
+      -1,    -1,    92,    -1,    -1,    95,    96,    97,    98,    -1,
       88,    89,    -1,    91,    -1,    93,    94,     1,    -1,    -1,
       -1,    -1,   100,   101,   102,   103,    -1,    11,    -1,    13,
       14,    15,    16,    17,    -1,    -1,    20,    21,    22,    23,
       24,    -1,    26,    27,    28,    29,    30,    31,    -1,    -1,
-      -1,    -1,    36,    -1,    -1,    51,    -1,    -1,    -1,    -1,
-      -1,    -1,    58,    59,    60,    61,    50,    -1,    52,    53,
+      -1,    -1,    36,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      58,    59,    60,    61,    -1,    -1,    50,    -1,    52,    53,
       54,    55,    56,    57,    -1,    -1,    -1,    -1,    62,    63,
-      64,    65,    66,    67,    68,    81,    82,    83,    84,    85,
-      86,    87,    76,    -1,    -1,    -1,    92,    -1,    -1,    95,
-      96,    97,    98,    -1,    88,    89,    -1,    91,    -1,    93,
-      94,     1,    -1,    -1,    -1,    -1,   100,   101,   102,   103,
-      -1,    11,    -1,    13,    14,    15,    16,    17,    -1,    -1,
-      20,    21,    22,    23,    24,    -1,    26,    27,    28,    29,
-      30,    31,    -1,    -1,    -1,    -1,    36,    -1,    -1,    -1,
-      -1,    -1,    -1,    58,    59,    60,    61,    -1,    -1,    -1,
-      50,    -1,    52,    53,    54,    55,    56,    57,    -1,    -1,
-      -1,    -1,    62,    63,    64,    65,    66,    67,    68,    84,
-      85,    86,    87,    -1,    -1,    -1,    76,    92,    -1,    -1,
-      95,    96,    97,    98,    -1,    -1,    -1,    -1,    88,    89,
-      -1,    91,    -1,    93,    94,    -1,    -1,    -1,    -1,    99,
-     100,    -1,   102,   103,     9,    -1,    11,    -1,    13,    14,
-      15,    16,    17,    -1,    -1,    20,    21,    22,    23,    24,
-      25,    26,    27,    28,    29,    30,    31,    -1,    -1,    -1,
-      -1,    36,    -1,    -1,    -1,    -1,    58,    59,    60,    61,
-      -1,    -1,    -1,    -1,    -1,    50,    -1,    52,    53,    54,
-      55,    56,    57,    -1,    -1,    -1,    -1,    62,    63,    64,
-      65,    66,    67,    68,    86,    87,    -1,    -1,    -1,    -1,
-      92,    76,    -1,    95,    96,    97,    98,    -1,    -1,    -1,
-      -1,    -1,    -1,    88,    89,    -1,    91,    -1,    93,    94,
-      -1,    -1,    -1,    -1,    -1,   100,    -1,   102,   103,     9,
-      -1,    11,    -1,    13,    14,    15,    16,    17,    -1,    -1,
-      20,    21,    22,    23,    24,    -1,    26,    27,    28,    29,
-      30,    31,    -1,    -1,    -1,    -1,    36,    -1,    -1,    -1,
-      -1,    58,    59,    60,    61,    -1,    -1,    -1,    -1,    -1,
-      50,    -1,    52,    53,    54,    55,    56,    57,    -1,    -1,
-      -1,    -1,    62,    63,    64,    65,    66,    67,    68,    86,
-      87,    -1,    -1,    -1,    -1,    92,    76,    -1,    95,    96,
-      97,    98,    -1,    -1,    -1,    -1,    -1,    -1,    88,    89,
-      -1,    91,    -1,    93,    94,    -1,    -1,    -1,    -1,    -1,
-     100,    -1,   102,   103,    11,    12,    13,    14,    15,    16,
-      17,    -1,    -1,    20,    21,    22,    23,    24,    -1,    26,
-      27,    28,    29,    30,    31,    -1,    -1,    -1,    -1,    36,
-      39,    40,    41,    42,    -1,    -1,    -1,    46,    -1,    48,
-      -1,    -1,    -1,    50,    -1,    52,    53,    54,    55,    56,
-      57,    -1,    -1,    -1,    -1,    62,    63,    64,    65,    66,
-      67,    68,    -1,    -1,    73,    74,    75,    -1,    -1,    76,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    88,    89,    -1,    91,    -1,    93,    94,    -1,    -1,
-      -1,    -1,    -1,   100,    -1,   102,   103,    11,    -1,    13,
+      64,    65,    66,    67,    68,    83,    84,    85,    86,    87,
+      -1,    -1,    76,    -1,    92,    -1,    -1,    95,    96,    97,
+      98,    -1,    -1,    -1,    88,    89,    -1,    91,    -1,    93,
+      94,    -1,    -1,    -1,    -1,    99,   100,    -1,   102,   103,
+       9,    -1,    11,    -1,    13,    14,    15,    16,    17,    -1,
+      -1,    20,    21,    22,    23,    24,    25,    26,    27,    28,
+      29,    30,    31,    -1,    -1,    -1,    -1,    36,    -1,    -1,
+      -1,    -1,    -1,    -1,    58,    59,    60,    61,    -1,    -1,
+      -1,    50,    -1,    52,    53,    54,    55,    56,    57,    -1,
+      -1,    -1,    -1,    62,    63,    64,    65,    66,    67,    68,
+      -1,    85,    86,    87,    -1,    -1,    -1,    76,    92,    -1,
+      -1,    95,    96,    97,    98,    -1,    -1,    -1,    -1,    88,
+      89,    -1,    91,    -1,    93,    94,    -1,    -1,    -1,    -1,
+      -1,   100,    -1,   102,   103,     9,    -1,    11,    -1,    13,
       14,    15,    16,    17,    -1,    -1,    20,    21,    22,    23,
       24,    -1,    26,    27,    28,    29,    30,    31,    -1,    -1,
-      -1,    -1,    36,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    50,    -1,    52,    53,
+      -1,    -1,    36,    -1,    -1,    -1,    -1,    58,    59,    60,
+      61,    -1,    -1,    -1,    -1,    -1,    50,    -1,    52,    53,
       54,    55,    56,    57,    -1,    -1,    -1,    -1,    62,    63,
-      64,    65,    66,    67,    68,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    76,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      64,    65,    66,    67,    68,    86,    87,    -1,    -1,    -1,
+      -1,    92,    76,    -1,    95,    96,    97,    98,    -1,    -1,
       -1,    -1,    -1,    -1,    88,    89,    -1,    91,    -1,    93,
-      94,    -1,    -1,    -1,    -1,    -1,   100,   101,   102,   103,
-      11,    -1,    13,    14,    15,    16,    17,    -1,    -1,    20,
+      94,    -1,    -1,    -1,    -1,    -1,   100,    -1,   102,   103,
+      11,    12,    13,    14,    15,    16,    17,    -1,    -1,    20,
       21,    22,    23,    24,    -1,    26,    27,    28,    29,    30,
       31,    -1,    -1,    -1,    -1,    36,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    50,
+      58,    59,    60,    61,    -1,    -1,    -1,    -1,    -1,    50,
       -1,    52,    53,    54,    55,    56,    57,    -1,    -1,    -1,
-      -1,    62,    63,    64,    65,    66,    67,    68,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    76,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    88,    89,    -1,
-      91,    -1,    93,    94,    -1,    -1,    -1,    -1,    99,   100,
+      -1,    62,    63,    64,    65,    66,    67,    68,    86,    87,
+      -1,    -1,    -1,    -1,    92,    76,    -1,    95,    96,    97,
+      98,    -1,    -1,    -1,    -1,    -1,    -1,    88,    89,    -1,
+      91,    -1,    93,    94,    -1,    -1,    -1,    -1,    -1,   100,
       -1,   102,   103,    11,    -1,    13,    14,    15,    16,    17,
       -1,    -1,    20,    21,    22,    23,    24,    -1,    26,    27,
       28,    29,    30,    31,    -1,    -1,    -1,    -1,    36,    -1,
@@ -863,7 +851,7 @@ static const yytype_int16 yycheck[] =
       68,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    76,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
       88,    89,    -1,    91,    -1,    93,    94,    -1,    -1,    -1,
-      -1,    99,   100,    -1,   102,   103,    11,    -1,    13,    14,
+      -1,    -1,   100,   101,   102,   103,    11,    -1,    13,    14,
       15,    16,    17,    -1,    -1,    20,    21,    22,    23,    24,
       -1,    26,    27,    28,    29,    30,    31,    -1,    -1,    -1,
       -1,    36,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
@@ -918,7 +906,7 @@ static const yytype_int16 yycheck[] =
       -1,    -1,    62,    63,    64,    65,    66,    67,    68,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    76,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    88,    89,
-      -1,    91,    -1,    93,    94,    -1,    -1,    -1,    -1,    -1,
+      -1,    91,    -1,    93,    94,    -1,    -1,    -1,    -1,    99,
      100,    -1,   102,   103,    11,    -1,    13,    14,    15,    16,
       17,    -1,    -1,    20,    21,    22,    23,    24,    -1,    26,
       27,    28,    29,    30,    31,    -1,    -1,    -1,    -1,    36,
@@ -926,20 +914,34 @@ static const yytype_int16 yycheck[] =
       -1,    -1,    -1,    50,    -1,    52,    53,    54,    55,    56,
       57,    -1,    -1,    -1,    -1,    62,    63,    64,    65,    66,
       67,    68,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    76,
-      51,    -1,    -1,    -1,    -1,    -1,    -1,    58,    59,    60,
-      61,    88,    89,    -1,    91,    -1,    93,    94,    -1,    -1,
-      -1,    -1,    -1,   100,    -1,   102,   103,    78,    79,    80,
-      81,    82,    83,    84,    85,    86,    87,    -1,    -1,    -1,
-      -1,    92,    51,    -1,    95,    96,    97,    98,    -1,    58,
-      59,    60,    61,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    78,
-      79,    -1,    81,    82,    83,    84,    85,    86,    87,    -1,
-      -1,    -1,    -1,    92,    51,    -1,    95,    96,    97,    98,
-      -1,    58,    59,    60,    61,    -1,    -1,    -1,    -1,    -1,
       -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
-      -1,    -1,    79,    -1,    81,    82,    83,    84,    85,    86,
-      87,    -1,    -1,    -1,    -1,    92,    -1,    -1,    95,    96,
-      97,    98
+      -1,    88,    89,    -1,    91,    -1,    93,    94,    -1,    -1,
+      -1,    -1,    99,   100,    -1,   102,   103,    11,    -1,    13,
+      14,    15,    16,    17,    -1,    -1,    20,    21,    22,    23,
+      24,    -1,    26,    27,    28,    29,    30,    31,    -1,    -1,
+      -1,    -1,    36,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    50,    -1,    52,    53,
+      54,    55,    56,    57,    -1,    -1,    -1,    -1,    62,    63,
+      64,    65,    66,    67,    68,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    76,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    88,    89,    -1,    91,    -1,    93,
+      94,    -1,    -1,    -1,    -1,    -1,   100,    -1,   102,   103,
+      11,    -1,    13,    14,    15,    16,    17,    -1,    -1,    20,
+      21,    22,    23,    24,    -1,    26,    27,    28,    29,    30,
+      31,    -1,    -1,    -1,    -1,    36,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    50,
+      -1,    52,    53,    54,    55,    56,    57,    -1,    -1,    -1,
+      -1,    62,    63,    64,    65,    66,    67,    68,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    76,    51,    -1,    -1,    -1,
+      -1,    -1,    -1,    58,    59,    60,    61,    88,    89,    -1,
+      91,    -1,    93,    94,    -1,    -1,    -1,    -1,    -1,   100,
+      -1,   102,   103,    78,    79,    -1,    81,    82,    83,    84,
+      85,    86,    87,    -1,    -1,    -1,    -1,    92,    51,    -1,
+      95,    96,    97,    98,    -1,    58,    59,    60,    61,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,    -1,
+      -1,    -1,    -1,    -1,    -1,    -1,    79,    -1,    81,    82,
+      83,    84,    85,    86,    87,    -1,    -1,    -1,    -1,    92,
+      -1,    -1,    95,    96,    97,    98
 };
 
   /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
@@ -951,54 +953,55 @@ static const yytype_uint8 yystos[] =
       16,    17,    20,    21,    22,    23,    24,    26,    27,    28,
       29,    30,    31,    36,    50,    52,    53,    54,    55,    56,
       57,    62,    63,    64,    65,    66,    67,    68,    76,    88,
-      89,    91,    93,    94,   100,   102,   103,   152,   153,   154,
-     157,   158,   159,   160,   161,   162,   164,   167,   173,   174,
-     175,   176,   177,   178,   179,   180,   181,     9,   113,     1,
+      89,    91,    93,    94,   100,   102,   103,   160,   161,   162,
+     165,   166,   167,   168,   169,   170,   172,   175,   181,   182,
+     183,   184,   185,   186,   187,   188,   189,     9,   113,     1,
       32,    34,    35,    37,    38,    39,    40,    41,    42,    46,
-      47,    48,    49,   101,   113,   122,   132,   152,    33,   120,
-     121,   122,   118,   118,    12,   152,   162,   162,    20,    25,
-     113,   174,   182,   182,   182,   182,   182,   163,    11,   100,
-     162,   143,   143,   162,   100,   100,   100,   113,   162,    20,
-     153,   166,   174,   182,   182,   113,   162,   101,   152,    20,
-      25,   145,   162,    91,   100,   165,   174,   175,   176,   162,
-     153,   162,   162,   162,   162,   162,    99,   152,   182,   182,
+      47,    48,    49,   101,   113,   122,   132,   160,    33,   120,
+     121,   122,   118,   118,    12,   160,   170,   170,    20,    25,
+     113,   182,   190,   190,   190,   190,   190,   171,    11,   100,
+     170,   143,   143,   170,   100,   100,   100,   113,   170,    20,
+     161,   174,   182,   190,   190,   113,   170,   101,   160,    20,
+      25,   145,   170,    91,   100,   173,   182,   183,   184,   170,
+     161,   170,   170,   170,   170,   170,    99,   160,   190,   190,
       73,    74,    75,    77,     9,    11,   100,    51,    58,    59,
       60,    61,    78,    79,    81,    82,    83,    84,    85,    86,
       87,    92,    95,    96,    97,    98,   100,     9,    11,     9,
       11,     9,    11,     9,   115,   144,   145,    20,   142,   100,
-     100,   100,   100,    67,    91,   100,   172,   174,   100,   100,
+     100,   100,   100,    67,    91,   100,   180,   182,   100,   100,
      113,    45,   134,   101,    39,    40,    41,    42,    46,    48,
-     121,   122,   120,    12,   166,   100,   100,   152,    99,   113,
-      23,   115,   146,    99,    99,   152,   167,   182,   153,    10,
-     101,   166,   100,   162,   165,   174,   175,   176,    99,   152,
-      69,   148,    11,    99,   152,   152,   152,   162,   152,   152,
-      99,   152,   162,   162,   162,   162,   162,   162,   162,   162,
-     162,   162,   162,   162,   162,   162,   162,     9,    11,    15,
-      16,    17,    21,    62,   100,   102,   103,   156,   174,    99,
-     152,   152,   152,   152,   152,   152,   152,   152,   118,    20,
+     121,   122,   120,    12,   174,   100,   100,   160,    99,   113,
+      23,   115,   146,    99,    99,   160,   175,   190,   161,    10,
+     101,   174,   100,   170,   173,   182,   183,   184,    99,   160,
+      69,   148,    11,    99,   160,   160,   160,   170,   160,   160,
+      99,   160,   170,   170,   170,   170,   170,   170,   170,   170,
+     170,   170,   170,   170,   170,   170,   170,     9,    11,    15,
+      16,    17,    21,    62,   100,   102,   103,   164,   182,    99,
+     160,   160,   160,   160,   160,   160,   160,   160,   118,    20,
      141,   142,    20,   125,   115,   115,   115,   115,    91,   115,
-      67,   170,   171,   173,   174,   175,   176,   115,   115,   100,
-     115,   115,   113,   152,   138,   152,   152,   152,   152,   152,
-     167,   153,    12,   155,   100,   149,    69,   147,    99,    99,
-     152,    10,    99,   152,   148,    99,    23,   152,    11,   101,
-      12,    99,    80,   152,   152,   103,   103,   103,   103,    99,
-     152,   103,   103,   100,    99,   101,    12,   101,    12,   101,
+      67,   178,   179,   181,   182,   183,   184,   115,   115,   100,
+     115,   115,   113,   160,   138,   160,   160,   160,   160,   160,
+     175,   161,    12,   163,   100,   157,    69,   147,    99,    99,
+     160,    10,    99,   160,   148,    99,    23,   160,    11,   101,
+      12,    99,    80,   160,   160,   103,   103,   103,   103,    99,
+     160,   103,   103,   100,    99,   101,    12,   101,    12,   101,
       12,   101,    10,    18,   114,   123,   124,     9,   101,    20,
-     137,   152,   138,   139,   152,   139,   169,   174,   100,   132,
-     136,   139,   140,   152,   170,   115,   139,   139,    99,   104,
-     168,   166,   150,   147,    23,   113,    99,    99,    12,   152,
-      10,   162,   101,    12,    99,   167,    10,    10,    10,    10,
+     137,   160,   138,   139,   160,   139,   177,   182,   100,   132,
+     136,   139,   140,   160,   178,   115,   139,   139,    99,   104,
+     176,   174,   158,   147,    23,   113,    99,    99,    12,   160,
+      10,   170,   101,    12,    99,   175,    10,    10,    10,    10,
      115,   146,   115,   115,    20,    99,    99,    99,    99,   100,
-     115,    99,   101,   128,   139,    99,    99,   152,    99,    99,
-       9,    12,    10,    99,   101,   147,   149,   129,   166,   135,
-     135,     9,   116,   116,   139,   139,   116,   126,   100,    99,
-     116,   116,   118,    71,   101,   113,   151,   147,   118,   101,
-     116,   116,   117,    43,    44,   133,   133,    99,    99,   134,
-     137,   139,   116,    10,   119,     9,    10,   134,   134,   118,
-     116,   100,   116,   116,   101,    99,   134,    23,   101,   130,
-     118,    10,   139,   134,   134,   127,   116,    70,   131,    19,
-      10,    99,   135,   134,   118,   116,   140,    71,   133,    99,
-     116
+     115,    99,   101,   128,   139,    99,    99,   160,    99,    15,
+      16,   102,   150,   151,   153,   154,   155,   156,     9,    12,
+      10,    99,   101,   147,   157,   129,   174,   135,   135,     9,
+     116,   116,   139,   139,   116,   126,   100,    99,   116,   116,
+      25,   149,   149,    77,    99,   118,    71,   101,   113,   159,
+     147,   118,   101,   116,   116,   117,    43,    44,   133,   133,
+      99,    99,   134,   137,   139,   116,    78,   152,   152,   154,
+      10,   119,     9,    10,   134,   134,   118,   116,   100,   116,
+     116,   101,    99,   134,   170,    23,   101,   130,   118,    10,
+     139,   134,   134,   127,   116,    70,   131,    19,    10,    99,
+     135,   134,   118,   116,   140,    71,   133,    99,   116
 };
 
   /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives.  */
@@ -1013,23 +1016,25 @@ static const yytype_uint8 yyr1[] =
      132,   132,   132,   132,   132,   132,   132,   132,   133,   133,
      133,   134,   134,   135,   136,   136,   137,   137,   138,   139,
      140,   141,   141,   142,   143,   144,   145,   145,   146,   146,
-     147,   147,   147,   148,   148,   150,   149,   151,   151,   152,
-     152,   152,   152,   153,   153,   153,   154,   154,   154,   154,
-     154,   154,   154,   154,   155,   154,   156,   156,   157,   157,
-     157,   157,   157,   157,   157,   157,   157,   157,   157,   157,
-     157,   157,   158,   158,   158,   158,   158,   158,   158,   158,
-     158,   158,   158,   158,   158,   158,   159,   159,   159,   159,
-     159,   159,   159,   159,   159,   160,   160,   160,   160,   160,
-     160,   161,   161,   162,   162,   162,   162,   162,   162,   162,
-     162,   162,   162,   162,   162,   162,   162,   162,   162,   162,
-     162,   162,   162,   162,   162,   162,   162,   162,   162,   162,
-     162,   162,   162,   162,   162,   162,   162,   162,   162,   162,
-     162,   162,   162,   162,   162,   162,   162,   162,   162,   162,
-     162,   162,   163,   162,   162,   162,   162,   162,   164,   164,
-     164,   165,   165,   165,   165,   165,   166,   166,   167,   167,
-     168,   168,   169,   170,   170,   170,   171,   171,   172,   172,
-     173,   174,   175,   176,   177,   177,   178,   179,   179,   180,
-     180,   181,   181,   182,   182,   182,   182
+     147,   147,   147,   148,   148,   149,   149,   150,   150,   151,
+     152,   152,   152,   153,   154,   154,   155,   155,   155,   156,
+     156,   158,   157,   159,   159,   160,   160,   160,   160,   161,
+     161,   161,   162,   162,   162,   162,   162,   162,   162,   162,
+     163,   162,   164,   164,   165,   165,   165,   165,   165,   165,
+     165,   165,   165,   165,   165,   165,   165,   165,   166,   166,
+     166,   166,   166,   166,   166,   166,   166,   166,   166,   166,
+     166,   166,   167,   167,   167,   167,   167,   167,   167,   167,
+     167,   168,   168,   168,   168,   168,   168,   169,   169,   170,
+     170,   170,   170,   170,   170,   170,   170,   170,   170,   170,
+     170,   170,   170,   170,   170,   170,   170,   170,   170,   170,
+     170,   170,   170,   170,   170,   170,   170,   170,   170,   170,
+     170,   170,   170,   170,   170,   170,   170,   170,   170,   170,
+     170,   170,   170,   170,   170,   170,   170,   170,   171,   170,
+     170,   170,   170,   170,   172,   172,   172,   173,   173,   173,
+     173,   173,   174,   174,   175,   175,   176,   176,   177,   178,
+     178,   178,   179,   179,   180,   180,   181,   182,   183,   184,
+     185,   185,   186,   187,   187,   188,   188,   189,   189,   190,
+     190,   190,   190
 };
 
   /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN.  */
@@ -1044,23 +1049,25 @@ static const yytype_uint8 yyr2[] =
        1,     1,     3,     3,     3,     3,     3,     3,     0,     2,
        6,     0,     2,     0,     0,     1,     0,     1,     1,     1,
        1,     1,     0,     0,     0,     0,     1,     1,     0,     1,
-       0,     2,     1,     2,     1,     0,     3,     1,     1,     3,
-       3,     3,     1,     2,     3,     1,     3,     5,     6,     3,
-       3,     5,     2,     4,     0,     5,     1,     1,     5,     4,
-       5,     4,     5,     6,     5,     4,     5,     4,     3,     6,
-       4,     5,     3,     3,     3,     3,     3,     3,     3,     3,
-       3,     3,     3,     3,     3,     3,     2,     2,     2,     2,
-       2,     2,     2,     2,     2,     3,     2,     4,     3,     5,
-       8,     2,     2,     1,     1,     1,     1,     5,     2,     3,
-       1,     2,     3,     1,     2,     1,     1,     1,     1,     1,
-       1,     4,     4,     5,     5,     1,     1,     3,     4,     3,
-       4,     4,     4,     4,     4,     1,     2,     2,     1,     2,
-       2,     1,     2,     1,     2,     1,     3,     1,     3,     1,
-       3,     4,     0,     6,     1,     1,     1,     1,     3,     2,
-       4,     3,     2,     1,     1,     1,     0,     1,     0,     1,
-       0,     2,     1,     1,     1,     1,     1,     1,     2,     2,
-       2,     2,     2,     2,     2,     4,     2,     1,     3,     1,
-       3,     1,     3,     1,     1,     1,     1
+       0,     2,     1,     2,     1,     0,     1,     1,     1,     3,
+       0,     1,     2,     3,     1,     1,     2,     3,     1,     0,
+       1,     0,     4,     1,     1,     3,     3,     3,     1,     2,
+       3,     1,     3,     5,     6,     3,     3,     5,     2,     4,
+       0,     5,     1,     1,     5,     4,     5,     4,     5,     6,
+       5,     4,     5,     4,     3,     6,     4,     5,     3,     3,
+       3,     3,     3,     3,     3,     3,     3,     3,     3,     3,
+       3,     3,     2,     2,     2,     2,     2,     2,     2,     2,
+       2,     3,     2,     4,     3,     5,     8,     2,     2,     1,
+       1,     1,     1,     5,     2,     3,     1,     2,     3,     1,
+       2,     1,     1,     1,     1,     1,     1,     4,     4,     5,
+       5,     1,     1,     3,     4,     3,     4,     4,     4,     4,
+       4,     1,     2,     2,     1,     2,     2,     1,     2,     1,
+       2,     1,     3,     1,     3,     1,     3,     4,     0,     6,
+       1,     1,     1,     1,     3,     2,     4,     3,     2,     1,
+       1,     1,     0,     1,     0,     1,     0,     2,     1,     1,
+       1,     1,     1,     1,     2,     2,     2,     2,     2,     2,
+       2,     4,     2,     1,     3,     1,     3,     1,     3,     1,
+       1,     1,     1
 };
 
 typedef enum {
@@ -1091,15 +1098,17 @@ static const toketypes yy_type_tab[] =
   toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival,
   toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival,
   toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval,
-  toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval,
-  toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval,
-  toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval,
+  toketype_opval, toketype_opval, toketype_ival, toketype_opval,
   toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval,
-  toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval,
-  toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval
+  toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval,
+  toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval,
+  toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval,
+  toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival,
+  toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval,
+  toketype_opval, toketype_opval
 };
 
 /* Generated from:
- * fba24dfc68a3a84c9ae95cb9e14cc156ac487e6f3228cdf84c166d3cd820e59a perly.y
+ * 1a8fc0f841dee6e563463a6b91bf9c410b47437c760f485a16d87ade3d66bf1d perly.y
  * 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl
  * ex: set ro: */
diff --git a/perly.y b/perly.y
index 6eb4b23aad190e99051b79afb144052f2e0410c3..ff14780c9c031d429df433dd0911015852c4b63e 100644 (file)
--- a/perly.y
+++ b/perly.y
 %type <opval> formname subname proto optsubbody cont my_scalar my_var
 %type <opval> refgen_topic formblock
 %type <opval> subattrlist myattrlist myattrterm myterm
-%type <opval> subsignature termbinop termunop anonymous termdo
+%type <opval> termbinop termunop anonymous termdo
+%type <ival>  sigslurpsigil
+%type <opval> sigvarname sigdefault sigscalarelem sigslurpelem
+%type <opval> sigelem siglist siglistornull subsignature 
 %type <opval> formstmtseq formline formarg
 
 %nonassoc <ival> PREC_LOW
@@ -628,25 +631,194 @@ myattrlist:      COLONATTR THING
                        { $$ = (OP*)NULL; }
        ;
 
-/* Subroutine signature */
-subsignature:  '('
-                       {
-                         /* We shouldn't get here otherwise */
-                         assert(FEATURE_SIGNATURES_IS_ENABLED);
 
-                         Perl_ck_warner_d(aTHX_
-                               packWARN(WARN_EXPERIMENTAL__SIGNATURES),
-                               "The signatures feature is experimental");
-                         $<opval>$ = parse_subsignature();
+
+/* --------------------------------------
+ * subroutine signature parsing
+ */
+
+/* the '' or 'foo' part of a '$' or '@foo' etc signature variable  */
+sigvarname:     /* NULL */
+                       { parser->in_my = 0; $$ = (OP*)NULL; }
+        |       PRIVATEREF
+                        { parser->in_my = 0; $$ = $1; }
+       ;
+
+sigslurpsigil:
+                '@'
+                        { $$ = '@'; }
+        |       '%'
+                        { $$ = '%'; }
+
+/* @, %, @foo, %foo */
+sigslurpelem: sigslurpsigil sigvarname sigdefault/* def only to catch errors */ 
+                        {
+                            I32 sigil   = $1;
+                            OP *var     = $2;
+                            OP *defexpr = $3;
+
+                            if (parser->sig_slurpy)
+                                yyerror("Multiple slurpy parameters not allowed");
+                            parser->sig_slurpy = (char)sigil;
+
+                            if (defexpr)
+                                yyerror("A slurpy parameter may not have "
+                                        "a default value");
+
+                            $$ = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
+                        }
+       ;
+
+/* default part of sub signature scalar element: i.e. '= default_expr' */
+sigdefault:    /* NULL */
+                       { $$ = (OP*)NULL; }
+        |       ASSIGNOP
+                        { $$ = newOP(OP_NULL, 0); }
+        |       ASSIGNOP term
+                        { $$ = $2; }
+
+
+/* subroutine signature scalar element: e.g. '$x', '$=', '$x = $default' */
+sigscalarelem:
+                '$' sigvarname sigdefault
+                        {
+                            OP *var     = $2;
+                            OP *defexpr = $3;
+
+                            if (parser->sig_slurpy)
+                                yyerror("Slurpy parameter not last");
+
+                            parser->sig_elems++;
+
+                            if (defexpr) {
+                                parser->sig_optelems++;
+
+                                if (   defexpr->op_type == OP_NULL
+                                    && !(defexpr->op_flags & OPf_KIDS))
+                                {
+                                    /* handle '$=' special case */
+                                    if (var)
+                                        yyerror("Optional parameter "
+                                                    "lacks default expression");
+                                    op_free(defexpr);
+                                }
+                                else { 
+                                    /* a normal '=default' expression */ 
+                                    OP *defop = (OP*)alloc_LOGOP(OP_ARGDEFELEM,
+                                                        defexpr,
+                                                        LINKLIST(defexpr));
+                                    /* re-purpose op_targ to hold @_ index */
+                                    defop->op_targ =
+                                        (PADOFFSET)(parser->sig_elems - 1);
+
+                                    if (var) {
+                                        var->op_flags |= OPf_STACKED;
+                                        (void)op_sibling_splice(var,
+                                                        NULL, 0, defop);
+                                        scalar(defop);
+                                    }
+                                    else
+                                        var = newUNOP(OP_NULL, 0, defop);
+
+                                    LINKLIST(var);
+                                    /* NB: normally the first child of a
+                                     * logop is executed before the logop,
+                                     * and it pushes a boolean result
+                                     * ready for the logop. For ARGDEFELEM,
+                                     * the op itself does the boolean
+                                     * calculation, so set the first op to
+                                     * it instead.
+                                     */
+                                    var->op_next = defop;
+                                    defexpr->op_next = var;
+                                }
+                            }
+                            else {
+                                if (parser->sig_optelems)
+                                    yyerror("Mandatory parameter "
+                                            "follows optional parameter");
+                            }
+
+                            $$ = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
+                        }
+       ;
+
+
+/* subroutine signature element: e.g. '$x = $default' or '%h' */
+sigelem:        sigscalarelem
+                        { parser->in_my = KEY_sigvar; $$ = $1; }
+        |       sigslurpelem
+                        { parser->in_my = KEY_sigvar; $$ = $1; }
+       ;
+
+/* list of subroutine signature elements */
+siglist:
+               siglist ','
+                       { $$ = $1; }
+       |       siglist ',' sigelem
+                       {
+                         $$ = op_append_list(OP_LINESEQ, $1, $3);
                        }
-               ')'
+        |      sigelem  %prec PREC_LOW
+                       { $$ = $1; }
+       ;
+
+/* () or (....) */
+siglistornull:         /* NULL */
+                       { $$ = (OP*)NULL; }
+       |       siglist
+                       { $$ = $1; }
+
+/* Subroutine signature */
+subsignature:  '('
+                        {
+                            ENTER;
+                            SAVEIV(parser->sig_elems);
+                            SAVEIV(parser->sig_optelems);
+                            SAVEI8(parser->sig_slurpy);
+                            parser->sig_elems    = 0;
+                            parser->sig_optelems = 0;
+                            parser->sig_slurpy   = 0;
+                            parser->in_my        = KEY_sigvar;
+                        }
+                siglistornull
+                ')'
                        {
-                         $$ = op_append_list(OP_LINESEQ, $<opval>2,
-                               newSTATEOP(0, NULL, sawparens(newNULLLIST())));
-                         parser->expect = XATTRBLOCK;
+                            OP            *sigops = $3;
+                            UNOP_AUX_item *aux;
+                            OP            *check;
+
+                            assert(FEATURE_SIGNATURES_IS_ENABLED);
+
+                            /* We shouldn't get here otherwise */
+                            Perl_ck_warner_d(aTHX_
+                                packWARN(WARN_EXPERIMENTAL__SIGNATURES),
+                                "The signatures feature is experimental");
+
+                            aux = (UNOP_AUX_item*)PerlMemShared_malloc(
+                                sizeof(UNOP_AUX_item) * 3);
+                            aux[0].iv = parser->sig_elems;
+                            aux[1].iv = parser->sig_optelems;
+                            aux[2].iv = parser->sig_slurpy;
+                            check = newUNOP_AUX(OP_ARGCHECK, 0, NULL, aux);
+                            sigops = op_prepend_elem(OP_LINESEQ, check, sigops);
+                            sigops = op_prepend_elem(OP_LINESEQ,
+                                                newSTATEOP(0, NULL, NULL),
+                                                sigops);
+                            /* a nextstate at the end handles context
+                             * correctly for an empty sub body */
+                            $$ = op_append_elem(OP_LINESEQ,
+                                                sigops,
+                                                newSTATEOP(0, NULL, NULL));
+
+                            parser->in_my = 0;
+                            parser->expect = XATTRBLOCK;
+                            LEAVE;
                        }
        ;
 
+
+
 /* Optional subroutine body, for named subroutine declaration */
 optsubbody:    block
        |       ';'     { $$ = (OP*)NULL; }
index b2305e797ad0f4a836ab6a8bb87cd0b56191cffb..776953734278d7b7b4a53d2b789504b3984b4fb6 100644 (file)
  *     This symbol contains the ~name expanded version of PRIVLIB, to be used
  *     in programs that are not prepared to deal with ~ expansion at run-time.
  */
-#define PRIVLIB "/sys/lib/perl/5.25.3"         /**/
-#define PRIVLIB_EXP "/sys/lib/perl/5.25.3"             /**/
+#define PRIVLIB "/sys/lib/perl/5.25.4"         /**/
+#define PRIVLIB_EXP "/sys/lib/perl/5.25.4"             /**/
 
 /* PTRSIZE:
  *     This symbol contains the size of a pointer, so that the C preprocessor
  *     removed.  The elements in inc_version_list (inc_version_list.U) can
  *     be tacked onto this variable to generate a list of directories to search.
  */
-#define SITELIB "/sys/lib/perl/5.25.3/site_perl"               /**/
-#define SITELIB_EXP "/sys/lib/perl/5.25.3/site_perl"           /**/
-#define SITELIB_STEM "/sys/lib/perl/5.25.3/site_perl"          /**/
+#define SITELIB "/sys/lib/perl/5.25.4/site_perl"               /**/
+#define SITELIB_EXP "/sys/lib/perl/5.25.4/site_perl"           /**/
+#define SITELIB_STEM "/sys/lib/perl/5.25.4/site_perl"          /**/
 
 /* Size_t_size:
  *     This symbol holds the size of a Size_t in bytes.
index 7dd1927395aa27708e228a4e3b1024e7e5aad90c..a89c918e5edd57eba8a9e5e1c50a4ed0b5b588a3 100644 (file)
@@ -32,12 +32,12 @@ alignbytes='4'
 ansi2knr=''
 aphostname='/bin/uname -n'
 api_revision='5'
-api_subversion='3'
+api_subversion='4'
 api_version='25'
-api_versionstring='5.25.3'
+api_versionstring='5.25.4'
 ar='ar'
-archlib='/sys/lib/perl5/5.25.3/386'
-archlibexp='/sys/lib/perl5/5.25.3/386'
+archlib='/sys/lib/perl5/5.25.4/386'
+archlibexp='/sys/lib/perl5/5.25.4/386'
 archname64=''
 archname='386'
 archobjs=''
@@ -233,6 +233,7 @@ d_fsync='define'
 d_ftello='undef'
 d_ftime='undef'
 d_futimes='undef'
+d_gai_strerror='undef'
 d_gdbm_ndbm_h_uses_prototypes='undef'
 d_gdbmndbm_h_uses_prototypes='undef'
 d_getaddrinfo='undef'
@@ -799,22 +800,23 @@ i_values='undef'
 i_varargs='undef'
 i_varhdr='stdarg.h'
 i_vfork='undef'
+i_xlocale='undef'
 ignore_versioned_solibs=''
 inc_version_list=' '
 inc_version_list_init='0'
 incpath=''
 inews=''
-installarchlib='/sys/lib/perl/5.25.3/386'
+installarchlib='/sys/lib/perl/5.25.4/386'
 installbin='/usr/bin'
 installman1dir='/sys/man/1pub'
 installman3dir='/sys/man/2pub'
 installprefix='/usr'
 installprefixexp='/usr'
-installprivlib='/sys/lib/perl/5.25.3'
+installprivlib='/sys/lib/perl/5.25.4'
 installscript='/usr/bin'
-installsitearch='/sys/lib/perl/5.25.3/site_perl/386'
+installsitearch='/sys/lib/perl/5.25.4/site_perl/386'
 installsitebin='/usr/bin'
-installsitelib='/sys/lib/perl/5.25.3/site_perl'
+installsitelib='/sys/lib/perl/5.25.4/site_perl'
 installstyle='lib/perl5'
 installusrbinperl='undef'
 installvendorarch=''
@@ -939,8 +941,8 @@ pmake=''
 pr=''
 prefix='/usr'
 prefixexp='/usr'
-privlib='/sys/lib/perl/5.25.3'
-privlibexp='/sys/lib/perl/5.25.3'
+privlib='/sys/lib/perl/5.25.4'
+privlibexp='/sys/lib/perl/5.25.4'
 procselfexe=''
 prototype='define'
 ptrsize='4'
@@ -1005,13 +1007,13 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 0'
 sig_size='50'
 signal_t='void'
-sitearch='/sys/lib/perl/5.25.3/site_perl/386'
+sitearch='/sys/lib/perl/5.25.4/site_perl/386'
 sitearchexp='/sys/lib/perl/site_perl/386'
 sitebin='/usr/bin'
 sitebinexp='/usr/bin'
-sitelib='/sys/lib/perl/5.25.3/site_perl'
-sitelib_stem='/sys/lib/perl/5.25.3/site_perl'
-sitelibexp='/sys/lib/perl/5.25.3/site_perl'
+sitelib='/sys/lib/perl/5.25.4/site_perl'
+sitelib_stem='/sys/lib/perl/5.25.4/site_perl'
+sitelibexp='/sys/lib/perl/5.25.4/site_perl'
 siteprefix='/usr'
 siteprefixexp='/usr'
 sizesize='4'
@@ -1044,7 +1046,7 @@ stdio_stream_array=''
 strerror_r_proto='0'
 strings='/sys/include/ape/string.h'
 submit=''
-subversion='3'
+subversion='4'
 sysman='/sys/man/1pub'
 tail=''
 tar=''
@@ -1126,8 +1128,8 @@ vendorlib_stem=''
 vendorlibexp=''
 vendorprefix=''
 vendorprefixexp=''
-version='5.25.3'
-version_patchlevel_string='version 25 subversion 3'
+version='5.25.4'
+version_patchlevel_string='version 25 subversion 4'
 versiononly='undef'
 vi=''
 xlibpth=''
@@ -1141,9 +1143,9 @@ config_args=''
 config_argc=0
 PERL_REVISION=5
 PERL_VERSION=25
-PERL_SUBVERSION=3
+PERL_SUBVERSION=4
 PERL_API_REVISION=5
 PERL_API_VERSION=25
-PERL_API_SUBVERSION=3
+PERL_API_SUBVERSION=4
 PERL_PATCHLEVEL=
 PERL_CONFIG_SH=true
index 286d32d0c66daefa0e57f971192dc22176b84108..50266bbeab1d1c4a68cfd88d601b999c34b5b47a 100644 (file)
@@ -53,7 +53,7 @@
 /roffitall
 
 # generated
-/perl5253delta.pod
+/perl5254delta.pod
 /perlapi.pod
 /perlintern.pod
 *.html
index 0cbaa8d990e399ec2541db0ccfcbbea99c18392e..f8bf742daa4382c1d94f435ad7ae0e649a0b128e 100644 (file)
@@ -180,6 +180,7 @@ aux c2ph h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp
 
     perlhist           Perl history records
     perldelta          Perl changes since previous version
+    perl5253delta      Perl changes in version 5.25.3
     perl5252delta      Perl changes in version 5.25.2
     perl5251delta      Perl changes in version 5.25.1
     perl5250delta      Perl changes in version 5.25.0
diff --git a/pod/perl5253delta.pod b/pod/perl5253delta.pod
new file mode 100644 (file)
index 0000000..bc1b375
--- /dev/null
@@ -0,0 +1,492 @@
+=encoding utf8
+
+=head1 NAME
+
+perl5253delta - what is new for perl v5.25.3
+
+=head1 DESCRIPTION
+
+This document describes differences between the 5.25.2 release and the 5.25.3
+release.
+
+If you are upgrading from an earlier release such as 5.25.1, first read
+L<perl5252delta>, which describes differences between 5.25.1 and 5.25.2.
+
+=head1 Core Enhancements
+
+=head2 Unicode 9.0 is now supported
+
+A list of changes is at L<http://www.unicode.org/versions/Unicode9.0.0/>.
+Modules that are shipped with core Perl but not maintained by p5p do not
+necessarily support Unicode 9.0.  L<Unicode::Normalize> does work on 9.0.
+
+=head2 Use of C<\p{I<script>}> uses the improved Script_Extensions property
+
+Unicode 6.0 introduced an improved form of the Script (C<sc>) property, and
+called it Script_Extensions (C<scx>).  As of now, Perl uses this improved
+version when a property is specified as just C<\p{I<script>}>.  The meaning of
+compound forms, like C<\p{sc=I<script>}> are unchanged.  This should make
+programs be more accurate when determining if a character is used in a given
+script, but there is a slight chance of breakage for programs that very
+specifically needed the old behavior.  See L<perlunicode/Scripts>.
+
+=head2 Declaring a reference to a variable
+
+As an experimental feature, Perl now allows the referencing operator to come
+after L<C<my()>|perlfunc/my>, L<C<state()>|perlfunc/state>,
+L<C<our()>|perlfunc/our>, or L<C<local()>|perlfunc/local>.  This syntax must
+be enabled with C<use feature 'declared_refs'>.  It is experimental, and will
+warn by default unless C<no warnings 'experimental::refaliasing'> is in effect.
+It is intended mainly for use in assignments to references.  For example:
+
+    use experimental 'refaliasing', 'declared_refs';
+    my \$a = \$b;
+
+See L<perlref/Assigning to References> for slightly more detail.
+
+=head1 Incompatible Changes
+
+=head2 C<${^ENCODING}> has been removed
+
+Consequently, the L<encoding> pragma's default mode is no longer supported.  If
+you still need to write your source code in encodings other than UTF-8, use a
+source filter such as L<Filter::Encoding> on CPAN or L<encoding>'s C<Filter>
+option.
+
+=head2 C<scalar(%hash)> return signature changed
+
+The value returned for C<scalar(%hash)> will no longer show information about
+the buckets allocated in the hash.  It will simply return the count of used
+keys.  It is thus equivalent to C<0+keys(%hash)>.
+
+A form of backwards compatibility is provided via C<Hash::Util::bucket_ratio()>
+which provides the same behavior as C<scalar(%hash)> provided prior to Perl
+5.25.
+
+=head1 Modules and Pragmata
+
+=head2 Updated Modules and Pragmata
+
+=over 4
+
+=item *
+
+L<bignum> has been upgraded from version 0.42 to 0.43.
+
+=item *
+
+L<Data::Dumper> has been upgraded from version 2.160 to 2.161.
+
+=item *
+
+L<Devel::PPPort> has been upgraded from version 3.32 to 3.35.
+
+=item *
+
+L<Encode> has been upgraded from version 2.80 to 2.84.
+
+=item *
+
+L<encoding> has been upgraded from version 2.17 to 2.17_01.
+
+This module's default mode is no longer supported as of Perl 5.25.3.  It now
+dies when imported, unless the C<Filter> option is being used.
+
+=item *
+
+L<encoding::warnings> has been upgraded from version 0.12 to 0.13.
+
+This module is no longer supported as of Perl 5.25.3.  It emits a warning to
+that effect and then does nothing.
+
+=item *
+
+L<ExtUtils::ParseXS> has been upgraded from version 3.32 to 3.33.
+
+=item *
+
+L<ExtUtils::Typemaps> has been upgraded from version 3.32 to 3.33.
+
+=item *
+
+L<feature> has been upgraded from version 1.44 to 1.45.
+
+=item *
+
+L<Hash::Util> has been upgraded from version 0.19 to 0.20.
+
+=item *
+
+L<Math::BigInt> has been upgraded from version 1.999715 to 1.999726.
+
+=item *
+
+L<Math::BigInt::FastCalc> has been upgraded from version 0.40 to 0.42.
+
+=item *
+
+L<Math::BigRat> has been upgraded from version 0.260802 to 0.260804.
+
+=item *
+
+L<Module::CoreList> has been upgraded from version 5.20160620 to 5.20160720.
+
+=item *
+
+L<Parse::CPAN::Meta> has been upgraded from version 1.4417 to 1.4422.
+
+=item *
+
+L<Perl::OSType> has been upgraded from version 1.009 to 1.010.
+
+=item *
+
+L<Test::Simple> has been upgraded from version 1.302026 to 1.302045.
+
+=item *
+
+L<Time::HiRes> has been upgraded from version 1.9734 to 1.9739.
+
+=item *
+
+L<Unicode::UCD> has been upgraded from version 0.65 to 0.66.
+
+=item *
+
+L<version> has been upgraded from version 0.9916 to 0.9917.
+
+=item *
+
+L<warnings> has been upgraded from version 1.36 to 1.37.
+
+=item *
+
+L<XSLoader> has been upgraded from version 0.21 to 0.22, fixing a security hole
+in which binary files could be loaded from a path outside of
+L<C<@INC>|perlvar/@INC>.
+
+=back
+
+=head1 Documentation
+
+=head2 Changes to Existing Documentation
+
+=head3 L<perldata> and L<perltie>
+
+=over 4
+
+=item *
+
+Updated documentation of C<scalar(%hash)>.  See L</scalar(%hash) return
+signature changed> above.
+
+=back
+
+=head3 L<perlexperiment> and L<perlref>
+
+=over 4
+
+=item *
+
+Documented new feature: See L</Declaring a reference to a variable> above.
+
+=back
+
+=head3 L<perlfunc>
+
+=over 4
+
+=item *
+
+Clarified documentation of L<C<seek()>|perlfunc/seek>,
+L<C<tell()>|perlfunc/tell> and L<C<sysseek()>|perlfunc/sysseek>.
+L<[perl #128607]|https://rt.perl.org/Public/Bug/Display.html?id=128607>
+
+=item *
+
+Removed obsolete documentation of L<C<study()>|perlfunc/study>.
+
+=back
+
+=head3 L<perlunicode>
+
+=over 4
+
+=item *
+
+Documented change to C<\p{I<script>}> to now use the improved Script_Extensions
+property.  See L</Use of \p{script} uses the improved Script_Extensions
+property> above.
+
+=item *
+
+Updated the text to correspond with changes in Unicode UTS#18, concerning
+regular expressions, and Perl compatibility with what it says.
+
+=back
+
+=head3 L<perlvar>
+
+=over 4
+
+=item *
+
+Removed obsolete documentation of C<${^ENCODING}>.  See L</${^ENCODING} has
+been removed> above.
+
+=back
+
+=head1 Diagnostics
+
+The following additions or changes have been made to diagnostic output,
+including warnings and fatal error messages.  For the complete list of
+diagnostic messages, see L<perldiag>.
+
+=head2 New Diagnostics
+
+=head3 New Errors
+
+=over 4
+
+=item *
+
+L<The experimental declared_refs feature is not enabled|perldiag/"The experimental declared_refs feature is not enabled">
+
+(F) To declare references to variables, as in C<my \%x>, you must first enable
+the feature:
+
+    no warnings "experimental::declared_refs";
+    use feature "declared_refs";
+
+=back
+
+=head3 New Warnings
+
+=over 4
+
+=item *
+
+L<Declaring references is experimental|perldiag/"Declaring references is experimental">
+
+(S experimental::declared_refs) This warning is emitted if you use a reference
+constructor on the right-hand side of C<my()>, C<state()>, C<our()>, or
+C<local()>.  Simply suppress the warning if you want to use the feature, but
+know that in doing so you are taking the risk of using an experimental feature
+which may change or be removed in a future Perl version:
+
+    no warnings "experimental::declared_refs";
+    use feature "declared_refs";
+    $fooref = my \$foo;
+
+=item *
+
+L<C<${^ENCODING}> is no longer supported|perldiag/"${^ENCODING} is no longer supported">
+
+(D deprecated) The special variable C<${^ENCODING}>, formerly used to implement
+the C<encoding> pragma, is no longer supported as of Perl 5.26.0.
+
+=back
+
+=head1 Configuration and Compilation
+
+=over 4
+
+=item *
+
+F<Configure> now aborts if both "-Duselongdouble" and "-Dusequadmath" are
+requested.
+L<[perl #126203]|https://rt.perl.org/Public/Bug/Display.html?id=126203>
+
+=item *
+
+Fixed a bug in which F<Configure> could append "-quadmath" to the archname even
+if it was already present.
+L<[perl #128538]|https://rt.perl.org/Public/Bug/Display.html?id=128538>
+
+=item *
+
+Clang builds with "-DPERL_GLOBAL_STRUCT" or "-DPERL_GLOBAL_STRUCT_PRIVATE" have
+been fixed (by disabling Thread Safety Analysis for these configurations).
+
+=back
+
+=head1 Testing
+
+=over 4
+
+=item *
+
+A new test script, F<t/op/decl-refs.t>, has been added to test the new feature,
+"Declaring a reference to a variable".
+
+=item *
+
+A new test script, F<t/re/anyof.t>, has been added to test that the ANYOF nodes
+generated by bracketed character classes are as expected.
+
+=back
+
+=head1 Platform Support
+
+=head2 Platform-Specific Notes
+
+=over 4
+
+=item VAX
+
+VAX floating point formats are now supported.
+
+=back
+
+=head1 Selected Bug Fixes
+
+=over 4
+
+=item *
+
+An assertion failure with C<%: = 0> has been fixed.
+L<[perl #128238]|https://rt.perl.org/Public/Bug/Display.html?id=128238>
+
+=item *
+
+In Perl 5.18, the parsing of C<"$foo::$bar"> was accidentally changed, such
+that it would be treated as C<$foo."::".$bar>.  The previous behavior, which
+was to parse it as C<$foo:: . $bar>, has been restored.
+L<[perl #128478]|https://rt.perl.org/Public/Bug/Display.html?id=128478>
+
+=item *
+
+Since Perl 5.20, line numbers have been off by one when perl is invoked with
+the B<-x> switch.  This has been fixed.
+L<[perl #128508]|https://rt.perl.org/Public/Bug/Display.html?id=128508>
+
+=item *
+
+Vivifying a subroutine stub in a deleted stash (e.g., C<delete $My::{"Foo::"};
+\&My::Foo::foo>) no longer crashes.  It had begun crashing in Perl 5.18.
+L<[perl #128532]|https://rt.perl.org/Public/Bug/Display.html?id=128532>
+
+=item *
+
+Some obscure cases of subroutines and file handles being freed at the same time
+could result in crashes, but have been fixed.  The crash was introduced in Perl
+5.22.
+L<[perl #128597]|https://rt.perl.org/Public/Bug/Display.html?id=128597>
+
+=item *
+
+Code that looks for a variable name associated with an uninitialized value
+could cause an assertion in cases where magic is involved, such as
+C<$ISA[0][0]>.  This has now been fixed.
+L<[perl #128253]|https://rt.perl.org/Public/Bug/Display.html?id=128253>
+
+=item *
+
+A crash caused by code generating the warning "Subroutine STASH::NAME
+redefined" in cases such as C<sub P::f{} undef *P::; *P::f =sub{};> has been
+fixed.  In these cases, where the STASH is missing, the warning will now appear
+as "Subroutine NAME redefined".
+L<[perl #128257]|https://rt.perl.org/Public/Bug/Display.html?id=128257>
+
+=item *
+
+Fixed an assertion triggered by some code that handles deprecated behavior in
+formats, e.g. in cases like this:
+
+    format STDOUT =
+    @
+    0"$x"
+
+L<[perl #128255]|https://rt.perl.org/Public/Bug/Display.html?id=128255>
+
+=item *
+
+A possible divide by zero in string transformation code on Windows has been
+avoided, fixing a crash when collating an empty string.
+L<[perl #128618]|https://rt.perl.org/Public/Bug/Display.html?id=128618>
+
+=item *
+
+Some regular expression parsing glitches could lead to assertion failures with
+regular expressions such as C</(?<=/> and C</(?<!/>.  This has now been fixed.
+L<[perl #128170]|https://rt.perl.org/Public/Bug/Display.html?id=128170>
+
+=back
+
+=head1 Errata From Previous Releases
+
+=over 4
+
+=item *
+
+Parsing bad POSIX charclasses no longer leaks memory.  This was fixed in Perl
+5.25.2
+L<[perl #128313]|https://rt.perl.org/Public/Bug/Display.html?id=128313>
+
+=item *
+
+Fixed issues with recursive regexes.  The behavior was fixed in Perl 5.24.0.
+L<[perl #126182]|https://rt.perl.org/Public/Bug/Display.html?id=126182>
+
+=back
+
+=head1 Acknowledgements
+
+Perl 5.25.3 represents approximately 4 weeks of development since Perl 5.25.2
+and contains approximately 67,000 lines of changes across 510 files from 25
+authors.
+
+Excluding auto-generated files, documentation and release tools, there were
+approximately 40,000 lines of changes to 290 .pm, .t, .c and .h files.
+
+Perl continues to flourish into its third decade thanks to a vibrant community
+of users and developers.  The following people are known to have contributed
+the improvements that became Perl 5.25.3:
+
+Aaron Crane, Ævar Arnfjörð Bjarmason, Alex Vandiver, Aristotle Pagaltzis,
+Chad Granum, Chris 'BinGOs' Williams, Chris Lamb, Craig A. Berry, Dan Collins,
+David Mitchell, Father Chrysostomos, H.Merijn Brand, Jarkko Hietaniemi, Karl
+Williamson, Lukas Mai, Matthew Horsfall, Salvador Fandiño, Sawyer X,
+Sébastien Aperghis-Tramoni, Steffen Müller, Steve Hay, Todd Rinaldo, Tony
+Cook, Unicode Consortium, Yves Orton.
+
+The list above is almost certainly incomplete as it is automatically generated
+from version control history.  In particular, it does not include the names of
+the (very much appreciated) contributors who reported issues to the Perl bug
+tracker.
+
+Many of the changes included in this version originated in the CPAN modules
+included in Perl's core.  We're grateful to the entire CPAN community for
+helping Perl to flourish.
+
+For a more complete list of all of Perl's historical contributors, please see
+the F<AUTHORS> file in the Perl source distribution.
+
+=head1 Reporting Bugs
+
+If you find what you think is a bug, you might check the perl bug database at
+L<https://rt.perl.org/> .  There may also be information at
+L<http://www.perl.org/> , the Perl Home Page.
+
+If you believe you have an unreported bug, please run the L<perlbug> program
+included with your release.  Be sure to trim your bug down to a tiny but
+sufficient test case.  Your bug report, along with the output of C<perl -V>,
+will be sent off to perlbug@perl.org to be analysed by the Perl porting team.
+
+If the bug you are reporting has security implications which make it
+inappropriate to send to a publicly archived mailing list, then see
+L<perlsec/SECURITY VULNERABILITY CONTACT INFORMATION> for details of how to
+report the issue.
+
+=head1 SEE ALSO
+
+The F<Changes> file for an explanation of how to view exhaustive details on
+what changed.
+
+The F<INSTALL> file for how to build Perl.
+
+The F<README> file for general stuff.
+
+The F<Artistic> and F<Copying> files for copyright information.
+
+=cut
index c41d8357911e97eb930204e019b2265f7159c191..9a268aa4c10aa046b3088fae120facdf7734ccc9 100644 (file)
@@ -1223,8 +1223,6 @@ I<PrintList>.
     static void
     call_PrintList()
     {
-        dSP;
-
         call_argv("PrintList", G_DISCARD, words);
     }
 
index 2607446c7dda8a83ad936864a3877be020188d12..0846821cf7a4de53b73e5cdb77d6c84cc8fe754a 100644 (file)
@@ -2,66 +2,41 @@
 
 =head1 NAME
 
-perldelta - what is new for perl v5.25.3
+perldelta - what is new for perl v5.25.4
 
 =head1 DESCRIPTION
 
-This document describes differences between the 5.25.2 release and the 5.25.3
+This document describes differences between the 5.25.3 release and the 5.25.4
 release.
 
-If you are upgrading from an earlier release such as 5.25.1, first read
-L<perl5252delta>, which describes differences between 5.25.1 and 5.25.2.
+If you are upgrading from an earlier release such as 5.25.2, first read
+L<perl5253delta>, which describes differences between 5.25.2 and 5.25.3.
 
-=head1 Core Enhancements
+=head1 Performance Enhancements
 
-=head2 Unicode 9.0 is now supported
-
-A list of changes is at L<http://www.unicode.org/versions/Unicode9.0.0/>.
-Modules that are shipped with core Perl but not maintained by p5p do not
-necessarily support Unicode 9.0.  L<Unicode::Normalize> does work on 9.0.
-
-=head2 Use of C<\p{I<script>}> uses the improved Script_Extensions property
-
-Unicode 6.0 introduced an improved form of the Script (C<sc>) property, and
-called it Script_Extensions (C<scx>).  As of now, Perl uses this improved
-version when a property is specified as just C<\p{I<script>}>.  The meaning of
-compound forms, like C<\p{sc=I<script>}> are unchanged.  This should make
-programs be more accurate when determining if a character is used in a given
-script, but there is a slight chance of breakage for programs that very
-specifically needed the old behavior.  See L<perlunicode/Scripts>.
+=over 4
 
-=head2 Declaring a reference to a variable
+=item *
 
-As an experimental feature, Perl now allows the referencing operator to come
-after L<C<my()>|perlfunc/my>, L<C<state()>|perlfunc/state>,
-L<C<our()>|perlfunc/our>, or L<C<local()>|perlfunc/local>.  This syntax must
-be enabled with C<use feature 'declared_refs'>.  It is experimental, and will
-warn by default unless C<no warnings 'experimental::refaliasing'> is in effect.
-It is intended mainly for use in assignments to references.  For example:
+The rather slow implementation for the experimental subroutine signatures
+feature has been made much faster; it is now comparable in speed with the
+old-style C<my ($a, $b, @c) = @_>.
 
-    use experimental 'refaliasing', 'declared_refs';
-    my \$a = \$b;
+=back
 
-See L<perlref/Assigning to References> for slightly more detail.
+=head1 Documentation
 
-=head1 Incompatible Changes
+=head2 Changes to Existing Documentation
 
-=head2 C<${^ENCODING}> has been removed
+=head3 L<perlcall>
 
-Consequently, the L<encoding> pragma's default mode is no longer supported.  If
-you still need to write your source code in encodings other than UTF-8, use a
-source filter such as L<Filter::Encoding> on CPAN or L<encoding>'s C<Filter>
-option.
+=over 4
 
-=head2 C<scalar(%hash)> return signature changed
+=item *
 
-The value returned for C<scalar(%hash)> will no longer show information about
-the buckets allocated in the hash.  It will simply return the count of used
-keys.  It is thus equivalent to C<0+keys(%hash)>.
+Removed redundant C<dSP> from an example.
 
-A form of backwards compatibility is provided via C<Hash::Util::bucket_ratio()>
-which provides the same behavior as C<scalar(%hash)> provided prior to Perl
-5.25.
+=back
 
 =head1 Modules and Pragmata
 
@@ -71,258 +46,200 @@ which provides the same behavior as C<scalar(%hash)> provided prior to Perl
 
 =item *
 
-L<bignum> has been upgraded from version 0.42 to 0.43.
+L<Archive::Tar> has been upgraded from version 2.08 to 2.10.
 
 =item *
 
-L<Data::Dumper> has been upgraded from version 2.160 to 2.161.
+L<arybase> has been upgraded from version 0.11 to 0.12.
 
 =item *
 
-L<Devel::PPPort> has been upgraded from version 3.32 to 3.35.
+L<B> has been upgraded from version 1.62 to 1.63.
 
 =item *
 
-L<Encode> has been upgraded from version 2.80 to 2.84.
+L<B::Concise> has been upgraded from version 0.996 to 0.998.
 
 =item *
 
-L<encoding> has been upgraded from version 2.17 to 2.17_01.
-
-This module's default mode is no longer supported as of Perl 5.25.3.  It now
-dies when imported, unless the C<Filter> option is being used.
+L<B::Deparse> has been upgraded from version 1.37 to 1.38.
 
 =item *
 
-L<encoding::warnings> has been upgraded from version 0.12 to 0.13.
-
-This module is no longer supported as of Perl 5.25.3.  It emits a warning to
-that effect and then does nothing.
+L<base> has been upgraded from version 2.23 to 2.24.
 
 =item *
 
-L<ExtUtils::ParseXS> has been upgraded from version 3.32 to 3.33.
+L<bignum> has been upgraded from version 0.43 to 0.43_01.
 
 =item *
 
-L<ExtUtils::Typemaps> has been upgraded from version 3.32 to 3.33.
+L<Carp> has been upgraded from version 1.41 to 1.42.
 
 =item *
 
-L<feature> has been upgraded from version 1.44 to 1.45.
+L<Config::Perl::V> has been upgraded from version 0.26 to 0.27.
 
 =item *
 
-L<Hash::Util> has been upgraded from version 0.19 to 0.20.
+L<CPAN> has been upgraded from version 2.14 to 2.14_01.
 
 =item *
 
-L<Math::BigInt> has been upgraded from version 1.999715 to 1.999726.
+L<CPAN::Meta> has been upgraded from version 2.150005 to 2.150010.
 
 =item *
 
-L<Math::BigInt::FastCalc> has been upgraded from version 0.40 to 0.42.
+L<Digest> has been upgraded from version 1.17 to 1.17_01.
 
 =item *
 
-L<Math::BigRat> has been upgraded from version 0.260802 to 0.260804.
+L<Digest::SHA> has been upgraded from version 5.95 to 5.96.
 
 =item *
 
-L<Module::CoreList> has been upgraded from version 5.20160620 to 5.20160720.
+L<Encode> has been upgraded from version 2.84 to 2.86.
 
 =item *
 
-L<Parse::CPAN::Meta> has been upgraded from version 1.4417 to 1.4422.
+L<encoding> has been upgraded from version 2.17_01 to 2.18.
 
 =item *
 
-L<Perl::OSType> has been upgraded from version 1.009 to 1.010.
+L<Errno> has been upgraded from version 1.25 to 1.26.
 
 =item *
 
-L<Test::Simple> has been upgraded from version 1.302026 to 1.302045.
+L<ExtUtils::MakeMaker> has been upgraded from version 7.18 to 7.24.
 
 =item *
 
-L<Time::HiRes> has been upgraded from version 1.9734 to 1.9739.
+L<File::Fetch> has been upgraded from version 0.48 to 0.52.
 
 =item *
 
-L<Unicode::UCD> has been upgraded from version 0.65 to 0.66.
+L<File::Spec> has been upgraded from version 3.64 to 3.65.
 
 =item *
 
-L<version> has been upgraded from version 0.9916 to 0.9917.
+L<Hash::Util> has been upgraded from version 0.20 to 0.21.
 
 =item *
 
-L<warnings> has been upgraded from version 1.36 to 1.37.
+L<HTTP::Tiny> has been upgraded from version 0.058 to 0.064.
 
 =item *
 
-L<XSLoader> has been upgraded from version 0.21 to 0.22, fixing a security hole
-in which binary files could be loaded from a path outside of
-L<C<@INC>|perlvar/@INC>.
-
-=back
-
-=head1 Documentation
-
-=head2 Changes to Existing Documentation
-
-=head3 L<perldata> and L<perltie>
-
-=over 4
+L<I18N::LangTags> has been upgraded from version 0.40 to 0.41.
 
 =item *
 
-Updated documentation of C<scalar(%hash)>.  See L</scalar(%hash) return
-signature changed> above.
-
-=back
-
-=head3 L<perlexperiment> and L<perlref>
-
-=over 4
+L<IO> has been upgraded from version 1.36 to 1.37.
 
 =item *
 
-Documented new feature: See L</Declaring a reference to a variable> above.
+L<IO-Compress> has been upgraded from version 2.069 to 2.069_01.
 
-=back
+=item *
 
-=head3 L<perlfunc>
-
-=over 4
+L<IO::Socket::IP> has been upgraded from version 0.37 to 0.38.
 
 =item *
 
-Clarified documentation of L<C<seek()>|perlfunc/seek>,
-L<C<tell()>|perlfunc/tell> and L<C<sysseek()>|perlfunc/sysseek>.
-L<[perl #128607]|https://rt.perl.org/Public/Bug/Display.html?id=128607>
+L<IPC::Cmd> has been upgraded from version 0.94 to 0.96.
 
 =item *
 
-Removed obsolete documentation of L<C<study()>|perlfunc/study>.
+L<JSON::PP> has been upgraded from version 2.27400 to 2.27400_01.
 
-=back
-
-=head3 L<perlunicode>
+=item *
 
-=over 4
+L<Locale::Maketext> has been upgraded from version 1.27 to 1.28.
 
 =item *
 
-Documented change to C<\p{I<script>}> to now use the improved Script_Extensions
-property.  See L</Use of \p{script} uses the improved Script_Extensions
-property> above.
+L<Locale::Maketext::Simple> has been upgraded from version 0.21 to 0.21_01.
 
 =item *
 
-Updated the text to correspond with changes in Unicode UTS#18, concerning
-regular expressions, and Perl compatibility with what it says.
-
-=back
+L<Memoize> has been upgraded from version 1.03 to 1.03_01.
 
-=head3 L<perlvar>
+=item *
 
-=over 4
+L<Module::CoreList> has been upgraded from version 5.20160720 to 5.20160820.
 
 =item *
 
-Removed obsolete documentation of C<${^ENCODING}>.  See L</${^ENCODING} has
-been removed> above.
+L<Module::Load::Conditional> has been upgraded from version 0.64 to 0.68.
 
-=back
+=item *
 
-=head1 Diagnostics
+L<Module::Metadata> has been upgraded from version 1.000032 to 1.000033.
 
-The following additions or changes have been made to diagnostic output,
-including warnings and fatal error messages.  For the complete list of
-diagnostic messages, see L<perldiag>.
+=item *
 
-=head2 New Diagnostics
+L<Net::Ping> has been upgraded from version 2.43 to 2.44.
 
-=head3 New Errors
+=item *
 
-=over 4
+L<NEXT> has been upgraded from version 0.65 to 0.67.
 
 =item *
 
-L<The experimental declared_refs feature is not enabled|perldiag/"The experimental declared_refs feature is not enabled">
-
-(F) To declare references to variables, as in C<my \%x>, you must first enable
-the feature:
+L<Opcode> has been upgraded from version 1.35 to 1.37.
 
-    no warnings "experimental::declared_refs";
-    use feature "declared_refs";
+=item *
 
-=back
+L<Pod::Html> has been upgraded from version 1.22 to 1.2201.
 
-=head3 New Warnings
+=item *
 
-=over 4
+L<Pod::Perldoc> has been upgraded from version 3.25_02 to 3.27.
 
 =item *
 
-L<Declaring references is experimental|perldiag/"Declaring references is experimental">
+L<POSIX> has been upgraded from version 1.70 to 1.71.
 
-(S experimental::declared_refs) This warning is emitted if you use a reference
-constructor on the right-hand side of C<my()>, C<state()>, C<our()>, or
-C<local()>.  Simply suppress the warning if you want to use the feature, but
-know that in doing so you are taking the risk of using an experimental feature
-which may change or be removed in a future Perl version:
+=item *
 
-    no warnings "experimental::declared_refs";
-    use feature "declared_refs";
-    $fooref = my \$foo;
+L<Storable> has been upgraded from version 2.56 to 2.57.
 
 =item *
 
-L<C<${^ENCODING}> is no longer supported|perldiag/"${^ENCODING} is no longer supported">
+L<Sys::Syslog> has been upgraded from version 0.34 to 0.34_01.
 
-(D deprecated) The special variable C<${^ENCODING}>, formerly used to implement
-the C<encoding> pragma, is no longer supported as of Perl 5.26.0.
+=item *
 
-=back
+L<Test> has been upgraded from version 1.28 to 1.29.
 
-=head1 Configuration and Compilation
+=item *
 
-=over 4
+L<Test::Harness> has been upgraded from version 3.36 to 3.36_01.
 
 =item *
 
-F<Configure> now aborts if both "-Duselongdouble" and "-Dusequadmath" are
-requested.
-L<[perl #126203]|https://rt.perl.org/Public/Bug/Display.html?id=126203>
+L<Test::Simple> has been upgraded from version 1.302045 to 1.302052.
 
 =item *
 
-Fixed a bug in which F<Configure> could append "-quadmath" to the archname even
-if it was already present.
-L<[perl #128538]|https://rt.perl.org/Public/Bug/Display.html?id=128538>
+L<Tie::Hash::NamedCapture> has been upgraded from version 0.09 to 0.10.
 
 =item *
 
-Clang builds with "-DPERL_GLOBAL_STRUCT" or "-DPERL_GLOBAL_STRUCT_PRIVATE" have
-been fixed (by disabling Thread Safety Analysis for these configurations).
+L<Time::Local> has been upgraded from version 1.2300 to 1.24.
 
 =back
 
-=head1 Testing
+=head1 Configuration and Compilation
 
 =over 4
 
 =item *
 
-A new test script, F<t/op/decl-refs.t>, has been added to test the new feature,
-"Declaring a reference to a variable".
-
-=item *
-
-A new test script, F<t/re/anyof.t>, has been added to test that the ANYOF nodes
-generated by bracketed character classes are as expected.
+A probe for C<gai_strerror> was added to F<Configure> that checks if the
+the gai_strerror() routine is available and can be used to
+translate error codes returned by getaddrinfo() into human
+readable strings.
 
 =back
 
@@ -332,131 +249,151 @@ generated by bracketed character classes are as expected.
 
 =over 4
 
-=item VAX
+=item Hurd
 
-VAX floating point formats are now supported.
+The hints for Hurd have been improved enabling malloc wrap and reporting the
+GNU libc used (previously it was an empty string when reported).
 
 =back
 
-=head1 Selected Bug Fixes
+=head1 Internal Changes
 
 =over 4
 
 =item *
 
-An assertion failure with C<%: = 0> has been fixed.
-L<[perl #128238]|https://rt.perl.org/Public/Bug/Display.html?id=128238>
+Three new ops, C<OP_ARGELEM>, C<OP_ARGDEFELEM> and C<OP_ARGCHECK> have
+been added. These are intended principally to implement the individual
+elements of a subroutine signature, plus any overall checking required.
+
+=back
+
+=head1 Selected Bug Fixes
+
+=over 4
 
 =item *
 
-In Perl 5.18, the parsing of C<"$foo::$bar"> was accidentally changed, such
-that it would be treated as C<$foo."::".$bar>.  The previous behavior, which
-was to parse it as C<$foo:: . $bar>, has been restored.
-L<[perl #128478]|https://rt.perl.org/Public/Bug/Display.html?id=128478>
+Problems with in-place array sorts: code like C<@a = sort { ... } @a>,
+where the source and destination of the sort are the same plain array, are
+optimised to do less copying around. Two side-effects of this optimisation
+were that the contents of C<@a> as visible to to sort routine were
+partially sorted, and under some circumstances accessing C<@a> during the
+sort could crash the interpreter. Both these issues have been fixed, and
+Sort functions see the original value of C<@a>.
 
 =item *
 
-Since Perl 5.20, line numbers have been off by one when perl is invoked with
-the B<-x> switch.  This has been fixed.
-L<[perl #128508]|https://rt.perl.org/Public/Bug/Display.html?id=128508>
+Non-ASCII string delimiters are now reported correctly in error messages
+for unterminated strings.  [perl #128701]
 
 =item *
 
-Vivifying a subroutine stub in a deleted stash (e.g., C<delete $My::{"Foo::"};
-\&My::Foo::foo>) no longer crashes.  It had begun crashing in Perl 5.18.
-L<[perl #128532]|https://rt.perl.org/Public/Bug/Display.html?id=128532>
+C<pack("p", ...)> used to emit its warning ("Attempt to pack pointer to
+temporary value") erroneously in some cases, but has been fixed.
 
 =item *
 
-Some obscure cases of subroutines and file handles being freed at the same time
-could result in crashes, but have been fixed.  The crash was introduced in Perl
-5.22.
-L<[perl #128597]|https://rt.perl.org/Public/Bug/Display.html?id=128597>
+C<@DB::args> is now exempt from "used once" warnings.  The warnings only
+occurred under B<-w>, because F<warnings.pm> itself uses C<@DB::args>
+multiple times.
 
 =item *
 
-Code that looks for a variable name associated with an uninitialized value
-could cause an assertion in cases where magic is involved, such as
-C<$ISA[0][0]>.  This has now been fixed.
-L<[perl #128253]|https://rt.perl.org/Public/Bug/Display.html?id=128253>
+The use of built-in arrays or hash slices in a double-quoted string no
+longer issues a warning ("Possible unintended interpolation...") if the
+variable has not been mentioned before.  This affected code like
+C<qq|@DB::args|> and C<qq|@SIG{'CHLD', 'HUP'}|>.  (The special variables
+C<@-> and C<@+> were already exempt from the warning.)
 
 =item *
 
-A crash caused by code generating the warning "Subroutine STASH::NAME
-redefined" in cases such as C<sub P::f{} undef *P::; *P::f =sub{};> has been
-fixed.  In these cases, where the STASH is missing, the warning will now appear
-as "Subroutine NAME redefined".
-L<[perl #128257]|https://rt.perl.org/Public/Bug/Display.html?id=128257>
+C<gethostent> and similar functions now perform a null check internally, to
+avoid crashing with torsocks.  This was a regression from 5.22.  [perl
+#128740]
 
 =item *
 
-Fixed an assertion triggered by some code that handles deprecated behavior in
-formats, e.g. in cases like this:
+C<defined *{'!'}>, C<defined *{'['}>, and C<defined *{'-'}> no longer leak
+memory if the typeglob in question has never been accessed before.
 
-    format STDOUT =
-    @
-    0"$x"
+=item *
 
-L<[perl #128255]|https://rt.perl.org/Public/Bug/Display.html?id=128255>
+In 5.25.4 fchown() was changed not to accept negative one as an argument
+because in some platforms that is an error.  However, in some other platforms
+that is an acceptable argument.  This change has been reverted [perl #128967].
 
 =item *
 
-A possible divide by zero in string transformation code on Windows has been
-avoided, fixing a crash when collating an empty string.
-L<[perl #128618]|https://rt.perl.org/Public/Bug/Display.html?id=128618>
+Mentioning the same constant twice in a row (which is a syntax error) no
+longer fails an assertion under debugging builds.  This was a regression
+from 5.20.  [perl #126482]
 
 =item *
 
-Some regular expression parsing glitches could lead to assertion failures with
-regular expressions such as C</(?<=/> and C</(?<!/>.  This has now been fixed.
-L<[perl #128170]|https://rt.perl.org/Public/Bug/Display.html?id=128170>
+Many issues relating to C<printf "%a"> of hexadecimal floating point
+were fixed.  In addition, the "subnormals" (formerly known as "denormals")
+floating point anumbers are now supported both with the plain IEEE 754
+floating point numbers (64-bit or 128-bit) and the x86 80-bit
+"extended precision".  Note that subnormal hexadecimal floating
+point literals will give a warning about "exponent underflow".
+[perl #128843, #128889, #128890, #128893, #128909, #128919]
 
-=back
+=item *
 
-=head1 Errata From Previous Releases
+A regression in 5.24 with C<tr/\N{U+...}/foo/> when the code point was between
+128 and 255 has been fixed. [perl #128734].
 
-=over 4
+=item *
+
+A regression from the previous development release, 5.23.3, where
+compiling a regular expression could crash the interpreter has been
+fixed. [perl #128686].
 
 =item *
 
-Parsing bad POSIX charclasses no longer leaks memory.  This was fixed in Perl
-5.25.2
-L<[perl #128313]|https://rt.perl.org/Public/Bug/Display.html?id=128313>
+Use of a string delimiter whose code point is above 2**31 now works
+correctly on platforms that allow this.  Previously, certain characters,
+due to truncation, would be confused with other delimiter characters
+with special meaning (such as C<?> in C<m?...?>), resulting
+in inconsistent behaviour.  Note that this is non-portable,
+and is based on Perl's extension to UTF-8, and is probably not
+displayable nor enterable by any editor. [perl #128738]
 
 =item *
 
-Fixed issues with recursive regexes.  The behavior was fixed in Perl 5.24.0.
-L<[perl #126182]|https://rt.perl.org/Public/Bug/Display.html?id=126182>
+C<@{x> followed by a newline where C<x> represents a control or non-ASCII
+character no longer produces a garbled syntax error message or a crash.
+[perl #128951]
 
 =back
 
 =head1 Acknowledgements
 
-Perl 5.25.3 represents approximately 4 weeks of development since Perl 5.25.2
-and contains approximately 67,000 lines of changes across 510 files from 25
+Perl 5.25.4 represents approximately 4 weeks of development since Perl 5.25.3
+and contains approximately 18,000 lines of changes across 820 files from 23
 authors.
 
 Excluding auto-generated files, documentation and release tools, there were
-approximately 40,000 lines of changes to 290 .pm, .t, .c and .h files.
+approximately 9,200 lines of changes to 660 .pm, .t, .c and .h files.
 
 Perl continues to flourish into its third decade thanks to a vibrant community
-of users and developers.  The following people are known to have contributed
-the improvements that became Perl 5.25.3:
+of users and developers. The following people are known to have contributed the
+improvements that became Perl 5.25.4:
 
-Aaron Crane, Ævar Arnfjörð Bjarmason, Alex Vandiver, Aristotle Pagaltzis,
-Chad Granum, Chris 'BinGOs' Williams, Chris Lamb, Craig A. Berry, Dan Collins,
-David Mitchell, Father Chrysostomos, H.Merijn Brand, Jarkko Hietaniemi, Karl
-Williamson, Lukas Mai, Matthew Horsfall, Salvador Fandiño, Sawyer X,
-Sébastien Aperghis-Tramoni, Steffen Müller, Steve Hay, Todd Rinaldo, Tony
-Cook, Unicode Consortium, Yves Orton.
+Chris 'BinGOs' Williams, Craig A. Berry, Dagfinn Ilmari Mannsåker, Dan
+Collins, Daniel Dragan, David Mitchell, Father Chrysostomos, H.Merijn Brand,
+James E Keenan, Jarkko Hietaniemi, Karen Etheridge, Karl Williamson, Lukas Mai,
+Neil Bowers, Nicolas R., Pino Toscano, Rafael Garcia-Suarez, Richard Levitte,
+Shlomi Fish, Smylers, Steve Hay, Tony Cook, Yves Orton.
 
 The list above is almost certainly incomplete as it is automatically generated
-from version control history.  In particular, it does not include the names of
+from version control history. In particular, it does not include the names of
 the (very much appreciated) contributors who reported issues to the Perl bug
 tracker.
 
 Many of the changes included in this version originated in the CPAN modules
-included in Perl's core.  We're grateful to the entire CPAN community for
+included in Perl's core. We're grateful to the entire CPAN community for
 helping Perl to flourish.
 
 For a more complete list of all of Perl's historical contributors, please see
@@ -464,8 +401,8 @@ the F<AUTHORS> file in the Perl source distribution.
 
 =head1 Reporting Bugs
 
-If you find what you think is a bug, you might check the perl bug database at
-L<https://rt.perl.org/> .  There may also be information at
+If you find what you think is a bug, you might check the perl bug database
+at L<https://rt.perl.org/> .  There may also be information at
 L<http://www.perl.org/> , the Perl Home Page.
 
 If you believe you have an unreported bug, please run the L<perlbug> program
@@ -475,8 +412,8 @@ will be sent off to perlbug@perl.org to be analysed by the Perl porting team.
 
 If the bug you are reporting has security implications which make it
 inappropriate to send to a publicly archived mailing list, then see
-L<perlsec/SECURITY VULNERABILITY CONTACT INFORMATION> for details of how to
-report the issue.
+L<perlsec/SECURITY VULNERABILITY CONTACT INFORMATION>
+for details of how to report the issue.
 
 =head1 SEE ALSO
 
index 146cd5291174cf3d6ca404e2b1fae0f3f4357402..6d82cded39f62b185ceae27ae9c249335bf9a143 100644 (file)
@@ -221,6 +221,22 @@ Auto-decrement> for details.
 (W syntax) You called stat() on an array, but the array will be
 coerced to a scalar - the number of elements in the array.
 
+=item A signature parameter must start with '$', '@' or '%'
+
+(F) Each subroutine signature parameter declaration must start with a valid
+sigil; for example:
+
+    sub foo ($a, $, $b = 1, @c) {}
+
+=item A slurpy parameter may not have a default value
+
+(F) Only scalar subroutine signature parameters may have a default value;
+for example:
+
+    sub foo ($a = 1)        {} # legal
+    sub foo (@a = (1))      {} # invalid
+    sub foo (%a = (a => b)) {} # invalid
+
 =item assertion botched: %s
 
 (X) The malloc package that comes with Perl had an internal failure.
@@ -539,14 +555,14 @@ The C<strict> pragma is useful in avoiding such errors.
 =item Bareword in require maps to empty filename
 
 (F) The bareword form of require has been invoked with a filename which could
-not have been generated by a valid bareword permitted by the parser. You
+not have been generated by a valid bareword permitted by the parser.  You
 shouldn't be able to get this error from Perl code, but XS code may throw it
 if it passes an invalid module name to C<Perl_load_module>.
 
 =item Bareword in require must not start with a double-colon: "%s"
 
 (F) In C<require Bare::Word>, the bareword is not allowed to start with a
-double-colon. Write C<require ::Foo::Bar> as  C<require Foo::Bar> instead.
+double-colon.  Write C<require ::Foo::Bar> as  C<require Foo::Bar> instead.
 
 =item Bareword "%s" not allowed while "strict subs" in use
 
@@ -719,9 +735,9 @@ Perl code, but are only used internally.
 
 (F) Some XS code tried to use C<sv_catpvfn()> or a related function with a
 format string that specifies explicit indexes for some of the elements, and
-using a C-style variable-argument list (a C<va_list>). This is not currently
-supported. XS authors wanting to do this must instead construct a C array of
-C<SV*> scalars containing the arguments.
+using a C-style variable-argument list (a C<va_list>).  This is not currently
+supported.  XS authors wanting to do this must instead construct a C array
+of C<SV*> scalars containing the arguments.
 
 =item Can only compress unsigned integers in pack
 
@@ -2513,7 +2529,9 @@ than the floating point supports.
 =item Hexadecimal float: exponent underflow
 
 (W overflow) The hexadecimal floating point has a smaller exponent
-than the floating point supports.
+than the floating point supports.  With the IEEE 754 floating point,
+this may also mean that the subnormals (formerly known as denormals)
+are being used, which may or may not be an error.
 
 =item Hexadecimal float: internal error (%s)
 
@@ -2578,11 +2596,27 @@ or '%', since those two will accept 0 or more final parameters.
 
 =item Illegal character \%o (carriage return)
 
-(F) Perl normally treats carriage returns in the program text as it
-would any other whitespace, which means you should never see this error
-when Perl was built using standard options.  For some reason, your
-version of Perl appears to have been built without this support.  Talk
-to your Perl administrator.
+(F) Perl normally treats carriage returns in the program text as
+it would any other whitespace, which means you should never see
+this error when Perl was built using standard options.  For some
+reason, your version of Perl appears to have been built without
+this support.  Talk to your Perl administrator.
+
+=item Illegal character following sigil in a subroutine signature
+
+(F) A parameter in a subroutine signature contained an unexpected character
+following the C<$>, C<@> or C<%> sigil character.  Normally the sigil
+should be followed by the variable name or C<=> etc.  Perhaps you are
+trying use a prototype while in the scope of C<use feature 'signatures'>?
+For example:
+
+    sub foo ($$) {}            # legal - a prototype
+
+    use feature 'signatures;
+    sub foo ($$) {}            # illegal - was expecting a signature
+    sub foo ($a, $b)
+            :prototype($$) {}  # legal
+
 
 =item Illegal character in prototype for %s : %s
 
@@ -2707,11 +2741,10 @@ either consume text or fail.
 
 =item Initialization of state variables in list context currently forbidden
 
-(F) Currently the implementation of "state" only permits the
-initialization of scalar variables in scalar context.  Re-write
-C<state ($a) = 42> as C<state $a = 42> to change from list to scalar
-context.  Constructions such as C<state (@a) = foo()> will be
-supported in a future perl release.
+(F) C<state> only permits initializing a single scalar variable, in scalar
+context.  So C<state $a = 42> is allowed, but not C<state ($a) = 42>.  To apply
+state semantics to a hash or array, store a hash or array reference in a
+scalar variable.
 
 =item %%s[%s] in scalar context better written as $%s[%s]
 
@@ -3641,6 +3674,15 @@ mutable before freeing the ops.
 (W syntax) Multidimensional arrays aren't written like C<$foo[1,2,3]>.
 They're written like C<$foo[1][2][3]>, as in C.
 
+=item Multiple slurpy parameters not allowed
+
+(F) In subroutine signatures, a slurpy parameter (C<@> or C<%>) must be
+the last parameter, and there must not be more than one of them; for
+example:
+
+    sub foo ($a, @b)    {} # legal
+    sub foo ($a, @b, %) {} # invalid
+
 =item '/' must follow a numeric type in unpack
 
 (F) You had an unpack template that contained a '/', but this did not
@@ -4020,6 +4062,19 @@ kind of ref it really was.  See L<perlref>.
 reference to something else instead.  You can use the ref() function to
 find out what kind of ref it really was.  See L<perlref>.
 
+=item '#' not allowed immediately following a sigil in a subroutine signature
+
+(F) In a subroutine signature definition, a comment following a sigil
+(C<$>, C<@> or C<%>), needs to be separated by whitespace or a commma etc., in
+particular to avoid confusion with the C<$#> variable.  For example:
+
+    # bad
+    sub f ($# ignore first arg
+           , $b) {}
+    # good
+    sub f ($, # ignore first arg
+           $b) {}
+
 =item Not an ARRAY reference
 
 (F) Perl was trying to evaluate a reference to an array value, but found
@@ -5488,7 +5543,7 @@ setting C<$/> to undef, with the exception that this warning would be
 thrown.
 
 You are recommended to change your code to set C<$/> to C<undef> explicitly
-if you wish to slurp the file. In future versions of Perl assigning
+if you wish to slurp the file.  In future versions of Perl assigning
 a reference to will throw a fatal error.
 
 =item Setting $/ to %s reference is forbidden
@@ -6000,10 +6055,9 @@ system call to call, silly dilly.
 
 =item Too few arguments for subroutine
 
-(F) A subroutine using a signature received fewer arguments than required
-by the signature.  The caller of the subroutine is presumably at fault.
-Inconveniently, this error will be reported at the location of the
-subroutine, not that of the caller.
+(F) A subroutine using a signature received too few arguments than
+required by the signature.  The caller of the subroutine is presumably
+at fault.
 
 =item Too late for "-%s" option
 
@@ -6037,10 +6091,10 @@ BEGIN block.
 
 =item Too many arguments for subroutine
 
-(F) A subroutine using a signature received more arguments than required
-by the signature.  The caller of the subroutine is presumably at fault.
-Inconveniently, this error will be reported at the location of the
-subroutine, not that of the caller.
+(F) A subroutine using a signature received too many arguments than
+required by the signature.  The caller of the subroutine is presumably
+at fault.
+
 
 =item Too many )'s
 
@@ -6847,7 +6901,10 @@ points up to 0x10FFFF, but Perl allows much larger ones.  However, the
 largest possible ones break the perl interpreter in some constructs,
 including causing it to hang in a few cases.  The known problem areas
 are in C<tr///>, regular expression pattern matching using quantifiers,
-and as the upper limits in loops.
+as quote delimiters in C<qI<X>...I<X>> (where I<X> is the C<chr()> of a large
+code point), and as the upper limits in loops.
+There may be other breakages as well.  If you get this warning, and
+things aren't working correctly, you probably have found one of these.
 
 If your code is to run on various platforms, keep in mind that the upper
 limit depends on the platform.  It is much larger on 64-bit word sizes
@@ -7198,7 +7255,7 @@ argument or check that you are using the right verb.
 =item Version control conflict marker
 
 (F) The parser found a line starting with C<E<lt><<<<<<>,
-C<E<gt>E<gt>E<gt>E<gt>E<gt>E<gt>E<gt>>, or C<=======>. These may be left by a
+C<E<gt>E<gt>E<gt>E<gt>E<gt>E<gt>E<gt>>, or C<=======>.  These may be left by a
 version control system to mark conflicts after a failed merge operation.
 
 =item Version number must be a constant number
@@ -7237,8 +7294,8 @@ when its reference count reached zero while it was still open, e.g.:
 
 Because various errors may only be detected by close() (e.g. buffering could
 allow the C<print> in this example to return true even when the disk is full),
-it is dangerous to ignore its result. So when it happens implicitly, perl will
-signal errors by warning.
+it is dangerous to ignore its result.  So when it happens implicitly, perl
+will signal errors by warning.
 
 B<Prior to version 5.22.0, perl ignored such errors>, so the common idiom shown
 above was liable to cause B<silent data loss>.
index 2ac48b9196631ddc8b847acf1edc79f8d10568b2..176b02cc7d7e510fc729cbad1ad02809969afbd5 100644 (file)
@@ -5604,7 +5604,9 @@ X<pos> X<match, position>
 
 Returns the offset of where the last C<m//g> search left off for the
 variable in question (L<C<$_>|perlvar/$_> is used when the variable is not
-specified).  Note that 0 is a valid match offset.
+specified).  This offset is in characters unless the
+(no-longer-recommended) L<C<use bytes>|bytes> pragma is in effect, in
+which case the offset is in bytes.  Note that 0 is a valid match offset.
 L<C<undef>|/undef EXPR> indicates
 that the search position is reset (usually due to match failure, but
 can also be because no match has yet been run on the scalar).
index cd843a0424b594ff5e8cb989a766c390b14bb036..03e1610a5a608a3a9643f1898841a8c4b758f255 100644 (file)
@@ -2674,6 +2674,20 @@ whatever the compiler has.
 If you are printing addresses of pointers, use UVxf combined
 with PTR2UV(), do not use %lx or %p.
 
+=head2 Formatted Printing of Size_t and SSize_t
+
+The most general way to do this is to cast them to a UV or IV, and
+print as in the
+L<previous section|/Formatted Printing of IVs, UVs, and NVs>.
+
+But if you're using C<PerlIO_printf()>, it's less typing and visual
+clutter to use the C<"%z"> length modifier (for I<siZe>):
+
+        PerlIO_printf("STRLEN is %zu\n", len);
+
+This modifier is not portable, so its use should be restricted to
+C<PerlIO_printf()>.
+
 =head2 Pointer-To-Integer and Integer-To-Pointer
 
 Because pointer size does not necessarily equal integer size,
index 21edf2f3f24575c37612373568f23c545f2ef8f4..5aa0b63a0430fbd7739953f8e47983fdada38cb7 100644 (file)
@@ -516,6 +516,9 @@ Or you can try casting to a "wide enough" type:
 
    printf("i = %"IVdf"\n", (IV)something_very_small_and_signed);
 
+See L<perlguts/Formatted Printing of Size_t and SSize_t> for how to
+print those.
+
 Also remember that the C<%p> format really does require a void pointer:
 
    U8* p = ...;
@@ -733,28 +736,39 @@ happened, or how did we end up having wrong or unexpected results.
 To really poke around with Perl, you'll probably want to build Perl for
 debugging, like this:
 
-    ./Configure -d -D optimize=-g
+    ./Configure -d -DDEBUGGING
     make
 
-C<-g> is a flag to the C compiler to have it produce debugging
-information which will allow us to step through a running program, and
-to see in which C function we are at (without the debugging information
-we might see only the numerical addresses of the functions, which is
-not very helpful).
-
-F<Configure> will also turn on the C<DEBUGGING> compilation symbol
-which enables all the internal debugging code in Perl.  There are a
-whole bunch of things you can debug with this: L<perlrun> lists them
-all, and the best way to find out about them is to play about with
-them.  The most useful options are probably
+C<-DDEBUGGING> turns on the C compiler's C<-g> flag to have it produce
+debugging information which will allow us to step through a running
+program, and to see in which C function we are at (without the debugging
+information we might see only the numerical addresses of the functions,
+which is not very helpful). It will also turn on the C<DEBUGGING>
+compilation symbol which enables all the internal debugging code in Perl.
+There are a whole bunch of things you can debug with this: L<perlrun>
+lists them all, and the best way to find out about them is to play about
+with them.  The most useful options are probably
 
     l  Context (loop) stack processing
+    s  Stack snapshots (with v, displays all stacks)
     t  Trace execution
     o  Method and overloading resolution
     c  String/numeric conversions
 
-Some of the functionality of the debugging code can be achieved using
-XS modules.
+For example
+
+    $ perl -Dst -e '$a + 1'
+    ....
+    (-e:1)     gvsv(main::a)
+        =>  UNDEF
+    (-e:1)     const(IV(1))
+        =>  UNDEF  IV(1)
+    (-e:1)     add
+        =>  NV(1)
+
+
+Some of the functionality of the debugging code can be achieved with a
+non-debugging perl by using XS modules:
 
     -Dr => use re 'debug'
     -Dx => use O 'Debug'
index e0a5289773c57b24d457cfe14418181c7a455f62..840b04f44d381057508464ddbf9288a5485ab211 100644 (file)
@@ -568,6 +568,8 @@ the strings?).
  Steve     5.22.2-RC1   2016-Apr-10
  Steve     5.22.2       2016-Apr-29
  Steve     5.22.3-RC1   2016-Jul-17
+ Steve     5.22.3-RC2   2016-Jul-25
+ Steve     5.22.3-RC3   2016-Aug-11
 
  Ricardo   5.23.0       2015-Jun-20     The 5.23 development track
  Matthew   5.23.1       2015-Jul-20
@@ -587,11 +589,14 @@ the strings?).
  Ricardo   5.24.0-RC5   2016-May-04
  Ricardo   5.24.0       2016-May-09
  Steve     5.24.1-RC1   2016-Jul-17
+ Steve     5.24.1-RC2   2016-Jul-25
+ Steve     5.24.1-RC3   2016-Aug-11
 
  Ricardo   5.25.0       2016-May-09     The 5.25 development track
  Sawyer X  5.25.1       2016-May-20
  Matthew   5.25.2       2016-Jun-20
  Steve     5.25.3       2016-Jul-20
+ BinGOs    5.25.4       2016-Aug-20
 
 =head2 SELECTED RELEASE SIZES
 
index bb559ba02b9d2de5ff53cfcf6133c69610535119..5c41e29391a0e9017bd5c2d190d51f63c0c2b951 100644 (file)
@@ -473,11 +473,11 @@ Originally, the tree would have looked like this:
     11              SVOP (0x816dcf0) gv  GV (0x80fa460) *a
 
 That is, fetch the C<a> entry from the main symbol table, and then look
-at the scalar component of it: C<gvsv> (C<pp_gvsv> into F<pp_hot.c>)
+at the scalar component of it: C<gvsv> (C<pp_gvsv> in F<pp_hot.c>)
 happens to do both these things.
 
 The right hand side, starting at line 5 is similar to what we've just
-seen: we have the C<add> op (C<pp_add> also in F<pp_hot.c>) add
+seen: we have the C<add> op (C<pp_add>, also in F<pp_hot.c>) add
 together two C<gvsv>s.
 
 Now, what's this about?
index d9dc6a603c1bc64e0b1bf05d8df3415d5756b316..d65e911a1e980360871d56146625c6fa5c8a3e1d 100644 (file)
@@ -2377,9 +2377,9 @@ of those; in other words, an lvalue.
 A character range may be specified with a hyphen, so C<tr/A-J/0-9/>
 does the same replacement as C<tr/ACEGIBDFHJ/0246813579/>.
 For B<sed> devotees, C<y> is provided as a synonym for C<tr>.  If the
-I<SEARCHLIST> is delimited by bracketing quotes, the I<REPLACEMENTLIST> has
-its own pair of quotes, which may or may not be bracketing quotes;
-for example, C<tr[aeiouy][yuoiea]> or C<tr(+\-*/)/ABCD/>.
+I<SEARCHLIST> is delimited by bracketing quotes, the I<REPLACEMENTLIST>
+must have its own pair of quotes, which may or may not be bracketing
+quotes; for example, C<tr[aeiouy][yuoiea]> or C<tr(+\-*/)/ABCD/>.
 
 Characters may be literals or any of the escape sequences accepted in
 double-quoted strings.  But there is no interpolation, so C<"$"> and
@@ -2390,12 +2390,14 @@ Quote-like Operators>.
 
 Note that C<tr> does B<not> do regular expression character classes such as
 C<\d> or C<\pL>.  The C<tr> operator is not equivalent to the C<L<tr(1)>>
-utility.  If you want to map strings between lower/upper cases, see
-L<perlfunc/lc> and L<perlfunc/uc>, and in general consider using the C<s>
-operator if you need regular expressions.  The C<\U>, C<\u>, C<\L>, and
-C<\l> string-interpolation escapes on the right side of a substitution
-operator will perform correct case-mappings, but C<tr[a-z][A-Z]> will not
-(except sometimes on legacy 7-bit data).
+utility.  C<tr[a-z][A-Z]> will uppercase the 26 letters "a" through "z",
+but for case changing not confined to ASCII, use
+L<C<lc>|perlfunc/lc>, L<C<uc>|perlfunc/uc>,
+L<C<lcfirst>|perlfunc/lcfirst>, L<C<ucfirst>|perlfunc/ucfirst>
+(all documented in L<perlfunc>), or the
+L<substitution operator C<sE<sol>I<PATTERN>E<sol>I<REPLACEMENT>E<sol>>|/sE<sol>PATTERNE<sol>REPLACEMENTE<sol>msixpodualngcer>
+(with C<\U>, C<\u>, C<\L>, and C<\l> string-interpolation escapes in the
+I<REPLACEMENT> portion).
 
 Most ranges are unportable between character sets, but certain ones
 signal Perl to do special handling to make them portable.  There are two
@@ -2430,7 +2432,7 @@ controls and characters which have no ASCII equivalents.
 But, even for portable ranges, it is not generally obvious what is
 included without having to look things up.  A sound principle is to use
 only ranges that begin from and end at either ASCII alphabetics of equal
-case (C<b-e>, C<b-E>), or digits (C<1-4>).  Anything else is unclear
+case (C<b-e>, C<B-E>), or digits (C<1-4>).  Anything else is unclear
 (and unportable unless C<\N{...}> is used).  If in doubt, spell out the
 character sets in full.
 
index ffabf071828c9353f21ce8bd94bf4edda082307d..cc47774fe96a9f08826ae63e6898d1320e7e9840 100644 (file)
@@ -95,42 +95,50 @@ translates it to (or from) C<\015\012>, depending on whether you're
 reading or writing. Unix does the same thing on ttys in canonical
 mode.  C<\015\012> is commonly referred to as CRLF.
 
-To trim trailing newlines from text lines use C<chomp()>.  With default
-settings that function looks for a trailing C<\n> character and thus
-trims in a portable way.
+To trim trailing newlines from text lines use
+L<C<chomp>|perlfunc/chomp VARIABLE>.  With default settings that function
+looks for a trailing C<\n> character and thus trims in a portable way.
 
 When dealing with binary files (or text files in binary mode) be sure
-to explicitly set $/ to the appropriate value for your file format
-before using C<chomp()>.
-
-Because of the "text" mode translation, DOSish perls have limitations
-in using C<seek> and C<tell> on a file accessed in "text" mode.
-Stick to C<seek>-ing to locations you got from C<tell> (and no
-others), and you are usually free to use C<seek> and C<tell> even
-in "text" mode.  Using C<seek> or C<tell> or other file operations
-may be non-portable.  If you use C<binmode> on a file, however, you
-can usually C<seek> and C<tell> with arbitrary values safely.
+to explicitly set L<C<$E<sol>>|perlvar/$E<sol>> to the appropriate value for
+your file format before using L<C<chomp>|perlfunc/chomp VARIABLE>.
+
+Because of the "text" mode translation, DOSish perls have limitations in
+using L<C<seek>|perlfunc/seek FILEHANDLE,POSITION,WHENCE> and
+L<C<tell>|perlfunc/tell FILEHANDLE> on a file accessed in "text" mode.
+Stick to L<C<seek>|perlfunc/seek FILEHANDLE,POSITION,WHENCE>-ing to
+locations you got from L<C<tell>|perlfunc/tell FILEHANDLE> (and no
+others), and you are usually free to use
+L<C<seek>|perlfunc/seek FILEHANDLE,POSITION,WHENCE> and
+L<C<tell>|perlfunc/tell FILEHANDLE> even in "text" mode.  Using
+L<C<seek>|perlfunc/seek FILEHANDLE,POSITION,WHENCE> or
+L<C<tell>|perlfunc/tell FILEHANDLE> or other file operations may be
+non-portable.  If you use L<C<binmode>|perlfunc/binmode FILEHANDLE> on a
+file, however, you can usually
+L<C<seek>|perlfunc/seek FILEHANDLE,POSITION,WHENCE> and
+L<C<tell>|perlfunc/tell FILEHANDLE> with arbitrary values safely.
 
 A common misconception in socket programming is that S<C<\n eq \012>>
 everywhere.  When using protocols such as common Internet protocols,
 C<\012> and C<\015> are called for specifically, and the values of
 the logical C<\n> and C<\r> (carriage return) are not reliable.
 
-    print SOCKET "Hi there, client!\r\n";      # WRONG
-    print SOCKET "Hi there, client!\015\012";  # RIGHT
+    print $socket "Hi there, client!\r\n";      # WRONG
+    print $socket "Hi there, client!\015\012";  # RIGHT
 
 However, using C<\015\012> (or C<\cM\cJ>, or C<\x0D\x0A>) can be tedious
 and unsightly, as well as confusing to those maintaining the code.  As
-such, the C<Socket> module supplies the Right Thing for those who want it.
+such, the L<C<Socket>|Socket> module supplies the Right Thing for those
+who want it.
 
     use Socket qw(:DEFAULT :crlf);
-    print SOCKET "Hi there, client!$CRLF"      # RIGHT
+    print $socket "Hi there, client!$CRLF"      # RIGHT
 
 When reading from a socket, remember that the default input record
-separator C<$/> is C<\n>, but robust socket code will recognize as
-either C<\012> or C<\015\012> as end of line:
+separator L<C<$E<sol>>|perlvar/$E<sol>> is C<\n>, but robust socket code
+will recognize as either C<\012> or C<\015\012> as end of line:
 
-    while (<SOCKET>) {  # NOT ADVISABLE!
+    while (<$socket>) {  # NOT ADVISABLE!
         # ...
     }
 
@@ -140,7 +148,7 @@ be set to LF and any CR stripped later.  Better to write:
     use Socket qw(:DEFAULT :crlf);
     local($/) = LF;      # not needed if $/ is already \012
 
-    while (<SOCKET>) {
+    while (<$socket>) {
         s/$CR?$LF/\n/;   # not sure if socket uses LF or CRLF, OK
     #   s/\015?\012/\n/; # same thing
     }
@@ -210,7 +218,8 @@ decimal), a big-endian host (Motorola, Sparc, PA) reads it as
 0x78563412 (2018915346 in decimal).  Alpha and MIPS can be either:
 Digital/Compaq used/uses them in little-endian mode; SGI/Cray uses
 them in big-endian mode.  To avoid this problem in network (socket)
-connections use the C<pack> and C<unpack> formats C<n> and C<N>, the
+connections use the L<C<pack>|perlfunc/pack TEMPLATE,LIST> and
+L<C<unpack>|perlfunc/unpack TEMPLATE,EXPR> formats C<n> and C<N>, the
 "network" orders.  These are guaranteed to be portable.
 
 As of Perl 5.10.0, you can also use the C<E<gt>> and C<E<lt>> modifiers
@@ -237,10 +246,9 @@ transferring or storing raw binary numbers.
 
 One can circumnavigate both these problems in two ways.  Either
 transfer and store numbers always in text format, instead of raw
-binary, or else consider using modules like C<Data::Dumper> and
-C<Storable>
-(included as of Perl 5.8).  Keeping all data as text significantly
-simplifies matters.
+binary, or else consider using modules like
+L<C<Data::Dumper>|Data::Dumper> and L<C<Storable>|Storable> (included as
+of Perl 5.8).  Keeping all data as text significantly simplifies matters.
 
 =head2 Files and Filesystems
 
@@ -261,16 +269,20 @@ and LPT:).
 
 S<Mac OS> 9 and earlier used C<:> as a path separator instead of C</>.
 
-The filesystem may support neither hard links (C<link>) nor
-symbolic links (C<symlink>, C<readlink>, C<lstat>).
+The filesystem may support neither hard links
+(L<C<link>|perlfunc/link OLDFILE,NEWFILE>) nor symbolic links
+(L<C<symlink>|perlfunc/symlink OLDFILE,NEWFILE>,
+L<C<readlink>|perlfunc/readlink EXPR>,
+L<C<lstat>|perlfunc/lstat FILEHANDLE>).
 
 The filesystem may support neither access timestamp nor change
 timestamp (meaning that about the only portable timestamp is the
 modification timestamp), or one second granularity of any timestamps
 (e.g. the FAT filesystem limits the time granularity to two seconds).
 
-The "inode change timestamp" (the C<-C> filetest) may really be the
-"creation timestamp" (which it is not in Unix).
+The "inode change timestamp" (the L<C<-C>|perlfunc/-X FILEHANDLE>
+filetest) may really be the "creation timestamp" (which it is not in
+Unix).
 
 VOS perl can emulate Unix filenames with C</> as path separator.  The
 native pathname characters greater-than, less-than, number-sign, and
@@ -282,19 +294,19 @@ signal filesystems and disk names.
 
 Don't assume Unix filesystem access semantics: that read, write,
 and execute are all the permissions there are, and even if they exist,
-that their semantics (for example what do C<"r">, C<"w">, and C<"x"> mean on
+that their semantics (for example what do C<r>, C<w>, and C<x> mean on
 a directory) are the Unix ones.  The various Unix/POSIX compatibility
-layers usually try to make interfaces like C<chmod()> work, but sometimes
-there simply is no good mapping.
+layers usually try to make interfaces like L<C<chmod>|perlfunc/chmod LIST>
+work, but sometimes there simply is no good mapping.
 
-The C<File::Spec> modules provide methods to manipulate path
+The L<C<File::Spec>|File::Spec> modules provide methods to manipulate path
 specifications and return the results in native format for each
 platform.  This is often unnecessary as Unix-style paths are
 understood by Perl on every supported platform, but if you need to
 produce native paths for a native utility that does not understand
 Unix syntax, or if you are operating on paths or path components
-in unknown (and thus possibly native) syntax, C<File::Spec> is
-your friend.  Here are two brief examples:
+in unknown (and thus possibly native) syntax, L<C<File::Spec>|File::Spec>
+is your friend.  Here are two brief examples:
 
     use File::Spec::Functions;
     chdir(updir());        # go up one directory
@@ -313,9 +325,9 @@ machines.
 This is especially noticeable in scripts like Makefiles and test suites,
 which often assume C</> as a path separator for subdirectories.
 
-Also of use is C<File::Basename> from the standard distribution, which
-splits a pathname into pieces (base filename, full path to directory,
-and file suffix).
+Also of use is L<C<File::Basename>|File::Basename> from the standard
+distribution, which splits a pathname into pieces (base filename, full
+path to directory, and file suffix).
 
 Even when on a single platform (if you can call Unix a single platform),
 remember not to count on the existence or the contents of particular
@@ -338,9 +350,9 @@ not to have non-word characters (except for C<.>) in the names, and
 keep them to the 8.3 convention, for maximum portability, onerous a
 burden though this may appear.
 
-Likewise, when using the C<AutoSplit> module, try to keep your functions to
-8.3 naming and case-insensitive conventions; or, at the least,
-make it so the resulting files have a unique (case-insensitively)
+Likewise, when using the L<C<AutoSplit>|AutoSplit> module, try to keep
+your functions to 8.3 naming and case-insensitive conventions; or, at the
+least, make it so the resulting files have a unique (case-insensitively)
 first 8 characters.
 
 Whitespace in filenames is tolerated on most systems, but not all,
@@ -351,18 +363,16 @@ Many systems (DOS, VMS ODS-2) cannot have more than one C<.> in their
 filenames.
 
 Don't assume C<< > >> won't be the first character of a filename.
-Always use C<< < >> explicitly to open a file for reading, or even
-better, use the three-arg version of C<open>, unless you want the user to
-be able to specify a pipe open.
+Always use the three-arg version of
+L<C<open>|perlfunc/open FILEHANDLE,EXPR>:
 
     open my $fh, '<', $existing_file) or die $!;
 
-If filenames might use strange characters, it is safest to open it
-with C<sysopen> instead of C<open>.  C<open> is magic and can
-translate characters like C<< > >>, C<< < >>, and C<|>, which may
-be the wrong thing to do.  (Sometimes, though, it's the right thing.)
-Three-arg open can also help protect against this translation in cases
-where it is undesirable.
+Two-arg L<C<open>|perlfunc/open FILEHANDLE,EXPR> is magic and can
+translate characters like C<< > >>, C<< < >>, and C<|> in filenames,
+which is usually the wrong thing to do.
+L<C<sysopen>|perlfunc/sysopen FILEHANDLE,FILENAME,MODE> and three-arg
+L<C<open>|perlfunc/open FILEHANDLE,EXPR> don't have this problem.
 
 Don't use C<:> as a part of a filename since many systems use that for
 their own semantics (Mac OS Classic for separating pathname components,
@@ -381,7 +391,7 @@ The I<portable filename characters> as defined by ANSI C are
  0 1 2 3 4 5 6 7 8 9
  . _ -
 
-and the C<"-"> shouldn't be the first character.  If you want to be
+and C<-> shouldn't be the first character.  If you want to be
 hypercorrect, stay case-insensitive and within the 8.3 naming
 convention (all the files and directories have to be unique within one
 directory if their names are lowercased and truncated to eight
@@ -398,10 +408,14 @@ to deal with, so don't stay up late worrying about it.
 
 Some platforms can't delete or rename files held open by the system,
 this limitation may also apply to changing filesystem metainformation
-like file permissions or owners.  Remember to C<close> files when you
-are done with them.  Don't C<unlink> or C<rename> an open file.  Don't
-C<tie> or C<open> a file already tied or opened; C<untie> or C<close>
-it first.
+like file permissions or owners.  Remember to
+L<C<close>|perlfunc/close FILEHANDLE> files when you are done with them.
+Don't L<C<unlink>|perlfunc/unlink LIST> or
+L<C<rename>|perlfunc/rename OLDNAME,NEWNAME> an open file.  Don't
+L<C<tie>|perlfunc/tie VARIABLE,CLASSNAME,LIST> or
+L<C<open>|perlfunc/open FILEHANDLE,EXPR> a file already tied or opened;
+L<C<untie>|perlfunc/untie VARIABLE> or
+L<C<close>|perlfunc/close FILEHANDLE> it first.
 
 Don't open the same file more than once at a time for writing, as some
 operating systems put mandatory locks on such files.
@@ -413,84 +427,95 @@ permission also (or even just) in the file/directory itself.  In some
 filesystems (AFS, DFS) the permission to add/delete directory entries
 is a completely separate permission.
 
-Don't assume that a single C<unlink> completely gets rid of the file:
-some filesystems (most notably the ones in VMS) have versioned
-filesystems, and C<unlink()> removes only the most recent one (it doesn't
-remove all the versions because by default the native tools on those
-platforms remove just the most recent version, too).  The portable
-idiom to remove all the versions of a file is
+Don't assume that a single L<C<unlink>|perlfunc/unlink LIST> completely
+gets rid of the file: some filesystems (most notably the ones in VMS) have
+versioned filesystems, and L<C<unlink>|perlfunc/unlink LIST> removes only
+the most recent one (it doesn't remove all the versions because by default
+the native tools on those platforms remove just the most recent version,
+too).  The portable idiom to remove all the versions of a file is
 
     1 while unlink "file";
 
 This will terminate if the file is undeleteable for some reason
 (protected, not there, and so on).
 
-Don't count on a specific environment variable existing in C<%ENV>.
-Don't count on C<%ENV> entries being case-sensitive, or even
-case-preserving.  Don't try to clear C<%ENV> by saying C<%ENV = ();>, or,
-if you really have to, make it conditional on C<$^O ne 'VMS'> since in
-VMS the C<%ENV> table is much more than a per-process key-value string
-table.
-
-On VMS, some entries in the C<%ENV> hash are dynamically created when
-their key is used on a read if they did not previously exist.  The
-values for C<$ENV{HOME}>, C<$ENV{TERM}>, C<$ENV{PATH}>, and C<$ENV{USER}>,
-are known to be dynamically generated.  The specific names that are
-dynamically generated may vary with the version of the C library on VMS,
-and more may exist than are documented.
-
-On VMS by default, changes to the %ENV hash persist after perl exits.
-Subsequent invocations of perl in the same process can inadvertently
-inherit environment settings that were meant to be temporary.
-
-Don't count on signals or C<%SIG> for anything.
-
-Don't count on filename globbing.  Use C<opendir>, C<readdir>, and
-C<closedir> instead.
+Don't count on a specific environment variable existing in
+L<C<%ENV>|perlvar/%ENV>.  Don't count on L<C<%ENV>|perlvar/%ENV> entries
+being case-sensitive, or even case-preserving.  Don't try to clear
+L<C<%ENV>|perlvar/%ENV> by saying C<%ENV = ();>, or, if you really have
+to, make it conditional on C<$^O ne 'VMS'> since in VMS the
+L<C<%ENV>|perlvar/%ENV> table is much more than a per-process key-value
+string table.
+
+On VMS, some entries in the L<C<%ENV>|perlvar/%ENV> hash are dynamically
+created when their key is used on a read if they did not previously
+exist.  The values for C<$ENV{HOME}>, C<$ENV{TERM}>, C<$ENV{PATH}>, and
+C<$ENV{USER}>, are known to be dynamically generated.  The specific names
+that are dynamically generated may vary with the version of the C library
+on VMS, and more may exist than are documented.
+
+On VMS by default, changes to the L<C<%ENV>|perlvar/%ENV> hash persist
+after perl exits.  Subsequent invocations of perl in the same process can
+inadvertently inherit environment settings that were meant to be
+temporary.
+
+Don't count on signals or L<C<%SIG>|perlvar/%SIG> for anything.
+
+Don't count on filename globbing.  Use
+L<C<opendir>|perlfunc/opendir DIRHANDLE,EXPR>,
+L<C<readdir>|perlfunc/readdir DIRHANDLE>, and
+L<C<closedir>|perlfunc/closedir DIRHANDLE> instead.
 
 Don't count on per-program environment variables, or per-program current
 directories.
 
-Don't count on specific values of C<$!>, neither numeric nor
+Don't count on specific values of L<C<$!>|perlvar/$!>, neither numeric nor
 especially the string values. Users may switch their locales causing
 error messages to be translated into their languages.  If you can
 trust a POSIXish environment, you can portably use the symbols defined
-by the C<Errno> module, like C<ENOENT>.  And don't trust on the values of C<$!>
-at all except immediately after a failed system call.
+by the L<C<Errno>|Errno> module, like C<ENOENT>.  And don't trust on the
+values of L<C<$!>|perlvar/$!> at all except immediately after a failed
+system call.
 
 =head2 Command names versus file pathnames
 
 Don't assume that the name used to invoke a command or program with
-C<system> or C<exec> can also be used to test for the existence of the
-file that holds the executable code for that command or program.
+L<C<system>|perlfunc/system LIST> or L<C<exec>|perlfunc/exec LIST> can
+also be used to test for the existence of the file that holds the
+executable code for that command or program.
 First, many systems have "internal" commands that are built-in to the
 shell or OS and while these commands can be invoked, there is no
 corresponding file.  Second, some operating systems (e.g., Cygwin,
 DJGPP, OS/2, and VOS) have required suffixes for executable files;
 these suffixes are generally permitted on the command name but are not
-required.  Thus, a command like F<"perl"> might exist in a file named
-F<"perl">, F<"perl.exe">, or F<"perl.pm">, depending on the operating system.
-The variable C<"_exe"> in the C<Config> module holds the executable suffix,
-if any.  Third, the VMS port carefully sets up C<$^X> and
-C<$Config{perlpath}> so that no further processing is required.  This is
-just as well, because the matching regular expression used below would
-then have to deal with a possible trailing version number in the VMS
-file name.
-
-To convert C<$^X> to a file pathname, taking account of the requirements
-of the various operating system possibilities, say:
+required.  Thus, a command like C<perl> might exist in a file named
+F<perl>, F<perl.exe>, or F<perl.pm>, depending on the operating system.
+The variable L<C<$Config{_exe}>|Config/C<_exe>> in the
+L<C<Config>|Config> module holds the executable suffix, if any.  Third,
+the VMS port carefully sets up L<C<$^X>|perlvar/$^X> and
+L<C<$Config{perlpath}>|Config/C<perlpath>> so that no further processing
+is required.  This is just as well, because the matching regular
+expression used below would then have to deal with a possible trailing
+version number in the VMS file name.
+
+To convert L<C<$^X>|perlvar/$^X> to a file pathname, taking account of
+the requirements of the various operating system possibilities, say:
 
  use Config;
  my $thisperl = $^X;
- if ($^O ne 'VMS')
-    {$thisperl .= $Config{_exe} unless $thisperl =~ m/$Config{_exe}$/i;}
+ if ($^O ne 'VMS') {
+     $thisperl .= $Config{_exe}
+         unless $thisperl =~ m/\Q$Config{_exe}\E$/i;
+ }
 
-To convert C<$Config{perlpath}> to a file pathname, say:
+To convert L<C<$Config{perlpath}>|Config/C<perlpath>> to a file pathname, say:
 
  use Config;
  my $thisperl = $Config{perlpath};
- if ($^O ne 'VMS')
-    {$thisperl .= $Config{_exe} unless $thisperl =~ m/$Config{_exe}$/i;}
+ if ($^O ne 'VMS') {
+     $thisperl .= $Config{_exe}
+         unless $thisperl =~ m/\Q$Config{_exe}\E$/i;
+ }
 
 =head2 Networking
 
@@ -512,17 +537,18 @@ can't bind to many virtual IP addresses.
 
 Don't assume a particular network device name.
 
-Don't assume a particular set of C<ioctl()>s will work.
+Don't assume a particular set of
+L<C<ioctl>|perlfunc/ioctl FILEHANDLE,FUNCTION,SCALAR>s will work.
 
 Don't assume that you can ping hosts and get replies.
 
 Don't assume that any particular port (service) will respond.
 
-Don't assume that C<Sys::Hostname> (or any other API or command) returns
-either a fully qualified hostname or a non-qualified hostname: it all
-depends on how the system had been configured.  Also remember that for
-things such as DHCP and NAT, the hostname you get back might not be
-very useful.
+Don't assume that L<C<Sys::Hostname>|Sys::Hostname> (or any other API or
+command) returns either a fully qualified hostname or a non-qualified
+hostname: it all depends on how the system had been configured.  Also
+remember that for things such as DHCP and NAT, the hostname you get back
+might not be very useful.
 
 All the above I<don't>s may look daunting, and they are, but the key
 is to degrade gracefully if one cannot reach the particular network
@@ -531,9 +557,12 @@ service one wants.  Croaking or hanging do not look very professional.
 =head2 Interprocess Communication (IPC)
 
 In general, don't directly access the system in code meant to be
-portable.  That means, no C<system>, C<exec>, C<fork>, C<pipe>,
-C<``>, C<qx//>, C<open> with a C<|>, nor any of the other things
-that makes being a Perl hacker worth being.
+portable.  That means, no L<C<system>|perlfunc/system LIST>,
+L<C<exec>|perlfunc/exec LIST>, L<C<fork>|perlfunc/fork>,
+L<C<pipe>|perlfunc/pipe READHANDLE,WRITEHANDLE>,
+L<C<``> or C<qxE<sol>E<sol>>|perlop/C<qxE<sol>I<STRING>E<sol>>>,
+L<C<open>|perlfunc/open FILEHANDLE,EXPR> with a C<|>, nor any of the other
+things that makes being a Perl hacker worth being.
 
 Commands that launch external processes are generally supported on
 most platforms (though many of them do not support any type of
@@ -542,22 +571,23 @@ them on.  External tools are often named differently on different
 platforms, may not be available in the same location, might accept
 different arguments, can behave differently, and often present their
 results in a platform-dependent way.  Thus, you should seldom depend
-on them to produce consistent results. (Then again, if you're calling
-I<netstat -a>, you probably don't expect it to run on both Unix and CP/M.)
+on them to produce consistent results.  (Then again, if you're calling
+C<netstat -a>, you probably don't expect it to run on both Unix and CP/M.)
 
 One especially common bit of Perl code is opening a pipe to B<sendmail>:
 
-    open(MAIL, '|/usr/lib/sendmail -t')
+    open(my $mail, '|-', '/usr/lib/sendmail -t')
        or die "cannot fork sendmail: $!";
 
 This is fine for systems programming when sendmail is known to be
 available.  But it is not fine for many non-Unix systems, and even
 some Unix systems that may not have sendmail installed.  If a portable
 solution is needed, see the various distributions on CPAN that deal
-with it.  C<Mail::Mailer> and C<Mail::Send> in the C<MailTools> distribution are
-commonly used, and provide several mailing methods, including C<mail>,
-C<sendmail>, and direct SMTP (via C<Net::SMTP>) if a mail transfer agent is
-not available.  C<Mail::Sendmail> is a standalone module that provides
+with it.  L<C<Mail::Mailer>|Mail::Mailer> and L<C<Mail::Send>|Mail::Send>
+in the C<MailTools> distribution are commonly used, and provide several
+mailing methods, including C<mail>, C<sendmail>, and direct SMTP (via
+L<C<Net::SMTP>|Net::SMTP>) if a mail transfer agent is not available.
+L<C<Mail::Sendmail>|Mail::Sendmail> is a standalone module that provides
 simple, platform-independent mailing.
 
 The Unix System V IPC (C<msg*(), sem*(), shm*()>) is not available
@@ -568,8 +598,10 @@ bare v-strings (such as C<v10.20.30.40>) to represent IPv4 addresses:
 both forms just pack the four bytes into network order.  That this
 would be equal to the C language C<in_addr> struct (which is what the
 socket code internally uses) is not guaranteed.  To be portable use
-the routines of the C<Socket> extension, such as C<inet_aton()>,
-C<inet_ntoa()>, and C<sockaddr_in()>.
+the routines of the L<C<Socket>|Socket> module, such as
+L<C<inet_aton>|Socket/$ip_address = inet_aton $string>,
+L<C<inet_ntoa>|Socket/$string = inet_ntoa $ip_address>, and
+L<C<sockaddr_in>|Socket/$sockaddr = sockaddr_in $port, $ip_address>.
 
 The rule of thumb for portable code is: Do it all in portable Perl, or
 use a module (that may internally implement it with platform-specific
@@ -592,19 +624,20 @@ achieve portability.
 =head2 Standard Modules
 
 In general, the standard modules work across platforms.  Notable
-exceptions are the C<CPAN> module (which currently makes connections to external
-programs that may not be available), platform-specific modules (like
-C<ExtUtils::MM_VMS>), and DBM modules.
+exceptions are the L<C<CPAN>|CPAN> module (which currently makes
+connections to external programs that may not be available),
+platform-specific modules (like L<C<ExtUtils::MM_VMS>|ExtUtils::MM_VMS>),
+and DBM modules.
 
 There is no one DBM module available on all platforms.
-C<SDBM_File> and the others are generally available on all Unix and DOSish
-ports, but not in MacPerl, where only C<NDBM_File> and C<DB_File> are
-available.
+L<C<SDBM_File>|SDBM_File> and the others are generally available on all
+Unix and DOSish ports, but not in MacPerl, where only
+L<C<NDBM_File>|NDBM_File> and L<C<DB_File>|DB_File> are available.
 
 The good news is that at least some DBM module should be available, and
-C<AnyDBM_File> will use whichever module it can find.  Of course, then
-the code needs to be fairly strict, dropping to the greatest common
-factor (e.g., not exceeding 1K for each record), so that it will
+L<C<AnyDBM_File>|AnyDBM_File> will use whichever module it can find.  Of
+course, then the code needs to be fairly strict, dropping to the greatest
+common factor (e.g., not exceeding 1K for each record), so that it will
 work with any DBM module.  See L<AnyDBM_File> for more details.
 
 =head2 Time and Date
@@ -627,15 +660,17 @@ defines YYYY-MM-DD as the date format, or YYYY-MM-DDTHH:MM:SS
 Please do use the ISO 8601 instead of making us guess what
 date 02/03/04 might be.  ISO 8601 even sorts nicely as-is.
 A text representation (like "1987-12-18") can be easily converted
-into an OS-specific value using a module like C<Date::Parse>.
-An array of values, such as those returned by C<localtime>, can be
-converted to an OS-specific representation using C<Time::Local>.
+into an OS-specific value using a module like
+L<C<Time::Piece>|Time::Piece> (see L<Time::Piece/Date Parsing>) or
+L<C<Date::Parse>|Date::Parse>.  An array of values, such as those
+returned by L<C<localtime>|perlfunc/localtime EXPR>, can be converted to an OS-specific
+representation using L<C<Time::Local>|Time::Local>.
 
 When calculating specific times, such as for tests in time or date modules,
 it may be appropriate to calculate an offset for the epoch.
 
-    require Time::Local;
-    my $offset = Time::Local::timegm(0, 0, 0, 1, 0, 70);
+    use Time::Local qw(timegm);
+    my $offset = timegm(0, 0, 0, 1, 0, 70);
 
 The value for C<$offset> in Unix will be C<0>, but in Mac OS Classic
 will be some large number.  C<$offset> can then be added to a Unix time
@@ -645,20 +680,25 @@ value to get what should be the proper value on any system.
 
 Assume very little about character sets.
 
-Assume nothing about numerical values (C<ord>, C<chr>) of characters.
+Assume nothing about numerical values (L<C<ord>|perlfunc/ord EXPR>,
+L<C<chr>|perlfunc/chr NUMBER>) of characters.
 Do not use explicit code point ranges (like C<\xHH-\xHH)>.  However,
 starting in Perl v5.22, regular expression pattern bracketed character
 class ranges specified like C<qr/[\N{U+HH}-\N{U+HH}]/> are portable,
-and starting in Perl v5.24, the same ranges are portable in C<tr///>.
+and starting in Perl v5.24, the same ranges are portable in
+L<C<trE<sol>E<sol>E<sol>>|perlop/C<trE<sol>I<SEARCHLIST>E<sol>I<REPLACEMENTLIST>E<sol>cdsr>>.
 You can portably use symbolic character classes like C<[:print:]>.
 
 Do not assume that the alphabetic characters are encoded contiguously
 (in the numeric sense).  There may be gaps.  Special coding in Perl,
 however, guarantees that all subsets of C<qr/[A-Z]/>, C<qr/[a-z]/>, and
-C<qr/[0-9]/> behave as expected.  C<tr///> behaves the same for these
-ranges.  In patterns, any ranges specified with end points using the
-C<\N{...}> notations ensures character set portability, but it is a bug
-in Perl v5.22, that this isn't true of C<tr///>, fixed in v5.24.
+C<qr/[0-9]/> behave as expected.
+L<C<trE<sol>E<sol>E<sol>>|perlop/C<trE<sol>I<SEARCHLIST>E<sol>I<REPLACEMENTLIST>E<sol>cdsr>>
+behaves the same for these ranges.  In patterns, any ranges specified with
+end points using the C<\N{...}> notations ensures character set
+portability, but it is a bug in Perl v5.22 that this isn't true of
+L<C<trE<sol>E<sol>E<sol>>|perlop/C<trE<sol>I<SEARCHLIST>E<sol>I<REPLACEMENTLIST>E<sol>cdsr>>,
+fixed in v5.24.
 
 Do not assume anything about the ordering of the characters.
 The lowercase letters may come before or after the uppercase letters;
@@ -679,18 +719,13 @@ and time formatting--amongst other things.
 If you really want to be international, you should consider Unicode.
 See L<perluniintro> and L<perlunicode> for more information.
 
-If you want to use non-ASCII bytes (outside the bytes 0x00..0x7f) in
-the "source code" of your code, to be portable you have to be explicit
-about what bytes they are.  Someone might for example be using your
-code under a UTF-8 locale, in which case random native bytes might be
-illegal ("Malformed UTF-8 ...")  This means that for example embedding
-ISO 8859-1 bytes beyond 0x7f into your strings might cause trouble
-later.  If the bytes are native 8-bit bytes, you can use the C<bytes>
-pragma.  If the bytes are in a string (regular expressions being
-curious strings), you can often also use the C<\xHH> or more portably,
-the C<\N{U+HH}> notations instead
-of embedding the bytes as-is.  If you want to write your code in UTF-8,
-you can use L<utf8>.
+By default Perl assumes your source code is written in an 8-bit ASCII
+superset. To embed Unicode characters in your strings and regexes, you can
+use the L<C<\x{HH}> or (more portably) C<\N{U+HH}>
+notations|perlop/Quote and Quote-like Operators>. You can also use the
+L<C<utf8>|utf8> pragma and write your code in UTF-8, which lets you use
+Unicode characters directly (not just in quoted constructs but also in
+identifiers).
 
 =head2 System Resources
 
@@ -731,19 +766,20 @@ permissions between the permissions check and the actual operation.
 Just try the operation.)
 
 Don't assume the Unix user and group semantics: especially, don't
-expect C<< $< >> and C<< $> >> (or C<$(> and C<$)>) to work
-for switching identities (or memberships).
+expect L<C<< $< >>|perlvar/$E<lt>> and L<C<< $> >>|perlvar/$E<gt>> (or
+L<C<$(>|perlvar/$(> and L<C<$)>|perlvar/$)>) to work for switching
+identities (or memberships).
 
-Don't assume set-uid and set-gid semantics. (And even if you do,
+Don't assume set-uid and set-gid semantics.  (And even if you do,
 think twice: set-uid and set-gid are a known can of security worms.)
 
 =head2 Style
 
 For those times when it is necessary to have platform-specific code,
 consider keeping the platform-specific code in one place, making porting
-to other platforms easier.  Use the C<Config> module and the special
-variable C<$^O> to differentiate platforms, as described in
-L</"PLATFORMS">.
+to other platforms easier.  Use the L<C<Config>|Config> module and the
+special variable L<C<$^O>|perlvar/$^O> to differentiate platforms, as
+described in L</"PLATFORMS">.
 
 Beware of the "else syndrome":
 
@@ -762,12 +798,12 @@ often happens when tests spawn off other processes or call external
 programs to aid in the testing, or when (as noted above) the tests
 assume certain things about the filesystem and paths.  Be careful not
 to depend on a specific output style for errors, such as when checking
-C<$!> after a failed system call.  Using C<$!> for anything else than
-displaying it as output is doubtful (though see the C<Errno> module for
-testing reasonably portably for error value). Some platforms expect
-a certain output format, and Perl on those platforms may have been
-adjusted accordingly.  Most specifically, don't anchor a regex when
-testing an error value.
+L<C<$!>|perlvar/$!> after a failed system call.  Using
+L<C<$!>|perlvar/$!> for anything else than displaying it as output is
+doubtful (though see the L<C<Errno>|Errno> module for testing reasonably
+portably for error value). Some platforms expect a certain output format,
+and Perl on those platforms may have been adjusted accordingly.  Most
+specifically, don't anchor a regex when testing an error value.
 
 =head1 CPAN Testers
 
@@ -797,30 +833,31 @@ Testing results: L<http://www.cpantesters.org/>
 
 =head1 PLATFORMS
 
-Perl is built with a C<$^O> variable that indicates the operating
-system it was built on.  This was implemented
+Perl is built with a L<C<$^O>|perlvar/$^O> variable that indicates the
+operating system it was built on.  This was implemented
 to help speed up code that would otherwise have to C<use Config>
-and use the value of C<$Config{osname}>.  Of course, to get more
-detailed information about the system, looking into C<%Config> is
-certainly recommended.
+and use the value of L<C<$Config{osname}>|Config/C<osname>>.  Of course,
+to get more detailed information about the system, looking into
+L<C<%Config>|Config/DESCRIPTION> is certainly recommended.
 
-C<%Config> cannot always be trusted, however, because it was built
-at compile time.  If perl was built in one place, then transferred
-elsewhere, some values may be wrong.  The values may even have been
-edited after the fact.
+L<C<%Config>|Config/DESCRIPTION> cannot always be trusted, however,
+because it was built at compile time.  If perl was built in one place,
+then transferred elsewhere, some values may be wrong.  The values may
+even have been edited after the fact.
 
 =head2 Unix
 
 Perl works on a bewildering variety of Unix and Unix-like platforms (see
 e.g. most of the files in the F<hints/> directory in the source code kit).
-On most of these systems, the value of C<$^O> (hence C<$Config{'osname'}>,
-too) is determined either by lowercasing and stripping punctuation from the
-first field of the string returned by typing C<uname -a> (or a similar command)
-at the shell prompt or by testing the file system for the presence of
-uniquely named files such as a kernel or header file.  Here, for example,
-are a few of the more popular Unix flavors:
-
-    uname         $^O        $Config{'archname'}
+On most of these systems, the value of L<C<$^O>|perlvar/$^O> (hence
+L<C<$Config{osname}>|Config/C<osname>>, too) is determined either by
+lowercasing and stripping punctuation from the first field of the string
+returned by typing C<uname -a> (or a similar command) at the shell prompt
+or by testing the file system for the presence of uniquely named files
+such as a kernel or header file.  Here, for example, are a few of the
+more popular Unix flavors:
+
+    uname         $^O        $Config{archname}
     --------------------------------------------
     AIX           aix        aix
     BSD/OS        bsdos      i386-bsdos
@@ -850,8 +887,9 @@ are a few of the more popular Unix flavors:
     SunOS         solaris    i86pc-solaris
     SunOS4        sunos      sun4-sunos
 
-Because the value of C<$Config{archname}> may depend on the
-hardware architecture, it can vary more than the value of C<$^O>.
+Because the value of L<C<$Config{archname}>|Config/C<archname>> may
+depend on the hardware architecture, it can vary more than the value of
+L<C<$^O>|perlvar/$^O>.
 
 =head2 DOS and Derivatives
 
@@ -878,65 +916,70 @@ not to.
 The DOS FAT filesystem can accommodate only "8.3" style filenames.  Under
 the "case-insensitive, but case-preserving" HPFS (OS/2) and NTFS (NT)
 filesystems you may have to be careful about case returned with functions
-like C<readdir> or used with functions like C<open> or C<opendir>.
+like L<C<readdir>|perlfunc/readdir DIRHANDLE> or used with functions like
+L<C<open>|perlfunc/open FILEHANDLE,EXPR> or
+L<C<opendir>|perlfunc/opendir DIRHANDLE,EXPR>.
 
-DOS also treats several filenames as special, such as AUX, PRN,
-NUL, CON, COM1, LPT1, LPT2, etc.  Unfortunately, sometimes these
-filenames won't even work if you include an explicit directory
-prefix.  It is best to avoid such filenames, if you want your code
-to be portable to DOS and its derivatives.  It's hard to know what
-these all are, unfortunately.
+DOS also treats several filenames as special, such as F<AUX>, F<PRN>,
+F<NUL>, F<CON>, F<COM1>, F<LPT1>, F<LPT2>, etc.  Unfortunately, sometimes
+these filenames won't even work if you include an explicit directory
+prefix.  It is best to avoid such filenames, if you want your code to be
+portable to DOS and its derivatives.  It's hard to know what these all
+are, unfortunately.
 
 Users of these operating systems may also wish to make use of
-scripts such as I<pl2bat.bat> or I<pl2cmd> to
-put wrappers around your scripts.
-
-Newline (C<\n>) is translated as C<\015\012> by STDIO when reading from
-and writing to files (see L</"Newlines">).  C<binmode(FILEHANDLE)>
-will keep C<\n> translated as C<\012> for that filehandle.  Since it is a
-no-op on other systems, C<binmode> should be used for cross-platform code
-that deals with binary data.  That's assuming you realize in advance
-that your data is in binary.  General-purpose programs should
-often assume nothing about their data.
-
-The C<$^O> variable and the C<$Config{archname}> values for various
-DOSish perls are as follows:
-
-     OS            $^O      $Config{archname}   ID    Version
-     --------------------------------------------------------
-     MS-DOS        dos        ?
-     PC-DOS        dos        ?
-     OS/2          os2        ?
-     Windows 3.1   ?          ?                 0      3 01
-     Windows 95    MSWin32    MSWin32-x86       1      4 00
-     Windows 98    MSWin32    MSWin32-x86       1      4 10
-     Windows ME    MSWin32    MSWin32-x86       1      ?
-     Windows NT    MSWin32    MSWin32-x86       2      4 xx
-     Windows NT    MSWin32    MSWin32-ALPHA     2      4 xx
-     Windows NT    MSWin32    MSWin32-ppc       2      4 xx
-     Windows 2000  MSWin32    MSWin32-x86       2      5 00
-     Windows XP    MSWin32    MSWin32-x86       2      5 01
-     Windows 2003  MSWin32    MSWin32-x86       2      5 02
-     Windows Vista MSWin32    MSWin32-x86       2      6 00
-     Windows 7     MSWin32    MSWin32-x86       2      6 01
-     Windows 7     MSWin32    MSWin32-x64       2      6 01
-     Windows 2008  MSWin32    MSWin32-x86       2      6 01
-     Windows 2008  MSWin32    MSWin32-x64       2      6 01
-     Windows CE    MSWin32    ?                 3
-     Cygwin        cygwin     cygwin
+scripts such as F<pl2bat.bat> to put wrappers around your scripts.
+
+Newline (C<\n>) is translated as C<\015\012> by the I/O system when
+reading from and writing to files (see L</"Newlines">).
+C<binmode($filehandle)> will keep C<\n> translated as C<\012> for that
+filehandle.
+L<C<binmode>|perlfunc/binmode FILEHANDLE> should always be used for code
+that deals with binary data.  That's assuming you realize in advance that
+your data is in binary.  General-purpose programs should often assume
+nothing about their data.
+
+The L<C<$^O>|perlvar/$^O> variable and the
+L<C<$Config{archname}>|Config/C<archname>> values for various DOSish
+perls are as follows:
+
+    OS             $^O       $Config{archname}  ID    Version
+    ---------------------------------------------------------
+    MS-DOS         dos       ?
+    PC-DOS         dos       ?
+    OS/2           os2       ?
+    Windows 3.1    ?         ?                  0     3 01
+    Windows 95     MSWin32   MSWin32-x86        1     4 00
+    Windows 98     MSWin32   MSWin32-x86        1     4 10
+    Windows ME     MSWin32   MSWin32-x86        1     ?
+    Windows NT     MSWin32   MSWin32-x86        2     4 xx
+    Windows NT     MSWin32   MSWin32-ALPHA      2     4 xx
+    Windows NT     MSWin32   MSWin32-ppc        2     4 xx
+    Windows 2000   MSWin32   MSWin32-x86        2     5 00
+    Windows XP     MSWin32   MSWin32-x86        2     5 01
+    Windows 2003   MSWin32   MSWin32-x86        2     5 02
+    Windows Vista  MSWin32   MSWin32-x86        2     6 00
+    Windows 7      MSWin32   MSWin32-x86        2     6 01
+    Windows 7      MSWin32   MSWin32-x64        2     6 01
+    Windows 2008   MSWin32   MSWin32-x86        2     6 01
+    Windows 2008   MSWin32   MSWin32-x64        2     6 01
+    Windows CE     MSWin32   ?                  3
+    Cygwin         cygwin    cygwin
 
 The various MSWin32 Perl's can distinguish the OS they are running on
 via the value of the fifth element of the list returned from
-C<Win32::GetOSVersion()>.  For example:
+L<C<Win32::GetOSVersion()>|Win32/Win32::GetOSVersion()>.  For example:
 
     if ($^O eq 'MSWin32') {
         my @os_version_info = Win32::GetOSVersion();
         print +('3.1','95','NT')[$os_version_info[4]],"\n";
     }
 
-There are also C<Win32::IsWinNT()> and C<Win32::IsWin95()>; try C<perldoc Win32>,
-and as of libwin32 0.19 (not part of the core Perl distribution)
-C<Win32::GetOSName()>.  The very portable C<POSIX::uname()> will work too:
+There are also C<Win32::IsWinNT()|Win32/Win32::IsWinNT()>,
+C<Win32::IsWin95()|Win32/Win32::IsWin95()>, and
+L<C<Win32::GetOSName()>|Win32/Win32::GetOSName()>; try
+L<C<perldoc Win32>|Win32>.
+The very portable L<C<POSIX::uname()>|POSIX/C<uname>> will work too:
 
     c:\> perl -MPOSIX -we "print join '|', uname"
     Windows NT|moonru|5.0|Build 2195 (Service Pack 2)|x86
@@ -1036,32 +1079,34 @@ but not a mixture of both as in:
 In general, the easiest path to portability is always to specify
 filenames in Unix format unless they will need to be processed by native
 commands or utilities.  Because of this latter consideration, the
-File::Spec module by default returns native format specifications
+L<File::Spec> module by default returns native format specifications
 regardless of input format.  This default may be reversed so that
 filenames are always reported in Unix format by specifying the
 C<DECC$FILENAME_UNIX_REPORT> feature logical in the environment.
 
 The file type, or extension, is always present in a VMS-format file
 specification even if it's zero-length.  This means that, by default,
-C<readdir> will return a trailing dot on a file with no extension, so
-where you would see C<"a"> on Unix you'll see C<"a."> on VMS.  However,
-the trailing dot may be suppressed by enabling the
-C<DECC$READDIR_DROPDOTNOTYPE> feature in the environment (see the CRTL
+L<C<readdir>|perlfunc/readdir DIRHANDLE> will return a trailing dot on a
+file with no extension, so where you would see C<"a"> on Unix you'll see
+C<"a."> on VMS.  However, the trailing dot may be suppressed by enabling
+the C<DECC$READDIR_DROPDOTNOTYPE> feature in the environment (see the CRTL
 documentation on feature logical names).
 
 What C<\n> represents depends on the type of file opened.  It usually
 represents C<\012> but it could also be C<\015>, C<\012>, C<\015\012>,
 C<\000>, C<\040>, or nothing depending on the file organization and
-record format.  The C<VMS::Stdio> module provides access to the
-special C<fopen()> requirements of files with unusual attributes on VMS.
+record format.  The L<C<VMS::Stdio>|VMS::Stdio> module provides access to
+the special C<fopen()> requirements of files with unusual attributes on
+VMS.
 
-The value of C<$^O> on OpenVMS is "VMS".  To determine the architecture
-that you are running on refer to C<$Config{'archname'}>.
+The value of L<C<$^O>|perlvar/$^O> on OpenVMS is "VMS".  To determine the
+architecture that you are running on refer to
+L<C<$Config{archname}>|Config/C<archname>>.
 
 On VMS, perl determines the UTC offset from the C<SYS$TIMEZONE_DIFFERENTIAL>
 logical name.  Although the VMS epoch began at 17-NOV-1858 00:00:00.00,
-calls to C<localtime> are adjusted to count offsets from
-01-JAN-1970 00:00:00.00, just like Unix.
+calls to L<C<localtime>|perlfunc/localtime EXPR> are adjusted to count
+offsets from 01-JAN-1970 00:00:00.00, just like Unix.
 
 Also see:
 
@@ -1108,13 +1153,13 @@ must be renamed before they can be processed by Perl.
 Older releases of VOS (prior to OpenVOS Release 17.0) limit file
 names to 32 or fewer characters, prohibit file names from
 starting with a C<-> character, and prohibit file names from
-containing any character matching C<< tr/ !#%&'()*;<=>?// >>.
+containing C< > (space) or any character from the set C<< !#%&'()*;<=>? >>.
 
 Newer releases of VOS (OpenVOS Release 17.0 or later) support a
 feature known as extended names.  On these releases, file names
 can contain up to 255 characters, are prohibited from starting
 with a C<-> character, and the set of prohibited characters is
-reduced to any character matching C<< tr/#%*<>?// >>.  There are
+reduced to C<< #%*<>? >>.  There are
 restrictions involving spaces and apostrophes:  these characters
 must not begin or end a name, nor can they immediately precede or
 follow a period.  Additionally, a space must not immediately
@@ -1126,17 +1171,9 @@ trailing apostrophe.  Although an extended file name is limited
 to 255 characters, a path name is still limited to 256
 characters.
 
-The value of C<$^O> on VOS is "vos".  To determine the
-architecture that you are running on without resorting to loading
-all of C<%Config> you can examine the content of the C<@INC> array
-like so:
-
-    if ($^O =~ /vos/) {
-        print "I'm on a Stratus box!\n";
-    } else {
-        print "I'm not on a Stratus box!\n";
-        die;
-    }
+The value of L<C<$^O>|perlvar/$^O> on VOS is "vos".  To determine the
+architecture that you are running on refer to
+L<C<$Config{archname}>|Config/C<archname>>.
 
 Also see:
 
@@ -1170,9 +1207,8 @@ VOS Open-Source Software on the web at L<http://ftp.stratus.com/pub/vos/vos.html
 v5.22 core Perl runs on z/OS (formerly OS/390).  Theoretically it could
 run on the successors of OS/400 on AS/400 minicomputers as well as
 VM/ESA, and BS2000 for S/390 Mainframes.  Such computers use EBCDIC
-character sets internally (usually
-Character Code Set ID 0037 for OS/400 and either 1047 or POSIX-BC for S/390
-systems).
+character sets internally (usually Character Code Set ID 0037 for OS/400
+and either 1047 or POSIX-BC for S/390 systems).
 
 The rest of this section may need updating, but we don't know what it
 should say.  Please email comments to
@@ -1198,8 +1234,8 @@ similar to the following simple script:
     print "Hello from perl!\n";
 
 OS/390 will support the C<#!> shebang trick in release 2.8 and beyond.
-Calls to C<system> and backticks can use POSIX shell syntax on all
-S/390 systems.
+Calls to L<C<system>|perlfunc/system LIST> and backticks can use POSIX
+shell syntax on all S/390 systems.
 
 On the AS/400, if PERL5 is in your library list, you may need
 to wrap your Perl scripts in a CL procedure to invoke them like so:
@@ -1209,15 +1245,20 @@ to wrap your Perl scripts in a CL procedure to invoke them like so:
     ENDPGM
 
 This will invoke the Perl script F<hello.pl> in the root of the
-QOpenSys file system.  On the AS/400 calls to C<system> or backticks
-must use CL syntax.
+QOpenSys file system.  On the AS/400 calls to
+L<C<system>|perlfunc/system LIST> or backticks must use CL syntax.
 
 On these platforms, bear in mind that the EBCDIC character set may have
-an effect on what happens with some Perl functions (such as C<chr>,
-C<pack>, C<print>, C<printf>, C<ord>, C<sort>, C<sprintf>, C<unpack>), as
-well as bit-fiddling with ASCII constants using operators like C<^>, C<&>
-and C<|>, not to mention dealing with socket interfaces to ASCII computers
-(see L</"Newlines">).
+an effect on what happens with some Perl functions (such as
+L<C<chr>|perlfunc/chr NUMBER>, L<C<pack>|perlfunc/pack TEMPLATE,LIST>,
+L<C<print>|perlfunc/print FILEHANDLE LIST>,
+L<C<printf>|perlfunc/printf FILEHANDLE FORMAT, LIST>,
+L<C<ord>|perlfunc/ord EXPR>, L<C<sort>|perlfunc/sort SUBNAME LIST>,
+L<C<sprintf>|perlfunc/sprintf FORMAT, LIST>,
+L<C<unpack>|perlfunc/unpack TEMPLATE,EXPR>), as
+well as bit-fiddling with ASCII constants using operators like
+L<C<^>, C<&> and C<|>|perlop/Bitwise String Operators>, not to mention
+dealing with socket interfaces to ASCII computers (see L</"Newlines">).
 
 Fortunately, most web servers for the mainframe will correctly
 translate the C<\n> in the following statement to its ASCII equivalent
@@ -1225,9 +1266,9 @@ translate the C<\n> in the following statement to its ASCII equivalent
 
     print "Content-type: text/html\r\n\r\n";
 
-The values of C<$^O> on some of these platforms includes:
+The values of L<C<$^O>|perlvar/$^O> on some of these platforms include:
 
-    uname         $^O        $Config{'archname'}
+    uname         $^O        $Config{archname}
     --------------------------------------------
     OS/390        os390      os390
     OS400         os400      os400
@@ -1236,7 +1277,7 @@ The values of C<$^O> on some of these platforms includes:
 Some simple tricks for determining if you are running on an EBCDIC
 platform could include any of the following (perhaps all):
 
-    if ("\t" eq "\005")   { print "EBCDIC may be spoken here!\n"; }
+    if ("\t" eq "\005")  { print "EBCDIC may be spoken here!\n"; }
 
     if (ord('A') == 193) { print "EBCDIC may be spoken here!\n"; }
 
@@ -1297,11 +1338,12 @@ where
     ^ is the parent directory
     Directory and File =~ m|[^\0- "\.\$\%\&:\@\\^\|\177]+|
 
-The default filename translation is roughly C<tr|/.|./|;>
+The default filename translation is roughly C<tr|/.|./|>, swapping dots
+and slahes.
 
 Note that C<"ADFS::HardDisk.$.File" ne 'ADFS::HardDisk.$.File'> and that
 the second stage of C<$> interpolation in regular expressions will fall
-foul of the C<$.> if scripts are not careful.
+foul of the L<C<$.>|perlvar/$.> variable if scripts are not careful.
 
 Logical paths specified by system variables containing comma-separated
 search lists are also allowed; hence C<System:Modules> is a valid
@@ -1312,8 +1354,9 @@ C<System$Path> contains a single item list.  The filesystem will also
 expand system variables in filenames if enclosed in angle brackets, so
 C<< <System$Dir>.Modules >> would look for the file
 S<C<$ENV{'System$Dir'} . 'Modules'>>.  The obvious implication of this is
-that B<fully qualified filenames can start with C<< <> >>> and should
-be protected when C<open> is used for input.
+that B<fully qualified filenames can start with C<< <> >>> and the
+three-argument form of L<C<open>|perlfunc/open FILEHANDLE,EXPR> should
+always be used.
 
 Because C<.> was in use as a directory separator and filenames could not
 be assumed to be unique after 10 characters, Acorn implemented the C
@@ -1332,13 +1375,15 @@ The Unix emulation library's translation of filenames to native assumes
 that this sort of translation is required, and it allows a user-defined list
 of known suffixes that it will transpose in this fashion.  This may
 seem transparent, but consider that with these rules F<foo/bar/baz.h>
-and F<foo/bar/h/baz> both map to F<foo.bar.h.baz>, and that C<readdir> and
-C<glob> cannot and do not attempt to emulate the reverse mapping.  Other
+and F<foo/bar/h/baz> both map to F<foo.bar.h.baz>, and that
+L<C<readdir>|perlfunc/readdir DIRHANDLE> and L<C<glob>|perlfunc/glob EXPR>
+cannot and do not attempt to emulate the reverse mapping.  Other
 C<.>'s in filenames are translated to C</>.
 
-As implied above, the environment accessed through C<%ENV> is global, and
-the convention is that program specific environment variables are of the
-form C<Program$Name>.  Each filesystem maintains a current directory,
+As implied above, the environment accessed through
+L<C<%ENV>|perlvar/%ENV> is global, and the convention is that program
+specific environment variables are of the form C<Program$Name>.
+Each filesystem maintains a current directory,
 and the current filesystem's current directory is the B<global> current
 directory.  Consequently, sociable programs don't change the current
 directory but rely on full pathnames, and programs (and Makefiles) cannot
@@ -1353,9 +1398,9 @@ passing C<STDIN>, C<STDOUT>, or C<STDERR> to your children.
 
 The desire of users to express filenames of the form
 C<< <Foo$Dir>.Bar >> on the command line unquoted causes problems,
-too: C<``> command output capture has to perform a guessing game.  It
-assumes that a string C<< <[^<>]+\$[^<>]> >> is a
-reference to an environment variable, whereas anything else involving
+too: L<C<``>|perlop/C<qxE<sol>I<STRING>E<sol>>> command output capture has
+to perform a guessing game.  It assumes that a string C<< <[^<>]+\$[^<>]> >>
+is a reference to an environment variable, whereas anything else involving
 C<< < >> or C<< > >> is redirection, and generally manages to be 99%
 right.  Of course, the problem remains that scripts cannot rely on any
 Unix tools being available, or that any tools found have Unix-like command
@@ -1366,11 +1411,11 @@ tools.  In practice, many don't, as users of the Acorn platform are
 used to binary distributions.  MakeMaker does run, but no available
 make currently copes with MakeMaker's makefiles; even if and when
 this should be fixed, the lack of a Unix-like shell will cause
-problems with makefile rules, especially lines of the form C<cd
-sdbm && make all>, and anything using quoting.
+problems with makefile rules, especially lines of the form
+C<cd sdbm && make all>, and anything using quoting.
 
-"S<RISC OS>" is the proper name for the operating system, but the value
-in C<$^O> is "riscos" (because we don't like shouting).
+S<"RISC OS"> is the proper name for the operating system, but the value
+in L<C<$^O>|perlvar/$^O> is "riscos" (because we don't like shouting).
 
 =head2 Other perls
 
@@ -1383,10 +1428,10 @@ aos, Atari ST, lynxos, riscos, Novell Netware, Tandem Guardian,
 I<etc.>  (Yes, we know that some of these OSes may fall under the
 Unix category, but we are not a standards body.)
 
-Some approximate operating system names and their C<$^O> values
-in the "OTHER" category include:
+Some approximate operating system names and their L<C<$^O>|perlvar/$^O>
+values in the "OTHER" category include:
 
-    OS            $^O        $Config{'archname'}
+    OS            $^O        $Config{archname}
     ------------------------------------------
     Amiga DOS     amigaos    m68k-amigos
 
@@ -1414,7 +1459,7 @@ S<Plan 9>, F<README.plan9>
 
 Listed below are functions that are either completely unimplemented
 or else have been implemented differently on various platforms.
-Following each description will be, in parentheses, a list of
+Preceding each description will be, in parentheses, a list of
 platforms that the description applies to.
 
 The list may well be incomplete, or even wrong in some places.  When
@@ -1424,10 +1469,11 @@ a given port.
 
 Be aware, moreover, that even among Unix-ish systems there are variations.
 
-For many functions, you can also query C<%Config>, exported by
-default from the C<Config> module.  For example, to check whether the
-platform has the C<lstat> call, check C<$Config{d_lstat}>.  See
-L<Config> for a full description of available variables.
+For many functions, you can also query L<C<%Config>|Config/DESCRIPTION>,
+exported by default from the L<C<Config>|Config> module.  For example, to
+check whether the platform has the L<C<lstat>|perlfunc/lstat FILEHANDLE>
+call, check L<C<$Config{d_lstat}>|Config/C<d_lstat>>.  See L<Config> for a
+full description of available variables.
 
 =head2 Alphabetical Listing of Perl Functions
 
@@ -1435,362 +1481,443 @@ L<Config> for a full description of available variables.
 
 =item -X
 
+(Win32)
 C<-w> only inspects the read-only file attribute (FILE_ATTRIBUTE_READONLY),
 which determines whether the directory can be deleted, not whether it can
 be written to. Directories always have read and write access unless denied
-by discretionary access control lists (DACLs).  (S<Win32>)
+by discretionary access control lists (DACLs).
 
+(VMS)
 C<-r>, C<-w>, C<-x>, and C<-o> tell whether the file is accessible,
-which may not reflect UIC-based file protections.  (VMS)
+which may not reflect UIC-based file protections.
 
+(S<RISC OS>)
 C<-s> by name on an open file will return the space reserved on disk,
 rather than the current extent.  C<-s> on an open filehandle returns the
-current size.  (S<RISC OS>)
+current size.
 
+(Win32, VMS, S<RISC OS>)
 C<-R>, C<-W>, C<-X>, C<-O> are indistinguishable from C<-r>, C<-w>,
-C<-x>, C<-o>. (Win32, VMS, S<RISC OS>)
+C<-x>, C<-o>.
 
-C<-g>, C<-k>, C<-l>, C<-u>, C<-A> are not particularly meaningful.
 (Win32, VMS, S<RISC OS>)
+C<-g>, C<-k>, C<-l>, C<-u>, C<-A> are not particularly meaningful.
 
-C<-p> is not particularly meaningful. (VMS, S<RISC OS>)
+(VMS, S<RISC OS>)
+C<-p> is not particularly meaningful.
 
-C<-d> is true if passed a device spec without an explicit directory.
 (VMS)
+C<-d> is true if passed a device spec without an explicit directory.
 
+(Win32)
 C<-x> (or C<-X>) determine if a file ends in one of the executable
-suffixes.  C<-S> is meaningless.  (Win32)
+suffixes.  C<-S> is meaningless.
 
-C<-x> (or C<-X>) determine if a file has an executable file type.
 (S<RISC OS>)
+C<-x> (or C<-X>) determine if a file has an executable file type.
 
 =item alarm
 
+(Win32)
 Emulated using timers that must be explicitly polled whenever Perl
 wants to dispatch "safe signals" and therefore cannot interrupt
-blocking system calls.  (Win32)
+blocking system calls.
 
 =item atan2
 
+(Tru64, HP-UX 10.20)
 Due to issues with various CPUs, math libraries, compilers, and standards,
-results for C<atan2()> may vary depending on any combination of the above.
+results for C<atan2> may vary depending on any combination of the above.
 Perl attempts to conform to the Open Group/IEEE standards for the results
-returned from C<atan2()>, but cannot force the issue if the system Perl is
-run on does not allow it.  (Tru64, HP-UX 10.20)
+returned from C<atan2>, but cannot force the issue if the system Perl is
+run on does not allow it.
 
-The current version of the standards for C<atan2()> is available at
+The current version of the standards for C<atan2> is available at
 L<http://www.opengroup.org/onlinepubs/009695399/functions/atan2.html>.
 
 =item binmode
 
-Meaningless.  (S<RISC OS>)
+(S<RISC OS>)
+Meaningless.
 
+(VMS)
 Reopens file and restores pointer; if function fails, underlying
 filehandle may be closed, or pointer may be in a different position.
-(VMS)
 
-The value returned by C<tell> may be affected after the call, and
-the filehandle may be flushed. (Win32)
+(Win32)
+The value returned by L<C<tell>|perlfunc/tell FILEHANDLE> may be affected
+after the call, and the filehandle may be flushed.
 
 =item chmod
 
-Only good for changing "owner" read-write access, "group", and "other"
-bits are meaningless. (Win32)
+(Win32)
+Only good for changing "owner" read-write access; "group" and "other"
+bits are meaningless.
 
-Only good for changing "owner" and "other" read-write access. (S<RISC OS>)
+(S<RISC OS>)
+Only good for changing "owner" and "other" read-write access.
 
-Access permissions are mapped onto VOS access-control list changes. (VOS)
+(VOS)
+Access permissions are mapped onto VOS access-control list changes.
 
-The actual permissions set depend on the value of the C<CYGWIN>
-in the SYSTEM environment settings.  (Cygwin)
+(Cygwin)
+The actual permissions set depend on the value of the C<CYGWIN> variable
+in the SYSTEM environment settings.
 
+(Android)
 Setting the exec bit on some locations (generally F</sdcard>) will return true
-but not actually set the bit. (Android)
+but not actually set the bit.
 
 =item chown
 
-Not implemented. (Win32, S<Plan 9>, S<RISC OS>)
+(S<Plan 9>, S<RISC OS>)
+Not implemented.
 
-Does nothing, but won't fail. (Win32)
+(Win32)
+Does nothing, but won't fail.
 
-A little funky, because VOS's notion of ownership is a little funky (VOS).
+(VOS)
+A little funky, because VOS's notion of ownership is a little funky.
 
 =item chroot
 
-Not implemented. (Win32, VMS, S<Plan 9>, S<RISC OS>, VOS)
+(Win32, VMS, S<Plan 9>, S<RISC OS>, VOS)
+Not implemented.
 
 =item crypt
 
+(Win32)
 May not be available if library or source was not provided when building
-perl. (Win32)
+perl.
 
-Not implemented. (Android)
+(Android)
+Not implemented.
 
 =item dbmclose
 
-Not implemented. (VMS, S<Plan 9>, VOS)
+(VMS, S<Plan 9>, VOS)
+Not implemented.
 
 =item dbmopen
 
-Not implemented. (VMS, S<Plan 9>, VOS)
+(VMS, S<Plan 9>, VOS)
+Not implemented.
 
 =item dump
 
-Not useful. (S<RISC OS>)
+(S<RISC OS>)
+Not useful.
 
-Not supported. (Cygwin, Win32)
+(Cygwin, Win32)
+Not supported.
 
-Invokes VMS debugger. (VMS)
+(VMS)
+Invokes VMS debugger.
 
 =item exec
 
+(Win32)
 C<exec LIST> without the use of indirect object syntax (C<exec PROGRAM LIST>)
-may fall back to trying the shell if the first C<spawn()> fails.  (Win32)
+may fall back to trying the shell if the first C<spawn()> fails.
 
-Does not automatically flush output handles on some platforms.
 (SunOS, Solaris, HP-UX)
+Does not automatically flush output handles on some platforms.
 
-Not supported. (Symbian OS)
+(Symbian OS)
+Not supported.
 
 =item exit
 
-Emulates Unix C<exit()> (which considers C<exit 1> to indicate an error) by
+(VMS)
+Emulates Unix C<exit> (which considers C<exit 1> to indicate an error) by
 mapping the C<1> to C<SS$_ABORT> (C<44>).  This behavior may be overridden
-with the pragma C<use vmsish 'exit'>.  As with the CRTL's C<exit()>
-function, C<exit 0> is also mapped to an exit status of C<SS$_NORMAL>
-(C<1>); this mapping cannot be overridden.  Any other argument to
-C<exit()>
+with the pragma L<C<use vmsish 'exit'>|vmsish/C<vmsish exit>>.  As with
+the CRTL's C<exit()> function, C<exit 0> is also mapped to an exit status
+of C<SS$_NORMAL> (C<1>); this mapping cannot be overridden.  Any other
+argument to C<exit>
 is used directly as Perl's exit status.  On VMS, unless the future
 POSIX_EXIT mode is enabled, the exit code should always be a valid
 VMS exit code and not a generic number.  When the POSIX_EXIT mode is
 enabled, a generic number will be encoded in a method compatible with
 the C library _POSIX_EXIT macro so that it can be decoded by other
-programs, particularly ones written in C, like the GNV package.  (VMS)
+programs, particularly ones written in C, like the GNV package.
 
-C<exit()> resets file pointers, which is a problem when called
-from a child process (created by C<fork()>) in C<BEGIN>.
-A workaround is to use C<POSIX::_exit>.  (Solaris)
+(Solaris)
+C<exit> resets file pointers, which is a problem when called
+from a child process (created by L<C<fork>|perlfunc/fork>) in
+L<C<BEGIN>|perlmod/BEGIN, UNITCHECK, CHECK, INIT and END>.
+A workaround is to use L<C<POSIX::_exit>|POSIX/C<_exit>>.
 
     exit unless $Config{archname} =~ /\bsolaris\b/;
-    require POSIX and POSIX::_exit(0);
+    require POSIX;
+    POSIX::_exit(0);
 
 =item fcntl
 
-Not implemented. (Win32)
+(Win32)
+Not implemented.
 
-Some functions available based on the version of VMS. (VMS)
+(VMS)
+Some functions available based on the version of VMS.
 
 =item flock
 
-Not implemented (VMS, S<RISC OS>, VOS).
+(VMS, S<RISC OS>, VOS)
+Not implemented.
 
 =item fork
 
-Not implemented. (AmigaOS, S<RISC OS>, VMS)
+(AmigaOS, S<RISC OS>, VMS)
+Not implemented.
 
-Emulated using multiple interpreters.  See L<perlfork>.  (Win32)
+(Win32)
+Emulated using multiple interpreters.  See L<perlfork>.
 
-Does not automatically flush output handles on some platforms.
 (SunOS, Solaris, HP-UX)
+Does not automatically flush output handles on some platforms.
 
 =item getlogin
 
-Not implemented. (S<RISC OS>)
+(S<RISC OS>)
+Not implemented.
 
 =item getpgrp
 
-Not implemented. (Win32, VMS, S<RISC OS>)
+(Win32, VMS, S<RISC OS>)
+Not implemented.
 
 =item getppid
 
-Not implemented. (Win32, S<RISC OS>)
+(Win32, S<RISC OS>)
+Not implemented.
 
 =item getpriority
 
-Not implemented. (Win32, VMS, S<RISC OS>, VOS)
+(Win32, VMS, S<RISC OS>, VOS)
+Not implemented.
 
 =item getpwnam
 
-Not implemented. (Win32)
+(Win32)
+Not implemented.
 
-Not useful. (S<RISC OS>)
+(S<RISC OS>)
+Not useful.
 
 =item getgrnam
 
-Not implemented. (Win32, VMS, S<RISC OS>)
+(Win32, VMS, S<RISC OS>)
+Not implemented.
 
 =item getnetbyname
 
-Not implemented. (Android, Win32, S<Plan 9>)
+(Android, Win32, S<Plan 9>)
+Not implemented.
 
 =item getpwuid
 
-Not implemented. (Win32)
+(Win32)
+Not implemented.
 
-Not useful. (S<RISC OS>)
+(S<RISC OS>)
+Not useful.
 
 =item getgrgid
 
-Not implemented. (Win32, VMS, S<RISC OS>)
+(Win32, VMS, S<RISC OS>)
+Not implemented.
 
 =item getnetbyaddr
 
-Not implemented. (Android, Win32, S<Plan 9>)
+(Android, Win32, S<Plan 9>)
+Not implemented.
 
 =item getprotobynumber
 
-Not implemented. (Android)
-
-=item getservbyport
+(Android)
+Not implemented.
 
 =item getpwent
 
-Not implemented. (Android, Win32)
+(Android, Win32)
+Not implemented.
 
 =item getgrent
 
-Not implemented. (Android, Win32, VMS)
+(Android, Win32, VMS)
+Not implemented.
 
 =item gethostbyname
 
+(S<Irix 5>)
 C<gethostbyname('localhost')> does not work everywhere: you may have
-to use C<gethostbyname('127.0.0.1')>. (S<Irix 5>)
+to use C<gethostbyname('127.0.0.1')>.
 
 =item gethostent
 
-Not implemented. (Win32)
+(Win32)
+Not implemented.
 
 =item getnetent
 
-Not implemented. (Android, Win32, S<Plan 9>)
+(Android, Win32, S<Plan 9>)
+Not implemented.
 
 =item getprotoent
 
-Not implemented. (Android, Win32, S<Plan 9>)
+(Android, Win32, S<Plan 9>)
+Not implemented.
 
 =item getservent
 
-Not implemented. (Win32, S<Plan 9>)
+(Win32, S<Plan 9>)
+Not implemented.
 
 =item seekdir
 
-Not implemented. (Android)
+(Android)
+Not implemented.
 
 =item sethostent
 
-Not implemented. (Android, Win32, S<Plan 9>, S<RISC OS>)
+(Android, Win32, S<Plan 9>, S<RISC OS>)
+Not implemented.
 
 =item setnetent
 
-Not implemented. (Win32, S<Plan 9>, S<RISC OS>)
+(Win32, S<Plan 9>, S<RISC OS>)
+Not implemented.
 
 =item setprotoent
 
-Not implemented. (Android, Win32, S<Plan 9>, S<RISC OS>)
+(Android, Win32, S<Plan 9>, S<RISC OS>)
+Not implemented.
 
 =item setservent
 
-Not implemented. (S<Plan 9>, Win32, S<RISC OS>)
+(S<Plan 9>, Win32, S<RISC OS>)
+Not implemented.
 
 =item endpwent
 
-Not implemented. (Win32)
+(Win32)
+Not implemented.
 
-Either not implemented or a no-op. (Android)
+(Android)
+Either not implemented or a no-op.
 
 =item endgrent
 
-Not implemented. (Android, S<RISC OS>, VMS, Win32)
+(Android, S<RISC OS>, VMS, Win32)
+Not implemented.
 
 =item endhostent
 
-Not implemented. (Android, Win32)
+(Android, Win32)
+Not implemented.
 
 =item endnetent
 
-Not implemented. (Android, Win32, S<Plan 9>)
+(Android, Win32, S<Plan 9>)
+Not implemented.
 
 =item endprotoent
 
-Not implemented. (Android, Win32, S<Plan 9>)
+(Android, Win32, S<Plan 9>)
+Not implemented.
 
 =item endservent
 
-Not implemented. (S<Plan 9>, Win32)
+(S<Plan 9>, Win32)
+Not implemented.
 
-=item getsockopt SOCKET,LEVEL,OPTNAME
+=item getsockopt
 
-Not implemented. (S<Plan 9>)
+(S<Plan 9>)
+Not implemented.
 
 =item glob
 
-This operator is implemented via the C<File::Glob> extension on most
-platforms.  See L<File::Glob> for portability information.
+This operator is implemented via the L<C<File::Glob>|File::Glob> extension
+on most platforms.  See L<File::Glob> for portability information.
 
 =item gmtime
 
-In theory, C<gmtime()> is reliable from -2**63 to 2**63-1.  However,
-because work arounds in the implementation use floating point numbers,
+In theory, C<gmtime> is reliable from -2**63 to 2**63-1.  However,
+because work-arounds in the implementation use floating point numbers,
 it will become inaccurate as the time gets larger.  This is a bug and
 will be fixed in the future.
 
-On VOS, time values are 32-bit quantities.
+(VOS)
+Time values are 32-bit quantities.
 
-=item ioctl FILEHANDLE,FUNCTION,SCALAR
+=item ioctl
 
-Not implemented. (VMS)
+(VMS)
+Not implemented.
 
+(Win32)
 Available only for socket handles, and it does what the C<ioctlsocket()> call
-in the Winsock API does. (Win32)
+in the Winsock API does.
 
-Available only for socket handles. (S<RISC OS>)
+(S<RISC OS>)
+Available only for socket handles.
 
 =item kill
 
-Not implemented, hence not useful for taint checking. (S<RISC OS>)
+(S<RISC OS>)
+Not implemented, hence not useful for taint checking.
 
-C<kill()> doesn't have the semantics of C<raise()>, i.e. it doesn't send
-a signal to the identified process like it does on Unix platforms.
-Instead C<kill($sig, $pid)> terminates the process identified by C<$pid>,
-and makes it exit immediately with exit status $sig.  As in Unix, if
-$sig is 0 and the specified process exists, it returns true without
-actually terminating it. (Win32)
+(Win32)
+C<kill> doesn't send a signal to the identified process like it does on
+Unix platforms.  Instead C<kill($sig, $pid)> terminates the process
+identified by C<$pid>, and makes it exit immediately with exit status
+C<$sig>.  As in Unix, if C<$sig> is 0 and the specified process exists, it
+returns true without actually terminating it.
 
+(Win32)
 C<kill(-9, $pid)> will terminate the process specified by C<$pid> and
 recursively all child processes owned by it.  This is different from
 the Unix semantics, where the signal will be delivered to all
 processes in the same process group as the process specified by
-$pid. (Win32)
+C<$pid>.
 
+(VMS)
 A pid of -1 indicating all processes on the system is not currently
-supported. (VMS)
+supported.
 
 =item link
 
-Not implemented. (S<RISC OS>, VOS)
+(S<RISC OS>, VOS)
+Not implemented.
 
+(AmigaOS)
 Link count not updated because hard links are not quite that hard
-(They are sort of half-way between hard and soft links). (AmigaOS)
+(They are sort of half-way between hard and soft links).
 
+(Win32)
 Hard links are implemented on Win32 under NTFS only. They are
 natively supported on Windows 2000 and later.  On Windows NT they
 are implemented using the Windows POSIX subsystem support and the
 Perl process will need Administrator or Backup Operator privileges
 to create hard links.
 
-Available on 64 bit OpenVMS 8.2 and later.  (VMS)
+(VMS)
+Available on 64 bit OpenVMS 8.2 and later.
 
 =item localtime
 
-localtime() has the same range as L</gmtime>, but because time zone
-rules change its accuracy for historical and future times may degrade
+C<localtime> has the same range as L</gmtime>, but because time zone
+rules change, its accuracy for historical and future times may degrade
 but usually by no more than an hour.
 
 =item lstat
 
-Not implemented. (S<RISC OS>)
+(S<RISC OS>)
+Not implemented.
 
-Return values (especially for device and inode) may be bogus. (Win32)
+(Win32)
+Return values (especially for device and inode) may be bogus.
 
 =item msgctl
 
@@ -1800,36 +1927,45 @@ Return values (especially for device and inode) may be bogus. (Win32)
 
 =item msgrcv
 
-Not implemented. (Android, Win32, VMS, S<Plan 9>, S<RISC OS>, VOS)
+(Android, Win32, VMS, S<Plan 9>, S<RISC OS>, VOS)
+Not implemented.
 
 =item open
 
-open to C<|-> and C<-|> are unsupported. (Win32, S<RISC OS>)
+(Win32, S<RISC OS>)
+Open modes C<|-> and C<-|> are unsupported.
 
+(SunOS, Solaris, HP-UX)
 Opening a process does not automatically flush output handles on some
-platforms.  (SunOS, Solaris, HP-UX)
+platforms.
 
 =item readlink
 
-Not implemented. (Win32, VMS, S<RISC OS>)
+(Win32, VMS, S<RISC OS>)
+Not implemented.
 
 =item rename
 
-Can't move directories between directories on different logical volumes. (Win32)
+(Win32)
+Can't move directories between directories on different logical volumes.
 
 =item rewinddir
 
-Will not cause C<readdir()> to re-read the directory stream.  The entries
-already read before the C<rewinddir()> call will just be returned again
-from a cache buffer. (Win32)
+(Win32)
+Will not cause L<C<readdir>|perlfunc/readdir DIRHANDLE> to re-read the
+directory stream.  The entries already read before the C<rewinddir> call
+will just be returned again from a cache buffer.
 
 =item select
 
-Only implemented on sockets. (Win32, VMS)
+(Win32, VMS)
+Only implemented on sockets.
 
-Only reliable on sockets. (S<RISC OS>)
+(S<RISC OS>)
+Only reliable on sockets.
 
-Note that the C<select FILEHANDLE> form is generally portable.
+Note that the L<C<select FILEHANDLE>|perlfunc/select FILEHANDLE> form is
+generally portable.
 
 =item semctl
 
@@ -1837,27 +1973,33 @@ Note that the C<select FILEHANDLE> form is generally portable.
 
 =item semop
 
-Not implemented. (Android, Win32, VMS, S<RISC OS>)
+(Android, Win32, VMS, S<RISC OS>)
+Not implemented.
 
 =item setgrent
 
-Not implemented. (Android, VMS, Win32, S<RISC OS>)
+(Android, VMS, Win32, S<RISC OS>)
+Not implemented.
 
 =item setpgrp
 
-Not implemented. (Win32, VMS, S<RISC OS>, VOS)
+(Win32, VMS, S<RISC OS>, VOS)
+Not implemented.
 
 =item setpriority
 
-Not implemented. (Win32, VMS, S<RISC OS>, VOS)
+(Win32, VMS, S<RISC OS>, VOS)
+Not implemented.
 
 =item setpwent
 
-Not implemented. (Android, Win32, S<RISC OS>)
+(Android, Win32, S<RISC OS>)
+Not implemented.
 
 =item setsockopt
 
-Not implemented. (S<Plan 9>)
+(S<Plan 9>)
+Not implemented.
 
 =item shmctl
 
@@ -1867,154 +2009,182 @@ Not implemented. (S<Plan 9>)
 
 =item shmwrite
 
-Not implemented. (Android, Win32, VMS, S<RISC OS>)
+(Android, Win32, VMS, S<RISC OS>)
+Not implemented.
 
 =item sleep
 
+(Win32)
 Emulated using synchronization functions such that it can be
-interrupted by C<alarm()>, and limited to a maximum of 4294967 seconds,
-approximately 49 days. (Win32)
-
-=item sockatmark
-
-A relatively recent addition to socket functions, may not
-be implemented even in Unix platforms.
+interrupted by L<C<alarm>|perlfunc/alarm SECONDS>, and limited to a
+maximum of 4294967 seconds, approximately 49 days.
 
 =item socketpair
 
-Not implemented. (S<RISC OS>)
+(S<RISC OS>)
+Not implemented.
 
-Available on 64 bit OpenVMS 8.2 and later.  (VMS)
+(VMS)
+Available on 64 bit OpenVMS 8.2 and later.
 
 =item stat
 
-Platforms that do not have rdev, blksize, or blocks will return these
-as '', so numeric comparison or manipulation of these fields may cause
-'not numeric' warnings.
+Platforms that do not have C<rdev>, C<blksize>, or C<blocks> will return
+these as C<''>, so numeric comparison or manipulation of these fields may
+cause 'not numeric' warnings.
 
-ctime not supported on UFS (S<Mac OS X>).
+(S<Mac OS X>)
+C<ctime> not supported on UFS.
 
-ctime is creation time instead of inode change time  (Win32).
+(Win32)
+C<ctime> is creation time instead of inode change time.
 
-device and inode are not meaningful.  (Win32)
+(Win32)
+C<dev> and C<ino> are not meaningful.
 
-device and inode are not necessarily reliable.  (VMS)
+(VMS)
+C<dev> and C<ino> are not necessarily reliable.
 
-mtime, atime and ctime all return the last modification time.  Device and
-inode are not necessarily reliable.  (S<RISC OS>)
+(S<RISC OS>)
+C<mtime>, C<atime> and C<ctime> all return the last modification time.
+C<dev> and C<ino> are not necessarily reliable.
 
-dev, rdev, blksize, and blocks are not available.  inode is not
-meaningful and will differ between stat calls on the same file.  (os2)
+(OS/2)
+C<dev>, C<rdev>, C<blksize>, and C<blocks> are not available.  C<ino> is not
+meaningful and will differ between stat calls on the same file.
 
-some versions of cygwin when doing a C<stat("foo")> and if not finding it
-may then attempt to C<stat("foo.exe")> (Cygwin)
+(Cygwin)
+Some versions of cygwin when doing a C<stat("foo")> and not finding it
+may then attempt to C<stat("foo.exe")>.
 
-On Win32 C<stat()> needs to open the file to determine the link count
+(Win32)
+C<stat> needs to open the file to determine the link count
 and update attributes that may have been changed through hard links.
-Setting C<${^WIN32_SLOPPY_STAT}> to a true value speeds up C<stat()> by
-not performing this operation. (Win32)
+Setting L<C<${^WIN32_SLOPPY_STAT}>|perlvar/${^WIN32_SLOPPY_STAT}> to a
+true value speeds up C<stat> by not performing this operation.
 
 =item symlink
 
-Not implemented. (Win32, S<RISC OS>)
+(Win32, S<RISC OS>)
+Not implemented.
 
+(VMS)
 Implemented on 64 bit VMS 8.3.  VMS requires the symbolic link to be in Unix
 syntax if it is intended to resolve to a valid path.
 
 =item syscall
 
-Not implemented. (Win32, VMS, S<RISC OS>, VOS)
+(Win32, VMS, S<RISC OS>, VOS)
+Not implemented.
 
 =item sysopen
 
-The traditional "0", "1", and "2" MODEs are implemented with different
-numeric values on some systems.  The flags exported by C<Fcntl>
-(O_RDONLY, O_WRONLY, O_RDWR) should work everywhere though.  (S<Mac
-OS>, OS/390)
+(S<Mac OS>, OS/390)
+The traditional C<0>, C<1>, and C<2> MODEs are implemented with different
+numeric values on some systems.  The flags exported by L<C<Fcntl>|Fcntl>
+(C<O_RDONLY>, C<O_WRONLY>, C<O_RDWR>) should work everywhere though.
 
 =item system
 
+(Win32)
 As an optimization, may not call the command shell specified in
 C<$ENV{PERL5SHELL}>.  C<system(1, @args)> spawns an external
 process and immediately returns its process designator, without
 waiting for it to terminate.  Return value may be used subsequently
-in C<wait> or C<waitpid>.  Failure to C<spawn()> a subprocess is indicated
-by setting C<$?> to S<C<"255 << 8">>.  C<$?> is set in a way compatible with
-Unix (i.e. the exitstatus of the subprocess is obtained by S<C<"$? >> 8">>,
-as described in the documentation).  (Win32)
+in L<C<wait>|perlfunc/wait> or L<C<waitpid>|perlfunc/waitpid PID,FLAGS>.
+Failure to C<spawn()> a subprocess is indicated by setting
+L<C<$?>|perlvar/$?> to C<<< 255 << 8 >>>.  L<C<$?>|perlvar/$?> is set in a
+way compatible with Unix (i.e. the exit status of the subprocess is
+obtained by C<<< $? >> 8 >>>, as described in the documentation).
 
+(S<RISC OS>)
 There is no shell to process metacharacters, and the native standard is
 to pass a command line terminated by "\n" "\r" or "\0" to the spawned
 program.  Redirection such as C<< > foo >> is performed (if at all) by
-the run time library of the spawned program.  C<system> I<list> will call
-the Unix emulation library's C<exec> emulation, which attempts to provide
-emulation of the stdin, stdout, stderr in force in the parent, providing
-the child program uses a compatible version of the emulation library.
-I<scalar> will call the native command line direct and no such emulation
-of a child Unix program will exists.  Mileage B<will> vary.  (S<RISC OS>)
-
+the run time library of the spawned program.  C<system LIST> will call
+the Unix emulation library's L<C<exec>|perlfunc/exec LIST> emulation,
+which attempts to provide emulation of the stdin, stdout, stderr in force
+in the parent, provided the child program uses a compatible version of the
+emulation library.  C<system SCALAR> will call the native command line
+directly and no such emulation of a child Unix program will occur.
+Mileage B<will> vary.
+
+(Win32)
 C<system LIST> without the use of indirect object syntax (C<system PROGRAM LIST>)
-may fall back to trying the shell if the first C<spawn()> fails.  (Win32)
+may fall back to trying the shell if the first C<spawn()> fails.
 
-Does not automatically flush output handles on some platforms.
 (SunOS, Solaris, HP-UX)
+Does not automatically flush output handles on some platforms.
 
+(VMS)
 The return value is POSIX-like (shifted up by 8 bits), which only allows
 room for a made-up value derived from the severity bits of the native
-32-bit condition code (unless overridden by C<use vmsish 'status'>).
-If the native condition code is one that has a POSIX value encoded, the
-POSIX value will be decoded to extract the expected exit value.
-For more details see L<perlvms/$?>. (VMS)
+32-bit condition code (unless overridden by
+L<C<use vmsish 'status'>|vmsish/C<vmsish status>>).  If the native
+condition code is one that has a POSIX value encoded, the POSIX value will
+be decoded to extract the expected exit value.  For more details see
+L<perlvms/$?>.
 
 =item telldir
 
-Not implemented. (Android)
+(Android)
+Not implemented.
 
 =item times
 
-"cumulative" times will be bogus.  On anything other than Windows NT
+(Win32)
+"Cumulative" times will be bogus.  On anything other than Windows NT
 or Windows 2000, "system" time will be bogus, and "user" time is
-actually the time returned by the C<clock()> function in the C runtime
-library. (Win32)
+actually the time returned by the L<C<clock()>|clock(3)> function in the C
+runtime library.
 
-Not useful. (S<RISC OS>)
+(S<RISC OS>)
+Not useful.
 
 =item truncate
 
-Not implemented. (Older versions of VMS)
+(Older versions of VMS)
+Not implemented.
 
-Truncation to same-or-shorter lengths only. (VOS)
+(VOS)
+Truncation to same-or-shorter lengths only.
 
+(Win32)
 If a FILEHANDLE is supplied, it must be writable and opened in append
-mode (i.e., use C<<< open(FH, '>>filename') >>>
-or C<sysopen(FH,...,O_APPEND|O_RDWR)>.  If a filename is supplied, it
-should not be held open elsewhere. (Win32)
+mode (i.e., use C<<< open(my $fh, '>>', 'filename') >>>
+or C<sysopen(my $fh, ..., O_APPEND|O_RDWR)>.  If a filename is supplied, it
+should not be held open elsewhere.
 
 =item umask
 
-Returns undef where unavailable.
+Returns C<undef> where unavailable.
 
+(AmigaOS)
 C<umask> works but the correct permissions are set only when the file
-is finally closed. (AmigaOS)
+is finally closed.
 
 =item utime
 
-Only the modification time is updated. (VMS, S<RISC OS>)
+(VMS, S<RISC OS>)
+Only the modification time is updated.
 
+(Win32)
 May not behave as expected.  Behavior depends on the C runtime
-library's implementation of C<utime()>, and the filesystem being
-used.  The FAT filesystem typically does not support an "access
-time" field, and it may limit timestamps to a granularity of
-two seconds. (Win32)
+library's implementation of L<C<utime()>|utime(2)>, and the filesystem
+being used.  The FAT filesystem typically does not support an "access
+time" field, and it may limit timestamps to a granularity of two seconds.
 
 =item wait
 
 =item waitpid
 
+(Win32)
 Can only be applied to process handles returned for processes spawned
-using C<system(1, ...)> or pseudo processes created with C<fork()>. (Win32)
+using C<system(1, ...)> or pseudo processes created with
+L<C<fork>|perlfunc/fork>.
 
-Not useful. (S<RISC OS>)
+(S<RISC OS>)
+Not useful.
 
 =back
 
@@ -2344,6 +2514,7 @@ Nick Ing-Simmons <nick@ing-simmons.net>,
 Andreas J. KE<ouml>nig <a.koenig@mind.de>,
 Markus Laker <mlaker@contax.co.uk>,
 Andrew M. Langmead <aml@world.std.com>,
+Lukas Mai <l.mai@web.de>,
 Larry Moore <ljmoore@freespace.net>,
 Paul Moore <Paul.Moore@uk.origin-it.com>,
 Chris Nandor <pudge@pobox.com>,
index 10f9f22809b23da0da2794323007da5effe6baac..0e3928cab3a5d4ee31750eda2ea144e15872c1ed 100644 (file)
@@ -1883,6 +1883,213 @@ See L<perlrecharclass/Extended Bracketed Character Classes>.
 
 =back
 
+=head2 Backtracking
+X<backtrack> X<backtracking>
+
+NOTE: This section presents an abstract approximation of regular
+expression behavior.  For a more rigorous (and complicated) view of
+the rules involved in selecting a match among possible alternatives,
+see L</Combining RE Pieces>.
+
+A fundamental feature of regular expression matching involves the
+notion called I<backtracking>, which is currently used (when needed)
+by all regular non-possessive expression quantifiers, namely C<"*">, C<"*?">, C<"+">,
+C<"+?">, C<{n,m}>, and C<{n,m}?>.  Backtracking is often optimized
+internally, but the general principle outlined here is valid.
+
+For a regular expression to match, the I<entire> regular expression must
+match, not just part of it.  So if the beginning of a pattern containing a
+quantifier succeeds in a way that causes later parts in the pattern to
+fail, the matching engine backs up and recalculates the beginning
+part--that's why it's called backtracking.
+
+Here is an example of backtracking:  Let's say you want to find the
+word following "foo" in the string "Food is on the foo table.":
+
+    $_ = "Food is on the foo table.";
+    if ( /\b(foo)\s+(\w+)/i ) {
+        print "$2 follows $1.\n";
+    }
+
+When the match runs, the first part of the regular expression (C<\b(foo)>)
+finds a possible match right at the beginning of the string, and loads up
+C<$1> with "Foo".  However, as soon as the matching engine sees that there's
+no whitespace following the "Foo" that it had saved in C<$1>, it realizes its
+mistake and starts over again one character after where it had the
+tentative match.  This time it goes all the way until the next occurrence
+of "foo". The complete regular expression matches this time, and you get
+the expected output of "table follows foo."
+
+Sometimes minimal matching can help a lot.  Imagine you'd like to match
+everything between "foo" and "bar".  Initially, you write something
+like this:
+
+    $_ =  "The food is under the bar in the barn.";
+    if ( /foo(.*)bar/ ) {
+        print "got <$1>\n";
+    }
+
+Which perhaps unexpectedly yields:
+
+  got <d is under the bar in the >
+
+That's because C<.*> was greedy, so you get everything between the
+I<first> "foo" and the I<last> "bar".  Here it's more effective
+to use minimal matching to make sure you get the text between a "foo"
+and the first "bar" thereafter.
+
+    if ( /foo(.*?)bar/ ) { print "got <$1>\n" }
+  got <d is under the >
+
+Here's another example. Let's say you'd like to match a number at the end
+of a string, and you also want to keep the preceding part of the match.
+So you write this:
+
+    $_ = "I have 2 numbers: 53147";
+    if ( /(.*)(\d*)/ ) {                                # Wrong!
+        print "Beginning is <$1>, number is <$2>.\n";
+    }
+
+That won't work at all, because C<.*> was greedy and gobbled up the
+whole string. As C<\d*> can match on an empty string the complete
+regular expression matched successfully.
+
+    Beginning is <I have 2 numbers: 53147>, number is <>.
+
+Here are some variants, most of which don't work:
+
+    $_ = "I have 2 numbers: 53147";
+    @pats = qw{
+        (.*)(\d*)
+        (.*)(\d+)
+        (.*?)(\d*)
+        (.*?)(\d+)
+        (.*)(\d+)$
+        (.*?)(\d+)$
+        (.*)\b(\d+)$
+        (.*\D)(\d+)$
+    };
+
+    for $pat (@pats) {
+        printf "%-12s ", $pat;
+        if ( /$pat/ ) {
+            print "<$1> <$2>\n";
+        } else {
+            print "FAIL\n";
+        }
+    }
+
+That will print out:
+
+    (.*)(\d*)    <I have 2 numbers: 53147> <>
+    (.*)(\d+)    <I have 2 numbers: 5314> <7>
+    (.*?)(\d*)   <> <>
+    (.*?)(\d+)   <I have > <2>
+    (.*)(\d+)$   <I have 2 numbers: 5314> <7>
+    (.*?)(\d+)$  <I have 2 numbers: > <53147>
+    (.*)\b(\d+)$ <I have 2 numbers: > <53147>
+    (.*\D)(\d+)$ <I have 2 numbers: > <53147>
+
+As you see, this can be a bit tricky.  It's important to realize that a
+regular expression is merely a set of assertions that gives a definition
+of success.  There may be 0, 1, or several different ways that the
+definition might succeed against a particular string.  And if there are
+multiple ways it might succeed, you need to understand backtracking to
+know which variety of success you will achieve.
+
+When using lookahead assertions and negations, this can all get even
+trickier.  Imagine you'd like to find a sequence of non-digits not
+followed by "123".  You might try to write that as
+
+    $_ = "ABC123";
+    if ( /^\D*(?!123)/ ) {                # Wrong!
+        print "Yup, no 123 in $_\n";
+    }
+
+But that isn't going to match; at least, not the way you're hoping.  It
+claims that there is no 123 in the string.  Here's a clearer picture of
+why that pattern matches, contrary to popular expectations:
+
+    $x = 'ABC123';
+    $y = 'ABC445';
+
+    print "1: got $1\n" if $x =~ /^(ABC)(?!123)/;
+    print "2: got $1\n" if $y =~ /^(ABC)(?!123)/;
+
+    print "3: got $1\n" if $x =~ /^(\D*)(?!123)/;
+    print "4: got $1\n" if $y =~ /^(\D*)(?!123)/;
+
+This prints
+
+    2: got ABC
+    3: got AB
+    4: got ABC
+
+You might have expected test 3 to fail because it seems to a more
+general purpose version of test 1.  The important difference between
+them is that test 3 contains a quantifier (C<\D*>) and so can use
+backtracking, whereas test 1 will not.  What's happening is
+that you've asked "Is it true that at the start of C<$x>, following 0 or more
+non-digits, you have something that's not 123?"  If the pattern matcher had
+let C<\D*> expand to "ABC", this would have caused the whole pattern to
+fail.
+
+The search engine will initially match C<\D*> with "ABC".  Then it will
+try to match C<(?!123)> with "123", which fails.  But because
+a quantifier (C<\D*>) has been used in the regular expression, the
+search engine can backtrack and retry the match differently
+in the hope of matching the complete regular expression.
+
+The pattern really, I<really> wants to succeed, so it uses the
+standard pattern back-off-and-retry and lets C<\D*> expand to just "AB" this
+time.  Now there's indeed something following "AB" that is not
+"123".  It's "C123", which suffices.
+
+We can deal with this by using both an assertion and a negation.
+We'll say that the first part in C<$1> must be followed both by a digit
+and by something that's not "123".  Remember that the lookaheads
+are zero-width expressions--they only look, but don't consume any
+of the string in their match.  So rewriting this way produces what
+you'd expect; that is, case 5 will fail, but case 6 succeeds:
+
+    print "5: got $1\n" if $x =~ /^(\D*)(?=\d)(?!123)/;
+    print "6: got $1\n" if $y =~ /^(\D*)(?=\d)(?!123)/;
+
+    6: got ABC
+
+In other words, the two zero-width assertions next to each other work as though
+they're ANDed together, just as you'd use any built-in assertions:  C</^$/>
+matches only if you're at the beginning of the line AND the end of the
+line simultaneously.  The deeper underlying truth is that juxtaposition in
+regular expressions always means AND, except when you write an explicit OR
+using the vertical bar.  C</ab/> means match "a" AND (then) match "b",
+although the attempted matches are made at different positions because "a"
+is not a zero-width assertion, but a one-width assertion.
+
+B<WARNING>: Particularly complicated regular expressions can take
+exponential time to solve because of the immense number of possible
+ways they can use backtracking to try for a match.  For example, without
+internal optimizations done by the regular expression engine, this will
+take a painfully long time to run:
+
+    'aaaaaaaaaaaa' =~ /((a{0,5}){0,5})*[c]/
+
+And if you used C<"*">'s in the internal groups instead of limiting them
+to 0 through 5 matches, then it would take forever--or until you ran
+out of stack space.  Moreover, these internal optimizations are not
+always applicable.  For example, if you put C<{0,5}> instead of C<"*">
+on the external group, no current optimization is applicable, and the
+match takes a long time to finish.
+
+A powerful tool for optimizing such beasts is what is known as an
+"independent group",
+which does not backtrack (see L</C<< (?>pattern) >>>).  Note also that
+zero-length lookahead/lookbehind assertions will not backtrack to make
+the tail match, since they are in "logical" context: only
+whether they match is considered relevant.  For an example
+where side-effects of lookahead I<might> have influenced the
+following match, see L</C<< (?>pattern) >>>.
+
 =head2 Special Backtracking Control Verbs
 
 These special patterns are generally of the form C<(*I<VERB>:I<ARG>)>. Unless
@@ -2129,213 +2336,6 @@ C<$REGMARK> after the match completes.
 
 =back
 
-=head2 Backtracking
-X<backtrack> X<backtracking>
-
-NOTE: This section presents an abstract approximation of regular
-expression behavior.  For a more rigorous (and complicated) view of
-the rules involved in selecting a match among possible alternatives,
-see L</Combining RE Pieces>.
-
-A fundamental feature of regular expression matching involves the
-notion called I<backtracking>, which is currently used (when needed)
-by all regular non-possessive expression quantifiers, namely C<"*">, C<"*?">, C<"+">,
-C<"+?">, C<{n,m}>, and C<{n,m}?>.  Backtracking is often optimized
-internally, but the general principle outlined here is valid.
-
-For a regular expression to match, the I<entire> regular expression must
-match, not just part of it.  So if the beginning of a pattern containing a
-quantifier succeeds in a way that causes later parts in the pattern to
-fail, the matching engine backs up and recalculates the beginning
-part--that's why it's called backtracking.
-
-Here is an example of backtracking:  Let's say you want to find the
-word following "foo" in the string "Food is on the foo table.":
-
-    $_ = "Food is on the foo table.";
-    if ( /\b(foo)\s+(\w+)/i ) {
-        print "$2 follows $1.\n";
-    }
-
-When the match runs, the first part of the regular expression (C<\b(foo)>)
-finds a possible match right at the beginning of the string, and loads up
-C<$1> with "Foo".  However, as soon as the matching engine sees that there's
-no whitespace following the "Foo" that it had saved in C<$1>, it realizes its
-mistake and starts over again one character after where it had the
-tentative match.  This time it goes all the way until the next occurrence
-of "foo". The complete regular expression matches this time, and you get
-the expected output of "table follows foo."
-
-Sometimes minimal matching can help a lot.  Imagine you'd like to match
-everything between "foo" and "bar".  Initially, you write something
-like this:
-
-    $_ =  "The food is under the bar in the barn.";
-    if ( /foo(.*)bar/ ) {
-        print "got <$1>\n";
-    }
-
-Which perhaps unexpectedly yields:
-
-  got <d is under the bar in the >
-
-That's because C<.*> was greedy, so you get everything between the
-I<first> "foo" and the I<last> "bar".  Here it's more effective
-to use minimal matching to make sure you get the text between a "foo"
-and the first "bar" thereafter.
-
-    if ( /foo(.*?)bar/ ) { print "got <$1>\n" }
-  got <d is under the >
-
-Here's another example. Let's say you'd like to match a number at the end
-of a string, and you also want to keep the preceding part of the match.
-So you write this:
-
-    $_ = "I have 2 numbers: 53147";
-    if ( /(.*)(\d*)/ ) {                                # Wrong!
-        print "Beginning is <$1>, number is <$2>.\n";
-    }
-
-That won't work at all, because C<.*> was greedy and gobbled up the
-whole string. As C<\d*> can match on an empty string the complete
-regular expression matched successfully.
-
-    Beginning is <I have 2 numbers: 53147>, number is <>.
-
-Here are some variants, most of which don't work:
-
-    $_ = "I have 2 numbers: 53147";
-    @pats = qw{
-        (.*)(\d*)
-        (.*)(\d+)
-        (.*?)(\d*)
-        (.*?)(\d+)
-        (.*)(\d+)$
-        (.*?)(\d+)$
-        (.*)\b(\d+)$
-        (.*\D)(\d+)$
-    };
-
-    for $pat (@pats) {
-        printf "%-12s ", $pat;
-        if ( /$pat/ ) {
-            print "<$1> <$2>\n";
-        } else {
-            print "FAIL\n";
-        }
-    }
-
-That will print out:
-
-    (.*)(\d*)    <I have 2 numbers: 53147> <>
-    (.*)(\d+)    <I have 2 numbers: 5314> <7>
-    (.*?)(\d*)   <> <>
-    (.*?)(\d+)   <I have > <2>
-    (.*)(\d+)$   <I have 2 numbers: 5314> <7>
-    (.*?)(\d+)$  <I have 2 numbers: > <53147>
-    (.*)\b(\d+)$ <I have 2 numbers: > <53147>
-    (.*\D)(\d+)$ <I have 2 numbers: > <53147>
-
-As you see, this can be a bit tricky.  It's important to realize that a
-regular expression is merely a set of assertions that gives a definition
-of success.  There may be 0, 1, or several different ways that the
-definition might succeed against a particular string.  And if there are
-multiple ways it might succeed, you need to understand backtracking to
-know which variety of success you will achieve.
-
-When using lookahead assertions and negations, this can all get even
-trickier.  Imagine you'd like to find a sequence of non-digits not
-followed by "123".  You might try to write that as
-
-    $_ = "ABC123";
-    if ( /^\D*(?!123)/ ) {                # Wrong!
-        print "Yup, no 123 in $_\n";
-    }
-
-But that isn't going to match; at least, not the way you're hoping.  It
-claims that there is no 123 in the string.  Here's a clearer picture of
-why that pattern matches, contrary to popular expectations:
-
-    $x = 'ABC123';
-    $y = 'ABC445';
-
-    print "1: got $1\n" if $x =~ /^(ABC)(?!123)/;
-    print "2: got $1\n" if $y =~ /^(ABC)(?!123)/;
-
-    print "3: got $1\n" if $x =~ /^(\D*)(?!123)/;
-    print "4: got $1\n" if $y =~ /^(\D*)(?!123)/;
-
-This prints
-
-    2: got ABC
-    3: got AB
-    4: got ABC
-
-You might have expected test 3 to fail because it seems to a more
-general purpose version of test 1.  The important difference between
-them is that test 3 contains a quantifier (C<\D*>) and so can use
-backtracking, whereas test 1 will not.  What's happening is
-that you've asked "Is it true that at the start of C<$x>, following 0 or more
-non-digits, you have something that's not 123?"  If the pattern matcher had
-let C<\D*> expand to "ABC", this would have caused the whole pattern to
-fail.
-
-The search engine will initially match C<\D*> with "ABC".  Then it will
-try to match C<(?!123)> with "123", which fails.  But because
-a quantifier (C<\D*>) has been used in the regular expression, the
-search engine can backtrack and retry the match differently
-in the hope of matching the complete regular expression.
-
-The pattern really, I<really> wants to succeed, so it uses the
-standard pattern back-off-and-retry and lets C<\D*> expand to just "AB" this
-time.  Now there's indeed something following "AB" that is not
-"123".  It's "C123", which suffices.
-
-We can deal with this by using both an assertion and a negation.
-We'll say that the first part in C<$1> must be followed both by a digit
-and by something that's not "123".  Remember that the lookaheads
-are zero-width expressions--they only look, but don't consume any
-of the string in their match.  So rewriting this way produces what
-you'd expect; that is, case 5 will fail, but case 6 succeeds:
-
-    print "5: got $1\n" if $x =~ /^(\D*)(?=\d)(?!123)/;
-    print "6: got $1\n" if $y =~ /^(\D*)(?=\d)(?!123)/;
-
-    6: got ABC
-
-In other words, the two zero-width assertions next to each other work as though
-they're ANDed together, just as you'd use any built-in assertions:  C</^$/>
-matches only if you're at the beginning of the line AND the end of the
-line simultaneously.  The deeper underlying truth is that juxtaposition in
-regular expressions always means AND, except when you write an explicit OR
-using the vertical bar.  C</ab/> means match "a" AND (then) match "b",
-although the attempted matches are made at different positions because "a"
-is not a zero-width assertion, but a one-width assertion.
-
-B<WARNING>: Particularly complicated regular expressions can take
-exponential time to solve because of the immense number of possible
-ways they can use backtracking to try for a match.  For example, without
-internal optimizations done by the regular expression engine, this will
-take a painfully long time to run:
-
-    'aaaaaaaaaaaa' =~ /((a{0,5}){0,5})*[c]/
-
-And if you used C<"*">'s in the internal groups instead of limiting them
-to 0 through 5 matches, then it would take forever--or until you ran
-out of stack space.  Moreover, these internal optimizations are not
-always applicable.  For example, if you put C<{0,5}> instead of C<"*">
-on the external group, no current optimization is applicable, and the
-match takes a long time to finish.
-
-A powerful tool for optimizing such beasts is what is known as an
-"independent group",
-which does not backtrack (see L</C<< (?>pattern) >>>).  Note also that
-zero-length lookahead/lookbehind assertions will not backtrack to make
-the tail match, since they are in "logical" context: only
-whether they match is considered relevant.  For an example
-where side-effects of lookahead I<might> have influenced the
-following match, see L</C<< (?>pattern) >>>.
-
 =head2 Version 8 Regular Expressions
 X<regular expression, version 8> X<regex, version 8> X<regexp, version 8>
 
index b7e10594410b2268ff810a514bebaaf069d00181..12cba356f5692fb9a46584f04ea0bc7265fc40fd 100644 (file)
@@ -379,11 +379,14 @@ X<-D> X<DEBUGGING> X<-DDEBUGGING>
 
 =item B<-D>I<number>
 
-sets debugging flags.  To watch how it executes your program, use
-B<-Dtls>.  (This works only if debugging is compiled into your
-Perl.)  Another nice value is B<-Dx>, which lists your compiled
-syntax tree.  And B<-Dr> displays compiled regular expressions;
-the format of the output is explained in L<perldebguts>.
+sets debugging flags. This switch is enabled only if your perl binary has
+been built with debugging enabled: normal production perls won't have
+been.
+
+For example, to watch how perl executes your program, use B<-Dtls>.
+Another nice value is B<-Dx>, which lists your compiled syntax tree, and
+B<-Dr> displays compiled regular expressions; the format of the output is
+explained in L<perldebguts>.
 
 As an alternative, specify a number instead of list of letters (e.g.,
 B<-D14> is equivalent to B<-Dtls>):
@@ -429,8 +432,7 @@ All these flags require B<-DDEBUGGING> when you compile the Perl
 executable (but see C<:opd> in L<Devel::Peek> or L<re/'debug' mode>
 which may change this).
 See the F<INSTALL> file in the Perl source distribution
-for how to do this.  This flag is automatically set if you include B<-g>
-option when C<Configure> asks you about optimizer/debugger flags.
+for how to do this.
 
 If you're just trying to get a print out of each line of Perl code
 as it executes, the way that C<sh -x> provides for shell scripts,
index 7ddf77c172967ec712764f301a0e4ad7a6adc183..beccd3c6a44c518fc83d198c86c99393bb366c7a 100644 (file)
@@ -112,7 +112,7 @@ unallocated, for future growth.  But there have been occasions when
 a later release needed more code points than the available extras, and a
 new block had to allocated somewhere else, not contiguous to the initial
 one, to handle the overflow.  Thus, it became apparent early on that
-"block" wasn't an adequate organizing principal, and so the C<Script>
+"block" wasn't an adequate organizing principle, and so the C<Script>
 property was created.  (Later an improved script property was added as
 well, the C<Script_Extensions> property.)  Those code points that are in
 overflow blocks can still
index 684cd5318f9921ceb4118fc88c7052892b38364e..35351b773b2891d5ee22978a2400b0e697708e93 100644 (file)
@@ -715,13 +715,14 @@ conversion, which works for both v-strings or version objects:
 See the documentation of C<use VERSION> and C<require VERSION>
 for a convenient way to fail if the running Perl interpreter is too old.
 
-See also C<$]> for a decimal representation of the Perl version.
+See also C<L</$]>> for a decimal representation of the Perl version.
 
 The main advantage of C<$^V> over C<$]> is that, for Perl v5.10.0 or
 later, it overloads operators, allowing easy comparison against other
 version representations (e.g. decimal, literal v-string, "v1.2.3", or
 objects).  The disadvantage is that prior to v5.10.0, it was only a
-literal v-string, which can't be easily printed or compared.
+literal v-string, which can't be easily printed or compared, whereas
+the behavior of C<$]> is unchanged on all versions of Perl.
 
 Mnemonic: use ^V for a version object.
 
diff --git a/pp.c b/pp.c
index 4771134c7c7a54ccfbd720a2a21677116705be9d..49b6abe6a449b74b2844dae72ecf53d01214186f 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -3544,18 +3544,11 @@ PP(pp_index)
            sv_usepvn(temp, pv, llen);
            little_p = SvPVX(little);
        } else {
-           temp = little_utf8
-               ? newSVpvn(big_p, biglen) : newSVpvn(little_p, llen);
+           temp = newSVpvn(little_p, llen);
 
            sv_utf8_upgrade(temp);
-           if (little_utf8) {
-               big = temp;
-               big_utf8 = TRUE;
-               big_p = SvPV_const(big, biglen);
-           } else {
-               little = temp;
-               little_p = SvPV_const(little, llen);
-           }
+           little = temp;
+           little_p = SvPV_const(little, llen);
        }
     }
     if (SvGAMAGIC(big)) {
@@ -4116,8 +4109,7 @@ PP(pp_uc)
                      * allocate without allocating too much.  Such is life.
                      * See corresponding comment in lc code for another option
                      * */
-                    SvGROW(dest, min);
-                    d = (U8*)SvPVX(dest) + o;
+                    d = o + (U8*) SvGROW(dest, min);
                 }
                 Copy(tmpbuf, d, ulen, U8);
                 d += ulen;
@@ -4181,8 +4173,7 @@ PP(pp_uc)
                         * ASCII.  If not enough room, grow the string */
                        if (SvLEN(dest) < ++min) {      
                            const UV o = d - (U8*)SvPVX_const(dest);
-                           SvGROW(dest, min);
-                           d = (U8*)SvPVX(dest) + o;
+                           d = o + (U8*) SvGROW(dest, min);
                        }
                        *d++ = 'S'; *d = 'S'; /* upper case is 'SS' */
                        continue;   /* Back to the tight loop; still in ASCII */
@@ -4332,8 +4323,7 @@ PP(pp_lc)
                 * Another option would be to grow an extra byte or two more
                 * each time we need to grow, which would cut down the million
                 * to 500K, with little waste */
-               SvGROW(dest, min);
-               d = (U8*)SvPVX(dest) + o;
+               d = o + (U8*) SvGROW(dest, min);
            }
 
            /* Copy the newly lowercased letter to the output buffer we're
@@ -4527,8 +4517,7 @@ PP(pp_fc)
 
             if (ulen > u && (SvLEN(dest) < (min += ulen - u))) {
                 const UV o = d - (U8*)SvPVX_const(dest);
-                SvGROW(dest, min);
-                d = (U8*)SvPVX(dest) + o;
+                d = o + (U8*) SvGROW(dest, min);
             }
 
             Copy(tmpbuf, d, ulen, U8);
@@ -4607,8 +4596,7 @@ PP(pp_fc)
                      * becomes "ss", which may require growing the SV. */
                     if (SvLEN(dest) < ++min) {
                         const UV o = d - (U8*)SvPVX_const(dest);
-                        SvGROW(dest, min);
-                        d = (U8*)SvPVX(dest) + o;
+                        d = o + (U8*) SvGROW(dest, min);
                      }
                     *(d)++ = 's';
                     *d = 's';
@@ -6174,7 +6162,7 @@ PP(pp_lock)
 }
 
 
-/* used for: pp_padany(), pp_mapstart(), pp_custom(); plus any system ops
+/* used for: pp_padany(), pp_custom(); plus any system ops
  * that aren't implemented on a particular platform */
 
 PP(unimplemented_op)
@@ -6615,6 +6603,226 @@ PP(pp_anonconst)
     RETURN;
 }
 
+
+/* process one subroutine argument - typically when the sub has a signature:
+ * introduce PL_curpad[op_targ] and assign to it the value
+ *  for $:   (OPf_STACKED ? *sp : $_[N])
+ *  for @/%: @_[N..$#_]
+ *
+ * It's equivalent to 
+ *    my $foo = $_[N];
+ * or
+ *    my $foo = (value-on-stack)
+ * or
+ *    my @foo = @_[N..$#_]
+ * etc
+ */
+
+PP(pp_argelem)
+{
+    dTARG;
+    SV *val;
+    SV ** padentry;
+    OP *o = PL_op;
+    AV *defav = GvAV(PL_defgv); /* @_ */
+    IV ix = PTR2IV(cUNOP_AUXo->op_aux);
+    IV argc;
+
+    /* do 'my $var, @var or %var' action */
+    padentry = &(PAD_SVl(o->op_targ));
+    save_clearsv(padentry);
+    targ = *padentry;
+
+    if ((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_SV) {
+        if (o->op_flags & OPf_STACKED) {
+            dSP;
+            val = POPs;
+            PUTBACK;
+        }
+        else {
+            SV **svp;
+            /* should already have been checked */
+            assert(ix >= 0);
+#if IVSIZE > PTRSIZE
+            assert(ix <= SSize_t_MAX);
+#endif
+
+            svp = av_fetch(defav, ix, FALSE);
+            val = svp ? *svp : &PL_sv_undef;
+        }
+
+        /* $var = $val */
+
+        /* cargo-culted from pp_sassign */
+        assert(TAINTING_get || !TAINT_get);
+        if (UNLIKELY(TAINT_get) && !SvTAINTED(val))
+            TAINT_NOT;
+
+        SvSetMagicSV(targ, val);
+        return o->op_next;
+    }
+
+    /* must be AV or HV */
+
+    assert(!(o->op_flags & OPf_STACKED));
+    argc = ((IV)AvFILL(defav) + 1) - ix;
+
+    /* This is a copy of the relevant parts of pp_aassign().
+     */
+    if ((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_AV) {
+        IV i;
+
+        if (AvFILL((AV*)targ) > -1) {
+            /* target should usually be empty. If we get get
+             * here, someone's been doing some weird closure tricks.
+             * Make a copy of all args before clearing the array,
+             * to avoid the equivalent of @a = ($a[0]) prematurely freeing
+             * elements. See similar code in pp_aassign.
+             */
+            for (i = 0; i < argc; i++) {
+                SV **svp = av_fetch(defav, ix + i, FALSE);
+                SV *newsv = newSV(0);
+                sv_setsv_flags(newsv,
+                                svp ? *svp : &PL_sv_undef,
+                                (SV_DO_COW_SVSETSV|SV_NOSTEAL));
+                if (!av_store(defav, ix + i, newsv))
+                    SvREFCNT_dec_NN(newsv);
+            }
+            av_clear((AV*)targ);
+        }
+
+        if (argc <= 0)
+            return o->op_next;
+
+        av_extend((AV*)targ, argc);
+
+        i = 0;
+        while (argc--) {
+            SV *tmpsv;
+            SV **svp = av_fetch(defav, ix + i, FALSE);
+            SV *val = svp ? *svp : &PL_sv_undef;
+            tmpsv = newSV(0);
+            sv_setsv(tmpsv, val);
+            av_store((AV*)targ, i++, tmpsv);
+            TAINT_NOT;
+        }
+
+    }
+    else {
+        IV i;
+
+        assert((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_HV);
+
+        if (SvRMAGICAL(targ) || HvUSEDKEYS((HV*)targ)) {
+            /* see "target should usually be empty" comment above */
+            for (i = 0; i < argc; i++) {
+                SV **svp = av_fetch(defav, ix + i, FALSE);
+                SV *newsv = newSV(0);
+                sv_setsv_flags(newsv,
+                                svp ? *svp : &PL_sv_undef,
+                                (SV_DO_COW_SVSETSV|SV_NOSTEAL));
+                if (!av_store(defav, ix + i, newsv))
+                    SvREFCNT_dec_NN(newsv);
+            }
+            hv_clear((HV*)targ);
+        }
+
+        if (argc <= 0)
+            return o->op_next;
+        assert(argc % 2 == 0);
+
+        i = 0;
+        while (argc) {
+            SV *tmpsv;
+            SV **svp;
+            SV *key;
+            SV *val;
+
+            svp = av_fetch(defav, ix + i++, FALSE);
+            key = svp ? *svp : &PL_sv_undef;
+            svp = av_fetch(defav, ix + i++, FALSE);
+            val = svp ? *svp : &PL_sv_undef;
+
+            argc -= 2;
+            if (UNLIKELY(SvGMAGICAL(key)))
+                key = sv_mortalcopy(key);
+            tmpsv = newSV(0);
+            sv_setsv(tmpsv, val);
+            hv_store_ent((HV*)targ, key, tmpsv, 0);
+            TAINT_NOT;
+        }
+    }
+
+    return o->op_next;
+}
+
+/* Handle a default value for one subroutine argument (typically as part
+ * of a subroutine signature).
+ * It's equivalent to
+ *    @_ > op_targ ? $_[op_targ] : result_of(op_other)
+ *
+ * Intended to be used where op_next is an OP_ARGELEM
+ *
+ * We abuse the op_targ field slightly: it's an index into @_ rather than
+ * into PL_curpad.
+ */
+
+PP(pp_argdefelem)
+{
+    OP * const o = PL_op;
+    AV *defav = GvAV(PL_defgv); /* @_ */
+    IV ix = (IV)o->op_targ;
+
+    assert(ix >= 0);
+#if IVSIZE > PTRSIZE
+    assert(ix <= SSize_t_MAX);
+#endif
+
+    if (AvFILL(defav) >= ix) {
+        dSP;
+        SV **svp = av_fetch(defav, ix, FALSE);
+        SV  *val = svp ? *svp : &PL_sv_undef;
+        XPUSHs(val);
+        RETURN;
+    }
+    return cLOGOPo->op_other;
+}
+
+
+
+/* Check a  a subs arguments - i.e. that it has the correct number of args
+ * (and anything else we might think of in future). Typically used with
+ * signatured subs.
+ */
+
+PP(pp_argcheck)
+{
+    OP * const o       = PL_op;
+    UNOP_AUX_item *aux = cUNOP_AUXo->op_aux;
+    IV   params        = aux[0].iv;
+    IV   opt_params    = aux[1].iv;
+    char slurpy        = (char)(aux[2].iv);
+    AV  *defav         = GvAV(PL_defgv); /* @_ */
+    IV   argc;
+    bool too_few;
+
+    assert(!SvMAGICAL(defav));
+    argc = (AvFILLp(defav) + 1);
+    too_few = (argc < (params - opt_params));
+
+    if (UNLIKELY(too_few || (!slurpy && argc > params)))
+        /* diag_listed_as: Too few arguments for subroutine */
+        /* diag_listed_as: Too many arguments for subroutine */
+        Perl_croak_caller("Too %s arguments for subroutine",
+                            too_few ? "few" : "many");
+
+    if (UNLIKELY(slurpy == '%' && argc > params && (argc - params) % 2))
+        Perl_croak_caller("Odd name/value argument for subroutine");
+
+
+    return NORMAL;
+}
+
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */
diff --git a/pp.h b/pp.h
index d3d8f988ee0b5cc7ec45d2653856938f813eac5c..98d1a434ec649fde96138e70234e0433b6415146 100644 (file)
--- a/pp.h
+++ b/pp.h
@@ -55,9 +55,7 @@ Refetch the stack pointer.  Used after a callback.  See L<perlcall>.
 #define MARK mark
 #define TARG targ
 
-#if defined(DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS)
-
-#  define PUSHMARK(p) \
+#define PUSHMARK(p) \
     STMT_START {                                                      \
         I32 * mark_stack_entry;                                       \
         if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr)          \
@@ -69,44 +67,16 @@ Refetch the stack pointer.  Used after a callback.  See L<perlcall>.
                 PL_markstack_ptr, (IV)*mark_stack_entry)));           \
     } STMT_END
 
-#  define TOPMARK \
-    ({                                                                \
-        DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,                 \
-                "MARK top  %p %"IVdf"\n",                             \
-                PL_markstack_ptr, (IV)*PL_markstack_ptr)));           \
-        *PL_markstack_ptr;                                            \
-    })
+#define TOPMARK S_TOPMARK(aTHX)
+#define POPMARK S_POPMARK(aTHX)
 
-#  define POPMARK \
-    ({                                                                \
-        DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,                 \
-                "MARK pop  %p %"IVdf"\n",                             \
-                (PL_markstack_ptr-1), (IV)*(PL_markstack_ptr-1))));   \
-        assert((PL_markstack_ptr > PL_markstack) || !"MARK underflow");\
-        *PL_markstack_ptr--;                                          \
-    })
-
-#  define INCMARK \
-    ({                                                                \
+#define INCMARK \
+    STMT_START {                                                      \
         DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log,                 \
                 "MARK inc  %p %"IVdf"\n",                             \
                 (PL_markstack_ptr+1), (IV)*(PL_markstack_ptr+1))));   \
-        *PL_markstack_ptr++;                                          \
-    })
-
-#else
-
-#  define PUSHMARK(p)                                                   \
-    STMT_START {                                                     \
-        I32 * mark_stack_entry;                                       \
-        if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) == PL_markstack_max)) \
-           mark_stack_entry = markstack_grow();                      \
-        *mark_stack_entry  = (I32)((p) - PL_stack_base);              \
+        PL_markstack_ptr++;                                           \
     } STMT_END
-#  define TOPMARK                (*PL_markstack_ptr)
-#  define POPMARK                (*PL_markstack_ptr--)
-#  define INCMARK                (*PL_markstack_ptr++)
-#endif
 
 #define dSP            SV **sp = PL_stack_sp
 #define djSP           dSP
index 5a66e267a76869b2956ed50c1d2a2c038c4ff9ed..0d7628665d4f31921152075af8b73abfb994e08a 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -927,6 +927,7 @@ PP(pp_formline)
     }
 }
 
+/* also used for: pp_mapstart() */
 PP(pp_grepstart)
 {
     dSP;
@@ -1598,7 +1599,7 @@ Perl_qerror(pTHX_ SV *err)
 static void
 S_pop_eval_context_maybe_croak(pTHX_ PERL_CONTEXT *cx, SV *errsv, int action)
 {
-    SV  *namesv;
+    SV  *namesv = NULL; /* init to avoid dumb compiler warning */
     bool do_croak;
 
     CX_LEAVE_SCOPE(cx);
index 87346871d651f803ff834903d9bbeda7de87ebca..a794fd525e4e0772fc21230fcfd34caba0f88770 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -830,7 +830,7 @@ PP(pp_aelemfast)
     /* inlined av_fetch() for simple cases ... */
     if (!SvRMAGICAL(av) && key >= 0 && key <= AvFILLp(av)) {
         sv = AvARRAY(av)[key];
-        if (sv && !SvIS_FREED(sv)) {
+        if (sv) {
             PUSHs(sv);
             RETURN;
         }
@@ -4023,6 +4023,28 @@ Perl_sub_crush_depth(pTHX_ CV *cv)
     }
 }
 
+
+
+/* like croak, but report in context of caller */
+
+void
+Perl_croak_caller(const char *pat, ...)
+{
+    dTHX;
+    va_list args;
+    const PERL_CONTEXT *cx = caller_cx(0, NULL);
+
+    /* make error appear at call site */
+    assert(cx);
+    PL_curcop = cx->blk_oldcop;
+
+    va_start(args, pat);
+    vcroak(pat, &args);
+    NOT_REACHED; /* NOTREACHED */
+    va_end(args);
+}
+
+
 PP(pp_aelem)
 {
     dSP;
index 891d2e2d42a7b9b517174b8c88a6c75594bd1d8a..40c310003c4890aaf7a53fcae11175d312ad23b1 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -3042,7 +3042,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                     * of pack() (and all copies of the result) are
                     * gone.
                     */
-                   if ((SvTEMP(fromstr) || (SvPADTMP(fromstr) &&
+                   if (((SvTEMP(fromstr) && SvREFCNT(fromstr) == 1)
+                        || (SvPADTMP(fromstr) &&
                             !SvREADONLY(fromstr)))) {
                        Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
                                       "Attempt to pack pointer to temporary value");
index fd54df8e451f886b5f71065e816fa8b630b9a895..16b172934840f1e06fec5a4a1bcd61c6b9961171 100644 (file)
@@ -19,6 +19,9 @@ PERL_CALLCONV OP *Perl_pp_anoncode(pTHX);
 PERL_CALLCONV OP *Perl_pp_anonconst(pTHX);
 PERL_CALLCONV OP *Perl_pp_anonhash(pTHX);
 PERL_CALLCONV OP *Perl_pp_anonlist(pTHX);
+PERL_CALLCONV OP *Perl_pp_argcheck(pTHX);
+PERL_CALLCONV OP *Perl_pp_argdefelem(pTHX);
+PERL_CALLCONV OP *Perl_pp_argelem(pTHX);
 PERL_CALLCONV OP *Perl_pp_aslice(pTHX);
 PERL_CALLCONV OP *Perl_pp_atan2(pTHX);
 PERL_CALLCONV OP *Perl_pp_av2arylen(pTHX);
index c91aab06f63777c8747e4f218618022995b3dee8..4f0553b8084eb2f1c769a63eccf6b9961c48c348 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1482,7 +1482,6 @@ PP(pp_sort)
     bool hasargs = FALSE;
     bool copytmps;
     I32 is_xsub = 0;
-    I32 sorting_av = 0;
     const U8 priv = PL_op->op_private;
     const U8 flags = PL_op->op_flags;
     U32 sort_flags = 0;
@@ -1563,34 +1562,31 @@ PP(pp_sort)
        PL_sortcop = NULL;
     }
 
-    /* optimiser converts "@a = sort @a" to "sort \@a";
-     * in case of tied @a, pessimise: push (@a) onto stack, then assign
-     * result back to @a at the end of this function */
+    /* optimiser converts "@a = sort @a" to "sort \@a".  In this case,
+     * push (@a) onto stack, then assign result back to @a at the end of
+     * this function */
     if (priv & OPpSORT_INPLACE) {
        assert( MARK+1 == SP && *SP && SvTYPE(*SP) == SVt_PVAV);
        (void)POPMARK; /* remove mark associated with ex-OP_AASSIGN */
        av = MUTABLE_AV((*SP));
+        if (SvREADONLY(av))
+            Perl_croak_no_modify();
        max = AvFILL(av) + 1;
+        MEXTEND(SP, max);
        if (SvMAGICAL(av)) {
-           MEXTEND(SP, max);
            for (i=0; i < max; i++) {
                SV **svp = av_fetch(av, i, FALSE);
                *SP++ = (svp) ? *svp : NULL;
            }
-           SP--;
-           p1 = p2 = SP - (max-1);
        }
-       else {
-           if (SvREADONLY(av))
-               Perl_croak_no_modify();
-           else
-           {
-               SvREADONLY_on(av);
-               save_pushptr((void *)av, SAVEt_READONLY_OFF);
-           }
-           p1 = p2 = AvARRAY(av);
-           sorting_av = 1;
+        else {
+            SV **svp = AvARRAY(av);
+            assert(svp || max == 0);
+           for (i = 0; i < max; i++)
+                *SP++ = *svp++;
        }
+        SP--;
+        p1 = p2 = SP - (max-1);
     }
     else {
        p2 = MARK+1;
@@ -1600,7 +1596,7 @@ PP(pp_sort)
     /* shuffle stack down, removing optional initial cv (p1!=p2), plus
      * any nulls; also stringify or converting to integer or number as
      * required any args */
-    copytmps = !sorting_av && PL_sortcop;
+    copytmps = cBOOL(PL_sortcop);
     for (i=max; i > 0 ; i--) {
        if ((*p1 = *p2++)) {                    /* Weed out nulls. */
            if (copytmps && SvPADTMP(*p1)) {
@@ -1633,9 +1629,6 @@ PP(pp_sort)
        else
            max--;
     }
-    if (sorting_av)
-       AvFILLp(av) = max-1;
-
     if (max > 1) {
        SV **start;
        if (PL_sortcop) {
@@ -1716,7 +1709,7 @@ PP(pp_sort)
        }
        else {
            MEXTEND(SP, 20);    /* Can't afford stack realloc on signal. */
-           start = sorting_av ? AvARRAY(av) : ORIGMARK+1;
+           start = ORIGMARK+1;
            sortsvp(aTHX_ start, max,
                    (priv & OPpSORT_NUMERIC)
                        ? ( ( ( priv & OPpSORT_INTEGER) || all_SIVs)
@@ -1742,27 +1735,51 @@ PP(pp_sort)
            }
        }
     }
-    if (sorting_av)
-       SvREADONLY_off(av);
-    else if (av && !sorting_av) {
-       /* simulate pp_aassign of tied AV */
-       SV** const base = MARK+1;
-       for (i=0; i < max; i++) {
-           base[i] = newSVsv(base[i]);
-       }
-       av_clear(av);
-       av_extend(av, max);
-       for (i=0; i < max; i++) {
-           SV * const sv = base[i];
-           SV ** const didstore = av_store(av, i, sv);
-           if (SvSMAGICAL(sv))
-               mg_set(sv);
-           if (!didstore)
-               sv_2mortal(sv);
-       }
+
+    if (av) {
+        /* copy back result to the array */
+        SV** const base = MARK+1;
+        if (SvMAGICAL(av)) {
+            for (i = 0; i < max; i++)
+                base[i] = newSVsv(base[i]);
+            av_clear(av);
+            av_extend(av, max);
+            for (i=0; i < max; i++) {
+                SV * const sv = base[i];
+                SV ** const didstore = av_store(av, i, sv);
+                if (SvSMAGICAL(sv))
+                    mg_set(sv);
+                if (!didstore)
+                    sv_2mortal(sv);
+            }
+        }
+        else {
+            /* the elements of av are likely to be the same as the
+             * (non-refcounted) elements on the stack, just in a different
+             * order. However, its possible that someone's messed with av
+             * in the meantime. So bump and unbump the relevant refcounts
+             * first.
+             */
+            for (i = 0; i < max; i++) {
+                SV *sv = base[i];
+                assert(sv);
+                if (SvREFCNT(sv) > 1)
+                    base[i] = newSVsv(sv);
+                else
+                    SvREFCNT_inc_simple_void_NN(sv);
+            }
+            av_clear(av);
+            if (max > 0) {
+                av_extend(av, max);
+                Copy(base, AvARRAY(av), max, SV*);
+            }
+            AvFILLp(av) = max - 1;
+            AvREIFY_off(av);
+            AvREAL_on(av);
+        }
     }
     LEAVE;
-    PL_stack_sp = ORIGMARK + (sorting_av ? 0 : max);
+    PL_stack_sp = ORIGMARK +  max;
     return nextop;
 }
 
index 3bf2673112ce53b5ae2756fd44ff9fdce750d61a..d16a0e5da1ae77a9ab612d17305aa7cf73e50e2f 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -4934,9 +4934,7 @@ S_space_join_names_mortal(pTHX_ char *const *array)
 {
     SV *target;
 
-    PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL;
-
-    if (*array) {
+    if (array && *array) {
        target = newSVpvs_flags("", SVs_TEMP);
        while (1) {
            sv_catpv(target, *array);
diff --git a/proto.h b/proto.h
index ec2ae330f09d8a16c3c5bd12c2debf711a8266d2..9047bc638b7537e82e1e1952d37042d93903a627 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -36,7 +36,6 @@ PERL_CALLCONV UV      NATIVE_TO_NEED(const UV enc, const UV ch)
 
 PERL_CALLCONV const char *     Perl_PerlIO_context_layers(pTHX_ const char *mode);
 PERL_CALLCONV void*    Perl_Slab_Alloc(pTHX_ size_t sz)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV void     Perl_Slab_Free(pTHX_ void *op);
@@ -108,6 +107,7 @@ PERL_CALLCONV UV    Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN
 #define PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS  \
        assert(p); assert(ustrp)
 PERL_CALLCONV void     Perl__warn_problematic_locale(void);
+PERL_CALLCONV LOGOP*   Perl_alloc_LOGOP(pTHX_ I32 type, OP *first, OP *other);
 PERL_CALLCONV PADOFFSET        Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags);
 #define PERL_ARGS_ASSERT_ALLOCMY       \
        assert(name)
@@ -546,6 +546,10 @@ PERL_CALLCONV_NO_RET void  Perl_croak(pTHX_ const char* pat, ...)
                        __attribute__noreturn__
                        __attribute__format__null_ok__(__printf__,pTHX_1,pTHX_2);
 
+PERL_CALLCONV_NO_RET void      Perl_croak_caller(const char* pat, ...)
+                       __attribute__noreturn__
+                       __attribute__format__null_ok__(__printf__,1,2);
+
 PERL_STATIC_NO_RET void        S_croak_memory_wrap(void)
                        __attribute__noreturn__;
 
@@ -1994,16 +1998,13 @@ PERL_CALLCONV int       Perl_my_vsnprintf(char *buffer, const Size_t len, const char *
        assert(buffer); assert(format)
 PERL_CALLCONV OP*      Perl_newANONATTRSUB(pTHX_ I32 floor, OP *proto, OP *attrs, OP *block);
 PERL_CALLCONV OP*      Perl_newANONHASH(pTHX_ OP* o)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newANONLIST(pTHX_ OP* o)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newANONSUB(pTHX_ I32 floor, OP* proto, OP* block);
 PERL_CALLCONV OP*      Perl_newASSIGNOP(pTHX_ I32 flags, OP* left, I32 optype, OP* right)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 /* PERL_CALLCONV CV*   newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block); */
@@ -2014,17 +2015,14 @@ PERL_CALLCONV AV*       Perl_newAV(pTHX)
 #endif
 
 PERL_CALLCONV OP*      Perl_newAVREF(pTHX_ OP* o)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWAVREF      \
        assert(o)
 
 PERL_CALLCONV OP*      Perl_newBINOP(pTHX_ I32 type, I32 flags, OP* first, OP* last)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newCONDOP(pTHX_ I32 flags, OP* first, OP* trueop, OP* falseop)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWCONDOP     \
        assert(first)
@@ -2032,7 +2030,6 @@ PERL_CALLCONV OP* Perl_newCONDOP(pTHX_ I32 flags, OP* first, OP* trueop, OP* fal
 PERL_CALLCONV CV*      Perl_newCONSTSUB(pTHX_ HV* stash, const char* name, SV* sv);
 PERL_CALLCONV CV*      Perl_newCONSTSUB_flags(pTHX_ HV* stash, const char* name, STRLEN len, U32 flags, SV* sv);
 PERL_CALLCONV OP*      Perl_newCVREF(pTHX_ I32 flags, OP* o)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newDEFSVOP(pTHX)
@@ -2040,13 +2037,11 @@ PERL_CALLCONV OP*       Perl_newDEFSVOP(pTHX)
 
 PERL_CALLCONV void     Perl_newFORM(pTHX_ I32 floor, OP* o, OP* block);
 PERL_CALLCONV OP*      Perl_newFOROP(pTHX_ I32 flags, OP* sv, OP* expr, OP* block, OP* cont)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWFOROP      \
        assert(expr)
 
 PERL_CALLCONV OP*      Perl_newGIVENOP(pTHX_ OP* cond, OP* block, PADOFFSET defsv_off)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWGIVENOP    \
        assert(cond); assert(block)
@@ -2055,18 +2050,15 @@ PERL_CALLCONV GP *      Perl_newGP(pTHX_ GV *const gv);
 #define PERL_ARGS_ASSERT_NEWGP \
        assert(gv)
 PERL_CALLCONV OP*      Perl_newGVOP(pTHX_ I32 type, I32 flags, GV* gv)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWGVOP       \
        assert(gv)
 
 PERL_CALLCONV OP*      Perl_newGVREF(pTHX_ I32 type, OP* o)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 /* PERL_CALLCONV GV*   newGVgen(pTHX_ const char* pack); */
 PERL_CALLCONV GV*      Perl_newGVgen_flags(pTHX_ const char* pack, U32 flags)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWGVGEN_FLAGS        \
        assert(pack)
@@ -2077,49 +2069,40 @@ PERL_CALLCONV HV*       Perl_newHV(pTHX)
 #endif
 
 PERL_CALLCONV OP*      Perl_newHVREF(pTHX_ OP* o)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWHVREF      \
        assert(o)
 
 PERL_CALLCONV HV*      Perl_newHVhv(pTHX_ HV *hv)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 #ifndef NO_MATHOMS
 PERL_CALLCONV IO*      Perl_newIO(pTHX)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #endif
 
 PERL_CALLCONV OP*      Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP* first, OP* last)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newLOGOP(pTHX_ I32 optype, I32 flags, OP *first, OP *other)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWLOGOP      \
        assert(first); assert(other)
 
 PERL_CALLCONV OP*      Perl_newLOOPEX(pTHX_ I32 type, OP* label)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWLOOPEX     \
        assert(label)
 
 PERL_CALLCONV OP*      Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP* expr, OP* block)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newMETHOP(pTHX_ I32 type, I32 flags, OP* dynamic_meth)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWMETHOP     \
        assert(dynamic_meth)
 
 PERL_CALLCONV OP*      Perl_newMETHOP_named(pTHX_ I32 type, I32 flags, SV* const_meth)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWMETHOP_NAMED       \
        assert(const_meth)
@@ -2128,64 +2111,52 @@ PERL_CALLCONV CV *      Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, O
 #define PERL_ARGS_ASSERT_NEWMYSUB      \
        assert(o)
 PERL_CALLCONV OP*      Perl_newNULLLIST(pTHX)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newOP(pTHX_ I32 optype, I32 flags)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV PADNAMELIST *    Perl_newPADNAMELIST(size_t max)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV PADNAME *        Perl_newPADNAMEouter(PADNAME *outer)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWPADNAMEOUTER       \
        assert(outer)
 
 PERL_CALLCONV PADNAME *        Perl_newPADNAMEpvn(const char *s, STRLEN len)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWPADNAMEPVN \
        assert(s)
 
 PERL_CALLCONV OP*      Perl_newPMOP(pTHX_ I32 type, I32 flags)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV void     Perl_newPROG(pTHX_ OP* o);
 #define PERL_ARGS_ASSERT_NEWPROG       \
        assert(o)
 PERL_CALLCONV OP*      Perl_newPVOP(pTHX_ I32 type, I32 flags, char* pv)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newRANGE(pTHX_ I32 flags, OP* left, OP* right)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWRANGE      \
        assert(left); assert(right)
 
 PERL_CALLCONV SV*      Perl_newRV(pTHX_ SV *const sv)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWRV \
        assert(sv)
 
 PERL_CALLCONV SV*      Perl_newRV_noinc(pTHX_ SV *const tmpRef)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWRV_NOINC   \
        assert(tmpRef)
 
 PERL_CALLCONV OP*      Perl_newSLICEOP(pTHX_ I32 flags, OP* subscript, OP* listop)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newSTATEOP(pTHX_ I32 flags, char* label, OP* o)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV CV*      Perl_newSTUB(pTHX_ GV *gv, bool fake);
@@ -2195,97 +2166,77 @@ PERL_CALLCONV CV*       Perl_newSTUB(pTHX_ GV *gv, bool fake);
 PERL_CALLCONV CV*      Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block);
 #endif
 PERL_CALLCONV SV*      Perl_newSV(pTHX_ const STRLEN len)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newSVOP(pTHX_ I32 type, I32 flags, SV* sv)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWSVOP       \
        assert(sv)
 
 PERL_CALLCONV OP*      Perl_newSVREF(pTHX_ OP* o)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWSVREF      \
        assert(o)
 
 PERL_CALLCONV SV*      Perl_newSV_type(pTHX_ const svtype type)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_newSVavdefelem(pTHX_ AV *av, SSize_t ix, bool extendible)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWSVAVDEFELEM        \
        assert(av)
 
 PERL_CALLCONV SV*      Perl_newSVhek(pTHX_ const HEK *const hek)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_newSViv(pTHX_ const IV i)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_newSVnv(pTHX_ const NV n)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_newSVpv(pTHX_ const char *const s, const STRLEN len)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_newSVpv_share(pTHX_ const char* s, U32 hash)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_newSVpvf(pTHX_ const char *const pat, ...)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__
                        __attribute__format__(__printf__,pTHX_1,pTHX_2);
 #define PERL_ARGS_ASSERT_NEWSVPVF      \
        assert(pat)
 
 PERL_CALLCONV SV*      Perl_newSVpvn(pTHX_ const char *const s, const STRLEN len)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_newSVpvn_flags(pTHX_ const char *const s, const STRLEN len, const U32 flags)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_newSVpvn_share(pTHX_ const char* s, I32 len, U32 hash)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_newSVrv(pTHX_ SV *const rv, const char *const classname);
 #define PERL_ARGS_ASSERT_NEWSVRV       \
        assert(rv)
 PERL_CALLCONV SV*      Perl_newSVsv(pTHX_ SV *const old)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_newSVuv(pTHX_ const UV u)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newUNOP(pTHX_ I32 type, I32 flags, OP* first)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newUNOP_AUX(pTHX_ I32 type, I32 flags, OP* first, UNOP_AUX_item *aux)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV OP*      Perl_newWHENOP(pTHX_ OP* cond, OP* block)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWWHENOP     \
        assert(block)
 
 PERL_CALLCONV OP*      Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP* loop, OP* expr, OP* block, OP* cont, I32 has_my)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV CV*      Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename);
@@ -2306,14 +2257,12 @@ PERL_CALLCONV void      Perl_new_ctype(pTHX_ const char* newctype);
        assert(newctype)
 PERL_CALLCONV void     Perl_new_numeric(pTHX_ const char* newcoll);
 PERL_CALLCONV PERL_SI* Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_new_version(pTHX_ SV *ver);
 #define PERL_ARGS_ASSERT_NEW_VERSION   \
        assert(ver)
 PERL_CALLCONV STRLEN * Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits, STRLEN size)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEW_WARNINGS_BITFIELD \
        assert(bits)
@@ -2416,7 +2365,6 @@ PERL_CALLCONV void        Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv
 PERL_CALLCONV void     Perl_pad_free(pTHX_ PADOFFSET po);
 PERL_CALLCONV OP *     Perl_pad_leavemy(pTHX);
 PERL_CALLCONV PADLIST* Perl_pad_new(pTHX_ int flags)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV void     Perl_pad_push(pTHX_ PADLIST *padlist, int depth);
@@ -2449,9 +2397,6 @@ PERL_CALLCONV OP* Perl_parse_fullstmt(pTHX_ U32 flags);
 PERL_CALLCONV SV*      Perl_parse_label(pTHX_ U32 flags);
 PERL_CALLCONV OP*      Perl_parse_listexpr(pTHX_ U32 flags);
 PERL_CALLCONV OP*      Perl_parse_stmtseq(pTHX_ U32 flags);
-PERL_CALLCONV OP *     Perl_parse_subsignature(pTHX)
-                       __attribute__warn_unused_result__;
-
 PERL_CALLCONV OP*      Perl_parse_termexpr(pTHX_ U32 flags);
 PERL_CALLCONV U32      Perl_parse_unicode_opts(pTHX_ const char **popt);
 #define PERL_ARGS_ASSERT_PARSE_UNICODE_OPTS    \
@@ -2507,7 +2452,6 @@ PERL_CALLCONV void*       Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *const tbl, const void
 
 PERL_CALLCONV void     Perl_ptr_table_free(pTHX_ PTR_TBL_t *const tbl);
 PERL_CALLCONV PTR_TBL_t*       Perl_ptr_table_new(pTHX)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV void     Perl_ptr_table_split(pTHX_ PTR_TBL_t *const tbl);
@@ -2545,7 +2489,6 @@ PERL_CALLCONV REGEXP*     Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_cou
 #define PERL_ARGS_ASSERT_RE_OP_COMPILE \
        assert(eng)
 PERL_CALLCONV Malloc_t Perl_realloc(Malloc_t where, MEM_SIZE nbytes)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV void     Perl_reentrant_free(pTHX);
@@ -2672,7 +2615,6 @@ PERL_CALLCONV Malloc_t    Perl_safesysmalloc(MEM_SIZE nbytes)
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV Malloc_t Perl_safesysrealloc(Malloc_t where, MEM_SIZE nbytes)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV void     Perl_save_I16(pTHX_ I16* intp);
@@ -3138,12 +3080,10 @@ PERL_CALLCONV MAGIC *   Perl_sv_magicext_mglob(pTHX_ SV *sv);
        assert(sv)
 #ifndef NO_MATHOMS
 PERL_CALLCONV SV*      Perl_sv_mortalcopy(pTHX_ SV *const oldsv)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #endif
 
 PERL_CALLCONV SV*      Perl_sv_mortalcopy_flags(pTHX_ SV *const oldsv, U32 flags)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_CALLCONV SV*      Perl_sv_newmortal(pTHX)
@@ -3601,7 +3541,6 @@ PERL_CALLCONV SV* Perl_vmess(pTHX_ const char* pat, va_list* args);
 #define PERL_ARGS_ASSERT_VMESS \
        assert(pat)
 PERL_CALLCONV SV*      Perl_vnewSVpvf(pTHX_ const char *const pat, va_list *const args)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_VNEWSVPVF     \
        assert(pat)
@@ -3802,6 +3741,11 @@ STATIC PerlIO *  S_doopen_pm(pTHX_ SV *name)
 STATIC void    S__append_range_to_invlist(pTHX_ SV* const invlist, const UV start, const UV end);
 #define PERL_ARGS_ASSERT__APPEND_RANGE_TO_INVLIST      \
        assert(invlist)
+PERL_STATIC_INLINE UV* S__invlist_array_init(SV* const invlist, const bool will_have_0)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT__INVLIST_ARRAY_INIT   \
+       assert(invlist)
+
 PERL_STATIC_INLINE IV* S_get_invlist_previous_index_addr(SV* invlist)
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_GET_INVLIST_PREVIOUS_INDEX_ADDR       \
@@ -3813,6 +3757,11 @@ PERL_STATIC_INLINE void  S_invlist_clear(pTHX_ SV* invlist);
 STATIC void    S_invlist_extend(pTHX_ SV* const invlist, const UV len);
 #define PERL_ARGS_ASSERT_INVLIST_EXTEND        \
        assert(invlist)
+PERL_STATIC_INLINE UV  S_invlist_max(SV* const invlist)
+                       __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_INVLIST_MAX   \
+       assert(invlist)
+
 PERL_STATIC_INLINE IV  S_invlist_previous_index(SV* const invlist)
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_INVLIST_PREVIOUS_INDEX        \
@@ -4041,6 +3990,11 @@ PERL_CALLCONV char *     Perl__setlocale_debug_string(const int category, const char
                        __attribute__pure__;
 
 #  endif
+#  if defined(USE_LOCALE) && defined(PERL_IN_LOCALE_C)
+STATIC void    S_print_collxfrm_input_and_return(pTHX_ const char * const s, const char * const e, const STRLEN * const xlen, const bool is_utf8);
+#define PERL_ARGS_ASSERT_PRINT_COLLXFRM_INPUT_AND_RETURN       \
+       assert(s); assert(e)
+#  endif
 #endif
 #if defined(DEBUG_LEAKING_SCALARS_FORK_DUMP)
 PERL_CALLCONV void     Perl_dump_sv_child(pTHX_ SV *sv);
@@ -4354,7 +4308,7 @@ STATIC void       S_gv_init_svtype(pTHX_ GV *gv, const svtype sv_type);
 STATIC bool    S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8);
 #define PERL_ARGS_ASSERT_GV_IS_IN_MAIN \
        assert(name)
-STATIC bool    S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, bool addmg, const svtype sv_type);
+STATIC bool    S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, const svtype sv_type);
 #define PERL_ARGS_ASSERT_GV_MAGICALIZE \
        assert(gv); assert(stash); assert(name)
 STATIC void    S_gv_magicalize_isa(pTHX_ GV *gv);
@@ -4370,9 +4324,9 @@ STATIC void       S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype s
 STATIC bool    S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, STRLEN *len, const char *nambeg, STRLEN full_len, const U32 is_utf8, const I32 add);
 #define PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME   \
        assert(stash); assert(gv); assert(name); assert(len); assert(nambeg)
-STATIC HV*     S_require_tie_mod(pTHX_ GV *gv, const char *varpv, SV* namesv, const char *methpv, const U32 flags);
+STATIC void    S_require_tie_mod(pTHX_ GV *gv, const char varname, const char * name, STRLEN len, const U32 flags);
 #define PERL_ARGS_ASSERT_REQUIRE_TIE_MOD       \
-       assert(gv); assert(varpv); assert(namesv); assert(methpv)
+       assert(gv); assert(varname); assert(name)
 #endif
 #if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) || defined(PERL_IN_PAD_C) || defined(PERL_IN_OP_C)
 PERL_CALLCONV void     Perl_sv_add_backref(pTHX_ SV *const tsv, SV *const sv);
@@ -4408,7 +4362,6 @@ PERL_STATIC_NO_RET void   S_hv_notallowed(pTHX_ int flags, const char *key, I32 kl
        assert(key); assert(msg)
 
 STATIC HE*     S_new_he(pTHX)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 
 PERL_STATIC_INLINE U32 S_ptr_hash(PTRV u);
@@ -4849,15 +4802,8 @@ STATIC OP*       S_doform(pTHX_ CV *cv, GV *gv, OP *retop);
 #define PERL_ARGS_ASSERT_DOFORM        \
        assert(cv); assert(gv)
 STATIC SV *    S_space_join_names_mortal(pTHX_ char *const *array);
-#define PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL       \
-       assert(array)
 #endif
 #if defined(PERL_IN_REGCOMP_C)
-PERL_STATIC_INLINE UV* S__invlist_array_init(SV* const invlist, const bool will_have_0)
-                       __attribute__warn_unused_result__;
-#define PERL_ARGS_ASSERT__INVLIST_ARRAY_INIT   \
-       assert(invlist)
-
 STATIC SV*     S__make_exactf_invlist(pTHX_ RExC_state_t *pRExC_state, regnode *node)
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT__MAKE_EXACTF_INVLIST  \
@@ -4945,11 +4891,6 @@ STATIC bool      S_invlist_iternext(SV* invlist, UV* start, UV* end)
 #define PERL_ARGS_ASSERT_INVLIST_ITERNEXT      \
        assert(invlist); assert(start); assert(end)
 
-PERL_STATIC_INLINE UV  S_invlist_max(SV* const invlist)
-                       __attribute__warn_unused_result__;
-#define PERL_ARGS_ASSERT_INVLIST_MAX   \
-       assert(invlist)
-
 PERL_STATIC_INLINE void        S_invlist_set_len(pTHX_ SV* const invlist, const UV len, const bool offset);
 #define PERL_ARGS_ASSERT_INVLIST_SET_LEN       \
        assert(invlist)
@@ -5687,7 +5628,6 @@ PERL_CALLCONV void        Perl_clone_params_del(CLONE_PARAMS *param);
 #define PERL_ARGS_ASSERT_CLONE_PARAMS_DEL      \
        assert(param)
 PERL_CALLCONV CLONE_PARAMS *   Perl_clone_params_new(PerlInterpreter *const from, PerlInterpreter *const to)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_CLONE_PARAMS_NEW      \
        assert(from); assert(to)
@@ -5729,7 +5669,6 @@ PERL_CALLCONV struct mro_meta*    Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, C
 #define PERL_ARGS_ASSERT_MRO_META_DUP  \
        assert(smeta); assert(param)
 PERL_CALLCONV OP*      Perl_newPADOP(pTHX_ I32 type, I32 flags, SV* sv)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_NEWPADOP      \
        assert(sv)
@@ -5770,7 +5709,6 @@ PERL_CALLCONV PERL_SI*    Perl_si_dup(pTHX_ PERL_SI* si, CLONE_PARAMS* param)
        assert(param)
 
 PERL_CALLCONV ANY*     Perl_ss_dup(pTHX_ PerlInterpreter* proto_perl, CLONE_PARAMS* param)
-                       __attribute__malloc__
                        __attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_SS_DUP        \
        assert(proto_perl); assert(param)
index d4b483c00f611f1ad40c045d80422e26d742b516..845df79daacbb2bf6d6f6bf5c23a432bf78af4d9 100644 (file)
  * 37f6186253da9824bdb27f4ad867bfe8c25d4dc6bdb2f05585e40a034675a348 lib/unicore/extracted/DLineBreak.txt
  * ef24061b5a5dc93d7e90c2e34530ec757180ee75d872cba65ffc946e52624ae8 lib/unicore/extracted/DNumType.txt
  * a197371fec9a1b517058b440841f60f9378d81682084eef8db22a88cb2f96e90 lib/unicore/extracted/DNumValues.txt
- * 0cc006e22469cee3db1a55a4df1ac656c9d26a70ba920985883eb77198931c1a lib/unicore/mktables
+ * 5c7eb94310e2aaa15702fd6bed24ff0e7ab5448f9a8231d8c49ca96c9e941089 lib/unicore/mktables
  * cdecb300baad839a6f62791229f551a4fa33f3cbdca08e378dc976466354e778 lib/unicore/version
  * 913d2f93f3cb6cdf1664db888bf840bc4eb074eef824e082fceda24a9445e60c regen/charset_translations.pl
  * d9c04ac46bdd81bb3e26519f2b8eb6242cb12337205add3f7cf092b0c58dccc4 regen/regcharclass.pl
index e57f2339584968899a797e0aff2ecd767a8cad3b..bba5a2be23e5c630c9c70ae17c51764feb584b24 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -8376,6 +8376,8 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags)
 
 /* The header definitions are in F<invlist_inline.h> */
 
+#ifndef PERL_IN_XSUB_RE
+
 PERL_STATIC_INLINE UV*
 S__invlist_array_init(SV* const invlist, const bool will_have_0)
 {
@@ -8402,6 +8404,8 @@ S__invlist_array_init(SV* const invlist, const bool will_have_0)
     return zero_addr + *offset;
 }
 
+#endif
+
 PERL_STATIC_INLINE void
 S_invlist_set_len(pTHX_ SV* const invlist, const UV len, const bool offset)
 {
@@ -8538,6 +8542,8 @@ S_invlist_is_iterating(SV* const invlist)
     return *(get_invlist_iter_addr(invlist)) < (STRLEN) UV_MAX;
 }
 
+#ifndef PERL_IN_XSUB_RE
+
 PERL_STATIC_INLINE UV
 S_invlist_max(SV* const invlist)
 {
@@ -8554,8 +8560,6 @@ S_invlist_max(SV* const invlist)
            ? FROM_INTERNAL_SIZE(SvCUR(invlist)) - 1
            : FROM_INTERNAL_SIZE(SvLEN(invlist)) - 1;
 }
-
-#ifndef PERL_IN_XSUB_RE
 SV*
 Perl__new_invlist(pTHX_ IV initial_size)
 {
@@ -17471,22 +17475,15 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
                                       &nonascii_but_latin1_properties);
 
                 /* And add them to the final list of such characters. */
-                if (has_upper_latin1_only_utf8_matches) {
-                    _invlist_union(has_upper_latin1_only_utf8_matches,
-                                   nonascii_but_latin1_properties,
-                                   &has_upper_latin1_only_utf8_matches);
-                    SvREFCNT_dec_NN(nonascii_but_latin1_properties);
-                }
-                else {
-                    has_upper_latin1_only_utf8_matches
-                                                = nonascii_but_latin1_properties;
-                }
+                _invlist_union(has_upper_latin1_only_utf8_matches,
+                               nonascii_but_latin1_properties,
+                               &has_upper_latin1_only_utf8_matches);
 
                 /* Remove them from what now becomes the unconditional list */
                 _invlist_subtract(posixes, nonascii_but_latin1_properties,
                                   &posixes);
 
-                /* And the remainder are the unconditional ones */
+                /* And add those unconditional ones to the final list */
                 if (cp_list) {
                     _invlist_union(cp_list, posixes, &cp_list);
                     SvREFCNT_dec_NN(posixes);
@@ -17496,8 +17493,11 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth,
                     cp_list = posixes;
                 }
 
+                SvREFCNT_dec(nonascii_but_latin1_properties);
+
                 /* Get rid of any characters that we now know are matched
-                 * unconditionally from the conditional list */
+                 * unconditionally from the conditional list, which may make
+                 * that list empty */
                 _invlist_subtract(has_upper_latin1_only_utf8_matches,
                                   cp_list,
                                   &has_upper_latin1_only_utf8_matches);
index e291295cd005bfb583944e337d868ed5cf6b7bbd..478144273c57fee505994f9acb9f497298c429b6 100644 (file)
@@ -762,6 +762,18 @@ addbits('multideref',
 
 addbits('avhvswitch', '0..1' => { });
 
+addbits('argelem',
+   '1..2' =>  {
+                   mask_def  => 'OPpARGELEM_MASK',
+                   enum => [ qw(
+                               0   OPpARGELEM_SV   SV
+                               1   OPpARGELEM_AV   AV
+                               2   OPpARGELEM_HV   HV
+                           )],
+               },
+);
+
+
 1;
 
 # ex: set ts=8 sts=4 sw=4 et:
index b70ff923a9ecac00173f7d2a02fbd16eb8985605..57dd363c1c943a03c6d8d53857df07424c7719fb 100644 (file)
@@ -299,6 +299,9 @@ method              method lookup           ck_method       d.
 entersub       subroutine entry        ck_subr         dm1     L
 leavesub       subroutine exit         ck_null         1       
 leavesublv     lvalue subroutine return        ck_null         1       
+argcheck       check subroutine arguments      ck_null         +
+argelem                subroutine argument     ck_null         +
+argdefelem     subroutine argument default value       ck_null         |
 caller         caller                  ck_fun          t%      S?
 warn           warn                    ck_fun          imst@   L
 die            die                     ck_fun          imst@   L
index 60ff2a0ff1f970d47212a0092a4e636b2664fbdd..380e378d96d305d17c8b07decbad2a5f5a1d56d7 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -458,7 +458,7 @@ S_isFOO_lc(pTHX_ const U8 classnum, const U8 character)
         case _CC_ENUM_ALPHA:     return isALPHA_LC(character);
         case _CC_ENUM_ASCII:     return isASCII_LC(character);
         case _CC_ENUM_BLANK:     return isBLANK_LC(character);
-        case _CC_ENUM_CASED:     return isLOWER_LC(character)
+        case _CC_ENUM_CASED:     return    isLOWER_LC(character)
                                         || isUPPER_LC(character);
         case _CC_ENUM_CNTRL:     return isCNTRL_LC(character);
         case _CC_ENUM_DIGIT:     return isDIGIT_LC(character);
diff --git a/scope.c b/scope.c
index 55f801ab329075c928838ebc22d311bcc3ad86c4..ba0f26378e780b109e6c52d115b3801fe07c68ff 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -497,6 +497,17 @@ Perl_save_strlen(pTHX_ STRLEN *ptr)
     SS_ADD_END(3);
 }
 
+void
+Perl_save_iv(pTHX_ IV *ivp)
+{
+    PERL_ARGS_ASSERT_SAVE_IV;
+
+    SSCHECK(3);
+    SSPUSHIV(*ivp);
+    SSPUSHPTR(ivp);
+    SSPUSHUV(SAVEt_IV);
+}
+
 /* Cannot use save_sptr() to store a char* since the SV** cast will
  * force word-alignment and we'll miss the pointer.
  */
@@ -772,29 +783,63 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad)
 }
 
 
+static U8 arg_counts[] = {
+    0, /* SAVEt_ALLOC              */
+    0, /* SAVEt_CLEARPADRANGE      */
+    0, /* SAVEt_CLEARSV            */
+    0, /* SAVEt_REGCONTEXT         */
+    1, /* SAVEt_TMPSFLOOR          */
+    1, /* SAVEt_BOOL               */
+    1, /* SAVEt_COMPILE_WARNINGS   */
+    1, /* SAVEt_COMPPAD            */
+    1, /* SAVEt_FREECOPHH          */
+    1, /* SAVEt_FREEOP             */
+    1, /* SAVEt_FREEPV             */
+    1, /* SAVEt_FREESV             */
+    1, /* SAVEt_I16                */
+    1, /* SAVEt_I32_SMALL          */
+    1, /* SAVEt_I8                 */
+    1, /* SAVEt_INT_SMALL          */
+    1, /* SAVEt_MORTALIZESV        */
+    1, /* SAVEt_NSTAB              */
+    1, /* SAVEt_OP                 */
+    1, /* SAVEt_PARSER             */
+    1, /* SAVEt_STACK_POS          */
+    1, /* SAVEt_READONLY_OFF       */
+    1, /* SAVEt_FREEPADNAME        */
+    2, /* SAVEt_AV                 */
+    2, /* SAVEt_DESTRUCTOR         */
+    2, /* SAVEt_DESTRUCTOR_X       */
+    2, /* SAVEt_GENERIC_PVREF      */
+    2, /* SAVEt_GENERIC_SVREF      */
+    2, /* SAVEt_GP                 */
+    2, /* SAVEt_GVSV               */
+    2, /* SAVEt_HINTS              */
+    2, /* SAVEt_HPTR               */
+    2, /* SAVEt_HV                 */
+    2, /* SAVEt_I32                */
+    2, /* SAVEt_INT                */
+    2, /* SAVEt_ITEM               */
+    2, /* SAVEt_IV                 */
+    2, /* SAVEt_LONG               */
+    2, /* SAVEt_PPTR               */
+    2, /* SAVEt_SAVESWITCHSTACK    */
+    2, /* SAVEt_SHARED_PVREF       */
+    2, /* SAVEt_SPTR               */
+    2, /* SAVEt_STRLEN             */
+    2, /* SAVEt_SV                 */
+    2, /* SAVEt_SVREF              */
+    2, /* SAVEt_VPTR               */
+    2, /* SAVEt_ADELETE            */
+    2, /* SAVEt_APTR               */
+    3, /* SAVEt_HELEM              */
+    3, /* SAVEt_PADSV_AND_MORTALIZE*/
+    3, /* SAVEt_SET_SVFLAGS        */
+    3, /* SAVEt_GVSLOT             */
+    3, /* SAVEt_AELEM              */
+    3  /* SAVEt_DELETE             */
+};
 
-#define ARG0_SV  MUTABLE_SV(arg0.any_ptr)
-#define ARG0_AV  MUTABLE_AV(arg0.any_ptr)
-#define ARG0_HV  MUTABLE_HV(arg0.any_ptr)
-#define ARG0_PTR arg0.any_ptr
-#define ARG0_PV  (char*)(arg0.any_ptr)
-#define ARG0_PVP (char**)(arg0.any_ptr)
-#define ARG0_I32 (arg0.any_i32)
-
-#define ARG1_SV  MUTABLE_SV(arg1.any_ptr)
-#define ARG1_AV  MUTABLE_AV(arg1.any_ptr)
-#define ARG1_GV  MUTABLE_GV(arg1.any_ptr)
-#define ARG1_SVP (SV**)(arg1.any_ptr)
-#define ARG1_PVP (char**)(arg1.any_ptr)
-#define ARG1_PTR arg1.any_ptr
-#define ARG1_PV  (char*)(arg1.any_ptr)
-#define ARG1_I32 (arg1.any_i32)
-
-#define ARG2_SV  MUTABLE_SV(arg2.any_ptr)
-#define ARG2_AV  MUTABLE_AV(arg2.any_ptr)
-#define ARG2_HV  MUTABLE_HV(arg2.any_ptr)
-#define ARG2_GV  MUTABLE_GV(arg2.any_ptr)
-#define ARG2_PV  (char*)(arg2.any_ptr)
 
 void
 Perl_leave_scope(pTHX_ I32 base)
@@ -802,17 +847,6 @@ Perl_leave_scope(pTHX_ I32 base)
     /* Localise the effects of the TAINT_NOT inside the loop.  */
     bool was = TAINT_get;
 
-    I32 i;
-    SV *sv;
-
-    ANY arg0, arg1, arg2;
-
-    /* these initialisations are logically unnecessary, but they shut up
-     * spurious 'may be used uninitialized' compiler warnings */
-    arg0.any_ptr = NULL;
-    arg1.any_ptr = NULL;
-    arg2.any_ptr = NULL;
-
     if (UNLIKELY(base < -1))
        Perl_croak(aTHX_ "panic: corrupt saved stack index %ld", (long) base);
     DEBUG_l(Perl_deb(aTHX_ "savestack: releasing items %ld -> %ld\n",
@@ -820,37 +854,30 @@ Perl_leave_scope(pTHX_ I32 base)
     while (PL_savestack_ix > base) {
        UV uv;
        U8 type;
-
-        SV *refsv;
-        SV **svp;
+        ANY *ap; /* arg pointer */
+        ANY a0, a1, a2; /* up to 3 args */
 
        TAINT_NOT;
 
         {
+            U8  argcount;
             I32 ix = PL_savestack_ix - 1;
-            ANY *p = &PL_savestack[ix];
-            uv = p->any_uv;
+
+            ap = &PL_savestack[ix];
+            uv = ap->any_uv;
             type = (U8)uv & SAVE_MASK;
-            if (type > SAVEt_ARG0_MAX) {
-                ANY *p0 = p;
-                arg0 = *--p;
-                if (type > SAVEt_ARG1_MAX) {
-                    arg1 = *--p;
-                    if (type > SAVEt_ARG2_MAX) {
-                        arg2 = *--p;
-                    }
-                }
-                ix -= (p0 - p);
-            }
-            PL_savestack_ix = ix;
+            argcount = arg_counts[type];
+            PL_savestack_ix = ix - argcount;
+            ap -= argcount;
         }
 
        switch (type) {
        case SAVEt_ITEM:                        /* normal string */
-           sv_replace(ARG1_SV, ARG0_SV);
-            if (UNLIKELY(SvSMAGICAL(ARG1_SV))) {
+            a0 = ap[0]; a1 = ap[1];
+           sv_replace(a0.any_sv, a1.any_sv);
+            if (UNLIKELY(SvSMAGICAL(a0.any_sv))) {
                 PL_localizing = 2;
-                mg_set(ARG1_SV);
+                mg_set(a0.any_sv);
                 PL_localizing = 0;
             }
            break;
@@ -858,195 +885,241 @@ Perl_leave_scope(pTHX_ I32 base)
            /* This would be a mathom, but Perl_save_svref() calls a static
               function, S_save_scalar_at(), so has to stay in this file.  */
        case SAVEt_SVREF:                       /* scalar reference */
-           svp = ARG1_SVP;
-           refsv = NULL; /* what to refcnt_dec */
+            a0 = ap[0]; a1 = ap[1];
+           a2.any_svp = a0.any_svp;
+           a0.any_sv = NULL; /* what to refcnt_dec */
            goto restore_sv;
 
        case SAVEt_SV:                          /* scalar reference */
-           svp = &GvSV(ARG1_GV);
-           refsv = ARG1_SV; /* what to refcnt_dec */
+            a0 = ap[0]; a1 = ap[1];
+           a2.any_svp = &GvSV(a0.any_gv);
        restore_sv:
         {
-           SV * const sv = *svp;
-           *svp = ARG0_SV;
+            /* do *a2.any_svp = a1 and free a0 */
+           SV * const sv = *a2.any_svp;
+           *a2.any_svp = a1.any_sv;
            SvREFCNT_dec(sv);
-            if (UNLIKELY(SvSMAGICAL(ARG0_SV))) {
-                /* mg_set could die, skipping the freeing of ARG0_SV and
-                 * refsv; Ensure that they're always freed in that case */
+            if (UNLIKELY(SvSMAGICAL(a1.any_sv))) {
+                /* mg_set could die, skipping the freeing of a0 and
+                 * a1; Ensure that they're always freed in that case */
                 dSS_ADD;
-                SS_ADD_PTR(ARG0_SV);
+                SS_ADD_PTR(a1.any_sv);
                 SS_ADD_UV(SAVEt_FREESV);
-                SS_ADD_PTR(refsv);
+                SS_ADD_PTR(a0.any_sv);
                 SS_ADD_UV(SAVEt_FREESV);
                 SS_ADD_END(4);
                 PL_localizing = 2;
-                mg_set(ARG0_SV);
+                mg_set(a1.any_sv);
                 PL_localizing = 0;
                 break;
             }
-           SvREFCNT_dec_NN(ARG0_SV);
-           SvREFCNT_dec(refsv);
+           SvREFCNT_dec_NN(a1.any_sv);
+           SvREFCNT_dec(a0.any_sv);
            break;
         }
+
        case SAVEt_GENERIC_PVREF:               /* generic pv */
-           if (*ARG0_PVP != ARG1_PV) {
-               Safefree(*ARG0_PVP);
-               *ARG0_PVP = ARG1_PV;
+            a0 = ap[0]; a1 = ap[1];
+           if (*a1.any_pvp != a0.any_pv) {
+               Safefree(*a1.any_pvp);
+               *a1.any_pvp = a0.any_pv;
            }
            break;
+
        case SAVEt_SHARED_PVREF:                /* shared pv */
-           if (*ARG1_PVP != ARG0_PV) {
+            a0 = ap[0]; a1 = ap[1];
+           if (*a0.any_pvp != a1.any_pv) {
 #ifdef NETWARE
-               PerlMem_free(*ARG1_PVP);
+               PerlMem_free(*a0.any_pvp);
 #else
-               PerlMemShared_free(*ARG1_PVP);
+               PerlMemShared_free(*a0.any_pvp);
 #endif
-               *ARG1_PVP = ARG0_PV;
+               *a0.any_pvp = a1.any_pv;
            }
            break;
+
        case SAVEt_GVSV:                        /* scalar slot in GV */
-           svp = &GvSV(ARG1_GV);
+            a0 = ap[0]; a1 = ap[1];
+           a0.any_svp = &GvSV(a0.any_gv);
            goto restore_svp;
+
        case SAVEt_GENERIC_SVREF:               /* generic sv */
-            svp = ARG1_SVP;
+            a0 = ap[0]; a1 = ap[1];
        restore_svp:
         {
-           SV * const sv = *svp;
-           *svp = ARG0_SV;
+            /* do *a0.any_svp = a1 */
+           SV * const sv = *a0.any_svp;
+           *a0.any_svp = a1.any_sv;
            SvREFCNT_dec(sv);
-           SvREFCNT_dec(ARG0_SV);
+           SvREFCNT_dec(a1.any_sv);
            break;
         }
+
        case SAVEt_GVSLOT:                      /* any slot in GV */
         {
-            HV *const hv = GvSTASH(ARG2_GV);
-           svp = ARG1_SVP;
+            HV * hv;
+            a0 = ap[0]; a1 = ap[1]; a2 = ap[2];
+            hv = GvSTASH(a0.any_gv);
            if (hv && HvENAME(hv) && (
-                   (ARG0_SV && SvTYPE(ARG0_SV) == SVt_PVCV)
-                || (*svp && SvTYPE(*svp) == SVt_PVCV)
+                   (a2.any_sv && SvTYPE(a2.any_sv) == SVt_PVCV)
+                || (*a1.any_svp && SvTYPE(*a1.any_svp) == SVt_PVCV)
               ))
            {
-               if ((char *)svp < (char *)GvGP(ARG2_GV)
-                || (char *)svp > (char *)GvGP(ARG2_GV) + sizeof(struct gp)
-                || GvREFCNT(ARG2_GV) > 2) /* "> 2" to ignore savestack's ref */
+               if ((char *)a1.any_svp < (char *)GvGP(a0.any_gv)
+                || (char *)a1.any_svp > (char *)GvGP(a0.any_gv) + sizeof(struct gp)
+                || GvREFCNT(a0.any_gv) > 2) /* "> 2" to ignore savestack's ref */
                    PL_sub_generation++;
                else mro_method_changed_in(hv);
            }
+            a0.any_svp = a1.any_svp;
+            a1.any_sv  = a2.any_sv;
            goto restore_svp;
         }
+
        case SAVEt_AV:                          /* array reference */
-           SvREFCNT_dec(GvAV(ARG1_GV));
-           GvAV(ARG1_GV) = ARG0_AV;
+            a0 = ap[0]; a1 = ap[1];
+           SvREFCNT_dec(GvAV(a0.any_gv));
+           GvAV(a0.any_gv) = a1.any_av;
           avhv_common:
-            if (UNLIKELY(SvSMAGICAL(ARG0_SV))) {
-                /* mg_set might die, so make sure ARG1 isn't leaked */
+            if (UNLIKELY(SvSMAGICAL(a1.any_sv))) {
+                /* mg_set might die, so make sure a0 isn't leaked */
                 dSS_ADD;
-                SS_ADD_PTR(ARG1_SV);
+                SS_ADD_PTR(a0.any_sv);
                 SS_ADD_UV(SAVEt_FREESV);
                 SS_ADD_END(2);
                 PL_localizing = 2;
-                mg_set(ARG0_SV);
+                mg_set(a1.any_sv);
                 PL_localizing = 0;
                 break;
             }
-           SvREFCNT_dec_NN(ARG1_GV);
+           SvREFCNT_dec_NN(a0.any_sv);
            break;
+
        case SAVEt_HV:                          /* hash reference */
-           SvREFCNT_dec(GvHV(ARG1_GV));
-           GvHV(ARG1_GV) = ARG0_HV;
+            a0 = ap[0]; a1 = ap[1];
+           SvREFCNT_dec(GvHV(a0.any_gv));
+           GvHV(a0.any_gv) = a1.any_hv;
             goto avhv_common;
 
        case SAVEt_INT_SMALL:
-           *(int*)ARG0_PTR = (int)(uv >> SAVE_TIGHT_SHIFT);
+            a0 = ap[0];
+           *(int*)a0.any_ptr = (int)(uv >> SAVE_TIGHT_SHIFT);
            break;
+
        case SAVEt_INT:                         /* int reference */
-           *(int*)ARG0_PTR = (int)ARG1_I32;
+            a0 = ap[0]; a1 = ap[1];
+           *(int*)a1.any_ptr = (int)a0.any_i32;
            break;
+
        case SAVEt_STRLEN:                      /* STRLEN/size_t ref */
-           *(STRLEN*)ARG0_PTR = (STRLEN)arg1.any_iv;
+            a0 = ap[0]; a1 = ap[1];
+           *(STRLEN*)a1.any_ptr = (STRLEN)a0.any_iv;
            break;
+
        case SAVEt_TMPSFLOOR:                   /* restore PL_tmps_floor */
-           PL_tmps_floor = (SSize_t)arg0.any_iv;
+            a0 = ap[0];
+           PL_tmps_floor = (SSize_t)a0.any_iv;
            break;
+
        case SAVEt_BOOL:                        /* bool reference */
-           *(bool*)ARG0_PTR = cBOOL(uv >> 8);
+            a0 = ap[0];
+           *(bool*)a0.any_ptr = cBOOL(uv >> 8);
 #ifdef NO_TAINT_SUPPORT
             PERL_UNUSED_VAR(was);
 #else
-           if (UNLIKELY(ARG0_PTR == &(TAINT_get))) {
+           if (UNLIKELY(a0.any_ptr == &(TAINT_get))) {
                /* If we don't update <was>, to reflect what was saved on the
                 * stack for PL_tainted, then we will overwrite this attempt to
                 * restore it when we exit this routine.  Note that this won't
                 * work if this value was saved in a wider-than necessary type,
                 * such as I32 */
-               was = *(bool*)ARG0_PTR;
+               was = *(bool*)a0.any_ptr;
            }
 #endif
            break;
+
        case SAVEt_I32_SMALL:
-           *(I32*)ARG0_PTR = (I32)(uv >> SAVE_TIGHT_SHIFT);
+            a0 = ap[0];
+           *(I32*)a0.any_ptr = (I32)(uv >> SAVE_TIGHT_SHIFT);
            break;
+
        case SAVEt_I32:                         /* I32 reference */
+            a0 = ap[0]; a1 = ap[1];
 #ifdef PERL_DEBUG_READONLY_OPS
-            if (*(I32*)ARG0_PTR != ARG1_I32)
+            if (*(I32*)a1.any_ptr != a0.any_i32)
 #endif
-                *(I32*)ARG0_PTR = ARG1_I32;
+                *(I32*)a1.any_ptr = a0.any_i32;
            break;
+
        case SAVEt_SPTR:                        /* SV* reference */
-           *(SV**)(ARG0_PTR)= ARG1_SV;
-           break;
        case SAVEt_VPTR:                        /* random* reference */
        case SAVEt_PPTR:                        /* char* reference */
-           *ARG0_PVP = ARG1_PV;
-           break;
        case SAVEt_HPTR:                        /* HV* reference */
-           *(HV**)ARG0_PTR = MUTABLE_HV(ARG1_PTR);
-           break;
        case SAVEt_APTR:                        /* AV* reference */
-           *(AV**)ARG0_PTR = ARG1_AV;
+            a0 = ap[0]; a1 = ap[1];
+           *a1.any_svp= a0.any_sv;
            break;
+
        case SAVEt_GP:                          /* scalar reference */
         {
             HV *hv;
+           bool had_method;
+
+            a0 = ap[0]; a1 = ap[1];
             /* possibly taking a method out of circulation */  
-           const bool had_method = !!GvCVu(ARG1_GV);
-           gp_free(ARG1_GV);
-           GvGP_set(ARG1_GV, (GP*)ARG0_PTR);
-           if ((hv=GvSTASH(ARG1_GV)) && HvENAME_get(hv)) {
-               if (   GvNAMELEN(ARG1_GV) == 3
-                    && strnEQ(GvNAME(ARG1_GV), "ISA", 3)
+           had_method = !!GvCVu(a0.any_gv);
+           gp_free(a0.any_gv);
+           GvGP_set(a0.any_gv, (GP*)a1.any_ptr);
+           if ((hv=GvSTASH(a0.any_gv)) && HvENAME_get(hv)) {
+               if (   GvNAMELEN(a0.any_gv) == 3
+                    && strnEQ(GvNAME(a0.any_gv), "ISA", 3)
                 )
                    mro_isa_changed_in(hv);
-                else if (had_method || GvCVu(ARG1_GV))
+                else if (had_method || GvCVu(a0.any_gv))
                     /* putting a method back into circulation ("local")*/      
-                    gv_method_changed(ARG1_GV);
+                    gv_method_changed(a0.any_gv);
            }
-           SvREFCNT_dec_NN(ARG1_GV);
+           SvREFCNT_dec_NN(a0.any_gv);
            break;
         }
+
        case SAVEt_FREESV:
-           SvREFCNT_dec(ARG0_SV);
+            a0 = ap[0];
+           SvREFCNT_dec(a0.any_sv);
            break;
+
        case SAVEt_FREEPADNAME:
-           PadnameREFCNT_dec((PADNAME *)ARG0_PTR);
+            a0 = ap[0];
+           PadnameREFCNT_dec((PADNAME *)a0.any_ptr);
            break;
+
        case SAVEt_FREECOPHH:
-           cophh_free((COPHH *)ARG0_PTR);
+            a0 = ap[0];
+           cophh_free((COPHH *)a0.any_ptr);
            break;
+
        case SAVEt_MORTALIZESV:
-           sv_2mortal(ARG0_SV);
+            a0 = ap[0];
+           sv_2mortal(a0.any_sv);
            break;
+
        case SAVEt_FREEOP:
+            a0 = ap[0];
            ASSERT_CURPAD_LEGAL("SAVEt_FREEOP");
-           op_free((OP*)ARG0_PTR);
+           op_free(a0.any_op);
            break;
+
        case SAVEt_FREEPV:
-           Safefree(ARG0_PTR);
+            a0 = ap[0];
+           Safefree(a0.any_ptr);
            break;
 
         case SAVEt_CLEARPADRANGE:
+        {
+            I32 i;
+           SV **svp;
             i = (I32)((uv >> SAVE_TIGHT_SHIFT) & OPpPADRANGE_COUNTMASK);
-           svp = &PL_curpad[uv >>
+            svp = &PL_curpad[uv >>
                     (OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT)] + i - 1;
             goto clearsv;
        case SAVEt_CLEARSV:
@@ -1054,7 +1127,7 @@ Perl_leave_scope(pTHX_ I32 base)
             i = 1;
           clearsv:
             for (; i; i--, svp--) {
-                sv = *svp;
+                SV *sv = *svp;
 
                 DEBUG_Xv(PerlIO_printf(Perl_debug_log,
              "Pad 0x%"UVxf"[0x%"UVxf"] clearsv: %ld sv=0x%"UVxf"<%"IVdf"> %s\n",
@@ -1163,64 +1236,89 @@ Perl_leave_scope(pTHX_ I32 base)
                 }
             }
            break;
+        }
+
        case SAVEt_DELETE:
-           (void)hv_delete(ARG0_HV, ARG2_PV, ARG1_I32, G_DISCARD);
-           SvREFCNT_dec(ARG0_HV);
-           Safefree(arg2.any_ptr);
+            a0 = ap[0]; a1 = ap[1]; a2 = ap[2];
+           (void)hv_delete(a2.any_hv, a0.any_pv, a1.any_i32, G_DISCARD);
+           SvREFCNT_dec(a2.any_hv);
+           Safefree(a0.any_ptr);
            break;
+
        case SAVEt_ADELETE:
-           (void)av_delete(ARG0_AV, arg1.any_iv, G_DISCARD);
-           SvREFCNT_dec(ARG0_AV);
+            a0 = ap[0]; a1 = ap[1];
+           (void)av_delete(a1.any_av, a0.any_iv, G_DISCARD);
+           SvREFCNT_dec(a1.any_av);
            break;
+
        case SAVEt_DESTRUCTOR_X:
-           (*arg1.any_dxptr)(aTHX_ ARG0_PTR);
+            a0 = ap[0]; a1 = ap[1];
+           (*a0.any_dxptr)(aTHX_ a1.any_ptr);
            break;
+
        case SAVEt_REGCONTEXT:
            /* regexp must have croaked */
        case SAVEt_ALLOC:
            PL_savestack_ix -= uv >> SAVE_TIGHT_SHIFT;
            break;
+
        case SAVEt_STACK_POS:           /* Position on Perl stack */
-           PL_stack_sp = PL_stack_base + arg0.any_i32;
+            a0 = ap[0];
+           PL_stack_sp = PL_stack_base + a0.any_i32;
            break;
+
        case SAVEt_AELEM:               /* array element */
-           svp = av_fetch(ARG2_AV, arg1.any_iv, 1);
-           if (UNLIKELY(!AvREAL(ARG2_AV) && AvREIFY(ARG2_AV))) /* undo reify guard */
-               SvREFCNT_dec(ARG0_SV);
+        {
+            SV **svp;
+            a0 = ap[0]; a1 = ap[1]; a2 = ap[2];
+           svp = av_fetch(a0.any_av, a1.any_iv, 1);
+           if (UNLIKELY(!AvREAL(a0.any_av) && AvREIFY(a0.any_av))) /* undo reify guard */
+               SvREFCNT_dec(a2.any_sv);
            if (LIKELY(svp)) {
                SV * const sv = *svp;
                if (LIKELY(sv && sv != &PL_sv_undef)) {
-                   if (UNLIKELY(SvTIED_mg((const SV *)ARG2_AV, PERL_MAGIC_tied)))
+                   if (UNLIKELY(SvTIED_mg((const SV *)a0.any_av, PERL_MAGIC_tied)))
                        SvREFCNT_inc_void_NN(sv);
-                    refsv = ARG2_SV;
+                    a1.any_sv  = a2.any_sv;
+                    a2.any_svp = svp;
                    goto restore_sv;
                }
            }
-           SvREFCNT_dec(ARG2_AV);
-           SvREFCNT_dec(ARG0_SV);
+           SvREFCNT_dec(a0.any_av);
+           SvREFCNT_dec(a2.any_sv);
            break;
+        }
+
        case SAVEt_HELEM:               /* hash element */
         {
-           HE * const he = hv_fetch_ent(ARG2_HV, ARG1_SV, 1, 0);
-           SvREFCNT_dec(ARG1_SV);
+           HE *he;
+
+            a0 = ap[0]; a1 = ap[1]; a2 = ap[2];
+           he = hv_fetch_ent(a0.any_hv, a1.any_sv, 1, 0);
+           SvREFCNT_dec(a1.any_sv);
            if (LIKELY(he)) {
                const SV * const oval = HeVAL(he);
                if (LIKELY(oval && oval != &PL_sv_undef)) {
-                   svp = &HeVAL(he);
-                   if (UNLIKELY(SvTIED_mg((const SV *)ARG2_HV, PERL_MAGIC_tied)))
+                    SV **svp = &HeVAL(he);
+                   if (UNLIKELY(SvTIED_mg((const SV *)a0.any_hv, PERL_MAGIC_tied)))
                        SvREFCNT_inc_void(*svp);
-                   refsv = ARG2_SV; /* what to refcnt_dec */
+                    a1.any_sv  = a2.any_sv;
+                    a2.any_svp = svp;
                    goto restore_sv;
                }
            }
-           SvREFCNT_dec(ARG2_HV);
-           SvREFCNT_dec(ARG0_SV);
+           SvREFCNT_dec(a0.any_hv);
+           SvREFCNT_dec(a2.any_sv);
            break;
         }
+
        case SAVEt_OP:
-           PL_op = (OP*)ARG0_PTR;
+            a0 = ap[0];
+           PL_op = (OP*)a0.any_ptr;
            break;
+
        case SAVEt_HINTS:
+            a0 = ap[0]; a1 = ap[1];
            if ((PL_hints & HINT_LOCALIZE_HH)) {
              while (GvHV(PL_hintgv)) {
                HV *hv = GvHV(PL_hintgv);
@@ -1229,8 +1327,8 @@ Perl_leave_scope(pTHX_ I32 base)
              }
            }
            cophh_free(CopHINTHASH_get(&PL_compiling));
-           CopHINTHASH_set(&PL_compiling, (COPHH*)ARG0_PTR);
-           *(I32*)&PL_hints = ARG1_I32;
+           CopHINTHASH_set(&PL_compiling, (COPHH*)a1.any_ptr);
+           *(I32*)&PL_hints = a0.any_i32;
            if (PL_hints & HINT_LOCALIZE_HH) {
                SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv)));
                GvHV(PL_hintgv) = MUTABLE_HV(SSPOPPTR);
@@ -1244,73 +1342,100 @@ Perl_leave_scope(pTHX_ I32 base)
            }
            assert(GvHV(PL_hintgv));
            break;
+
        case SAVEt_COMPPAD:
-           PL_comppad = (PAD*)ARG0_PTR;
+            a0 = ap[0];
+           PL_comppad = (PAD*)a0.any_ptr;
            if (LIKELY(PL_comppad))
                PL_curpad = AvARRAY(PL_comppad);
            else
                PL_curpad = NULL;
            break;
+
        case SAVEt_PADSV_AND_MORTALIZE:
            {
                SV **svp;
-               assert (ARG1_PTR);
-               svp = AvARRAY((PAD*)ARG1_PTR) + (PADOFFSET)arg0.any_uv;
+
+                a0 = ap[0]; a1 = ap[1]; a2 = ap[2];
+               assert (a1.any_ptr);
+               svp = AvARRAY((PAD*)a1.any_ptr) + (PADOFFSET)a2.any_uv;
                 /* This mortalizing used to be done by CX_POOPLOOP() via
                    itersave.  But as we have all the information here, we
                    can do it here, save even having to have itersave in
                    the struct.
                    */
                sv_2mortal(*svp);
-               *svp = ARG2_SV;
+               *svp = a0.any_sv;
            }
            break;
+
        case SAVEt_SAVESWITCHSTACK:
            {
                dSP;
-               SWITCHSTACK(ARG0_AV, ARG1_AV);
-               PL_curstackinfo->si_stack = ARG1_AV;
+
+                a0 = ap[0]; a1 = ap[1];
+               SWITCHSTACK(a1.any_av, a0.any_av);
+               PL_curstackinfo->si_stack = a0.any_av;
            }
            break;
+
        case SAVEt_SET_SVFLAGS:
-            SvFLAGS(ARG2_SV) &= ~((U32)ARG1_I32);
-            SvFLAGS(ARG2_SV) |= (U32)ARG0_I32;
+            a0 = ap[0]; a1 = ap[1]; a2 = ap[2];
+            SvFLAGS(a0.any_sv) &= ~(a1.any_u32);
+            SvFLAGS(a0.any_sv) |= a2.any_u32;
            break;
 
            /* These are only saved in mathoms.c */
        case SAVEt_NSTAB:
-           (void)sv_clear(ARG0_SV);
+            a0 = ap[0];
+           (void)sv_clear(a0.any_sv);
            break;
+
        case SAVEt_LONG:                        /* long reference */
-           *(long*)ARG0_PTR = arg1.any_long;
+            a0 = ap[0]; a1 = ap[1];
+           *(long*)a1.any_ptr = a0.any_long;
            break;
+
        case SAVEt_IV:                          /* IV reference */
-           *(IV*)ARG0_PTR = arg1.any_iv;
+            a0 = ap[0]; a1 = ap[1];
+           *(IV*)a1.any_ptr = a0.any_iv;
            break;
 
        case SAVEt_I16:                         /* I16 reference */
-           *(I16*)ARG0_PTR = (I16)(uv >> 8);
+            a0 = ap[0];
+           *(I16*)a0.any_ptr = (I16)(uv >> 8);
            break;
+
        case SAVEt_I8:                          /* I8 reference */
-           *(I8*)ARG0_PTR = (I8)(uv >> 8);
+            a0 = ap[0];
+           *(I8*)a0.any_ptr = (I8)(uv >> 8);
            break;
+
        case SAVEt_DESTRUCTOR:
-           (*arg1.any_dptr)(ARG0_PTR);
+            a0 = ap[0]; a1 = ap[1];
+           (*a0.any_dptr)(a1.any_ptr);
            break;
+
        case SAVEt_COMPILE_WARNINGS:
+            a0 = ap[0];
            if (!specialWARN(PL_compiling.cop_warnings))
                PerlMemShared_free(PL_compiling.cop_warnings);
-
-           PL_compiling.cop_warnings = (STRLEN*)ARG0_PTR;
+           PL_compiling.cop_warnings = (STRLEN*)a0.any_ptr;
            break;
+
        case SAVEt_PARSER:
-           parser_free((yy_parser *) ARG0_PTR);
+            a0 = ap[0];
+           parser_free((yy_parser *)a0.any_ptr);
            break;
+
        case SAVEt_READONLY_OFF:
-           SvREADONLY_off(ARG0_SV);
+            a0 = ap[0];
+           SvREADONLY_off(a0.any_sv);
            break;
+
        default:
-           Perl_croak(aTHX_ "panic: leave_scope inconsistency %u", type);
+           Perl_croak(aTHX_ "panic: leave_scope inconsistency %u",
+                    (U8)uv & SAVE_MASK);
        }
     }
 
diff --git a/scope.h b/scope.h
index 9a504f1bfd8c600b87451b3a1ae6e6057bedcf93..ad276a94a74a84cc2bb4e88d8d288ef9801f82ca 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -8,7 +8,7 @@
  *
  */
 
-/* *** these are ordered by number of of auto-popped args */
+/* *** Update arg_counts[] in scope.c if you modify these */
 
 /* zero args */
 
@@ -17,8 +17,6 @@
 #define SAVEt_CLEARSV          2
 #define SAVEt_REGCONTEXT       3
 
-#define SAVEt_ARG0_MAX         3
-
 /* one arg */
 
 #define SAVEt_TMPSFLOOR                4
@@ -41,8 +39,6 @@
 #define SAVEt_READONLY_OFF     21
 #define SAVEt_FREEPADNAME      22
 
-#define SAVEt_ARG1_MAX         22
-
 /* two args */
 
 #define SAVEt_AV               23
@@ -71,8 +67,6 @@
 #define SAVEt_ADELETE          46
 #define SAVEt_APTR             47
 
-#define SAVEt_ARG2_MAX         47
-
 /* three args */
 
 #define SAVEt_HELEM            48
diff --git a/sv.c b/sv.c
index 00a70677aa08e32e5977045ced29594073e7201d..c4cac80b1542adff737ad1163113ef68f28531c6 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4925,7 +4925,7 @@ Perl_sv_setpvn_mg(pTHX_ SV *const sv, const char *const ptr, const STRLEN len)
 =for apidoc sv_setpv
 
 Copies a string into an SV.  The string must be terminated with a C<NUL>
-character.
+character, and not contain embeded C<NUL>'s.
 Does not handle 'set' magic.  See C<L</sv_setpv_mg>>.
 
 =cut
@@ -8038,10 +8038,24 @@ Perl_sv_cmp_locale_flags(pTHX_ SV *const sv1, SV *const sv2,
     if (PL_collation_standard)
        goto raw_compare;
 
-    len1 = 0;
-    pv1 = sv1 ? sv_collxfrm_flags(sv1, &len1, flags) : (char *) NULL;
-    len2 = 0;
-    pv2 = sv2 ? sv_collxfrm_flags(sv2, &len2, flags) : (char *) NULL;
+    len1 = len2 = 0;
+
+    /* Revert to using raw compare if both operands exist, but either one
+     * doesn't transform properly for collation */
+    if (sv1 && sv2) {
+        pv1 = sv_collxfrm_flags(sv1, &len1, flags);
+        if (! pv1) {
+            goto raw_compare;
+        }
+        pv2 = sv_collxfrm_flags(sv2, &len2, flags);
+        if (! pv2) {
+            goto raw_compare;
+        }
+    }
+    else {
+        pv1 = sv1 ? sv_collxfrm_flags(sv1, &len1, flags) : (char *) NULL;
+        pv2 = sv2 ? sv_collxfrm_flags(sv2, &len2, flags) : (char *) NULL;
+    }
 
     if (!pv1 || !len1) {
        if (pv2 && len2)
@@ -10963,8 +10977,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
  * the hexadecimal values (for %a/%A).  The nv is the NV where the value
  * are being extracted from (either directly from the long double in-memory
  * presentation, or from the uquad computed via frexp+ldexp).  frexp also
- * is used to update the exponent.  vhex is the pointer to the beginning
- * of the output buffer (of VHEX_SIZE).
+ * is used to update the exponent.  The subnormal is set to true
+ * for IEEE 754 subnormals/denormals (including the x86 80-bit format).
+ * The vhex is the pointer to the beginning of the output buffer of VHEX_SIZE.
  *
  * The tricky part is that S_hextract() needs to be called twice:
  * the first time with vend as NULL, and the second time with vend as
@@ -10974,14 +10989,15 @@ Perl_sv_vcatpvfn(pTHX_ SV *const sv, const char *const pat, const STRLEN patlen,
  * (the extraction of the hexadecimal values) takes place.
  * Sanity failures cause fatal failures during both rounds. */
 STATIC U8*
-S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
+S_hextract(pTHX_ const NV nv, int* exponent, bool *subnormal,
+           U8* vhex, U8* vend)
 {
     U8* v = vhex;
     int ix;
     int ixmin = 0, ixmax = 0;
 
-    /* XXX Inf/NaN/denormal handling in the HEXTRACT_IMPLICIT_BIT,
-     * and elsewhere. */
+    /* XXX Inf/NaN are not handled here, since it is
+     * assumed they are to be output as "Inf" and "NaN". */
 
     /* These macros are just to reduce typos, they have multiple
      * repetitions below, but usually only one (or sometimes two)
@@ -11014,13 +11030,20 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
     for (ix = a; ix >= b; ix--) { HEXTRACT_BYTE(ix); }
 #define HEXTRACT_BYTES_BE(a, b) \
     for (ix = a; ix <= b; ix++) { HEXTRACT_BYTE(ix); }
+#define HEXTRACT_GET_SUBNORMAL(nv) *subnormal = Perl_fp_class_denorm(nv)
 #define HEXTRACT_IMPLICIT_BIT(nv) \
     STMT_START { \
-        if (vend) *v++ = ((nv) == 0.0) ? 0 : 1; else v++; \
+        if (!*subnormal) { \
+            if (vend) *v++ = ((nv) == 0.0) ? 0 : 1; else v++; \
+        } \
    } STMT_END
 
-/* Most formats do.  Those which don't should undef this. */
+/* Most formats do.  Those which don't should undef this.
+ *
+ * But also note that IEEE 754 subnormals do not have it, or,
+ * expressed alternatively, their implicit bit is zero. */
 #define HEXTRACT_HAS_IMPLICIT_BIT
+
 /* Many formats do.  Those which don't should undef this. */
 #define HEXTRACT_HAS_TOP_NYBBLE
 
@@ -11034,6 +11057,7 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
     const U8* vmaxend = vhex + HEXTRACTSIZE;
     PERL_UNUSED_VAR(ix); /* might happen */
     (void)Perl_frexp(PERL_ABS(nv), exponent);
+    *subnormal = FALSE;
     if (vend && (vend <= vhex || vend > vmaxend)) {
         /* diag_listed_as: Hexadecimal float: internal error (%s) */
         Perl_croak(aTHX_ "Hexadecimal float: internal error (entry)");
@@ -11043,10 +11067,11 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
 #if defined(USE_LONG_DOUBLE) && (NVSIZE > DOUBLESIZE)
 #  if LONG_DOUBLEKIND == LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN
         /* Used in e.g. VMS and HP-UX IA-64, e.g. -0.1L:
-         * 9a 99 99 99 99 99 99 99 99 99 99 99 99 99 fb 3f */
+         * 9a 99 99 99 99 99 99 99 99 99 99 99 99 99 fb bf */
         /* The bytes 13..0 are the mantissa/fraction,
          * the 15,14 are the sign+exponent. */
         const U8* nvp = (const U8*)(&nv);
+       HEXTRACT_GET_SUBNORMAL(nv);
         HEXTRACT_IMPLICIT_BIT(nv);
 #   undef HEXTRACT_HAS_TOP_NYBBLE
         HEXTRACT_BYTES_LE(13, 0);
@@ -11056,18 +11081,21 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
         /* The bytes 2..15 are the mantissa/fraction,
          * the 0,1 are the sign+exponent. */
         const U8* nvp = (const U8*)(&nv);
+       HEXTRACT_GET_SUBNORMAL(nv);
         HEXTRACT_IMPLICIT_BIT(nv);
 #   undef HEXTRACT_HAS_TOP_NYBBLE
         HEXTRACT_BYTES_BE(2, 15);
 #  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_LITTLE_ENDIAN
         /* x86 80-bit "extended precision", 64 bits of mantissa / fraction /
-         * significand, 15 bits of exponent, 1 bit of sign.  NVSIZE can
-         * be either 12 (ILP32, Solaris x86) or 16 (LP64, Linux and OS X),
-         * meaning that 2 or 6 bytes are empty padding. */
-        /* The bytes 7..0 are the mantissa/fraction */
+         * significand, 15 bits of exponent, 1 bit of sign.  No implicit bit.
+         * NVSIZE can be either 12 (ILP32, Solaris x86) or 16 (LP64, Linux
+         * and OS X), meaning that 2 or 6 bytes are empty padding. */
+        /* The bytes 0..1 are the sign+exponent,
+        * the bytes 2..9 are the mantissa/fraction. */
         const U8* nvp = (const U8*)(&nv);
 #    undef HEXTRACT_HAS_IMPLICIT_BIT
 #    undef HEXTRACT_HAS_TOP_NYBBLE
+       HEXTRACT_GET_SUBNORMAL(nv);
         HEXTRACT_BYTES_LE(7, 0);
 #  elif LONG_DOUBLEKIND == LONG_DOUBLE_IS_X86_80_BIT_BIG_ENDIAN
         /* Does this format ever happen? (Wikipedia says the Motorola
@@ -11077,6 +11105,7 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
         const U8* nvp = (const U8*)(&nv);
 #    undef HEXTRACT_HAS_IMPLICIT_BIT
 #    undef HEXTRACT_HAS_TOP_NYBBLE
+       HEXTRACT_GET_SUBNORMAL(nv);
         HEXTRACT_BYTES_BE(0, 7);
 #  else
 #    define HEXTRACT_FALLBACK
@@ -11112,18 +11141,21 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
 #    ifdef HEXTRACT_LITTLE_ENDIAN
         /* 0 1 2 3 4 5 6 7 (MSB = 7, LSB = 0, 6+7 = exponent+sign) */
         const U8* nvp = (const U8*)(&nv);
+       HEXTRACT_GET_SUBNORMAL(nv);
         HEXTRACT_IMPLICIT_BIT(nv);
         HEXTRACT_TOP_NYBBLE(6);
         HEXTRACT_BYTES_LE(5, 0);
 #    elif defined(HEXTRACT_BIG_ENDIAN)
         /* 7 6 5 4 3 2 1 0 (MSB = 7, LSB = 0, 6+7 = exponent+sign) */
         const U8* nvp = (const U8*)(&nv);
+       HEXTRACT_GET_SUBNORMAL(nv);
         HEXTRACT_IMPLICIT_BIT(nv);
         HEXTRACT_TOP_NYBBLE(1);
         HEXTRACT_BYTES_BE(2, 7);
 #    elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_LE_BE
         /* 4 5 6 7 0 1 2 3 (MSB = 7, LSB = 0, 6:7 = nybble:exponent:sign) */
         const U8* nvp = (const U8*)(&nv);
+       HEXTRACT_GET_SUBNORMAL(nv);
         HEXTRACT_IMPLICIT_BIT(nv);
         HEXTRACT_TOP_NYBBLE(2); /* 6 */
         HEXTRACT_BYTE(1); /* 5 */
@@ -11135,6 +11167,7 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
 #    elif DOUBLEKIND == DOUBLE_IS_IEEE_754_64_BIT_MIXED_ENDIAN_BE_LE
         /* 3 2 1 0 7 6 5 4 (MSB = 7, LSB = 0, 7:6 = sign:exponent:nybble) */
         const U8* nvp = (const U8*)(&nv);
+       HEXTRACT_GET_SUBNORMAL(nv);
         HEXTRACT_IMPLICIT_BIT(nv);
         HEXTRACT_TOP_NYBBLE(5); /* 6 */
         HEXTRACT_BYTE(6); /* 5 */
@@ -11151,6 +11184,7 @@ S_hextract(pTHX_ const NV nv, int* exponent, U8* vhex, U8* vend)
 #  endif
 #endif /* #if defined(USE_LONG_DOUBLE) && (NVSIZE > DOUBLESIZE) #else */
 #  ifdef HEXTRACT_FALLBACK
+       HEXTRACT_GET_SUBNORMAL(nv);
 #    undef HEXTRACT_HAS_TOP_NYBBLE /* Meaningless, but consistent. */
         /* The fallback is used for the double-double format, and
          * for unknown long double formats, and for unknown double
@@ -12382,6 +12416,7 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 U8* vend; /* pointer to one beyond last digit of vhex */
                 U8* vfnz = NULL; /* first non-zero */
                 U8* vlnz = NULL; /* last non-zero */
+                U8* v0 = NULL; /* first output */
                 const bool lower = (c == 'a');
                 /* At output the values of vhex (up to vend) will
                  * be mapped through the xdig to get the actual
@@ -12390,33 +12425,47 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                 int zerotail = 0; /* how many extra zeros to append */
                 int exponent = 0; /* exponent of the floating point input */
                 bool hexradix = FALSE; /* should we output the radix */
+                bool subnormal = FALSE; /* IEEE 754 subnormal/denormal */
+                bool negative = FALSE;
 
-                /* XXX: denormals, NaN, Inf.
+                /* XXX: NaN, Inf -- though they are printed as "NaN" and "Inf".
                  *
                  * For example with denormals, (assuming the vanilla
                  * 64-bit double): the exponent is zero. 1xp-1074 is
                  * the smallest denormal and the smallest double, it
-                 * should be output as 0x0.0000000000001p-1022 to
+                 * could be output also as 0x0.0000000000001p-1022 to
                  * match its internal structure. */
 
-                vend = S_hextract(aTHX_ nv, &exponent, vhex, NULL);
-                S_hextract(aTHX_ nv, &exponent, vhex, vend);
+                vend = S_hextract(aTHX_ nv, &exponent, &subnormal, vhex, NULL);
+                S_hextract(aTHX_ nv, &exponent, &subnormal, vhex, vend);
 
 #if NVSIZE > DOUBLESIZE
 #  ifdef HEXTRACT_HAS_IMPLICIT_BIT
                 /* In this case there is an implicit bit,
-                 * and therefore the exponent is shifted shift by one. */
+                 * and therefore the exponent is shifted by one. */
                 exponent--;
 #  else
-                /* In this case there is no implicit bit,
-                 * and the exponent is shifted by the first xdigit. */
-                exponent -= 4;
+#   ifdef NV_X86_80_BIT
+                if (subnormal) {
+                    /* The subnormals of the x86-80 have a base exponent of -16382,
+                     * (while the physical exponent bits are zero) but the frexp()
+                     * returned the scientific-style floating exponent.  We want
+                     * to map the last one as:
+                     * -16831..-16384 -> -16382 (the last normal is 0x1p-16382)
+                     * -16835..-16388 -> -16384
+                     * since we want to keep the first hexdigit
+                     * as one of the [8421]. */
+                    exponent = -4 * ( (exponent + 1) / -4) - 2;
+                } else {
+                    exponent -= 4;
+                }
+#   endif
+                /* TBD: other non-implicit-bit platforms than the x86-80. */
 #  endif
 #endif
 
-                if (fv < 0
-                    || Perl_signbit(nv)
-                  )
+                negative = fv < 0 || Perl_signbit(nv);
+                if (negative)
                     *p++ = '-';
                 else if (plus)
                     *p++ = plus;
@@ -12451,50 +12500,98 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                         exponent--;
 #endif
 
-                    if (precis > 0) {
-                        if ((SSize_t)(precis + 1) < vend - vhex) {
-                            bool round;
-
-                            v = vhex + precis + 1;
-                            /* Round away from zero: if the tail
-                             * beyond the precis xdigits is equal to
-                             * or greater than 0x8000... */
-                            round = *v > 0x8;
-                            if (!round && *v == 0x8) {
-                                for (v++; v < vend; v++) {
-                                    if (*v) {
-                                        round = TRUE;
-                                        break;
-                                    }
+                    if (subnormal) {
+#ifndef NV_X86_80_BIT
+                      if (vfnz[0] > 1) {
+                        /* IEEE 754 subnormals (but not the x86 80-bit):
+                         * we want "normalize" the subnormal,
+                        * so we need to right shift the hex nybbles
+                         * so that the output of the subnormal starts
+                         * from the first true bit.  (Another, equally
+                        * valid, policy would be to dump the subnormal
+                        * nybbles as-is, to display the "physical" layout.) */
+                        int i, n;
+                        U8 *vshr;
+                        /* Find the ceil(log2(v[0])) of
+                         * the top non-zero nybble. */
+                        for (i = vfnz[0], n = 0; i > 1; i >>= 1, n++) { }
+                        assert(n < 4);
+                        vlnz[1] = 0;
+                        for (vshr = vlnz; vshr >= vfnz; vshr--) {
+                          vshr[1] |= (vshr[0] & (0xF >> (4 - n))) << (4 - n);
+                          vshr[0] >>= n;
+                        }
+                        if (vlnz[1]) {
+                          vlnz++;
+                        }
+                      }
+#endif
+                      v0 = vfnz;
+                    } else {
+                      v0 = vhex;
+                    }
+
+                    if (has_precis) {
+                        U8* ve = (subnormal ? vlnz + 1 : vend);
+                        SSize_t vn = ve - (subnormal ? vfnz : vhex);
+                        if ((SSize_t)(precis + 1) < vn) {
+                            bool overflow = FALSE;
+                            if (v0[precis + 1] < 0x8) {
+                                /* Round down, nothing to do. */
+                            } else if (v0[precis + 1] > 0x8) {
+                                /* Round up. */
+                                v0[precis]++;
+                                overflow = v0[precis] > 0xF;
+                                v0[precis] &= 0xF;
+                            } else { /* v0[precis] == 0x8 */
+                                /* Half-point: round towards the one
+                                 * with the even least-significant digit:
+                                 * 08 -> 0  88 -> 8
+                                 * 18 -> 2  98 -> a
+                                 * 28 -> 2  a8 -> a
+                                 * 38 -> 4  b8 -> c
+                                 * 48 -> 4  c8 -> c
+                                 * 58 -> 6  d8 -> e
+                                 * 68 -> 6  e8 -> e
+                                 * 78 -> 8  f8 -> 10 */
+                                if ((v0[precis] & 0x1)) {
+                                    v0[precis]++;
                                 }
+                                overflow = v0[precis] > 0xF;
+                                v0[precis] &= 0xF;
                             }
-                            if (round) {
-                                for (v = vhex + precis; v >= vhex; v--) {
-                                    if (*v < 0xF) {
-                                        (*v)++;
+
+                            if (overflow) {
+                                for (v = v0 + precis - 1; v >= v0; v--) {
+                                    (*v)++;
+                                    overflow = *v > 0xF;
+                                    (*v) &= 0xF;
+                                    if (!overflow) {
                                         break;
                                     }
-                                    *v = 0;
-                                    if (v == vhex) {
-                                        /* If the carry goes all the way to
-                                         * the front, we need to output
-                                         * a single '1'. This goes against
-                                         * the "xdigit and then radix"
-                                         * but since this is "cannot happen"
-                                         * category, that is probably good. */
-                                        *p++ = xdig[1];
-                                    }
+                                }
+                                if (v == v0 - 1 && overflow) {
+                                    /* If the overflow goes all the
+                                     * way to the front, we need to
+                                     * insert 0x1 in front, and adjust
+                                     * the exponent. */
+                                    Move(v0, v0 + 1, vn, char);
+                                    *v0 = 0x1;
+                                    exponent += 4;
                                 }
                             }
+
                             /* The new effective "last non zero". */
-                            vlnz = vhex + precis;
+                            vlnz = v0 + precis;
                         }
                         else {
-                            zerotail = precis - (vlnz - vhex);
+                            zerotail =
+                              subnormal ? precis - vn + 1 :
+                              precis - (vlnz - vhex);
                         }
                     }
 
-                    v = vhex;
+                    v = v0;
                     *p++ = xdig[*v++];
 
                     /* If there are non-zero xdigits, the radix
@@ -12554,12 +12651,18 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p
                         memset(PL_efloatbuf + elen, ' ', width - elen);
                     }
                     else if (fill == '0') {
-                        /* Insert the zeros between the "0x" and
-                         * the digits, otherwise we end up with
-                         * "0000xHHH..." */
+                        /* Insert the zeros after the "0x" and the
+                         * the potential sign, but before the digits,
+                         * otherwise we end up with "0000xH.HHH...",
+                         * when we want "0x000H.HHH..."  */
                         STRLEN nzero = width - elen;
                         char* zerox = PL_efloatbuf + 2;
-                        Move(zerox, zerox + nzero,  elen - 2, char);
+                        STRLEN nmove = elen - 2;
+                        if (negative || plus) {
+                            zerox++;
+                            nmove--;
+                        }
+                        Move(zerox, zerox + nzero, nmove, char);
                         memset(zerox, fill, nzero);
                     }
                     else {
@@ -12952,7 +13055,10 @@ Perl_parser_dup(pTHX_ const yy_parser *const proto, CLONE_PARAMS *const param)
     parser->multi_start        = proto->multi_start;
     parser->multi_end  = proto->multi_end;
     parser->preambled  = proto->preambled;
-    parser->sublex_info        = proto->sublex_info; /* XXX not quite right */
+    parser->lex_super_state = proto->lex_super_state;
+    parser->lex_sub_inwhat  = proto->lex_sub_inwhat;
+    parser->lex_sub_op = proto->lex_sub_op;
+    parser->lex_sub_repl= sv_dup_inc(proto->lex_sub_repl, param);
     parser->linestr    = sv_dup_inc(proto->linestr, param);
     parser->expect     = proto->expect;
     parser->copline    = proto->copline;
@@ -12964,8 +13070,9 @@ Perl_parser_dup(pTHX_ const yy_parser *const proto, CLONE_PARAMS *const param)
     parser->in_my      = proto->in_my;
     parser->in_my_stash        = hv_dup(proto->in_my_stash, param);
     parser->error_count        = proto->error_count;
-
-
+    parser->sig_elems  = proto->sig_elems;
+    parser->sig_optelems= proto->sig_optelems;
+    parser->sig_slurpy  = proto->sig_slurpy;
     parser->linestr    = sv_dup_inc(proto->linestr, param);
 
     {
@@ -14694,8 +14801,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_forkprocess     = proto_perl->Iforkprocess;
 
     /* internal state */
-    PL_maxo            = proto_perl->Imaxo;
-
     PL_main_start      = proto_perl->Imain_start;
     PL_eval_root       = proto_perl->Ieval_root;
     PL_eval_start      = proto_perl->Ieval_start;
@@ -16159,6 +16264,7 @@ S_find_uninit_var(pTHX_ const OP *const obase, const SV *const uninit_sv,
             */
             break;
        }
+       match = 1;
        goto do_op;
 
     /* ops where $_ may be an implicit arg */
diff --git a/sv.h b/sv.h
index bfda6bf6cb1287eb9d961c2de48fd939314b1b95..07719a6c08e4c28d9864d78a27d18c7fd34d66f4 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -269,7 +269,8 @@ struct p5rx {
 =head1 SV Manipulation Functions
 
 =for apidoc Am|U32|SvREFCNT|SV* sv
-Returns the value of the object's reference count.
+Returns the value of the object's reference count. Exposed
+to perl code via Internals::SvREFCNT().
 
 =for apidoc Am|SV*|SvREFCNT_inc|SV* sv
 Increments the reference count of the given SV, returning the SV.
@@ -617,7 +618,7 @@ struct xpvio {
      * Perl_filter_add() tries to do with the dirp), hence the
      *  following union trick (as suggested by Gurusamy Sarathy).
      * For further information see Geir Johansen's problem report
-     * titled [ID 20000612.002] Perl problem on Cray system
+     * titled [ID 20000612.002 (#3366)] Perl problem on Cray system
      * The any pointer (known as IoANY()) will also be a good place
      * to hang any IO disciplines to.
      */
@@ -1089,6 +1090,22 @@ C<sv_force_normal> does nothing.
 #define SvOBJECT_on(sv)                (SvFLAGS(sv) |= SVs_OBJECT)
 #define SvOBJECT_off(sv)       (SvFLAGS(sv) &= ~SVs_OBJECT)
 
+/*
+=for apidoc Am|U32|SvREADONLY|SV* sv
+Returns true if the argument is readonly, otherwise returns false.
+Exposed to to perl code via Internals::SvREADONLY().
+
+=for apidoc Am|U32|SvREADONLY_on|SV* sv
+Mark an object as readonly. Exactly what this means depends on the object
+type. Exposed to perl code via Internals::SvREADONLY().
+
+=for apidoc Am|U32|SvREADONLY_off|SV* sv
+Mark an object as not-readonly. Exactly what this mean depends on the
+object type. Exposed to perl code via Internals::SvREADONLY().
+
+=cut
+*/
+
 #define SvREADONLY(sv)         (SvFLAGS(sv) & (SVf_READONLY|SVf_PROTECT))
 #ifdef PERL_CORE
 # define SvREADONLY_on(sv)     (SvFLAGS(sv) |= (SVf_READONLY|SVf_PROTECT))
index 103a88b78483a7ea5839a85f37b570367babc0ed..b311521b2c3216a4a146136bbdccf36da9f78670 100644 (file)
@@ -178,6 +178,7 @@ d_ftello='undef'
 d_ftime='undef'
 d_futimes='undef'
 d_futimesat='undef'
+d_gai_strerror='undef'
 d_gdbm_ndbm_h_uses_prototypes='undef'
 d_gdbmndbm_h_uses_prototypes='undef'
 d_getaddrinfo='undef'
@@ -726,6 +727,7 @@ i_values='undef'
 i_varargs='undef'
 i_varhdr='stdarg.h'
 i_vfork='undef'
+i_xlocale='undef'
 ignore_versioned_solibs='y'
 inc_version_list=''
 inc_version_list_init='0'
diff --git a/t/TEST b/t/TEST
index b27ab0290a3901545589d330e23db3b91d33a1ed..e00029c60bd03a43c5f35f8264dd31e59bb857c3 100755 (executable)
--- a/t/TEST
+++ b/t/TEST
@@ -51,7 +51,6 @@ my %abs = (
           '../cpan/Locale-Codes' => 1,
           '../cpan/Module-Load' => 1,
           '../cpan/Module-Load-Conditional' => 1,
-          '../cpan/Parse-CPAN-Meta' => 1,
           '../cpan/Pod-Simple' => 1,
           '../cpan/Test-Simple' => 1,
           '../cpan/podlators' => 1,
@@ -69,7 +68,6 @@ my %temp_no_core =
      '../cpan/IO-Compress' => 1,
      '../cpan/MIME-Base64' => 1,
      '../cpan/parent' => 1,
-     '../cpan/Parse-CPAN-Meta' => 1,
      '../cpan/Pod-Simple' => 1,
      '../cpan/podlators' => 1,
      '../cpan/Test-Simple' => 1,
index 4ac2b5bc5361281cb5a4d4c00cb3cad58f6450b5..87eb0e4a3c3e6fe9302b645f6d20d10af2d17557 100644 (file)
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..107\n";
+print "1..109\n";
 
 $x = 'x';
 
@@ -535,3 +535,16 @@ print qq|ok $test - [perl #128478] "\$foo::\$bar"\n|; $test++;
 @bar = ("baz","bonk");
 print "not " unless "$foo::@bar" eq "barbaz bonk";
 print qq|ok $test - [perl #128478] "\$foo::\@bar"\n|; $test ++;
+
+# Test that compilation of tentative indirect method call syntax which
+# turns out not to be such does not upgrade constants to full globs in the
+# symbol table.
+sub fop() { 0 }
+sub bas() { 0 }
+{ local $SIG{__WARN__}=sub{}; eval 'fop bas'; }
+print "not " unless ref $::{fop} eq 'SCALAR';
+print "ok $test - first constant in 'const1 const2' is not upgraded\n";
+$test++;
+print "not " unless ref $::{bas} eq 'SCALAR';
+print "ok $test - second constant in 'const1 const2' is not upgraded\n";
+$test++;
index 9652c4278ac7ff64e95a285b2490a366cd5fa81e..5ca07eaf4d3daa24f0a0107270aab7928b32812c 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
     chdir 't' if -d 't';
 }
 
-print "1..185\n";
+print "1..186\n";
 
 sub failed {
     my ($got, $expected, $name) = @_;
@@ -58,11 +58,11 @@ sub is {
 eval '%@x=0;';
 like( $@, qr/^Can't modify hash dereference in repeat \(x\)/, '%@x=0' );
 
-# Bug 20010422.005
+# Bug 20010422.005 (#6874)
 eval q{{s//${}/; //}};
 like( $@, qr/syntax error/, 'syntax error, used to dump core' );
 
-# Bug 20010528.007
+# Bug 20010528.007 (#7052)
 eval q/"\x{"/;
 like( $@, qr/^Missing right brace on \\x/,
     'syntax error in string, used to dump core' );
@@ -85,7 +85,7 @@ eval "a.b.c.d.e.f;sub";
 like( $@, qr/^Illegal declaration of anonymous subroutine/,
     'found by Markov chain stress testing' );
 
-# Bug 20010831.001
+# Bug 20010831.001 (#7605)
 eval '($a, b) = (1, 2);';
 like( $@, qr/^Can't modify constant item in list assignment/,
     'bareword in list assignment' );
@@ -96,11 +96,11 @@ like( $@, qr/^Can't modify constant item in tie /,
 
 eval 'undef foo';
 like( $@, qr/^Can't modify constant item in undef operator /,
-    'undefing constant causes a segfault in 5.6.1 [ID 20010906.019]' );
+    'undefing constant causes a segfault in 5.6.1 [ID 20010906.019 (#7642)]' );
 
 eval 'read($bla, FILE, 1);';
 like( $@, qr/^Can't modify constant item in read /,
-    'read($var, FILE, 1) segfaults on 5.6.1 [ID 20011025.054]' );
+    'read($var, FILE, 1) segfaults on 5.6.1 [ID 20011025.054 (#7847)]' );
 
 # This used to dump core (bug #17920)
 eval q{ sub { sub { f1(f2();); my($a,$b,$c) } } };
@@ -573,6 +573,15 @@ is $@, "", 'read into keys';
 eval 'substr keys(%h),0,=3';
 is $@, "", 'substr keys assignment';
 
+# very large utf8 char in error message was overflowing buffer
+{
+
+    no warnings;
+    eval "q" . chr(100000000064);
+    like $@, qr/Can't find string terminator "." anywhere before EOF/,
+        'RT 128952';
+}
+
 # Add new tests HERE (above this line)
 
 # bug #74022: Loop on characters in \p{OtherIDContinue}
index 3a768b29e86070f78d28322814b9de26eee743be..288586e97df5e29a27027653368c109173849355 100644 (file)
@@ -2,11 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    require "./test.pl";
+    set_up_inc('../lib');
 }
 
-BEGIN { require "./test.pl"; }
-
 plan(tests => 37);
 
 my ($devnull, $no_devnull);
index 473261e38a53ba37ad4eabf012090b3ccca77c21..36090d2160ad6fe0d1b9f093f2004ebfec33d362 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require './test.pl';
+    set_up_inc(qw(. ../lib));
     eval 'use Errno';
     die $@ if $@ and !is_miniperl();
 }
index 5f88a7df1c7348bd9f99ad7d54aab14e5ded40c9..0a79a056a989745133ea80712b05a3a81be6c690 100644 (file)
@@ -2,11 +2,11 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    require "./test.pl";
+    set_up_inc('../lib');
+    require "./charset_tools.pl";
 }
 
-BEGIN { require "./test.pl"; require "./charset_tools.pl"; }
-
 plan(tests => 3);
 
 # It is important that the script contains at least one newline character
index a90db6869c9f8d122cea6c93f9fe69570c3c8741..6ba80f8ba86d26d1c5f5a556d7170560df1fa34b 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
-    require './test.pl';
+    require "./test.pl";
+    set_up_inc('../lib');
 }
 
 if ($^O eq 'dos') {
index 9331068f2e86027a66ff344bb68a0a612c1acc15..7fb4c1e4a82871cd12178b07859ff25e749888ae 100644 (file)
@@ -2,8 +2,9 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
-    require "./test.pl"; require "charset_tools.pl";
+    require "./test.pl";
+    set_up_inc('../lib');
+    require "./charset_tools.pl";
     skip_all_without_perlio();
 }
 
index abcdebc6b45f2e756f08be40a94874f4817aa2ef..03779a9177ac98ad1b4454d7876abfec34a95cc0 100644 (file)
@@ -4,8 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
-    require './test.pl';
+    require "./test.pl";
+    set_up_inc('../lib');
 }
 
 $|=1;
index a70fb6f26666fe718b066a7aa6ea860468525681..27ba83b8bd2ec476fd23b7d3a4e344eb9c7e80e0 100644 (file)
@@ -8,8 +8,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 16;
index 1328aebcd4f0fb9efd1635b567294ab84a0823a9..8a8b27eabdac5eed8daa7fbfe50fbc87fb8654f0 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require "./test.pl";
+    set_up_inc(qw(. ../lib));
 }
 
 use Config;
index 1a81cdf76b9cf9235c98cbc8cf0cd973f33c7f4c..1ec80a3e157cf9b0b7d8ed97c8803cd8a3cb0b0b 100644 (file)
@@ -8,8 +8,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all_without_dynamic_extension('Fcntl');
 }
 
@@ -17,8 +17,6 @@ use warnings;
 use strict;
 use Config;
 
-require './test.pl';
-
 my $piped;
 eval {
        pipe my $in, my $out;
index 1a0d84d39ce2e26fde07dea562feeda7af61ba74..1a3fd2b9b3a665b59d0af20df137435f3d69c694 100644 (file)
@@ -6,8 +6,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
-    require './test.pl';
+    require "./test.pl";
+    set_up_inc('../lib');
     skip_all_if_miniperl("No XS under miniperl");
 }
 
index ef6a7bd9f93ca1c49ffa6411a16696172dc181a0..938d6dca49020de646f9d2dab50cf1ad26a223c6 100644 (file)
@@ -2,11 +2,11 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
+    require "./test.pl";
+    set_up_inc( qw(. ../lib) );
 }
 
 require Config; import Config;
-require "./test.pl";
 plan(tests => 1);
 
 SKIP: {
index 0bbfa545e6dc3023772fd55e67a53532e28897a8..8e89ebb5d48911a6110f55e74c2ba3d91ecf5796 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 # Script to test auto flush on fork/exec/system/qx.  The idea is to
index fd36bf0ec77076dd0b5e2bfd62183848792d2af2..5ed205395931fde9feb92d33d5c63804fa990ab4 100644 (file)
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require "./test.pl";
+    set_up_inc('../lib');
 }
 
 use Config;
index f2ac66fb9cf2a154ce40f8b666e9e9dee8c49417..d45bf09113b5b8c261188c2a554314745f995e7e 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all_if_miniperl("miniperl can't load IO::File");
 }
 
index 86d171ce2b907e6aff164b997afdf10ae2508ea2..541b4775bc75a8a5cc5e1855345bea4b8ac41933 100644 (file)
@@ -4,8 +4,8 @@ my $PERLIO;
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all_without_perlio();
     # FIXME - more of these could be tested without Encode or full perl
     skip_all_without_dynamic_extension('Encode');
@@ -223,7 +223,7 @@ __EOH__
 
     # Check that PL_sigwarn's reference count is correct, and that 
     # &PerlIO::Layer::NoWarnings isn't prematurely freed.
-    fresh_perl_like (<<"EOT", qr/^CODE/);
+    fresh_perl_like (<<"EOT", qr/^CODE/, {}, "Check PL_sigwarn's reference count");
 open(UTF, "<:raw:encoding(utf8)", '$afile') or die \$!;
 print ref *PerlIO::Layer::NoWarnings{CODE};
 EOT
index 41417cdf1e7572d60b02a991c7596a131a2aae2a..f0eee30c590bacef7f1cf46d42a5007b9de7fad5 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require "./test.pl";
+    set_up_inc('../lib');
 }
 
 print "1..5\n";
index cffef1441873326128d38ba7bbb66ce519a1ba96..6be9f0e84209014209d562bf190cbb2957c7b503 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 $|  = 1;
index 946fa5e3c210a3646ee6903dc080850fae79bb6b..d3fcf7869adc0186bff5d731b2d35a8cff3a0569 100644 (file)
@@ -9,8 +9,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 if ($^O eq 'dos') {
index 6b03e1962ae82b731937c749698e05d34b84ff9a..91652abe565e4985cf258ad7133a30851cbdbec0 100644 (file)
@@ -1,8 +1,8 @@
 BEGIN {
        chdir 't' if -d 't';
-       @INC = '../lib';
        require Config; import Config;
-       require './test.pl';
+    require './test.pl';
+    set_up_inc('../lib');
        skip_all_without_perlio();
 }
 
index 6bc9b17b27279df956ecc2279ba46166c99b6a08..f7aa70988df59e6ad38bd7f25954e9b02397eca9 100644 (file)
@@ -2,12 +2,13 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require "../t/test.pl";
+    set_up_inc('../lib');
     skip_all_without_perlio();
-    plan (15);
 }
 
+plan (15);
+
 use warnings 'layer';
 my $warn;
 my $file = "fail$$";
index a7cdf288979030eccc02eb850a5d049cbcdff961..f725eef3413e58660d8c261ee3b3ef5efb82f492 100644 (file)
@@ -3,8 +3,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 702c76c35ef773e0d33a6696ee80663647be7bcd..99d7e51646bea2f35d1c575ae6f529c95a3ba049 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all_without_perlio();
     skip_all_without_dynamic_extension('Fcntl'); # how did you get this far?
 }
index fdd8b992bf52a6b31aba45a57b844ce8f633ea49..bec1a662b93650d7f37019f52f7638707a7623e2 100644 (file)
@@ -2,16 +2,15 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require Config; import Config;
     require './test.pl';
-
-    if (!$Config{'d_fork'}) {
-        skip_all("fork required to pipe");
-    }
-    else {
-        plan(tests => 24);
-    }
+    set_up_inc('../lib');
+}
+if (!$Config{'d_fork'}) {
+    skip_all("fork required to pipe");
+}
+else {
+    plan(tests => 24);
 }
 
 my $Perl = which_perl();
index 4336090572e1e782ee77785f9983e618678ceb19..f8f36468c51dabbda71710be67e33c148d54bde7 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     eval 'use Errno';
     die $@ if $@ and !is_miniperl();
 }
index 19f97337aa01e3a6b6a6f7c687936b221ba6a171..2affbacad0b875baf5a58c28091719c5ed1dc87a 100644 (file)
@@ -5,8 +5,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require "./test.pl";
+    set_up_inc(qw(. ../lib));
 }
 
 BEGIN { $| = 1 }
index 8cc1640b597f3310e4def5746a7b686d37ac1077..601b9c14576fc41c5727f4fac436d8b007eeb9c5 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     eval 'use Errno';
     die $@ if $@ and !is_miniperl();
 }
index 70f83a78d7b431d86bc5aa80fe03935ca82b939b..83e63945a33886ba25bdf7a4f1bb707f0ad06a6e 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     eval 'use Errno';
     die $@ if $@ and !is_miniperl();
 }
index 0e309eb4f6ee739d5acee8ca72d7725536726669..7a911fccdb0f34dd5421127d5b26269dee46a5c3 100644 (file)
@@ -2,9 +2,9 @@
 
 BEGIN {
   chdir 't' if -d 't';
-  @INC = '../lib' if -d '../lib' && -d '../ext';
 
   require "./test.pl";
+  set_up_inc( '../lib' ) if -d '../lib' && -d '../ext';
   require Config; import Config;
 
   if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
index 01e21725700709f1ff9f7ed908258b666e749998..3feb3032d9b9b57c84455d3068d8a6169ae339c3 100644 (file)
 ################################################################################
 
 BEGIN {
-  if ($ENV{'PERL_CORE'}) {
-    chdir 't' if -d 't';
-    @INC = '../lib' if -d '../lib' && -d '../ext';
-  }
-
+  chdir 't' if -d 't' && $ENV{'PERL_CORE'};
   require "./test.pl";
+  set_up_inc('../lib') if $ENV{'PERL_CORE'} && -d '../lib' && -d '../ext';
+
   require Config; import Config;
 
   if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) {
index bba7f914686743785655679b58673a774d0c3dab..0783a770d993716b93db622b43ec67af1aa44b9f 100644 (file)
@@ -4,9 +4,9 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib' if -d '../lib' && -d '../ext';
 
     require "./test.pl";
+    set_up_inc( '../lib' ) if -d '../lib' && -d '../ext';
     require Config; import Config;
 
     skip_all_if_miniperl();
index f9226b02de5e4b3ed1eea01101330103cceec9d1..5474499b6d6a87e8dbb878532f773294f117afaa 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 print "1..35\n";
index e1b3c3c815f6dc30f8df64bf0fb5369a14edc1c4..65a64bbcafc940194d771a81d846d730dcf79ca8 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all("VMS too picky about line endings for record-oriented pipes")
        if $^O eq 'VMS';
 }
index 2606ef558df57bf2248810886ccff997d1697627..282b8e78bd58ac8cd3b0de8232694d85431d37b9 100644 (file)
@@ -2,10 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl'; require './charset_tools.pl';
-    skip_all_without_perlio();
+    set_up_inc('../lib');
 }
+skip_all_without_perlio();
 
 no utf8; # needed for use utf8 not griping about the raw octets
 
index 367c676d5161fab3309b91e44a4722cb64893fdd..561e1ffca807c833bd1daaa9eac0cda25c7269a8 100644 (file)
@@ -27,7 +27,8 @@ if (@ARGV) {
     print "ARGV = [@ARGV]\n";
     @w_files = map { "./lib/$pragma_name/$_" } @ARGV;
 } else {
-    @w_files = sort glob catfile(curdir(), "lib", $pragma_name, "*");
+    @w_files = sort grep !/( \.rej | ~ | \ \(Autosaved\)\.txt ) \z/nx,
+                        glob catfile(curdir(), "lib", $pragma_name, "*");
 }
 
 my ($tests, @prgs) = setup_multiple_progs(@w_files);
index 1c6e4a221e68d6209eca096aa748fd98d310559f..d35eab69f6a94716d95fd1b5498f31e5ccd855f8 100644 (file)
@@ -70,6 +70,13 @@ Can't find string terminator "foo" anywhere before EOF at (eval 1) line 1.
 EXPECT
 Can't find string terminator "foo" anywhere before EOF at - line 1.
 ########
+# NAME Unterminated here-doc with non-Latin-1 terminator
+BEGIN { binmode STDERR, ":utf8" }
+use utf8;
+<<옷옷
+EXPECT
+Can't find string terminator "옷옷" anywhere before EOF at - line 3.
+########
 # NAME Unterminated qw//
 qw/
 EXPECT
@@ -85,6 +92,20 @@ Can't find string terminator "/" anywhere before EOF at - line 1.
 EXPECT
 Can't find string terminator "'" anywhere before EOF at - line 1.
 ########
+# NAME Unterminated q// with non-ASCII delimiter, under utf8
+BEGIN { binmode STDERR, ":utf8" }
+use utf8;
+q«
+EXPECT
+Can't find string terminator "«" anywhere before EOF at - line 3.
+########
+# NAME Unterminated q// with non-Latin-1 delimiter
+BEGIN { binmode STDERR, ":utf8" }
+use utf8;
+q 옷
+EXPECT
+Can't find string terminator "옷" anywhere before EOF at - line 3.
+########
 # NAME /\N{/
 /\N{/
 EXPECT
@@ -309,3 +330,23 @@ Version control conflict marker at - line 1, near "<<<<<<<"
 Version control conflict marker at - line 3, near "======="
 Version control conflict marker at - line 5, near ">>>>>>>"
 Execution of - aborted due to compilation errors.
+########
+# NAME (Might be a runaway multi-line...) with Latin-1 delimiters in utf8
+BEGIN { binmode STDERR, ':utf8' }
+use utf8;
+q«
+« time
+EXPECT
+syntax error at - line 4, near "« time"
+  (Might be a runaway multi-line «« string starting on line 3)
+Execution of - aborted due to compilation errors.
+########
+# NAME (Might be a runaway multi-line...) with non-Latin-1 delimiters
+BEGIN { binmode STDERR, ':utf8' }
+use utf8;
+q ϡ
+ϡ time
+EXPECT
+syntax error at - line 4, near "ϡ time"
+  (Might be a runaway multi-line ϡϡ string starting on line 3)
+Execution of - aborted due to compilation errors.
index 5d4098c7350be78db7195b1d2f9357b56ace3b01..40590f38d83f2285342ab4a99119c8d4379a565f 100644 (file)
@@ -413,7 +413,7 @@ unlink <Op_dbmx*>, $Dfile;
 }
 
 {
-    # Bug ID 20001013.009
+    # Bug ID 20001013.009 (#4434)
     #
     # test that $hash{KEY} = undef doesn't produce the warning
     #     Use of uninitialized value in null operation
index dff9282e56e0dfb68ce90305e170a408d09c9111..a83df015053d82baf563797117af1fe8806c437d 100644 (file)
@@ -337,7 +337,7 @@ Execution of - aborted due to compilation errors.
 
 ########
 
-# ID 20020703.002
+# ID 20020703.002 (#10021)
 use strict;
 use warnings;
 my $abc = XYZ ? 1 : 0;
index 5980cade35157077e0e8c00897da32b85ba3d004..feb3db98b9faaf71f09001d4059f00b69416e598 100644 (file)
@@ -14,11 +14,9 @@ for my $arg ('', 'q[]', qw( 1 undef )) {
 sub tryit { eval shift or warn \$@ }
 tryit "&Internals::SvREADONLY($arg)";
 tryit "&Internals::SvREFCNT($arg)";
-tryit "&Internals::hv_clear_placeholders($arg)";
 ----
 Usage: Internals::SvREADONLY(SCALAR[, ON]) at (eval 1) line 1.
 Usage: Internals::SvREFCNT(SCALAR[, REFCOUNT]) at (eval 2) line 1.
-Usage: Internals::hv_clear_placeholders(hv) at (eval 3) line 1.
 ====
 }
 
index 7fbf442861ab269b524a146514ad05325265063f..51719413ac7512110f01c5ed2896b9eb7c83456c 100644 (file)
@@ -2180,3 +2180,9 @@ undef $SIG{__WARN__};
 EXPECT
 ok
 Use of uninitialized value $a[140688675223280] in string at - line 15.
+########
+# RT #128940
+use warnings 'uninitialized';
+my $x = "" . open my $fh, "<", "no / such / file";
+EXPECT
+Use of uninitialized value in concatenation (.) or string at - line 3.
index e5acc6ce917e235837915941d59d25f45fba30d5..9a30f60e07c7309a13c3ac4304e349c461bf91ba 100644 (file)
@@ -47,6 +47,20 @@ $0; # and
 $123; # numbers
 $_;    # and
 $_foo;  # underscores (none of which should warn)
+@DB::args
+EXPECT
+########
+-w
+# perl.c
+print # avoid void warning
+$\, # test a few
+$:, # punct vars
+$0, # and
+$123, # numbers
+$_,    # and
+$_foo,  # underscores (none of which should warn)
+@DB::args
+if 0;
 EXPECT
 ########
 -W
index 702df088772737f67be5aa46c9ef842781441127..e660528b52422739d63467f312d9d415919248d2 100644 (file)
@@ -136,7 +136,7 @@ print() on closed filehandle STDIN at - line 6.
        (Are you trying to call print() on dirhandle STDIN?)
 ########
 # pp_hot.c [pp_print]
-# [ID 20020425.012] from Dave Steiner <steiner@bakerst.rutgers.edu>
+# [ID 20020425.012 (#9030)] from Dave Steiner <steiner@bakerst.rutgers.edu>
 # This goes segv on 5.7.3
 use warnings 'closed' ;
 my $fh = *STDOUT{IO};
index 62ae3a9a89e40e24be01a34d1b1259ade4792dd3..29ab0ac9910a8d13baf89a52081795368579ad47 100644 (file)
@@ -21,38 +21,18 @@ EXPECT
 Invalid type ',' in unpack at - line 4.
 Invalid type ',' in pack at - line 5.
 ########
-# pp.c
-use warnings 'uninitialized' ;
-my $a = undef ; 
-my $b = $$a;
-no warnings 'uninitialized' ;
-my $c = $$a;
-EXPECT
-Use of uninitialized value $a in scalar dereference at - line 4.
-########
 # pp_pack.c
 use warnings 'pack' ;
 sub foo { my $a = "a"; return $a . $a++ . $a++ }
 my $a = pack("p", &foo) ;
+@a = "foo";
+sub bar { pop @{\@_}, pack "p", $a[0] } # This should *not* warn, even
+bar(@a);                                # though $a[0] is SvTEMP.
 no warnings 'pack' ;
 my $b = pack("p", &foo) ;
 EXPECT
 Attempt to pack pointer to temporary value at - line 4.
 ########
-# pp.c
-use warnings 'misc' ;
-bless \[], "" ;
-no warnings 'misc' ;
-bless \[], "" ;
-EXPECT
-Explicit blessing to '' (assuming package main) at - line 3.
-########
-# pp.c
-use utf8 ;
-$_ = "\x80  \xff" ;
-reverse ;
-EXPECT
-########
 # pp_pack.c
 use warnings 'pack' ;
 print unpack("C", pack("C",   -1)), "\n",
index c8e0e62ddfa7f426a2667bb6cf9aeb2a56db56db..ee0fdc25792b38a0fe9118f4f15173ac348ba43c 100644 (file)
@@ -200,7 +200,7 @@ $C .= $A ;
 EXPECT
 Use of uninitialized value $A in concatenation (.) or string at - line 10.
 ########
-# perlbug 20011116.125
+# perlbug 20011116.125 (#7917)
 use warnings 'uninitialized';
 $a = undef;
 $foo = join '', $a, "\n";
index 0b23fe53d18feed1ab6c14af68c90adeeffa3c1f..10f20f9d10f8120f6bee33be09e85e5e996360f4 100644 (file)
@@ -1112,6 +1112,11 @@ no warnings 'ambiguous';
 EXPECT
 Possible unintended interpolation of @mjd_previously_unused_ぁrrぁy in string at - line 5.
 ########
+-w
+# toke.c
+$_ = "@DB::args";        
+EXPECT
+########
 # toke.c
 # 20020328 mjd-perl-patch+@plover.com at behest of jfriedl@yahoo.com
 use warnings 'regexp';
index 8d54dc3f524bf44b66f1340085f7be4613585170..994831f1348898fead1d46ef6ed251920c3773b3 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require q(./test.pl);
+    set_up_inc('../lib');
 }
 
 use strict;
index b0052261dd6199881698fe136643876d3478dcf4..7bb53b1f71af2efe0be8b28d99af4bcac8135c0b 100644 (file)
@@ -3,14 +3,15 @@
 BEGIN {
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
+    require q(./test.pl);
+    set_up_inc('../lib');
 }
 
 use strict;
 use warnings;
 
-require q(./test.pl); plan(tests => 1);
+plan(tests => 1);
 
 require mro;
 
index b7baa3ec5d812a2a2f5a21c4615f5af98fd87393..4d2b5be47ec500ec398def9e21600ffcd9a84b88 100644 (file)
@@ -3,8 +3,9 @@
 BEGIN {
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
+    require q(./test.pl);
+    set_up_inc('../lib');
 }
 
 use strict;
@@ -13,7 +14,7 @@ use warnings;
 use utf8;
 use open qw( :utf8 :std );
 
-require q(./test.pl); plan(tests => 1);
+plan(tests => 1);
 
 require mro;
 
index 6ce81d137ec6b25dbdaba2bbbb36f1e65ee789e9..eb2aeeafd0c8fe562b1117957ad943a809b4172d 100644 (file)
@@ -1,6 +1,10 @@
 #!./perl
 
-BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl' }
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+    set_up_inc('../lib');
+}
 
 plan 13;
 
index 721a4918dd23178589c91e4270eb2b91d88db07d..fa972e4c5541c21b01721fd92d517bea31e91db8 100644 (file)
@@ -1,6 +1,10 @@
 #!./perl
 
-BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl' }
+BEGIN {
+    chdir 't' if -d 't';
+    require './test.pl';
+    set_up_inc('../lib');
+}
 
 use utf8;
 use open qw( :utf8 :std );
index 20ae5f09b453150e3915a780aa6d3dcbb0be0e88..ecec0a5938f6d52a257d5ab25cc2d824e02df977 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require "./test.pl";
+    set_up_inc('../lib');
 }
 
 use strict;
index 3e2e7a999cb5c8d26a74a14dc23a4622cf438311..431e7395672dd847a22131eb184afc081e2f5ca5 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require "./test.pl";
+    set_up_inc('../lib');
 }
 
 use strict;
index 77c122ea74662f305bdbcde9b384540cb3f5e33a..e32ed756fb1d3a7a68029255c68eb123f0c70e28 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require "./test.pl";
+    set_up_inc('../lib');
 }
 
 use strict;
index 1c95eaa58e0bbcdd01ac0d90570e3c9ddba40540..6fa0b59eceb02865557be8abfc172232efafa01f 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require "./test.pl";
+    set_up_inc('../lib');
 }
 
 use strict;
index 892b40c798fe42d2e01d22ad7dec12260e80c75c..bc35dd28bd1ba37b0a5ef9546043b8ef8e801577 100644 (file)
@@ -3,9 +3,9 @@
 BEGIN {
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
     require q(./test.pl);
+    set_up_inc('../lib') unless -d 'blib';
 }
 
 use strict;
index dff3058ee65e632f07e1a249093e7dcd822a492c..61f7cf37cbea38b079dff3af11d54713134dfc78 100644 (file)
@@ -3,9 +3,9 @@
 BEGIN {
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
     require q(./test.pl);
+    set_up_inc('../lib');
 }
 
 use strict;
index ab312a86bb5057e3c1656fd97d5638679542275c..a6b290680212243da28e4e9cb939420292c6955c 100644 (file)
@@ -3,9 +3,9 @@
 BEGIN {
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index ee31869dd32b6e354aff89a337016bf3f26c806f..31187cabe156ec7cd50e917dd6c7f9b89f9dbc78 100644 (file)
@@ -3,8 +3,9 @@
 BEGIN {
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
+    require './test.pl';
+    set_up_inc('../lib');
 }
 
 use utf8;
@@ -14,8 +15,6 @@ use warnings;
 no warnings 'redefine'; # we do a lot of this
 no warnings 'prototype'; # we do a lot of this
 
-require './test.pl';
-
 {
     package MC텟ᵀ::Bࡎᶓ;
     sub ᕘ { return $_[1]+1 };
index ccae4ef5041291e9f8e6e572f6755e7c09c71a23..31a33552f3ee2156e9124e9e98ac9068f7d77e48 100644 (file)
@@ -3,7 +3,9 @@
 use strict;
 use warnings;
 
-BEGIN { chdir 't' if -d 't'; require q(./test.pl); @INC = qw "../lib lib" }
+BEGIN { chdir 't' if -d 't'; require q(./test.pl);
+set_up_inc('../lib', 'lib');
+}
 
 plan(tests => 12);
 
index 3546a70b7b0198ec0792e9be514d3857da50939c..8be8d66fea643b026487c7ebc962b6ab62d1c755 100644 (file)
@@ -3,7 +3,11 @@
 use strict;
 use warnings;
 
-BEGIN { chdir 't' if -d 't'; require q(./test.pl); @INC = qw "../lib lib" }
+BEGIN {
+    chdir 't' if -d 't';
+    require q(./test.pl);
+    set_up_inc('../lib', 'lib');
+}
 
 use utf8;
 use open qw( :utf8 :std );
@@ -47,7 +51,7 @@ plan(tests => 12);
     SKIP: {    
         eval 'use Sub::Name';
         skip("Sub::Name is required for this test", 3) if $@;
-    
+
         my $m = sub { (shift)->next::method() };
         Sub::Name::subname('Baɾ::ƚ', $m);
         {
index db2b1ec6600029a50a6793817c66505989168af4..0ba1509502f1b10e7a816e835c57c659685db495 100644 (file)
@@ -5,11 +5,12 @@ use warnings;
 BEGIN {
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
+    require q(./test.pl);
+    set_up_inc('../lib');
 }
 
-require q(./test.pl); plan(tests => 7);
+plan(tests => 7);
 
 {
     package BaseTest;
index bcb9f70c7798ef83cc7ea0315bd925924f6a3ae3..3981cbe42c847b825e44026f1b75f9d53cda6b3d 100644 (file)
@@ -5,14 +5,15 @@ use warnings;
 BEGIN {
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
+    require q(./test.pl);
+    set_up_inc('../lib');
 }
 
 use utf8;
 use open qw( :utf8 :std );
 
-require q(./test.pl); plan(tests => 7);
+plan(tests => 7);
 
 {
     package 밧e텟ʇ;
index 5943c855db0e17133ea55c273554d36ed635da7d..00d2753939c343e955a11b6ac257bbeda059d2b5 100644 (file)
@@ -5,11 +5,12 @@ use warnings;
 BEGIN {
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
+    require q(./test.pl);
+    set_up_inc('../lib');
 }
 
-require q(./test.pl); plan(tests => 7);
+plan(tests => 7);
 
 {
     package BaseTest;
index 6998a892963e1770220a5739b76895d844878e52..dd811a62f88fbf186641810e5cfdeaa2eae45b5f 100644 (file)
@@ -3,9 +3,9 @@
 BEGIN {
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
     require q(./test.pl);
+    set_up_inc('../lib');
 }
 
 use strict;
index 09db6b7c198ce1a984c20df7b8d89335ffa51732..0fc762d2d5c4146d77a6092d2c27eba2fee276c5 100644 (file)
@@ -4,9 +4,9 @@ BEGIN {
     $ENV{PERL_UNICODE} = 0;
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
     require q(./test.pl);
+    set_up_inc('../lib');
 }
 
 use strict;
index 6ebd7fb2a173fab4fec0225b89c53f920b082e74..d5bcbaf41a385fa6689d18e47d6a288177959684 100644 (file)
@@ -1,14 +1,13 @@
 #!./perl
 
 BEGIN {
+    require './test.pl';
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
+    set_up_inc('../lib');
 }
 
-require './test.pl';
-
 use strict;
 use warnings;
 
index 3abc136f728d0008d915a6876d4109ebd68c3885..bac3a59caca23b4a6411f6b3cad8f661d47b2855 100644 (file)
@@ -5,14 +5,13 @@ use warnings;
 BEGIN {
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
+    require './test.pl';
+    set_up_inc('../lib');
 }
 use utf8;
 use open qw( :utf8 :std );
 
-require './test.pl';
-
 plan(skip_all => "Your system has no SIGALRM") if !exists $SIG{ALRM};
 plan(tests => 8);
 
index 00efe6d734928df8d064a2451d6811da1d285e01..88c4ece76ed4fbc2abba18d43d40f12e60a66466 100644 (file)
@@ -1,17 +1,14 @@
 #!./perl
 
 BEGIN {
-    unless (-d 'blib') {
-        chdir 't' if -d 't';
-        @INC = '../lib';
-    }
+    chdir 't' if -d 't';
+    require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
 use warnings;
 
-require './test.pl';
-
 plan(skip_all => "Your system has no SIGALRM") if !exists $SIG{ALRM};
 plan(tests => 8);
 
index 6b428e1de3d59acf5e1355beaa7ac0bca747988c..4ad427e64f57834e67f71c7fa1c3fc494bf070d0 100644 (file)
@@ -5,14 +5,13 @@ use warnings;
 BEGIN {
     unless (-d 'blib') {
         chdir 't' if -d 't';
-        @INC = '../lib';
     }
+    require './test.pl';
+    set_up_inc('../lib');
 }
 use utf8;
 use open qw( :utf8 :std );
 
-require './test.pl';
-
 plan(skip_all => "Your system has no SIGALRM") if !exists $SIG{ALRM};
 plan(tests => 8);
 
index b764f0ebb3f1557e71fbebc02f2e137ea4a74080..a5f6f1077a013b2cdf0f2085ccd9356eb6385f51 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     eval { my $q = pack "q", 0 };
     skip_all('no 64-bit types') if $@;
 }
index f9493d9b46b6ca87ecc78f8371dcff7669ed26ff..e894841bcc2e8cddb56e7d3ac1abfe1f4aeaba0d 100644 (file)
@@ -15,8 +15,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib')
 }
 
 use warnings;
index 28cc65cf7cd58f30b7e3b5f3b6848f86d3bf0215..749482c26dd8dbe5de4ff8fb118fcd0eacee4cce 100644 (file)
@@ -2,15 +2,14 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
-BEGIN {
-    use Config;
-    if( !$Config{d_alarm} ) {
-        skip_all("alarm() not implemented on this platform");
-    }
+
+use Config;
+if ( !$Config{d_alarm} ) {
+    skip_all("alarm() not implemented on this platform");
 }
 
 plan tests => 5;
index b281cc1b4fb569ada907f67346d47c3d4960a2e2..89a6acbabafac8491837a97b394db97d23df7d0f 100644 (file)
@@ -3,7 +3,7 @@
 BEGIN {
     chdir 't';
     require './test.pl';
-    @INC = "../lib";
+    set_up_inc("../lib");
 }
 
 plan 8;
index d65acfe2db5857e0929eede8fcb78e47cd7e9122..91976e50c7ef1ae76167e6eb3725f497e4882760 100644 (file)
@@ -1,8 +1,9 @@
 #!./perl -w
 
 chdir 't' if -d 't';
-@INC = '../lib';
 require './test.pl';
+set_up_inc('../lib');
+
 use strict;
 
 $|=1;
index 44847b55ab633c229236e075b5e3092ff2bd7bde..5001dc6e4e905f1cd82b04d13f6bf06b3e5d2103 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 ##Literal test count since evals below can fail
index 23b5505d3e21e316dadf87f02a5c4b053defb1b9..7cf5cbd4c0369489ae2bd8aade2aa50153b9c353 100644 (file)
@@ -2,10 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    require './test.pl';
+    set_up_inc('../lib');
 }
 
-require './test.pl';
 plan( tests => 23 );
 
 # test various operations on @_
index c8513d1ca0785b874e8bd47c4b8bea390b5de989..691d6ce8157e0c4805d9b212524c193a3270f513 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('.', '../lib');
     require './test.pl';
+    set_up_inc('.', '../lib');
 }
 
 plan (173);
index ac1ad77277363ec9b64f5db790652822de4e976d..81019431fcb4bb7275f3dfbd15b88c423f0e3a1f 100644 (file)
@@ -9,8 +9,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 996d57237519953ef46e0a5c99b8dfadc43b2d43..13a23817e48477283587b3304b765c66d023ff24 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all_if_miniperl("miniperl can't load attributes");
 }
 
index 464081f29adc7df34ac4affc18272f84afa8b756..e30e40ab253c20b21b7835c7af2595a43a98bfdc 100644 (file)
@@ -5,8 +5,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all_if_miniperl("miniperl can't load attributes");
 }
 use warnings;
index 219db03d296fb5e303266087c4960e0f9c887179..23b00cadd590f197ba96653e87b0574845f801ed 100644 (file)
@@ -4,8 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all_if_miniperl("miniperl can't load attributes");
 }
 
index 90380ed46d4d9e48f221bf400490ff18e480b077..64dd06d978ea03abea3e8dbee4ba6113245563f0 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require "./test.pl";
+    set_up_inc(qw(. ../lib));
 }
 
 plan( tests => 47 );
index 39a54dc70fdceeef3a46aed1e1eb04c37c7e4049..72d041f5b5dc632165fd4919b9c56a1c88e9071e 100644 (file)
@@ -276,7 +276,7 @@ eval {
 };
 not_hash($@);
 
-# Check hash slices (BUG ID 20010423.002)
+# Check hash slices (BUG ID 20010423.002 (#6879))
 $avhv = [{foo=>1, bar=>2}];
 eval {
     @$avhv{"foo", "bar"} = (42, 53);
index 69217fde9b17132c78955c7a4156a7d2394ee680..73c82ba71a374fa2ac20afbd4d4858e504e18852 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan (114);
index 14e57ba2111a82662a21f5173ca6d81b7bc93464..2afb8d7c81109839969f6d688affaf434d1e11b8 100644 (file)
@@ -9,8 +9,9 @@ no warnings 'deprecated';
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
-    require "./test.pl"; require "./charset_tools.pl";
+    require "./test.pl";
+    set_up_inc('../lib');
+    require "./charset_tools.pl";
     require Config;
 }
 
index 80d3a5a167bca606f827b6f5767b353750402b2d..969c3bd6a5004bfa7af42b806030e6c350b43e13 100644 (file)
@@ -3,9 +3,9 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
-    plan( tests => 96 );
+    set_up_inc('../lib');
+    plan( tests => 96 ); # some tests are run in a BEGIN block
 }
 
 my @c;
@@ -27,7 +27,7 @@ sub { @c = caller(0) } -> ();
 is( $c[3], "main::__ANON__", "anonymous subroutine name" );
 ok( $c[4], "hasargs true with anon sub" );
 
-# Bug 20020517.003, used to dump core
+# Bug 20020517.003 (#9367), used to dump core
 sub foo { @c = caller(0) }
 my $fooref = delete $::{foo};
 $fooref -> ();
index 5eef6776f8a07df65912ba5fa2066ff44835d443..2c312590649ca0d16be554f17c83dcea024c369e 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 34;
index a5ea76acc704ac2ef7ec8722ca68e8ea96ee4c67..9967707a0cf54fd1580d78235c7bfeea9b236d29 100644 (file)
@@ -8,11 +8,12 @@ BEGIN {
     # We're not going to chdir() into 't' because we don't know if
     # chdir() works!  Instead, we'll hedge our bets and put both
     # possibilities into @INC.
-    unshift @INC, qw(t . lib ../lib);
-    require "test.pl";
-    plan(tests => 47);
+    require "./test.pl";
+    set_up_inc(qw(t . lib ../lib));
 }
 
+plan(tests => 47);
+
 use Config;
 use Errno qw(ENOENT EBADF EINVAL);
 
index d24b9e068d35a25c1ddda6d9fbb2e83126d5443e..743f21ad7770dbf794195763dfcf672d4d3f8aca 100644 (file)
@@ -2,8 +2,9 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
-    require './test.pl'; require './charset_tools.pl';
+    require './test.pl';
+    set_up_inc('../lib');
+    require './charset_tools.pl';
 }
 
 my $tests_count = 148;
@@ -123,7 +124,7 @@ is ($_, "\x{1234}");
 my @stuff = qw(this that);
 is (chop(@stuff[0,1]), 't');
 
-# bug id 20010305.012
+# bug id 20010305.012 (#5972)
 @stuff = qw(ab cd ef);
 is (chop(@stuff = @stuff), 'f');
 
index d43fa592abe43fa7585dc1e7355a1fae8f093c6e..e0a51eb3a96ef1ba6d06161837d426c2bfa38ec9 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib); # ../lib needed for test.deparse
     require "./test.pl";
+    set_up_inc(qw(. ../lib)); # ../lib needed for test.deparse
 }
 
 plan tests => 45;
index 363bcf8bf54e13673876f3b87ac724c7ab9f80f3..cc2fa4f00bb2e38e30514cf30fa6e0976f487f6e 100644 (file)
@@ -8,8 +8,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan 2;
index acf0704580d308a896b171ec67851faf97ec64d0..25d506047b6cf9f698056168296fcc71bb8b9690 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 is( 1 ? 1 : 0, 1, 'compile time, true' );
index bd47064d442e69f1625b1129fd0c60838c9600aa..b378d4a53c9557cff2f60c0fe742fd2662ca3f52 100644 (file)
@@ -6,7 +6,7 @@
 BEGIN {
     chdir 't';
     require './test.pl';
-    @INC = '../lib';
+    set_up_inc('../lib');
 }
 plan 168;
 
index 41ee84bf512fdffd7248d9e5a6e175fc7c86b72e..29b08c0d2b9b48f89f862b5e4775cfc36a105ead 100644 (file)
@@ -2,7 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
+    require "./test.pl";
+    set_up_inc( qw(. ../lib) );
 }
 
 require "./test.pl";
index cca23f36b5ef8568fb2834d657dbebec534e74de..c9586542704b3978ed821ab24a30d3a0aca31e94 100644 (file)
@@ -9,9 +9,9 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib ../dist/if);
     require "./test.pl"; require './charset_tools.pl';
     $^P |= 0x100;
+    set_up_inc( qw(. ../lib ../dist/if) );
 }
 
 no warnings 'experimental::smartmatch';
@@ -631,7 +631,12 @@ is &mykeys({ 1..4 }), 2, '&mykeys(\%hash) in scalar cx';
 lis [sort &mykeys({1..4})], [1,3], '&mykeys(\%hash) in list cx';
 is &mykeys([ 1..4 ]), 4, '&mykeys(\@array) in scalar cx';
 lis [&mykeys([ 1..4 ])], [0..3], '&mykeys(\@array) in list cx';
-{
+
+SKIP: {
+  skip "no Hash::Util on miniperl", 2, if is_miniperl;
+  require Hash::Util;
+  sub Hash::Util::bucket_ratio (\%);
+
   my %h = 1..2;
   &mykeys(\%h) = 1024;
   like Hash::Util::bucket_ratio(%h), qr|/1024\z|, '&mykeys = changed number of buckets allocated';
index c18fdcde9337b0145a0f8c8af4437ed59eb89297..62210b576d9a5e9c7169e411b2059526d509a308 100644 (file)
@@ -6,8 +6,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require "./test.pl";
+    set_up_inc(qw(. ../lib));
     skip_all_without_dynamic_extension('B');
     $^P |= 0x100;
 }
index aace8aa03604cbf8d1f70ba3e22e87504c732bfa..fec9fe6ba9399e3bed776b8994f1082212fa476f 100644 (file)
@@ -3,10 +3,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    require './test.pl';
+    set_up_inc('../lib');
 }
 
-BEGIN { require './test.pl'; }
 plan tests => 254;
 
 while (<DATA>) {
index 4e0662927b718729de6e1004ebe1b3a69db1f04f..5e7183b8630d51a017c95324868833e5ccecf418 100644 (file)
@@ -2,21 +2,18 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
-}
-
-BEGIN {
-    use Config;
-
     require "./test.pl";
+    set_up_inc( qw(. ../lib) );
+    use Config;
+}
 
-    if( !$Config{d_crypt} ) {
-        skip_all("crypt unimplemented");
-    }
-    else {
-        plan(tests => 6);
-    }
+if ( !$Config{d_crypt} ) {
+    skip_all("crypt unimplemented");
 }
+else {
+    plan(tests => 6);
+}
+
 
 # Can't assume too much about the string returned by crypt(),
 # and about how many bytes of the encrypted (really, hashed)
index 2dcc1847e8ab42d0b603abc8144ecc2b8ac530ff..b7647faefdffe14710a99fc555b0d69f3bd54247 100644 (file)
@@ -2,9 +2,9 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(../lib);
     require './test.pl';
-    plan (tests => 22);
+    set_up_inc( qw(../lib) );
+    plan (tests => 22); # some tests are run in BEGIN block
 }
 
 is __SUB__, "__SUB__", '__SUB__ is a bareword outside of use feature';
index 6c51dad61e8b745c52b53a283a9f2df1a6f0d513..f3b7de2833e9fa4bc182395b38ed9f162eab03a1 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 
     eval { require AnyDBM_File }; # not all places have dbm* functions
     skip_all("No dbm functions") if $@;
@@ -11,7 +11,7 @@ BEGIN {
 
 plan tests => 5;
 
-# This is [20020104.007] "coredump on dbmclose"
+# This is [20020104.007 (#8179)] "coredump on dbmclose"
 
 my $filename = tempfile();
 
index 2c11daa529637485ec64537d16dfab3aac62400f..80e6b7fbcaeb2bfc0828d7f2fdb063c47d574570 100644 (file)
@@ -4,15 +4,18 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-plan 188;
+plan 402;
 
 for my $decl (qw< my CORE::state our local >) {
     for my $funny (qw< $ @ % >) {
         # Test three syntaxes with each declarator/funny char combination:
-        #     my \$foo    my(\$foo)    my\($foo)
+        #     my \$foo    my(\$foo)    my\($foo)    for my \$foo
 
         for my $code("$decl \\${funny}x", "$decl\(\\${funny}x\)",
-                     "$decl\\\(${funny}x\)") {
+                     "$decl\\\(${funny}x\)",
+                     "for $decl \\${funny}x (\\${funny}y) {}") {
+          SKIP: {
+            skip "for local is illegal", 3 if $code =~ /^for local/;
             eval $code;
             like
                 $@,
@@ -27,6 +30,7 @@ for my $decl (qw< my CORE::state our local >) {
             is $c, 1, "one warning from $code";
             like $w, qr/^Declaring references is experimental at /,
                 "experimental warning for $code";
+          }
         }
     }
 }
@@ -35,62 +39,84 @@ use feature 'declared_refs', 'state';
 no warnings 'experimental::declared_refs';
 
 for $decl ('my', 'state', 'our', 'local') {
+for $sigl ('$', '@', '%') {
+    # The weird code that follows uses ~ as a sigil placeholder and MY
+    # as a declarator placeholder.
     my $code = '#line ' . (__LINE__+1) . ' ' . __FILE__ . "\n" . <<'END';
-    my $ret = MY \$a;
-    is $ret, \$a, 'MY \$a returns ref to $a';
-    isnt $ret, \$::a, 'MY \$a ret val is not pkg var';
-    my @ret = MY \($b, $c);
-    is "@ret", \$b." ".\$c, 'MY \($b, $c) returns correct refs';
-    isnt $ret[0], \$::b, 'first retval of MY \($b, $c) is not pkg var';
-    isnt $ret[1], \$::c, '2nd retval of MY \($b, $c) is not pkg var';
-    @ret = MY (\($d, $e));
-    is "@ret", \$d." ".\$e, 'MY (\($d, $e)) returns correct refs';
-    isnt $ret[0], \$::d, 'first retval of MY (\($d, $e)) is not pkg var';
-    isnt $ret[1], \$::e, '2nd retval of MY (\($d, $e)) is not pkg var';
-    @ret = \MY (\$f, $g);
-    is ${$ret[0]}, \$f, 'first retval of MY (\$f, $g) is \$f';
-    isnt ${$ret[0]}, \$::f, 'first retval of MY (\$f, $g) is not \$::f';
-    is $ret[1], \$g, '2nd retval of MY (\$f, $g) is $g';
-    isnt $ret[1], \$::g, '2nd retval of MY (\$f, $g) is not $::g';
+    my $ret = MY \~a;
+    is $ret, \~a, 'MY \$a returns ref to $a';
+    isnt $ret, \~::a, 'MY \$a ret val is not pkg var';
+    my @ret = MY \(~b, ~c);
+    is "@ret", \~b." ".\~c, 'MY \(~b, ~c) returns correct refs';
+    isnt $ret[0], \~::b, 'first retval of MY \(~b, ~c) is not pkg var';
+    isnt $ret[1], \~::c, '2nd retval of MY \(~b, ~c) is not pkg var';
+    @ret = MY (\(~d, ~e));
+    is "@ret", \~d." ".\~e, 'MY (\(~d, ~e)) returns correct refs';
+    isnt $ret[0], \~::d, 'first retval of MY (\(~d, ~e)) is not pkg var';
+    isnt $ret[1], \~::e, '2nd retval of MY (\(~d, ~e)) is not pkg var';
+    @ret = \MY (\~f, ~g);
+    is ${$ret[0]}, \~f, 'first retval of MY (\~f, ~g) is \~f';
+    isnt ${$ret[0]}, \~::f, 'first retval of MY (\~f, ~g) is not \~::f';
+    is $ret[1], \~g, '2nd retval of MY (\~f, ~g) is ~g';
+    isnt $ret[1], \~::g, '2nd retval of MY (\~f, ~g) is not ~::g';
     *MODIFY_SCALAR_ATTRIBUTES = sub {
-        is @_, 3, 'MY \$h : risible  calls handler with right no. of args';
-        is $_[2], 'risible', 'correct attr passed by MY \$h : risible';
+        is @_, 3, 'MY \~h : risible  calls handler with right no. of args';
+        is $_[2], 'risible', 'correct attr passed by MY \~h : risible';
         return;
     };
     SKIP : {
         unless ('MY' eq 'local') {
             skip_if_miniperl "No attributes on miniperl", 2;
-            eval 'MY \$h : risible' or die $@ unless 'MY' eq 'local';
+            eval 'MY \~h : risible' or die $@ unless 'MY' eq 'local';
         }
     }
-    eval 'MY \$a ** 1';
+    eval 'MY \~a ** 1';
     like $@,
         qr/^Can't (?:declare|modify) exponentiation \(\*\*\) in "?MY"? at/,
-       'comp error for MY \$a ** 1';
-    $ret = MY \\$i;
-    is $$ret, \$i, 'retval of MY \\$i is ref to ref to $i';
-    $ret = MY \\$i;
-    isnt $$ret, \$::i, 'retval of MY \\$i is ref to ref to $::i';
-    $ret = MY (\\$i);
-    is $$ret, \$i, 'retval of MY (\\$i) is ref to ref to $i';
-    $ret = MY (\\$i);
-    isnt $$ret, \$::i, 'retval of MY (\\$i) is ref to ref to $::i';
+       'comp error for MY \~a ** 1';
+    $ret = MY \\~i;
+    is $$ret, \~i, 'retval of MY \\~i is ref to ref to ~i';
+    $ret = MY \\~i;
+    isnt $$ret, \~::i, 'retval of MY \\~i is ref to ref to ~::i';
+    $ret = MY (\\~i);
+    is $$ret, \~i, 'retval of MY (\\~i) is ref to ref to ~i';
+    $ret = MY (\\~i);
+    isnt $$ret, \~::i, 'retval of MY (\\~i) is ref to ref to ~::i';
     *MODIFY_SCALAR_ATTRIBUTES = sub {
-        is @_, 3, 'MY (\$h) : bumpy  calls handler with right no. of args';
-        is $_[2], 'bumpy', 'correct attr passed by MY (\$h) : bumpy';
+        is @_, 3, 'MY (\~h) : bumpy  calls handler with right no. of args';
+        is $_[2], 'bumpy', 'correct attr passed by MY (\~h) : bumpy';
         return;
     };
     SKIP : {
         unless ('MY' eq 'local') {
             skip_if_miniperl "No attributes on miniperl", 2;
-            eval 'MY (\$h) : bumpy' or die $@;
+            eval 'MY (\~h) : bumpy' or die $@;
         }
     }
     1;
 END
     $code =~ s/MY/$decl/g;
+    $code =~ s/~/$sigl/g;
+    $code =~ s/MODIFY_\KSCALAR/$sigl eq '@' ? "ARRAY" : "HASH"/eggnog
+        if $sigl ne '$';
     if ($decl =~ /^(?:our|local)\z/) {
         $code =~ s/is ?no?t/is/g; # tests for package vars
     }
     eval $code or die $@;
-}
+}}
+
+use feature 'refaliasing'; no warnings "experimental::refaliasing";
+for $decl ('my', 'state', 'our') {
+for $sigl ('$', '@', '%') {
+    my $code = '#line ' . (__LINE__+1) . ' ' . __FILE__ . "\n" . <<'ENE';
+    for MY \~x (\~::y) {
+        is \~x, \~::y, '\~x aliased by for MY \~x';
+        isnt \~x, \~::x, '\~x is not equivalent to \~::x';
+    }
+    1;
+ENE
+    $code =~ s/MY/$decl/g;
+    $code =~ s/~/$sigl/g;
+    $code =~ s/is ?no?t/is/g if $decl eq 'our';
+    eval $code or die $@;
+}}
index 86e0dd8287f4d5227cf23fc37857328540e05624..fb746d5f93b1ac4b274efe6f7661e216b48c51a8 100644 (file)
@@ -6,10 +6,11 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
+    require './test.pl';
+    set_up_inc( qw(. ../lib) );
     $SIG{__WARN__} = sub { $warns++; warn $_[0] };
 }
-require './test.pl';
+
 plan( tests => 27 );
 
 my $unix_mode = 1;
index e6833273aa07bd73150b7e29ffeb1c8276b530e1..e7c1e876571af356eb8a4dc4bd0b3b802343e957 100644 (file)
@@ -2,10 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
+    require "./test.pl";
+    set_up_inc( qw(. ../lib) );
 }
 
-require "./test.pl";
 plan( tests => 38 );
 
 # delete() on hash elements
index c98b8ff8f20ddca86c143d2ce8002ac9e6bd46dc..0833095d322f0768efe02abec67f43b3f64da321 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 19;
index bd9ac28598944721ac63f41143378a32c9b9a4ad..e074913e86d8eaf06465c41ba1b0cfdf441f4006 100644 (file)
@@ -7,8 +7,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 055a8020a5f1c6b388c5573e40b3adbb64a14978..80c4c02e9a1bc461a1936595c6b1fd4da0238787 100644 (file)
@@ -3,9 +3,10 @@
 BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
-    plan(24);
 }
 
+plan(24);
+
 sub End::DESTROY { $_[0]->() }
 
 sub end(&) {
index 0bbab5e506e97dc2c660f9058284fee81a3602df..78d88008861c9a6c8348432461b6294626014c30 100644 (file)
--- a/t/op/do.t
+++ b/t/op/do.t
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc( '../lib' );
 }
 use strict;
 no warnings 'void';
@@ -41,7 +41,7 @@ if (open my $do, '>', $file18) {
 
 do $file18; die $@ if $@;
 
-# bug ID 20010920.007
+# bug ID 20010920.007 (#7713)
 eval qq{ do qq(a file that does not exist); };
 is($@, '', "do on a non-existing file, first try");
 
index 7fbeca06eb852345e1d8c8c8c722e0ba5c7c5079..4b89fd0d8c5fcddf658a21f2f9cb3c46fd19b118 100644 (file)
@@ -4,11 +4,11 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    require "./test.pl";
+    set_up_inc('../lib');
 }
 
 package main;
-require './test.pl';
 
 plan( tests => 34 );
 
index 7c5c3af8980f333a9a3086b9499879ebe54a41ba..e261db18d5a464427d11d21699c79235f7e4b429 100644 (file)
@@ -4,9 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require './test.pl';
-
+    set_up_inc( qw(. ../lib) );
     skip_all_if_miniperl();
 }
 
index 0d342a2f308f4504431f857f6ca3eef442ec2716..e9ee30200fa2e2fd8e7de573050446f1738f997c 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 59;
@@ -60,20 +60,26 @@ is ($i, 30, "each count");
 @keys = ('blurfl', keys(%h), 'dyick');
 is ($#keys, 31, "added a key");
 
-$size = Hash::Util::num_buckets(%h);
-keys %h = $size * 5;
-$newsize = Hash::Util::num_buckets(%h);
-is ($newsize, $size * 8, "resize");
-keys %h = 1;
-$size = Hash::Util::num_buckets(%h);
-is ($size, $newsize, "same size");
-%h = (1,1);
-$size = Hash::Util::num_buckets(%h);
-is ($size, $newsize, "still same size");
-undef %h;
-%h = (1,1);
-$size = Hash::Util::num_buckets(%h);
-is ($size, 8, "size 8");
+SKIP: {
+    skip "no Hash::Util on miniperl", 4, if is_miniperl;
+    require Hash::Util;
+    sub Hash::Util::num_buckets (\%);
+
+    $size = Hash::Util::num_buckets(%h);
+    keys %h = $size * 5;
+    $newsize = Hash::Util::num_buckets(%h);
+    is ($newsize, $size * 8, "resize");
+    keys %h = 1;
+    $size = Hash::Util::num_buckets(%h);
+    is ($size, $newsize, "same size");
+    %h = (1,1);
+    $size = Hash::Util::num_buckets(%h);
+    is ($size, $newsize, "still same size");
+    undef %h;
+    %h = (1,1);
+    $size = Hash::Util::num_buckets(%h);
+    is ($size, 8, "size 8");
+}
 
 # test scalar each
 %hash = 1..20;
@@ -98,15 +104,20 @@ $total = 0;
 $total += $key while $key = each %hash;
 is ($total, 100, "test values keys resets iterator");
 
-$size = Hash::Util::num_buckets(%hash);
-keys(%hash) = $size / 2;
-is ($size, Hash::Util::num_buckets(%hash),
-    "assign to keys does not shrink hash bucket array");
-keys(%hash) = $size + 100;
-isnt ($size, Hash::Util::num_buckets(%hash),
-    "assignment to keys of a number not large enough does not change size");
-
-is (keys(%hash), 10, "keys (%hash)");
+SKIP: {
+    skip "no Hash::Util on miniperl", 3, if is_miniperl;
+    require Hash::Util;
+    sub Hash::Util::num_buckets (\%);
+
+    $size = Hash::Util::num_buckets(%hash);
+    keys(%hash) = $size / 2;
+    is ($size, Hash::Util::num_buckets(%hash),
+       "assign to keys does not shrink hash bucket array");
+    keys(%hash) = $size + 100;
+    isnt ($size, Hash::Util::num_buckets(%hash),
+         "assignment to keys of a number not large enough does not change size");
+    is (keys(%hash), 10, "keys (%hash)");
+}
 
 @tests = (&next_test, &next_test, &next_test);
 {
index f6916dcf7818a6488a7d9bb39dc8df212b00f4cf..b819d26653b5253b540da6535d047f7a98585398 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 use strict;
 use warnings;
index 7b9fb17f7fb603d5946f0d947898b2c4d839bb66..722cd35c37b07f48fbdd2ad0abe30e47ce767aef 100644 (file)
@@ -221,7 +221,7 @@ is(do {
 }
 
 # Check that eval catches bad goto calls
-#   (BUG ID 20010305.003)
+#   (BUG ID 20010305.003 (#5963))
 {
     eval {
        eval { goto foo; };
@@ -248,7 +248,7 @@ is(do {
 {
     $@ = 5;
     eval q{};
-    cmp_ok(length $@, '==', 0, '[ID 20020623.002] eval "" doesn\'t clear $@');
+    cmp_ok(length $@, '==', 0, '[ID 20020623.002 (#9721)] eval "" doesn\'t clear $@');
 }
 
 # DAPM Nov-2002. Perl should now capture the full lexical context during
index cca7c04787a093d2bac3d6129433bccb8674ca70..9b77c8e0685f7f8ac3e4699d842ecee778a20c01 100644 (file)
@@ -2,8 +2,9 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
-    require './test.pl'; require './charset_tools.pl';
+    require './test.pl';
+    set_up_inc('../lib');
+    require './charset_tools.pl';
 }
 
 plan(tests => 8);
index 325ccb2aceaf846b7ddef56f70449595831a77bb..886c32350a0847e5182347f80617c801e0df8c6e 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('../lib');
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 my $vms_exit_mode = 0;
index a08e0f5422d045a84df16fa6ef69886b0e01cccf..9785fa32155d71c0825881a35c0f20470c3542ba 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 sub t1;
index eb53f1b5eb1c2613bfcb01e69c43f62268731ab6..5878f4431b1f05a936a058a8c666b74850554645 100644 (file)
@@ -4,8 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use Config;
index 356eb43fb338e6b5484ed00febb4f2f58c577be0..bda59c1fee155043aa52c029f3f6825a78f7feab 100644 (file)
--- a/t/op/fh.t
+++ b/t/op/fh.t
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 8;
index a7621db59aaa55dfce30422a1e474e3007da1268..5ccdf5ecf6a1b57a21d2fc67ff2be343401a86fb 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all_if_miniperl("no dynamic loading on miniperl, no IO, hence no FileHandle");
 }
 
index 4128612d6cd891529c37b98379dae7e4e6d5f36d..ceff452da13957956a0d4bd9b69383f30fc34fc4 100644 (file)
@@ -6,8 +6,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 my @ops = split //, 'rwxoRWXOezsfdlpSbctugkTMBAC';
index eec67ec8677e9a8bda28b861b8da0dcaac5dcff0..a7819eaeb4195da398b2f35062e6be18bc6dd189 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 2706bf82cf33352662d5b66b0d177a6fb72c743f..0758623e79c3cc5c15df373a9030860320b2ea09 100644 (file)
@@ -36,7 +36,7 @@ $x = 3.14;
 ok(($x...$x) eq "1");
 
 {
-    # coredump reported in bug 20001018.008
+    # coredump reported in bug 20001018.008 (#4474)
     readline(UNKNOWN);
     $. = 1;
     $x = 1..10;
index 77cc7b73ddefca1e41b79cba1a3afc5116ef18a3..b69a929fe02c5bb0b79ddb876434378e2c9918cd 100644 (file)
@@ -4,8 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     require Config;
     skip_all('no fork')
        unless ($Config::Config{d_fork} or $Config::Config{d_pseudofork});
index fcf48e76222e93ba70d0c936fb2b9a0b4f708f39..b540a802eb54f6f45c9a7c8d64166674a3772b64 100644 (file)
@@ -4,8 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan 1;
index cc3085ae519447ffdf646270c89893e4b5273199..109edd2882ef390111ec93b2e48b4ed12f98c58e 100644 (file)
@@ -4,16 +4,18 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(../lib);
     require './test.pl';
+    set_up_inc( qw(../lib) );
+    skip_all_if_miniperl(
+       "no dynamic loading on miniperl, no threads/attributes"
+    );
 }
 
 use strict;
 use Config;
 
-BEGIN {
+{
     skip_all_without_config(qw(useithreads d_getppid));
-    skip_all_if_miniperl("no dynamic loading on miniperl, no threads");
     eval 'use threads; use threads::shared';
     plan tests => 3;
     if ($@) {
index a8d0f2cb3b8e4f476dc63ec819f65f66143a47df..11e0f6412208343fecbb413fa556352bd59aa48b 100644 (file)
@@ -9,16 +9,14 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(../lib);
+    require './test.pl';
+    set_up_inc( qw(../lib) );
 }
 
 use strict;
 
-BEGIN {
-    require './test.pl';
-    skip_all_without_config(qw(d_pipe d_fork d_waitpid d_getppid));
-    plan (8);
-}
+skip_all_without_config(qw(d_pipe d_fork d_waitpid d_getppid));
+plan (8);
 
 # No, we don't want any zombies. kill 0, $ppid spots zombies :-(
 $SIG{CHLD} = 'IGNORE';
index 7eec330563516c692f009575451af04d397fe632..01f46a08c0091673b233994e9773747b218b3a9a 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require './test.pl';
+    set_up_inc( qw(. ../lib) );
 }
 
 plan( tests => 18 );
@@ -143,4 +143,4 @@ SKIP: {
         print "ok2" if $output1 eq $output2;
     }
 EOP
-}
\ No newline at end of file
+}
index 43f8fdbf5955e95d157037657274fece224b2439..1226e3a7851577374470b7d3552abaf83bd4b3f2 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index aa2f24fa7c386a8c3834c9077c0db443f3e06601..58780bb776a91e9e9de82d3de3d7e624089f1aa1 100644 (file)
@@ -4,8 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require "./test.pl"; require './charset_tools.pl';
+    set_up_inc( qw(. ../lib) );
 }
 
 use warnings;
@@ -97,7 +97,7 @@ for (1) {
 is($count, 2, 'end of loop');
 
 # Does goto work correctly within a for(;;) loop?
-#  (BUG ID 20010309.004)
+#  (BUG ID 20010309.004 (#5998))
 
 for(my $i=0;!$i++;) {
   my $x=1;
index fbdd2dd8cd9cf5fddf1e996cafcdf2eecf336b2d..f7d50b7b00810b62a5a466f540d52264a49b7c36 100644 (file)
@@ -12,7 +12,7 @@ BEGIN {
     require './test.pl';
 # turn warnings into fatal errors
     $SIG{__WARN__} = sub { die "WARNING: @_" } ;
-
+    set_up_inc('../lib');
     skip_all_if_miniperl("no dynamic loading on miniperl, no Fcntl");
     require Fcntl;
 }
index 3b28619605eb694f1a308c7aac37617d0ffcc078..8fc8c7c8fa726812a870645650036f61bcc21e12 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 eval {my @n = getgrgid 0};
index 83ee4b6621c11c425150149b6eaf5831926202ba..765fd6bf38151c4de020a6867767084ea869a878 100644 (file)
@@ -5,9 +5,9 @@
 #
 
 BEGIN {
-    chdir 't' if -d 't';
-    @INC = qw(. ../lib);
+    chdir 't' if -d 't'; 
     require "./test.pl";
+    set_up_inc( qw(. ../lib) );
 }
 
 plan( tests => 67 );
index 754690cf1fa0732ff93b276a3e33bac1a25bdb08..912b2e92a8595b2fa6772dc7f9750d170f6113b8 100644 (file)
@@ -11,10 +11,11 @@ BEGIN {
     $ENV{LANGUAGE} = 'C'; # GNU locale extension
 
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc( '../lib' );
     skip_all_if_miniperl("no dynamic loading on miniperl, no POSIX");
 }
+
 use 5.010;
 use strict;
 use Config ();
index 03ae46e46b2172e551a3f94393f184cba4df57c6..9bdc711f7a4eda2af7b8a9a4d199b022cc749202 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -240,7 +240,7 @@ is *x{PACKAGE}, 'main', 'and *foo{PACKAGE} the original package';
     ok(defined *{$a});
 }
 
-# [ID 20010526.001] localized glob loses value when assigned to
+# [ID 20010526.001 (#7038)] localized glob loses value when assigned to
 
 $j=1; %j=(a=>1); @j=(1); local *j=*j; *j = sub{};
 
index 8dbf004dce85ace4029cbeb84c86ecfe84c9ce50..eb9264c5e2f112d17736330e09c2c3e484d5d275 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
   chdir 't' if -d 't';
-  @INC = '../lib';
   require './test.pl';
+  set_up_inc( '../lib' );
   skip_all_without_dynamic_extension("Devel::Peek");
 }
 
index 3c083e02810412b10433d951aa451862fc5a00c5..1f8a55065535fbf268cd7a6bd3e290615dea746b 100644 (file)
@@ -134,6 +134,9 @@ sub validate_hash {
 
   is($scalar, $count, "$desc scalar() should be the same as 0+keys() as of perl 5.25");
 
+  require Hash::Util;
+  sub Hash::Util::bucket_ratio (\%);
+
   # back compat tests, via Hash::Util::bucket_ratio();
   my $ratio = Hash::Util::bucket_ratio(%$h);
   my $expect = qr!\A(\d+)/(\d+)\z!;
@@ -212,9 +215,13 @@ sub torture_hash {
   is(scalar %$h1, scalar %$h, "scalar keys is identical on copy and original");
 }
 
-torture_hash('a .. zz', 'a' .. 'zz');
-torture_hash('0 .. 9', 0 .. 9);
-torture_hash("'Perl'", 'Rules');
+if (is_miniperl) {
+    print "# skipping torture_hash tests on miniperl because no Hash::Util\n";
+} else {
+    torture_hash('a .. zz', 'a' .. 'zz');
+    torture_hash('0 .. 9', 0 .. 9);
+    torture_hash("'Perl'", 'Rules');
+}
 
 {
     my %h = qw(a x b y c z);
index 57a625cb2e46793723e4a92670aa2508d918dbbb..d6ede42131d0f6fa2be0672373cdde8d5541ac5e 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 # use strict;
index 6d7224487d3ea0e158e23dee166875b5ea5f8725..72f4a8e253f93c27dbce2c679e06d61159b4fab9 100644 (file)
@@ -2,10 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
+    require './test.pl';
+    set_up_inc( qw(. ../lib) );
 }
 
-require './test.pl';
 plan( tests => 18 );
 
 use strict;
index 8fe0c0fdda516e366e934f30d51c8139db811570..90ba6060e27214a9466431d24714b62bc2d8535f 100644 (file)
@@ -1,9 +1,9 @@
 # tests for heredocs besides what is tested in base/lex.t
 
 BEGIN {
-   chdir 't' if -d 't';
-   @INC = '../lib';
-   require './test.pl';
+    chdir 't' if -d 't';
+    require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 4b2a96d051b082a27d860ce800c0a1a089f55838..bdf1e95d8d7044962f4f28333a890e8d16de617e 100644 (file)
@@ -2,15 +2,15 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
 
 use Config;
 
-plan(tests => 105);
+plan(tests => 109);
 
 # Test hexfloat literals.
 
@@ -243,6 +243,19 @@ SKIP:
     }
 }
 
+# [perl #128919] limited exponent range in hex fp literal with long double
+SKIP: {
+    skip("non-80-bit-long-double", 4)
+        unless ($Config{uselongdouble} &&
+               ($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
+               ($Config{longdblkind} == 3 ||
+                $Config{longdblkind} == 4));
+    is(0x1p-1074,  4.94065645841246544e-324);
+    is(0x1p-1075,  2.47032822920623272e-324, '[perl #128919]');
+    is(0x1p-1076,  1.23516411460311636e-324);
+    is(0x1p-16445, 3.6451995318824746e-4951);
+}
+
 # sprintf %a/%A testing is done in sprintf2.t,
 # trickier than necessary because of long doubles,
 # and because looseness of the spec.
index e362ed12f8730fcfd79c24eca0d593277094be59..20d47696572d9a2189053f0e7b861d3e52000a2a 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 016b425665e3358a3e983e5672419569296673fe..4e81a8a42512f94df95a540a1f18c7510dbe70be 100644 (file)
@@ -197,7 +197,7 @@ is( $ret, 'abc', 'do "abc.pl" sees return value' );
     my $got;
     #local @INC; # local fails on tied @INC
     my @old_INC = @INC; # because local doesn't work on tied arrays
-    @INC = ('lib', 'lib/Devel', sub { $got = $_[1]; return undef; });
+    @INC =  ('lib', 'lib/Devel', sub { $got = $_[1]; return undef; });
     foreach my $filename ('/test_require.pm', './test_require.pm',
                          '../test_require.pm') {
        local %INC;
@@ -274,7 +274,7 @@ sub fake_module {
 }
 {
     local @INC = @INC;
-    unshift @INC, (\&fake_module)x2;
+    @INC = (\&fake_module)x2;
     eval { require "${\'bralbalhablah'}" };
     like $@, qr/^Can't locate/,
         'require PADTMP passing freed var when @INC has multiple subs';\r
index 9019ba5df38eed03df85535ccb4d87eb3314b18c..de692de1f2037520a3f04d4abd0d22418567cec0 100644 (file)
@@ -4,11 +4,15 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require './test.pl';
-    skip_all_if_miniperl('no dynamic loading on miniperl, no Filter::Util::Call');
-    skip_all_without_perlio();
+    set_up_inc( qw(. ../lib) );
+    skip_all_if_miniperl(
+       'no dynamic loading on miniperl, no Filter::Util::Call'
+    );
 }
+
+skip_all_without_perlio();
+
 use strict;
 use Config;
 use Filter::Util::Call;
index 06fb60d49cf90099f1b4f7e8cf5b796519ca096d..b50d6e68d54af801db16ed90aa420dc1bc6fde01 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index dda49080daeef057f79cadc27f4ac1ff6055f917..7e936da68d17411ccacb6943c99755e645386982 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     require Config;
 }
 
index 17b618e7be9f94be311ce9418b59763c9f165f47..7f9a1968980b5764111a333a511bdd9bf2140879 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 29;
index 7f6e6ecb79cf96bf7674168dc3da26b669c14675..402916edc6ca865480679ba32e467148da83871e 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 BEGIN {
index dd94d30aa84407909f4f8ca02e468f757f157782..92d1c73a0039e2d50c538651050c532aa3441d8d 100644 (file)
@@ -7,7 +7,7 @@
 BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
-    @INC = '../lib';
+    set_up_inc('../lib');
 }
 
 # Hack to allow test counts to be specified piecemeal
@@ -19,6 +19,7 @@ plan (tests => $tests);
 use tests 2; # First make sure that %! %- %+ do not load extra modules.
 map %{"foo::$_"}, qw< ! - + >;
 ok !exists $INC{'Errno.pm'}, '$swext::! does not load Errno';
+
 ok !exists $INC{'Tie/Hash/NamedCapture.pm'},
   '$foo::+ and $foo::- do not load Tie::Hash::NamedCapture';
 
index 00e64fccecf820ad418aea2c316cdbbd64f9632d..e68fab44b8842a5d2caca5f8820eee8a44bbe2c4 100644 (file)
@@ -7,7 +7,7 @@ use warnings;
 
 BEGIN { chdir 't' if -d 't'; require './test.pl'; }
 
-plan(tests => 26);
+plan(tests => 28);
 
 {
     no warnings 'deprecated';
@@ -129,7 +129,7 @@ fresh_perl_is(
   '* <null> ident'
 );
 SKIP: {
-    skip "Different output on EBCDIC (presumably)", 2 if $::IS_EBCDIC;
+    skip "Different output on EBCDIC (presumably)", 3 if $::IS_EBCDIC;
     fresh_perl_is(
       qq'"ab}"ax;&\0z\x8Ao}\x82x;', <<gibberish,
 Bareword found where operator expected at - line 1, near ""ab}"ax"
@@ -150,6 +150,13 @@ gibberish
        { stderr => 1 },
       'gibberish containing &{+z} - used to crash [perl #123753]'
     );
+    fresh_perl_is(
+      "\@{\327\n", <<\gibberisi,
+Unrecognized character \xD7; marked by <-- HERE after @{<-- HERE near column 3 at - line 1.
+gibberisi
+       { stderr => 1 },
+      '@ { \327 \n - used to garble output (or fail asan) [perl #128951]'
+    );
 }
 
 fresh_perl_is(
@@ -214,5 +221,9 @@ fresh_perl_is(
   '$_ = q-strict.pm-; 1 ? require : die;'
  .' print qq-ok\n- if $INC{q-strict.pm-}',
   "ok\n",
+  {},
   'foo ? require : bar [perl #128307]'
 );
+
+like runperl(prog => 'sub ub(){0} ub ub', stderr=>1), qr/Bareword found/,
+ '[perl #126482] Assert failure when mentioning a constant twice in a row';
index 3e7a00816b906f7aef81fb75a82ed4561435540b..e1abde35c98baf27dcd74da73490bc4c35b32121 100644 (file)
@@ -5,8 +5,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 $| = 1;
@@ -102,12 +102,13 @@ EOE
 {                              # Check calling STORE
   note('Tied variables, calling STORE');
   my $sc = 0;
-  sub B::TIESCALAR {bless [11], 'B'}
-  sub B::FETCH { -(shift->[0]) }
-  sub B::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift }
+  # do not use B:: namespace
+  sub BB::TIESCALAR {bless [11], 'BB'}
+  sub BB::FETCH { -(shift->[0]) }
+  sub BB::STORE { $sc++; my $o = shift; $o->[0] = 17 + shift }
 
   my $m;
-  tie $m, 'B';
+  tie $m, 'BB';
   $m = 100;
 
   is( $sc, 1, 'STORE called when assigning scalar to tied variable' );
index acf9fe801fc95e5b817731ab13876924f522f5f9..1ddfd13ccdd7e4b53ec858fbcfba6f86c4744d1f 100644 (file)
@@ -4,9 +4,9 @@
 
 BEGIN {
        chdir 't' if -d 't';
-       @INC = '../lib';
        require './test.pl';
-       require Config;
+       set_up_inc('../lib');
+    require Config;
        # Don't bother if there are no quad offsets.
        skip_all('no 64-bit file offsets')
                if $Config::Config{lseeksize} < 8;
index 9fe00a4634df901c76fae5562feee8beff2cb256..7bd3eb41b55b68245c6dc06693dba3577209ac10 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require "./test.pl";
+    set_up_inc(qw(. ../lib));
 }
 
 plan( tests => 70 );
index 7ff21abf9cc0a38dcabd5165241c65afad7fdea9..fa22126abe4336a48f537ebe2851c28a9b804015 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require './test.pl';
+    set_up_inc(  qw(. ../lib) );
 }
 plan tests => 310;
 
index c40ec4c9fd0869debffe499f3e65fbae9f53d6c1..972fc0efb37484d3c2de5baf13e46ffe316de36c 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require './test.pl';
+    set_up_inc( qw(. ../lib) );
 }
 plan tests => 5;
 
index e0e37e46852534fab24ba5b3a6a15d3ba8cd04f0..1bb3c9c691fd1de3331084b70e9a67458a47f465 100644 (file)
@@ -32,8 +32,8 @@
 #  -- .robin. <robin@kitsite.com>  2001-03-13
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require "./test.pl";
+    set_up_inc(qw(. ../lib));
 }
 
 plan( tests => 67 );
index fe1c4326c9848babb7e73e288923d0a7125bee59..9ec628ae8598101b2d965bb178ea6fc5b051f449 100644 (file)
@@ -6,8 +6,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 23;
index a1c7fe293925b60dfd1bacc167ab786123ef0f0f..0106e45c3f8fe7ebd41120ea30786db9dc0f9754 100644 (file)
@@ -4,10 +4,13 @@ BEGIN {
     $SIG{__WARN__} = sub { die "Dying on warning: ", @_ };
     chdir 't' if -d 't';
     require './test.pl';
-    skip_all_if_miniperl("no dynamic loading on miniperl, no Tie::Hash::NamedCapture");
-    plan(tests => 2);
+    skip_all_if_miniperl(
+       "no dynamic loading on miniperl, no Tie::Hash::NamedCapture"
+    );
 }
 
+plan(tests => 2);
+
 use strict;
 
 # Test for bug [perl #27839]
index ad907497c60dfb2ca903ae1497178cdee2760e50..3f71f8ec642b543cc894c061987cf273f58e93e3 100644 (file)
@@ -3,9 +3,9 @@
 BEGIN {
     $| = 1;
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
-    plan (tests => 192);
+    set_up_inc( '../lib' );
+    plan (tests => 192); # some tests are run in BEGIN block
 }
 
 # Test that defined() returns true for magic variables created on the fly,
@@ -62,6 +62,7 @@ $PERL =
     $Is_MSWin32 ? '.\perl' :
                   './perl');
 
+
 sub env_is {
     my ($key, $val, $desc) = @_;
 
@@ -466,6 +467,7 @@ SKIP:  {
 
     undef %Errno::;
     delete $INC{"Errno.pm"};
+    delete $::{"!"};
 
     open(FOO, "nonesuch"); # Generate ENOENT
     my %errs = %{"!"}; # Cause Errno.pm to be loaded at run-time
@@ -705,6 +707,7 @@ is ++${^MPEN}, 1, '${^MPEN} can be incremented';
     sub FETCH { push @RT12608::G::ISA, "RT12608::H"; "RT12608::Y"; }
 }
 
+
 # ^^^^^^^^^ New tests go here ^^^^^^^^^
 
 SKIP: {
@@ -718,10 +721,12 @@ SKIP: {
            if $ENV{PERL_VALGRIND} || $Is_VMS;
 
            $PATH = $ENV{PATH};
+           $SYSTEMROOT = $ENV{SYSTEMROOT} if exists $ENV{SYSTEMROOT}; # win32
            $PDL = $ENV{PERL_DESTRUCT_LEVEL} || 0;
            $ENV{foo} = "bar";
            %ENV = ();
            $ENV{PATH} = $PATH;
+           $ENV{SYSTEMROOT} = $SYSTEMROOT if defined $SYSTEMROOT;
            $ENV{PERL_DESTRUCT_LEVEL} = $PDL || 0;
            if ($Is_MSWin32) {
                is `set foo 2>NUL`, "";
index b915306b8ead9418ed3503c4fcd40914be57aca0..8795734ae43b7499e30f44ee5a6c236b97d61e21 100644 (file)
@@ -6,8 +6,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib lib ../dist/base/lib);
     require "./test.pl";
+    set_up_inc( qw(. ../lib lib ../dist/base/lib) );
 }
 
 use strict;
@@ -311,7 +311,7 @@ is( Foo->boogie(), "yes, sir!");
 eval 'sub AUTOLOAD { "ok ", shift, "\n"; }';
 ok(1);
 
-# Bug ID 20010902.002
+# Bug ID 20010902.002 (#7609)
 is(
     eval q[
        my $x = 'x'; # Lexical or package variable, 5.6.1 panics.
@@ -336,7 +336,7 @@ is(
     is($w, '');
 }
 
-# [ID 20020305.025] PACKAGE::SUPER doesn't work anymore
+# [ID 20020305.025 (#8788)] PACKAGE::SUPER doesn't work anymore
 
 package main;
 our @X;
@@ -543,7 +543,7 @@ like $@,
      qr/^Can't call method "squeak" on unblessed reference/,
     'method call on \*typeglob';
 *stdout2 = *STDOUT;  # stdout2 now stringifies as *main::STDOUT
-sub IO::Handle::self { $_[0] }
+ sub IO::Handle::self { $_[0] }
 # This used to stringify the glob:
 is *stdout2->self, (\*stdout2)->self,
   '*glob->method is equiv to (\*glob)->method';
index d37acc62fab4184469583da354710565660932c4..ba2378aeb4f570ef3c91ca34c5a808d6a5ea2130 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 17;
index e76fc5e5af32ac0d7cac8340ffc0b9832ac5f01c..35211068d782d31e4442eb3b2604c1504e3f530c 100644 (file)
--- a/t/op/my.t
+++ b/t/op/my.t
@@ -1,8 +1,8 @@
 #!./perl
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 sub foo {
index 11b55dd69ec38074d6aadda6e2fb4ecc932e0050..42a81d9ab0fa4194b16eaea0b7d208267ae336f9 100644 (file)
@@ -2,13 +2,14 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
+plan tests => 1;
+
 use strict;
 
 eval 'my $_';
 like $@, qr/^Can't use global \$_ in "my" at /;
 
-done_testing();
index 8fa8c0a7fe788bc567973aa974baa24d7e2b8259..683804d21cb14c406281e0365a07b7479e0383b9 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 48;
index 17f7a36d6b4b1f23957ae454c90fb4671f65b9aa..48a016839248f150c70ca2e657383706ee28170d 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 24;
index e62cac312127a66b79811da841f825107ca90e8b..2fbffa0766021f66641f0665517871255f8f1aae 100644 (file)
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
     if (pack("d", 1) =~ /^[\x80\10]\x40/) {
         skip_all("VAX float cannot do infinity");
     }
+    set_up_inc('../lib');
 }
 
 use strict;
index 9e7de4c2bd155b887a7fceca8f4c1f46ffca93ec..503dd57e3220b8b1130aa333bfc979e8c6a5c74f 100644 (file)
--- a/t/op/or.t
+++ b/t/op/or.t
@@ -4,7 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    require './test.pl';
+    set_up_inc('../lib');
 }
 
 
@@ -23,7 +24,6 @@ sub FETCH {
 
 
 package main;
-require './test.pl';
 
 plan( tests => 14 );
 
index 51b2a4e38dd5c39a289a6c7023779b9801ed58b4..deb08802f5d2a4346dabed14f6c45aff58569614 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib); # ../lib needed for test.deparse
     require "./test.pl";
+    set_up_inc(qw(. ../lib)); # ../lib needed for test.deparse
 }
 
 plan tests => 35;
index d485f58e5b7ab3caf9dc7a8e5aabf93f090b60a0..8d00b39899c78a8ce7d21f87f3ac42ade3415237 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw '../lib ../cpan/version/lib';
     require './test.pl';
+    set_up_inc(qw '../lib ../cpan/version/lib');
 }
 
 # XXX remove this later -- dagolden, 2010-01-13
index 04b527246d8e478785d3fd33a51d7b9da08f7753..9d9c3d5058be8f40c868d3686bcc4cee70d0b055 100644 (file)
@@ -2,11 +2,11 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
-plan tests => 29;
+plan tests => 33;
 
 $x='banana';
 $x=~/.a/g;
@@ -20,7 +20,7 @@ sub f { my $p=$_[0]; return $p }
 $x=~/.a/g;
 is(f(pos($x)), 4, "matching again, pos() next leaves off at offset 4");
 
-# Is pos() set inside //g? (bug id 19990615.008)
+# Is pos() set inside //g? (bug id 19990615.008 (#874))
 $x = "test string?"; $x =~ s/\w/pos($x)/eg;
 is($x, "0123 5678910?", "pos() set inside //g");
 
@@ -131,3 +131,31 @@ for my $one(pos $x) {
            'no assertion failure when getting pos clobbers ref with undef';
     }
 }
+
+{
+    # RT # 127518
+    my $x = "\N{U+10000}abc";
+    my %expected = (
+        chars   => { length => 4, pos => 2 },
+        bytes   => { length => 7, pos => 5 },
+    );
+    my %observed;
+    $observed{chars}{length} = length($x);
+    $x =~ m/a/g;
+    $observed{chars}{pos}    = pos($x);
+
+    {
+        use bytes;
+        $observed{bytes}{length} = length($x);
+        $observed{bytes}{pos}    = pos($x);
+    }
+
+    is( $observed{chars}{length}, $expected{chars}{length},
+         "Got expected length in chars");
+    is( $observed{chars}{pos}, $expected{chars}{pos},
+         "Got expected pos in chars");
+    is( $observed{bytes}{length}, $expected{bytes}{length},
+         "Got expected length in bytes");
+    is( $observed{bytes}{pos}, $expected{bytes}{pos},
+         "Got expected pos in bytes");
+}
index c3fa968d4985882827e9751e9ae7b83721c159d9..ba69f0693a5183b0c9236297a147a525fdefdc54 100644 (file)
@@ -10,8 +10,8 @@ this file contains all dereferencing tests from ref.t but using postfix instead
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require './test.pl';
+    set_up_inc(qw(. ../lib));
 }
 
 use strict qw(refs subs);
index 4cfeed1e6319f1979e95421ddd07f62ff5ac4dbe..e9608ff2b84782b8b8e51e3a56143ad1a4bae789 100644 (file)
@@ -3,8 +3,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 # This calculation ought to be within 0.001 of the right answer.
index eb046e5bb6600cac5613d2467780929f00a8a177..cbec601c7cc31bdcb8dd827198b8a955cfa5c5c8 100644 (file)
@@ -2,16 +2,14 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
+    require './test.pl';
+    set_up_inc( qw(. ../lib) );
 }
 
 use strict;
 use warnings;
 
-BEGIN {
-    require './test.pl';
-    plan( tests => 12 );
-}
+plan( tests => 12 );
 
 use vars qw{ @warnings $sub $warn };
 
index f4cc8ecfe169edda148d225485123501355ed4e2..e1fc1e123590c8c6a32a82390cf44f6aa7ab2b61 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 35ed2c67e878496a42c95d80132ef29f4dfee3ef..20497bfe4b52d35f7f5f1e551e69e6ebbe027f76 100644 (file)
@@ -2,9 +2,9 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(../lib .);
-    require Config; import Config;
     require "./test.pl";
+    set_up_inc(  qw(../lib .) );
+    require Config; import Config;
     require "./loc_tools.pl";
 }
 
index b3df32ef8d167747e05979bf22e6c0d4c06b1f61..7a7f757b03125b505a35a32b6bc490cee99ca33b 100644 (file)
 
 BEGIN {
     chdir "t" if -d "t";
-    @INC = qw(. ../lib);
+    require "./test.pl";
+    set_up_inc( qw(. ../lib) );
 }
 
 use strict;
 use Config;
 
-require "./test.pl";
-
-
 my $reps = 100_000;    # How many times to try rand each time.
                        # May be changed, but should be over 500.
                        # The more the better! (But slower.)
index 7809882fb2fed535dbedf08790afee485a6f6dbc..f30fa8d7b7d6cfee667caaf22f25d1f340daeec1 100644 (file)
@@ -2,10 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('../lib', '.');
+    require './test.pl';
+    set_up_inc('../lib', '.');
 }   
 # Avoid using eq_array below as it uses .. internally.
-require './test.pl';
 
 use Config;
 
index 11cb454ee80f5f53706ba7848cf8914f10e764fa..c5b616a0f39877ef8cfd6a1750fcddf65034e491 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 use strict;
 
index 8515d1d9d0ef06eff597a4cc7eb45ccaed306556..84648f28554aede95c7f71f833f53221acaa3819 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
@@ -71,6 +71,7 @@ SKIP:
 { # [perl #118651]
   # test that readdir doesn't modify errno on successfully reaching the end of the list
   # in scalar context, POSIX requires that readdir() not modify errno on end-of-directory
+
   my @s;
   ok(opendir(OP, "op"), "opendir op");
   $! = 0;
index c64dda151e68345f462ae3fa0047741d93806bcb..7626af9a8d1dcbdf8198d653ff8532e26acfadd8 100644 (file)
@@ -6,11 +6,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require "./test.pl";
-    plan(tests => 28);
+    set_up_inc(qw(. ../lib));
 }
 
+plan(tests => 28);
+
 use strict;
 
 sub gcd {
index 84d921764e9ff53422561403ebb3f1f594e6301f..65d50b67a245138c2999239a2671dc979322ac7f 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     require './test.pl';
+    set_up_inc( qw(. ../lib) );
 }
 
 use strict qw(refs subs);
index bee7dac2931f811f01ddaa0c6c117faf380bd707..d21bdb3e484a44d25806fe0c1f819002b6623490 100644 (file)
@@ -2,10 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    require './test.pl';
+    set_up_inc( '../lib' );
 }
 
-require './test.pl';
 plan(tests => 48);
 
 # compile time
@@ -152,10 +152,10 @@ is($Tiecount::Tiecount, 1,
    '(...)x... in void context in list (via scalar comma)');
 
 
-# perlbug 20011113.110 works in 5.6.1, broken in 5.7.2
+# perlbug 20011113.110 (#7902) works in 5.6.1, broken in 5.7.2
 {
     my $x= [("foo") x 2];
-    is( join('', @$x), 'foofoo', 'list repeat in anon array ref broken [ID 20011113.110]' );
+    is( join('', @$x), 'foofoo', 'list repeat in anon array ref broken [ID 20011113.110 (#7902)]' );
 }
 
 # [perl #35885]
index b107636c99811f8d4e9ffacc65de0f948c0fc14e..f06b49e18869a6faae0fdadfa7a08d5a0a507691 100644 (file)
@@ -5,7 +5,7 @@
 
 chdir 't' if -d 't';
 require './test.pl';
-@INC = 'lib';
+set_up_inc( 'lib' );
 
 use strict;
 
index f2f98b0c43bd41d3dab1d937df2ef5280af54c23..d2c2bb5cf74c5160754ce17798c3088f3d594833 100644 (file)
@@ -3,7 +3,7 @@
 BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
-    @INC="../lib";
+    set_up_inc( qw(../lib) );
 }
 
 use strict;
@@ -13,8 +13,6 @@ plan(tests => 20);
 
 my $nonfile = tempfile();
 
-@INC = qw(Perl Rules);
-
 # The tests for ' ' and '.h' never did fail, but previously the error reporting
 # code would read memory before the start of the SV's buffer
 
@@ -133,7 +131,7 @@ like $@, qr/^Can't locate strict\.pm\\0invalid: /, 'do nul check';
 
   $WARN = '';
   local @INC = @INC;
-  unshift @INC, "lib\0invalid";
+  set_up_inc( "lib\0invalid" );
   eval { require "unknown.pm" };
   like $WARN, qr{^Invalid \\0 character in \@INC entry for require: lib\\0invalid at }, 'nul warning';
 }
index 227c84a3d9a68887b8df6a3bf7bc31ba24cfbc6e..bb5fbfce5ee572ee0a92c8e74ba31f30e81669de 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 use strict;
 
@@ -184,7 +184,7 @@ SKIP:
            my $copy = $prog;
            $copy =~ s/8/$eight/gm;
            $copy =~ s/9/$nine/gm;
-           fresh_perl_is($copy, "pass", "",
+           fresh_perl_is($copy, "pass", {},
                          "first pattern $eight$eight, second $nine$nine");
        }
     }
index 5b6b39fa3742b66bbcc8dc7e1c5df7b2ecb8640f..c42ce2d62b59e61a6a0b1d9b72fe219860d26d6f 100644 (file)
@@ -7,8 +7,8 @@
 ##
 
 chdir 't' if -d 't';
-@INC = '../lib';
 require './test.pl';
+set_up_inc('../lib');
 
 $|=1;
 
index b384138dacc1ee04d185934082b1051eccb2fe59..588c8b9d4dd82805f4f8d214f83677c68b9da6e8 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all_without_config('d_setpgrp');
 }
 
index 217efa3add931b7cdde995d38492302f9051738e..0e53bf05d240c7d68c31be08724d515b84d6a85b 100644 (file)
@@ -6,15 +6,19 @@ BEGIN {
     set_up_inc('../lib');
 }
 
-no warnings "illegalproto";
+use warnings;
+use strict;
 
 our $a = 123;
 our $z;
 
-sub t000 ($a) { $a || "z" }
-is prototype(\&t000), "\$a", "(\$a) interpreted as protoype when not enabled";
-is &t000(456), 123, "(\$a) not signature when not enabled";
-is $a, 123;
+{
+    no warnings "illegalproto";
+    sub t000 ($a) { $a || "z" }
+    is prototype(\&t000), "\$a", "(\$a) interpreted as protoype when not enabled";
+    is &t000(456), 123, "(\$a) not signature when not enabled";
+    is $a, 123;
+}
 
 no warnings "experimental::signatures";
 use feature "signatures";
@@ -415,7 +419,8 @@ like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/;
 is $a, 123;
 
 eval "#line 8 foo\nsub t024 (\$a =) { }";
-is $@, "Optional parameter lacks default expression at foo line 8\.\n";
+is $@,
+    qq{Optional parameter lacks default expression at foo line 8, near "=) "\n};
 
 sub t025 ($ = undef) { $a // "z" }
 is prototype(\&t025), undef;
@@ -557,10 +562,13 @@ like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/;
 is $a, 123;
 
 eval "#line 8 foo\nsub t030 (\$a = 222, \$b) { }";
-is $@, "Mandatory parameter follows optional parameter at foo line 8\.\n";
+is $@, qq{Mandatory parameter follows optional parameter at foo line 8, near "\$b) "\n};
 
 eval "#line 8 foo\nsub t031 (\$a = 222, \$b = 333, \$c, \$d) { }";
-is $@, "Mandatory parameter follows optional parameter at foo line 8\.\n";
+is $@, <<EOF;
+Mandatory parameter follows optional parameter at foo line 8, near "\$c,"
+Mandatory parameter follows optional parameter at foo line 8, near "\$d) "
+EOF
 
 sub t034 (@abc) { join("/", @abc).";".scalar(@abc) }
 is prototype(\&t034), undef;
@@ -575,10 +583,10 @@ is eval("t034(456, 789, 987, 654, 321, 111)"), "456/789/987/654/321/111;6";
 is $a, 123;
 
 eval "#line 8 foo\nsub t136 (\@abc = 222) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n};
 
 eval "#line 8 foo\nsub t137 (\@abc =) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n};
 
 sub t035 (@) { $a }
 is prototype(\&t035), undef;
@@ -593,10 +601,10 @@ is eval("t035(456, 789, 987, 654, 321, 111)"), 123;
 is $a, 123;
 
 eval "#line 8 foo\nsub t138 (\@ = 222) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n};
 
 eval "#line 8 foo\nsub t139 (\@ =) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n};
 
 sub t039 (%abc) { join("/", map { $_."=".$abc{$_} } sort keys %abc) }
 is prototype(\&t039), undef;
@@ -615,10 +623,10 @@ is eval("t039(456, 789, 987, 654, 321, 111)"), "321=111/456=789/987=654";
 is $a, 123;
 
 eval "#line 8 foo\nsub t140 (\%abc = 222) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n};
 
 eval "#line 8 foo\nsub t141 (\%abc =) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n};
 
 sub t040 (%) { $a }
 is prototype(\&t040), undef;
@@ -637,10 +645,10 @@ is eval("t040(456, 789, 987, 654, 321, 111)"), 123;
 is $a, 123;
 
 eval "#line 8 foo\nsub t142 (\% = 222) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "222) "\n};
 
 eval "#line 8 foo\nsub t143 (\% =) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "=) "\n};
 
 sub t041 ($a, @b) { $a.";".join("/", @b) }
 is prototype(\&t041), undef;
@@ -873,67 +881,70 @@ is eval("t058(456, 789, 987, 654, 321, 111)"), "456;789;987/654/321/111;4";
 is $a, 123;
 
 eval "#line 8 foo\nsub t059 (\@a, \$b) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Slurpy parameter not last at foo line 8, near "\$b) "\n};
 
 eval "#line 8 foo\nsub t060 (\@a, \$b = 222) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Slurpy parameter not last at foo line 8, near "222) "\n};
 
 eval "#line 8 foo\nsub t061 (\@a, \@b) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\@b) "\n};
 
 eval "#line 8 foo\nsub t062 (\@a, \%b) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "%b) "\n};
 
 eval "#line 8 foo\nsub t063 (\@, \$b) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Slurpy parameter not last at foo line 8, near "\$b) "\n};
 
 eval "#line 8 foo\nsub t064 (\@, \$b = 222) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Slurpy parameter not last at foo line 8, near "222) "\n};
 
 eval "#line 8 foo\nsub t065 (\@, \@b) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\@b) "\n};
 
 eval "#line 8 foo\nsub t066 (\@, \%b) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "%b) "\n};
 
 eval "#line 8 foo\nsub t067 (\@a, \$) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Slurpy parameter not last at foo line 8, near "\$) "\n};
 
 eval "#line 8 foo\nsub t068 (\@a, \$ = 222) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Slurpy parameter not last at foo line 8, near "222) "\n};
 
 eval "#line 8 foo\nsub t069 (\@a, \@) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\@) "\n};
 
 eval "#line 8 foo\nsub t070 (\@a, \%) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\%) "\n};
 
 eval "#line 8 foo\nsub t071 (\@, \$) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Slurpy parameter not last at foo line 8, near "\$) "\n};
 
 eval "#line 8 foo\nsub t072 (\@, \$ = 222) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Slurpy parameter not last at foo line 8, near "222) "\n};
 
 eval "#line 8 foo\nsub t073 (\@, \@) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\@) "\n};
 
 eval "#line 8 foo\nsub t074 (\@, \%) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Multiple slurpy parameters not allowed at foo line 8, near "\%) "\n};
 
 eval "#line 8 foo\nsub t075 (\%a, \$b) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Slurpy parameter not last at foo line 8, near "\$b) "\n};
 
 eval "#line 8 foo\nsub t076 (\%, \$b) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Slurpy parameter not last at foo line 8, near "\$b) "\n};
 
 eval "#line 8 foo\nsub t077 (\$a, \@b, \$c) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Slurpy parameter not last at foo line 8, near "\$c) "\n};
 
 eval "#line 8 foo\nsub t078 (\$a, \%b, \$c) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, qq{Slurpy parameter not last at foo line 8, near "\$c) "\n};
 
 eval "#line 8 foo\nsub t079 (\$a, \@b, \$c, \$d) { }";
-is $@, "Slurpy parameter not last at foo line 8\.\n";
+is $@, <<EOF;
+Slurpy parameter not last at foo line 8, near "\$c,"
+Slurpy parameter not last at foo line 8, near "\$d) "
+EOF
 
 sub t080 ($a,,, $b) { $a.$b }
 is prototype(\&t080), undef;
@@ -962,10 +973,10 @@ like $@, qr/\AToo many arguments for subroutine at \(eval \d+\) line 1\.\n\z/;
 is $a, 123;
 
 eval "#line 8 foo\nsub t082 (, \$a) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, qq{syntax error at foo line 8, near "(,"\n};
 
 eval "#line 8 foo\nsub t083 (,) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, qq{syntax error at foo line 8, near "(,"\n};
 
 sub t084($a,$b){ $a.$b }
 is prototype(\&t084), undef;
@@ -1058,38 +1069,50 @@ is $a, 123;
 eval "#line 8 foo\nsub t088 (\$ #foo\na) { }";
 is $@, "";
 
+
 eval "#line 8 foo\nsub t089 (\$#foo\na) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+like $@, qr{\A'#' not allowed immediately following a sigil in a subroutine signature at foo line 8, near "\(\$"\n};
 
 eval "#line 8 foo\nsub t090 (\@ #foo\na) { }";
 is $@, "";
 
 eval "#line 8 foo\nsub t091 (\@#foo\na) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+like $@, qr{\A'#' not allowed immediately following a sigil in a subroutine signature at foo line 8, near "\(\@"\n};
 
 eval "#line 8 foo\nsub t092 (\% #foo\na) { }";
 is $@, "";
 
 eval "#line 8 foo\nsub t093 (\%#foo\na) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+like $@, qr{\A'#' not allowed immediately following a sigil in a subroutine signature at foo line 8, near "\(%"\n};
 
 eval "#line 8 foo\nsub t094 (123) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+like $@, qr{\AA signature parameter must start with '\$', '\@' or '%' at foo line 8, near "\(1"\n};
 
 eval "#line 8 foo\nsub t095 (\$a, 123) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, <<EOF;
+A signature parameter must start with '\$', '\@' or '%' at foo line 8, near ", 1"
+syntax error at foo line 8, near ", 123"
+EOF
 
-eval "#line 8 foo\nsub t096 (\$a 123) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+eval "#line 8 foo\nno warnings; sub t096 (\$a 123) { }";
+is $@, qq{syntax error at foo line 8, near "\$a 123"\n};
 
 eval "#line 8 foo\nsub t097 (\$a { }) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, <<EOF;
+syntax error at foo line 8, near "\$a { "
+EOF
 
 eval "#line 8 foo\nsub t098 (\$a; \$b) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, <<EOF;
+syntax error at foo line 8, at EOF
+syntax error at foo line 8, near "\$b) "
+EOF
 
 eval "#line 8 foo\nsub t099 (\$\$) { }";
-like $@, qr/\AParse error at foo line 8\.\n/;
+is $@, <<EOF;
+Illegal character following sigil in a subroutine signature at foo line 8, near "(\$"
+syntax error at foo line 8, near "\$\$) "
+EOF
 
 eval "#line 8 foo\nsub t101 (\@_) { }";
 like $@, qr/\ACan't use global \@_ in "my" at foo line 8/;
@@ -1276,6 +1299,172 @@ is scalar(t117()), undef;
 is scalar(@{[ t117(333, 444) ]}), 0;
 is scalar(t117(333, 444)), undef;
 
+sub t145 ($=3) { }
+is scalar(t145()), undef;
+
+{
+    my $want;
+    sub want { $want = wantarray ? "list"
+                        : defined(wantarray) ? "scalar" : "void"; 1 }
+
+    sub t144 ($a = want()) { $a }
+    t144();
+    is ($want, "scalar", "default expression is scalar in void context");
+    my $x = t144();
+    is ($want, "scalar", "default expression is scalar in scalar context");
+    () = t144();
+    is ($want, "scalar", "default expression is scalar in list context");
+}
+
+
+# check for default arg code doing nasty things (closures, gotos,
+# modifying @_ etc).
+
+{
+    no warnings qw(closure);
+    use Tie::Array;
+    use Tie::Hash;
+
+    sub t146 ($a = t146x()) {
+        sub t146x { $a = "abc"; 1 }
+        $a;
+    }
+    is t146(), 1, "t146: closure can make new lexical not undef";
+
+    sub t147 ($a = t147x()) {
+        sub t147x { $a = "abc"; pos($a)=1; 1 }
+        is pos($a), undef, "t147: pos magic cleared";
+        $a;
+    }
+    is t147(), 1, "t147: closure can make new lexical not undef and magical";
+
+    sub t148 ($a = t148x()) {
+        sub t148x { $a = [];  1 }
+        $a;
+    }
+    is t148(), 1, "t148: closure can make new lexical a ref";
+
+    sub t149 ($a = t149x()) {
+        sub t149x { $a = 1;  [] }
+        $a;
+    }
+    is ref(t149()), "ARRAY", "t149: closure can make new lexical a ref";
+
+    sub t150 ($a = do {@_ = qw(a b c); 1}, $b = 2) {
+        is $a, 1,   "t150: a: growing \@_";
+        is $b, "b", "t150: b: growing \@_";
+    }
+    t150();
+
+
+    sub t151 ($a = do {tie @_, 'Tie::StdArray'; @_ = qw(a b c); 1}, $b = 2) {
+        is $a, 1,   "t151: a: tied \@_";
+        is $b, "b", "t151: b: tied \@_";
+    }
+    t151();
+
+    sub t152 ($a = t152x(), @b) {
+        sub t152x { @b = qw(a b c); 1 }
+        $a . '-' . join(':', @b);
+    }
+    is t152(), "1-", "t152: closure can make new lexical array non-empty";
+
+    sub t153 ($a = t153x(), %b) {
+        sub t153x { %b = qw(a 10 b 20); 1 }
+        $a . '-' . join(':', sort %b);
+    }
+    is t153(), "1-", "t153: closure can make new lexical hash non-empty";
+
+    sub t154 ($a = t154x(), @b) {
+        sub t154x { tie @b, 'Tie::StdArray'; @b = qw(a b c); 1 }
+        $a . '-' . join(':', @b);
+    }
+    is t154(), "1-", "t154: closure can make new lexical array tied";
+
+    sub t155 ($a = t155x(), %b) {
+        sub t155x { tie %b, 'Tie::StdHash'; %b = qw(a 10 b 20); 1 }
+        $a . '-' . join(':', sort %b);
+    }
+    is t155(), "1-", "t155: closure can make new lexical hash tied";
+
+    sub t156 ($a = do {@_ = qw(a b c); 1}, @b) {
+        is $a, 1,       "t156: a: growing \@_";
+        is "@b", "b c", "t156: b: growing \@_";
+    }
+    t156();
+
+    sub t157 ($a = do {@_ = qw(a b c); 1}, %b) {
+        is $a, 1,                     "t157: a: growing \@_";
+        is join(':', sort %b), "b:c", "t157: b: growing \@_";
+    }
+    t157();
+
+    sub t158 ($a = do {tie @_, 'Tie::StdArray'; @_ = qw(a b c); 1}, @b) {
+        is $a, 1,          "t158: a: tied \@_";
+        is "@b", "b c",    "t158: b: tied \@_";
+    }
+    t158();
+
+    sub t159 ($a = do {tie @_, 'Tie::StdArray'; @_ = qw(a b c); 1}, %b) {
+        is  $a, 1,                     "t159: a: tied \@_";
+        is  join(':', sort %b), "b:c", "t159: b: tied \@_";
+    }
+    t159();
+
+    # see if we can handle the equivalent of @a = ($a[1], $a[0])
+
+    sub t160 ($s, @a) {
+        sub t160x {
+            @a = qw(x y);
+            t160(1, $a[1], $a[0]);
+        }
+        # encourage recently-freed SVPVs to be realloced with new values
+        my @pad = qw(a b);
+        join ':', $s, @a;
+    }
+    is t160x(), "1:y:x", 'handle commonality in slurpy array';
+
+    # see if we can handle the equivalent of %h = ('foo', $h{foo})
+
+    sub t161 ($s, %h) {
+        sub t161x {
+            %h = qw(k1 v1 k2 v2);
+            t161(1, k1 => $h{k2}, k2 => $h{k1});
+        }
+        # encourage recently-freed SVPVs to be realloced with new values
+        my @pad = qw(a b);
+        join ' ', $s, map "($_,$h{$_})", sort keys %h;
+    }
+    is t161x(), "1 (k1,v2) (k2,v1)", 'handle commonality in slurpy hash';
+
+    # see if we can handle the equivalent of ($a,$b) = ($b,$a)
+    # Note that for non-signatured subs, my ($a,$b) = @_ already fails the
+    # equivalent of this test too, since I skipped pessimising it
+    # (90ce4d057857) as commonality in this case is rare and contrived,
+    # as the example below shows. DAPM.
+    sub t162 ($a, $b) {
+        sub t162x {
+            ($a, $b) = qw(x y);
+            t162($b, $a);
+        }
+        "$a:$b";
+    }
+    {
+        local $::TODO = q{can't handle commonaility};
+        is t162x(), "y:x", 'handle commonality in scalar parms';
+    }
+}
+
+{
+    my $w;
+    local $SIG{__WARN__} = sub { $w .= "@_" };
+    is eval q{sub ($x,$x) { $x}->(1,2)}, 2, "duplicate sig var names";
+    like $w, qr/^"my" variable \$x masks earlier declaration in same scope/,
+            "masking warning";
+}
+
+
+
 use File::Spec::Functions;
 my $keywords_file = catfile(updir,'regen','keywords.pl');
 open my $kh, $keywords_file
@@ -1285,11 +1474,7 @@ while(<$kh>) {
         chomp(my $word = $');
         # $y should be an error after $x=foo.  The exact error we get may
         # differ if this is __END__ or s or some other special keyword.
-        eval 'sub ($x = ' . $word . ', $y) {}';
-        local $::TODO = 'does not work yet'
-          if $word =~ /^(?:chmod|chown|die|exec|glob|kill|mkdir|print
-                          |printf|return|reverse|select|setpgrp|sort|split
-                          |system|unlink|utime|warn)\z/x;
+        eval 'no warnings; sub ($x = ' . $word . ', $y) {}';
         isnt $@, "", "$word does not swallow trailing comma";
     }
 }
index 441f76a6aa02da1e88927a7e9bd334254f881b2b..d0ed9177695f758fd1f9c84f366d7ede2c0ac3b2 100644 (file)
@@ -2,10 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
+    require "./test.pl";
+    set_up_inc( qw(. ../lib) );
 }
 
-require "./test.pl";
 plan( tests => 4 );
 
 use strict;
index 22d83a9ea11f2be07ec191a952f5edfae92b4f32..cd1c6eb55f6d78d7264a31eb629adcf2ed5925b7 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 use warnings;
-plan(tests => 195);
+plan(tests => 196);
 
 # these shouldn't hang
 {
@@ -408,7 +408,7 @@ cmp_ok($x,'eq','123',q(optimized-away comparison block doesn't take any other ar
 {
     sub routine { "one", "two" };
     @a = sort(routine(1));
-    cmp_ok("@a",'eq',"one two",'bug id 19991001.003');
+    cmp_ok("@a",'eq',"one two",'bug id 19991001.003 (#1549)');
 }
 
 
@@ -417,21 +417,21 @@ cmp_ok($x,'eq','123',q(optimized-away comparison block doesn't take any other ar
     my ($r1,$r2,@a);
     our @g;
     @g = (3,2,1); $r1 = \$g[2]; @g = sort @g; $r2 = \$g[0];
-    is "$r1-@g", "$r2-1 2 3", "inplace sort of global";
+    is "$$r1-$$r2-@g", "1-1-1 2 3", "inplace sort of global";
 
     @a = qw(b a c); $r1 = \$a[1]; @a = sort @a; $r2 = \$a[0];
-    is "$r1-@a", "$r2-a b c", "inplace sort of lexical";
+    is "$$r1-$$r2-@a", "a-a-a b c", "inplace sort of lexical";
 
     @g = (2,3,1); $r1 = \$g[1]; @g = sort { $b <=> $a } @g; $r2 = \$g[0];
-    is "$r1-@g", "$r2-3 2 1", "inplace reversed sort of global";
+    is "$$r1-$$r2-@g", "3-3-3 2 1", "inplace reversed sort of global";
 
     @g = (2,3,1);
     $r1 = \$g[1]; @g = sort { $a<$b?1:$a>$b?-1:0 } @g; $r2 = \$g[0];
-    is "$r1-@g", "$r2-3 2 1", "inplace custom sort of global";
+    is "$$r1-$$r2-@g", "3-3-3 2 1", "inplace custom sort of global";
 
     sub mysort { $b cmp $a };
     @a = qw(b c a); $r1 = \$a[1]; @a = sort mysort @a; $r2 = \$a[0];
-    is "$r1-@a", "$r2-c b a", "inplace sort with function of lexical";
+    is "$$r1-$$r2-@a", "c-c-c b a", "inplace sort with function of lexical";
 
     use Tie::Array;
     my @t;
@@ -474,6 +474,25 @@ cmp_ok($x,'eq','123',q(optimized-away comparison block doesn't take any other ar
     no warnings 'void';
     my @m; push @m, 0 for 1 .. 1024; $#m; @m = sort @m;
     ::pass("in-place sorting segfault");
+
+    # RT #39358 - array should be preserved during sort
+
+    {
+        my @aa = qw(b c a);
+        my @copy;
+        @aa = sort { @copy = @aa; $a cmp $b } @aa;
+        is "@aa",   "a b c", "RT 39358 - aa";
+        is "@copy", "b c a", "RT 39358 - copy";
+    }
+
+    # RT #128340: in-place sort incorrectly preserves element lvalue identity
+
+    @a = (5, 4, 3);
+    my $r = \$a[2];
+    @a = sort { $a <=> $b } @a;
+    $$r = "z";
+    is ("@a", "3 4 5", "RT #128340");
+
 }
 
 # Test optimisations of reversed sorts. As we now guarantee stability by
@@ -846,16 +865,6 @@ cmp_ok($answer,'eq','good','sort subr called from other package');
 }
 
 
-# Bug 7567 - an array shouldn't be modifiable while it's being
-# sorted in-place.
-{
-    eval { @a=(1..8); @a = sort { @a = (0) } @a; };
-
-    $fail_msg = q(Modification of a read-only value attempted);
-    cmp_ok(substr($@,0,length($fail_msg)),'eq',$fail_msg,'bug 7567');
-    eval { @a=1..3 };
-    is $@, "", 'abrupt scope exit turns off readonliness';
-}
 
 # I commented out this TODO test because messing with FREEd scalars on the
 # stack can have all sorts of strange side-effects, not made safe by eval
index c0af5d397beb043a43dfd67550ab455614639421..7ad49db2ba55a825bf53be79635bf492562da7b3 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 $|  = 1;
@@ -39,12 +39,12 @@ is( j(@a), j(1,7,7,3), '... array 1,7,7,3');
 is( j(splice(@a,-3,-2,2)), j(7), 'replace first 7 with a 2, negative offset, negative length, return value is 7');
 is( j(@a), j(1,2,7,3), '... array has 1,2,7,3');
 
-# Bug 20000223.001 - no test for splice(@array).  Destructive test!
+# Bug 20000223.001 (#2196) - no test for splice(@array).  Destructive test!
 is( j(splice(@a)), j(1,2,7,3), 'bare splice empties the array, return value is the array');
 is( j(@a),  '', 'array is empty');
 
 # Tests 11 and 12:
-# [ID 20010711.005] in Tie::Array, SPLICE ignores context, breaking SHIFT
+# [ID 20010711.005 (#7265)] in Tie::Array, SPLICE ignores context, breaking SHIFT
 
 my $foo;
 
index fb73271db2686396ecd50463275b9cd4f9b05100..9c19365cc8cb983e3023e179cd42601758b2992e 100644 (file)
@@ -207,8 +207,8 @@ $cnt =           split //, v1.20.300.4000.50000.4000.300.20.1;
 is("@ary", "1 20 300 4000 50000 4000 300 20 1");
 is($cnt, scalar(@ary));
 
-@ary = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016
-$cnt = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016
+@ary = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016 (#5088)
+$cnt = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016 (#5088)
 ok(@ary == 2 &&
    $ary[0] eq "\xFF"   && $ary[1] eq "\xFD" &&
    $ary[0] eq "\x{FF}" && $ary[1] eq "\x{FD}");
@@ -244,7 +244,7 @@ is($cnt, scalar(@ary));
 }
 
 {
-    # bug id 20000427.003 
+    # bug id 20000427.003 (#3173) 
 
     use warnings;
     use strict;
@@ -266,7 +266,7 @@ is($cnt, scalar(@ary));
     my $s = "\x20\x40\x{80}\x{100}\x{80}\x40\x20";
 
   {
-       # bug id 20000426.003
+       # bug id 20000426.003 (#3166)
 
        my ($a, $b, $c) = split(/\x40/, $s);
        ok($a eq "\x20" && $b eq "\x{80}\x{100}\x{80}" && $c eq $a);
@@ -288,7 +288,7 @@ is($cnt, scalar(@ary));
 }
 
 {
-    # 20001205.014
+    # 20001205.014 (#4844)
 
     my $a = "ABC\x{263A}";
 
index 8bfa9356570879e12ce38c4f2e02b15cdaeccddf..1d02cb2c24d28d70ea80be9b9403c5e371cc09ca 100644 (file)
@@ -3,10 +3,11 @@
 BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
-    skip_all_if_miniperl("no dynamic loading on miniperl, no File::Spec (used by charnames)");
-    plan(tests => 145);
 }
 
+skip_all_if_miniperl("no dynamic loading on miniperl, no File::Spec (used by charnames)");
+plan(tests => 145);
+
 {
     # check the special casing of split /\s/ and unicode
     use charnames qw(:full);
index 04fc4ce6b704936f3774f34589d6ead0f7c2ca59..18bee69017b58c49aa173e9df58e216eb20d9806 100644 (file)
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw '../lib ../cpan/version/lib';
+    require './test.pl';
+    set_up_inc(qw '../lib ../cpan/version/lib');
 }
 use warnings;
 use version;
 use Config;
 use strict;
-require './test.pl';
+
 
 my @tests = ();
 my ($template, $data, $result, $comment, $w, $x, $evalData, $n, $p);
@@ -32,6 +33,9 @@ if ($^O eq 'VMS') {
 # No %Config.
 my $Is_Ultrix_VAX = $^O eq 'ultrix' && `uname -m` =~ /^VAX$/;
 
+# The most generic VAX catcher.
+my $Is_VAX_Float = (pack("d", 1) =~ /^[\x80\x10]\x40/);
+
 our $IS_EBCDIC = $::IS_EBCDIC;  # Solely to avoid the 'used once' warning
 our $IS_ASCII = $::IS_ASCII;   # Solely to avoid the 'used once' warning
 
@@ -51,7 +55,7 @@ while (<DATA>) {
         $data   =~ s/([eE])\-101$/${1}-56/;  # larger exponents
         $result =~ s/([eE])\-102$/${1}-57/;  #  "       "
     }
-    if ($Is_VMS_VAX || $Is_Ultrix_VAX) {
+    if ($Is_VMS_VAX || $Is_Ultrix_VAX || $Is_VAX_Float) {
        # VAX DEC C 5.3 at least since there is no
        # ccflags =~ /float=ieee/ on VAX.
        # AXP is unaffected whether or not it is using ieee.
@@ -113,23 +117,20 @@ for (@tests) {
        my $osv = exists $Config{osvers} ? $Config{osvers} : "0";
        my $archname = $Config{archname};
        # >comment skip: all<
-       if ($os =~ /\ball\b/i) {
-           $skip = 1;
-       } elsif ($os =~ /\b$^O(?::(\S+))?\b/i) {
+       # >comment skip: solaris<
+        # >comment skip: x86_64-linux-ld<
+       if ($os =~ /\b(?:all|\Q$^O\E|\Q$archname\E)\b/i) {
+            $skip = 1;
+       } elsif ($os =~ /\b\Q$^O\E(?::(\S+))\b/i) {
             # We can have the $^O followed by an optional condition.
             # The condition, if present, can be one of:
-            # (1) a regex between slashes...
-            #     tested as a regex against $Config{archname}
-            # (2) starts with a digit...
+            # (1) starts with a digit...
             #     the first pair of dot-separated digits is
-            #     tested against $Config{osvers}
-            # (3) tested as literal string against $Config{archname}
+            #     tested numerically against $Config{osvers}
+            # (2) otherwise...
+            #     tested as a \b/i regex against $Config{archname}
             my $cond = $1;
-            if ($cond =~ m{^/(.+)/$}) {
-                # >comment skip: solaris:/86/<
-                my $vsr = $1;
-                $skip = $archname =~ /$vsr/;
-            } elsif ($cond =~ /^\d/) {
+            if ($cond =~ /^\d/) {
                 # >comment skip: hpux:10.20<
                 my $vsn = $cond;
                 # Only compare on the the first pair of digits, as numeric
@@ -138,7 +139,7 @@ for (@tests) {
                 $skip = $vsn ? ($osv <= $vsn ? 1 : 0) : 1;
             } else {
                 # >comment skip: netbsd:vax-netbsd<
-                $skip = $cond eq $archname;
+                $skip = $archname =~ /\b\Q$cond\E\b/i;
             }
        }
        $skip and $comment =~ s/$/, failure expected on $^O $osv $archname/;
@@ -148,7 +149,7 @@ for (@tests) {
         ok(1, join ' ', grep length, ">$result<", $comment);
     }
     elsif ($skip) {
-        ok(1, "skip $comment");
+      SKIP: { skip($comment, 1) }
     }
     elsif ($y eq ">$result<")  # Some C libraries always give
     {                          # three-digit exponent
index d975630ad323e60ea043395364358fcf75a19f4d..8b9931fae38c9b1c33ef11a93ec63324409de0f9 100644 (file)
@@ -4,8 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }   
 
 # We'll run 12 extra tests (see below) if $Q is false.
@@ -21,6 +21,7 @@ print "# uvsize = $Config{uvsize}\n";
 print "# nvsize = $Config{nvsize}\n";
 print "# nv_preserves_uv_bits = $Config{nv_preserves_uv_bits}\n";
 print "# d_quad = $Config{d_quad}\n";
+print "# uselongdouble = " . ($Config{uselongdouble} // 'undef') . "\n";
 if ($Config{nvsize} == 8 &&
     (
      # IEEE-754 64-bit ("double precision"), the most common out there
@@ -219,7 +220,7 @@ if ($Config{nvsize} == 8 &&
        [ '%a', '0.25',    '0x1p-2' ],
        [ '%a', '0.75',    '0x1.8p-1' ],
        [ '%a', '3.14',    '0x1.91eb851eb851eb851eb851eb85p+1' ],
-       [ '%a', '-1',      '-0x0p+0' ],
+       [ '%a', '-1',      '-0x1p+0' ],
        [ '%a', '-3.14',   '-0x1.91eb851eb851eb851eb851eb85p+1' ],
        [ '%a', '0.1',     '0x1.999999999999999999999999998p-4' ],
        [ '%a', '1/7',     '0x1.249249249249249249249249248p-3' ],
@@ -262,8 +263,6 @@ if ($Config{nvsize} == 8 &&
     print "# no hexfloat tests\n";
 }
 
-plan tests => 1408 + ($Q ? 0 : 12) + @hexfloat + 12;
-
 use strict;
 use Config;
 
@@ -299,7 +298,7 @@ for my $i (1, 3, 5, 10) {
 # Used to mangle PL_sv_undef
 fresh_perl_like(
     'print sprintf "xxx%n\n"; print undef',
-    qr/Modification of a read-only value attempted at - line 1\./,
+    qr/Modification of a read-only value attempted at\b/,
     { switches => [ '-w' ] },
     q(%n should not be able to modify read-only constants),
 );
@@ -630,7 +629,7 @@ for my $t (@hexfloat) {
         ok($ok, "'$format' '$arg' -> '$result' cf '$expected'");
         next;
     }
-    unless ($ok) {
+    if (!$ok && $result =~ /\./ && $expected =~ /\./) {
         # It seems that there can be difference in the last bits:
         # [perl #122578]
         #      got "0x1.5bf0a8b14576ap+1"
@@ -731,6 +730,7 @@ SKIP: {
 SKIP: {
     # [perl #127183] Non-canonical hexadecimal floats are parsed prematurely
 
+    # IEEE 754 64-bit
     skip("nv_preserves_uv_bits is $Config{nv_preserves_uv_bits}, not 53", 3)
         unless $Config{nv_preserves_uv_bits} == 53;
 
@@ -759,3 +759,159 @@ SKIP: {
            "non-canonical form");
     }
 }
+
+# These are IEEE 754 64-bit subnormals (formerly known as denormals).
+# Keep these as strings so that non-IEEE-754 don't trip over them.
+my @subnormals = (
+    [ '1e-320', '%a', '0x1.fap-1064' ],
+    [ '1e-321', '%a', '0x1.94p-1067' ],
+    [ '1e-322', '%a', '0x1.4p-1070' ],
+    [ '1e-323', '%a', '0x1p-1073' ],
+    [ '1e-324', '%a', '0x0p+0' ],  # underflow
+    [ '3e-320', '%a', '0x1.7b8p-1062' ],
+    [ '3e-321', '%a', '0x1.2f8p-1065' ],
+    [ '3e-322', '%a', '0x1.e8p-1069' ],
+    [ '3e-323', '%a', '0x1.8p-1072' ],
+    [ '3e-324', '%a', '0x1p-1074' ], # the smallest possible value
+    [ '7e-320', '%a', '0x1.bacp-1061' ],
+    [ '7e-321', '%a', '0x1.624p-1064' ],
+    [ '7e-322', '%a', '0x1.1cp-1067' ],
+    [ '7e-323', '%a', '0x1.cp-1071' ],
+    [ '7e-324', '%a', '0x1p-1074' ], # the smallest possible value, again
+    [ '3e-320', '%.4a', '0x1.7b80p-1062' ],
+    [ '3e-321', '%.4a', '0x1.2f80p-1065' ],
+    [ '3e-322', '%.4a', '0x1.e800p-1069' ],
+    [ '3e-323', '%.4a', '0x1.8000p-1072' ],
+    [ '3e-324', '%.4a', '0x1.0000p-1074' ],
+    [ '3e-320', '%.1a', '0x1.8p-1062' ],
+    [ '3e-321', '%.1a', '0x1.3p-1065' ],
+    [ '3e-322', '%.1a', '0x1.ep-1069' ],
+    [ '3e-323', '%.1a', '0x1.8p-1072' ],
+    [ '3e-324', '%.1a', '0x1.0p-1074' ],
+    [ '0x1.fffffffffffffp-1022', '%a', '0x1.fffffffffffffp-1022' ],
+    [ '0x0.fffffffffffffp-1022', '%a', '0x1.ffffffffffffep-1023' ],
+    [ '0x0.7ffffffffffffp-1022', '%a', '0x1.ffffffffffffcp-1024' ],
+    [ '0x0.3ffffffffffffp-1022', '%a', '0x1.ffffffffffff8p-1025' ],
+    [ '0x0.1ffffffffffffp-1022', '%a', '0x1.ffffffffffffp-1026' ],
+    [ '0x0.0ffffffffffffp-1022', '%a', '0x1.fffffffffffep-1027' ],
+    );
+
+SKIP: {
+    # [rt.perl.org #128843]
+    skip("non-IEEE-754-non-64-bit", scalar @subnormals + 34)
+        unless ($Config{nvsize} == 8 &&
+               $Config{nv_preserves_uv_bits} == 53 &&
+               ($Config{doublekind} == 3 ||
+                $Config{doublekind} == 4));
+
+    for my $t (@subnormals) {
+       # Note that "0x1p+2" is not considered numeric,
+       # since neither is "0x12", hence the eval.
+        my $s = sprintf($t->[1], eval $t->[0]);
+        is($s, $t->[2], "subnormal @$t got $s");
+    }
+
+    # [rt.perl.org #128888]
+    is(sprintf("%a", 1.03125),   "0x1.08p+0");
+    is(sprintf("%.1a", 1.03125), "0x1.0p+0");
+    is(sprintf("%.0a", 1.03125), "0x1p+0", "[rt.perl.org #128888]");
+
+    # [rt.perl.org #128889]
+    is(sprintf("%.*a", -1, 1.03125), "0x1.08p+0", "[rt.perl.org #128889]");
+
+    # [rt.perl.org #128890]
+    is(sprintf("%a", 0x1.18p+0), "0x1.18p+0");
+    is(sprintf("%.1a", 0x1.08p+0), "0x1.0p+0");
+    is(sprintf("%.1a", 0x1.18p+0), "0x1.2p+0", "[rt.perl.org #128890]");
+    is(sprintf("%.1a", 0x1.28p+0), "0x1.2p+0");
+    is(sprintf("%.1a", 0x1.38p+0), "0x1.4p+0");
+    is(sprintf("%.1a", 0x1.48p+0), "0x1.4p+0");
+    is(sprintf("%.1a", 0x1.58p+0), "0x1.6p+0");
+    is(sprintf("%.1a", 0x1.68p+0), "0x1.6p+0");
+    is(sprintf("%.1a", 0x1.78p+0), "0x1.8p+0");
+    is(sprintf("%.1a", 0x1.88p+0), "0x1.8p+0");
+    is(sprintf("%.1a", 0x1.98p+0), "0x1.ap+0");
+    is(sprintf("%.1a", 0x1.a8p+0), "0x1.ap+0");
+    is(sprintf("%.1a", 0x1.b8p+0), "0x1.cp+0");
+    is(sprintf("%.1a", 0x1.c8p+0), "0x1.cp+0");
+    is(sprintf("%.1a", 0x1.d8p+0), "0x1.ep+0");
+    is(sprintf("%.1a", 0x1.e8p+0), "0x1.ep+0");
+    is(sprintf("%.1a", 0x1.f8p+0), "0x2.0p+0");
+
+    is(sprintf("%.1a", 0x1.10p+0), "0x1.1p+0");
+    is(sprintf("%.1a", 0x1.17p+0), "0x1.1p+0");
+    is(sprintf("%.1a", 0x1.19p+0), "0x1.2p+0");
+    is(sprintf("%.1a", 0x1.1fp+0), "0x1.2p+0");
+
+    is(sprintf("%.2a", 0x1.fffp+0), "0x2.00p+0");
+    is(sprintf("%.2a", 0xf.fffp+0), "0x2.00p+3");
+
+    # [rt.perl.org #128893]
+    is(sprintf("%020a", 1.5), "0x0000000000001.8p+0");
+    is(sprintf("%020a", -1.5), "-0x000000000001.8p+0", "[rt.perl.org #128893]");
+    is(sprintf("%+020a", 1.5), "+0x000000000001.8p+0", "[rt.perl.org #128893]");
+    is(sprintf("% 020a", 1.5), " 0x000000000001.8p+0", "[rt.perl.org #128893]");
+    is(sprintf("%20a", -1.5), "           -0x1.8p+0");
+    is(sprintf("%+20a", 1.5), "           +0x1.8p+0");
+    is(sprintf("% 20a", 1.5), "            0x1.8p+0");
+}
+
+# x86 80-bit long-double tests for
+# rt.perl.org #128843, #128888, #128889, #128890, #128893, #128909
+SKIP: {
+    skip("non-80-bit-long-double", 17)
+        unless ($Config{uselongdouble} &&
+               ($Config{nvsize} == 16 || $Config{nvsize} == 12) &&
+               ($Config{longdblkind} == 3 ||
+                $Config{longdblkind} == 4));
+
+    {
+        # The last normal for this format.
+       is(sprintf("%a", eval '0x1p-16382'), "0x8p-16385", "[rt.perl.org #128843]");
+
+       # The subnormals cause "exponent underflow" warnings,
+        # but that is not why we are here.
+       local $SIG{__WARN__} = sub {
+           die "$0: $_[0]" unless $_[0] =~ /exponent underflow/;
+       };
+
+       is(sprintf("%a", eval '0x1p-16383'), "0x4p-16382", "[rt.perl.org #128843]");
+       is(sprintf("%a", eval '0x1p-16384'), "0x2p-16382", "[rt.perl.org #128843]");
+       is(sprintf("%a", eval '0x1p-16385'), "0x1p-16382", "[rt.perl.org #128843]");
+       is(sprintf("%a", eval '0x1p-16386'), "0x8p-16386", "[rt.perl.org #128843]");
+       is(sprintf("%a", eval '0x1p-16387'), "0x4p-16386", "[rt.perl.org #128843]");
+    }
+    is(sprintf("%.0a", 1.03125), "0x8p-3", "[rt.perl.org #128888]");
+    is(sprintf("%.*a", -1, 1.03125), "0x8.4p-3", "[rt.perl.org #128889]");
+    is(sprintf("%.1a", 0x8.18p+0), "0x8.2p+0", "[rt.perl.org #128890]");
+    is(sprintf("%020a", -1.5), "-0x0000000000000cp-3", "[rt.perl.org #128893]");
+    is(sprintf("%+020a", 1.5), "+0x0000000000000cp-3", "[rt.perl.org #128893]");
+    is(sprintf("% 020a", 1.5), " 0x0000000000000cp-3", "[rt.perl.org #128893]");
+    is(sprintf("%a", 1.9999999999999999999), "0xf.fffffffffffffffp-3");
+    is(sprintf("%.3a", 1.9999999999999999999), "0x1.000p+1", "[rt.perl.org #128909]");
+    is(sprintf("%.2a", 1.9999999999999999999), "0x1.00p+1");
+    is(sprintf("%.1a", 1.9999999999999999999), "0x1.0p+1");
+    is(sprintf("%.0a", 1.9999999999999999999), "0x1p+1");
+}
+
+# quadmath tests for rt.perl.org #128843
+SKIP: {
+    skip "need quadmath", 7, unless $Config{usequadmath};
+
+    is(sprintf("%a", eval '0x1p-16382'), '0x1p-16382');  # last normal
+
+    local $SIG{__WARN__} = sub {
+        die "$0: $_[0]" unless $_[0] =~ /exponent underflow/;
+    };
+
+    is(sprintf("%a", eval '0x1p-16383'), '0x1p-16383');
+    is(sprintf("%a", eval '0x1p-16384'), '0x1p-16384');
+
+    is(sprintf("%a", eval '0x1p-16491'), '0x1p-16491');
+    is(sprintf("%a", eval '0x1p-16492'), '0x1p-16492');
+    is(sprintf("%a", eval '0x1p-16493'), '0x1p-16493'); # last denormal
+
+    is(sprintf("%a", eval '0x1p-16494'), '0x1p-16494'); # underflow
+}
+
+done_testing();
index 61c64d29efd858cac472abaf8c4450207057b226..09de60aa22323dce28e421bda13da133f5ff49c3 100644 (file)
@@ -2,14 +2,14 @@
 
 BEGIN {
     chdir "t" if -d "t";
-    @INC = qw(. ../lib);
+    require "./test.pl";
+    set_up_inc( qw(. ../lib) );
 }
 
 # Test srand.
 
 use strict;
 
-require "./test.pl";
 plan(tests => 10);
 
 # Generate a load of random numbers.
index 212c69adb45ac033d52519ae7880bcb578efe2c9..a2507c788b13db9efbe6eaa30b75a6ab765a47f7 100644 (file)
@@ -3,12 +3,11 @@
 my $hires;
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('.', '../lib');
+    require './test.pl';
+    set_up_inc('.', '../lib');
     $hires = eval 'use Time::HiResx "time"; 1';
 }
 
-require './test.pl';
-
 skip_all("Win32 miniperl has no socket select")
   if $^O eq "MSWin32" && is_miniperl();
 
index fe427003227eba658ce96023692f3e38e3e12eb9..8d2d628bdd91c0074f20a4641ab3224e365f72ca 100644 (file)
@@ -2,11 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(../lib);
+    require "./test.pl";
+    set_up_inc( qw(../lib) );
 }
 
-BEGIN { require "./test.pl"; }
-
 plan( tests => 54 );
 
 # Used to segfault (bug #15479)
index 151f940c2d97f6a9d513717192b88cfe80b3687e..4df4ac7264fc9c9f388fd6af3d972ca23d6e5988 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';       # for which_perl() etc
+    set_up_inc('../lib');
 }
 
 use Config;
@@ -443,7 +443,7 @@ ok(-f(),    '     -f() "');
 
 unlink $tmpfile or print "# unlink failed: $!\n";
 
-# bug id 20011101.069
+# bug id 20011101.069 (#7861)
 my @r = \stat($Curdir);
 is(scalar @r, 13,   'stat returns full 13 elements');
 
@@ -489,7 +489,7 @@ like $@, qr/^The stat preceding lstat\(\) wasn't an lstat at /,
 SKIP: {
     skip "No lstat", 2 unless $Config{d_lstat};
 
-    # bug id 20020124.004
+    # bug id 20020124.004 (#8334)
     # If we have d_lstat, we should have symlink()
     my $linkname = 'stat-' . rand =~ y/.//dr;
     my $target = $Perl;
index ed68b515aa5a8b0c95c468eeafb4440ddfed8df6..92f1f60887dcb6a7ab0f1dc41060937141bd9131 100644 (file)
@@ -3,8 +3,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 906aba95a0fb26344fbe5c30f1f6bee79d711ce9..e268f59baf71ec786ffba608c2e58cd559447c2c 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 watchdog(10);
@@ -82,8 +82,8 @@ TODO: {
 
     $_ = 'FGF';
     study;
-    ok(!/G.F$/, 'bug 20010618.006');
-    ok(!/[F]F$/, 'bug 20010618.006');
+    ok(!/G.F$/, 'bug 20010618.006 (#7126)');
+    ok(!/[F]F$/, 'bug 20010618.006 (#7126)');
 }
 
 {
index 62f1ac9ad6f994606f39df8c8173d157dd3cf027..00cf8b0a8857ebd0ec444250104930d1fb480091 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index eb33027ea5f9f9e66c962951eddfc36f0e60f687..bf1b49cbc143b2c545dacb9b6651be78ea551346 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 plan tests=>211;
 
@@ -549,19 +549,25 @@ while (/f/g) {
 }
 is("@p", "1 8");
 
-sub keeze : lvalue { keys %__ }
-%__ = ("a","b");
-keeze = 64;
-is Hash::Util::bucket_ratio(%__), '1/64', 'keys assignment through lvalue sub';
-eval { (keeze) = 64 };
-like $@, qr/^Can't modify keys in list assignment at /,
-  'list assignment to keys through lv sub is forbidden';
-sub akeeze : lvalue { keys @_ }
-eval { (akeeze) = 64 };
-like $@, qr/^Can't modify keys on array in list assignment at /,
-  'list assignment to keys @_ through lv sub is forbidden';
-
-# Bug 20001223.002: split thought that the list had only one element
+SKIP: {
+    skip "no Hash::Util on miniperl", 3, if is_miniperl;
+    require Hash::Util;
+    sub Hash::Util::bucket_ratio (\%);
+
+    sub keeze : lvalue { keys %__ }
+    %__ = ("a","b");
+    keeze = 64;
+    is Hash::Util::bucket_ratio(%__), '1/64', 'keys assignment through lvalue sub';
+    eval { (keeze) = 64 };
+    like $@, qr/^Can't modify keys in list assignment at /,
+         'list assignment to keys through lv sub is forbidden';
+    sub akeeze : lvalue { keys @_ }
+    eval { (akeeze) = 64 };
+    like $@, qr/^Can't modify keys on array in list assignment at /,
+         'list assignment to keys @_ through lv sub is forbidden';
+}
+
+# Bug 20001223.002 (#5005): split thought that the list had only one element
 @ary = qw(4 5 6);
 sub lval1 : lvalue { $ary[0]; }
 sub lval2 : lvalue { $ary[1]; }
@@ -820,7 +826,8 @@ is $wheel, 8, 'tied pad var explicitly returned in list ref context';
     is ($result, 'bar', "RT #41550");
 }
 
-SKIP: { skip 'no attributes.pm', 1 unless eval 'require attributes';
+SKIP: {
+  skip 'no attributes.pm', 1 unless eval 'require attributes';
 fresh_perl_is(<<'----', <<'====', {}, "lvalue can not be set after definition. [perl #68758]");
 use warnings;
 our $x;
index c18f498cbe7384024b485b3b5c41a7d209eefb37..77ff9ae83bdf4344e0ba1e9cb605188ea0ca0c73 100644 (file)
@@ -15,7 +15,7 @@ BEGIN {
 
 use Config;
 
-plan tests => 132;
+plan tests => 138;
 
 # run some code N times. If the number of SVs at the end of loop N is
 # greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -78,6 +78,19 @@ leak(5, 1, sub {push @a,1;},       "basic check 3 of leak test infrastructure");
        'delete local on nonexistent env var');
 }
 
+# defined
+leak(2, 0, sub { defined *{"!"} }, 'defined *{"!"}');
+leak(2, 0, sub { defined *{"["} }, 'defined *{"["}');
+leak(2, 0, sub { defined *{"-"} }, 'defined *{"-"}');
+sub def_bang { defined *{"!"}; delete $::{"!"} }
+def_bang;
+leak(2, 0, \&def_bang,'defined *{"!"} vivifying GV');
+leak(2, 0, sub { defined *{"["}; delete $::{"["} },
+    'defined *{"["} vivifying GV');
+sub def_neg { defined *{"-"}; delete $::{"-"} }
+def_neg;
+leak(2, 0, \&def_neg, 'defined *{"-"} vivifying GV');
+
 # Fatal warnings
 my $f = "use warnings FATAL =>";
 my $all = "$f 'all';";
index 8b43ef61e7772ab2608937252cbe040b9a6e5c05..fac25385c0df26400c161f0769b11530309158df 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 2596ae64107a8c939769644caf4e61a77a7a519e..20b522676fad86874ee03ce15c2c28909c0492bc 100644 (file)
@@ -2,11 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
-    plan( tests => 8 );
+    set_up_inc('../lib');
 }
 
+plan( tests => 8 );
+
 use strict;
 
 # first, with delete
index 25d71970248bdc931cd1e5777a768bcb740a02ec..b95def0ecbd41fd1ed82f547c6fe72c49d23b19c 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
   chdir 't' if -d 't';
-  @INC = '../lib';
   require './test.pl';
+  set_up_inc('../lib');
 }
 
 plan tests => 48;
index 101c6da42707e6900e6eaf3ef70e62dd9d3d317b..1915c38a3ef5aa096e3a724c567701f6efdc5949 100644 (file)
@@ -1462,7 +1462,7 @@ SKIP: {
 }
 
 {
-    # bug id 20001004.006
+    # bug id 20001004.006 (#4380)
 
     open my $fh, '<', $TEST or warn "$0: cannot read $TEST: $!" ;
     local $/;
@@ -1475,7 +1475,7 @@ SKIP: {
 }
 
 {
-    # bug id 20001004.007
+    # bug id 20001004.007 (#4381)
 
     open my $fh, '<', $TEST or warn "$0: cannot read $TEST: $!" ;
     my $a = <$fh>;
@@ -1502,7 +1502,7 @@ SKIP: {
 }
 
 {
-    # bug id 20010519.003
+    # bug id 20010519.003 (#7015)
 
     BEGIN {
        use vars qw($has_fcntl);
@@ -1547,7 +1547,7 @@ SKIP: {
 }
 
 {
-    # bug 20010526.004
+    # bug 20010526.004 (#7041)
 
     use warnings;
 
@@ -1568,7 +1568,7 @@ SKIP: {
 
 
 {
-    # Bug ID 20010730.010
+    # Bug ID 20010730.010 (#7387)
 
     my $i = 0;
 
@@ -1618,7 +1618,7 @@ like($@, qr/^Modification of a read-only value attempted/,
      'Assigning to ${^TAINT} fails');
 
 {
-    # bug 20011111.105
+    # bug 20011111.105 (#7897)
     
     my $re1 = qr/x$TAINT/;
     is_tainted($re1);
@@ -1633,7 +1633,7 @@ like($@, qr/^Modification of a read-only value attempted/,
 SKIP: {
     skip "system {} has different semantics on Win32", 1 if $Is_MSWin32;
 
-    # bug 20010221.005
+    # bug 20010221.005 (#5882)
     local $ENV{PATH} .= $TAINT;
     eval { system { "echo" } "/arg0", "arg1" };
     like($@, qr/^Insecure \$ENV/);
@@ -1643,7 +1643,7 @@ TODO: {
     todo_skip 'tainted %ENV warning occludes tainted arguments warning', 22
       if $Is_VMS;
 
-    # bug 20020208.005 plus some single arg exec/system extras
+    # bug 20020208.005 (#8465) plus some single arg exec/system extras
     violates_taint(sub { exec $TAINT, $TAINT }, 'exec');
     violates_taint(sub { exec $TAINT $TAINT }, 'exec');
     violates_taint(sub { exec $TAINT $TAINT, $TAINT }, 'exec');
@@ -1672,7 +1672,7 @@ TODO: {
 }
 
 {
-    # [ID 20020704.001] taint propagation failure
+    # [ID 20020704.001 (#10026)] taint propagation failure
     use re 'taint';
     $TAINT =~ /(.*)/;
     is_tainted(my $foo = $1);
index 123ad27e3a41af91fde51a115ed4c62a6228e3fd..3a7c7cac057fdc9a12d447a9f76e41fb8f6bf2fa 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
      chdir 't' if -d 't';
-     @INC = '../lib';
      require './test.pl';
+     set_up_inc( '../lib' );
      $| = 1;
 
      skip_all_without_config('useithreads');
@@ -399,7 +399,7 @@ fresh_perl_is(
   'no crash when deleting $::{INC} in thread'
 );
 
-fresh_perl_is(<<'CODE', 'ok', 'no crash modifying extended array element');
+fresh_perl_is(<<'CODE', 'ok', {}, 'no crash modifying extended array element');
 use threads;
 my @a = 1;
 threads->create(sub { $#a = 1; $a[1] = 2; print qq/ok\n/ })->join;
index ae0db6fc98d72e76a7769ed5aafa3976f5fcb914..6c13bee1b585461fcae9cb528d703e5540dcebc7 100644 (file)
@@ -10,8 +10,8 @@
 #
 
 chdir 't' if -d 't';
-@INC = '../lib';
 require './test.pl';
+set_up_inc('../lib');
 
 $|=1;
 
@@ -284,7 +284,7 @@ EXPECT
 2
 ########
 
-#  [20020716.007] - nested FETCHES
+#  [20020716.007 (#10080)] - nested FETCHES
 
 sub F1::TIEARRAY { bless [], 'F1' }
 sub F1::FETCH { 1 }
index 2b3b01aa8f914fac88123e3bd90460cf6dc25e9d..57e7acaac289fab82a72810a356c77c85b89f658 100644 (file)
@@ -7,9 +7,10 @@ BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
     set_up_inc('../lib');
-    plan (tests => 345);
 }
 
+plan (tests => 345);
+
 use strict;
 use warnings;
 
index 99b7938487a3baedd582e2292dfcd938e9a44e5d..1b9149ce70038a7bab328ee4d31f82f621e659c6 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 my %seen;
index 21f56fcc19d195cfc7641bb3ea4272bdc266bbc9..8b8ab6c595a9db5b457aa24505eb08b523d410c3 100644 (file)
@@ -277,7 +277,7 @@ is($r, 1);
 }
 
 {
-    # [ID 20020713.001] chomp($data=<tied_fh>)
+    # [ID 20020713.001 (#10048)] chomp($data=<tied_fh>)
     local *TEST;
     tie *TEST, 'CHOMP';
     my $data;
index c726ebfe6f6c5eaa641ba4dc128bf2f68f87d90a..e0197da2582c1b93542f37451a04fba6e3fcd7f6 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 72;
index b50ac4239d71ea5064be02a4a7db0fea287a9b39..47acd9e310ae7c340885f88d725a5fffae78042e 100644 (file)
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -13,7 +13,7 @@ BEGIN {
 
 use utf8;
 
-plan tests => 164;
+plan tests => 166;
 
 # Test this first before we extend the stack with other operations.
 # This caused an asan failure due to a bad write past the end of the stack.
@@ -170,7 +170,7 @@ like $@, qr\^Using !~ with tr///r doesn't make sense\,
   is $wc, 1, '/r warns just once';
 }
 
-# perlbug [ID 20000511.005]
+# perlbug [ID 20000511.005 (#3237)]
 $_ = 'fred';
 /([a-z]{2})/;
 $1 =~ tr/A-Z//;
@@ -502,7 +502,7 @@ is( ref $x, 'SCALAR', "    doesn't stringify its argument" );
 
 # rt.perl.org 36622.  Perl didn't like a y/// at end of file.  No trailing
 # newline allowed.
-fresh_perl_is(q[$_ = "foo"; y/A-Z/a-z/], '');
+fresh_perl_is(q[$_ = "foo"; y/A-Z/a-z/], '', {}, 'RT #36622 y/// at end of file');
 
 
 { # [perl #38293] chr(65535) should be allowed in regexes
@@ -647,4 +647,13 @@ for ("", nullrocow) {
        ok(1, "tr///d on glob does not assert");
 }
 
+{ # [perl #128734
+    my $string = chr utf8::unicode_to_native(0x00e0);
+    $string =~ tr/\N{U+00e0}/A/;
+    is($string, "A", 'tr// of \N{U+...} works for upper-Latin1');
+    my $string = chr utf8::unicode_to_native(0x00e1);
+    $string =~ tr/\N{LATIN SMALL LETTER A WITH ACUTE}/A/;
+    is($string, "A", 'tr// of \N{name} works for upper-Latin1');
+}
+
 1;
index ddef5963861dfb196b2669632d611563670d9ec2..cf471153ceb5889d42b20ea07be2820a8fab194c 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 892b6469efd5a0f8c6cba0ce18dd4183f5dcc1ab..417ec0c9504500755528030f89df1fbc3e95eaeb 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan 6;
index d451cd56dd8b3ee4df52cfea6f9d79015b2b31f6..cc77cd604598de727471b207667e636c605b09d0 100644 (file)
@@ -6,8 +6,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index e89758761f482f765be1da4a0bb70de7220ae8be..68b6cc9023693fea414056d48d30028549eebcb4 100644 (file)
@@ -3,8 +3,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 9508efd88a9d4a1cb23ef68829e00a70b5df70f9..c8c7dc7dc0ee68106aa3ba444e33d842ca29dbd1 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 $|=1;
index c071664f52663894a8e76822412d8a324f7a5a18..7dcb2524f5e2a1443f07c2682ea92270fa1b2ee1 100644 (file)
@@ -2,8 +2,9 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
-    require './test.pl'; require './charset_tools.pl';
+    require './test.pl';
+    set_up_inc('../lib');
+    require './charset_tools.pl';
 }
 
 plan tests => 6;
index 5200c5b8a15831f6a86ed6714a43f8beb4938a5c..72ad0586d269de317b4441fa389843697e1d9d90 100644 (file)
@@ -2,12 +2,12 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
-
-    plan(tests => 99);
+    set_up_inc('../lib');
 }
 
+plan(tests => 99);
+
 use strict;
 
 # Two hashes one with all 8-bit possible keys (initially), other
index 503efd7a664f070283f492be59c87985d5d4d575..e896711718fc1160baeccdb2ebb4a6a9895cf0a0 100644 (file)
@@ -2,9 +2,10 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib);
     $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN };
-    require "./test.pl"; require "./charset_tools.pl";
+    require "./test.pl";
+    set_up_inc( qw(. ../lib) );
+    require "./charset_tools.pl";
 }
 
 $DOWARN = 1; # enable run-time warnings now
@@ -160,13 +161,13 @@ is(sprintf("%vd", join("", map { chr }
 }
 
 {
-    # bug id 20000323.056
+    # bug id 20000323.056 (#2641)
 
-    is( "\x{41}",      +v65, 'bug id 20000323.056');
-    is( "\x41",        +v65, 'bug id 20000323.056');
-    is( "\x{c8}",     +v200, 'bug id 20000323.056');
-    is( "\xc8",       +v200, 'bug id 20000323.056');
-    is( "\x{221b}",  +v8731, 'bug id 20000323.056');
+    is( "\x{41}",      +v65, 'bug id 20000323.056 (#2641)');
+    is( "\x41",        +v65, 'bug id 20000323.056 (#2641)');
+    is( "\x{c8}",     +v200, 'bug id 20000323.056 (#2641)');
+    is( "\xc8",       +v200, 'bug id 20000323.056 (#2641)');
+    is( "\x{221b}",  +v8731, 'bug id 20000323.056 (#2641)');
 }
 
 # See if the things Camel-III says are true: 29..33
@@ -196,7 +197,7 @@ SKIP: {
 # Chapter 28, pp671
 ok(v5.6.0 lt v5.7.0, "v5.6.0 lt v5.7.0");
 
-# part of 20000323.059
+# part of 20000323.059 (#2644)
 is(v200, chr(200),      "v200 eq chr(200)"      );
 is(v200, +v200,         "v200 eq +v200"         );
 is(v200, eval( "v200"), 'v200 eq "v200"'        );
@@ -226,7 +227,7 @@ ok( abs($v - $]) < 10**-8 , "\$^V == \$] (numeric)" );
 {
 
   no warnings 'deprecated'; # These are above IV_MAX on 32 bit machines
-  # [ID 20010902.001] check if v-strings handle full UV range or not
+  # [ID 20010902.001 (#7608)] check if v-strings handle full UV range or not
   if ( $Config{'uvsize'} >= 4 ) {
     is(  sprintf("%vd", eval 'v2147483647.2147483648'),   '2147483647.2147483648', 'v-string > IV_MAX[32-bit]' );
     is(  sprintf("%vd", eval 'v3141592653'),              '3141592653',            'IV_MAX < v-string < UV_MAX[32-bit]');
index aff2b99a0e2ff79eda7294605621b4fcb56d9c49..497fc26cb688913d8331c740a0ac3bb742e4369d 100644 (file)
@@ -4,8 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     require Config;
     skip_all('no Errno')
        unless eval 'use Errno qw(EINVAL); 1';
index 433a839fcec1eba254b45b1440dc362c9ed2d051..854cca6b4986e497f7656c92f5bd00bb5c009cb1 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
@@ -26,7 +26,7 @@ $a = scalar context('S');
 ($a) = scalar context('S');
 
 {
-  # [ID 20020626.011] incorrect wantarray optimisation
+  # [ID 20020626.011 (#9998)] incorrect wantarray optimisation
   sub simple { wantarray ? 1 : 2 }
   sub inline {
     my $a = wantarray ? simple() : simple();
index a0f2c67638e4c00b4d9d200d98f62e7ae5a697cf..3f27ac0eb2a63edcf5a6ca76ed20875df19ab131 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = "../lib";
     require "./test.pl";
+    set_up_inc('../lib');
 }
 
 plan(26);
index a213bec2beb37a23bfd15e5341479d15cbe0204e..861389f4c597704ff015c233fb1353d80b51d1b6 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 8aa1e16224a84b6f7c238625f8f4357a43a2800a..81f272a7a8393b51d9d578f277e19b47420462f5 100644 (file)
@@ -2,7 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
+    require './test.pl';
+    set_up_inc('../lib');
 }
 
 # This file has been placed in t/opbasic to indicate that it should not use
index 9c4cbe20e224d110a15127408698cb180fac3573..7802fc98ce52964da5e68186398650c3a872088a 100644 (file)
@@ -33,63 +33,63 @@ ok("$c$a$c" eq "foo",    "concatenate undef, fore and aft");
 # Okay, so that wasn't very challenging.  Let's go Unicode.
 
 {
-    # bug id 20000819.004 
+    # bug id 20000819.004 (#3761) 
 
     $_ = $dx = "\x{10f2}";
     s/($dx)/$dx$1/;
     {
-        ok($_ eq  "$dx$dx","bug id 20000819.004, back");
+        ok($_ eq  "$dx$dx","bug id 20000819.004 (#3761), back");
     }
 
     $_ = $dx = "\x{10f2}";
     s/($dx)/$1$dx/;
     {
-        ok($_ eq  "$dx$dx","bug id 20000819.004, front");
+        ok($_ eq  "$dx$dx","bug id 20000819.004 (#3761), front");
     }
 
     $dx = "\x{10f2}";
     $_  = "\x{10f2}\x{10f2}";
     s/($dx)($dx)/$1$2/;
     {
-        ok($_ eq  "$dx$dx","bug id 20000819.004, front and back");
+        ok($_ eq  "$dx$dx","bug id 20000819.004 (#3761), front and back");
     }
 }
 
 {
-    # bug id 20000901.092
+    # bug id 20000901.092 (#4184)
     # test that undef left and right of utf8 results in a valid string
 
     my $a;
     $a .= "\x{1ff}";
-    ok($a eq  "\x{1ff}", "bug id 20000901.092, undef left");
+    ok($a eq  "\x{1ff}", "bug id 20000901.092 (#4184), undef left");
     $a .= undef;
-    ok($a eq  "\x{1ff}", "bug id 20000901.092, undef right");
+    ok($a eq  "\x{1ff}", "bug id 20000901.092 (#4184), undef right");
 }
 
 {
-    # ID 20001020.006
+    # ID 20001020.006 (#4484)
 
     "x" =~ /(.)/; # unset $2
 
     # Without the fix this 5.7.0 would croak:
     # Modification of a read-only value attempted at ...
     eval {"$2\x{1234}"};
-    ok(!$@, "bug id 20001020.006, left");
+    ok(!$@, "bug id 20001020.006 (#4484), left");
 
     # For symmetry with the above.
     eval {"\x{1234}$2"};
-    ok(!$@, "bug id 20001020.006, right");
+    ok(!$@, "bug id 20001020.006 (#4484), right");
 
     *pi = \undef;
     # This bug existed earlier than the $2 bug, but is fixed with the same
     # patch. Without the fix this 5.7.0 would also croak:
     # Modification of a read-only value attempted at ...
     eval{"$pi\x{1234}"};
-    ok(!$@, "bug id 20001020.006, constant left");
+    ok(!$@, "bug id 20001020.006 (#4484), constant left");
 
     # For symmetry with the above.
     eval{"\x{1234}$pi"};
-    ok(!$@, "bug id 20001020.006, constant right");
+    ok(!$@, "bug id 20001020.006 (#4484), constant right");
 }
 
 sub beq { use bytes; $_[0] eq $_[1]; }
index 88b20deb940b1ce770e9550da4ba83a8c7ecfbd6..6ea1ce882bdf5885dced758b9316a800bfc193fa 100644 (file)
@@ -33,6 +33,7 @@
 #
 #     call::     subroutine and method handling
 #     expr::     expressions: e.g. $x=1, $foo{bar}[0]
+#     func::     perl functions, e.g. func::sort::...
 #     loop::     structural code like for, while(), etc
 #     regex::    regular expressions
 #     string::   string handling
         code    => '$y = $x--', # scalar context so not optimised to --$x
     },
 
+
+    'func::sort::num' => {
+        desc    => 'plain numeric sort',
+        setup   => 'my (@a, @b); @a = reverse 1..10;',
+        code    => '@b = sort { $a <=> $b } @a',
+    },
+    'func::sort::num_block' => {
+        desc    => 'codeblock numeric sort',
+        setup   => 'my (@a, @b); @a = reverse 1..10;',
+        code    => '@b = sort { $a + 1 <=> $b + 1 } @a',
+    },
+    'func::sort::num_fn' => {
+        desc    => 'function numeric sort',
+        setup   => 'sub f { $a + 1 <=> $b + 1 } my (@a, @b); @a = reverse 1..10;',
+        code    => '@b = sort f @a',
+    },
+    'func::sort::str' => {
+        desc    => 'plain string sort',
+        setup   => 'my (@a, @b); @a = reverse "a".."j";',
+        code    => '@b = sort { $a cmp $b } @a',
+    },
+    'func::sort::str_block' => {
+        desc    => 'codeblock string sort',
+        setup   => 'my (@a, @b); @a = reverse "a".."j";',
+        code    => '@b = sort { ($a . "") cmp ($b . "") } @a',
+    },
+    'func::sort::str_fn' => {
+        desc    => 'function string sort',
+        setup   => 'sub f { ($a . "") cmp ($b . "") } my (@a, @b); @a = reverse  "a".."j";',
+        code    => '@b = sort f @a',
+    },
+
+    'func::sort::num_inplace' => {
+        desc    => 'plain numeric sort in-place',
+        setup   => 'my @a = reverse 1..10;',
+        code    => '@a = sort { $a <=> $b } @a',
+    },
+    'func::sort::num_block_inplace' => {
+        desc    => 'codeblock numeric sort in-place',
+        setup   => 'my @a = reverse 1..10;',
+        code    => '@a = sort { $a + 1 <=> $b + 1 } @a',
+    },
+    'func::sort::num_fn_inplace' => {
+        desc    => 'function numeric sort in-place',
+        setup   => 'sub f { $a + 1 <=> $b + 1 } my @a = reverse 1..10;',
+        code    => '@a = sort f @a',
+    },
+    'func::sort::str_inplace' => {
+        desc    => 'plain string sort in-place',
+        setup   => 'my @a = reverse "a".."j";',
+        code    => '@a = sort { $a cmp $b } @a',
+    },
+    'func::sort::str_block_inplace' => {
+        desc    => 'codeblock string sort in-place',
+        setup   => 'my @a = reverse "a".."j";',
+        code    => '@a = sort { ($a . "") cmp ($b . "") } @a',
+    },
+    'func::sort::str_fn_inplace' => {
+        desc    => 'function string sort in-place',
+        setup   => 'sub f { ($a . "") cmp ($b . "") } my @a = reverse  "a".."j";',
+        code    => '@a = sort f @a',
+    },
+
+
     'loop::block' => {
         desc    => 'empty basic loop',
-        setup   => ';',
+        setup   => '',
         code    => '{1;}',
     },
 
index 13c916db365914d3ca44834270738af4542aec2d..f65695dc8647cf2e871a327822db4cf66a78a090 100644 (file)
@@ -20,7 +20,7 @@ BEGIN {
 use warnings;
 use strict;
 
-plan 2250;
+plan 2256;
 
 use B ();
 
@@ -266,3 +266,62 @@ test_opcount(0, 'barewords can be constant-folded',
              {
                  concat => 0,
              });
+
+{
+    no warnings 'experimental::signatures';
+    use feature 'signatures';
+
+    my @a;
+    test_opcount(0, 'signature default expressions get optimised',
+                 sub ($s = $a[0]) {},
+                 {
+                     aelem         => 0,
+                     aelemfast_lex => 1,
+                 });
+}
+
+# in-place sorting
+
+{
+    local our @global = (3,2,1);
+    my @lex = qw(a b c);
+
+    test_opcount(0, 'in-place sort of global',
+                 sub { @global = sort @global; 1 },
+                 {
+                     rv2av   => 1,
+                     aassign => 0,
+                 });
+
+    test_opcount(0, 'in-place sort of lexical',
+                 sub { @lex = sort @lex; 1 },
+                 {
+                     padav   => 1,
+                     aassign => 0,
+                 });
+
+    test_opcount(0, 'in-place reversed sort of global',
+                 sub { @global = sort { $b <=> $a } @global; 1 },
+                 {
+                     rv2av   => 1,
+                     aassign => 0,
+                 });
+
+
+    test_opcount(0, 'in-place custom sort of global',
+                 sub { @global = sort {  $a<$b?1:$a>$b?-1:0 } @global; 1 },
+                 {
+                     rv2av   => 1,
+                     aassign => 0,
+                 });
+
+    sub mysort { $b cmp $a };
+    test_opcount(0, 'in-place sort with function of lexical',
+                 sub { @lex = sort mysort @lex; 1 },
+                 {
+                     padav   => 1,
+                     aassign => 0,
+                 });
+
+
+}
index a8d4e10e32eb96ff647e64ab4ae76f8374a76542..8129fac367f0490e4876e7743a9962b9a904a2a7 100644 (file)
@@ -1,23 +1,45 @@
-Encode cpan/Encode/Byte/Makefile.PL 54f446297d614331ef3f51e8310faff27cc44f90
-Encode cpan/Encode/encoding.pm 90ea1844e5ae863a17dd40ac6a0f27f438db9c1f
-Encode cpan/Encode/t/enc_data.t e8b94d651a6519e186a2b74245f0002c4bb62160
-Encode cpan/Encode/t/enc_eucjp.t 9d73fce7d5ae83036be546d1603262baffd68cdb
-Encode cpan/Encode/t/enc_module.t aad4fcde7389ad55731206f62284dadf21ffe274
-Encode cpan/Encode/t/enc_utf8.t 7d1c9a4260c0c6b263eff30539e591c417e602a9
-Encode cpan/Encode/t/encoding.t ed051c17c92510713b24217c22384815088834a8
-Encode cpan/Encode/t/jperl.t 584a3813e7bc680ee6ec1d54253bbf861bda8215
+CPAN cpan/CPAN/lib/App/Cpan.pm 3cef68c2a44a4996b432bc25622e3a544a188aa5
+CPAN cpan/CPAN/lib/CPAN.pm 4616a44963045f7bd07bb7f8e5f99bbd789af4e5
+CPAN cpan/CPAN/scripts/cpan 22610ed0301d48a269d1739afd2f7f84359d956f
+Digest cpan/Digest/Digest.pm 43f7f544cb11842b2f55c73e28930da50774e081
 ExtUtils::Constant cpan/ExtUtils-Constant/t/Constant.t a0369c919e216fb02767a637666bb4577ad79b02
-ExtUtils::MakeMaker cpan/ExtUtils-MakeMaker/t/basic.t b7ee8691baf37197bf4249534f429fcf28f5cedf
-ExtUtils::MakeMaker cpan/ExtUtils-MakeMaker/t/lib/MakeMaker/Test/Setup/XS.pm 27aaa6acefd4223b57de74299314c19891ed17bc
 File::Path cpan/File-Path/lib/File/Path.pm fd8ce4420a0c113d3f47dd3223859743655c1da8
 File::Path cpan/File-Path/t/Path_win32.t 94b9276557ce7f80b91f6fd9bfa7a0cd9bf9683e
-Module::Metadata cpan/Module-Metadata/t/extract-package.t ddb0a96a6bd0c1593c5654d4ac4449c1a64f6953
-Module::Metadata cpan/Module-Metadata/t/metadata.t ed2fa6cb370800830a826f19c4f012ff622e6aab
+IO-Compress cpan/IO-Compress/bin/zipdetails 381ba2a6ae5bd21c8d2e994316e3e13f2f0a4f41
+IO-Compress cpan/IO-Compress/lib/Compress/Zlib.pm 0f93fb368d1d6af6f461b86304e8aabe0472754d
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm 3acbcf5538e036a1b7907eedf038badf38254d71
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm ed1c8835f3c3cb333b1ff5d4d517695ac2569f6a
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm 75a361c5032bf602cd55d2b52a9fc6dee3f966ee
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Base.pm 490ddf3f073a6d1a9b508a06e870709d19932d6f
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Base/Common.pm 46dcd7effb81737a5e3aaa322d2b7404a36666e4
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Bzip2.pm 4fc4bc90f9566eeecb0b6f3fe3b59443ed838378
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Deflate.pm 729f52133f69df0d4e83f1561c1a4a9b18c00753
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Gzip.pm 26654883fe0e4224e1d86c8d7d8cd11d75505075
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm f8cc94ebbbf50310d7fbd9c4addf1619646e8e7a
+IO-Compress cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm 19ba3e84de766613f53e29de4f76b46ed50b780c
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Zip.pm db0231d4dea78b8400db6ea7b65ac9ef95ead319
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm e810575fb4ef2a4a2e26ab528484061eb822f508
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm 65fe46cd7b9fdfd54bdfc4635829fb302d0d6d30
+IO-Compress cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm d80925cae9d1f26c526e898a70d6d4052749b217
+IO-Compress cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm 784c7c313969d869a59118d327895e0b60f1decc
+IO-Compress cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm 5ed1888ebf365026460873e37c7db8bf7655b1a0
+IO-Compress cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm f427dff7fb2cb55f7ee04adc20986cc3ae32e84c
+IO-Compress cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm c51ae0e7524891d82634309353700cc802583b7e
+IO-Compress cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm 18b7d32dfa4eee9c11bdd8a98e68bcd00040e082
+IO-Compress cpan/IO-Compress/lib/IO/Uncompress/Base.pm 821b0445d3edfa5761e7a7935cd80b2b35e22017
+IO-Compress cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm 7dd2eaf1727fa77e184c7cb2d6513f396e57a3e8
+IO-Compress cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm 7490524bf3714621bb3292574d0f97212f2538bd
+IO-Compress cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm c75aa1ec1f2a6138ef9ae660771fb2cac8be6931
+IO-Compress cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm 8f30a77bcda7123300ef5a8d02c2160ebb72f013
+IO-Compress cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm 321a55011a1f11fe73b005e33942eb27fed6d046
+JSON::PP cpan/JSON-PP/bin/json_pp a7b8de6c201ef177ee82624ee4ca6a47cc1a3b4f
+JSON::PP cpan/JSON-PP/lib/JSON/PP.pm c8762a306740d0b32c099faf7118f2c1a391d9db
+Locale::Maketext::Simple cpan/Locale-Maketext-Simple/lib/Locale/Maketext/Simple.pm 57ed38905791a17c150210cd6f42ead22a7707b6
+Memoize cpan/Memoize/Memoize.pm 902092ff91cdec9c7b4bd06202eb179e1ce26ca2
 Pod::Checker cpan/Pod-Checker/t/pod/contains_bad_pod.xr 73538fd80dfe6e19ad561fe034009b44460208f6
 Pod::Checker cpan/Pod-Checker/t/pod/selfcheck.t 8ce3cfd38e4b9bcf5bc7fe7f2a14195e49aed7d8
 Pod::Checker cpan/Pod-Checker/t/pod/testcmp.pl a0cd5c8eca775c7753f4464eee96fa916e3d8a16
 Pod::Checker cpan/Pod-Checker/t/pod/testpchk.pl b2072c7f4379fd050e15424175d7cac5facf5b3b
-Pod::Perldoc cpan/Pod-Perldoc/lib/Pod/Perldoc.pm fe0bc906fb74b69cfd3fb289316ba669d770d465
 Scalar-List-Utils cpan/Scalar-List-Utils/lib/List/Util.pm e479a29c6b66ac5cbbde4ef2296afaab6c4635a6
 Scalar-List-Utils cpan/Scalar-List-Utils/lib/List/Util/XS.pm cbc38838d32fd213ae7b37ac38e30195355be3b9
 Scalar-List-Utils cpan/Scalar-List-Utils/lib/Scalar/Util.pm 14a20075dfb9a4ef33b99115ed6f43e6d1a15f9b
@@ -25,5 +47,62 @@ Scalar-List-Utils cpan/Scalar-List-Utils/lib/Sub/Util.pm b984c0a2935bd5f5cf1733d
 Scalar-List-Utils cpan/Scalar-List-Utils/ListUtil.xs 362a247c65878265fd8acae607b207400628ef3b
 Socket cpan/Socket/Socket.pm 98e38176d745c38282907f391c077298f5a3d0ba
 Socket cpan/Socket/Socket.xs edd4fed212785f11c5c2095a75941dad27d586d9
+Sys::Syslog cpan/Sys-Syslog/Syslog.pm 1cbcaaf58302bf803570546d8ced83190d3e5581
+Test::Harness cpan/Test-Harness/bin/prove 9b2866928cb1125de2c68f9773b25723e02c54c0
+Test::Harness cpan/Test-Harness/lib/App/Prove.pm a312bbbc97860d5051f06056eb30b985b15ee57c
+Test::Harness cpan/Test-Harness/lib/App/Prove/State.pm f4f7d11878eae1fd81d9c3d82097ddfd43b679a1
+Test::Harness cpan/Test-Harness/lib/App/Prove/State/Result.pm 374f5be770e2709c744ddf77927b73ab0f644219
+Test::Harness cpan/Test-Harness/lib/App/Prove/State/Result/Test.pm d3a2ef3916946e0880ffd00356b3ed0feb589029
+Test::Harness cpan/Test-Harness/lib/TAP/Base.pm 38c1bbc33e1e28919dd905ee7f416c2f1cd2014b
+Test::Harness cpan/Test-Harness/lib/TAP/Formatter/Base.pm 92783e20c15f982a25025c1fd7dc512071aa2671
+Test::Harness cpan/Test-Harness/lib/TAP/Formatter/Color.pm f4f02b5a4f8f11c0e9fa95d06e9bc8f14a172555
+Test::Harness cpan/Test-Harness/lib/TAP/Formatter/Console.pm 36fec1e9ca70e359cf1cf110cbdf86040686e635
+Test::Harness cpan/Test-Harness/lib/TAP/Formatter/Console/ParallelSession.pm 579df1507c22c5a6c8116943ba7b084dd557a2a3
+Test::Harness cpan/Test-Harness/lib/TAP/Formatter/Console/Session.pm 98f620cadecbe7529b62addf35e16be72b066bcf
+Test::Harness cpan/Test-Harness/lib/TAP/Formatter/File.pm 531f646edd5d5768a02728be5c3c1786df17a328
+Test::Harness cpan/Test-Harness/lib/TAP/Formatter/File/Session.pm cb8b1dd0039381c41b11ba186ed25969fd33b654
+Test::Harness cpan/Test-Harness/lib/TAP/Formatter/Session.pm ce57cb909e8e9b1a8263939da1b4eac6ac5df6e5
+Test::Harness cpan/Test-Harness/lib/TAP/Harness.pm dbbeef74569163d00c8befccf9f2670bafa2dc2f
+Test::Harness cpan/Test-Harness/lib/TAP/Harness/Env.pm 7743d40504d23867fe5f6b3967f7c907c530074f
+Test::Harness cpan/Test-Harness/lib/TAP/Object.pm 19b27d7e30f6e69c3ffaec939418978ba7b0bc7c
+Test::Harness cpan/Test-Harness/lib/TAP/Parser.pm a97c90c41959194ad828511a2b5f6ad068fd2f23
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Aggregator.pm bf32f2c834f5242af1db2b5f02419451e87c3b68
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Grammar.pm 2626f555bcf238e4c6a5a0e07eb016f38520d705
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Iterator.pm 6b2729f8883718683b0a2d7cd75d734501360e7b
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Iterator/Array.pm c4ebe427ef24bfbcfcf74459cb74249bf84ec92a
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Iterator/Process.pm 43c08c6ba2a2e599f503cfec086f8ac9b2b8a8f1
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Iterator/Stream.pm f28ccf211ebdb527b558a83d6969d96ba13414af
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/IteratorFactory.pm 561ba7be34786134f70b67e73e604de1c934f9bb
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Multiplexer.pm 7417eede2c1554b94dfbbbce5a90dc6e4d8bbbe6
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Result.pm be74c62222a90404d2d6586f77a4f66bafee2879
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Result/Bailout.pm 89a3c49f5b03501813b5a6133ca2ca3fa25f8648
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Result/Comment.pm e49dde84304dc1a034fd1a5c38f18bed99c1b4d4
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Result/Plan.pm cf334e85a8e77fe6f830744f70e4c9c1a24c36a5
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Result/Pragma.pm b1587f903cc7937190789b1de8bdf20d6e30ff28
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Result/Test.pm dff1422b7cc8ea0c24aedef020fc2266144eb1ea
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Result/Unknown.pm 0959ff5602d340f92be31f01ee2f890028784a8d
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Result/Version.pm 8491bba7a07568374cafd8fc40cb08d9b4458e9b
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Result/YAML.pm 7dc7b96d882dce5e20696305705f4f0e7462d8bc
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/ResultFactory.pm 1f64e8390990ad99eea3d0fb202487ba973e9a2d
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Scheduler.pm 471ea7d1db535364dd86ab106771c652742c0c05
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Scheduler/Job.pm 3d7ee9db8277b50fcebcf239898a8023791b8654
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Scheduler/Spinner.pm 1c04e88f45719f92961821d9ed65e80800986893
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/Source.pm c820d95e2a4797893eb717c07b72742e6e0a1542
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/SourceHandler.pm b25f8e7d1a9f2215175618a989df39d78a878df5
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Executable.pm 5f542b39c98ebe3ee6d906e38b8944abbac5188b
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/SourceHandler/File.pm 6aa5762461cb06f3db57d13de0fc771d5563c871
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Handle.pm edc91794e1fbefbbf8e919658fe7a5bbd7c84916
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Perl.pm 809d6d6779c2aed829a9a087ecb219fbcc7fbfb5
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/SourceHandler/RawTAP.pm d01e1e2a87733ab45f387e34803f821ed184e5cc
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/YAMLish/Reader.pm 76771092dd2b87a2adb7ff20b7ae77cbae7d0563
+Test::Harness cpan/Test-Harness/lib/TAP/Parser/YAMLish/Writer.pm bf1fbfff9720330886651f183959a5db56daeea0
+Test::Harness cpan/Test-Harness/lib/Test/Harness.pm da2d76ba673372da129060c9d0adb8cf0d91f9f7
 autodie cpan/autodie/t/mkdir.t 9e70d2282a3cc7d76a78bf8144fccba20fb37dac
+base dist/base/lib/base.pm 9575442273694d41c8e86cb1d86fa1935a07c8a8
+bignum cpan/bignum/lib/bigint.pm b901044cb5ecd8b331495769f547350da5d4ed60
+bignum cpan/bignum/lib/bignum.pm 9903bb25a330e0af73016000c0fba147bb990afd
+bignum cpan/bignum/lib/bigrat.pm b8fcffd8e60bfa9f32ccb9ab8c0fa5726d6392f8
+bignum cpan/bignum/lib/Math/BigFloat/Trace.pm 1ec133b0c03687fd621cc35946c465c66e38127a
+bignum cpan/bignum/lib/Math/BigInt/Trace.pm 3e1cc7726c55f9d5f4db6e5ec41c5fd266fcb289
 version cpan/version/lib/version.pm a032a751524bdd07a93c945d2a1703abe7ad8ef0
+Encode cpan/Encode/Encode.xs dba310bf3d362b1ade421b1a741875511d84809a
index 396c04dc3c0264d9b891afc1190801902843129f..942826c201b9b69013acc6e5d8d43a4cd3ef23b2 100644 (file)
@@ -48,6 +48,7 @@ Class::Tiny
 Class::Tiny::Antlers
 Classic::Perl
 clearerr(3)
+clock(3)
 Clone
 closedir(2)
 connect(2)
@@ -69,6 +70,7 @@ Data::Float
 Data::Structure::Util
 Data::Types
 Data::Util
+Date::Parse
 Date::Pcalc
 DateTime
 DB_File(3)
@@ -161,7 +163,9 @@ Log::Message::Item
 Log::Message::Simple
 lseek(2)
 LWP::ConsoleLogger
+Mail::Mailer
 Mail::Send
+Mail::Sendmail
 Mail::SpamAssassin
 man(5)
 man(7)
@@ -334,6 +338,7 @@ pod/perlbook.pod    Verbatim line length including indents exceeds 79 by    1
 pod/perlce.pod Verbatim line length including indents exceeds 79 by    3
 pod/perldebguts.pod    Verbatim line length including indents exceeds 79 by    27
 pod/perldebtut.pod     Verbatim line length including indents exceeds 79 by    3
+pod/perldelta.pod      Apparent broken link    1
 pod/perldtrace.pod     Verbatim line length including indents exceeds 79 by    7
 pod/perlgit.pod        ? Should you be using F<...> or maybe L<...> instead of 1
 pod/perlgit.pod        Verbatim line length including indents exceeds 79 by    1
index f0c39909513770c07f8130a0a69a9548e2f92134..a6c8528865fc44636a1f53b88f8b678f01084ff9 100644 (file)
@@ -531,16 +531,20 @@ sub suppressed {
         last SKIP;
     }
 
-    sub note {
-        my $message = shift;
+    sub _note {
+        my ($andle, $message) = @_;
 
         chomp $message;
 
-        print $message =~ s/^/# /mgr;
-        print "\n";
+        print $andle $message =~ s/^/# /mgr;
+        print $andle "\n";
         return;
     }
 
+    sub note { unshift @_, \*STDOUT; goto &_note }
+
+    sub diag { unshift @_, \*STDERR; goto &_note }
+
     END {
         if ($planned && $planned != $current_test) {
             print STDERR
@@ -2133,7 +2137,7 @@ foreach my $filename (@files) {
         }
         ok(@diagnostics == $thankful_diagnostics, $output);
         if (@diagnostics) {
-            note(join "", @diagnostics,
+            diag(join "", @diagnostics,
             "See end of this test output for your options on silencing this");
         }
 
@@ -2165,7 +2169,7 @@ if (%files_with_unknown_issues) {
                         : "were $were_count_files files";
     my $message = <<EOF;
 
-HOW TO GET THIS .t TO PASS
+HOW TO GET ${\__FILE__} TO PASS
 
 There $were_count_files that had new potential problems identified.
 Some of them may be real, and some of them may be false positives because
@@ -2204,9 +2208,9 @@ EOF
    and change the count of known potential problems to -1.
 EOF
 
-    note($message);
+    diag($message);
 } elsif (%files_with_fixes) {
-    note(<<EOF
+    diag(<<EOF
 To teach this test script that the potential problems have been fixed,
 $how_to
 EOF
index 7a5852ad4614184c514e2ca9d4fe5b5d2433bd5e..dc156c0cafd9e75f6a705c23b78ccb4e9e0144ab 100644 (file)
@@ -2,9 +2,9 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw '../lib ../dist/if';
     require './test.pl';
     require './loc_tools.pl';
+    set_up_inc('../lib', '../dist/if');
 }
 
 use strict;
@@ -41,7 +41,8 @@ $testcases{'[:word:]'} = $testcases{'\w'};
 my $utf8_locale;
 
 my @charsets = qw(a d u aa);
-if (! is_miniperl() && locales_enabled('LC_CTYPE')) {
+my $locales_ok = eval { locales_enabled('LC_CTYPE'); 1 };
+if (! is_miniperl() && $locales_ok) {
     require POSIX;
     my $current_locale = POSIX::setlocale( &POSIX::LC_ALL, "C") // "";
     if ($current_locale eq 'C') {
index fff68f35538d3cde18e531b7898d545fae29e4d5..63581656a99a540f1c8dc96c7512e291fb6a2bc5 100644 (file)
@@ -4,8 +4,8 @@ binmode STDOUT, ":utf8";
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     require Config; import Config;
     skip_all_if_miniperl("no dynamic loading on miniperl, no Encode nor POSIX");
     if ($^O eq 'dec_osf') {
index 6595a248b34157ea9f028c6caa07e1f73a67b1e9..15b1cb32937431598044c493740de695fab3f1b6 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 1;
index ee821f1e788a084e7067b6d1f321a421954f1ece..a11d4f5fa22d2db826ae579bd8d84407098b2304 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw '../lib ../ext/re';
     require './test.pl';
+    set_up_inc(qw '../lib ../ext/re');
 }
 
 use strict;
index f6bd04a89496ab4255d8956bbaf1b3624981b276..d0449e252586cec8954912aa22e526cffb6237d9 100644 (file)
@@ -15,15 +15,15 @@ $| = 1;
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('../lib','.','../ext/re');
     require Config; import Config;
     require './test.pl'; require './charset_tools.pl';
     require './loc_tools.pl';
+    set_up_inc('../lib', '.', '../ext/re');
+}
     skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
     skip_all_without_unicode_tables();
-}
 
-plan tests => 796;  # Update this when adding/deleting tests.
+plan tests => 799;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1781,6 +1781,21 @@ EOP
                 /.*a.*b.*c.*[de]/;
             ',"Timeout",{},"Test Perl 73464")
         }
+
+        {   # [perl #128686], crashed the the interpreter
+            my $AE = chr utf8::unicode_to_native(0xC6);
+            my $ae = chr utf8::unicode_to_native(0xE6);
+            my $re = qr/[$ae\s]/i;
+            ok($AE !~ $re, '/[\xE6\s]/i doesn\'t match \xC6 when not in UTF-8');
+            utf8::upgrade $AE;
+            ok($AE =~ $re, '/[\xE6\s]/i matches \xC6 when in UTF-8');
+        }
+
+        {   # [perl #126606 crashed the interpreter
+            no warnings 'deprecated';
+            like("sS", qr/\N{}Ss|/i, "\N{} with empty branch alternation works");
+        }
+
 } # End of sub run_tests
 
 1;
index 74aed911249adc92963beb3e5ab100a4284baf4f..5eb2cc599fcf7b1c17031e5f0ee15a585ebede9b 100644 (file)
@@ -6,9 +6,9 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(../lib .);
     require './test.pl';
     require './charset_tools.pl';
+    set_up_inc(qw '../lib .');
     skip_all_if_miniperl("miniperl can't load Tie::Hash::NamedCapture, need for %+ and %-");
 }
 
@@ -62,7 +62,7 @@ sub run_tests {
     }
 
     {
-        my $message = 'bug id 20001008.001';
+        my $message = 'bug id 20001008.001 (#4407)';
 
         my $strasse = "stra" . uni_to_native("\337") . "e";
         my @x = ("$strasse 138", "$strasse 138");
index fada30293f18e7b8f818ec9adecc2c9fd56e63b8..c0f855fbfdc4735b0f9835636dbe3dceb0dbc47e 100644 (file)
@@ -19,8 +19,8 @@ $| = 1;
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('../lib','.');
     require './test.pl';
+    set_up_inc('../lib', '.');
     if ($^O eq 'dec_osf') {
         skip_all("$^O cannot handle this test");
     }
index cb02ad2b6f761582f8d888b6869cd8abe70ed27e..cb09360f4d5fde1a8317e88ab4ab85d3d4d6876b 100644 (file)
@@ -10,8 +10,8 @@ $| = 1;
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('../lib','.');
     require './test.pl';
+    set_up_inc( '../lib', '.' );
     skip_all_if_miniperl("miniperl can't load Tie::Hash::NamedCapture, need for %+ and %-");
 }
 
@@ -30,15 +30,15 @@ run_tests() unless caller;
 sub run_tests {
 
     like("A \x{263a} B z C", qr/A . B (??{ "z" }) C/,
-        "Match UTF-8 char in presence of (??{ }); Bug 20000731.001");
+        "Match UTF-8 char in presence of (??{ }); Bug 20000731.001 (#3600)");
 
     {
         no warnings 'uninitialized';
-        ok(undef =~ /^([^\/]*)(.*)$/, "Used to cause a SEGV; Bug 20001021.005");
+        ok(undef =~ /^([^\/]*)(.*)$/, "Used to cause a SEGV; Bug 20001021.005 (#4492)");
     }
 
     {
-        my $message = 'bug id 20001008.001';
+        my $message = 'bug id 20001008.001 (#4407)';
 
         my @x = ("stra\337e 138", "stra\337e 138");
         for (@x) {
@@ -57,14 +57,14 @@ sub run_tests {
 
     {
         # Fist half of the bug.
-        my $message = 'HEBREW ACCENT QADMA matched by .*; Bug 20001028.003';
+        my $message = 'HEBREW ACCENT QADMA matched by .*; Bug 20001028.003 (#4536)';
         my $X = chr (1448);
         ok(my ($Y) = $X =~ /(.*)/, $message);
         is($Y, v1448, $message);
         is(length $Y, 1, $message);
 
         # Second half of the bug.
-        $message = 'HEBREW ACCENT QADMA in replacement; Bug 20001028.003';
+        $message = 'HEBREW ACCENT QADMA in replacement; Bug 20001028.003 (#4536)';
         $X = '';
         $X =~ s/^/chr(1488)/e;
         is(length $X, 1, $message);
@@ -72,7 +72,7 @@ sub run_tests {
     }
 
     {   
-        my $message = 'Repeated s///; Bug 20001108.001';
+        my $message = 'Repeated s///; Bug 20001108.001 (#4631)';
         my $X = "Szab\x{f3},Bal\x{e1}zs";
         my $Y = $X;
         $Y =~ s/(B)/$1/ for 0 .. 3;
@@ -81,7 +81,7 @@ sub run_tests {
     }
 
     {
-        my $message = 's/// on UTF-8 string; Bug 20000517.001';
+        my $message = 's/// on UTF-8 string; Bug 20000517.001 (#3253)';
         my $x = "\x{100}A";
         $x =~ s/A/B/;
         is($x, "\x{100}B", $message);
@@ -91,13 +91,13 @@ sub run_tests {
     {
         # The original bug report had 'no utf8' here but that was irrelevant.
 
-        my $message = "Don't dump core; Bug 20010306.008";
+        my $message = "Don't dump core; Bug 20010306.008 (#5982)";
         my $a = "a\x{1234}";
         like($a, qr/\w/, $message);  # used to core dump.
     }
 
     {
-        my $message = '/g in scalar context; Bug 20010410.006';
+        my $message = '/g in scalar context; Bug 20010410.006 (#6796)';
         for my $rx ('/(.*?)\{(.*?)\}/csg',
                    '/(.*?)\{(.*?)\}/cg',
                    '/(.*?)\{(.*?)\}/sg',
@@ -117,28 +117,28 @@ sub run_tests {
     {
         # Amazingly vertical tabulator is the same in ASCII and EBCDIC.
         for ("\n", "\t", "\014", "\r") {
-            unlike($_, qr/[[:print:]]/, sprintf "\\%03o not in [[:print:]]; Bug 20010619.003", ord $_);
+            unlike($_, qr/[[:print:]]/, sprintf "\\%03o not in [[:print:]]; Bug 20010619.003 (#7131)", ord $_);
         }
         for (" ") {
-            like($_, qr/[[:print:]]/, "'$_' in [[:print:]]; Bug 20010619.003");
+            like($_, qr/[[:print:]]/, "'$_' in [[:print:]]; Bug 20010619.003 (#7131)");
         }
     }
 
     {
-        # [ID 20010814.004] pos() doesn't work when using =~m// in list context
+        # [ID 20010814.004 (#7526)] pos() doesn't work when using =~m// in list context
 
         $_ = "ababacadaea";
         my $a = join ":", /b./gc;
         my $b = join ":", /a./gc;
         my $c = pos;
-        is("$a $b $c", 'ba:ba ad:ae 10', "pos() works with () = m//; Bug 20010814.004");
+        is("$a $b $c", 'ba:ba ad:ae 10', "pos() works with () = m//; Bug 20010814.004 (#7526)");
     }
 
     {
-        # [ID 20010407.006] matching utf8 return values from
+        # [ID 20010407.006 (#6767)] matching utf8 return values from
         # functions does not work
 
-        my $message = 'UTF-8 return values from functions; Bug 20010407.006';
+        my $message = 'UTF-8 return values from functions; Bug 20010407.006 (#6767)';
         package ID_20010407_006;
         sub x {"a\x{1234}"}
         my $x = x;
@@ -174,7 +174,7 @@ sub run_tests {
     }
 
     {
-        my $message = "s///eg [change 13f46d054db22cf4]; Bug 20020124.005";
+        my $message = "s///eg [change 13f46d054db22cf4]; Bug 20020124.005 (#8335)";
 
         for my $char ("a", "\x{df}", "\x{100}") {
             my $x = "$char b $char";
@@ -187,7 +187,7 @@ sub run_tests {
     }
 
     {
-        my $message = "Correct pmop flags checked when empty pattern; Bug 20020412.005";
+        my $message = "Correct pmop flags checked when empty pattern; Bug 20020412.005 (#8935)";
 
         # Requires reuse of last successful pattern.
         my $num = 123;
@@ -205,7 +205,7 @@ sub run_tests {
     }
 
     {
-        my $message = 'UTF-8 regex matches above 32k; Bug 20020630.002';
+        my $message = 'UTF-8 regex matches above 32k; Bug 20020630.002 (#10013)';
         for (['byte', "\x{ff}"], ['utf8', "\x{1ff}"]) {
             my ($type, $char) = @$_;
             for my $len (32000, 32768, 33000) {
index d116eb99510700de0f2d32d7fd3bfed13a651b0c..4bd8c4a86c6c57bd488bd0028ec2b61c26e23f96 100644 (file)
@@ -7,8 +7,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('../lib','.');
     require './test.pl';
+    set_up_inc( '../lib', '.' );
 }
 
 use strict;
index 593b44df400b849781ac91b396014c8073c1024d..dc24c879b0410a93844f09b00873b3622a12ed9f 100644 (file)
@@ -4,8 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 8;
index 1b27683332d9bdee06d8e5e8cb5010cbb329020f..5f41ae363f21e047fc4b5ca20f373b77e8c7fcdf 100644 (file)
@@ -5,9 +5,10 @@ BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
     skip_all_if_miniperl("no dynamic loading on miniperl, no Scalar::Util");
-    plan(tests => 14);
 }
 
+plan(tests => 14);
+
 # [perl 72922]: A 'copy' of a Regex object which has magic should not crash
 # When a Regex object was copied and the copy weaken then the original regex object
 # could no longer be 'copied' with qr//
index f2082cd4f1a9bbcf43ef7fa281fe5091d5c116d2..1d4605aea5027c88eb73da1a8ed62c79938f8b53 100644 (file)
--- a/t/re/qr.t
+++ b/t/re/qr.t
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 4;
index ca82f420efc96bd5bf98d43cebe26d1321246f62..ea2c3037170b985c9ca01fac317c466e92eb45c6 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     undef &Regexp::DESTROY;
 }
 
index 47d190d0559d165d433bf2f99c7e5ce81d912c1d..db5871c441d64e528f7b1aafec0258546c66c3ee 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 1;
index 7e8522da98a90686b5acfc81782f437889ee9cc2..b72b18a91325c9e2127d92c062acb5849b32a6dc 100644 (file)
@@ -957,12 +957,12 @@ tt+$      xxxtt   y       -       -
 (abc)?(abc)+   abc     y       $1:$2   :abc    -
 'b\s^'m        a\nb\n  n       -       -
 \ba    a       y       -       -
-^(a(??{"(?!)"})|(a)(?{1}))b    ab      y       $2      a       # [ID 20010811.006]
-ab(?i)cd       AbCd    n       -       -       # [ID 20010809.023]
+^(a(??{"(?!)"})|(a)(?{1}))b    ab      y       $2      a       # [ID 20010811.006 (#7512)]
+ab(?i)cd       AbCd    n       -       -       # [ID 20010809.023 (#7503)]
 ab(?i)cd       abCd    y       -       -
 (A|B)*(?(1)(CD)|(CD))  CD      y       $2-$3   -CD
 (A|B)*(?(1)(CD)|(CD))  ABCD    y       $2-$3   CD-
-(A|B)*?(?(1)(CD)|(CD)) CD      y       $2-$3   -CD     # [ID 20010803.016]
+(A|B)*?(?(1)(CD)|(CD)) CD      y       $2-$3   -CD     # [ID 20010803.016 (#7438)]
 (A|B)*?(?(1)(CD)|(CD)) ABCD    y       $2-$3   CD-
 '^(o)(?!.*\1)'i        Oo      n       -       -
 (.*)\d+\1      abc12bc y       $1      bc
index 222d1af3cd7fcdf3dfc61401628d8c4692a722bb..8c9b92e126dea967684291564c736cbe45130a80 100644 (file)
@@ -12,8 +12,8 @@ $| = 1;
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('../lib','.');
     require './test.pl';
+    set_up_inc( '../lib', '.' );
     skip_all_if_miniperl("no dynamic loading on miniperl, no re");
 }
 
index e370ca00714f5c89cfbd3398e85a8c74f93b0af2..ed74032a8e4b95fefdbf6069878e691dcd3731d8 100644 (file)
@@ -6,8 +6,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use utf8;
index 4fc9dfe0669a71b9385c61c0a68f59d55fb91eb7..7a57b66d3f14606dd44ae623231f94104238135f 100644 (file)
@@ -5,8 +5,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index a23a799f750e97416212df74e1e285296a8e89db..10529c2a52c0dda368030a5d94ec9022edd1ec42 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all_if_miniperl("no dynamic loading on miniperl, no File::Spec");
 }
 
index 3cf1d121d9453d5d9e49bcf184a580467ef9e2b5..5ca9b8ff007834680a2eed49e072b3e62c43f8c3 100644 (file)
@@ -4,12 +4,13 @@ $|=1;   # outherwise things get mixed up in output
 
 BEGIN {
        chdir 't' if -d 't';
-       @INC = qw '../lib ../ext/re';
        require './test.pl';
-       skip_all_without_unicode_tables();
+    set_up_inc( qw '../lib ../ext/re' );
        eval 'require Config'; # assume defaults if this fails
 }
 
+skip_all_without_unicode_tables();
+
 use strict;
 use open qw(:utf8 :std);
 
index 3380b257e2b4e68b0704c726b3ab18a68fdf7f75..b23dc8fda3399139ef802aa14f0edef11922bc92 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all_if_miniperl("no dynamic loading on miniperl, no Tie::Hash::NamedCapture");
 }
 
index f354ceab616a93b6bc20a7cb3539d41698ff5534..21ffe863f59960fa52fce11478f1e8069dafbd24 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 1db0bed3f619f18f4a82157aaff4882552da6516..a106e96b22984d7956ca3e2061bb9e0e81ba895c 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 0d66f5b456634e0ac2d76ac4acf0711509a2fe55..c8b573d75ca85434d7acca626a044ba1a663ad63 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index cd5df00ed0f2aa85c077df85f80b68fe5ad9c6ac..544d670dc6ad381014dd38a975437cf315938282 100644 (file)
@@ -7,13 +7,14 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('../lib','.','../ext/re');
     require './test.pl';
     require './charset_tools.pl';
     require './loc_tools.pl';
-    skip_all_without_unicode_tables();
+    set_up_inc( '../lib','.','../ext/re' );
 }
 
+skip_all_without_unicode_tables();
+
 use strict;
 use warnings;
 
@@ -175,6 +176,7 @@ for my $char ("٠", "٥", "٩") {
     fresh_perl_like('no warnings "experimental::regex_sets"; qr/(?[ ! ! (\w])/',
                     qr/^Unmatched \(/, {},
                     'qr/(?[ ! ! (\w])/ doesnt panic');
+
     # The following didn't panic before, but easy to add this here with a
     # paren between the !!
     fresh_perl_like('no warnings "experimental::regex_sets";qr/(?[ ! ( ! (\w)])/',
index 27cfe1a9c6b05f483fedd99ba7d4195a34710411..c05b0610ff593285ab640d8c1e39b9aa8cedba10 100644 (file)
@@ -7,13 +7,13 @@ $| = 1;
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('../lib','.','../ext/re');
     require './test.pl';
+    set_up_inc( '../lib', '.', '../ext/re' );
+}
     if (is_miniperl()) {
         skip_all_if_miniperl("Unicode tables not built yet", 2)
             unless eval 'require "unicore/Heavy.pl"';
     }
-}
 
 plan tests => 3;
 use strict;
index 648f2e9b749950c5feb580da4dce239ca96ec8ae..4a4830f60211e82d6cfa31fd05dfde0ae4e4869a 100644 (file)
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = ('../lib','.','../ext/re');
     require Config; import Config;
     require './test.pl';
-    skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
-    skip_all_without_unicode_tables();
+    set_up_inc('../lib','.','../ext/re');
 }
 
+skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
+skip_all_without_unicode_tables();
+
 plan tests => 58;  #** update watchdog timeouts proportionally when adding tests
 
 use strict;
@@ -119,6 +120,7 @@ sub run_tests {
         ok ($s !~ /.*?:::\s*ab/ms, 'PREGf_IMPLICIT/ms');
         ok ($s !~ /.*?:::\s*ab/msi,'PREGf_IMPLICIT/msi');
 
+
         for my $star ('*', '{0,}') {
             for my $greedy ('', '?') {
                 for my $flags ('', 'i', 'm', 'mi') {
@@ -129,7 +131,7 @@ TODO:
                         {
                             local $main::TODO = 'regdump gets mangled by the VMS pipe implementation' if $^O eq 'VMS';
                             fresh_perl_like(<<"PROG", qr/\b\Q$text\E\b/, {}, "/.${star}${greedy}X/${flags}${s} anchors implicitly");
-BEGIN { \@INC = ('../lib', '.', '../ext/re'); }
+BEGIN { require './test.pl'; set_up_inc('../lib', '.', '../ext/re'); }
 use re 'debug';
 qr/.${star}${greedy}:::\\s*ab/${flags}${s}
 PROG
@@ -140,6 +142,7 @@ PROG
         }
     }
 
+
     {
         # [perl #127855] Slowdown in m//g on COW strings of certain lengths
         # this should take milliseconds, but took 10's of seconds.
index 26a78c774d33d8b57a7cadeac7dacece08cfadc8..2de1a7b7bee2a8685a8a0ae51b30d5d9397c8e28 100644 (file)
@@ -996,7 +996,7 @@ SKIP:{
        /e;
     };
     is $locker{key}, '3', 'locking target in $hash{key} =~ s//.../e';
-    like $@, qr/^Modification of a read-only value/, 'err msg';
+    like $@, qr/^Modification of a read-only value/, 'err msg' . ($@ ? ": $@" : "");
 }
 delete $::{does_not_exist}; # just in case
 eval { no warnings; $::{does_not_exist}=~s/(?:)/*{"does_not_exist"}; 4/e };
index f05d95d2ac99b4b43d168fde2a86f377a05a0952..c6fac6513b341f226a55da7ad8a4e21c9d97fb64 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
index 4b5f7766d86324fbf630bf12310b3ce5e3c449cb..411ff04b9ce02f06a28ad3a22b5185751e60a6ba 100644 (file)
@@ -563,13 +563,13 @@ EOT
 EXPECT
 ok
 ########
-# [ID 20001202.002] and change #8066 added 'at -e line 1';
+# [ID 20001202.002 (#4821)] and change #8066 added 'at -e line 1';
 # reversed again as a result of [perl #17763]
 die qr(x)
 EXPECT
 (?^:x)
 ########
-# 20001210.003 mjd@plover.com
+# 20001210.003 (#4893) mjd@plover.com
 format REMITOUT_TOP =
 FOO
 .
@@ -615,11 +615,11 @@ new_pmop "abcdef"; reset;
 close STDERR; die;
 EXPECT
 ########
-# core dump in 20000716.007
+# core dump in 20000716.007 (#3516)
 -w
 "x" =~ /(\G?x)?/;
 ########
-# Bug 20010515.004
+# Bug 20010515.004 (#6998)
 my @h = 1 .. 10;
 bad(@h);
 sub bad {
@@ -632,7 +632,7 @@ EXPECT
 O
 Use of freed value in iteration at - line 7.
 ########
-# Bug 20010506.041
+# Bug 20010506.041 (#6952)
 "abcd\x{1234}" =~ /(a)(b[c])(d+)?/i and print "ok\n";
 EXPECT
 ok
@@ -663,13 +663,13 @@ Bar=ARRAY(0x...)
 BEGIN { print "ok\n" }
 EXPECT
 ok
-######## scalar ref to file test operator segfaults on 5.6.1 [ID 20011127.155]
+######## scalar ref to file test operator segfaults on 5.6.1 [ID 20011127.155 (#7947)]
 # This only happens if the filename is 11 characters or less.
 $foo = \-f "blah";
 print "ok" if ref $foo && !$$foo;
 EXPECT
 ok
-######## [ID 20011128.159] 'X' =~ /\X/ segfault in 5.6.1
+######## [ID 20011128.159 (#7951)] 'X' =~ /\X/ segfault in 5.6.1
 print "ok" if 'X' =~ /\X/;
 EXPECT
 ok
@@ -725,7 +725,7 @@ $code = eval q[
 print $x;
 EXPECT
 ok 1
-######## [ID 20020623.009] nested eval/sub segfaults
+######## [ID 20020623.009 (#9728)] nested eval/sub segfaults
 $eval = eval 'sub { eval "sub { %S }" }';
 $eval->({});
 ######## [perl #17951] Strange UTF error
index acb299561bb021040237de8a91b8fa81ba769f6a..43f31bf9b9e06723b4462373a5db077b90cf7a51 100644 (file)
@@ -26,7 +26,7 @@ END {
                   { stderr => 1 },
                   "No perlio debug file without -Di...");
     ok(!-e $perlio_log, "...no perlio.txt found");
-    fresh_perl_is("print qq(hello\n)", "\nEXECUTING...\n\nhello\n",
+    fresh_perl_like("print qq(hello\n)", qr/\nEXECUTING...\n{1,2}hello\n?/,
                   { stderr => 1, switches => [ "-Di" ] },
                   "Perlio debug file with both -Di and PERLIO_DEBUG...");
     ok(-e $perlio_log, "... perlio debugging file found with -Di and PERLIO_DEBUG");
index aa9bda38596e765eb03ee301667c7fb57945f133..0018a74dd65f73417358b990b7b21669c3821e91 100644 (file)
@@ -165,7 +165,7 @@ SWTEST
     is( $r, 'foo1', '-s on the shebang line' );
 }
 
-# Bug ID 20011106.084
+# Bug ID 20011106.084 (#7876)
 $filename = tempfile();
 SKIP: {
     open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
index 20d08e9af26a78ef89c780067ecd4720cad38812..349bcc9e3f3bb9b48dd811c2c9a633b98f755a73 100644 (file)
--- a/t/test.pl
+++ b/t/test.pl
@@ -964,6 +964,9 @@ sub fresh_perl {
     # returned, with $? set to the exit code.  Unless overridden, stderr is
     # redirected to stdout.
 
+    die sprintf "Third argument to fresh_perl_.* must be hashref of args to fresh_perl (or {})"
+        unless !(defined $runperl_args) || ref($runperl_args) eq 'HASH';
+
     # Given the choice of the mis-parsable {}
     # (we want an anon hash, but a borked lexer might think that it's a block)
     # or relying on taking a reference to a lexical
index 6dcc807634b5d996d1d538a6a0a4233fad270675..4a0cbdcd8a66a72ac005bf0be35bd4b141d133a5 100644 (file)
@@ -34,7 +34,7 @@ note('running tests in a new thread');
 # Same on AIX
 my $curr = threads->create({
                             stack_size => $^O eq 'hpux'   ? 524288 :
-                                          $^O eq 'darwin' ? 1000000:
+                                          $^O eq 'darwin' ? 2000000:
                                           $^O eq 'VMS'    ? 150000 :
                                           $^O eq 'aix'    ? 1000000 : 0,
                            }, sub {
index be064b992ab33c5dd8b3370f6673ff3de7adf7e7..98f676e6a85b3e9f9c249b3c48cc35a2f8f81ac5 100644 (file)
@@ -4,8 +4,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     skip_all_if_miniperl("miniperl can't load attributes");
 }
 
index 5475f3ee7314c581bfa9556ae06de98c80db380e..fe81485aab04cd01e1531c8c047ea9f1791343fd 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use utf8;
index b98ae07c4f07f1312d6ed971288a36e265ceaf08..de314b0a31319ced2eb008e2e55fc7f2b37423c5 100644 (file)
@@ -3,8 +3,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     plan( tests => 18 );
 }
 
@@ -24,7 +24,7 @@ sub { @c = caller(0) } -> ();
 ::is( $c[3], "main::__ANON__", "anonymous subroutine name" );
 ::ok( $c[4], "hasargs true with anon sub" );
 
-# Bug 20020517.003, used to dump core
+# Bug 20020517.003 (#9367), used to dump core
 sub foo { @c = caller(0) }
 my $fooref = delete $main::{foo};
 $fooref -> ();
index c3d5926cb83bdb876a06244296e694301e8c22d8..a391fe385a288e45c12cbed79cff5a7d2422ed68 100644 (file)
@@ -1,5 +1,5 @@
 BEGIN {
-    require "test.pl";
+    require "./test.pl";
     set_up_inc(qw(../lib .));
     skip_all_without_unicode_tables();
 }
index da48910ffb02fdb465fcda85f841500edb8ac760..f5188317dad912b48fe894ca723605f14e0932b2 100644 (file)
@@ -219,7 +219,7 @@ is (*{*Ẋ{GLOB}}, "*main::STDOUT");
     is ($state, 'ok');
 }
 
-# [ID 20010526.001] localized glob loses value when assigned to
+# [ID 20010526.001 (#7038)] localized glob loses value when assigned to
 
 $J=1; %J=(a=>1); @J=(1); local *J=*J; *J = sub{};
 
index c257dbce8bfc0d31b37e0becca78e82bda1ca5e3..ada31403e31df38e586bd44de543615b5e9a3f7e 100644 (file)
@@ -2,8 +2,8 @@
 # tests that utf8_heavy.pl doesn't use anything that prevents it loading
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 plan tests => 1;
index c7f447f8efcce16d3392b31c412f2504becf87f1..2913050017fc08b9170b3f3dc133694fe787ce93 100644 (file)
@@ -6,8 +6,8 @@ BEGIN {
     $| = 1;
 
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
     require './charset_tools.pl';
     skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader;
     skip_all_without_unicode_tables();
index 4a12e3d5871d5dfb57982d0780442a2b6b1368e0..cc710ef11280ecb91a38f3f3b35ba18b163b7f0d 100644 (file)
@@ -6,8 +6,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(. ../lib ../cpan/parent/lib);
     require "./test.pl"; require './charset_tools.pl';
+    set_up_inc( qw(. ../lib ../cpan/parent/lib) );
 }
 
 use strict;
index 7bc90246af1094b1d598595db981bf52c96bdb78..a16d9895db2173d2f9e66e07d887cae4d29c0371 100644 (file)
@@ -6,8 +6,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw '../lib ../dist/base/lib';
     require './test.pl';
+    set_up_inc(qw '../lib ../dist/base/lib');
 }
 
 use utf8;
index eb8d32a27cd908478c607abcb0f42f188ce82b37..d7d541c94e11ac0e89526649e8f8da689cc91627 100644 (file)
@@ -2,11 +2,11 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require Config; import Config;
     require './test.pl';
     require './charset_tools.pl';
     require './loc_tools.pl';
+    set_up_inc( '../lib' );
 }
 
 plan(tests => 215);
index ad905b01b0b9d522078236b9b191ace9588ed040..6c524b2e2f7c5af2695b4b02ba2080f521ab809d 100644 (file)
@@ -9,7 +9,7 @@ BEGIN {
     skip_all_without_unicode_tables();
 }
 
-plan (tests => 52);
+plan (tests => 55);
 
 use utf8;
 use open qw( :utf8 :std );
@@ -228,3 +228,35 @@ like( $@, qr/Bad name after Foo'/, 'Bad name after Foo\'' );
 
         {stderr => 1}, "RT# 124216");
 }
+
+SKIP: {   # [perl #128738]
+    use Config;
+    if ($Config{uvsize} < 8) {
+        skip("test is only valid on 64-bit ints", 2);
+    }
+    else {
+        no warnings 'deprecated';
+        my $a;
+        eval "\$a = q \x{ffffffff}Hello, \\\\whirled!\x{ffffffff}";
+        is $@, "",
+               "No errors in eval'ing a string with large code point delimiter";
+        is $a, 'Hello, \whirled!',
+               "Got expected result in eval'ing a string with a large code point"
+            . " delimiter";
+    }
+}
+
+
+# New tests go here ^^^^^
+
+# Keep this test last, as it will mess up line number reporting for any
+# subsequent tests.
+
+<<END;
+${
+#line 57
+qq ϟϟ }
+END
+is __LINE__, 59, '#line directive and qq with uni delims inside heredoc';
+
+# Put new tests above the line number tests.
index 0e00105398bf22434862a4b7d7e97a849665c46e..de0cb5ed76c82f1ba380a2fd4da0e41c285335a4 100644 (file)
@@ -6,8 +6,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = '../lib';
     require './test.pl';
+    set_up_inc('../lib');
 }
 
 use utf8;
index 258ab541b45795c24ee7a9e5e58cf802704ce0b0..58202395e84dce5926fcfaf70c3797b3b18e151e 100644 (file)
@@ -2,8 +2,8 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw(../lib .);
     require "./test.pl";
+    set_up_inc(qw(../lib .));
 }
 
 plan tests => 52;
@@ -113,7 +113,7 @@ $c = 0x200;
 }
 
 {
-    # 20010407.008 sprintf removes utf8-ness
+    # 20010407.008 (#6769) sprintf removes utf8-ness
     $a = sprintf "\x{1234}";
     is((sprintf "%x %d", unpack("U*", $a), length($a)),    "1234 1",
        '\x{1234}');
index 56b41d44d9b4d2bd328303d3ff2c90c4cf665761..0874bed604f78d03876855f064f17195811b6669 100644 (file)
@@ -5,9 +5,9 @@
 
 BEGIN {
     chdir 't' if -d 't';
-    @INC = qw '../lib ../dist/base/lib';
     $| = 1;
     require "./test.pl";
+    set_up_inc(qw '../lib ../dist/base/lib');
 }
 
 use utf8;
diff --git a/toke.c b/toke.c
index abf0377addea82d022396f9c36571cf27194cd17..2da8366203404d4dff5814b55d03e6d71b8832a2 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -64,7 +64,6 @@ Individual members of C<PL_parser> have their own documentation.
 #define PL_multi_open          (PL_parser->multi_open)
 #define PL_multi_close         (PL_parser->multi_close)
 #define PL_preambled           (PL_parser->preambled)
-#define PL_sublex_info         (PL_parser->sublex_info)
 #define PL_linestr             (PL_parser->linestr)
 #define PL_expect              (PL_parser->expect)
 #define PL_copline             (PL_parser->copline)
@@ -555,26 +554,39 @@ S_no_op(pTHX_ const char *const what, char *s)
 STATIC void
 S_missingterm(pTHX_ char *s)
 {
-    char tmpbuf[3];
+    char tmpbuf[UTF8_MAXBYTES + 1];
     char q;
+    bool uni = FALSE;
+    SV *sv;
     if (s) {
        char * const nl = strrchr(s,'\n');
        if (nl)
            *nl = '\0';
+       uni = UTF;
     }
-    else if ((U8) PL_multi_close < 32) {
+    else if (PL_multi_close < 32) {
        *tmpbuf = '^';
        tmpbuf[1] = (char)toCTRL(PL_multi_close);
        tmpbuf[2] = '\0';
        s = tmpbuf;
     }
     else {
-       *tmpbuf = (char)PL_multi_close;
-       tmpbuf[1] = '\0';
+       if (LIKELY(PL_multi_close < 256)) {
+           *tmpbuf = (char)PL_multi_close;
+           tmpbuf[1] = '\0';
+       }
+       else {
+           uni = TRUE;
+           *uvchr_to_utf8((U8 *)tmpbuf, PL_multi_close) = 0;
+       }
        s = tmpbuf;
     }
     q = strchr(s,'"') ? '\'' : '"';
-    Perl_croak(aTHX_ "Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
+    sv = sv_2mortal(newSVpv(s,0));
+    if (uni)
+       SvUTF8_on(sv);
+    Perl_croak(aTHX_ "Can't find string terminator %c%"SVf
+                    "%c anywhere before EOF",q,SVfARG(sv),q);
 }
 
 #include "feature.h"
@@ -761,7 +773,7 @@ Perl_parser_free(pTHX_  const yy_parser *parser)
        PerlIO_close(parser->rsfp);
     SvREFCNT_dec(parser->rsfp_filters);
     SvREFCNT_dec(parser->lex_stuff);
-    SvREFCNT_dec(parser->sublex_info.repl);
+    SvREFCNT_dec(parser->lex_sub_repl);
 
     Safefree(parser->lex_brackstack);
     Safefree(parser->lex_casestack);
@@ -1767,9 +1779,6 @@ S_incline(pTHX_ const char *s)
     CopLINE_set(PL_curcop, line_num);
 }
 
-#define skipspace(s) skipspace_flags(s, 0)
-
-
 STATIC void
 S_update_debugger_info(pTHX_ SV *orig_sv, const char *const buf, STRLEN len)
 {
@@ -1796,11 +1805,19 @@ S_update_debugger_info(pTHX_ SV *orig_sv, const char *const buf, STRLEN len)
 }
 
 /*
- * S_skipspace
+ * skipspace
  * Called to gobble the appropriate amount and type of whitespace.
  * Skips comments as well.
+ * Returns the next character after the whitespace that is skipped.
+ *
+ * peekspace
+ * Same thing, but look ahead without incrementing line numbers or
+ * adjusting PL_linestart.
  */
 
+#define skipspace(s) skipspace_flags(s, 0)
+#define peekspace(s) skipspace_flags(s, LEX_NO_INCLINE)
+
 STATIC char *
 S_skipspace_flags(pTHX_ char *s, U32 flags)
 {
@@ -2303,9 +2320,9 @@ S_sublex_start(pTHX)
        return THING;
     }
 
-    PL_sublex_info.super_state = PL_lex_state;
-    PL_sublex_info.sub_inwhat = (U16)op_type;
-    PL_sublex_info.sub_op = PL_lex_op;
+    PL_parser->lex_super_state = PL_lex_state;
+    PL_parser->lex_sub_inwhat = (U16)op_type;
+    PL_parser->lex_sub_op = PL_lex_op;
     PL_lex_state = LEX_INTERPPUSH;
 
     PL_expect = XTERM;
@@ -2333,7 +2350,7 @@ S_sublex_push(pTHX)
     const bool is_heredoc = PL_multi_close == '<';
     ENTER;
 
-    PL_lex_state = PL_sublex_info.super_state;
+    PL_lex_state = PL_parser->lex_super_state;
     SAVEI8(PL_lex_dojoin);
     SAVEI32(PL_lex_brackets);
     SAVEI32(PL_lex_allbrackets);
@@ -2352,7 +2369,7 @@ S_sublex_push(pTHX)
        SAVEI32(PL_parser->herelines);
        PL_parser->herelines = 0;
     }
-    SAVEI8(PL_multi_close);
+    SAVEIV(PL_multi_close);
     SAVEPPTR(PL_bufptr);
     SAVEPPTR(PL_bufend);
     SAVEPPTR(PL_oldbufptr);
@@ -2375,16 +2392,16 @@ S_sublex_push(pTHX)
     PL_parser->lex_shared->ls_bufptr  = PL_bufptr;
 
     PL_linestr = PL_lex_stuff;
-    PL_lex_repl = PL_sublex_info.repl;
+    PL_lex_repl = PL_parser->lex_sub_repl;
     PL_lex_stuff = NULL;
-    PL_sublex_info.repl = NULL;
+    PL_parser->lex_sub_repl = NULL;
 
     /* Arrange for PL_lex_stuff to be freed on scope exit, in case it gets
        set for an inner quote-like operator and then an error causes scope-
        popping.  We must not have a PL_lex_stuff value left dangling, as
        that breaks assumptions elsewhere.  See bug #123617.  */
     SAVEGENERICSV(PL_lex_stuff);
-    SAVEGENERICSV(PL_sublex_info.repl);
+    SAVEGENERICSV(PL_parser->lex_sub_repl);
 
     PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart
        = SvPVX(PL_linestr);
@@ -2411,10 +2428,10 @@ S_sublex_push(pTHX)
     shared->ls_prev = PL_parser->lex_shared;
     PL_parser->lex_shared = shared;
 
-    PL_lex_inwhat = PL_sublex_info.sub_inwhat;
+    PL_lex_inwhat = PL_parser->lex_sub_inwhat;
     if (PL_lex_inwhat == OP_TRANSR) PL_lex_inwhat = OP_TRANS;
     if (PL_lex_inwhat == OP_MATCH || PL_lex_inwhat == OP_QR || PL_lex_inwhat == OP_SUBST)
-       PL_lex_inpat = PL_sublex_info.sub_op;
+       PL_lex_inpat = PL_parser->lex_sub_op;
     else
        PL_lex_inpat = NULL;
 
@@ -2844,10 +2861,10 @@ S_scan_const(pTHX_ char *start)
     PERL_ARGS_ASSERT_SCAN_CONST;
 
     assert(PL_lex_inwhat != OP_TRANSR);
-    if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) {
+    if (PL_lex_inwhat == OP_TRANS && PL_parser->lex_sub_op) {
        /* If we are doing a trans and we know we want UTF8 set expectation */
-       has_utf8   = PL_sublex_info.sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF);
-       this_utf8  = PL_sublex_info.sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF);
+       has_utf8   = PL_parser->lex_sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF);
+       this_utf8  = PL_parser->lex_sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF);
     }
 
     /* Protect sv from errors and fatal warnings. */
@@ -3086,8 +3103,7 @@ S_scan_const(pTHX_ char *start)
 
                 /* Subtract 3 for the bytes that were already accounted for
                  * (min, max, and the hyphen) */
-                SvGROW(sv, SvLEN(sv) + grow - 3);
-               d = SvPVX(sv) + save_offset;    /* refresh d after realloc */
+                d = save_offset + SvGROW(sv, SvLEN(sv) + grow - 3);
 
                 /* Here, we expand out the range.  On ASCII platforms, the
                  * compiler should optimize out the 'convert_unicode==TRUE'
@@ -3386,9 +3402,9 @@ S_scan_const(pTHX_ char *start)
 
                        d = (char*)uvchr_to_utf8((U8*)d, uv);
                        if (PL_lex_inwhat == OP_TRANS
-                            && PL_sublex_info.sub_op)
+                            && PL_parser->lex_sub_op)
                         {
-                           PL_sublex_info.sub_op->op_private |=
+                           PL_parser->lex_sub_op->op_private |=
                                (PL_lex_repl ? OPpTRANS_FROM_UTF
                                             : OPpTRANS_TO_UTF);
                        }
@@ -3521,7 +3537,7 @@ S_scan_const(pTHX_ char *start)
                        }
 
                         /* Add the (Unicode) code point to the output. */
-                       if (OFFUNI_IS_INVARIANT(uv)) {
+                       if (! has_utf8 || OFFUNI_IS_INVARIANT(uv)) {
                            *d++ = (char) LATIN1_TO_NATIVE(uv);
                        }
                        else {
@@ -3665,9 +3681,9 @@ S_scan_const(pTHX_ char *start)
                         }
                         else if (! SvUTF8(res)) {
                             /* Make sure \N{} return is UTF-8.  This is because
-                            * \N{} implies Unicode semantics, and scalars have to
-                            * be in utf8 to guarantee those semantics; but not
-                            * needed in tr/// */
+                             * \N{} implies Unicode semantics, and scalars have
+                             * to be in utf8 to guarantee those semantics; but
+                             * not needed in tr/// */
                             sv_utf8_upgrade_flags(res, SV_UTF8_NO_ENCODING);
                             str = SvPV_const(res, len);
                         }
@@ -3801,8 +3817,8 @@ S_scan_const(pTHX_ char *start)
     SvPOK_on(sv);
     if (has_utf8) {
        SvUTF8_on(sv);
-       if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) {
-           PL_sublex_info.sub_op->op_private |=
+       if (PL_lex_inwhat == OP_TRANS && PL_parser->lex_sub_op) {
+           PL_parser->lex_sub_op->op_private |=
                    (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF);
        }
     }
@@ -4084,8 +4100,11 @@ S_intuit_method(pTHX_ char *start, SV *ioname, CV *cv)
            tmpbuf[len] = '\0';
            goto bare_package;
        }
-       indirgv = gv_fetchpvn_flags(tmpbuf, len, ( UTF ? SVf_UTF8 : 0 ), SVt_PVCV);
-       if (indirgv && GvCVu(indirgv))
+       indirgv = gv_fetchpvn_flags(tmpbuf, len,
+                                   GV_NOADD_NOINIT|( UTF ? SVf_UTF8 : 0 ),
+                                   SVt_PVCV);
+       if (indirgv && SvTYPE(indirgv) != SVt_NULL
+        && (!isGV(indirgv) || GvCVu(indirgv)))
            return 0;
        /* filehandle or package name makes it a method */
        if (!cv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, UTF ? SVf_UTF8 : 0)) {
@@ -4391,7 +4410,7 @@ S_tokenize_use(pTHX_ int is_use, char *s) {
     static const char* const exp_name[] =
        { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "ATTRBLOCK",
          "ATTRTERM", "TERMBLOCK", "XBLOCKTERM", "POSTDEREF",
-         "TERMORDORDOR"
+         "SIGVAR", "TERMORDORDOR"
        };
 #endif
 
@@ -4695,7 +4714,7 @@ Perl_yylex(pTHX)
            PL_lex_dojoin = FALSE;
            PL_lex_state = LEX_INTERPCONCAT;
            PL_lex_allbrackets--;
-           return REPORT(dojoin_was == 1 ? ')' : POSTJOIN);
+           return REPORT(dojoin_was == 1 ? (int)')' : (int)POSTJOIN);
        }
        if (PL_lex_inwhat == OP_SUBST && PL_linestr == PL_lex_repl
            && SvEVALED(PL_lex_repl))
@@ -4795,6 +4814,68 @@ Perl_yylex(pTHX)
     PL_oldbufptr = s;
     PL_parser->saw_infix_sigil = 0;
 
+    if (PL_in_my == KEY_sigvar) {
+        /* we expect the sigil and optional var name part of a
+         * signature element here. Since a '$' is not necessarily
+         * followed by a var name, handle it specially here; the general
+         * yylex code would otherwise try to interpret whatever follows
+         * as a var; e.g. ($, ...) would be seen as the var '$,'
+         */
+
+        char sigil;
+
+        s = skipspace(s);
+        sigil = *s++;
+        PL_bufptr = s; /* for error reporting */
+        switch (sigil) {
+        case '$':
+        case '@':
+        case '%':
+            /* spot stuff that looks like an prototype */
+            if (strchr("$:@%&*;\\[]", *s)) {
+                yyerror("Illegal character following sigil in a subroutine signature");
+                break;
+            }
+            /* '$#' is banned, while '$ # comment' isn't */
+            if (*s == '#') {
+                yyerror("'#' not allowed immediately following a sigil in a subroutine signature");
+                break;
+            }
+            s = skipspace(s);
+            if (isIDFIRST_lazy_if(s, UTF)) {
+                char *dest = PL_tokenbuf + 1;
+                /* read var name, including sigil, into PL_tokenbuf */
+                PL_tokenbuf[0] = sigil;
+                parse_ident(&s, &dest, dest + sizeof(PL_tokenbuf) - 1,
+                    0, cBOOL(UTF), FALSE);
+                *dest = '\0';
+                assert(PL_tokenbuf[1]); /* we have a variable name */
+                NEXTVAL_NEXTTOKE.ival = sigil;
+                force_next('p'); /* force a signature pending identifier */
+            }
+            else
+                PL_in_my = 0;
+            PL_expect = XOPERATOR;
+            break;
+
+        case ')':
+            PL_expect = XBLOCK;
+            break;
+        case ',': /* handle ($a,,$b) */
+            break;
+
+        default:
+            PL_in_my = 0;
+            yyerror("A signature parameter must start with '$', '@' or '%'");
+            /* very crude error recovery: skip to likely next signature
+             * element */
+            while (*s && *s != '$' && *s != '@' && *s != '%' && *s != ')')
+                s++;
+            break;
+        }
+        TOKEN(sigil);
+    }
+
   retry:
     switch (*s) {
     default:
@@ -6820,7 +6901,7 @@ Perl_yylex(pTHX)
            bool arrow;
            STRLEN bufoff = PL_bufptr - SvPVX(PL_linestr);
            STRLEN   soff = s         - SvPVX(PL_linestr);
-           s = skipspace_flags(s, LEX_NO_INCLINE);
+           s = peekspace(s);
            arrow = *s == '=' && s[1] == '>';
            PL_bufptr = SvPVX(PL_linestr) + bufoff;
            s         = SvPVX(PL_linestr) +   soff;
@@ -8462,6 +8543,9 @@ Perl_yylex(pTHX)
 
   Looks up an identifier in the pad or in a package
 
+  is_sig indicates that this is a subroutine signature variable
+  rather than a plain pad var.
+
   Returns:
     PRIVATEREF if this is a lexical name.
     BAREWORD   if this belongs to a package.
@@ -8504,6 +8588,7 @@ S_pending_ident(pTHX)
             tmp = allocmy(PL_tokenbuf, tokenbuf_len, UTF ? SVf_UTF8 : 0);
         }
         else {
+            OP *o;
             if (has_colon) {
                 /* "my" variable %s can't be in a package */
                 /* PL_no_myglob is constant */
@@ -8516,9 +8601,29 @@ S_pending_ident(pTHX)
                 GCC_DIAG_RESTORE;
             }
 
-            pl_yylval.opval = newOP(OP_PADANY, 0);
-            pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,
+            if (PL_in_my == KEY_sigvar) {
+                /* A signature 'padop' needs in addition, an op_first to
+                 * point to a child sigdefelem, and an extra field to hold
+                 * the signature index. We can achieve both by using an
+                 * UNOP_AUX and (ab)using the op_aux field to hold the
+                 * index. If we ever need more fields, use a real malloced
+                 * aux strut instead.
+                 */
+                o = newUNOP_AUX(OP_ARGELEM, 0, NULL,
+                                    INT2PTR(UNOP_AUX_item *,
+                                        (PL_parser->sig_elems)));
+                o->op_private |= (  PL_tokenbuf[0] == '$' ? OPpARGELEM_SV
+                                  : PL_tokenbuf[0] == '@' ? OPpARGELEM_AV
+                                  :                         OPpARGELEM_HV);
+            }
+            else
+                o = newOP(OP_PADANY, 0);
+            o->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,
                                                         UTF ? SVf_UTF8 : 0);
+            if (PL_in_my == KEY_sigvar)
+                PL_in_my = 0;
+
+            pl_yylval.opval = o;
            return PRIVATEREF;
         }
     }
@@ -8558,8 +8663,8 @@ S_pending_ident(pTHX)
     }
 
     /*
-       Whine if they've said @foo in a doublequoted string,
-       and @foo isn't a variable we can find in the symbol
+       Whine if they've said @foo or @foo{key} in a doublequoted string,
+       and @foo (or %foo) isn't a variable we can find in the symbol
        table.
     */
     if (ckWARN(WARN_AMBIGUOUS)
@@ -8568,11 +8673,9 @@ S_pending_ident(pTHX)
         && !PL_lex_brackets)
     {
         GV *const gv = gv_fetchpvn_flags(PL_tokenbuf + 1, tokenbuf_len - 1,
-                                        ( UTF ? SVf_UTF8 : 0 ), SVt_PVAV);
+                                         ( UTF ? SVf_UTF8 : 0 ) | GV_ADDMG,
+                                         SVt_PVAV);
         if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
-               /* DO NOT warn for @- and @+ */
-               && !( PL_tokenbuf[2] == '\0'
-                      && ( PL_tokenbuf[1] == '-' || PL_tokenbuf[1] == '+' ))
           )
         {
             /* Downgraded from fatal to warning 20000522 mjd */
@@ -8976,6 +9079,8 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
     else if (ck_uni && bracket == -1)
        check_uni();
     if (bracket != -1) {
+        bool skip;
+        char *s2;
         /* If we were processing {...} notation then...  */
        if (isIDFIRST_lazy_if(d,is_utf8)) {
             /* if it starts as a valid identifier, assume that it is one.
@@ -9024,13 +9129,19 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
 
         if ( !tmp_copline )
             tmp_copline = CopLINE(PL_curcop);
-        if (s < PL_bufend && isSPACE(*s)) {
-            s = skipspace(s);
-        }
+        if ((skip = s < PL_bufend && isSPACE(*s)))
+            /* Avoid incrementing line numbers or resetting PL_linestart,
+               in case we have to back up.  */
+            s2 = peekspace(s);
+        else
+            s2 = s;
            
         /* Expect to find a closing } after consuming any trailing whitespace.
          */
-       if (*s == '}') {
+        if (*s2 == '}') {
+            /* Now increment line numbers if applicable.  */
+            if (skip)
+                s = skipspace(s);
            s++;
            if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
                PL_lex_state = LEX_INTERPEND;
@@ -9312,15 +9423,15 @@ S_scan_subst(pTHX_ char *start)
                sv_catpvs(repl, "do ");
        }
        sv_catpvs(repl, "{");
-       sv_catsv(repl, PL_sublex_info.repl);
+       sv_catsv(repl, PL_parser->lex_sub_repl);
        sv_catpvs(repl, "}");
        SvEVALED_on(repl);
-       SvREFCNT_dec(PL_sublex_info.repl);
-       PL_sublex_info.repl = repl;
+       SvREFCNT_dec(PL_parser->lex_sub_repl);
+       PL_parser->lex_sub_repl = repl;
     }
     if (CopLINE(PL_curcop) != first_line) {
-       sv_upgrade(PL_sublex_info.repl, SVt_PVNV);
-       ((XPVNV*)SvANY(PL_sublex_info.repl))->xnv_u.xpad_cop_seq.xlow =
+       sv_upgrade(PL_parser->lex_sub_repl, SVt_PVNV);
+       ((XPVNV*)SvANY(PL_parser->lex_sub_repl))->xnv_u.xpad_cop_seq.xlow =
            CopLINE(PL_curcop) - first_line;
        CopLINE_set(PL_curcop, first_line);
     }
@@ -9384,7 +9495,7 @@ S_scan_trans(pTHX_ char *start)
     o->op_private &= ~OPpTRANS_ALL;
     o->op_private |= del|squash|complement|
       (DO_UTF8(PL_lex_stuff)? OPpTRANS_FROM_UTF : 0)|
-      (DO_UTF8(PL_sublex_info.repl) ? OPpTRANS_TO_UTF   : 0);
+      (DO_UTF8(PL_parser->lex_sub_repl) ? OPpTRANS_TO_UTF   : 0);
 
     PL_lex_op = o;
     pl_yylval.ival = nondestruct ? OP_TRANSR : OP_TRANS;
@@ -9917,7 +10028,7 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re
     char *to;                  /* current position in the sv's data */
     I32 brackets = 1;          /* bracket nesting level */
     bool has_utf8 = FALSE;     /* is there any utf8 content? */
-    I32 termcode;              /* terminating char. code */
+    IV termcode;               /* terminating char. code */
     U8 termstr[UTF8_MAXBYTES]; /* terminating string */
     STRLEN termlen;            /* length of terminating string */
     line_t herelines;
@@ -9947,14 +10058,14 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re
 
     /* mark where we are */
     PL_multi_start = CopLINE(PL_curcop);
-    PL_multi_open = term;
+    PL_multi_open = termcode;
     herelines = PL_parser->herelines;
 
     /* find corresponding closing delimiter */
     if (term && (tmps = strchr("([{< )]}> )]}>",term)))
        termcode = termstr[0] = term = tmps[5];
 
-    PL_multi_close = term;
+    PL_multi_close = termcode;
 
     if (PL_multi_open == PL_multi_close) {
         keep_bracketed_quoted = FALSE;
@@ -10020,7 +10131,8 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re
                /* backslashes can escape the open or closing characters */
                if (*s == '\\' && s+1 < PL_bufend) {
                    if (!keep_bracketed_quoted
-                       && ((s[1] == PL_multi_open) || (s[1] == PL_multi_close)))
+                       && ( ((UV)s[1] == PL_multi_open)
+                         || ((UV)s[1] == PL_multi_close) ))
                     {
                        s++;
                     }
@@ -10028,9 +10140,9 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re
                        *to++ = *s++;
                 }
                /* allow nested opens and closes */
-               else if (*s == PL_multi_close && --brackets <= 0)
+               else if ((UV)*s == PL_multi_close && --brackets <= 0)
                    break;
-               else if (*s == PL_multi_open)
+               else if ((UV)*s == PL_multi_open)
                    brackets++;
                else if (!has_utf8 && !UTF8_IS_INVARIANT((U8)*s) && UTF)
                    has_utf8 = TRUE;
@@ -10101,7 +10213,7 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re
     */
 
     if (PL_lex_stuff)
-       PL_sublex_info.repl = sv;
+       PL_parser->lex_sub_repl = sv;
     else
        PL_lex_stuff = sv;
     if (delimp) *delimp = PL_multi_open == PL_multi_close ? s-termlen : s;
@@ -10460,6 +10572,14 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 #ifdef NV_MIN_EXP
                                 if (negexp
                                     && -hexfp_exp < NV_MIN_EXP - 1) {
+                                    /* NOTE: this means that the exponent
+                                     * underflow warning happens for
+                                     * the IEEE 754 subnormals (denormals),
+                                     * because DBL_MIN_EXP etc are the lowest
+                                     * possible binary (or, rather, DBL_RADIX-base)
+                                     * exponent for normals, not subnormals.
+                                     *
+                                     * This may or may not be a good thing. */
                                     Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW),
                                                    "Hexadecimal float: exponent underflow");
                                     break;
@@ -10481,7 +10601,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
 #ifdef HEXFP_UQUAD
                         hexfp_exp -= hexfp_frac_bits;
 #endif
-                        hexfp_mult = pow(2.0, hexfp_exp);
+                        hexfp_mult = Perl_pow(2.0, hexfp_exp);
                         hexfp = TRUE;
                         goto decimal;
                     }
@@ -11725,219 +11845,6 @@ Perl_parse_stmtseq(pTHX_ U32 flags)
     return stmtseqop;
 }
 
-#define parse_opt_lexvar() S_parse_opt_lexvar(aTHX)
-static OP *
-S_parse_opt_lexvar(pTHX)
-{
-    I32 sigil, c;
-    char *s, *d;
-    OP *var;
-    lex_token_boundary();
-    sigil = lex_read_unichar(0);
-    if (lex_peek_unichar(0) == '#') {
-       qerror(Perl_mess(aTHX_ "Parse error"));
-       return NULL;
-    }
-    lex_read_space(0);
-    c = lex_peek_unichar(0);
-    if (c == -1 || !(UTF ? isIDFIRST_uni(c) : isIDFIRST_A(c)))
-       return NULL;
-    s = PL_bufptr;
-    d = PL_tokenbuf + 1;
-    PL_tokenbuf[0] = (char)sigil;
-    parse_ident(&s, &d, PL_tokenbuf + sizeof(PL_tokenbuf) - 1, 0,
-               cBOOL(UTF), FALSE);
-    PL_bufptr = s;
-    if (d == PL_tokenbuf+1)
-       return NULL;
-    var = newOP(sigil == '$' ? OP_PADSV : sigil == '@' ? OP_PADAV : OP_PADHV,
-               OPf_MOD | (OPpLVAL_INTRO<<8));
-    var->op_targ = allocmy(PL_tokenbuf, d - PL_tokenbuf, UTF ? SVf_UTF8 : 0);
-    return var;
-}
-
-OP *
-Perl_parse_subsignature(pTHX)
-{
-    I32 c;
-    int prev_type = 0, pos = 0, min_arity = 0, max_arity = 0;
-    OP *initops = NULL;
-    lex_read_space(0);
-    c = lex_peek_unichar(0);
-    while (c != /*(*/')') {
-       switch (c) {
-           case '$': {
-               OP *var, *expr;
-               if (prev_type == 2)
-                   qerror(Perl_mess(aTHX_ "Slurpy parameter not last"));
-               var = parse_opt_lexvar();
-               expr = var ?
-                   newBINOP(OP_AELEM, 0,
-                       ref(newUNOP(OP_RV2AV, 0, newGVOP(OP_GV, 0, PL_defgv)),
-                           OP_RV2AV),
-                       newSVOP(OP_CONST, 0, newSViv(pos))) :
-                   NULL;
-               lex_read_space(0);
-               c = lex_peek_unichar(0);
-               if (c == '=') {
-                   lex_token_boundary();
-                   lex_read_unichar(0);
-                   lex_read_space(0);
-                   c = lex_peek_unichar(0);
-                   if (c == ',' || c == /*(*/')') {
-                       if (var)
-                           qerror(Perl_mess(aTHX_ "Optional parameter "
-                                   "lacks default expression"));
-                   } else {
-                       OP *defexpr = parse_termexpr(0);
-                       if (defexpr->op_type == OP_UNDEF
-                            && !(defexpr->op_flags & OPf_KIDS))
-                        {
-                           op_free(defexpr);
-                       } else {
-                           OP *ifop = 
-                               newBINOP(OP_GE, 0,
-                                   scalar(newUNOP(OP_RV2AV, 0,
-                                           newGVOP(OP_GV, 0, PL_defgv))),
-                                   newSVOP(OP_CONST, 0, newSViv(pos+1)));
-                           expr = var ?
-                               newCONDOP(0, ifop, expr, defexpr) :
-                               newLOGOP(OP_OR, 0, ifop, defexpr);
-                       }
-                   }
-                   prev_type = 1;
-               } else {
-                   if (prev_type == 1)
-                       qerror(Perl_mess(aTHX_ "Mandatory parameter "
-                               "follows optional parameter"));
-                   prev_type = 0;
-                   min_arity = pos + 1;
-               }
-               if (var) expr = newASSIGNOP(OPf_STACKED, var, 0, expr);
-               if (expr)
-                   initops = op_append_list(OP_LINESEQ, initops,
-                               newSTATEOP(0, NULL, expr));
-               max_arity = ++pos;
-           } break;
-           case '@':
-           case '%': {
-               OP *var;
-               if (prev_type == 2)
-                   qerror(Perl_mess(aTHX_ "Slurpy parameter not last"));
-               var = parse_opt_lexvar();
-               if (c == '%') {
-                   OP *chkop = newLOGOP((pos & 1) ? OP_OR : OP_AND, 0,
-                           newBINOP(OP_BIT_AND, 0,
-                               scalar(newUNOP(OP_RV2AV, 0,
-                                   newGVOP(OP_GV, 0, PL_defgv))),
-                               newSVOP(OP_CONST, 0, newSViv(1))),
-                           op_convert_list(OP_DIE, 0,
-                               op_convert_list(OP_SPRINTF, 0,
-                                   op_append_list(OP_LIST,
-                                       newSVOP(OP_CONST, 0,
-                                           newSVpvs("Odd name/value argument for subroutine at %s line %d.\n")),
-                                       newSLICEOP(0,
-                                           op_append_list(OP_LIST,
-                                               newSVOP(OP_CONST, 0, newSViv(1)),
-                                               newSVOP(OP_CONST, 0, newSViv(2))),
-                                           newOP(OP_CALLER, 0))))));
-                   if (pos != min_arity)
-                       chkop = newLOGOP(OP_AND, 0,
-                                   newBINOP(OP_GT, 0,
-                                       scalar(newUNOP(OP_RV2AV, 0,
-                                           newGVOP(OP_GV, 0, PL_defgv))),
-                                       newSVOP(OP_CONST, 0, newSViv(pos))),
-                                   chkop);
-                   initops = op_append_list(OP_LINESEQ,
-                               newSTATEOP(0, NULL, chkop),
-                               initops);
-               }
-               if (var) {
-                   OP *slice = pos ?
-                       op_prepend_elem(OP_ASLICE,
-                           newOP(OP_PUSHMARK, 0),
-                           newLISTOP(OP_ASLICE, 0,
-                               list(newRANGE(0,
-                                   newSVOP(OP_CONST, 0, newSViv(pos)),
-                                   newUNOP(OP_AV2ARYLEN, 0,
-                                       ref(newUNOP(OP_RV2AV, 0,
-                                               newGVOP(OP_GV, 0, PL_defgv)),
-                                           OP_AV2ARYLEN)))),
-                               ref(newUNOP(OP_RV2AV, 0,
-                                       newGVOP(OP_GV, 0, PL_defgv)),
-                                   OP_ASLICE))) :
-                       newUNOP(OP_RV2AV, 0, newGVOP(OP_GV, 0, PL_defgv));
-                   initops = op_append_list(OP_LINESEQ, initops,
-                       newSTATEOP(0, NULL,
-                           newASSIGNOP(OPf_STACKED, var, 0, slice)));
-               }
-               prev_type = 2;
-               max_arity = -1;
-           } break;
-           default:
-               parse_error:
-               qerror(Perl_mess(aTHX_ "Parse error"));
-               return NULL;
-       }
-       lex_read_space(0);
-       c = lex_peek_unichar(0);
-       switch (c) {
-           case /*(*/')': break;
-           case ',':
-               do {
-                   lex_token_boundary();
-                   lex_read_unichar(0);
-                   lex_read_space(0);
-                   c = lex_peek_unichar(0);
-               } while (c == ',');
-               break;
-           default:
-               goto parse_error;
-       }
-    }
-    if (min_arity != 0) {
-       initops = op_append_list(OP_LINESEQ,
-           newSTATEOP(0, NULL,
-               newLOGOP(OP_OR, 0,
-                   newBINOP(OP_GE, 0,
-                       scalar(newUNOP(OP_RV2AV, 0,
-                           newGVOP(OP_GV, 0, PL_defgv))),
-                       newSVOP(OP_CONST, 0, newSViv(min_arity))),
-                   op_convert_list(OP_DIE, 0,
-                       op_convert_list(OP_SPRINTF, 0,
-                           op_append_list(OP_LIST,
-                               newSVOP(OP_CONST, 0,
-                                   newSVpvs("Too few arguments for subroutine at %s line %d.\n")),
-                               newSLICEOP(0,
-                                   op_append_list(OP_LIST,
-                                       newSVOP(OP_CONST, 0, newSViv(1)),
-                                       newSVOP(OP_CONST, 0, newSViv(2))),
-                                   newOP(OP_CALLER, 0))))))),
-           initops);
-    }
-    if (max_arity != -1) {
-       initops = op_append_list(OP_LINESEQ,
-           newSTATEOP(0, NULL,
-               newLOGOP(OP_OR, 0,
-                   newBINOP(OP_LE, 0,
-                       scalar(newUNOP(OP_RV2AV, 0,
-                           newGVOP(OP_GV, 0, PL_defgv))),
-                       newSVOP(OP_CONST, 0, newSViv(max_arity))),
-                   op_convert_list(OP_DIE, 0,
-                       op_convert_list(OP_SPRINTF, 0,
-                           op_append_list(OP_LIST,
-                               newSVOP(OP_CONST, 0,
-                                   newSVpvs("Too many arguments for subroutine at %s line %d.\n")),
-                               newSLICEOP(0,
-                                   op_append_list(OP_LIST,
-                                       newSVOP(OP_CONST, 0, newSViv(1)),
-                                       newSVOP(OP_CONST, 0, newSViv(2))),
-                                   newOP(OP_CALLER, 0))))))),
-           initops);
-    }
-    return initops;
-}
-
 /*
  * ex: set ts=8 sts=4 sw=4 et:
  */
index 415ec7cd73f3d4046a65fe7d78248835f411007a..a02560f77d096a4f66995f2c9a74c438a6684f31 100644 (file)
--- a/uconfig.h
+++ b/uconfig.h
  *     LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE
  *     LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE
  *     LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE
+ *     LONG_DOUBLE_IS_VAX_H_FLOAT
  *     LONG_DOUBLE_IS_UNKNOWN_FORMAT
  *     It is only defined if the system supports long doubles.
  */
 #define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE      6
 #define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE      7
 #define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE      8
+#define LONG_DOUBLE_IS_VAX_H_FLOAT                     9
 #define LONG_DOUBLE_IS_UNKNOWN_FORMAT                  -1
 #define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN      LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_LE /* back-compat */
 #define LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE /* back-compat */
  */
 /*#define HAS_FUTIMES          / **/
 
+/* HAS_GAI_STRERROR:
+ *     This symbol, if defined, indicates that the gai_strerror routine
+ *     is available to translate error codes returned by getaddrinfo()
+ *     into human readable strings.
+ */
+/*#define HAS_GAI_STRERROR     / **/
+
 /* HAS_GETADDRINFO:
  *     This symbol, if defined, indicates that the getaddrinfo() function
  *     is available for use.
  *     This symbol, if defined, indicates that the querylocale routine is
  *     available to return the name of the locale for a category mask.
  */
+/* I_XLOCALE:
+ *     This symbol, if defined, indicates to the C program that it should
+ *     include <xlocale.h> to get uselocale() and its friends.
+ */
 /*#define      HAS_NEWLOCALE   / **/
 /*#define      HAS_FREELOCALE  / **/
 /*#define      HAS_USELOCALE   / **/
 /*#define      HAS_QUERYLOCALE / **/
+/*#define      I_XLOCALE               / **/
 
 /* HAS_NEXTAFTER:
  *     This symbol, if defined, indicates that the nextafter routine is
 #endif
 
 /* Generated from:
- * 8559c6ec4e935f6478ac3149c106aed3eacfd60544281f97fd1383110d8a5cce config_h.SH
- * 3b14c76342a834042da506e8c3b4269f7d545453079733cb740970ab9cc4294e uconfig.sh
+ * 42be1deadbcceadd92a1463d6c11c441bad7c83fe2a4cd1c2ebec7742bb5e8a3 config_h.SH
+ * 0fca2bf99ac976bba919b593a18bacd059c581dbe6c8638dc0861b1e613b8406 uconfig.sh
  * ex: set ro: */
index c9511134fcc7bcced30e2a6752e634bc73359d40..edc36db32693ab2fbdce9a9b4524c33194c7a0fa 100644 (file)
@@ -171,6 +171,7 @@ d_fsync='undef'
 d_ftello='undef'
 d_ftime='undef'
 d_futimes='undef'
+d_gai_strerror='undef'
 d_gdbm_ndbm_h_uses_prototypes='undef'
 d_gdbmndbm_h_uses_prototypes='undef'
 d_getaddrinfo='undef'
@@ -712,6 +713,7 @@ i_values='undef'
 i_varargs='undef'
 i_varhdr='stdarg.h'
 i_vfork='undef'
+i_xlocale='undef'
 ignore_versioned_solibs='y'
 inc_version_list_init='NULL'
 installstyle='lib/perl5'
index 6efaf44269de590f4172fb6a843b91f36cea2d27..df18372a9c03e4192b48c90d5c427409a0879d9a 100644 (file)
@@ -172,6 +172,7 @@ d_fsync='undef'
 d_ftello='undef'
 d_ftime='undef'
 d_futimes='undef'
+d_gai_strerror='undef'
 d_gdbm_ndbm_h_uses_prototypes='undef'
 d_gdbmndbm_h_uses_prototypes='undef'
 d_getaddrinfo='undef'
@@ -713,6 +714,7 @@ i_values='undef'
 i_varargs='undef'
 i_varhdr='stdarg.h'
 i_vfork='undef'
+i_xlocale='undef'
 ignore_versioned_solibs='y'
 inc_version_list_init='NULL'
 installstyle='lib/perl5'
index 0fcaea7701e0bbcc4b989284d5b0820d0f511ca5..e77fad360554df0170cef9faf2384b97336eda8c 100644 (file)
@@ -627,20 +627,6 @@ XS(XS_Internals_SvREFCNT)  /* This is dangerous stuff. */
 
 }
 
-XS(XS_Internals_hv_clear_placehold); /* prototype to pass -Wmissing-prototypes */
-XS(XS_Internals_hv_clear_placehold)
-{
-    dXSARGS;
-
-    if (items != 1 || !SvROK(ST(0)))
-       croak_xs_usage(cv, "hv");
-    else {
-       HV * const hv = MUTABLE_HV(SvRV(ST(0)));
-       hv_clear_placeholders(hv);
-       XSRETURN(0);
-    }
-}
-
 XS(XS_PerlIO_get_layers); /* prototype to pass -Wmissing-prototypes */
 XS(XS_PerlIO_get_layers)
 {
@@ -766,68 +752,6 @@ XS(XS_PerlIO_get_layers)
     XSRETURN(0);
 }
 
-XS(XS_hash_util_bucket_ratio); /* prototype to pass -Wmissing-prototypes */
-XS(XS_hash_util_bucket_ratio)
-{
-    dXSARGS;
-    SV *rhv;
-    PERL_UNUSED_VAR(cv);
-
-    if (items != 1)
-        croak_xs_usage(cv, "hv");
-
-    rhv= ST(0);
-    if (SvROK(rhv)) {
-        rhv= SvRV(rhv);
-        if ( SvTYPE(rhv)==SVt_PVHV ) {
-            SV *ret= Perl_hv_bucket_ratio(aTHX_ (HV*)rhv);
-            ST(0)= ret;
-            XSRETURN(1);
-        }
-    }
-    XSRETURN_UNDEF;
-}
-
-XS(XS_hash_util_num_buckets); /* prototype to pass -Wmissing-prototypes */
-XS(XS_hash_util_num_buckets)
-{
-    dXSARGS;
-    SV *rhv;
-    PERL_UNUSED_VAR(cv);
-
-    if (items != 1)
-        croak_xs_usage(cv, "hv");
-
-    rhv= ST(0);
-    if (SvROK(rhv)) {
-        rhv= SvRV(rhv);
-        if ( SvTYPE(rhv)==SVt_PVHV ) {
-            XSRETURN_UV(HvMAX((HV*)rhv)+1);
-        }
-    }
-    XSRETURN_UNDEF;
-}
-
-XS(XS_hash_util_used_buckets); /* prototype to pass -Wmissing-prototypes */
-XS(XS_hash_util_used_buckets)
-{
-    dXSARGS;
-    SV *rhv;
-    PERL_UNUSED_VAR(cv);
-
-    if (items != 1)
-        croak_xs_usage(cv, "hv");
-
-    rhv= ST(0);
-    if (SvROK(rhv)) {
-        rhv= SvRV(rhv);
-        if ( SvTYPE(rhv)==SVt_PVHV ) {
-            XSRETURN_UV(HvFILL((HV*)rhv));
-        }
-    }
-    XSRETURN_UNDEF;
-}
-
 XS(XS_re_is_regexp); /* prototype to pass -Wmissing-prototypes */
 XS(XS_re_is_regexp)
 {
@@ -854,9 +778,6 @@ XS(XS_re_regnames_count)
     if (items != 0)
        croak_xs_usage(cv, "");
 
-    SP -= items;
-    PUTBACK;
-
     if (!rx)
         XSRETURN_UNDEF;
 
@@ -1080,13 +1001,9 @@ static const struct xsub_details details[] = {
     {"utf8::native_to_unicode", XS_utf8_native_to_unicode, NULL},
     {"utf8::unicode_to_native", XS_utf8_unicode_to_native, NULL},
     {"Internals::SvREADONLY", XS_Internals_SvREADONLY, "\\[$%@];$"},
-    {"constant::_make_const", XS_constant__make_const, "\\[$@]"},
     {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$"},
-    {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%"},
+    {"constant::_make_const", XS_constant__make_const, "\\[$@]"},
     {"PerlIO::get_layers", XS_PerlIO_get_layers, "*;@"},
-    {"Hash::Util::bucket_ratio", XS_hash_util_bucket_ratio, "\\%"},
-    {"Hash::Util::num_buckets", XS_hash_util_num_buckets, "\\%"},
-    {"Hash::Util::used_buckets", XS_hash_util_used_buckets, "\\%"},
     {"re::is_regexp", XS_re_is_regexp, "$"},
     {"re::regname", XS_re_regname, ";$$"},
     {"re::regnames", XS_re_regnames, ";$"},
diff --git a/utf8.c b/utf8.c
index 56d33227081e716f6c09117bdfa795cdd2c83b54..0b7cbdabab49db26f99b8bc2876f2e326fb26999 100644 (file)
--- a/utf8.c
+++ b/utf8.c
@@ -638,14 +638,10 @@ Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags)
     /* Here is not a continuation byte, nor an invariant.  The only thing left
      * is a start byte (possibly for an overlong) */
 
-#ifdef EBCDIC
-    uv = NATIVE_UTF8_TO_I8(uv);
-#endif
-
-    /* Remove the leading bits that indicate the number of bytes in the
-     * character's whole UTF-8 sequence, leaving just the bits that are part of
-     * the value */
-    uv &= UTF_START_MASK(expectlen);
+    /* Convert to I8 on EBCDIC (no-op on ASCII), then remove the leading bits
+     * that indicate the number of bytes in the character's whole UTF-8
+     * sequence, leaving just the bits that are part of the value.  */
+    uv = NATIVE_UTF8_TO_I8(uv) & UTF_START_MASK(expectlen);
 
     /* Now, loop through the remaining bytes in the character's sequence,
      * accumulating each into the working value as we go.  Be sure to not look
@@ -2888,7 +2884,7 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 m
  *
  * Non-binary properties are stored in as many bits as necessary to represent
  * their values (32 currently, though the code is more general than that), not
- * as single bits, but the principal is the same: the value for each key is a
+ * as single bits, but the principle is the same: the value for each key is a
  * vector that encompasses the property values for all code points whose UTF-8
  * representations are represented by the key.  That is, for all code points
  * whose UTF-8 representations are length N bytes, and the key is the first N-1
diff --git a/utf8.h b/utf8.h
index c954b42ff5d0f3f3f515e19a0d8661b6884e1f04..ee2d97e5438c704a9b549a229224abb3001b9397 100644 (file)
--- a/utf8.h
+++ b/utf8.h
@@ -156,8 +156,8 @@ END_EXTERN_C
  * rarely do we need to distinguish them.  The term "NATIVE_UTF8" applies to
  * whichever one is applicable on the current platform */
 #ifdef PERL_SMALL_MACRO_BUFFER
-#define NATIVE_UTF8_TO_I8(ch) (ch)
-#define I8_TO_NATIVE_UTF8(ch) (ch)
+#define NATIVE_UTF8_TO_I8(ch) ((U8) (ch))
+#define I8_TO_NATIVE_UTF8(ch) ((U8) (ch))
 #else
 #define NATIVE_UTF8_TO_I8(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) ((U8) (ch)))
 #define I8_TO_NATIVE_UTF8(ch) (__ASSERT_(FITS_IN_8_BITS(ch)) ((U8) (ch)))
@@ -338,11 +338,14 @@ encoded as UTF-8.  C<cp> is a native (ASCII or EBCDIC) code point if less than
  */
 #define UVCHR_SKIP(uv) ( UVCHR_IS_INVARIANT(uv) ? 1 : __BASE_UNI_SKIP(uv))
 
-/* As explained in the comments for __COMMON_UNI_SKIP, 32 start bytes with
+/* The largest code point representable by two UTF-8 bytes on this platform.
+ * As explained in the comments for __COMMON_UNI_SKIP, 32 start bytes with
  * UTF_ACCUMULATION_SHIFT bits of information each */
 #define MAX_UTF8_TWO_BYTE (32 * (1U << UTF_ACCUMULATION_SHIFT) - 1)
 
-/* constrained by EBCDIC which has 5 bits per continuation byte */
+/* The largest code point representable by two UTF-8 bytes on any platform that
+ * Perl runs on.  This value is constrained by EBCDIC which has 5 bits per
+ * continuation byte */
 #define MAX_PORTABLE_UTF8_TWO_BYTE (32 * (1U << 5) - 1)
 
 /* The maximum number of UTF-8 bytes a single Unicode character can
index 466223c8008cb86be86275c7ce762a058bc3bd4f..ea87a6f24635cb6f23ec279b4d6547161ad73083 100644 (file)
@@ -280,6 +280,7 @@ Anyway, here it is.  Should run on perl v4 or greater.  Maybe less.
 
 $RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $';
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use File::Temp;
 
 ######################################################################
index d082f227232c035d880f1dd4e311220d9502b4d3..2523c0a6545b71e221eb6e67b4900db8c3cfd67b 100644 (file)
@@ -36,6 +36,8 @@ $Config{startperl}
 
 print OUT <<'!NO!SUBS!';
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
+
 use strict;
 
 use Config;
index 4cb09437426884b621db1d02627c7c7931cbaae1..8fda87b0a78720c6469ff162341d1ac442e78d9b 100644 (file)
@@ -35,6 +35,8 @@ $Config{startperl}
 
 print OUT <<'!NO!SUBS!';
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
+
 use warnings;
 
 =head1 NAME
index 59a2de87c8027a5f067d7481faf1c174b643c748..26d2f995a90469f7a9ab8cf768e68ffc9cb43183 100644 (file)
@@ -97,6 +97,7 @@ Jarkko Hietaniemi, conversion into libnetcfg for inclusion into Perl 5.8.
 
 # $Id: Configure,v 1.8 1997/03/04 09:22:32 gbarr Exp $
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use strict;
 use IO::File;
 use Getopt::Std;
index 720cf1203ffd2a4a26ec77ae83ea45294bad579f..b0b2c1290502fd28fd7bbe9eb47fe4956ae8139c 100644 (file)
@@ -57,6 +57,7 @@ print OUT <<'!NO!SUBS!';
 my @patches = Config::local_patches();
 my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
 use warnings;
 use strict;
 use Config;
index e201de9d910582dbf8f137065942d7103397a168..cd60bd4354c7f9cc5960bd7a1212f409d2cafb8f 100644 (file)
@@ -44,7 +44,10 @@ $Config{startperl}
 # This "$file" file was generated by "$0"
 
 require 5;
-BEGIN { \$^W = 1 if \$ENV{'PERLDOCDEBUG'} }
+BEGIN {
+    \$^W = 1 if \$ENV{'PERLDOCDEBUG'};
+    pop \@INC if \$INC[-1] eq '.';
+}
 use Pod::Perldoc;
 exit( Pod::Perldoc->run() );
 
index c2f0a11f15524bd4fe89da1617a1ac204600091b..e5229133f4548cc9636ccdf6c329233e058eee20 100644 (file)
@@ -39,6 +39,8 @@ print OUT "\n# perlivp $^V\n";
 
 print OUT <<'!NO!SUBS!';
 
+BEGIN { pop @INC if $INC[-1] eq '.' }
+
 sub usage {
     warn "@_\n" if @_;
     print << "    EOUSAGE";
index 9c70b61afd545e70f6c6616ee9d97e0896b316c0..bbcdad6f1e9d7ca7839ead3272de8f2bfa4be4f8 100644 (file)
@@ -38,6 +38,12 @@ $Config{startperl}
        if \$running_under_some_shell;
 !GROK!THIS!
 
+print OUT <<'!NO!SUBS!';
+
+BEGIN { pop @INC if $INC[-1] eq '.' }
+
+!NO!SUBS!
+
 while (<IN>) {
     print OUT unless /^package diagnostics/;
 }
index 786cbcc5843cae6259b4100a1b4d251f73f38515..de4379deb83fb14c256c86f2b0284657033a9279 100644 (file)
@@ -307,7 +307,7 @@ utils : $(utils1) $(utils2) $(utils3) $(utils4) $(utils5)
 extra.pods : miniperl
        @ @extra_pods.com
 
-PERLDELTA_CURRENT = [.pod]perl5253delta.pod
+PERLDELTA_CURRENT = [.pod]perl5254delta.pod
 
 $(PERLDELTA_CURRENT) : [.pod]perldelta.pod
        Copy/NoConfirm/Log $(MMS$SOURCE) $(PERLDELTA_CURRENT)
index 9719332ab226af65aec67688e59bb368bfe48d54..56dee9f5f83ffd4fb20f4c65171827055380bb5a 100644 (file)
@@ -6,6 +6,7 @@ bin/*.bat
 html/
 mini/
 Extensions_static
+.coreheaders
 dlutils.c
 perllibst.h
 perlmain.c
index 112ea4c372cf04b4e5962414c718aa1bd50ceb25..d4d481821468ecfeabaecb085063e86f83948d28 100644 (file)
@@ -36,10 +36,6 @@ ifeq ($(GCCBIN),i686-w64-mingw32-gcc)
 GCCCROSS := i686-w64-mingw32
 endif
 
-GCCTARGET := $(shell $(GCCBIN) -dumpmachine)
-GCCVER1   := $(shell for /f "delims=. tokens=1,2,3" %%i in ('gcc -dumpversion') do echo %%i)
-GCCVER2   := $(shell for /f "delims=. tokens=1,2,3" %%i in ('gcc -dumpversion') do echo %%j)
-GCCVER3   := $(shell for /f "delims=. tokens=1,2,3" %%i in ('gcc -dumpversion') do echo %%k)
 
 ##
 ## Build configuration.  Edit the values below to suit your needs.
@@ -67,7 +63,7 @@ INST_TOP := $(INST_DRV)\perl
 # versioned installation can be obtained by setting INST_TOP above to a
 # path that includes an arbitrary version string.
 #
-#INST_VER      := \5.25.3
+#INST_VER      := \5.25.4
 
 #
 # Comment this out if you DON'T want your perl installation to have
@@ -178,7 +174,7 @@ USE_LARGE_FILES     := define
 # Visual C++ 2013 Express Edition (aka Visual C++ 12.0) (free version)
 #CCTYPE                := MSVC120FREE
 # MinGW or mingw-w64 with gcc-3.4.5 or later
-CCTYPE         := GCC
+#CCTYPE                := GCC
 
 #
 # If you are using Intel C++ Compiler uncomment this
@@ -354,6 +350,27 @@ ifeq ($(USE_NO_REGISTRY),define)
 BUILDOPT       += -DWIN32_NO_REGISTRY
 endif
 
+ifeq ($(CCTYPE),GCC)
+GCCTARGET      := $(shell $(GCCBIN) -dumpmachine)
+endif
+
+#no explicit CCTYPE given, do auto detection
+ifeq ($(CCTYPE),)
+GCCTARGET      := $(shell $(GCCBIN) -dumpmachine 2>NUL)
+#do we have a GCC?
+ifneq ($(GCCTARGET),)
+CCTYPE         := GCC
+else
+#use var to capture 1st line only, not 8th token of lines 2 & 3 in cl.exe output
+#rmving the cmd /c causes the var2b undef4echo but!4"set MSVCVER", cmd.exe bug?
+MSVCVER                := $(shell (set MSVCVER=) & (for /f "tokens=8 delims=.^ " \
+       %%i in ('cl ^2^>^&1') do if not defined MSVCVER set /A "MSVCVER=%%i-6") \
+       & cmd /c echo %%MSVCVER%%)
+CCTYPE         := MSVC$(MSVCVER)0
+endif
+endif
+
+
 ifeq ($(CCTYPE),GCC)
 ifeq ($(GCCTARGET),x86_64-w64-mingw32)
 WIN64 := define
@@ -483,6 +500,10 @@ BUILDOPT        += -D__USE_MINGW_ANSI_STDIO
 MINIBUILDOPT    += -D__USE_MINGW_ANSI_STDIO
 endif
 
+GCCVER1   := $(shell for /f "delims=. tokens=1,2,3" %%i in ('gcc -dumpversion') do echo %%i)
+GCCVER2   := $(shell for /f "delims=. tokens=1,2,3" %%i in ('gcc -dumpversion') do echo %%j)
+GCCVER3   := $(shell for /f "delims=. tokens=1,2,3" %%i in ('gcc -dumpversion') do echo %%k)
+
 # If you are using GCC, 4.3 or later by default we add the -fwrapv option.
 # See https://rt.perl.org/Ticket/Display.html?id=121505
 #
@@ -998,9 +1019,8 @@ UUDMAP_H   = ..\uudmap.h
 BITCOUNT_H     = ..\bitcount.h
 MG_DATA_H      = ..\mg_data.h
 GENERATED_HEADERS = $(UUDMAP_H) $(BITCOUNT_H) $(MG_DATA_H)
-#a stub ppport.h must be generated so building XS modules, .c->.obj wise, will
-#work, so this target also represents creating the COREDIR and filling it
-HAVE_COREDIR   = $(COREDIR)\ppport.h
+
+HAVE_COREDIR   = .coreheaders
 
 MICROCORE_OBJ  = $(MICROCORE_SRC:.c=$(o))
 CORE_OBJ       = $(MICROCORE_OBJ) $(EXTRACORE_SRC:.c=$(o))
@@ -1084,15 +1104,18 @@ CFG_VARS        =                                       \
 all : info rebasePE Extensions_nonxs $(PERLSTATIC)
 
 info :
+       @echo # CCTYPE=$(CCTYPE)
+ifeq ($(CCTYPE),GCC)
        @echo # GCCBIN=$(GCCBIN)
        @echo # GCCVER=$(GCCVER1).$(GCCVER2).$(GCCVER3)
        @echo # GCCTARGET=$(GCCTARGET)
        @echo # GCCCROSS=$(GCCCROSS)
+endif
        @echo # WIN64=$(WIN64)
        @echo # ARCHITECTURE=$(ARCHITECTURE)
        @echo # ARCHNAME=$(ARCHNAME)
        @echo # MAKE=$(PLMAKE)
-ifeq ($(GCCTARGET),)
+ifeq ($(CCTYPE),)
        @echo Unable to detect gcc and/or architecture!
        @exit 1
 endif
@@ -1419,10 +1442,13 @@ else
        $(EMBED_EXE_MANI)
 endif
 
-#This generates a stub ppport.h & creates & fills /lib/CORE to allow for XS
-#building .c->.obj wise (linking is a different thing). This target is AKA
-#$(HAVE_COREDIR).
-$(COREDIR)\ppport.h : $(CORE_H)
+.PHONY: MakePPPort
+
+MakePPPort : $(HAVEMINIPERL) $(CONFIGPM)
+       $(MINIPERL) -I..\lib ..\mkppport
+
+# also known as $(HAVE_COREDIR)
+.coreheaders : $(CORE_H)
        $(XCOPY) *.h $(COREDIR)\\*.*
        $(RCOPY) include $(COREDIR)\\*.*
        $(XCOPY) ..\\*.h $(COREDIR)\\*.*
@@ -1461,7 +1487,7 @@ endif
 # DynaLoader.pm, so this will have to do
 
 #most of deps of this target are in DYNALOADER and therefore omitted here
-Extensions : $(PERLDEP) $(DYNALOADER) $(GLOBEXE)
+Extensions : $(PERLDEP) $(DYNALOADER) $(GLOBEXE) MakePPPort
        $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --dynamic !Unicode/Normalize
 
 Extensions_normalize : $(PERLDEP) $(DYNALOADER) $(GLOBEXE) $(UNIDATAFILES)
@@ -1470,7 +1496,7 @@ Extensions_normalize : $(PERLDEP) $(DYNALOADER) $(GLOBEXE) $(UNIDATAFILES)
 Extensions_reonly : $(PERLDEP) $(DYNALOADER)
        $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --dynamic +re
 
-Extensions_static : ..\make_ext.pl list_static_libs.pl $(CONFIGPM) $(GLOBEXE) $(HAVE_COREDIR)
+Extensions_static : ..\make_ext.pl list_static_libs.pl $(CONFIGPM) $(GLOBEXE) $(HAVE_COREDIR) MakePPPort
        $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --static
        $(MINIPERL) -I..\lib list_static_libs.pl > Extensions_static
 
@@ -1544,7 +1570,7 @@ utils: $(HAVEMINIPERL) ..\utils\Makefile
        copy ..\README.tw       ..\pod\perltw.pod
        copy ..\README.vos      ..\pod\perlvos.pod
        copy ..\README.win32    ..\pod\perlwin32.pod
-       copy ..\pod\perldelta.pod ..\pod\perl5253delta.pod
+       copy ..\pod\perldelta.pod ..\pod\perl5254delta.pod
        $(MINIPERL) -I..\lib $(PL2BAT) $(UTILS)
        $(MINIPERL) -I..\lib ..\autodoc.pl ..
        $(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q ..
@@ -1641,7 +1667,7 @@ distclean: realclean
        -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API
        -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS
        -cd $(PODDIR) && del /f *.html *.bat roffitall \
-           perl5253delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
+           perl5254delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
            perlapi.pod perlbs2000.pod perlce.pod perlcn.pod perlcygwin.pod \
            perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \
            perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \
@@ -1769,6 +1795,7 @@ _clean :
        -@erase $(PERLDLL)
        -@erase $(CORE_OBJ)
        -@erase $(GENUUDMAP) $(GENUUDMAP_OBJ) $(GENERATED_HEADERS)
+       -@erase .coreheaders
        -if exist $(MINIDIR) rmdir /s /q $(MINIDIR)
        -if exist $(UNIDATADIR1) rmdir /s /q $(UNIDATADIR1)
        -if exist $(UNIDATADIR2) rmdir /s /q $(UNIDATADIR2)
index 0092dda152d0acea71e0125a80afbd96ef97b294..e45cb11dda405f9f0c4527e668d87a30a3b9a581 100644 (file)
@@ -38,7 +38,7 @@ INST_TOP      = $(INST_DRV)\perl
 # versioned installation can be obtained by setting INST_TOP above to a
 # path that includes an arbitrary version string.
 #
-#INST_VER      = \5.25.3
+#INST_VER      = \5.25.4
 
 #
 # Comment this out if you DON'T want your perl installation to have
@@ -1215,7 +1215,7 @@ utils: $(PERLEXE) ..\utils\Makefile
        copy ..\README.tw       ..\pod\perltw.pod
        copy ..\README.vos      ..\pod\perlvos.pod
        copy ..\README.win32    ..\pod\perlwin32.pod
-       copy ..\pod\perldelta.pod ..\pod\perl5253delta.pod
+       copy ..\pod\perldelta.pod ..\pod\perl5254delta.pod
        cd ..\win32
        $(PERLEXE) $(PL2BAT) $(UTILS)
        $(MINIPERL) -I..\lib ..\autodoc.pl ..
@@ -1314,7 +1314,7 @@ distclean: realclean
        -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API
        -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS
        -cd $(PODDIR) && del /f *.html *.bat roffitall \
-           perl5253delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
+           perl5254delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
            perlapi.pod perlbs2000.pod perlce.pod perlcn.pod perlcygwin.pod \
            perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \
            perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \
index b37222aee24ac91edd21f6d6a696e76f579c9e38..8f68ddd890fbd89915f8110f27bfb3f8ab9860c9 100644 (file)
@@ -219,6 +219,7 @@ d_fsync='undef'
 d_ftello='undef'
 d_ftime='define'
 d_futimes='undef'
+d_gai_strerror='undef'
 d_gdbm_ndbm_h_uses_prototypes='undef'
 d_gdbmndbm_h_uses_prototypes='undef'
 d_getaddrinfo='undef'
@@ -783,6 +784,7 @@ i_values='undef'
 i_varargs='undef'
 i_varhdr='varargs.h'
 i_vfork='undef'
+i_xlocale='undef'
 ignore_versioned_solibs=''
 inc_version_list=''
 inc_version_list_init='0'
index 017a5e5a867a57e2ba36be257d241cbabc894011..69a21a2a18b3a6443d42d6a79b14594e41f50d26 100644 (file)
@@ -220,6 +220,7 @@ d_fsync='undef'
 d_ftello='undef'
 d_ftime='define'
 d_futimes='undef'
+d_gai_strerror='undef'
 d_gdbm_ndbm_h_uses_prototypes='undef'
 d_gdbmndbm_h_uses_prototypes='undef'
 d_getaddrinfo='undef'
@@ -795,6 +796,7 @@ i_values='undef'
 i_varargs='undef'
 i_varhdr='varargs.h'
 i_vfork='undef'
+i_xlocale='undef'
 ignore_versioned_solibs=''
 inc_version_list=''
 inc_version_list_init='0'
index ddbd133e58c2b1ba0a5a31dd6721c275d1f887d8..50d2a92605949629c844116c5f15f36c71df9e2f 100644 (file)
@@ -220,6 +220,7 @@ d_fsync='undef'
 d_ftello='undef'
 d_ftime='define'
 d_futimes='undef'
+d_gai_strerror='undef'
 d_gdbm_ndbm_h_uses_prototypes='undef'
 d_gdbmndbm_h_uses_prototypes='undef'
 d_getaddrinfo='undef'
@@ -794,6 +795,7 @@ i_values='undef'
 i_varargs='undef'
 i_varhdr='varargs.h'
 i_vfork='undef'
+i_xlocale='undef'
 ignore_versioned_solibs=''
 inc_version_list=''
 inc_version_list_init='0'
index 58abd455393df3e5d1059698e7351a9625664c8d..478da430bc7e03ff44665f80aabf9ee3e3bbaaaa 100644 (file)
@@ -44,7 +44,7 @@ INST_TOP      *= $(INST_DRV)\perl
 # versioned installation can be obtained by setting INST_TOP above to a
 # path that includes an arbitrary version string.
 #
-#INST_VER      *= \5.25.3
+#INST_VER      *= \5.25.4
 
 #
 # Comment this out if you DON'T want your perl installation to have
@@ -146,7 +146,7 @@ USE_LARGE_FILES     *= define
 # Visual C++ 2013 Express Edition (aka Visual C++ 12.0) (free version)
 #CCTYPE                = MSVC120FREE
 # MinGW or mingw-w64 with gcc-3.4.5 or later
-CCTYPE         *= GCC
+#CCTYPE                = GCC
 
 #
 # If you are using GCC, 4.3 or later by default we add the -fwrapv option.
@@ -355,6 +355,20 @@ BUILDOPT   += -DPERL_IMPLICIT_SYS
 BUILDOPT       += -DWIN32_NO_REGISTRY
 .ENDIF
 
+#no explicit CCTYPE given, do auto detection
+.IF "$(CCTYPE)" == ""
+GCCTARGET      *= $(shell gcc -dumpmachine 2>NUL & exit /b 0)
+#do we have a GCC?
+.IF "$(GCCTARGET)" != ""
+CCTYPE         = GCC
+else
+#use var to capture 1st line only, not 8th token of lines 2 & 3 in cl.exe output
+MSVCVER                := $(shell (set MSVCVER=) & (for /f "tokens=8 delims=.^ " \
+       %i in ('cl ^2^>^&1') do @if not defined MSVCVER set /A "MSVCVER=%i-6"))
+CCTYPE         := MSVC$(MSVCVER)0
+endif
+endif
+
 PROCESSOR_ARCHITECTURE *= x86
 
 .IF "$(WIN64)" == "undef"
@@ -985,9 +999,8 @@ UUDMAP_H    = ..\uudmap.h
 BITCOUNT_H     = ..\bitcount.h
 MG_DATA_H      = ..\mg_data.h
 GENERATED_HEADERS = $(UUDMAP_H) $(BITCOUNT_H) $(MG_DATA_H)
-#a stub ppport.h must be generated so building XS modules, .c->.obj wise, will
-#work, so this target also represents creating the COREDIR and filling it
-HAVE_COREDIR   = $(COREDIR)\ppport.h
+
+HAVE_COREDIR   = .\.coreheaders
 
 MICROCORE_OBJ  = $(MICROCORE_SRC:db:+$(o))
 CORE_OBJ       = $(MICROCORE_OBJ) $(EXTRACORE_SRC:db:+$(o))
@@ -1387,10 +1400,11 @@ $(GENUUDMAP) $(GENERATED_HEADERS) .UPDATEALL : ..\mg_raw.h
 .ENDIF
        $(GENUUDMAP) $(GENERATED_HEADERS)
 
-#This generates a stub ppport.h & creates & fills /lib/CORE to allow for XS
-#building .c->.obj wise (linking is a different thing). This target is AKA
-#$(HAVE_COREDIR).
-$(COREDIR)\ppport.h : $(CORE_H)
+MakePPPort : $(HAVEMINIPERL) $(CONFIGPM)
+       $(MINIPERL) -I..\lib ..\mkppport
+
+# also known as $(HAVE_COREDIR)
+.\.coreheaders : $(CORE_H)
        $(XCOPY) *.h $(COREDIR)\*.* && $(RCOPY) include $(COREDIR)\*.* && $(XCOPY) ..\*.h $(COREDIR)\*.*
        rem. > $@
 
@@ -1427,7 +1441,7 @@ $(PERLEXESTATIC): $(PERLSTATICLIB) $(CONFIGPM) $(PERLEXEST_OBJ) $(PERLEXE_RES)
 # DynaLoader.pm, so this will have to do
 
 #most of deps of this target are in DYNALOADER and therefore omitted here
-Extensions : $(PERLDEP) $(DYNALOADER) $(GLOBEXE)
+Extensions : $(PERLDEP) $(DYNALOADER) $(GLOBEXE) MakePPPort
        $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --dynamic !Unicode/Normalize
 
 Extensions_normalize : $(PERLDEP) $(DYNALOADER) $(GLOBEXE) $(UNIDATAFILES)
@@ -1436,7 +1450,7 @@ Extensions_normalize : $(PERLDEP) $(DYNALOADER) $(GLOBEXE) $(UNIDATAFILES)
 Extensions_reonly : $(PERLDEP) $(DYNALOADER)
        $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --dynamic +re
 
-Extensions_static : ..\make_ext.pl list_static_libs.pl $(CONFIGPM) $(GLOBEXE) $(HAVE_COREDIR)
+Extensions_static : ..\make_ext.pl list_static_libs.pl $(CONFIGPM) $(GLOBEXE) $(HAVE_COREDIR) MakePPPort
        $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --static
        $(MINIPERL) -I..\lib list_static_libs.pl > Extensions_static
 
@@ -1511,7 +1525,7 @@ utils: $(HAVEMINIPERL) ..\utils\Makefile
        copy ..\README.tw       ..\pod\perltw.pod
        copy ..\README.vos      ..\pod\perlvos.pod
        copy ..\README.win32    ..\pod\perlwin32.pod
-       copy ..\pod\perldelta.pod ..\pod\perl5253delta.pod
+       copy ..\pod\perldelta.pod ..\pod\perl5254delta.pod
        $(MINIPERL) -I..\lib $(PL2BAT) $(UTILS)
        $(MINIPERL) -I..\lib ..\autodoc.pl ..
        $(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q ..
@@ -1609,7 +1623,7 @@ distclean: realclean
        -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API
        -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS
        -cd $(PODDIR) && del /f *.html *.bat roffitall \
-           perl5253delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
+           perl5254delta.pod perlaix.pod perlamiga.pod perlandroid.pod \
            perlapi.pod perlbs2000.pod perlce.pod perlcn.pod perlcygwin.pod \
            perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \
            perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \
@@ -1644,7 +1658,6 @@ install : all installbare installhtml
 
 installbare : utils ..\pod\perltoc.pod
        $(PERLEXE) ..\installperl
-       attrib -r $(INST_COREDIR)\ppport.h && del $(INST_COREDIR)\ppport.h
        if exist $(WPERLEXE) $(XCOPY) $(WPERLEXE) $(INST_BIN)\*.*
        if exist $(PERLEXESTATIC) $(XCOPY) $(PERLEXESTATIC) $(INST_BIN)\*.*
        $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.*
@@ -1735,6 +1748,7 @@ _clean :
        -@erase $(PERLDLL)
        -@erase $(CORE_OBJ)
        -@erase $(GENUUDMAP) $(GENUUDMAP_OBJ) $(GENERATED_HEADERS)
+       -@erase .coreheaders
        -if exist $(MINIDIR) rmdir /s /q $(MINIDIR)
        -if exist $(UNIDATADIR1) rmdir /s /q $(UNIDATADIR1)
        -if exist $(UNIDATADIR2) rmdir /s /q $(UNIDATADIR2)
index 4eef0539f01cb44e799c3c76077448ea80df6bce..730da8f147688a0031d55674c5839061d33bc9cf 100644 (file)
@@ -48,6 +48,7 @@ POD = perl.pod        \
        perl5251delta.pod       \
        perl5252delta.pod       \
        perl5253delta.pod       \
+       perl5254delta.pod       \
        perl561delta.pod        \
        perl56delta.pod \
        perl581delta.pod        \
@@ -190,6 +191,7 @@ MAN = perl.man      \
        perl5251delta.man       \
        perl5252delta.man       \
        perl5253delta.man       \
+       perl5254delta.man       \
        perl561delta.man        \
        perl56delta.man \
        perl581delta.man        \
@@ -332,6 +334,7 @@ HTML = perl.html    \
        perl5251delta.html      \
        perl5252delta.html      \
        perl5253delta.html      \
+       perl5254delta.html      \
        perl561delta.html       \
        perl56delta.html        \
        perl581delta.html       \
@@ -474,6 +477,7 @@ TEX = perl.tex      \
        perl5251delta.tex       \
        perl5252delta.tex       \
        perl5253delta.tex       \
+       perl5254delta.tex       \
        perl561delta.tex        \
        perl56delta.tex \
        perl581delta.tex        \