From e5d5ef51af824caa7c7a6b580a7df89ddeb380a7 Mon Sep 17 00:00:00 2001 From: DongHun Kwak Date: Wed, 28 Jun 2017 10:51:25 +0900 Subject: [PATCH] Imported Upstream version 5.25.9 Change-Id: Id3d2d48a2c217990b8454e7bf68f00078c07c599 Signed-off-by: DongHun Kwak --- .gitignore | 3 + AUTHORS | 2 + Configure | 34 +- Cross/Makefile-cross-SH | 4 +- Cross/config.sh-arm-linux | 40 +- Cross/config.sh-arm-linux-n770 | 40 +- Cross/generate_config_sh | 2 +- INSTALL | 37 +- MANIFEST | 7 +- META.json | 2 +- META.yml | 2 +- Makefile.SH | 88 +- NetWare/Makefile | 7 +- NetWare/config_H.wc | 10 +- NetWare/config_h.PL | 4 +- NetWare/config_sh.PL | 4 +- NetWare/t/NWModify.pl | 2 +- NetWare/t/NWScripts.pl | 8 +- Porting/Glossary | 5 + Porting/Maintainers.pl | 24 +- Porting/Maintainers.pm | 4 +- Porting/add-package.pl | 4 +- Porting/check83.pl | 2 +- Porting/checkAUTHORS.pl | 3 +- Porting/checkVERSION.pl | 2 +- Porting/checkansi.pl | 2 +- Porting/checkcfguse.pl | 6 +- Porting/config.sh | 42 +- Porting/config_H | 18 +- Porting/config_h.pl | 4 +- Porting/corecpan.pl | 2 +- Porting/epigraphs.pod | 136 + Porting/leakfinder.pl | 6 +- Porting/makerel | 2 +- Porting/manicheck | 2 +- Porting/release_managers_guide.pod | 15 +- Porting/release_schedule.pod | 8 +- Porting/sync-with-cpan | 193 +- Porting/todo.pod | 4 +- README | 2 +- README.haiku | 4 +- README.macosx | 8 +- README.os2 | 2 +- README.vms | 4 +- autodoc.pl | 2 +- cflags.SH | 8 +- charclass_invlists.h | 10421 +++++++++++++------ configpm | 10 +- configure.com | 2 - cpan/CPAN/lib/App/Cpan.pm | 21 +- cpan/CPAN/lib/CPAN.pm | 15 +- cpan/CPAN/lib/CPAN/Bundle.pm | 9 +- cpan/CPAN/lib/CPAN/Distribution.pm | 49 +- .../CPAN/lib/CPAN/Exception/RecursiveDependency.pm | 40 +- cpan/CPAN/lib/CPAN/FTP.pm | 4 +- cpan/CPAN/lib/CPAN/FirstTime.pm | 11 +- cpan/CPAN/lib/CPAN/HandleConfig.pm | 5 +- cpan/CPAN/lib/CPAN/Module.pm | 9 +- cpan/Compress-Raw-Bzip2/Bzip2.xs | 4 +- cpan/Compress-Raw-Bzip2/bzip2-src/compress.c | 2 +- cpan/Compress-Raw-Bzip2/lib/Compress/Raw/Bzip2.pm | 8 +- cpan/Compress-Raw-Bzip2/t/000prereq.t | 2 +- cpan/Compress-Raw-Zlib/Zlib.xs | 2 +- cpan/Compress-Raw-Zlib/lib/Compress/Raw/Zlib.pm | 18 +- cpan/Compress-Raw-Zlib/zlib-src/inflate.c | 2 +- cpan/DB_File/DB_File.pm | 2 +- cpan/DB_File/DB_File.xs | 3 + cpan/Scalar-List-Utils/t/tainted.t | 3 + .../Test-Simple/t/Test2/modules/IPC/Driver/Files.t | 8 +- dist/Data-Dumper/Dumper.pm | 6 +- dist/Data-Dumper/Dumper.xs | 2 + dist/Data-Dumper/t/bugs.t | 13 +- dist/Devel-SelfStubber/lib/Devel/SelfStubber.pm | 4 +- dist/Devel-SelfStubber/t/Devel-SelfStubber.t | 22 +- dist/Dumpvalue/t/Dumpvalue.t | 2 +- dist/ExtUtils-CBuilder/t/01-basic.t | 2 +- dist/ExtUtils-CBuilder/t/02-link.t | 2 +- dist/ExtUtils-CBuilder/t/03-cplusplus.t | 2 +- dist/I18N-LangTags/lib/I18N/LangTags.pm | 6 +- dist/IO/Makefile.PL | 2 +- dist/IO/t/IO.t | 2 +- dist/IO/t/io_dir.t | 2 +- dist/IO/t/io_file.t | 2 +- dist/IO/t/io_linenum.t | 2 +- dist/IO/t/io_sock.t | 2 +- dist/IO/t/io_unix.t | 2 +- dist/Module-CoreList/Changes | 9 + dist/Module-CoreList/lib/Module/CoreList.pm | 434 +- .../lib/Module/CoreList/TieHashDelta.pm | 2 +- dist/Module-CoreList/lib/Module/CoreList/Utils.pm | 25 +- dist/Safe/t/safe2.t | 2 +- dist/Safe/t/safeops.t | 2 +- dist/Search-Dict/t/Dict.t | 2 +- dist/Storable/Storable.pm | 10 +- dist/Storable/Storable.xs | 10 +- dist/Storable/t/code.t | 4 +- dist/Storable/t/compat01.t | 2 +- dist/Storable/t/destroy.t | 2 +- dist/Storable/t/file_magic.t | 2 +- dist/Storable/t/forgive.t | 2 +- dist/Storable/t/store.t | 18 +- dist/Storable/t/testlib.pl | 6 +- dist/Term-ReadLine/lib/Term/ReadLine.pm | 7 +- dist/Test/lib/Test.pm | 8 +- dist/Test/t/mix.t | 4 +- dist/Test/t/onfail.t | 2 +- dist/Test/t/todo.t | 4 +- dist/Tie-File/t/01_gen.t | 2 +- dist/Tie-File/t/02_fetchsize.t | 2 +- dist/Tie-File/t/03_longfetch.t | 2 +- dist/Tie-File/t/04_splice.t | 2 +- dist/Tie-File/t/05_size.t | 4 +- dist/Tie-File/t/07_rv_splice.t | 2 +- dist/Tie-File/t/08_ro.t | 4 +- dist/Tie-File/t/09_gen_rs.t | 2 +- dist/Tie-File/t/10_splice_rs.t | 2 +- dist/Tie-File/t/11_rv_splice_rs.t | 2 +- dist/Tie-File/t/12_longfetch_rs.t | 2 +- dist/Tie-File/t/13_size_rs.t | 4 +- dist/Tie-File/t/14_lock.t | 2 +- dist/Tie-File/t/16_handle.t | 2 +- dist/Tie-File/t/19_cache.t | 4 +- dist/Tie-File/t/20_cache_full.t | 4 +- dist/Tie-File/t/21_win32.t | 2 +- dist/Tie-File/t/22_autochomp.t | 2 +- dist/Tie-File/t/23_rv_ac_splice.t | 2 +- dist/Tie-File/t/24_cache_loop.t | 2 +- dist/Tie-File/t/25_gen_nocache.t | 2 +- dist/Tie-File/t/26_twrite.t | 8 +- dist/Tie-File/t/27_iwrite.t | 4 +- dist/Tie-File/t/28_mtwrite.t | 4 +- dist/Tie-File/t/29_downcopy.t | 6 +- dist/Tie-File/t/29a_upcopy.t | 6 +- dist/Tie-File/t/30_defer.t | 6 +- dist/Tie-File/t/31_autodefer.t | 2 +- dist/Tie-File/t/32_defer_misc.t | 2 +- dist/Tie-File/t/33_defer_vs.t | 2 +- dist/Time-HiRes/Makefile.PL | 12 +- dist/Time-HiRes/t/alarm.t | 2 +- dist/Time-HiRes/t/sleep.t | 2 +- dist/Time-HiRes/t/stat.t | 6 +- dist/Time-HiRes/t/utime.t | 4 +- dist/XSLoader/XSLoader_pm.PL | 6 +- dist/lib/lib_pm.PL | 4 +- dist/lib/t/01lib.t | 2 +- dist/threads-shared/lib/threads/shared.pm | 4 +- dist/threads-shared/shared.xs | 10 + dist/threads/lib/threads.pm | 4 +- dist/threads/t/exit.t | 10 +- dist/threads/t/kill3.t | 113 + dist/threads/t/thread.t | 2 +- dist/threads/threads.xs | 2 + djgpp/fixpmain | 6 +- doio.c | 2 +- dosish.h | 2 +- dquote.c | 8 +- embed.fnc | 86 +- embed.h | 26 +- embedvar.h | 2 + ext/B/B/Terse.pm | 4 +- ext/B/B/Xref.pm | 4 +- ext/B/t/OptreeCheck.pm | 4 +- ext/B/t/xref.t | 2 +- ext/Devel-Peek/t/Peek.t | 12 +- ext/DynaLoader/DynaLoader_pm.PL | 4 +- ext/Errno/Errno_pm.PL | 12 +- ext/Fcntl/t/syslfs.t | 2 +- ext/File-Glob/Glob.pm | 8 +- ext/File-Glob/t/basic.t | 4 +- ext/FileCache/t/02maxopen.t | 2 +- ext/GDBM_File/t/fatal.t | 2 +- ext/IPC-Open3/t/IPC-Open3.t | 2 +- ext/IPC-Open3/t/fd.t | 2 +- ext/POSIX/t/posix.t | 2 +- ext/POSIX/t/sigaction.t | 4 +- ext/POSIX/t/sysconf.t | 2 +- ext/PerlIO-encoding/t/encoding.t | 10 +- ext/PerlIO-encoding/t/fallback.t | 6 +- ext/PerlIO-scalar/scalar.pm | 2 +- ext/PerlIO-scalar/scalar.xs | 3 +- ext/PerlIO-via/t/via.t | 4 +- ext/Pod-Html/lib/Pod/Html.pm | 6 +- ext/Pod-Html/t/pod2html-lib.pl | 4 +- ext/VMS-DCLsym/DCLsym.pm | 4 +- ext/XS-APItest/APItest.pm | 2 +- ext/XS-APItest/APItest.xs | 865 +- ext/XS-APItest/Makefile.PL | 5 +- ext/XS-APItest/t/handy.t | 674 +- ext/XS-APItest/t/printf.t | 2 +- ext/XS-APItest/t/utf8.t | 67 +- ext/XS-Typemap/t/Typemap.t | 2 +- ext/attributes/attributes.pm | 11 +- ext/re/re.pm | 60 +- ext/re/t/reflags.t | 17 +- gv.c | 34 +- h2pl/mksizes | 2 +- h2pl/mkvars | 2 +- handy.h | 579 +- hints/catamount.sh | 4 +- hints/freebsd.sh | 10 +- installhtml | 26 +- intrpvar.h | 8 +- lib/B/Deparse-core.t | 2 +- lib/B/Deparse.pm | 4 +- lib/B/Op_private.pm | 2 +- lib/DBM_Filter/t/01error.t | 2 +- lib/DBM_Filter/t/02core.t | 2 +- lib/English.t | 6 +- lib/ExtUtils/Embed.pm | 4 +- lib/File/Compare.t | 2 +- lib/File/Copy.t | 36 +- lib/File/stat.t | 2 +- lib/SelectSaver.t | 4 +- lib/Symbol.pm | 4 +- lib/Tie/Handle/stdhandle.t | 2 +- lib/Unicode/UCD.pm | 4 +- lib/diagnostics.pm | 6 +- lib/feature.pm | 6 +- lib/h2ph.t | 2 +- lib/h2xs.t | 4 +- lib/overload.pm | 4 +- lib/perl5db.pl | 37 +- lib/perl5db.t | 2 + lib/unicore/mktables | 12 + lib/utf8.t | 2 +- lib/vmsish.t | 6 +- locale.c | 21 +- make_ext.pl | 2 +- makedef.pl | 2 +- makedepend.SH | 2 +- mathoms.c | 8 +- mg.c | 20 +- op.c | 301 +- op.h | 3 +- os2/OS2/OS2-Process/Process.pm | 6 +- os2/os2ish.h | 2 +- pad.c | 3 +- patchlevel.h | 8 +- perl.c | 10 +- plan9/config.plan9 | 10 +- plan9/config_sh.sample | 38 +- plan9/genconfig.pl | 10 +- plan9/plan9ish.h | 2 +- pod/.gitignore | 2 +- pod/perl.pod | 6 +- pod/perl5223delta.pod | 314 + pod/perl5241delta.pod | 308 + pod/perl5258delta.pod | 213 + pod/perlcheat.pod | 2 +- pod/perldelta.pod | 585 +- pod/perldeprecation.pod | 455 + pod/perldiag.pod | 274 +- pod/perlebcdic.pod | 3 - pod/perlhacktips.pod | 10 +- pod/perlhist.pod | 7 +- pod/perlop.pod | 26 +- pod/perlpodspec.pod | 2 +- pod/perlport.pod | 25 +- pod/perlre.pod | 94 +- pod/perlrecharclass.pod | 38 +- pod/perlref.pod | 6 +- pod/perlrequick.pod | 3 + pod/perlretut.pod | 69 +- pod/perlstyle.pod | 5 +- pod/perlsyn.pod | 6 +- pod/perlunicode.pod | 10 + pod/perluniintro.pod | 15 +- pod/perlutil.pod | 9 +- pod/perlvar.pod | 13 +- pod/splitman | 2 +- pod/splitpod | 2 +- pp.c | 36 +- pp_ctl.c | 20 + pp_hot.c | 6 +- pp_pack.c | 13 +- pp_sort.c | 12 +- pp_sys.c | 20 +- proto.h | 90 +- regcharclass.h | 6 +- regcomp.c | 216 +- regen/embed.pl | 2 +- regen/embed_lib.pl | 4 +- regen/feature.pl | 8 +- regen/mk_invlists.pl | 3 +- regen/opcode.pl | 2 +- regen/reentr.pl | 2 +- regen/regcharclass.pl | 2 +- regen/regcomp.pl | 2 +- regen/regen_lib.pl | 6 +- regexec.c | 193 +- regexp.h | 14 +- sv.c | 16 +- sv.h | 5 +- symbian/config.pl | 24 +- symbian/demo_pl | 2 +- symbian/hexdump.pl | 2 +- symbian/makesis.pl | 6 +- symbian/sisify.pl | 12 +- symbian/symbianish.h | 2 +- symbian/version.pl | 2 +- symbian/xsbuild.pl | 28 +- t/base/lex.t | 2 +- t/comp/parser.t | 2 +- t/lib/croak/pp_ctl | 3 +- t/lib/croak/toke | 7 + t/lib/overload_fallback.t | 15 +- t/lib/warnings/2use | 8 +- t/lib/warnings/9uninit | 4 +- t/lib/warnings/doop | 18 +- t/lib/warnings/gv | 34 +- t/lib/warnings/mg | 12 +- t/lib/warnings/op | 20 +- t/lib/warnings/pp | 6 +- t/lib/warnings/pp_sys | 20 +- t/lib/warnings/regcomp | 18 +- t/lib/warnings/sv | 3 + t/lib/warnings/toke | 87 +- t/lib/warnings/utf8 | 39 +- t/loc_tools.pl | 12 +- t/op/attrs.t | 5 +- t/op/const-optree.t | 3 +- t/op/coreamp.t | 8 +- t/op/dump.t | 7 + t/op/heredoc.t | 2 +- t/op/lex.t | 7 +- t/op/method.t | 9 +- t/op/pack.t | 14 +- t/op/range.t | 16 +- t/op/sort.t | 15 +- t/op/split.t | 14 +- t/op/stat.t | 10 +- t/op/taint.t | 16 +- t/op/tr.t | 53 +- t/op/write.t | 19 +- t/perf/benchmarks | 12 + t/perf/optree.t | 239 +- t/porting/customized.dat | 1 + t/porting/diag.t | 2 +- t/porting/known_pod_issues.dat | 3 +- t/re/anyof.t | 4 +- t/re/keep_tabs.t | 29 + t/re/pat.t | 43 +- t/re/pat_advanced.t | 2 +- t/re/re_tests | 16 +- t/re/reg_mesg.t | 76 +- t/re/regex_sets.t | 8 +- t/run/runenv.t | 145 +- t/test.pl | 3 +- t/uni/attrs.t | 2 +- t/uni/gv.t | 4 +- t/uni/parser.t | 2 + t/uni/variables.t | 2 +- toke.c | 929 +- universal.c | 7 +- unixish.h | 2 +- utf8.c | 834 +- utf8.h | 93 +- util.c | 14 +- utils.lst | 1 - utils/Makefile.PL | 10 +- utils/c2ph.PL | 1448 --- utils/corelist.PL | 4 +- utils/cpan.PL | 4 +- utils/enc2xs.PL | 4 +- utils/encguess.PL | 4 +- utils/h2ph.PL | 12 +- utils/h2xs.PL | 22 +- utils/instmodsh.PL | 4 +- utils/json_pp.PL | 4 +- utils/libnetcfg.PL | 2 +- utils/perlbug.PL | 2 +- utils/perldoc.PL | 2 +- utils/perlivp.PL | 2 +- utils/piconv.PL | 4 +- utils/pl2pm.PL | 4 +- utils/pod2html.PL | 2 +- utils/prove.PL | 4 +- utils/ptar.PL | 4 +- utils/ptardiff.PL | 4 +- utils/ptargrep.PL | 4 +- utils/shasum.PL | 4 +- utils/splain.PL | 6 +- utils/xsubpp.PL | 4 +- utils/zipdetails.PL | 4 +- vms/descrip_mms.template | 7 +- vms/gen_shrfls.pl | 4 +- vms/mms2make.pl | 4 +- vms/vms.c | 9 +- vms/vmsish.h | 2 +- win32/GNUmakefile | 10 +- win32/Makefile | 10 +- win32/bin/exetype.pl | 2 +- win32/bin/pl2bat.pl | 4 +- win32/bin/search.pl | 6 +- win32/ce-helpers/makedist.pl | 6 +- win32/config_h.PL | 4 +- win32/config_sh.PL | 4 +- win32/makefile.mk | 10 +- win32/pod.mak | 16 + 399 files changed, 15835 insertions(+), 7657 deletions(-) create mode 100644 dist/threads/t/kill3.t create mode 100644 pod/perl5223delta.pod create mode 100644 pod/perl5241delta.pod create mode 100644 pod/perl5258delta.pod create mode 100644 pod/perldeprecation.pod create mode 100644 t/re/keep_tabs.t delete mode 100644 utils/c2ph.PL diff --git a/.gitignore b/.gitignore index 157390a..131b1e4 100644 --- a/.gitignore +++ b/.gitignore @@ -199,3 +199,6 @@ GPATH GRPATH GRTAGS GTAGS + +# generated by Porting/sync-with-cpan +/make.log diff --git a/AUTHORS b/AUTHORS index b341532..e5eff79 100644 --- a/AUTHORS +++ b/AUTHORS @@ -963,6 +963,7 @@ Per Einar Ellefsen Perlover Pete Peterson Peter BARABAS +Peter Avalos Peter Chines Peter Dintelmann Peter E. Yee @@ -1183,6 +1184,7 @@ Thomas Bowditch Thomas Conté Thomas Dorner Thomas Kofler +Tomasz Konojacki Thomas König Thomas Pfau Thomas Sibley diff --git a/Configure b/Configure index 845fc43..9d91a81 100755 --- a/Configure +++ b/Configure @@ -949,6 +949,7 @@ lddlflags='' usedl='' doublesize='' dtraceobject='' +dtracexnolibs='' ebcdic='' fflushNULL='' fflushall='' @@ -20966,12 +20967,38 @@ randseedtype=U32 : object file that uses at least one of the probes defined in the .d file case "$usedtrace" in $define) + case "$dtracexnolibs" in + $define|true|[yY]*) + dtracexnolibs=$define + $dtrace -h -xnolibs -s ../perldtrace.d -o perldtrace.h + ;; + ' '|'') + if $dtrace -h -xnolibs -s ../perldtrace.d -o perldtrace.h 2>&1 ; then + dtracexnolibs=$define + echo "Your dtrace accepts -xnolibs" + elif $dtrace -h -s ../perldtrace.d -o perldtrace.h 2>&1 ; then + dtracexnolibs=$undef + echo "Your dtrace doesn't accept -xnolibs" + else + echo "Your dtrace doesn't work at all, try building without dtrace support" >&4 + exit 1 + fi + ;; + *) + dtracexnolibs=$undef + $dtrace -h -s ../perldtrace.d -o perldtrace.h + ;; + esac + case $dtracexnolibs in + $define) xnolibs=-xnolibs ;; + *) xnolibs= ;; + esac + case "$dtraceobject" in $define|true|[yY]*) dtraceobject=$define ;; ' '|'') - $dtrace -h -s ../perldtrace.d -o perldtrace.h $cat >try.c </dev/null 2>&1; then + && $dtrace -G $xnolibs -s ../perldtrace.d try.o >/dev/null 2>&1; then dtraceobject=$define echo "Your dtrace builds an object file" fi - $rm -f try.c try.o perldtrace.o ;; *) dtraceobject=$undef ;; esac + $rm -f try.c try.o perldtrace.o perldtrace.h esac : Determine if this is an EBCDIC system @@ -24954,6 +24981,7 @@ drand01='$drand01' drand48_r_proto='$drand48_r_proto' dtrace='$dtrace' dtraceobject='$dtraceobject' +dtracexnolibs='$dtracexnolibs' dynamic_ext='$dynamic_ext' eagain='$eagain' ebcdic='$ebcdic' diff --git a/Cross/Makefile-cross-SH b/Cross/Makefile-cross-SH index 31e4aaf..90f9f6f 100644 --- a/Cross/Makefile-cross-SH +++ b/Cross/Makefile-cross-SH @@ -327,7 +327,7 @@ private = preplibrary $(CONFIGPM) $(CROSS_LIB)/Config.pod lib/buildcustomize.pl shextract = Makefile cflags config.h makedepend \ makedir myconfig writemain pod/Makefile -addedbyconf = UU $(shextract) lib/lib.pm pstruct +addedbyconf = UU $(shextract) lib/lib.pm # Unicode data files generated by mktables unidatafiles = lib/unicore/Decomposition.pl lib/unicore/TestProp.pl \ @@ -997,7 +997,7 @@ _cleaner2: rm -rf $(unidatafiles) $(unidatadirs) rm -rf lib/auto rm -f lib/.exists lib/*/.exists lib/*/*/.exists - rm -f h2ph.man pstruct + rm -f h2ph.man rm -rf .config rm -f preload rm -rf lib/Encode lib/Compress lib/Hash lib/re diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux index 23865c3..c2647f0 100644 --- a/Cross/config.sh-arm-linux +++ b/Cross/config.sh-arm-linux @@ -32,12 +32,12 @@ alignbytes='4' ansi2knr='' aphostname='/bin/hostname' api_revision='5' -api_subversion='8' +api_subversion='9' api_version='25' -api_versionstring='5.25.8' +api_versionstring='5.25.9' ar='ar' -archlib='/usr/lib/perl5/5.25.8/armv4l-linux' -archlibexp='/usr/lib/perl5/5.25.8/armv4l-linux' +archlib='/usr/lib/perl5/5.25.9/armv4l-linux' +archlibexp='/usr/lib/perl5/5.25.9/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.8/armv4l-linux/CORE' +ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.25.9/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' @@ -826,7 +826,7 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='./install_me_here/usr/lib/perl5/5.25.8/armv4l-linux' +installarchlib='./install_me_here/usr/lib/perl5/5.25.9/armv4l-linux' installbin='./install_me_here/usr/bin' installhtml1dir='' installhtml3dir='' @@ -834,13 +834,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.8' +installprivlib='./install_me_here/usr/lib/perl5/5.25.9' installscript='./install_me_here/usr/bin' -installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.25.8/armv4l-linux' +installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.25.9/armv4l-linux' installsitebin='./install_me_here/usr/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.25.8' +installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.25.9' installsiteman1dir='./install_me_here/usr/share/man/man1' installsiteman3dir='./install_me_here/usr/share/man/man3' installsitescript='./install_me_here/usr/bin' @@ -974,8 +974,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/usr/lib/perl5/5.25.8' -privlibexp='/usr/lib/perl5/5.25.8' +privlib='/usr/lib/perl5/5.25.9' +privlibexp='/usr/lib/perl5/5.25.9' procselfexe='"/proc/self/exe"' prototype='define' ptrsize='4' @@ -1040,17 +1040,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.8/armv4l-linux' -sitearchexp='/usr/lib/perl5/site_perl/5.25.8/armv4l-linux' +sitearch='/usr/lib/perl5/site_perl/5.25.9/armv4l-linux' +sitearchexp='/usr/lib/perl5/site_perl/5.25.9/armv4l-linux' sitebin='/usr/bin' sitebinexp='/usr/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/usr/lib/perl5/site_perl/5.25.8' +sitelib='/usr/lib/perl5/site_perl/5.25.9' sitelib_stem='/usr/lib/perl5/site_perl' -sitelibexp='/usr/lib/perl5/site_perl/5.25.8' +sitelibexp='/usr/lib/perl5/site_perl/5.25.9' siteman1dir='/usr/share/man/man1' siteman1direxp='/usr/share/man/man1' siteman3dir='/usr/share/man/man3' @@ -1089,7 +1089,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='8' +subversion='9' sysman='/usr/share/man/man1' tail='' tar='' @@ -1181,8 +1181,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.25.8' -version_patchlevel_string='version 25 subversion 8' +version='5.25.9' +version_patchlevel_string='version 25 subversion 9' versiononly='undef' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1196,9 +1196,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=25 -PERL_SUBVERSION=8 +PERL_SUBVERSION=9 PERL_API_REVISION=5 PERL_API_VERSION=25 -PERL_API_SUBVERSION=8 +PERL_API_SUBVERSION=9 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770 index e785f30..05d51b7 100644 --- a/Cross/config.sh-arm-linux-n770 +++ b/Cross/config.sh-arm-linux-n770 @@ -32,12 +32,12 @@ alignbytes='4' ansi2knr='' aphostname='/bin/hostname' api_revision='5' -api_subversion='8' +api_subversion='9' api_version='25' -api_versionstring='5.25.8' +api_versionstring='5.25.9' ar='ar' -archlib='/usr/lib/perl5/5.25.8/armv4l-linux' -archlibexp='/usr/lib/perl5/5.25.8/armv4l-linux' +archlib='/usr/lib/perl5/5.25.9/armv4l-linux' +archlibexp='/usr/lib/perl5/5.25.9/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.8/armv4l-linux/CORE' +ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.25.9/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.8/armv4l-linux' +installarchlib='./install_me_here/usr/lib/perl5/5.25.9/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.8' +installprivlib='./install_me_here/usr/lib/perl5/5.25.9' installscript='./install_me_here/usr/bin' -installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.25.8/armv4l-linux' +installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.25.9/armv4l-linux' installsitebin='./install_me_here/usr/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.25.8' +installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.25.9' 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.8' -privlibexp='/usr/lib/perl5/5.25.8' +privlib='/usr/lib/perl5/5.25.9' +privlibexp='/usr/lib/perl5/5.25.9' 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.8/armv4l-linux' -sitearchexp='/usr/lib/perl5/site_perl/5.25.8/armv4l-linux' +sitearch='/usr/lib/perl5/site_perl/5.25.9/armv4l-linux' +sitearchexp='/usr/lib/perl5/site_perl/5.25.9/armv4l-linux' sitebin='/usr/bin' sitebinexp='/usr/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/usr/lib/perl5/site_perl/5.25.8' +sitelib='/usr/lib/perl5/site_perl/5.25.9' sitelib_stem='/usr/lib/perl5/site_perl' -sitelibexp='/usr/lib/perl5/site_perl/5.25.8' +sitelibexp='/usr/lib/perl5/site_perl/5.25.9' 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='8' +subversion='9' sysman='/usr/share/man/man1' tail='' tar='' @@ -1035,8 +1035,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.25.8' -version_patchlevel_string='version 25 subversion 8' +version='5.25.9' +version_patchlevel_string='version 25 subversion 9' 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=8 +PERL_SUBVERSION=9 PERL_API_REVISION=5 PERL_API_VERSION=25 -PERL_API_SUBVERSION=8 +PERL_API_SUBVERSION=9 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/Cross/generate_config_sh b/Cross/generate_config_sh index e47042a..203885e 100755 --- a/Cross/generate_config_sh +++ b/Cross/generate_config_sh @@ -44,7 +44,7 @@ if ($config eq "") { die("Please run me as generate_config_sh path/to/original/config.sh"); } -open(FILE, "$config") || die("Unable to open $config"); +open(FILE, '<', $config) || die("Unable to open $config"); my $line_in; while ($line_in = ) { diff --git a/INSTALL b/INSTALL index 97578ba..8fcc58f 100644 --- a/INSTALL +++ b/INSTALL @@ -423,6 +423,13 @@ See L and L for details on the environment variables, and L for further security details. +The C and PERL_PERTURB_KEYS> environment variables can +be disabled by building configuring perl with +C<-Accflags=-DNO_PERL_HASH_ENV>. + +The C environment variable can be disabled by +configuring perl with C<-Accflags=-DNO_PERL_HASH_SEED_DEBUG>. + =head3 SOCKS Perl can be configured to be 'socksified', that is, to use the SOCKS @@ -581,7 +588,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.8. +By default, Configure will use the following directories for 5.25.9. $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 @@ -2232,8 +2239,6 @@ make install will install the following: cppstdin This is used by the deprecated switch perl -P, if your cc -E can't read from stdin. - c2ph, pstruct Scripts for handling C structures in header - files. corelist Shows versions of modules that come with different versions of perl. @@ -2436,7 +2441,7 @@ http://www.chiark.greenend.org.uk/~sgtatham/bugs.html =head1 Coexistence with earlier versions of perl 5 -Perl 5.25.8 is not binary compatible with earlier versions of Perl. +Perl 5.25.9 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 @@ -2511,9 +2516,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.8 + sh Configure -Dprefix=/opt/perl5.25.9 -and adding /opt/perl5.25.8/bin to the shell PATH variable. Such users +and adding /opt/perl5.25.9/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. @@ -2528,11 +2533,11 @@ yet. =head2 Upgrading from 5.25.2 or earlier -B Perl modules having binary parts (meaning that a C compiler is used) will have to be recompiled to be -used with 5.25.8. If you find you do need to rebuild an extension with -5.25.8, you may safely do so without disturbing the older +used with 5.25.9. If you find you do need to rebuild an extension with +5.25.9, you may safely do so without disturbing the older installations. (See L<"Coexistence with earlier versions of perl 5"> above.) @@ -2565,15 +2570,15 @@ Firstly, the bare minimum to run this script print("$f\n"); } -in Linux with perl-5.25.8 is as follows (under $Config{prefix}): +in Linux with perl-5.25.9 is as follows (under $Config{prefix}): ./bin/perl - ./lib/perl5/5.25.8/strict.pm - ./lib/perl5/5.25.8/warnings.pm - ./lib/perl5/5.25.8/i686-linux/File/Glob.pm - ./lib/perl5/5.25.8/feature.pm - ./lib/perl5/5.25.8/XSLoader.pm - ./lib/perl5/5.25.8/i686-linux/auto/File/Glob/Glob.so + ./lib/perl5/5.25.9/strict.pm + ./lib/perl5/5.25.9/warnings.pm + ./lib/perl5/5.25.9/i686-linux/File/Glob.pm + ./lib/perl5/5.25.9/feature.pm + ./lib/perl5/5.25.9/XSLoader.pm + ./lib/perl5/5.25.9/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 diff --git a/MANIFEST b/MANIFEST index 714a384..4875774 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3689,6 +3689,7 @@ dist/threads/t/free2.t More ithread destruction tests dist/threads/t/join.t Testing the join function dist/threads/t/kill.t Tests thread signalling dist/threads/t/kill2.t Tests thread signalling +dist/threads/t/kill3.t Tests thread signalling dist/threads/t/libc.t testing libc functions for threadsafety dist/threads/t/list.t Test threads->list() dist/threads/t/no_threads.t threads test for non-threaded Perls @@ -4902,7 +4903,9 @@ pod/perl5203delta.pod Perl changes in version 5.20.3 pod/perl5220delta.pod Perl changes in version 5.22.0 pod/perl5221delta.pod Perl changes in version 5.22.1 pod/perl5222delta.pod Perl changes in version 5.22.2 +pod/perl5223delta.pod Perl changes in version 5.22.3 pod/perl5240delta.pod Perl changes in version 5.24.0 +pod/perl5241delta.pod Perl changes in version 5.24.1 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 @@ -4911,6 +4914,7 @@ pod/perl5254delta.pod Perl changes in version 5.25.4 pod/perl5255delta.pod Perl changes in version 5.25.5 pod/perl5256delta.pod Perl changes in version 5.25.6 pod/perl5257delta.pod Perl changes in version 5.25.7 +pod/perl5258delta.pod Perl changes in version 5.25.8 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 @@ -4938,6 +4942,7 @@ pod/perldebguts.pod Perl debugging guts and tips pod/perldebtut.pod Perl debugging tutorial pod/perldebug.pod Perl debugging pod/perldelta.pod Perl changes since previous version +pod/perldeprecation.pod Perl deprecations pod/perldiag.pod Perl diagnostic messages pod/perldsc.pod Perl data structures intro pod/perldtrace.pod Perl's support for DTrace @@ -5724,6 +5729,7 @@ t/porting/utils.t Check that utility scripts still compile t/re/anyof.t See if bracketed char classes [...] compile properly t/re/charset.t See if regex modifiers like /d, /u work properly t/re/fold_grind.t See if case folding works properly +t/re/keep_tabs.t Tests where \t can't be expanded. t/re/no_utf8_pm.t Verify utf8.pm doesn't get loaded unless required t/re/overload.t Test against string corruption in pattern matches on overloaded objects t/re/pat.t See if esoteric patterns work @@ -5885,7 +5891,6 @@ utfebcdic.h Unicode on EBCDIC (UTF-EBCDIC, tr16) header util.c Utility routines util.h Dummy header utils.lst Lists utilities bundled with Perl -utils/c2ph.PL program to translate dbx stabs to perl utils/corelist.PL Module::CoreList utils/cpan.PL easily interact with CPAN from the command line utils/enc2xs.PL Encode module generator diff --git a/META.json b/META.json index 0c22a75..41aa72a 100644 --- a/META.json +++ b/META.json @@ -126,6 +126,6 @@ "url" : "http://perl5.git.perl.org/" } }, - "version" : "5.025008", + "version" : "5.025009", "x_serialization_backend" : "JSON::PP version 2.27400_02" } diff --git a/META.yml b/META.yml index b5496d4..6753b00 100644 --- a/META.yml +++ b/META.yml @@ -113,5 +113,5 @@ resources: homepage: http://www.perl.org/ license: http://dev.perl.org/licenses/ repository: http://perl5.git.perl.org/ -version: '5.025008' +version: '5.025009' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/Makefile.SH b/Makefile.SH index 33befde..2cb0010 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -390,8 +390,13 @@ VG_TEST ?= ./perl -e 1 2>/dev/null ;; esac +case "$dtracexnolibs" in +define) xnolibs=-xnolibs ;; +*) xnolibs= ;; +esac + $spitshell >>$Makefile <>$Makefile <<'!NO!SUBS!' -addedbyconf = UU $(shextract) pstruct +addedbyconf = UU $(shextract) # Unicode data files generated by mktables unidatafiles = lib/unicore/Decomposition.pl lib/unicore/TestProp.pl \ @@ -518,11 +523,53 @@ main_only_objs = op$(OBJ_EXT) perl$(OBJ_EXT) miniperl_objs_nodt = $(mini_only_objs) $(common_objs) miniperlmain$(OBJ_EXT) perllib_objs_nodt = $(main_only_objs) $(common_objs) +!NO!SUBS! + +# dtrace with -G modifies the source object files, which can cause +# dependency issues, and can cause the dtrace -G to fail on FreeBSD +# so separate the objects generated by $(CC) from those used to link +# the executable when dtrace -G is involved. +# +# $(FOO:op%os=np%ns) isn't generally portable but is portable to +# the makes on darwin, Solaris, FreeBSD and Linux, which is where we +# use dtrace + +case "$usedtrace:$dtraceobject" in +define:define) + $spitshell >>$Makefile <<'!NO!SUBS!' + +miniperl_dtrace_objs = $(miniperl_objs_nodt:%=mpdtrace/%) +perllib_dtrace_objs = $(perllib_objs_nodt:%=libpdtrace/%) +perlmain_dtrace_objs = maindtrace/perlmain$(OBJ_EXT) + +miniperl_objs = $(miniperl_dtrace_objs) $(DTRACE_MINI_O) +perllib_objs = $(perllib_dtrace_objs) $(DTRACE_PERLLIB_O) +perlmain_objs = $(perlmain_dtrace_objs) $(DTRACE_MAIN_O) + +miniperl_dep = $(DTRACE_MINI_O) +perllib_dep = $(DTRACE_PERLLIB_O) +perlmain_dep = $(DTRACE_MAIN_O) + +!NO!SUBS! + ;; +*) + $spitshell >>$Makefile <<'!NO!SUBS!' + 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/perl5258delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod +miniperl_dep = $(miniperl_objs) +perllib_dep = $(perllib_objs) +perlmain_dep = $(perlmain_objs) + +!NO!SUBS! + ;; +esac + +$spitshell >>$Makefile <<'!NO!SUBS!' + +perltoc_pod_prereqs = extra.pods pod/perl5259delta.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 @@ -834,19 +881,32 @@ mydtrace.h: $(DTRACE_H) define) $spitshell >>$Makefile <<'!NO!SUBS!' $(DTRACE_MINI_O): perldtrace.d $(miniperl_objs_nodt) - $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MINI_O) $(miniperl_objs_nodt) + -rm -rf mpdtrace + mkdir mpdtrace + cp $(miniperl_objs_nodt) mpdtrace/ + $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MINI_O) $(miniperl_dtrace_objs) $(DTRACE_PERLLIB_O): perldtrace.d $(perllib_objs_nodt) - $(DTRACE) -G -s perldtrace.d -o $(DTRACE_PERLLIB_O) $(perllib_objs_nodt) + -rm -rf libpdtrace + mkdir libpdtrace + cp $(perllib_objs_nodt) libpdtrace/ + $(DTRACE) -G -s perldtrace.d -o $(DTRACE_PERLLIB_O) $(perllib_dtrace_objs) $(DTRACE_MAIN_O): perldtrace.d perlmain$(OBJ_EXT) - $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MAIN_O) perlmain$(OBJ_EXT) + -rm -rf maindtrace + mkdir maindtrace + cp perlmain$(OBJ_EXT) maindtrace/ + $(DTRACE) -G -s perldtrace.d -o $(DTRACE_MAIN_O) $(perlmain_dtrace_objs) || \ + ( $(ECHO) "No probes in perlmain$(OBJ_EXT), generating a dummy $(DTRACE_MAIN_O)" && \ + $(ECHO) >dtrace_main.c && \ + `$(CCCMD)` $(PLDLFLAGS) dtrace_main.c && \ + rm -f dtrace_main.c ) !NO!SUBS! ;; esac $spitshell >>$Makefile <<'!NO!SUBS!' -$(LIBPERL): $& $(perllib_objs) $(DYNALOADER) $(LIBPERLEXPORT) +$(LIBPERL): $& $(perllib_dep) $(DYNALOADER) $(LIBPERLEXPORT) !NO!SUBS! case "$useshrplib" in true) @@ -947,7 +1007,7 @@ lib/buildcustomize.pl: $& $(miniperl_objs) write_buildcustomize.pl *) if test "X$hostperl" != X; then $spitshell >>$Makefile <>$Makefile <<'!NO!SUBS!' -lib/buildcustomize.pl: $& $(miniperl_objs) write_buildcustomize.pl +lib/buildcustomize.pl: $& $(miniperl_dep) write_buildcustomize.pl -@rm -f miniperl.xok $(CC) $(CLDFLAGS) -o $(MINIPERL_EXE) \ $(miniperl_objs) $(libs) @@ -969,7 +1029,7 @@ lib/buildcustomize.pl: $& $(miniperl_objs) write_buildcustomize.pl $spitshell >>$Makefile <<'!NO!SUBS!' -$(PERL_EXE): $& $(perlmain_objs) $(LIBPERL) $(static_ext) ext.libs $(PERLEXPORT) write_buildcustomize.pl +$(PERL_EXE): $& $(perlmain_dep) $(LIBPERL) $(static_ext) ext.libs $(PERLEXPORT) write_buildcustomize.pl -@rm -f miniperl.xok !NO!SUBS! @@ -1059,9 +1119,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/perl5258delta.pod: pod/perldelta.pod - $(RMS) pod/perl5258delta.pod - $(LNS) perldelta.pod pod/perl5258delta.pod +pod/perl5259delta.pod: pod/perldelta.pod + $(RMS) pod/perl5259delta.pod + $(LNS) perldelta.pod pod/perl5259delta.pod extra.pods: $(MINIPERL_EXE) -@test ! -f extra.pods || rm -f `cat extra.pods` @@ -1338,7 +1398,7 @@ _cleaner2: rm -rf $(unidatafiles) $(unidatadirs) rm -rf lib/auto rm -f lib/.exists lib/*/.exists lib/*/*/.exists - rm -f h2ph.man pstruct + rm -f h2ph.man rm -rf .config rm -f preload rm -f pod2htmd.tmp diff --git a/NetWare/Makefile b/NetWare/Makefile index e061552..948bc94 100644 --- a/NetWare/Makefile +++ b/NetWare/Makefile @@ -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.8 for NetWare" +MODULE_DESC = "Perl 5.25.9 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.8 +INST_VER = \5.25.9 # # Comment this out if you DON'T want your perl installation to have @@ -661,7 +661,6 @@ UTILS = \ ..\utils\splain \ ..\utils\perlbug \ ..\utils\pl2pm \ - ..\utils\c2ph \ ..\utils\h2xs \ ..\utils\perldoc \ ..\pod\pod2html \ @@ -1349,7 +1348,7 @@ distclean: clean nwclean -del /f /q $(PODDIR)\*.html -del /f /q $(PODDIR)\*.bat cd ..\utils - -del /f /q h2ph splain perlbug pl2pm c2ph h2xs perldoc + -del /f /q h2ph splain perlbug pl2pm h2xs perldoc -del /f /q *.bat cd ..\netware -del /f /q ..\config.sh ..\splittree.pl dlutils.c config.h.new diff --git a/NetWare/config_H.wc b/NetWare/config_H.wc index e444500..8c02556 100644 --- a/NetWare/config_H.wc +++ b/NetWare/config_H.wc @@ -1042,7 +1042,7 @@ * 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.8\\lib\\NetWare-x86-multi-thread" /**/ +#define ARCHLIB "c:\\perl\\5.25.9\\lib\\NetWare-x86-multi-thread" /**/ /*#define ARCHLIB_EXP "" /**/ /* ARCHNAME: @@ -1073,8 +1073,8 @@ * 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.8\\bin\\NetWare-x86-multi-thread" /**/ -#define BIN_EXP "c:\\perl\\5.25.8\\bin\\NetWare-x86-multi-thread" /**/ +#define BIN "c:\\perl\\5.25.9\\bin\\NetWare-x86-multi-thread" /**/ +#define BIN_EXP "c:\\perl\\5.25.9\\bin\\NetWare-x86-multi-thread" /**/ /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, @@ -3088,7 +3088,7 @@ * 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.8\\lib\\NetWare-x86-multi-thread" /**/ +#define SITEARCH "c:\\perl\\site\\5.25.9\\lib\\NetWare-x86-multi-thread" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -3111,7 +3111,7 @@ * 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.8\\lib" /**/ +#define SITELIB "c:\\perl\\site\\5.25.9\\lib" /**/ /*#define SITELIB_EXP "" /**/ #define SITELIB_STEM "" /**/ diff --git a/NetWare/config_h.PL b/NetWare/config_h.PL index d0eb05a..67d5bc3 100644 --- a/NetWare/config_h.PL +++ b/NetWare/config_h.PL @@ -19,7 +19,7 @@ $patchlevel =~ s|~VERSION~|$Config{version}|g; $patchlevel ||= $Config{version}; $patchlevel = qq["$patchlevel"]; -open(SH,"<$name") || die "Cannot open $name:$!"; +open(SH,'<',$name) || die "Cannot open $name:$!"; while () { last if /^sed/; @@ -42,7 +42,7 @@ eval $str; die "$str:$@" if $@; -open(H,">$file.new") || die "Cannot open $file.new:$!"; +open(H,'>',"$file.new") || die "Cannot open $file.new:$!"; binmode H; # no CRs (which cause a spurious rebuild) while () { diff --git a/NetWare/config_sh.PL b/NetWare/config_sh.PL index 0e1d351..d2daf0e 100644 --- a/NetWare/config_sh.PL +++ b/NetWare/config_sh.PL @@ -18,7 +18,7 @@ sub loadopts { shift @ARGV; my $optfile = shift @ARGV; local (*F); - open OPTF, $optfile or die "Can't open $optfile: $!\n"; + open OPTF, '<', $optfile or die "Can't open $optfile: $!\n"; my @opts; chomp(my $line = ); my @vars = split(/\t+~\t+/, $line); @@ -43,7 +43,7 @@ while (@{$optref} && $optref->[0] =~ /^([\w_]+)=(.*)$/) { my $pl_h = '../patchlevel.h'; if (-e $pl_h) { - open PL, "<$pl_h" or die "Can't open $pl_h: $!"; + open PL, '<', $pl_h or die "Can't open $pl_h: $!"; while () { if (/^#\s*define\s+(PERL_\w+)\s+([\d.]+)/) { $opt{$1} = $2; diff --git a/NetWare/t/NWModify.pl b/NetWare/t/NWModify.pl index 4e98174..fa58b47 100644 --- a/NetWare/t/NWModify.pl +++ b/NetWare/t/NWModify.pl @@ -85,7 +85,7 @@ sub Process_File # Do the processing only if the file has '.t' extension. if($ext eq '.t') { - open(FH, "+< $FileToProcess") or die "Unable to open the file, $FileToProcess for reading and writing.\n"; + open(FH, '+<', $FileToProcess) or die "Unable to open the file, $FileToProcess for reading and writing.\n"; @ARRAY = ; # Get the contents of the file into an array. foreach $Line(@ARRAY) # Get each line of the file. diff --git a/NetWare/t/NWScripts.pl b/NetWare/t/NWScripts.pl index c16a4a1..5f21244 100644 --- a/NetWare/t/NWScripts.pl +++ b/NetWare/t/NWScripts.pl @@ -30,7 +30,7 @@ foreach $DirItem(@Dirs) # Open once in write mode since later files are opened in append mode, # and if there already exists a file with the same name, all further opens # will append to that file!! - open(FHW, "> $IntAutoScript") or die "Unable to open the file, $IntAutoScript for writing.\n"; + open(FHW, '>', $IntAutoScript) or die "Unable to open the file, $IntAutoScript for writing.\n"; seek(FHW, 0, 0); # seek to the beginning of the file. close FHW; # close the file. } @@ -39,7 +39,7 @@ foreach $DirItem(@Dirs) print "Generating t/nwauto.pl ...\n\n\n"; -open(FHWA, "> t/nwauto.pl") or die "Unable to open the file, t/nwauto.pl for writing.\n"; +open(FHWA, '>', 't/nwauto.pl') or die "Unable to open the file, t/nwauto.pl for writing.\n"; seek(FHWA, 0, 0); # seek to the beginning of the file. $version = sprintf("%vd",$^V); @@ -67,7 +67,7 @@ foreach $FileName(@DirNames) } # Write into the intermediary auto script. - open(FHW, ">> $IntAutoScript") or die "Unable to open the file, $IntAutoScript for appending.\n"; + open(FHW, '>>', $IntAutoScript) or die "Unable to open the file, $IntAutoScript for appending.\n"; seek(FHW, 0, 2); # seek to the end of the file. $pos = tell(FHW); @@ -164,7 +164,7 @@ foreach $DirItem(@Dirs) $IntAutoScript = "t/".$DirItem.".pl"; # Write into the intermediary auto script. - open(FHW, ">> $IntAutoScript") or die "Unable to open the file, $IntAutoScript for appending.\n"; + open(FHW, '>>', $IntAutoScript) or die "Unable to open the file, $IntAutoScript for appending.\n"; seek(FHW, 0, 2); # seek to the end of the file. # Write into the intermediary auto script. diff --git a/Porting/Glossary b/Porting/Glossary index 1d2a6ea..a94eaab 100644 --- a/Porting/Glossary +++ b/Porting/Glossary @@ -3031,6 +3031,11 @@ dtrace (usedtrace.U): dtraceobject (dtraceobject.U): Whether we need to build an object file with the dtrace tool. +dtracexnolibs (dtraceobject.U): + Whether dtrace accepts -xnolibs. If available we call dtrace -h + and dtrace -G with -xnolibs to allow dtrace to run in a jail on + FreeBSD. + dynamic_ext (Extensions.U): This variable holds a list of XS extension files we want to link dynamically into the package. It is used by Makefile. diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 00774d5..5e94e19 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -206,7 +206,7 @@ use File::Glob qw(:case); }, 'Compress::Raw::Bzip2' => { - 'DISTRIBUTION' => 'PMQS/Compress-Raw-Bzip2-2.069.tar.gz', + 'DISTRIBUTION' => 'PMQS/Compress-Raw-Bzip2-2.070.tar.gz', 'FILES' => q[cpan/Compress-Raw-Bzip2], 'EXCLUDED' => [ qr{^t/Test/}, @@ -217,7 +217,7 @@ use File::Glob qw(:case); }, 'Compress::Raw::Zlib' => { - 'DISTRIBUTION' => 'PMQS/Compress-Raw-Zlib-2.069.tar.gz', + 'DISTRIBUTION' => 'PMQS/Compress-Raw-Zlib-2.070.tar.gz', 'FILES' => q[cpan/Compress-Raw-Zlib], 'EXCLUDED' => [ @@ -251,7 +251,7 @@ use File::Glob qw(:case); }, 'CPAN' => { - 'DISTRIBUTION' => 'ANDK/CPAN-2.14.tar.gz', + 'DISTRIBUTION' => 'ANDK/CPAN-2.16-TRIAL2.tar.gz', 'FILES' => q[cpan/CPAN], 'EXCLUDED' => [ qr{^distroprefs/}, @@ -286,12 +286,6 @@ 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 @@ -335,7 +329,7 @@ use File::Glob qw(:case); }, 'DB_File' => { - 'DISTRIBUTION' => 'PMQS/DB_File-1.838.tar.gz', + 'DISTRIBUTION' => 'PMQS/DB_File-1.840.tar.gz', 'FILES' => q[cpan/DB_File], 'EXCLUDED' => [ qr{^patches/}, @@ -843,7 +837,7 @@ use File::Glob qw(:case); }, 'Module::CoreList' => { - 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20161120.tar.gz', + 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20161220.tar.gz', 'FILES' => q[dist/Module-CoreList], }, @@ -1178,6 +1172,10 @@ use File::Glob qw(:case); t/zzz-check-breaks.t ), ], + 'CUSTOMIZED' => [ + # + qw( t/Test2/modules/IPC/Driver/Files.t ) + ], }, 'Text::Abbrev' => { @@ -1245,7 +1243,7 @@ use File::Glob qw(:case); }, 'threads' => { - 'DISTRIBUTION' => 'JDHEDDEN/threads-2.09.tar.gz', + 'DISTRIBUTION' => 'JDHEDDEN/threads-2.12.tar.gz', 'FILES' => q[dist/threads], 'EXCLUDED' => [ qr{^examples/}, @@ -1257,7 +1255,7 @@ use File::Glob qw(:case); }, 'threads::shared' => { - 'DISTRIBUTION' => 'JDHEDDEN/threads-shared-1.52.tar.gz', + 'DISTRIBUTION' => 'JDHEDDEN/threads-shared-1.54.tar.gz', 'FILES' => q[dist/threads-shared], 'EXCLUDED' => [ qw( examples/class.pl diff --git a/Porting/Maintainers.pm b/Porting/Maintainers.pm index ef56abb..1c52829 100644 --- a/Porting/Maintainers.pm +++ b/Porting/Maintainers.pm @@ -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.11; +$VERSION = 0.12; require Exporter; @@ -41,7 +41,7 @@ sub reload_manifest { $manifest_path = "../MANIFEST"; } - if (open(my $manfh, $manifest_path )) { + if (open(my $manfh, '<', $manifest_path )) { while (<$manfh>) { if (/^(\S+)/) { $MANIFEST{$1}++; diff --git a/Porting/add-package.pl b/Porting/add-package.pl index ee03c45..012aa77 100755 --- a/Porting/add-package.pl +++ b/Porting/add-package.pl @@ -374,7 +374,7 @@ my @ChangedFiles; ### update the manifest { my $file = $Repo . '/MANIFEST'; my @manifest; - { open my $fh, "<$file" or die "Could not open $file: $!"; + { open my $fh, '<', $file or die "Could not open $file: $!"; @manifest = <$fh>; close $fh; } @@ -414,7 +414,7 @@ my @ChangedFiles; push @manifest, values %pkg_files; { chmod 0644, $file; - open my $fh, ">$file" or die "Could not open $file for writing: $!"; + open my $fh, '>', $file or die "Could not open $file for writing: $!"; #print $fh sort { lc $a cmp lc $b } @manifest; ### XXX stolen from pod/buildtoc:sub do_manifest print $fh diff --git a/Porting/check83.pl b/Porting/check83.pl index 64eac95..fbe5655 100755 --- a/Porting/check83.pl +++ b/Porting/check83.pl @@ -45,7 +45,7 @@ sub eight_dot_three { my %dir; -if (open(MANIFEST, "MANIFEST")) { +if (open(MANIFEST, '<', 'MANIFEST')) { while () { chomp; s/\s.+//; diff --git a/Porting/checkAUTHORS.pl b/Porting/checkAUTHORS.pl index 4204304..56fb39e 100755 --- a/Porting/checkAUTHORS.pl +++ b/Porting/checkAUTHORS.pl @@ -215,7 +215,7 @@ sub read_authors_files { return unless (@authors); my (%count, %raw); foreach my $filename (@authors) { - open FH, "<$filename" or die "Can't open $filename: $!"; + open FH, '<', $filename or die "Can't open $filename: $!"; binmode FH, ':encoding(UTF-8)'; while () { next if /^\#/; @@ -661,6 +661,7 @@ jasons\100cs.unm.edu jasons\100sandy-home.arc.unm.edu jbuehler\100hekimian.com jhpb\100hekimian.com jcromie\100100divsol.com jcromie\100cpan.org + jim.cromie\100gmail.com +jd\100cpanel.net lightsey\100debian.org jdhedden\100cpan.org jerry\100hedden.us + jdhedden\1001979.usna.com + jdhedden\100gmail.com diff --git a/Porting/checkVERSION.pl b/Porting/checkVERSION.pl index 9ad2ff5..d63c34e 100755 --- a/Porting/checkVERSION.pl +++ b/Porting/checkVERSION.pl @@ -24,7 +24,7 @@ sub parse_file { my $result; - open(FH,$parsefile) or warn "Could not open '$parsefile': $!"; + open(FH,'<',$parsefile) or warn "Could not open '$parsefile': $!"; my $inpod = 0; while () { diff --git a/Porting/checkansi.pl b/Porting/checkansi.pl index c072b28..f16691a 100755 --- a/Porting/checkansi.pl +++ b/Porting/checkansi.pl @@ -50,7 +50,7 @@ for my $k (keys %{$limits{$opt{std}}}) { find(sub { /\.([ch]|xs)$/ or return; - my $fh = IO::File->new($_) or die "$_: $!\n"; + my $fh = IO::File->new($_, 'r') or die "$_: $!\n"; my $ll = ''; while (defined(my $line = <$fh>)) { diff --git a/Porting/checkcfguse.pl b/Porting/checkcfguse.pl index af3dd12..986d4f9 100755 --- a/Porting/checkcfguse.pl +++ b/Porting/checkcfguse.pl @@ -47,7 +47,7 @@ my @PAT = print STDERR "$0: Looking for symbols...\n"; for my $pat (@PAT) { for my $fn (map { glob($_) } @{ $pat->[0] }) { - if (open(my $fh, $fn)) { + if (open(my $fh, '<', $fn)) { while (<$fh>) { for my $p (@$pat) { for my $sym (/$p/g) { @@ -70,7 +70,7 @@ delete $SYM{'const'}; my $SYM = join("|", sort { length($b) <=> length($a) || $a cmp $b } keys %SYM); -open(my $mani, "MANIFEST") or die "$0: Failed to open MANIFEST\n"; +open(my $mani, '<', "MANIFEST") or die "$0: Failed to open MANIFEST\n"; my %found; while (<$mani>) { @@ -80,7 +80,7 @@ while (<$mani>) { # from metaconfig generated files that refer to # the config symbols, and from pods. next if $fn =~ m{^(?:config_h.SH|Configure|configure\.com|Porting/(?:config|Glossary)|(?:NetWare|plan9|win32)/(?:config|(?:GNU)?[Mm]akefile)|uconfig)|\.pod$}; - open my $fh, $fn or die qq[$0: Failed to open $fn: $!]; + open my $fh, '<', $fn or die qq[$0: Failed to open $fn: $!]; while (<$fh>) { while (/\b($SYM)\b/go) { $found{$1}{$fn}++; diff --git a/Porting/config.sh b/Porting/config.sh index edb0cdd..fbeca17 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -39,12 +39,12 @@ alignbytes='8' ansi2knr='' aphostname='/bin/hostname' api_revision='5' -api_subversion='8' +api_subversion='9' api_version='25' -api_versionstring='5.25.8' +api_versionstring='5.25.9' ar='ar' -archlib='/tmp/mblead/lib/perl5/5.25.8/darwin-2level' -archlibexp='/tmp/mblead/lib/perl5/5.25.8/darwin-2level' +archlib='/tmp/mblead/lib/perl5/5.25.9/darwin-2level' +archlibexp='/tmp/mblead/lib/perl5/5.25.9/darwin-2level' archname64='' archname='darwin-2level' archobjs='' @@ -846,7 +846,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.8/darwin-2level' +installarchlib='/tmp/mblead/lib/perl5/5.25.9/darwin-2level' installbin='/tmp/mblead/bin' installhtml1dir='' installhtml3dir='' @@ -854,13 +854,13 @@ installman1dir='/tmp/mblead/man/man1' installman3dir='/tmp/mblead/man/man3' installprefix='/tmp/mblead' installprefixexp='/tmp/mblead' -installprivlib='/tmp/mblead/lib/perl5/5.25.8' +installprivlib='/tmp/mblead/lib/perl5/5.25.9' installscript='/tmp/mblead/bin' -installsitearch='/tmp/mblead/lib/perl5/site_perl/5.25.8/darwin-2level' +installsitearch='/tmp/mblead/lib/perl5/site_perl/5.25.9/darwin-2level' installsitebin='/tmp/mblead/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='/tmp/mblead/lib/perl5/site_perl/5.25.8' +installsitelib='/tmp/mblead/lib/perl5/site_perl/5.25.9' installsiteman1dir='/tmp/mblead/man/man1' installsiteman3dir='/tmp/mblead/man/man3' installsitescript='/tmp/mblead/bin' @@ -985,7 +985,7 @@ perl_patchlevel='' perl_static_inline='static __inline__' perladmin='aaron@daybreak.nonet' perllibs='-lpthread -ldl -lm -lutil -lc' -perlpath='/tmp/mblead/bin/perl5.25.8' +perlpath='/tmp/mblead/bin/perl5.25.9' pg='pg' phostname='hostname' pidtype='pid_t' @@ -994,8 +994,8 @@ pmake='' pr='' prefix='/tmp/mblead' prefixexp='/tmp/mblead' -privlib='/tmp/mblead/lib/perl5/5.25.8' -privlibexp='/tmp/mblead/lib/perl5/5.25.8' +privlib='/tmp/mblead/lib/perl5/5.25.9' +privlibexp='/tmp/mblead/lib/perl5/5.25.9' procselfexe='' prototype='define' ptrsize='8' @@ -1061,17 +1061,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.8/darwin-2level' -sitearchexp='/tmp/mblead/lib/perl5/site_perl/5.25.8/darwin-2level' +sitearch='/tmp/mblead/lib/perl5/site_perl/5.25.9/darwin-2level' +sitearchexp='/tmp/mblead/lib/perl5/site_perl/5.25.9/darwin-2level' sitebin='/tmp/mblead/bin' sitebinexp='/tmp/mblead/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/tmp/mblead/lib/perl5/site_perl/5.25.8' +sitelib='/tmp/mblead/lib/perl5/site_perl/5.25.9' sitelib_stem='/tmp/mblead/lib/perl5/site_perl' -sitelibexp='/tmp/mblead/lib/perl5/site_perl/5.25.8' +sitelibexp='/tmp/mblead/lib/perl5/site_perl/5.25.9' siteman1dir='/tmp/mblead/man/man1' siteman1direxp='/tmp/mblead/man/man1' siteman3dir='/tmp/mblead/man/man3' @@ -1097,7 +1097,7 @@ src='.' ssizetype='ssize_t' st_ino_sign='1' st_ino_size='8' -startperl='#!/tmp/mblead/bin/perl5.25.8' +startperl='#!/tmp/mblead/bin/perl5.25.9' startsh='#!/bin/sh' static_ext=' ' stdchar='char' @@ -1110,7 +1110,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='8' +subversion='9' sysman='/usr/share/man/man1' sysroot='' tail='' @@ -1209,8 +1209,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.25.8' -version_patchlevel_string='version 25 subversion 8' +version='5.25.9' +version_patchlevel_string='version 25 subversion 9' versiononly='define' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1220,9 +1220,9 @@ zcat='' zip='zip' PERL_REVISION=5 PERL_VERSION=25 -PERL_SUBVERSION=8 +PERL_SUBVERSION=9 PERL_API_REVISION=5 PERL_API_VERSION=25 -PERL_API_SUBVERSION=8 +PERL_API_SUBVERSION=9 PERL_PATCHLEVEL='' PERL_CONFIG_SH=true diff --git a/Porting/config_H b/Porting/config_H index 421feca..54b5b9d 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -960,8 +960,8 @@ * 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.8/i686-linux-64int-ld" /**/ -#define ARCHLIB_EXP "/pro/lib/perl5/5.25.8/i686-linux-64int-ld" /**/ +#define ARCHLIB "/pro/lib/perl5/5.25.9/i686-linux-64int-ld" /**/ +#define ARCHLIB_EXP "/pro/lib/perl5/5.25.9/i686-linux-64int-ld" /**/ /* ARCHNAME: * This symbol holds a string representing the architecture name. @@ -2068,8 +2068,8 @@ * 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.8" /**/ -#define PRIVLIB_EXP "/pro/lib/perl5/5.25.8" /**/ +#define PRIVLIB "/pro/lib/perl5/5.25.9" /**/ +#define PRIVLIB_EXP "/pro/lib/perl5/5.25.9" /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -2119,8 +2119,8 @@ * 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.8/i686-linux-64int-ld" /**/ -#define SITEARCH_EXP "/pro/lib/perl5/site_perl/5.25.8/i686-linux-64int-ld" /**/ +#define SITEARCH "/pro/lib/perl5/site_perl/5.25.9/i686-linux-64int-ld" /**/ +#define SITEARCH_EXP "/pro/lib/perl5/site_perl/5.25.9/i686-linux-64int-ld" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -2142,8 +2142,8 @@ * 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.8" /**/ -#define SITELIB_EXP "/pro/lib/perl5/site_perl/5.25.8" /**/ +#define SITELIB "/pro/lib/perl5/site_perl/5.25.9" /**/ +#define SITELIB_EXP "/pro/lib/perl5/site_perl/5.25.9" /**/ #define SITELIB_STEM "/pro/lib/perl5/site_perl" /**/ /* SSize_t: @@ -4282,7 +4282,7 @@ * script to make sure (one hopes) that it runs with perl and not * some shell. */ -#define STARTPERL "#!/pro/bin/perl5.25.8" /**/ +#define STARTPERL "#!/pro/bin/perl5.25.9" /**/ /* HAS_STDIO_STREAM_ARRAY: * This symbol, if defined, tells that there is an array diff --git a/Porting/config_h.pl b/Porting/config_h.pl index 82f40d9..8ac1582 100755 --- a/Porting/config_h.pl +++ b/Porting/config_h.pl @@ -15,7 +15,7 @@ use strict; use warnings; my ($cSH, $ch, @ch, %ch) = ("config_h.SH"); -open $ch, "<$cSH" or die "Cannot open $cSH: $!\n"; +open $ch, '<', $cSH or die "Cannot open $cSH: $!\n"; { local $/ = "\n\n"; @ch = <$ch>; close $ch; @@ -68,7 +68,7 @@ for (grep m{echo .Extracting \$CONFIG_H} => @ch) { push @ch, ";;\nesac\n"; -open $ch, "> $cSH" or die "Cannot write $cSH: $!\n"; +open $ch, '>', $cSH or die "Cannot write $cSH: $!\n"; print $ch <) { my ($p, $v) = split ' '; next if 1../^\s*$/; # skip header diff --git a/Porting/epigraphs.pod b/Porting/epigraphs.pod index 69fa0d2..28d3740 100644 --- a/Porting/epigraphs.pod +++ b/Porting/epigraphs.pod @@ -17,6 +17,21 @@ Consult your favorite dictionary for details. =head1 EPIGRAPHS +=head2 v5.25.8 - Langston Hughes, So long + +L + + So long + is in the song + and it's in the way you're gone + but it's like a foreign language + in my mind + and maybe was I blind + I could not see + and would not know + you're gone so long + so long. + =head2 v5.25.7 - J.R.R. Tolkien, "The Silmarillion" L @@ -178,6 +193,63 @@ L + + The Bellman looked uffish, and wrinkled his brow. + 'If only you'd spoken before! + It's excessively awkward to mention it now, + With the Snark, so to speak, at the door! + + 'We should all of us grieve, as you well may believe, + If you never were met with again - + But surely, my man, when the voyage began, + You might have suggested it then? + + 'It's excessively awkward to mention it now - + As I think I've already remarked.' + And the man they called 'Hi!' replied, with a sigh, + 'I informed you the day we embarked. + + 'You may charge me with murder - or want of sense - + (We are all of us weak at times): + But the slightest approach to a false pretence + Was never among my crimes! + + 'I said it in Hebrew - I said it in Dutch - + I said it in German and Greek: + But I wholly forgot (and it vexes me much) + That English is what you speak!' + + ''Tis a pitiful tale,' said the Bellman, whose face + Had grown longer at every word: + 'But, now that you've stated the whole of your case, + More debate would be simply absurd. + + 'The rest of my speech' (he exclaimed to his men) + 'You shall hear when I've leisure to speak it. + But the Snark is at hand, let me tell you again! + 'Tis your glorious duty to seek it! + +=head2 v5.24.1-RC5 - John Milton, ed. Gordon Campbell, "Paradise Regained", Book IV + +L + + Thus passed the night so foul, till Morning fair + Came forth with pilgrim steps, in amice grey; + Who with her radiant finger stilled the roar + Of thunder, chased the clouds, and laid the winds, + And grisly spectres, which the fiend had raised + To tempt the Son of God with terrors dire. + And now the sun with more effectual beams + Had cheered the face of earth, and dried the wet + From drooping plant, or dropping tree; the birds, + Who all things now behold more fresh and green, + After a night of storm so ruinous, + Cleared up their choicest notes in bush and spray, + To gratulate the sweet return of morn. + =head2 v5.24.1-RC4 - John Milton, ed. Gordon Campbell, "Paradise Lost", Book II L @@ -648,6 +720,70 @@ L + + As one who strives a hill to climb, + Who never climbed before: + Who finds it, in a little time, + Grow every moment less sublime, + And votes the thing a bore: + + Yet, having once begun to try, + Dares not desert his quest, + But, climbing, ever keeps his eye + On one small hut against the sky + Wherein he hopes to rest: + + Who climbs till nerve and force are spent, + With many a puff and pant: + Who still, as rises the ascent, + In language grows more violent, + Although in breath more scant: + + Who, climbing, gains at length the place + That crowns the upward track: + And, entering with unsteady pace, + Receives a buffet in the face + That lands him on his back: + + And feels himself, like one in sleep, + Glide swiftly down again, + A helpless weight, from steep to steep, + Till, with a headlong giddy sweep, + He drops upon the plain - + + So I, that had resolved to bring + Conviction to a ghost, + And found it quite a different thing + From any human arguing, + Yet dared not quit my post. + +=head2 v5.22.3-RC5 - John Milton, ed. Gordon Campbell, "Paradise Regained", Book II + +L + + Thus wore out night; and now the herald lark + Left his ground-nest, high towering to descry + The Morn's approach, and greet her with his song; + As lightly from his grassy couch up rose + Our Saviour, and found all was but a dream; + Fasting he went to sleep, and fasting waked. + Up to a hill anon his steps he reared, + From whose high top to ken the prospect round, + If cottage were in view, sheep-cote, or herd; + But cottage, herd, or sheep-cote, none he saw -- + Only in a bottom saw a pleasant grove, + With chant of tuneful birds resounding loud; + Thither he bent his way, determined there + To rest at noon, and entered soon the shade, + High-roofed and walks beneath, and alleys brown, + That opened in the midst a woody scene; + Nature's own work it seemed (Nature taught Art), + And, to a superstitious eye, the haunt + Of wood-gods and wood-nymphs. + =head2 v5.22.3-RC4 - John Milton, ed. Gordon Campbell, "Paradise Lost", Book II L diff --git a/Porting/leakfinder.pl b/Porting/leakfinder.pl index c22a58e..370ae5c 100644 --- a/Porting/leakfinder.pl +++ b/Porting/leakfinder.pl @@ -31,9 +31,9 @@ for(`find .`) { =~ s/\0/'."\\0".'/grid; $prog = <&", STDOUT; - open STDOUT, ">/dev/null"; - open STDIN, "/dev/null"; + open STDOUT, ">", "/dev/null"; + open STDIN, "<", "/dev/null"; + open STDERR, ">", "/dev/null"; \$unused_variable = '$q'; eval \$unused_variable while \$also_unused++ < 4; print oUt sv_count, "\n"; diff --git a/Porting/makerel b/Porting/makerel index 0bf7990..53ecdc2 100755 --- a/Porting/makerel +++ b/Porting/makerel @@ -48,7 +48,7 @@ $relroot = defined $opts{r} ? $opts{r} : ".."; die "Must be in root of the perl source tree.\n" unless -f "./MANIFEST" and -f "patchlevel.h"; -open PATCHLEVEL,"; close PATCHLEVEL; my $patchlevel_h = join "", grep { /^#\s*define/ } @patchlevel_h; diff --git a/Porting/manicheck b/Porting/manicheck index 1b506d9..b544a12 100644 --- a/Porting/manicheck +++ b/Porting/manicheck @@ -8,7 +8,7 @@ use strict; use warnings; use File::Find; -open my $fh, 'MANIFEST' or die "Can't read MANIFEST: $!\n"; +open my $fh, '<', 'MANIFEST' or die "Can't read MANIFEST: $!\n"; my @files = map { (split)[0] } <$fh>; close $fh; for (@files) { diff --git a/Porting/release_managers_guide.pod b/Porting/release_managers_guide.pod index d148c21..86f5e41 100644 --- a/Porting/release_managers_guide.pod +++ b/Porting/release_managers_guide.pod @@ -245,6 +245,15 @@ have some extra changes. =head3 How to sync a CPAN module with a cpanE distro +In most cases, once a new version of a distribution shipped with core has been +uploaded to CPAN, the core version thereof can be synchronized automatically +with the program F. (But see the comments at the +beginning of that program. In particular, it has not yet been exercised on +Windows as much as it has on Unix-like platforms.) + +If, however, F does not provide good results, follow +the steps below. + =over 4 =item * @@ -326,12 +335,6 @@ If everything is ok, commit the changes. For entries with a non-simple C section, or with a C, you may have to take more steps than listed above. -F is a script that automates most of the steps -above; but see the comments at the beginning of the file. In particular, -it has not yet been exercised on Windows, but will certainly require a set -of Unix tools such as Cygwin, and steps that run C will need to run -C instead. - =head3 dual-life CPAN module stability Ensure dual-life CPAN modules are stable, which comes down to: diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod index 4b8315d..7e74c6f 100644 --- a/Porting/release_schedule.pod +++ b/Porting/release_schedule.pod @@ -23,14 +23,16 @@ Code freezes (which happen in the 5.25.X series) =head2 Perl 5.24 2016-05-09 5.24.0 ✓ Ricardo Signes - 2016-07-25 5.24.1 Steve Hay + 2017-01-14 5.24.1 ✓ Steve Hay + 2017-02-?? 5.24.2 Steve Hay =head2 Perl 5.22 2015-06-01 5.22.0 ✓ Ricardo Signes 2015-12-13 5.22.1 ✓ Steve Hay 2016-04-29 5.22.2 ✓ Steve Hay - 2016-07-25 5.22.3 Steve Hay + 2017-01-14 5.22.3 ✓ Steve Hay + 2017-02-?? 5.22.4 Steve Hay =head1 DEVELOPMENT RELEASE SCHEDULE @@ -56,7 +58,7 @@ you should reset the version numbers to the next blead series. 2016-09-20 5.25.5 ✓ Stevan Little 2016-10-20 5.25.6 ✓ Aaron Crane 2016-11-20 5.25.7 ✓ Chad Granum - 2016-12-20 5.25.8 Sawyer X + 2016-12-20 5.25.8 ✓ Sawyer X 2017-01-20 5.25.9 Abigail 2017-02-20 5.25.10 Renée Bäcker diff --git a/Porting/sync-with-cpan b/Porting/sync-with-cpan index d0cc1d6..8245e5c 100755 --- a/Porting/sync-with-cpan +++ b/Porting/sync-with-cpan @@ -66,7 +66,7 @@ Restore files mentioned in C =item * -Adds new files to F +Updates the contents of F =item * @@ -90,13 +90,19 @@ Runs the porting tests C<--tarball> should be the path to the tarball; the version is extracted from the filename -- but can be overwritten by the C<--version> option. -=head1 TODO +=head1 OPTIONS =over 4 -=item * +=item C<--jobs> I + +When running C, pass a C<< -jI >> option to it. -Delete files from F +=back + +=head1 TODO + +=over 4 =item * @@ -128,15 +134,25 @@ use strict; use warnings; use Getopt::Long; use Archive::Tar; +use File::Basename qw( basename ); use File::Path qw( remove_tree ); use File::Find; +use File::Spec::Functions qw( tmpdir ); use Config qw( %Config ); $| = 1; +use constant WIN32 => $^O eq 'MSWin32'; + die "This does not look like a top level directory" unless -d "cpan" && -d "Porting"; +# Check that there's a Makefile, if needed; otherwise, we'll do most of our +# work only to fail when we try to run make, and the user will have to +# either unpick everything we've done, or do the rest manually. +die "Please run Configure before using $0\n" + if !WIN32 && !-f "Makefile"; + our @IGNORABLE; our %Modules; @@ -144,9 +160,11 @@ use autodie; require "Porting/Maintainers.pl"; +my $MAKE_LOG = 'make.log'; + my %IGNORABLE = map {$_ => 1} @IGNORABLE; -my $tmpdir= $ENV{ TEMP } // '/tmp'; +my $tmpdir = tmpdir(); my $package = "02packages.details.txt"; my $package_url = "http://www.cpan.org/modules/$package"; @@ -166,6 +184,7 @@ sub usage GetOptions ('tarball=s' => \my $tarball, 'version=s' => \my $version, + 'jobs=i' => \my $make_jobs, force => \my $force, help => sub { usage 0; }, ) or die "Failed to parse arguments"; @@ -184,30 +203,73 @@ sub find_type_f { # Equivalent of `chmod a-x` sub de_exec { - for my $filename ( @_ ) { - my $mode= (stat $filename)[2] & 0777; - if( $mode & 0111 ) { # exec-bit set - chmod $mode & 0666, $filename; - }; + my ($filename) = @_; + my $mode = (stat $filename)[2] & 0777; + if ($mode & 0111) { # exec-bit set + chmod $mode & 0666, $filename; + } +} + +# Equivalent of `chmod +w` +sub make_writable { + my ($filename) = @_; + my $mode = (stat $filename)[2] & 0777; + if (!($mode & 0222)) { # not writable + chmod $mode | (0222 & ~umask), $filename; } } sub make { my @args= @_; - if( $^O eq 'MSWin32') { + unshift @args, "-j$make_jobs" if defined $make_jobs; + if (WIN32) { chdir "Win32"; - system "$Config{make} @args> ..\\make.log 2>&1" and die "Running make failed, see make.log"; + system "$Config{make} @args> ..\\$MAKE_LOG 2>&1" + and die "Running make failed, see $MAKE_LOG"; chdir '..'; } else { - system "$Config{make} @args> make.log 2>&1" and die "Running make failed, see make.log"; + system "$Config{make} @args> $MAKE_LOG 2>&1" + and die "Running make failed, see $MAKE_LOG"; }; }; my ($module) = shift; -my $cpan_mod = @ARGV ? shift : $module; +my $info = $Modules{$module}; +if (!$info) { + # Maybe the user said "Test-Simple" instead of "Test::Simple", or + # "IO::Compress" instead of "IO-Compress". See if we can fix it up. + my $guess = $module; + s/-/::/g or s/::/-/g for $guess; + $info = $Modules{$guess} or die <<"EOF"; +Cannot find module $module. +The available options are listed in the %Modules hash in Porting/Maintainers.pl +EOF + say "Guessing you meant $guess instead of $module"; + $module = $guess; +} + +if ($info->{CUSTOMIZED}) { + print <<"EOF"; +$module has a CUSTOMIZED entry in Porting/Maintainers.pl. + +This program's behaviour is to copy every CUSTOMIZED file into the version +of the module being imported. But that might not be the right thing: in some +cases, the new CPAN version will supersede whatever changes had previously +been made in blead, so it would be better to import the new CPAN files. + +If you've checked that the CUSTOMIZED versions are still correct, you can +proceed now. Otherwise, you should abort and investigate the situation. If +the blead customizations are no longer needed, delete the CUSTOMIZED entry +for $module in Porting/Maintainers.pl (and you'll also need to regenerate +t/porting/customized.dat in that case; see t/porting/customized.t). + +EOF + print "Hit return to continue; ^C to abort "; ; +} + +my $cpan_mod = @ARGV ? shift : $module; -my $info = $Modules {$module} or die "Cannot find module $module"; my $distribution = $$info {DISTRIBUTION}; my @files = glob $$info {FILES}; @@ -238,7 +300,15 @@ if ($cpan_mod =~ /-/ && $cpan_mod !~ /::/) { # my $new_file; my $new_version; -unless ($tarball) { +if (defined $tarball) { + die "Tarball $tarball does not exist\n" if !-e $tarball; + die "Tarball $tarball is not a plain file\n" if !-f _; + $new_file = $tarball; + $new_version = $version // ($new_file =~ /-([0-9._]+(?:-TRIAL[0-9]*)?)\.tar\.gz/) [0]; + die "Blead and that tarball both have version $new_version of $module\n" + if $new_version eq $old_version; +} +else { # # Poor man's cache # @@ -261,6 +331,9 @@ unless ($tarball) { } $new_file = (split '/', $new_path) [-1]; + die "The latest version of $module is $new_version, but blead already has it\n" + if $new_version eq $old_version; + my $url = "http://search.cpan.org/CPAN/authors/id/$new_path"; say "Fetching $url"; # @@ -273,10 +346,6 @@ unless ($tarball) { 1 } or system wget => $url, '-qO', $new_file; } -else { - $new_file = $tarball; - $new_version = $version // ($new_file =~ /-([0-9._]+(?:-TRIAL[0-9]*)?)\.tar\.gz/) [0]; -} my $old_dir = "$pkg_dir-$old_version"; @@ -286,12 +355,11 @@ system git => 'clean', '-dfxq', $pkg_dir; say "Unpacking $new_file"; Archive::Tar->extract_archive( $new_file ); -(my $new_dir = $new_file) =~ s/\.tar\.gz//; +(my $new_dir = basename($new_file)) =~ s/\.tar\.gz//; # ensure 'make' will update all files my $t= time; for my $file (find_type_f($new_dir)) { - open(my $fh,">>$file") || die "Cannot write $file:$!"; - close($fh); + make_writable($file); # for convenience if the user later edits it utime($t,$t,$file); }; @@ -439,23 +507,58 @@ if ($$info {CUSTOMIZED}) { } chdir ".."; -if (@commit) { +if (@commit || @gone) { say "Fixing MANIFEST"; - my $MANIFEST = "MANIFEST"; - my $MANIFEST_SORT = "$MANIFEST.sorted"; - open my $fh, ">>", $MANIFEST; - say $fh "cpan/$pkg_dir/$_" for @commit; - close $fh; - system perl => "Porting/manisort", '--output', $MANIFEST_SORT; - rename $MANIFEST_SORT => $MANIFEST; + my $MANIFEST = "MANIFEST"; + my $MANIFEST_NEW = "$MANIFEST.new"; + + open my $orig, "<", $MANIFEST + or die "Failed to open $MANIFEST for reading: $!\n"; + open my $new, ">", $MANIFEST_NEW + or die "Failed to open $MANIFEST_NEW for writing: $!\n"; + my %gone = map +("cpan/$pkg_dir/$_" => 1), @gone; + while (my $line = <$orig>) { + my ($file) = $line =~ /^(\S+)/ + or die "Can't parse MANIFEST line: $line"; + print $new $line if !$gone{$file}; + } + + say $new "cpan/$pkg_dir/$_" for @commit; + + close $new or die "Can't close $MANIFEST: $!\n"; + + system $^X => "Porting/manisort", '--quiet', "--output=$MANIFEST", $MANIFEST_NEW; + unlink $MANIFEST_NEW + or die "Can't delete temporary $MANIFEST_NEW: $!\n"; } -print "Running a make ... "; +print "Running a make and saving its output to $MAKE_LOG ... "; # Prepare for running (selected) tests make 'test-prep'; print "done\n"; +# The build system installs code from CPAN dists into the lib/ directory, +# creating directories as needed. This means that the cleaning-related rules +# in the Makefile need to know which directories to clean up. The Makefile +# is generated by Configure from Makefile.SH, so *that* file needs the list +# of directories. regen/lib_cleanup.pl is capable of automatically updating +# the contents of Makefile.SH (and win32/Makefile, which needs similar but +# not identical lists of directories), so we can just run that (using the +# newly-built Perl, as is done with the regen programs run by "make regen"). +# +# We do this if any files at all have been added or deleted, regardless of +# whether those changes result in any directories being added or deleted, +# because the alternative would be to replicate the regen/lib_cleanup.pl +# logic here. That's fine, because regen/lib_cleanup.pl is idempotent if run +# repeatedly. +if (@commit || @gone) { + say "Running regen/lib_cleanup.pl to handle potential added/deleted dirs"; + my $exe_dir = WIN32 ? ".\\" : './'; + system "${exe_dir}perl$Config{_exe}", "-Ilib", "regen/lib_cleanup.pl" + and die "regen/lib_cleanup.pl failed\n"; +} + # # Must clean up, or else t/porting/FindExt.t will fail. # Note that we can always retrieve the original directory with a git checkout. @@ -471,8 +574,8 @@ unlink "cpan/$new_file" unless $tarball; # chdir "t"; say "Running module tests"; -my @test_files = grep { /\.t$/ } find_type_f( $pkg_dir ); -my $exe_dir= $^O =~ /MSWin/ ? "..\\" : './'; +my @test_files = grep { /\.t$/ } find_type_f( "../cpan/$pkg_dir" ); +my $exe_dir = WIN32 ? "..\\" : './'; my $output = `${exe_dir}perl$Config{_exe} TEST @test_files`; unless ($output =~ /All tests successful/) { say $output; @@ -494,7 +597,6 @@ print "\n"; say "Failed tests: @failed" if @failed; -say "Attempting to update Maintainers.pl"; chdir '..'; open my $Maintainers_pl, '<', 'Porting/Maintainers.pl'; @@ -511,12 +613,12 @@ while (<$Maintainers_pl>) { } } - if (/^ }/) { + if (/^ \}/) { $in_mod_section = 0; } } - if (/\Q$cpan_mod/) { + if (/\Q$module/) { $in_mod_section = 1; } } @@ -525,6 +627,7 @@ while (<$Maintainers_pl>) { } if ($found) { + say "Successfully updated Maintainers.pl"; unlink 'Porting/Maintainers.pl'; rename 'Maintainers.pl' => 'Porting/Maintainers.pl'; chmod 0755 => 'Porting/Maintainers.pl'; @@ -534,8 +637,20 @@ else { say "Make sure you update this by hand before committing."; } -say "$o_module is now version $new_version"; -say "Now you ought to run a make; make test ..."; +print <<"EOF"; + +======================================================================= + +$o_module is now at version $new_version +Next, you should run a "make test". + +Hopefully that will complete successfully, but if not, you can make any +changes you need to get the tests to pass. Don't forget that you'll need +a "CUSTOMIZED" entry in Porting/Maintainers.pl if you change any of the +files under cpan/$pkg_dir. + +Once all tests pass, you can "git add -u" and "git commit" the changes. +EOF __END__ diff --git a/Porting/todo.pod b/Porting/todo.pod index b4e79aa..f8ae842 100644 --- a/Porting/todo.pod +++ b/Porting/todo.pod @@ -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.8. +options would be nice for perl 5.25.9. =head2 Profile Perl - am I hot or not? @@ -1205,7 +1205,7 @@ L =head1 Big projects Tasks that will get your name mentioned in the description of the "Highlights -of 5.25.8" +of 5.25.9" =head2 make ithreads more robust diff --git a/README b/README index d46e72e..02ac59c 100644 --- a/README +++ b/README @@ -1,6 +1,6 @@ Perl is Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, -2013, 2014, 2015, 2016 by Larry Wall and others. All rights reserved. +2013, 2014, 2015, 2016, 2017 by Larry Wall and others. All rights reserved. diff --git a/README.haiku b/README.haiku index 5b7c0b2..f914965 100644 --- a/README.haiku +++ b/README.haiku @@ -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.8/BePC-haiku/CORE/libperl.so . + cd /boot/common/lib; ln -s perl5/5.25.9/BePC-haiku/CORE/libperl.so . -Replace C<5.25.8> with your respective version of Perl. +Replace C<5.25.9> with your respective version of Perl. =head1 KNOWN PROBLEMS diff --git a/README.macosx b/README.macosx index c3cb53c..6d93d15 100644 --- a/README.macosx +++ b/README.macosx @@ -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.8.tar.gz - tar -xzf perl-5.25.8.tar.gz - cd perl-5.25.8 + curl -O http://www.cpan.org/src/perl-5.25.9.tar.gz + tar -xzf perl-5.25.9.tar.gz + cd perl-5.25.9 ./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.8 as of this writing) builds without changes +The latest Perl release (5.25.9 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', diff --git a/README.os2 b/README.os2 index 9645848..475dcc4 100644 --- a/README.os2 +++ b/README.os2 @@ -619,7 +619,7 @@ C in F, see L">. =item Additional Perl modules - unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.25.8/ + unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.25.9/ Same remark as above applies. Additionally, if this directory is not one of directories on @INC (and @INC is influenced by C), you diff --git a/README.vms b/README.vms index 4b8738e..d9218ad 100644 --- a/README.vms +++ b/README.vms @@ -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^.8.tar + vmstar -xvf perl-5^.25^.9.tar Then set default to the top-level source directory like so: - set default [.perl-5^.25^.8] + set default [.perl-5^.25^.9] and proceed with configuration as described in the next section. diff --git a/autodoc.pl b/autodoc.pl index 597607c..2e6a1c3 100644 --- a/autodoc.pl +++ b/autodoc.pl @@ -355,7 +355,7 @@ open my $fh, '<', 'MANIFEST' while (my $line = <$fh>) { next unless my ($file) = $line =~ /^(\S+\.[ch])\t/; - open F, "< $file" or die "Cannot open $file for docs: $!\n"; + open F, '<', $file or die "Cannot open $file for docs: $!\n"; $curheader = "Functions in file $file\n"; autodoc(\*F,$file); close F or die "Error closing $file: $!\n"; diff --git a/cflags.SH b/cflags.SH index bd32840..3af1e97 100755 --- a/cflags.SH +++ b/cflags.SH @@ -485,10 +485,10 @@ for file do # allow variables like toke_cflags to be evaluated - if echo $file | grep -v / >/dev/null - then - eval 'eval ${'"${file}_cflags"'-""}' - fi + case "$file" in + */*) ;; + *) eval 'eval ${'"${file}_cflags"'-""}' ;; + esac # or customize here diff --git a/charclass_invlists.h b/charclass_invlists.h index 3f14119..732b6d0 100644 --- a/charclass_invlists.h +++ b/charclass_invlists.h @@ -42,81 +42,488 @@ static const UV ASCII_invlist[] = { /* for ASCII/Latin1 */ 0x80 }; -static const UV Cased_invlist[] = { /* for ASCII/Latin1 */ - 271, /* Number of elements */ +static const UV Assigned_invlist[] = { /* for ASCII/Latin1 */ + 1276, /* Number of elements */ 148565664, /* Version and data structure type */ - 1, /* 0 if the list starts at 0; + 0, /* 0 if the list starts at 0; 1 if it starts at the element beyond 0 */ 0x0, - 0x41, - 0x5B, - 0x61, - 0x7B, - 0xAA, - 0xAB, - 0xB5, - 0xB6, - 0xBA, - 0xBB, - 0xC0, - 0xD7, - 0xD8, - 0xF7, - 0xF8, - 0x1BB, - 0x1BC, - 0x1C0, - 0x1C4, - 0x294, - 0x295, - 0x2B9, - 0x2C0, - 0x2C2, - 0x2E0, - 0x2E5, - 0x345, - 0x346, - 0x370, - 0x374, - 0x376, 0x378, 0x37A, - 0x37E, - 0x37F, 0x380, - 0x386, - 0x387, - 0x388, + 0x384, 0x38B, 0x38C, 0x38D, 0x38E, 0x3A2, 0x3A3, - 0x3F6, - 0x3F7, - 0x482, - 0x48A, 0x530, 0x531, 0x557, + 0x559, + 0x560, 0x561, 0x588, - 0x10A0, + 0x589, + 0x58B, + 0x58D, + 0x590, + 0x591, + 0x5C8, + 0x5D0, + 0x5EB, + 0x5F0, + 0x5F5, + 0x600, + 0x61D, + 0x61E, + 0x70E, + 0x70F, + 0x74B, + 0x74D, + 0x7B2, + 0x7C0, + 0x7FB, + 0x800, + 0x82E, + 0x830, + 0x83F, + 0x840, + 0x85C, + 0x85E, + 0x85F, + 0x8A0, + 0x8B5, + 0x8B6, + 0x8BE, + 0x8D4, + 0x984, + 0x985, + 0x98D, + 0x98F, + 0x991, + 0x993, + 0x9A9, + 0x9AA, + 0x9B1, + 0x9B2, + 0x9B3, + 0x9B6, + 0x9BA, + 0x9BC, + 0x9C5, + 0x9C7, + 0x9C9, + 0x9CB, + 0x9CF, + 0x9D7, + 0x9D8, + 0x9DC, + 0x9DE, + 0x9DF, + 0x9E4, + 0x9E6, + 0x9FC, + 0xA01, + 0xA04, + 0xA05, + 0xA0B, + 0xA0F, + 0xA11, + 0xA13, + 0xA29, + 0xA2A, + 0xA31, + 0xA32, + 0xA34, + 0xA35, + 0xA37, + 0xA38, + 0xA3A, + 0xA3C, + 0xA3D, + 0xA3E, + 0xA43, + 0xA47, + 0xA49, + 0xA4B, + 0xA4E, + 0xA51, + 0xA52, + 0xA59, + 0xA5D, + 0xA5E, + 0xA5F, + 0xA66, + 0xA76, + 0xA81, + 0xA84, + 0xA85, + 0xA8E, + 0xA8F, + 0xA92, + 0xA93, + 0xAA9, + 0xAAA, + 0xAB1, + 0xAB2, + 0xAB4, + 0xAB5, + 0xABA, + 0xABC, + 0xAC6, + 0xAC7, + 0xACA, + 0xACB, + 0xACE, + 0xAD0, + 0xAD1, + 0xAE0, + 0xAE4, + 0xAE6, + 0xAF2, + 0xAF9, + 0xAFA, + 0xB01, + 0xB04, + 0xB05, + 0xB0D, + 0xB0F, + 0xB11, + 0xB13, + 0xB29, + 0xB2A, + 0xB31, + 0xB32, + 0xB34, + 0xB35, + 0xB3A, + 0xB3C, + 0xB45, + 0xB47, + 0xB49, + 0xB4B, + 0xB4E, + 0xB56, + 0xB58, + 0xB5C, + 0xB5E, + 0xB5F, + 0xB64, + 0xB66, + 0xB78, + 0xB82, + 0xB84, + 0xB85, + 0xB8B, + 0xB8E, + 0xB91, + 0xB92, + 0xB96, + 0xB99, + 0xB9B, + 0xB9C, + 0xB9D, + 0xB9E, + 0xBA0, + 0xBA3, + 0xBA5, + 0xBA8, + 0xBAB, + 0xBAE, + 0xBBA, + 0xBBE, + 0xBC3, + 0xBC6, + 0xBC9, + 0xBCA, + 0xBCE, + 0xBD0, + 0xBD1, + 0xBD7, + 0xBD8, + 0xBE6, + 0xBFB, + 0xC00, + 0xC04, + 0xC05, + 0xC0D, + 0xC0E, + 0xC11, + 0xC12, + 0xC29, + 0xC2A, + 0xC3A, + 0xC3D, + 0xC45, + 0xC46, + 0xC49, + 0xC4A, + 0xC4E, + 0xC55, + 0xC57, + 0xC58, + 0xC5B, + 0xC60, + 0xC64, + 0xC66, + 0xC70, + 0xC78, + 0xC84, + 0xC85, + 0xC8D, + 0xC8E, + 0xC91, + 0xC92, + 0xCA9, + 0xCAA, + 0xCB4, + 0xCB5, + 0xCBA, + 0xCBC, + 0xCC5, + 0xCC6, + 0xCC9, + 0xCCA, + 0xCCE, + 0xCD5, + 0xCD7, + 0xCDE, + 0xCDF, + 0xCE0, + 0xCE4, + 0xCE6, + 0xCF0, + 0xCF1, + 0xCF3, + 0xD01, + 0xD04, + 0xD05, + 0xD0D, + 0xD0E, + 0xD11, + 0xD12, + 0xD3B, + 0xD3D, + 0xD45, + 0xD46, + 0xD49, + 0xD4A, + 0xD50, + 0xD54, + 0xD64, + 0xD66, + 0xD80, + 0xD82, + 0xD84, + 0xD85, + 0xD97, + 0xD9A, + 0xDB2, + 0xDB3, + 0xDBC, + 0xDBD, + 0xDBE, + 0xDC0, + 0xDC7, + 0xDCA, + 0xDCB, + 0xDCF, + 0xDD5, + 0xDD6, + 0xDD7, + 0xDD8, + 0xDE0, + 0xDE6, + 0xDF0, + 0xDF2, + 0xDF5, + 0xE01, + 0xE3B, + 0xE3F, + 0xE5C, + 0xE81, + 0xE83, + 0xE84, + 0xE85, + 0xE87, + 0xE89, + 0xE8A, + 0xE8B, + 0xE8D, + 0xE8E, + 0xE94, + 0xE98, + 0xE99, + 0xEA0, + 0xEA1, + 0xEA4, + 0xEA5, + 0xEA6, + 0xEA7, + 0xEA8, + 0xEAA, + 0xEAC, + 0xEAD, + 0xEBA, + 0xEBB, + 0xEBE, + 0xEC0, + 0xEC5, + 0xEC6, + 0xEC7, + 0xEC8, + 0xECE, + 0xED0, + 0xEDA, + 0xEDC, + 0xEE0, + 0xF00, + 0xF48, + 0xF49, + 0xF6D, + 0xF71, + 0xF98, + 0xF99, + 0xFBD, + 0xFBE, + 0xFCD, + 0xFCE, + 0xFDB, + 0x1000, 0x10C6, 0x10C7, 0x10C8, 0x10CD, 0x10CE, + 0x10D0, + 0x1249, + 0x124A, + 0x124E, + 0x1250, + 0x1257, + 0x1258, + 0x1259, + 0x125A, + 0x125E, + 0x1260, + 0x1289, + 0x128A, + 0x128E, + 0x1290, + 0x12B1, + 0x12B2, + 0x12B6, + 0x12B8, + 0x12BF, + 0x12C0, + 0x12C1, + 0x12C2, + 0x12C6, + 0x12C8, + 0x12D7, + 0x12D8, + 0x1311, + 0x1312, + 0x1316, + 0x1318, + 0x135B, + 0x135D, + 0x137D, + 0x1380, + 0x139A, 0x13A0, 0x13F6, 0x13F8, 0x13FE, - 0x1C80, + 0x1400, + 0x169D, + 0x16A0, + 0x16F9, + 0x1700, + 0x170D, + 0x170E, + 0x1715, + 0x1720, + 0x1737, + 0x1740, + 0x1754, + 0x1760, + 0x176D, + 0x176E, + 0x1771, + 0x1772, + 0x1774, + 0x1780, + 0x17DE, + 0x17E0, + 0x17EA, + 0x17F0, + 0x17FA, + 0x1800, + 0x180F, + 0x1810, + 0x181A, + 0x1820, + 0x1878, + 0x1880, + 0x18AB, + 0x18B0, + 0x18F6, + 0x1900, + 0x191F, + 0x1920, + 0x192C, + 0x1930, + 0x193C, + 0x1940, + 0x1941, + 0x1944, + 0x196E, + 0x1970, + 0x1975, + 0x1980, + 0x19AC, + 0x19B0, + 0x19CA, + 0x19D0, + 0x19DB, + 0x19DE, + 0x1A1C, + 0x1A1E, + 0x1A5F, + 0x1A60, + 0x1A7D, + 0x1A7F, + 0x1A8A, + 0x1A90, + 0x1A9A, + 0x1AA0, + 0x1AAE, + 0x1AB0, + 0x1ABF, + 0x1B00, + 0x1B4C, + 0x1B50, + 0x1B7D, + 0x1B80, + 0x1BF4, + 0x1BFC, + 0x1C38, + 0x1C3B, + 0x1C4A, + 0x1C4D, 0x1C89, + 0x1CC0, + 0x1CC8, + 0x1CD0, + 0x1CF7, + 0x1CF8, + 0x1CFA, 0x1D00, - 0x1DC0, - 0x1E00, + 0x1DF6, + 0x1DFB, 0x1F16, 0x1F18, 0x1F1E, @@ -137,143 +544,591 @@ static const UV Cased_invlist[] = { /* for ASCII/Latin1 */ 0x1F80, 0x1FB5, 0x1FB6, - 0x1FBD, - 0x1FBE, - 0x1FBF, - 0x1FC2, 0x1FC5, 0x1FC6, - 0x1FCD, - 0x1FD0, 0x1FD4, 0x1FD6, 0x1FDC, - 0x1FE0, - 0x1FED, + 0x1FDD, + 0x1FF0, 0x1FF2, 0x1FF5, 0x1FF6, - 0x1FFD, - 0x2071, - 0x2072, - 0x207F, - 0x2080, + 0x1FFF, + 0x2000, + 0x2065, + 0x2066, + 0x2072, + 0x2074, + 0x208F, 0x2090, 0x209D, - 0x2102, - 0x2103, - 0x2107, - 0x2108, - 0x210A, - 0x2114, - 0x2115, - 0x2116, - 0x2119, - 0x211E, - 0x2124, - 0x2125, - 0x2126, - 0x2127, - 0x2128, - 0x2129, - 0x212A, - 0x212E, - 0x212F, - 0x2135, - 0x2139, - 0x213A, - 0x213C, - 0x2140, - 0x2145, - 0x214A, - 0x214E, - 0x214F, - 0x2160, - 0x2180, - 0x2183, - 0x2185, - 0x24B6, - 0x24EA, + 0x20A0, + 0x20BF, + 0x20D0, + 0x20F1, + 0x2100, + 0x218C, + 0x2190, + 0x23FF, + 0x2400, + 0x2427, + 0x2440, + 0x244B, + 0x2460, + 0x2B74, + 0x2B76, + 0x2B96, + 0x2B98, + 0x2BBA, + 0x2BBD, + 0x2BC9, + 0x2BCA, + 0x2BD2, + 0x2BEC, + 0x2BF0, 0x2C00, 0x2C2F, 0x2C30, 0x2C5F, 0x2C60, - 0x2CE5, - 0x2CEB, - 0x2CEF, - 0x2CF2, 0x2CF4, - 0x2D00, + 0x2CF9, 0x2D26, 0x2D27, 0x2D28, 0x2D2D, 0x2D2E, + 0x2D30, + 0x2D68, + 0x2D6F, + 0x2D71, + 0x2D7F, + 0x2D97, + 0x2DA0, + 0x2DA7, + 0x2DA8, + 0x2DAF, + 0x2DB0, + 0x2DB7, + 0x2DB8, + 0x2DBF, + 0x2DC0, + 0x2DC7, + 0x2DC8, + 0x2DCF, + 0x2DD0, + 0x2DD7, + 0x2DD8, + 0x2DDF, + 0x2DE0, + 0x2E45, + 0x2E80, + 0x2E9A, + 0x2E9B, + 0x2EF4, + 0x2F00, + 0x2FD6, + 0x2FF0, + 0x2FFC, + 0x3000, + 0x3040, + 0x3041, + 0x3097, + 0x3099, + 0x3100, + 0x3105, + 0x312E, + 0x3131, + 0x318F, + 0x3190, + 0x31BB, + 0x31C0, + 0x31E4, + 0x31F0, + 0x321F, + 0x3220, + 0x32FF, + 0x3300, + 0x4DB6, + 0x4DC0, + 0x9FD6, + 0xA000, + 0xA48D, + 0xA490, + 0xA4C7, + 0xA4D0, + 0xA62C, 0xA640, - 0xA66E, - 0xA680, - 0xA69E, - 0xA722, - 0xA788, - 0xA78B, - 0xA78F, - 0xA790, + 0xA6F8, + 0xA700, 0xA7AF, 0xA7B0, 0xA7B8, - 0xA7F8, - 0xA7FB, + 0xA7F7, + 0xA82C, + 0xA830, + 0xA83A, + 0xA840, + 0xA878, + 0xA880, + 0xA8C6, + 0xA8CE, + 0xA8DA, + 0xA8E0, + 0xA8FE, + 0xA900, + 0xA954, + 0xA95F, + 0xA97D, + 0xA980, + 0xA9CE, + 0xA9CF, + 0xA9DA, + 0xA9DE, + 0xA9FF, + 0xAA00, + 0xAA37, + 0xAA40, + 0xAA4E, + 0xAA50, + 0xAA5A, + 0xAA5C, + 0xAAC3, + 0xAADB, + 0xAAF7, + 0xAB01, + 0xAB07, + 0xAB09, + 0xAB0F, + 0xAB11, + 0xAB17, + 0xAB20, + 0xAB27, + 0xAB28, + 0xAB2F, 0xAB30, - 0xAB5B, - 0xAB5C, 0xAB66, 0xAB70, - 0xABC0, + 0xABEE, + 0xABF0, + 0xABFA, + 0xAC00, + 0xD7A4, + 0xD7B0, + 0xD7C7, + 0xD7CB, + 0xD7FC, + 0xD800, + 0xFA6E, + 0xFA70, + 0xFADA, 0xFB00, 0xFB07, 0xFB13, 0xFB18, - 0xFF21, - 0xFF3B, - 0xFF41, - 0xFF5B, + 0xFB1D, + 0xFB37, + 0xFB38, + 0xFB3D, + 0xFB3E, + 0xFB3F, + 0xFB40, + 0xFB42, + 0xFB43, + 0xFB45, + 0xFB46, + 0xFBC2, + 0xFBD3, + 0xFD40, + 0xFD50, + 0xFD90, + 0xFD92, + 0xFDC8, + 0xFDF0, + 0xFDFE, + 0xFE00, + 0xFE1A, + 0xFE20, + 0xFE53, + 0xFE54, + 0xFE67, + 0xFE68, + 0xFE6C, + 0xFE70, + 0xFE75, + 0xFE76, + 0xFEFD, + 0xFEFF, + 0xFF00, + 0xFF01, + 0xFFBF, + 0xFFC2, + 0xFFC8, + 0xFFCA, + 0xFFD0, + 0xFFD2, + 0xFFD8, + 0xFFDA, + 0xFFDD, + 0xFFE0, + 0xFFE7, + 0xFFE8, + 0xFFEF, + 0xFFF9, + 0xFFFE, + 0x10000, + 0x1000C, + 0x1000D, + 0x10027, + 0x10028, + 0x1003B, + 0x1003C, + 0x1003E, + 0x1003F, + 0x1004E, + 0x10050, + 0x1005E, + 0x10080, + 0x100FB, + 0x10100, + 0x10103, + 0x10107, + 0x10134, + 0x10137, + 0x1018F, + 0x10190, + 0x1019C, + 0x101A0, + 0x101A1, + 0x101D0, + 0x101FE, + 0x10280, + 0x1029D, + 0x102A0, + 0x102D1, + 0x102E0, + 0x102FC, + 0x10300, + 0x10324, + 0x10330, + 0x1034B, + 0x10350, + 0x1037B, + 0x10380, + 0x1039E, + 0x1039F, + 0x103C4, + 0x103C8, + 0x103D6, 0x10400, - 0x10450, + 0x1049E, + 0x104A0, + 0x104AA, 0x104B0, 0x104D4, 0x104D8, 0x104FC, + 0x10500, + 0x10528, + 0x10530, + 0x10564, + 0x1056F, + 0x10570, + 0x10600, + 0x10737, + 0x10740, + 0x10756, + 0x10760, + 0x10768, + 0x10800, + 0x10806, + 0x10808, + 0x10809, + 0x1080A, + 0x10836, + 0x10837, + 0x10839, + 0x1083C, + 0x1083D, + 0x1083F, + 0x10856, + 0x10857, + 0x1089F, + 0x108A7, + 0x108B0, + 0x108E0, + 0x108F3, + 0x108F4, + 0x108F6, + 0x108FB, + 0x1091C, + 0x1091F, + 0x1093A, + 0x1093F, + 0x10940, + 0x10980, + 0x109B8, + 0x109BC, + 0x109D0, + 0x109D2, + 0x10A04, + 0x10A05, + 0x10A07, + 0x10A0C, + 0x10A14, + 0x10A15, + 0x10A18, + 0x10A19, + 0x10A34, + 0x10A38, + 0x10A3B, + 0x10A3F, + 0x10A48, + 0x10A50, + 0x10A59, + 0x10A60, + 0x10AA0, + 0x10AC0, + 0x10AE7, + 0x10AEB, + 0x10AF7, + 0x10B00, + 0x10B36, + 0x10B39, + 0x10B56, + 0x10B58, + 0x10B73, + 0x10B78, + 0x10B92, + 0x10B99, + 0x10B9D, + 0x10BA9, + 0x10BB0, + 0x10C00, + 0x10C49, 0x10C80, 0x10CB3, 0x10CC0, 0x10CF3, + 0x10CFA, + 0x10D00, + 0x10E60, + 0x10E7F, + 0x11000, + 0x1104E, + 0x11052, + 0x11070, + 0x1107F, + 0x110C2, + 0x110D0, + 0x110E9, + 0x110F0, + 0x110FA, + 0x11100, + 0x11135, + 0x11136, + 0x11144, + 0x11150, + 0x11177, + 0x11180, + 0x111CE, + 0x111D0, + 0x111E0, + 0x111E1, + 0x111F5, + 0x11200, + 0x11212, + 0x11213, + 0x1123F, + 0x11280, + 0x11287, + 0x11288, + 0x11289, + 0x1128A, + 0x1128E, + 0x1128F, + 0x1129E, + 0x1129F, + 0x112AA, + 0x112B0, + 0x112EB, + 0x112F0, + 0x112FA, + 0x11300, + 0x11304, + 0x11305, + 0x1130D, + 0x1130F, + 0x11311, + 0x11313, + 0x11329, + 0x1132A, + 0x11331, + 0x11332, + 0x11334, + 0x11335, + 0x1133A, + 0x1133C, + 0x11345, + 0x11347, + 0x11349, + 0x1134B, + 0x1134E, + 0x11350, + 0x11351, + 0x11357, + 0x11358, + 0x1135D, + 0x11364, + 0x11366, + 0x1136D, + 0x11370, + 0x11375, + 0x11400, + 0x1145A, + 0x1145B, + 0x1145C, + 0x1145D, + 0x1145E, + 0x11480, + 0x114C8, + 0x114D0, + 0x114DA, + 0x11580, + 0x115B6, + 0x115B8, + 0x115DE, + 0x11600, + 0x11645, + 0x11650, + 0x1165A, + 0x11660, + 0x1166D, + 0x11680, + 0x116B8, + 0x116C0, + 0x116CA, + 0x11700, + 0x1171A, + 0x1171D, + 0x1172C, + 0x11730, + 0x11740, 0x118A0, - 0x118E0, - 0x1D400, - 0x1D455, - 0x1D456, - 0x1D49D, - 0x1D49E, - 0x1D4A0, - 0x1D4A2, - 0x1D4A3, - 0x1D4A5, - 0x1D4A7, - 0x1D4A9, - 0x1D4AD, - 0x1D4AE, - 0x1D4BA, - 0x1D4BB, - 0x1D4BC, - 0x1D4BD, - 0x1D4C4, - 0x1D4C5, - 0x1D506, - 0x1D507, - 0x1D50B, - 0x1D50D, - 0x1D515, + 0x118F3, + 0x118FF, + 0x11900, + 0x11AC0, + 0x11AF9, + 0x11C00, + 0x11C09, + 0x11C0A, + 0x11C37, + 0x11C38, + 0x11C46, + 0x11C50, + 0x11C6D, + 0x11C70, + 0x11C90, + 0x11C92, + 0x11CA8, + 0x11CA9, + 0x11CB7, + 0x12000, + 0x1239A, + 0x12400, + 0x1246F, + 0x12470, + 0x12475, + 0x12480, + 0x12544, + 0x13000, + 0x1342F, + 0x14400, + 0x14647, + 0x16800, + 0x16A39, + 0x16A40, + 0x16A5F, + 0x16A60, + 0x16A6A, + 0x16A6E, + 0x16A70, + 0x16AD0, + 0x16AEE, + 0x16AF0, + 0x16AF6, + 0x16B00, + 0x16B46, + 0x16B50, + 0x16B5A, + 0x16B5B, + 0x16B62, + 0x16B63, + 0x16B78, + 0x16B7D, + 0x16B90, + 0x16F00, + 0x16F45, + 0x16F50, + 0x16F7F, + 0x16F8F, + 0x16FA0, + 0x16FE0, + 0x16FE1, + 0x17000, + 0x187ED, + 0x18800, + 0x18AF3, + 0x1B000, + 0x1B002, + 0x1BC00, + 0x1BC6B, + 0x1BC70, + 0x1BC7D, + 0x1BC80, + 0x1BC89, + 0x1BC90, + 0x1BC9A, + 0x1BC9C, + 0x1BCA4, + 0x1D000, + 0x1D0F6, + 0x1D100, + 0x1D127, + 0x1D129, + 0x1D1E9, + 0x1D200, + 0x1D246, + 0x1D300, + 0x1D357, + 0x1D360, + 0x1D372, + 0x1D400, + 0x1D455, + 0x1D456, + 0x1D49D, + 0x1D49E, + 0x1D4A0, + 0x1D4A2, + 0x1D4A3, + 0x1D4A5, + 0x1D4A7, + 0x1D4A9, + 0x1D4AD, + 0x1D4AE, + 0x1D4BA, + 0x1D4BB, + 0x1D4BC, + 0x1D4BD, + 0x1D4C4, + 0x1D4C5, + 0x1D506, + 0x1D507, + 0x1D50B, + 0x1D50D, + 0x1D515, 0x1D516, 0x1D51D, 0x1D51E, @@ -289,95 +1144,189 @@ static const UV Cased_invlist[] = { /* for ASCII/Latin1 */ 0x1D552, 0x1D6A6, 0x1D6A8, - 0x1D6C1, - 0x1D6C2, - 0x1D6DB, - 0x1D6DC, - 0x1D6FB, - 0x1D6FC, - 0x1D715, - 0x1D716, - 0x1D735, - 0x1D736, - 0x1D74F, - 0x1D750, - 0x1D76F, - 0x1D770, - 0x1D789, - 0x1D78A, - 0x1D7A9, - 0x1D7AA, - 0x1D7C3, - 0x1D7C4, 0x1D7CC, + 0x1D7CE, + 0x1DA8C, + 0x1DA9B, + 0x1DAA0, + 0x1DAA1, + 0x1DAB0, + 0x1E000, + 0x1E007, + 0x1E008, + 0x1E019, + 0x1E01B, + 0x1E022, + 0x1E023, + 0x1E025, + 0x1E026, + 0x1E02B, + 0x1E800, + 0x1E8C5, + 0x1E8C7, + 0x1E8D7, 0x1E900, - 0x1E944, + 0x1E94B, + 0x1E950, + 0x1E95A, + 0x1E95E, + 0x1E960, + 0x1EE00, + 0x1EE04, + 0x1EE05, + 0x1EE20, + 0x1EE21, + 0x1EE23, + 0x1EE24, + 0x1EE25, + 0x1EE27, + 0x1EE28, + 0x1EE29, + 0x1EE33, + 0x1EE34, + 0x1EE38, + 0x1EE39, + 0x1EE3A, + 0x1EE3B, + 0x1EE3C, + 0x1EE42, + 0x1EE43, + 0x1EE47, + 0x1EE48, + 0x1EE49, + 0x1EE4A, + 0x1EE4B, + 0x1EE4C, + 0x1EE4D, + 0x1EE50, + 0x1EE51, + 0x1EE53, + 0x1EE54, + 0x1EE55, + 0x1EE57, + 0x1EE58, + 0x1EE59, + 0x1EE5A, + 0x1EE5B, + 0x1EE5C, + 0x1EE5D, + 0x1EE5E, + 0x1EE5F, + 0x1EE60, + 0x1EE61, + 0x1EE63, + 0x1EE64, + 0x1EE65, + 0x1EE67, + 0x1EE6B, + 0x1EE6C, + 0x1EE73, + 0x1EE74, + 0x1EE78, + 0x1EE79, + 0x1EE7D, + 0x1EE7E, + 0x1EE7F, + 0x1EE80, + 0x1EE8A, + 0x1EE8B, + 0x1EE9C, + 0x1EEA1, + 0x1EEA4, + 0x1EEA5, + 0x1EEAA, + 0x1EEAB, + 0x1EEBC, + 0x1EEF0, + 0x1EEF2, + 0x1F000, + 0x1F02C, + 0x1F030, + 0x1F094, + 0x1F0A0, + 0x1F0AF, + 0x1F0B1, + 0x1F0C0, + 0x1F0C1, + 0x1F0D0, + 0x1F0D1, + 0x1F0F6, + 0x1F100, + 0x1F10D, + 0x1F110, + 0x1F12F, 0x1F130, - 0x1F14A, - 0x1F150, - 0x1F16A, + 0x1F16C, 0x1F170, - 0x1F18A -}; - -#endif /* defined(PERL_IN_PERL_C) */ - -#if defined(PERL_IN_REGCOMP_C) - -static const UV NonL1_Perl_Non_Final_Folds_invlist[] = { /* for ASCII/Latin1 */ - 45, /* Number of elements */ - 148565664, /* Version and data structure type */ - 1, /* 0 if the list starts at 0; - 1 if it starts at the element beyond 0 */ - 0x0, - 0x2BC, - 0x2BD, - 0x308, - 0x309, - 0x313, - 0x314, - 0x342, - 0x343, - 0x3AC, - 0x3AD, - 0x3AE, - 0x3AF, - 0x3B1, - 0x3B2, - 0x3B7, - 0x3B8, - 0x3B9, - 0x3BA, - 0x3C1, - 0x3C2, - 0x3C5, - 0x3C6, - 0x3C9, - 0x3CA, - 0x3CE, - 0x3CF, - 0x565, - 0x566, - 0x574, - 0x575, - 0x57E, - 0x57F, - 0x1F00, - 0x1F08, - 0x1F20, - 0x1F28, - 0x1F60, - 0x1F68, - 0x1F70, - 0x1F71, - 0x1F74, - 0x1F75, - 0x1F7C, - 0x1F7D + 0x1F1AD, + 0x1F1E6, + 0x1F203, + 0x1F210, + 0x1F23C, + 0x1F240, + 0x1F249, + 0x1F250, + 0x1F252, + 0x1F300, + 0x1F6D3, + 0x1F6E0, + 0x1F6ED, + 0x1F6F0, + 0x1F6F7, + 0x1F700, + 0x1F774, + 0x1F780, + 0x1F7D5, + 0x1F800, + 0x1F80C, + 0x1F810, + 0x1F848, + 0x1F850, + 0x1F85A, + 0x1F860, + 0x1F888, + 0x1F890, + 0x1F8AE, + 0x1F910, + 0x1F91F, + 0x1F920, + 0x1F928, + 0x1F930, + 0x1F931, + 0x1F933, + 0x1F93F, + 0x1F940, + 0x1F94C, + 0x1F950, + 0x1F95F, + 0x1F980, + 0x1F992, + 0x1F9C0, + 0x1F9C1, + 0x20000, + 0x2A6D7, + 0x2A700, + 0x2B735, + 0x2B740, + 0x2B81E, + 0x2B820, + 0x2CEA2, + 0x2F800, + 0x2FA1E, + 0xE0001, + 0xE0002, + 0xE0020, + 0xE0080, + 0xE0100, + 0xE01F0, + 0xF0000, + 0xFFFFE, + 0x100000, + 0x10FFFE }; -static const UV _Perl_Any_Folds_invlist[] = { /* for ASCII/Latin1 */ - 253, /* Number of elements */ +static const UV Cased_invlist[] = { /* for ASCII/Latin1 */ + 271, /* Number of elements */ 148565664, /* Version and data structure type */ 1, /* 0 if the list starts at 0; 1 if it starts at the element beyond 0 */ @@ -386,91 +1335,35 @@ static const UV _Perl_Any_Folds_invlist[] = { /* for ASCII/Latin1 */ 0x5B, 0x61, 0x7B, + 0xAA, + 0xAB, 0xB5, 0xB6, + 0xBA, + 0xBB, 0xC0, 0xD7, 0xD8, 0xF7, 0xF8, - 0x131, - 0x132, - 0x138, - 0x139, - 0x18D, - 0x18E, - 0x19B, - 0x19C, - 0x1AA, - 0x1AC, - 0x1BA, + 0x1BB, 0x1BC, - 0x1BE, - 0x1BF, 0x1C0, 0x1C4, - 0x221, - 0x222, - 0x234, - 0x23A, - 0x255, - 0x256, - 0x258, - 0x259, - 0x25A, - 0x25B, - 0x25D, - 0x260, - 0x262, - 0x263, - 0x264, - 0x265, - 0x267, - 0x268, - 0x26D, - 0x26F, - 0x270, - 0x271, - 0x273, - 0x275, - 0x276, - 0x27D, - 0x27E, - 0x280, - 0x281, - 0x283, - 0x284, - 0x287, - 0x28D, - 0x292, - 0x293, - 0x29D, - 0x29F, - 0x2BC, - 0x2BD, - 0x2BE, - 0x2BF, - 0x300, - 0x302, - 0x307, - 0x309, - 0x30A, - 0x30B, - 0x30C, - 0x30D, - 0x313, - 0x314, - 0x331, - 0x332, - 0x342, - 0x343, + 0x294, + 0x295, + 0x2B9, + 0x2C0, + 0x2C2, + 0x2E0, + 0x2E5, 0x345, 0x346, 0x370, 0x374, 0x376, 0x378, - 0x37B, + 0x37A, 0x37E, 0x37F, 0x380, @@ -483,12 +1376,8 @@ static const UV _Perl_Any_Folds_invlist[] = { /* for ASCII/Latin1 */ 0x38E, 0x3A2, 0x3A3, - 0x3D2, - 0x3D5, 0x3F6, 0x3F7, - 0x3FC, - 0x3FD, 0x482, 0x48A, 0x530, @@ -508,15 +1397,9 @@ static const UV _Perl_Any_Folds_invlist[] = { /* for ASCII/Latin1 */ 0x13FE, 0x1C80, 0x1C89, - 0x1D79, - 0x1D7A, - 0x1D7D, - 0x1D7E, + 0x1D00, + 0x1DC0, 0x1E00, - 0x1E9C, - 0x1E9E, - 0x1E9F, - 0x1EA0, 0x1F16, 0x1F18, 0x1F1E, @@ -554,12 +1437,38 @@ static const UV _Perl_Any_Folds_invlist[] = { /* for ASCII/Latin1 */ 0x1FF5, 0x1FF6, 0x1FFD, + 0x2071, + 0x2072, + 0x207F, + 0x2080, + 0x2090, + 0x209D, + 0x2102, + 0x2103, + 0x2107, + 0x2108, + 0x210A, + 0x2114, + 0x2115, + 0x2116, + 0x2119, + 0x211E, + 0x2124, + 0x2125, 0x2126, 0x2127, + 0x2128, + 0x2129, 0x212A, - 0x212C, - 0x2132, - 0x2133, + 0x212E, + 0x212F, + 0x2135, + 0x2139, + 0x213A, + 0x213C, + 0x2140, + 0x2145, + 0x214A, 0x214E, 0x214F, 0x2160, @@ -573,13 +1482,7 @@ static const UV _Perl_Any_Folds_invlist[] = { /* for ASCII/Latin1 */ 0x2C30, 0x2C5F, 0x2C60, - 0x2C71, - 0x2C72, - 0x2C74, - 0x2C75, - 0x2C77, - 0x2C7E, - 0x2CE4, + 0x2CE5, 0x2CEB, 0x2CEF, 0x2CF2, @@ -593,9 +1496,389 @@ static const UV _Perl_Any_Folds_invlist[] = { /* for ASCII/Latin1 */ 0xA640, 0xA66E, 0xA680, - 0xA69C, + 0xA69E, 0xA722, - 0xA730, + 0xA788, + 0xA78B, + 0xA78F, + 0xA790, + 0xA7AF, + 0xA7B0, + 0xA7B8, + 0xA7F8, + 0xA7FB, + 0xAB30, + 0xAB5B, + 0xAB5C, + 0xAB66, + 0xAB70, + 0xABC0, + 0xFB00, + 0xFB07, + 0xFB13, + 0xFB18, + 0xFF21, + 0xFF3B, + 0xFF41, + 0xFF5B, + 0x10400, + 0x10450, + 0x104B0, + 0x104D4, + 0x104D8, + 0x104FC, + 0x10C80, + 0x10CB3, + 0x10CC0, + 0x10CF3, + 0x118A0, + 0x118E0, + 0x1D400, + 0x1D455, + 0x1D456, + 0x1D49D, + 0x1D49E, + 0x1D4A0, + 0x1D4A2, + 0x1D4A3, + 0x1D4A5, + 0x1D4A7, + 0x1D4A9, + 0x1D4AD, + 0x1D4AE, + 0x1D4BA, + 0x1D4BB, + 0x1D4BC, + 0x1D4BD, + 0x1D4C4, + 0x1D4C5, + 0x1D506, + 0x1D507, + 0x1D50B, + 0x1D50D, + 0x1D515, + 0x1D516, + 0x1D51D, + 0x1D51E, + 0x1D53A, + 0x1D53B, + 0x1D53F, + 0x1D540, + 0x1D545, + 0x1D546, + 0x1D547, + 0x1D54A, + 0x1D551, + 0x1D552, + 0x1D6A6, + 0x1D6A8, + 0x1D6C1, + 0x1D6C2, + 0x1D6DB, + 0x1D6DC, + 0x1D6FB, + 0x1D6FC, + 0x1D715, + 0x1D716, + 0x1D735, + 0x1D736, + 0x1D74F, + 0x1D750, + 0x1D76F, + 0x1D770, + 0x1D789, + 0x1D78A, + 0x1D7A9, + 0x1D7AA, + 0x1D7C3, + 0x1D7C4, + 0x1D7CC, + 0x1E900, + 0x1E944, + 0x1F130, + 0x1F14A, + 0x1F150, + 0x1F16A, + 0x1F170, + 0x1F18A +}; + +#endif /* defined(PERL_IN_PERL_C) */ + +#if defined(PERL_IN_REGCOMP_C) + +static const UV NonL1_Perl_Non_Final_Folds_invlist[] = { /* for ASCII/Latin1 */ + 45, /* Number of elements */ + 148565664, /* Version and data structure type */ + 1, /* 0 if the list starts at 0; + 1 if it starts at the element beyond 0 */ + 0x0, + 0x2BC, + 0x2BD, + 0x308, + 0x309, + 0x313, + 0x314, + 0x342, + 0x343, + 0x3AC, + 0x3AD, + 0x3AE, + 0x3AF, + 0x3B1, + 0x3B2, + 0x3B7, + 0x3B8, + 0x3B9, + 0x3BA, + 0x3C1, + 0x3C2, + 0x3C5, + 0x3C6, + 0x3C9, + 0x3CA, + 0x3CE, + 0x3CF, + 0x565, + 0x566, + 0x574, + 0x575, + 0x57E, + 0x57F, + 0x1F00, + 0x1F08, + 0x1F20, + 0x1F28, + 0x1F60, + 0x1F68, + 0x1F70, + 0x1F71, + 0x1F74, + 0x1F75, + 0x1F7C, + 0x1F7D +}; + +static const UV _Perl_Any_Folds_invlist[] = { /* for ASCII/Latin1 */ + 253, /* Number of elements */ + 148565664, /* Version and data structure type */ + 1, /* 0 if the list starts at 0; + 1 if it starts at the element beyond 0 */ + 0x0, + 0x41, + 0x5B, + 0x61, + 0x7B, + 0xB5, + 0xB6, + 0xC0, + 0xD7, + 0xD8, + 0xF7, + 0xF8, + 0x131, + 0x132, + 0x138, + 0x139, + 0x18D, + 0x18E, + 0x19B, + 0x19C, + 0x1AA, + 0x1AC, + 0x1BA, + 0x1BC, + 0x1BE, + 0x1BF, + 0x1C0, + 0x1C4, + 0x221, + 0x222, + 0x234, + 0x23A, + 0x255, + 0x256, + 0x258, + 0x259, + 0x25A, + 0x25B, + 0x25D, + 0x260, + 0x262, + 0x263, + 0x264, + 0x265, + 0x267, + 0x268, + 0x26D, + 0x26F, + 0x270, + 0x271, + 0x273, + 0x275, + 0x276, + 0x27D, + 0x27E, + 0x280, + 0x281, + 0x283, + 0x284, + 0x287, + 0x28D, + 0x292, + 0x293, + 0x29D, + 0x29F, + 0x2BC, + 0x2BD, + 0x2BE, + 0x2BF, + 0x300, + 0x302, + 0x307, + 0x309, + 0x30A, + 0x30B, + 0x30C, + 0x30D, + 0x313, + 0x314, + 0x331, + 0x332, + 0x342, + 0x343, + 0x345, + 0x346, + 0x370, + 0x374, + 0x376, + 0x378, + 0x37B, + 0x37E, + 0x37F, + 0x380, + 0x386, + 0x387, + 0x388, + 0x38B, + 0x38C, + 0x38D, + 0x38E, + 0x3A2, + 0x3A3, + 0x3D2, + 0x3D5, + 0x3F6, + 0x3F7, + 0x3FC, + 0x3FD, + 0x482, + 0x48A, + 0x530, + 0x531, + 0x557, + 0x561, + 0x588, + 0x10A0, + 0x10C6, + 0x10C7, + 0x10C8, + 0x10CD, + 0x10CE, + 0x13A0, + 0x13F6, + 0x13F8, + 0x13FE, + 0x1C80, + 0x1C89, + 0x1D79, + 0x1D7A, + 0x1D7D, + 0x1D7E, + 0x1E00, + 0x1E9C, + 0x1E9E, + 0x1E9F, + 0x1EA0, + 0x1F16, + 0x1F18, + 0x1F1E, + 0x1F20, + 0x1F46, + 0x1F48, + 0x1F4E, + 0x1F50, + 0x1F58, + 0x1F59, + 0x1F5A, + 0x1F5B, + 0x1F5C, + 0x1F5D, + 0x1F5E, + 0x1F5F, + 0x1F7E, + 0x1F80, + 0x1FB5, + 0x1FB6, + 0x1FBD, + 0x1FBE, + 0x1FBF, + 0x1FC2, + 0x1FC5, + 0x1FC6, + 0x1FCD, + 0x1FD0, + 0x1FD4, + 0x1FD6, + 0x1FDC, + 0x1FE0, + 0x1FED, + 0x1FF2, + 0x1FF5, + 0x1FF6, + 0x1FFD, + 0x2126, + 0x2127, + 0x212A, + 0x212C, + 0x2132, + 0x2133, + 0x214E, + 0x214F, + 0x2160, + 0x2180, + 0x2183, + 0x2185, + 0x24B6, + 0x24EA, + 0x2C00, + 0x2C2F, + 0x2C30, + 0x2C5F, + 0x2C60, + 0x2C71, + 0x2C72, + 0x2C74, + 0x2C75, + 0x2C77, + 0x2C7E, + 0x2CE4, + 0x2CEB, + 0x2CEF, + 0x2CF2, + 0x2CF4, + 0x2D00, + 0x2D26, + 0x2D27, + 0x2D28, + 0x2D2D, + 0x2D2E, + 0xA640, + 0xA66E, + 0xA680, + 0xA69C, + 0xA722, + 0xA730, 0xA732, 0xA770, 0xA779, @@ -30266,539 +31549,488 @@ static const UV ASCII_invlist[] = { /* for EBCDIC 1047 */ 0xFA }; -static const UV Cased_invlist[] = { /* for EBCDIC 1047 */ - 297, /* Number of elements */ +static const UV Assigned_invlist[] = { /* for EBCDIC 1047 */ + 1276, /* Number of elements */ 148565664, /* Version and data structure type */ - 1, /* 0 if the list starts at 0; + 0, /* 0 if the list starts at 0; 1 if it starts at the element beyond 0 */ 0x0, - 0x42, - 0x4A, - 0x51, - 0x5A, - 0x62, - 0x6A, - 0x70, - 0x79, - 0x80, - 0x8A, - 0x8C, - 0x8F, - 0x91, - 0x9D, - 0x9E, - 0x9F, - 0xA0, - 0xA1, - 0xA2, - 0xAA, - 0xAC, - 0xAD, - 0xAE, - 0xAF, - 0xBA, - 0xBB, - 0xC1, - 0xCA, - 0xCB, - 0xD0, - 0xD1, - 0xDA, - 0xDB, - 0xE0, - 0xE2, - 0xEA, - 0xEB, - 0xF0, - 0xFB, - 0xFF, - 0x100, - 0x1BB, - 0x1BC, - 0x1C0, - 0x1C4, - 0x294, - 0x295, - 0x2B9, - 0x2C0, - 0x2C2, - 0x2E0, - 0x2E5, - 0x345, - 0x346, - 0x370, - 0x374, - 0x376, 0x378, 0x37A, - 0x37E, - 0x37F, 0x380, - 0x386, - 0x387, - 0x388, + 0x384, 0x38B, 0x38C, 0x38D, 0x38E, 0x3A2, 0x3A3, - 0x3F6, - 0x3F7, - 0x482, - 0x48A, 0x530, 0x531, 0x557, + 0x559, + 0x560, 0x561, 0x588, - 0x10A0, + 0x589, + 0x58B, + 0x58D, + 0x590, + 0x591, + 0x5C8, + 0x5D0, + 0x5EB, + 0x5F0, + 0x5F5, + 0x600, + 0x61D, + 0x61E, + 0x70E, + 0x70F, + 0x74B, + 0x74D, + 0x7B2, + 0x7C0, + 0x7FB, + 0x800, + 0x82E, + 0x830, + 0x83F, + 0x840, + 0x85C, + 0x85E, + 0x85F, + 0x8A0, + 0x8B5, + 0x8B6, + 0x8BE, + 0x8D4, + 0x984, + 0x985, + 0x98D, + 0x98F, + 0x991, + 0x993, + 0x9A9, + 0x9AA, + 0x9B1, + 0x9B2, + 0x9B3, + 0x9B6, + 0x9BA, + 0x9BC, + 0x9C5, + 0x9C7, + 0x9C9, + 0x9CB, + 0x9CF, + 0x9D7, + 0x9D8, + 0x9DC, + 0x9DE, + 0x9DF, + 0x9E4, + 0x9E6, + 0x9FC, + 0xA01, + 0xA04, + 0xA05, + 0xA0B, + 0xA0F, + 0xA11, + 0xA13, + 0xA29, + 0xA2A, + 0xA31, + 0xA32, + 0xA34, + 0xA35, + 0xA37, + 0xA38, + 0xA3A, + 0xA3C, + 0xA3D, + 0xA3E, + 0xA43, + 0xA47, + 0xA49, + 0xA4B, + 0xA4E, + 0xA51, + 0xA52, + 0xA59, + 0xA5D, + 0xA5E, + 0xA5F, + 0xA66, + 0xA76, + 0xA81, + 0xA84, + 0xA85, + 0xA8E, + 0xA8F, + 0xA92, + 0xA93, + 0xAA9, + 0xAAA, + 0xAB1, + 0xAB2, + 0xAB4, + 0xAB5, + 0xABA, + 0xABC, + 0xAC6, + 0xAC7, + 0xACA, + 0xACB, + 0xACE, + 0xAD0, + 0xAD1, + 0xAE0, + 0xAE4, + 0xAE6, + 0xAF2, + 0xAF9, + 0xAFA, + 0xB01, + 0xB04, + 0xB05, + 0xB0D, + 0xB0F, + 0xB11, + 0xB13, + 0xB29, + 0xB2A, + 0xB31, + 0xB32, + 0xB34, + 0xB35, + 0xB3A, + 0xB3C, + 0xB45, + 0xB47, + 0xB49, + 0xB4B, + 0xB4E, + 0xB56, + 0xB58, + 0xB5C, + 0xB5E, + 0xB5F, + 0xB64, + 0xB66, + 0xB78, + 0xB82, + 0xB84, + 0xB85, + 0xB8B, + 0xB8E, + 0xB91, + 0xB92, + 0xB96, + 0xB99, + 0xB9B, + 0xB9C, + 0xB9D, + 0xB9E, + 0xBA0, + 0xBA3, + 0xBA5, + 0xBA8, + 0xBAB, + 0xBAE, + 0xBBA, + 0xBBE, + 0xBC3, + 0xBC6, + 0xBC9, + 0xBCA, + 0xBCE, + 0xBD0, + 0xBD1, + 0xBD7, + 0xBD8, + 0xBE6, + 0xBFB, + 0xC00, + 0xC04, + 0xC05, + 0xC0D, + 0xC0E, + 0xC11, + 0xC12, + 0xC29, + 0xC2A, + 0xC3A, + 0xC3D, + 0xC45, + 0xC46, + 0xC49, + 0xC4A, + 0xC4E, + 0xC55, + 0xC57, + 0xC58, + 0xC5B, + 0xC60, + 0xC64, + 0xC66, + 0xC70, + 0xC78, + 0xC84, + 0xC85, + 0xC8D, + 0xC8E, + 0xC91, + 0xC92, + 0xCA9, + 0xCAA, + 0xCB4, + 0xCB5, + 0xCBA, + 0xCBC, + 0xCC5, + 0xCC6, + 0xCC9, + 0xCCA, + 0xCCE, + 0xCD5, + 0xCD7, + 0xCDE, + 0xCDF, + 0xCE0, + 0xCE4, + 0xCE6, + 0xCF0, + 0xCF1, + 0xCF3, + 0xD01, + 0xD04, + 0xD05, + 0xD0D, + 0xD0E, + 0xD11, + 0xD12, + 0xD3B, + 0xD3D, + 0xD45, + 0xD46, + 0xD49, + 0xD4A, + 0xD50, + 0xD54, + 0xD64, + 0xD66, + 0xD80, + 0xD82, + 0xD84, + 0xD85, + 0xD97, + 0xD9A, + 0xDB2, + 0xDB3, + 0xDBC, + 0xDBD, + 0xDBE, + 0xDC0, + 0xDC7, + 0xDCA, + 0xDCB, + 0xDCF, + 0xDD5, + 0xDD6, + 0xDD7, + 0xDD8, + 0xDE0, + 0xDE6, + 0xDF0, + 0xDF2, + 0xDF5, + 0xE01, + 0xE3B, + 0xE3F, + 0xE5C, + 0xE81, + 0xE83, + 0xE84, + 0xE85, + 0xE87, + 0xE89, + 0xE8A, + 0xE8B, + 0xE8D, + 0xE8E, + 0xE94, + 0xE98, + 0xE99, + 0xEA0, + 0xEA1, + 0xEA4, + 0xEA5, + 0xEA6, + 0xEA7, + 0xEA8, + 0xEAA, + 0xEAC, + 0xEAD, + 0xEBA, + 0xEBB, + 0xEBE, + 0xEC0, + 0xEC5, + 0xEC6, + 0xEC7, + 0xEC8, + 0xECE, + 0xED0, + 0xEDA, + 0xEDC, + 0xEE0, + 0xF00, + 0xF48, + 0xF49, + 0xF6D, + 0xF71, + 0xF98, + 0xF99, + 0xFBD, + 0xFBE, + 0xFCD, + 0xFCE, + 0xFDB, + 0x1000, 0x10C6, 0x10C7, 0x10C8, 0x10CD, 0x10CE, + 0x10D0, + 0x1249, + 0x124A, + 0x124E, + 0x1250, + 0x1257, + 0x1258, + 0x1259, + 0x125A, + 0x125E, + 0x1260, + 0x1289, + 0x128A, + 0x128E, + 0x1290, + 0x12B1, + 0x12B2, + 0x12B6, + 0x12B8, + 0x12BF, + 0x12C0, + 0x12C1, + 0x12C2, + 0x12C6, + 0x12C8, + 0x12D7, + 0x12D8, + 0x1311, + 0x1312, + 0x1316, + 0x1318, + 0x135B, + 0x135D, + 0x137D, + 0x1380, + 0x139A, 0x13A0, 0x13F6, 0x13F8, 0x13FE, - 0x1C80, - 0x1C89, - 0x1D00, - 0x1DC0, - 0x1E00, - 0x1F16, - 0x1F18, - 0x1F1E, - 0x1F20, - 0x1F46, - 0x1F48, - 0x1F4E, - 0x1F50, - 0x1F58, - 0x1F59, - 0x1F5A, - 0x1F5B, - 0x1F5C, - 0x1F5D, - 0x1F5E, - 0x1F5F, - 0x1F7E, - 0x1F80, - 0x1FB5, - 0x1FB6, - 0x1FBD, - 0x1FBE, - 0x1FBF, - 0x1FC2, - 0x1FC5, - 0x1FC6, - 0x1FCD, - 0x1FD0, - 0x1FD4, - 0x1FD6, - 0x1FDC, - 0x1FE0, - 0x1FED, - 0x1FF2, - 0x1FF5, - 0x1FF6, - 0x1FFD, - 0x2071, - 0x2072, - 0x207F, - 0x2080, - 0x2090, - 0x209D, - 0x2102, - 0x2103, - 0x2107, - 0x2108, - 0x210A, - 0x2114, - 0x2115, - 0x2116, - 0x2119, - 0x211E, - 0x2124, - 0x2125, - 0x2126, - 0x2127, - 0x2128, - 0x2129, - 0x212A, - 0x212E, - 0x212F, - 0x2135, - 0x2139, - 0x213A, - 0x213C, - 0x2140, - 0x2145, - 0x214A, - 0x214E, - 0x214F, - 0x2160, - 0x2180, - 0x2183, - 0x2185, - 0x24B6, - 0x24EA, - 0x2C00, - 0x2C2F, - 0x2C30, - 0x2C5F, - 0x2C60, - 0x2CE5, - 0x2CEB, - 0x2CEF, - 0x2CF2, - 0x2CF4, - 0x2D00, - 0x2D26, - 0x2D27, - 0x2D28, - 0x2D2D, - 0x2D2E, - 0xA640, - 0xA66E, - 0xA680, - 0xA69E, - 0xA722, - 0xA788, - 0xA78B, - 0xA78F, - 0xA790, - 0xA7AF, - 0xA7B0, - 0xA7B8, - 0xA7F8, - 0xA7FB, - 0xAB30, - 0xAB5B, - 0xAB5C, - 0xAB66, - 0xAB70, - 0xABC0, - 0xFB00, - 0xFB07, - 0xFB13, - 0xFB18, - 0xFF21, - 0xFF3B, - 0xFF41, - 0xFF5B, - 0x10400, - 0x10450, - 0x104B0, - 0x104D4, - 0x104D8, - 0x104FC, - 0x10C80, - 0x10CB3, - 0x10CC0, - 0x10CF3, - 0x118A0, - 0x118E0, - 0x1D400, - 0x1D455, - 0x1D456, - 0x1D49D, - 0x1D49E, - 0x1D4A0, - 0x1D4A2, - 0x1D4A3, - 0x1D4A5, - 0x1D4A7, - 0x1D4A9, - 0x1D4AD, - 0x1D4AE, - 0x1D4BA, - 0x1D4BB, - 0x1D4BC, - 0x1D4BD, - 0x1D4C4, - 0x1D4C5, - 0x1D506, - 0x1D507, - 0x1D50B, - 0x1D50D, - 0x1D515, - 0x1D516, - 0x1D51D, - 0x1D51E, - 0x1D53A, - 0x1D53B, - 0x1D53F, - 0x1D540, - 0x1D545, - 0x1D546, - 0x1D547, - 0x1D54A, - 0x1D551, - 0x1D552, - 0x1D6A6, - 0x1D6A8, - 0x1D6C1, - 0x1D6C2, - 0x1D6DB, - 0x1D6DC, - 0x1D6FB, - 0x1D6FC, - 0x1D715, - 0x1D716, - 0x1D735, - 0x1D736, - 0x1D74F, - 0x1D750, - 0x1D76F, - 0x1D770, - 0x1D789, - 0x1D78A, - 0x1D7A9, - 0x1D7AA, - 0x1D7C3, - 0x1D7C4, - 0x1D7CC, - 0x1E900, - 0x1E944, - 0x1F130, - 0x1F14A, - 0x1F150, - 0x1F16A, - 0x1F170, - 0x1F18A -}; - -#endif /* defined(PERL_IN_PERL_C) */ - -#if defined(PERL_IN_REGCOMP_C) - -static const UV NonL1_Perl_Non_Final_Folds_invlist[] = { /* for EBCDIC 1047 */ - 45, /* Number of elements */ - 148565664, /* Version and data structure type */ - 1, /* 0 if the list starts at 0; - 1 if it starts at the element beyond 0 */ - 0x0, - 0x2BC, - 0x2BD, - 0x308, - 0x309, - 0x313, - 0x314, - 0x342, - 0x343, - 0x3AC, - 0x3AD, - 0x3AE, - 0x3AF, - 0x3B1, - 0x3B2, - 0x3B7, - 0x3B8, - 0x3B9, - 0x3BA, - 0x3C1, - 0x3C2, - 0x3C5, - 0x3C6, - 0x3C9, - 0x3CA, - 0x3CE, - 0x3CF, - 0x565, - 0x566, - 0x574, - 0x575, - 0x57E, - 0x57F, - 0x1F00, - 0x1F08, - 0x1F20, - 0x1F28, - 0x1F60, - 0x1F68, - 0x1F70, - 0x1F71, - 0x1F74, - 0x1F75, - 0x1F7C, - 0x1F7D -}; - -static const UV _Perl_Any_Folds_invlist[] = { /* for EBCDIC 1047 */ - 285, /* Number of elements */ - 148565664, /* Version and data structure type */ - 1, /* 0 if the list starts at 0; - 1 if it starts at the element beyond 0 */ - 0x0, - 0x42, - 0x4A, - 0x51, - 0x5A, - 0x62, - 0x6A, - 0x70, - 0x79, - 0x80, - 0x8A, - 0x8C, - 0x8F, - 0x91, - 0x9A, - 0x9C, - 0x9D, - 0x9E, - 0x9F, - 0xA0, - 0xA1, - 0xA2, - 0xAA, - 0xAC, - 0xAD, - 0xAE, - 0xAF, - 0xBA, - 0xBB, - 0xC1, - 0xCA, - 0xCB, - 0xD0, - 0xD1, - 0xDA, - 0xDB, - 0xE0, - 0xE2, - 0xEA, - 0xEB, - 0xF0, - 0xFB, - 0xFF, - 0x100, - 0x131, - 0x132, - 0x138, - 0x139, - 0x18D, - 0x18E, - 0x19B, - 0x19C, - 0x1AA, - 0x1AC, - 0x1BA, - 0x1BC, - 0x1BE, - 0x1BF, - 0x1C0, - 0x1C4, - 0x221, - 0x222, - 0x234, - 0x23A, - 0x255, - 0x256, - 0x258, - 0x259, - 0x25A, - 0x25B, - 0x25D, - 0x260, - 0x262, - 0x263, - 0x264, - 0x265, - 0x267, - 0x268, - 0x26D, - 0x26F, - 0x270, - 0x271, - 0x273, - 0x275, - 0x276, - 0x27D, - 0x27E, - 0x280, - 0x281, - 0x283, - 0x284, - 0x287, - 0x28D, - 0x292, - 0x293, - 0x29D, - 0x29F, - 0x2BC, - 0x2BD, - 0x2BE, - 0x2BF, - 0x300, - 0x302, - 0x307, - 0x309, - 0x30A, - 0x30B, - 0x30C, - 0x30D, - 0x313, - 0x314, - 0x331, - 0x332, - 0x342, - 0x343, - 0x345, - 0x346, - 0x370, - 0x374, - 0x376, - 0x378, - 0x37B, - 0x37E, - 0x37F, - 0x380, - 0x386, - 0x387, - 0x388, - 0x38B, - 0x38C, - 0x38D, - 0x38E, - 0x3A2, - 0x3A3, - 0x3D2, - 0x3D5, - 0x3F6, - 0x3F7, - 0x3FC, - 0x3FD, - 0x482, - 0x48A, - 0x530, - 0x531, - 0x557, - 0x561, - 0x588, - 0x10A0, - 0x10C6, - 0x10C7, - 0x10C8, - 0x10CD, - 0x10CE, - 0x13A0, - 0x13F6, - 0x13F8, - 0x13FE, - 0x1C80, + 0x1400, + 0x169D, + 0x16A0, + 0x16F9, + 0x1700, + 0x170D, + 0x170E, + 0x1715, + 0x1720, + 0x1737, + 0x1740, + 0x1754, + 0x1760, + 0x176D, + 0x176E, + 0x1771, + 0x1772, + 0x1774, + 0x1780, + 0x17DE, + 0x17E0, + 0x17EA, + 0x17F0, + 0x17FA, + 0x1800, + 0x180F, + 0x1810, + 0x181A, + 0x1820, + 0x1878, + 0x1880, + 0x18AB, + 0x18B0, + 0x18F6, + 0x1900, + 0x191F, + 0x1920, + 0x192C, + 0x1930, + 0x193C, + 0x1940, + 0x1941, + 0x1944, + 0x196E, + 0x1970, + 0x1975, + 0x1980, + 0x19AC, + 0x19B0, + 0x19CA, + 0x19D0, + 0x19DB, + 0x19DE, + 0x1A1C, + 0x1A1E, + 0x1A5F, + 0x1A60, + 0x1A7D, + 0x1A7F, + 0x1A8A, + 0x1A90, + 0x1A9A, + 0x1AA0, + 0x1AAE, + 0x1AB0, + 0x1ABF, + 0x1B00, + 0x1B4C, + 0x1B50, + 0x1B7D, + 0x1B80, + 0x1BF4, + 0x1BFC, + 0x1C38, + 0x1C3B, + 0x1C4A, + 0x1C4D, 0x1C89, - 0x1D79, - 0x1D7A, - 0x1D7D, - 0x1D7E, - 0x1E00, - 0x1E9C, - 0x1E9E, - 0x1E9F, - 0x1EA0, + 0x1CC0, + 0x1CC8, + 0x1CD0, + 0x1CF7, + 0x1CF8, + 0x1CFA, + 0x1D00, + 0x1DF6, + 0x1DFB, 0x1F16, 0x1F18, 0x1F1E, @@ -30819,724 +32051,2058 @@ static const UV _Perl_Any_Folds_invlist[] = { /* for EBCDIC 1047 */ 0x1F80, 0x1FB5, 0x1FB6, - 0x1FBD, - 0x1FBE, - 0x1FBF, - 0x1FC2, 0x1FC5, 0x1FC6, - 0x1FCD, - 0x1FD0, 0x1FD4, 0x1FD6, 0x1FDC, - 0x1FE0, - 0x1FED, + 0x1FDD, + 0x1FF0, 0x1FF2, 0x1FF5, 0x1FF6, - 0x1FFD, - 0x2126, - 0x2127, - 0x212A, - 0x212C, - 0x2132, - 0x2133, - 0x214E, - 0x214F, - 0x2160, - 0x2180, - 0x2183, - 0x2185, - 0x24B6, - 0x24EA, + 0x1FFF, + 0x2000, + 0x2065, + 0x2066, + 0x2072, + 0x2074, + 0x208F, + 0x2090, + 0x209D, + 0x20A0, + 0x20BF, + 0x20D0, + 0x20F1, + 0x2100, + 0x218C, + 0x2190, + 0x23FF, + 0x2400, + 0x2427, + 0x2440, + 0x244B, + 0x2460, + 0x2B74, + 0x2B76, + 0x2B96, + 0x2B98, + 0x2BBA, + 0x2BBD, + 0x2BC9, + 0x2BCA, + 0x2BD2, + 0x2BEC, + 0x2BF0, 0x2C00, 0x2C2F, 0x2C30, 0x2C5F, 0x2C60, - 0x2C71, - 0x2C72, - 0x2C74, - 0x2C75, - 0x2C77, - 0x2C7E, - 0x2CE4, - 0x2CEB, - 0x2CEF, - 0x2CF2, 0x2CF4, - 0x2D00, + 0x2CF9, 0x2D26, 0x2D27, 0x2D28, 0x2D2D, 0x2D2E, + 0x2D30, + 0x2D68, + 0x2D6F, + 0x2D71, + 0x2D7F, + 0x2D97, + 0x2DA0, + 0x2DA7, + 0x2DA8, + 0x2DAF, + 0x2DB0, + 0x2DB7, + 0x2DB8, + 0x2DBF, + 0x2DC0, + 0x2DC7, + 0x2DC8, + 0x2DCF, + 0x2DD0, + 0x2DD7, + 0x2DD8, + 0x2DDF, + 0x2DE0, + 0x2E45, + 0x2E80, + 0x2E9A, + 0x2E9B, + 0x2EF4, + 0x2F00, + 0x2FD6, + 0x2FF0, + 0x2FFC, + 0x3000, + 0x3040, + 0x3041, + 0x3097, + 0x3099, + 0x3100, + 0x3105, + 0x312E, + 0x3131, + 0x318F, + 0x3190, + 0x31BB, + 0x31C0, + 0x31E4, + 0x31F0, + 0x321F, + 0x3220, + 0x32FF, + 0x3300, + 0x4DB6, + 0x4DC0, + 0x9FD6, + 0xA000, + 0xA48D, + 0xA490, + 0xA4C7, + 0xA4D0, + 0xA62C, 0xA640, - 0xA66E, - 0xA680, - 0xA69C, - 0xA722, - 0xA730, - 0xA732, - 0xA770, - 0xA779, - 0xA788, - 0xA78B, - 0xA78E, - 0xA790, - 0xA794, - 0xA796, + 0xA6F8, + 0xA700, 0xA7AF, 0xA7B0, 0xA7B8, - 0xAB53, - 0xAB54, + 0xA7F7, + 0xA82C, + 0xA830, + 0xA83A, + 0xA840, + 0xA878, + 0xA880, + 0xA8C6, + 0xA8CE, + 0xA8DA, + 0xA8E0, + 0xA8FE, + 0xA900, + 0xA954, + 0xA95F, + 0xA97D, + 0xA980, + 0xA9CE, + 0xA9CF, + 0xA9DA, + 0xA9DE, + 0xA9FF, + 0xAA00, + 0xAA37, + 0xAA40, + 0xAA4E, + 0xAA50, + 0xAA5A, + 0xAA5C, + 0xAAC3, + 0xAADB, + 0xAAF7, + 0xAB01, + 0xAB07, + 0xAB09, + 0xAB0F, + 0xAB11, + 0xAB17, + 0xAB20, + 0xAB27, + 0xAB28, + 0xAB2F, + 0xAB30, + 0xAB66, 0xAB70, - 0xABC0, + 0xABEE, + 0xABF0, + 0xABFA, + 0xAC00, + 0xD7A4, + 0xD7B0, + 0xD7C7, + 0xD7CB, + 0xD7FC, + 0xD800, + 0xFA6E, + 0xFA70, + 0xFADA, 0xFB00, 0xFB07, 0xFB13, 0xFB18, - 0xFF21, - 0xFF3B, - 0xFF41, - 0xFF5B, + 0xFB1D, + 0xFB37, + 0xFB38, + 0xFB3D, + 0xFB3E, + 0xFB3F, + 0xFB40, + 0xFB42, + 0xFB43, + 0xFB45, + 0xFB46, + 0xFBC2, + 0xFBD3, + 0xFD40, + 0xFD50, + 0xFD90, + 0xFD92, + 0xFDC8, + 0xFDF0, + 0xFDFE, + 0xFE00, + 0xFE1A, + 0xFE20, + 0xFE53, + 0xFE54, + 0xFE67, + 0xFE68, + 0xFE6C, + 0xFE70, + 0xFE75, + 0xFE76, + 0xFEFD, + 0xFEFF, + 0xFF00, + 0xFF01, + 0xFFBF, + 0xFFC2, + 0xFFC8, + 0xFFCA, + 0xFFD0, + 0xFFD2, + 0xFFD8, + 0xFFDA, + 0xFFDD, + 0xFFE0, + 0xFFE7, + 0xFFE8, + 0xFFEF, + 0xFFF9, + 0xFFFE, + 0x10000, + 0x1000C, + 0x1000D, + 0x10027, + 0x10028, + 0x1003B, + 0x1003C, + 0x1003E, + 0x1003F, + 0x1004E, + 0x10050, + 0x1005E, + 0x10080, + 0x100FB, + 0x10100, + 0x10103, + 0x10107, + 0x10134, + 0x10137, + 0x1018F, + 0x10190, + 0x1019C, + 0x101A0, + 0x101A1, + 0x101D0, + 0x101FE, + 0x10280, + 0x1029D, + 0x102A0, + 0x102D1, + 0x102E0, + 0x102FC, + 0x10300, + 0x10324, + 0x10330, + 0x1034B, + 0x10350, + 0x1037B, + 0x10380, + 0x1039E, + 0x1039F, + 0x103C4, + 0x103C8, + 0x103D6, 0x10400, - 0x10450, + 0x1049E, + 0x104A0, + 0x104AA, 0x104B0, 0x104D4, 0x104D8, 0x104FC, + 0x10500, + 0x10528, + 0x10530, + 0x10564, + 0x1056F, + 0x10570, + 0x10600, + 0x10737, + 0x10740, + 0x10756, + 0x10760, + 0x10768, + 0x10800, + 0x10806, + 0x10808, + 0x10809, + 0x1080A, + 0x10836, + 0x10837, + 0x10839, + 0x1083C, + 0x1083D, + 0x1083F, + 0x10856, + 0x10857, + 0x1089F, + 0x108A7, + 0x108B0, + 0x108E0, + 0x108F3, + 0x108F4, + 0x108F6, + 0x108FB, + 0x1091C, + 0x1091F, + 0x1093A, + 0x1093F, + 0x10940, + 0x10980, + 0x109B8, + 0x109BC, + 0x109D0, + 0x109D2, + 0x10A04, + 0x10A05, + 0x10A07, + 0x10A0C, + 0x10A14, + 0x10A15, + 0x10A18, + 0x10A19, + 0x10A34, + 0x10A38, + 0x10A3B, + 0x10A3F, + 0x10A48, + 0x10A50, + 0x10A59, + 0x10A60, + 0x10AA0, + 0x10AC0, + 0x10AE7, + 0x10AEB, + 0x10AF7, + 0x10B00, + 0x10B36, + 0x10B39, + 0x10B56, + 0x10B58, + 0x10B73, + 0x10B78, + 0x10B92, + 0x10B99, + 0x10B9D, + 0x10BA9, + 0x10BB0, + 0x10C00, + 0x10C49, 0x10C80, 0x10CB3, 0x10CC0, 0x10CF3, + 0x10CFA, + 0x10D00, + 0x10E60, + 0x10E7F, + 0x11000, + 0x1104E, + 0x11052, + 0x11070, + 0x1107F, + 0x110C2, + 0x110D0, + 0x110E9, + 0x110F0, + 0x110FA, + 0x11100, + 0x11135, + 0x11136, + 0x11144, + 0x11150, + 0x11177, + 0x11180, + 0x111CE, + 0x111D0, + 0x111E0, + 0x111E1, + 0x111F5, + 0x11200, + 0x11212, + 0x11213, + 0x1123F, + 0x11280, + 0x11287, + 0x11288, + 0x11289, + 0x1128A, + 0x1128E, + 0x1128F, + 0x1129E, + 0x1129F, + 0x112AA, + 0x112B0, + 0x112EB, + 0x112F0, + 0x112FA, + 0x11300, + 0x11304, + 0x11305, + 0x1130D, + 0x1130F, + 0x11311, + 0x11313, + 0x11329, + 0x1132A, + 0x11331, + 0x11332, + 0x11334, + 0x11335, + 0x1133A, + 0x1133C, + 0x11345, + 0x11347, + 0x11349, + 0x1134B, + 0x1134E, + 0x11350, + 0x11351, + 0x11357, + 0x11358, + 0x1135D, + 0x11364, + 0x11366, + 0x1136D, + 0x11370, + 0x11375, + 0x11400, + 0x1145A, + 0x1145B, + 0x1145C, + 0x1145D, + 0x1145E, + 0x11480, + 0x114C8, + 0x114D0, + 0x114DA, + 0x11580, + 0x115B6, + 0x115B8, + 0x115DE, + 0x11600, + 0x11645, + 0x11650, + 0x1165A, + 0x11660, + 0x1166D, + 0x11680, + 0x116B8, + 0x116C0, + 0x116CA, + 0x11700, + 0x1171A, + 0x1171D, + 0x1172C, + 0x11730, + 0x11740, 0x118A0, - 0x118E0, - 0x1E900, - 0x1E944 -}; - -static const UV _Perl_Folds_To_Multi_Char_invlist[] = { /* for EBCDIC 1047 */ - 59, /* Number of elements */ - 148565664, /* Version and data structure type */ - 1, /* 0 if the list starts at 0; - 1 if it starts at the element beyond 0 */ - 0x0, - 0x59, - 0x5A, - 0x130, - 0x131, - 0x149, - 0x14A, - 0x1F0, - 0x1F1, - 0x390, - 0x391, - 0x3B0, - 0x3B1, - 0x587, - 0x588, - 0x1E96, - 0x1E9B, - 0x1E9E, - 0x1E9F, - 0x1F50, - 0x1F51, - 0x1F52, - 0x1F53, - 0x1F54, - 0x1F55, - 0x1F56, - 0x1F57, - 0x1F80, - 0x1FB0, - 0x1FB2, - 0x1FB5, - 0x1FB6, - 0x1FB8, - 0x1FBC, - 0x1FBD, - 0x1FC2, - 0x1FC5, - 0x1FC6, - 0x1FC8, - 0x1FCC, - 0x1FCD, - 0x1FD2, - 0x1FD4, - 0x1FD6, - 0x1FD8, - 0x1FE2, - 0x1FE5, - 0x1FE6, - 0x1FE8, - 0x1FF2, - 0x1FF5, - 0x1FF6, - 0x1FF8, - 0x1FFC, - 0x1FFD, - 0xFB00, - 0xFB07, - 0xFB13, - 0xFB18 -}; - -#endif /* defined(PERL_IN_REGCOMP_C) */ - -#if defined(PERL_IN_PERL_C) - -static const UV _Perl_GCB_invlist[] = { /* for EBCDIC 1047 */ - 1615, /* Number of elements */ - 148565664, /* Version and data structure type */ - 0, /* 0 if the list starts at 0; - 1 if it starts at the element beyond 0 */ - 0x0, - 0xD, - 0xE, - 0x15, - 0x16, - 0x40, - 0xCA, + 0x118F3, + 0x118FF, + 0x11900, + 0x11AC0, + 0x11AF9, + 0x11C00, + 0x11C09, + 0x11C0A, + 0x11C37, + 0x11C38, + 0x11C46, + 0x11C50, + 0x11C6D, + 0x11C70, + 0x11C90, + 0x11C92, + 0x11CA8, + 0x11CA9, + 0x11CB7, + 0x12000, + 0x1239A, + 0x12400, + 0x1246F, + 0x12470, + 0x12475, + 0x12480, + 0x12544, + 0x13000, + 0x1342F, + 0x14400, + 0x14647, + 0x16800, + 0x16A39, + 0x16A40, + 0x16A5F, + 0x16A60, + 0x16A6A, + 0x16A6E, + 0x16A70, + 0x16AD0, + 0x16AEE, + 0x16AF0, + 0x16AF6, + 0x16B00, + 0x16B46, + 0x16B50, + 0x16B5A, + 0x16B5B, + 0x16B62, + 0x16B63, + 0x16B78, + 0x16B7D, + 0x16B90, + 0x16F00, + 0x16F45, + 0x16F50, + 0x16F7F, + 0x16F8F, + 0x16FA0, + 0x16FE0, + 0x16FE1, + 0x17000, + 0x187ED, + 0x18800, + 0x18AF3, + 0x1B000, + 0x1B002, + 0x1BC00, + 0x1BC6B, + 0x1BC70, + 0x1BC7D, + 0x1BC80, + 0x1BC89, + 0x1BC90, + 0x1BC9A, + 0x1BC9C, + 0x1BCA4, + 0x1D000, + 0x1D0F6, + 0x1D100, + 0x1D127, + 0x1D129, + 0x1D1E9, + 0x1D200, + 0x1D246, + 0x1D300, + 0x1D357, + 0x1D360, + 0x1D372, + 0x1D400, + 0x1D455, + 0x1D456, + 0x1D49D, + 0x1D49E, + 0x1D4A0, + 0x1D4A2, + 0x1D4A3, + 0x1D4A5, + 0x1D4A7, + 0x1D4A9, + 0x1D4AD, + 0x1D4AE, + 0x1D4BA, + 0x1D4BB, + 0x1D4BC, + 0x1D4BD, + 0x1D4C4, + 0x1D4C5, + 0x1D506, + 0x1D507, + 0x1D50B, + 0x1D50D, + 0x1D515, + 0x1D516, + 0x1D51D, + 0x1D51E, + 0x1D53A, + 0x1D53B, + 0x1D53F, + 0x1D540, + 0x1D545, + 0x1D546, + 0x1D547, + 0x1D54A, + 0x1D551, + 0x1D552, + 0x1D6A6, + 0x1D6A8, + 0x1D7CC, + 0x1D7CE, + 0x1DA8C, + 0x1DA9B, + 0x1DAA0, + 0x1DAA1, + 0x1DAB0, + 0x1E000, + 0x1E007, + 0x1E008, + 0x1E019, + 0x1E01B, + 0x1E022, + 0x1E023, + 0x1E025, + 0x1E026, + 0x1E02B, + 0x1E800, + 0x1E8C5, + 0x1E8C7, + 0x1E8D7, + 0x1E900, + 0x1E94B, + 0x1E950, + 0x1E95A, + 0x1E95E, + 0x1E960, + 0x1EE00, + 0x1EE04, + 0x1EE05, + 0x1EE20, + 0x1EE21, + 0x1EE23, + 0x1EE24, + 0x1EE25, + 0x1EE27, + 0x1EE28, + 0x1EE29, + 0x1EE33, + 0x1EE34, + 0x1EE38, + 0x1EE39, + 0x1EE3A, + 0x1EE3B, + 0x1EE3C, + 0x1EE42, + 0x1EE43, + 0x1EE47, + 0x1EE48, + 0x1EE49, + 0x1EE4A, + 0x1EE4B, + 0x1EE4C, + 0x1EE4D, + 0x1EE50, + 0x1EE51, + 0x1EE53, + 0x1EE54, + 0x1EE55, + 0x1EE57, + 0x1EE58, + 0x1EE59, + 0x1EE5A, + 0x1EE5B, + 0x1EE5C, + 0x1EE5D, + 0x1EE5E, + 0x1EE5F, + 0x1EE60, + 0x1EE61, + 0x1EE63, + 0x1EE64, + 0x1EE65, + 0x1EE67, + 0x1EE6B, + 0x1EE6C, + 0x1EE73, + 0x1EE74, + 0x1EE78, + 0x1EE79, + 0x1EE7D, + 0x1EE7E, + 0x1EE7F, + 0x1EE80, + 0x1EE8A, + 0x1EE8B, + 0x1EE9C, + 0x1EEA1, + 0x1EEA4, + 0x1EEA5, + 0x1EEAA, + 0x1EEAB, + 0x1EEBC, + 0x1EEF0, + 0x1EEF2, + 0x1F000, + 0x1F02C, + 0x1F030, + 0x1F094, + 0x1F0A0, + 0x1F0AF, + 0x1F0B1, + 0x1F0C0, + 0x1F0C1, + 0x1F0D0, + 0x1F0D1, + 0x1F0F6, + 0x1F100, + 0x1F10D, + 0x1F110, + 0x1F12F, + 0x1F130, + 0x1F16C, + 0x1F170, + 0x1F1AD, + 0x1F1E6, + 0x1F203, + 0x1F210, + 0x1F23C, + 0x1F240, + 0x1F249, + 0x1F250, + 0x1F252, + 0x1F300, + 0x1F6D3, + 0x1F6E0, + 0x1F6ED, + 0x1F6F0, + 0x1F6F7, + 0x1F700, + 0x1F774, + 0x1F780, + 0x1F7D5, + 0x1F800, + 0x1F80C, + 0x1F810, + 0x1F848, + 0x1F850, + 0x1F85A, + 0x1F860, + 0x1F888, + 0x1F890, + 0x1F8AE, + 0x1F910, + 0x1F91F, + 0x1F920, + 0x1F928, + 0x1F930, + 0x1F931, + 0x1F933, + 0x1F93F, + 0x1F940, + 0x1F94C, + 0x1F950, + 0x1F95F, + 0x1F980, + 0x1F992, + 0x1F9C0, + 0x1F9C1, + 0x20000, + 0x2A6D7, + 0x2A700, + 0x2B735, + 0x2B740, + 0x2B81E, + 0x2B820, + 0x2CEA2, + 0x2F800, + 0x2FA1E, + 0xE0001, + 0xE0002, + 0xE0020, + 0xE0080, + 0xE0100, + 0xE01F0, + 0xF0000, + 0xFFFFE, + 0x100000, + 0x10FFFE +}; + +static const UV Cased_invlist[] = { /* for EBCDIC 1047 */ + 297, /* Number of elements */ + 148565664, /* Version and data structure type */ + 1, /* 0 if the list starts at 0; + 1 if it starts at the element beyond 0 */ + 0x0, + 0x42, + 0x4A, + 0x51, + 0x5A, + 0x62, + 0x6A, + 0x70, + 0x79, + 0x80, + 0x8A, + 0x8C, + 0x8F, + 0x91, + 0x9D, + 0x9E, + 0x9F, + 0xA0, + 0xA1, + 0xA2, + 0xAA, + 0xAC, + 0xAD, + 0xAE, + 0xAF, + 0xBA, + 0xBB, + 0xC1, + 0xCA, 0xCB, + 0xD0, + 0xD1, + 0xDA, + 0xDB, + 0xE0, + 0xE2, + 0xEA, + 0xEB, + 0xF0, + 0xFB, 0xFF, 0x100, - 0x300, + 0x1BB, + 0x1BC, + 0x1C0, + 0x1C4, + 0x294, + 0x295, + 0x2B9, + 0x2C0, + 0x2C2, + 0x2E0, + 0x2E5, + 0x345, + 0x346, 0x370, - 0x483, + 0x374, + 0x376, + 0x378, + 0x37A, + 0x37E, + 0x37F, + 0x380, + 0x386, + 0x387, + 0x388, + 0x38B, + 0x38C, + 0x38D, + 0x38E, + 0x3A2, + 0x3A3, + 0x3F6, + 0x3F7, + 0x482, 0x48A, - 0x591, - 0x5BE, - 0x5BF, - 0x5C0, - 0x5C1, - 0x5C3, - 0x5C4, - 0x5C6, - 0x5C7, - 0x5C8, - 0x600, - 0x606, - 0x610, - 0x61B, - 0x61C, - 0x61D, - 0x64B, - 0x660, - 0x670, - 0x671, - 0x6D6, - 0x6DD, - 0x6DE, - 0x6DF, - 0x6E5, - 0x6E7, - 0x6E9, - 0x6EA, - 0x6EE, - 0x70F, - 0x710, - 0x711, - 0x712, - 0x730, - 0x74B, - 0x7A6, - 0x7B1, - 0x7EB, - 0x7F4, - 0x816, - 0x81A, - 0x81B, - 0x824, - 0x825, - 0x828, - 0x829, - 0x82E, - 0x859, - 0x85C, - 0x8D4, - 0x8E2, - 0x8E3, - 0x903, - 0x904, - 0x93A, - 0x93B, - 0x93C, - 0x93D, - 0x93E, - 0x941, - 0x949, - 0x94D, - 0x94E, - 0x950, - 0x951, - 0x958, - 0x962, - 0x964, - 0x981, - 0x982, - 0x984, - 0x9BC, - 0x9BD, - 0x9BE, - 0x9BF, - 0x9C1, - 0x9C5, - 0x9C7, - 0x9C9, - 0x9CB, - 0x9CD, - 0x9CE, - 0x9D7, - 0x9D8, - 0x9E2, - 0x9E4, - 0xA01, - 0xA03, - 0xA04, - 0xA3C, - 0xA3D, - 0xA3E, - 0xA41, - 0xA43, - 0xA47, - 0xA49, - 0xA4B, - 0xA4E, - 0xA51, - 0xA52, - 0xA70, - 0xA72, - 0xA75, - 0xA76, - 0xA81, - 0xA83, - 0xA84, - 0xABC, - 0xABD, - 0xABE, - 0xAC1, - 0xAC6, - 0xAC7, - 0xAC9, - 0xACA, - 0xACB, - 0xACD, - 0xACE, - 0xAE2, - 0xAE4, - 0xB01, - 0xB02, - 0xB04, - 0xB3C, - 0xB3D, - 0xB3E, - 0xB40, - 0xB41, - 0xB45, - 0xB47, - 0xB49, - 0xB4B, - 0xB4D, - 0xB4E, - 0xB56, - 0xB58, - 0xB62, - 0xB64, - 0xB82, - 0xB83, - 0xBBE, - 0xBBF, - 0xBC0, - 0xBC1, - 0xBC3, - 0xBC6, - 0xBC9, - 0xBCA, - 0xBCD, - 0xBCE, - 0xBD7, - 0xBD8, - 0xC00, - 0xC01, - 0xC04, - 0xC3E, - 0xC41, - 0xC45, - 0xC46, - 0xC49, - 0xC4A, - 0xC4E, - 0xC55, - 0xC57, - 0xC62, - 0xC64, - 0xC81, - 0xC82, - 0xC84, - 0xCBC, - 0xCBD, - 0xCBE, - 0xCBF, - 0xCC0, - 0xCC2, - 0xCC3, - 0xCC5, - 0xCC6, - 0xCC7, - 0xCC9, - 0xCCA, - 0xCCC, - 0xCCE, - 0xCD5, - 0xCD7, - 0xCE2, - 0xCE4, - 0xD01, - 0xD02, - 0xD04, - 0xD3E, - 0xD3F, - 0xD41, - 0xD45, - 0xD46, - 0xD49, - 0xD4A, - 0xD4D, - 0xD4E, - 0xD4F, - 0xD57, - 0xD58, - 0xD62, - 0xD64, - 0xD82, - 0xD84, - 0xDCA, - 0xDCB, - 0xDCF, - 0xDD0, - 0xDD2, - 0xDD5, - 0xDD6, - 0xDD7, - 0xDD8, - 0xDDF, - 0xDE0, - 0xDF2, - 0xDF4, - 0xE31, - 0xE32, - 0xE33, - 0xE34, - 0xE3B, - 0xE47, - 0xE4F, - 0xEB1, - 0xEB2, - 0xEB3, - 0xEB4, - 0xEBA, - 0xEBB, - 0xEBD, - 0xEC8, - 0xECE, - 0xF18, - 0xF1A, - 0xF35, - 0xF36, - 0xF37, - 0xF38, - 0xF39, - 0xF3A, - 0xF3E, - 0xF40, - 0xF71, - 0xF7F, - 0xF80, - 0xF85, - 0xF86, - 0xF88, - 0xF8D, - 0xF98, - 0xF99, - 0xFBD, - 0xFC6, - 0xFC7, - 0x102D, - 0x1031, - 0x1032, - 0x1038, - 0x1039, - 0x103B, - 0x103D, - 0x103F, - 0x1056, - 0x1058, - 0x105A, - 0x105E, - 0x1061, - 0x1071, - 0x1075, - 0x1082, - 0x1083, - 0x1084, - 0x1085, - 0x1087, - 0x108D, - 0x108E, - 0x109D, - 0x109E, - 0x1100, - 0x1160, - 0x11A8, - 0x1200, - 0x135D, - 0x1360, - 0x1712, - 0x1715, - 0x1732, - 0x1735, - 0x1752, - 0x1754, - 0x1772, - 0x1774, - 0x17B4, - 0x17B6, - 0x17B7, - 0x17BE, - 0x17C6, - 0x17C7, - 0x17C9, - 0x17D4, - 0x17DD, - 0x17DE, - 0x180B, - 0x180E, - 0x180F, - 0x1885, - 0x1887, - 0x18A9, - 0x18AA, - 0x1920, - 0x1923, - 0x1927, - 0x1929, - 0x192C, - 0x1930, - 0x1932, - 0x1933, - 0x1939, - 0x193C, - 0x1A17, - 0x1A19, - 0x1A1B, - 0x1A1C, - 0x1A55, - 0x1A56, - 0x1A57, - 0x1A58, - 0x1A5F, - 0x1A60, - 0x1A61, - 0x1A62, - 0x1A63, - 0x1A65, - 0x1A6D, - 0x1A73, - 0x1A7D, - 0x1A7F, - 0x1A80, - 0x1AB0, - 0x1ABF, - 0x1B00, - 0x1B04, - 0x1B05, - 0x1B34, - 0x1B35, - 0x1B36, - 0x1B3B, - 0x1B3C, - 0x1B3D, - 0x1B42, - 0x1B43, - 0x1B45, - 0x1B6B, - 0x1B74, - 0x1B80, - 0x1B82, - 0x1B83, - 0x1BA1, - 0x1BA2, - 0x1BA6, - 0x1BA8, - 0x1BAA, - 0x1BAB, - 0x1BAE, - 0x1BE6, - 0x1BE7, - 0x1BE8, - 0x1BEA, - 0x1BED, - 0x1BEE, - 0x1BEF, - 0x1BF2, - 0x1BF4, - 0x1C24, - 0x1C2C, - 0x1C34, - 0x1C36, - 0x1C38, - 0x1CD0, - 0x1CD3, - 0x1CD4, - 0x1CE1, - 0x1CE2, - 0x1CE9, - 0x1CED, - 0x1CEE, - 0x1CF2, - 0x1CF4, - 0x1CF5, - 0x1CF8, - 0x1CFA, + 0x530, + 0x531, + 0x557, + 0x561, + 0x588, + 0x10A0, + 0x10C6, + 0x10C7, + 0x10C8, + 0x10CD, + 0x10CE, + 0x13A0, + 0x13F6, + 0x13F8, + 0x13FE, + 0x1C80, + 0x1C89, + 0x1D00, 0x1DC0, - 0x1DF6, - 0x1DFB, 0x1E00, - 0x200B, - 0x200C, - 0x200D, - 0x200E, - 0x2010, - 0x2028, - 0x202F, - 0x2060, - 0x2070, - 0x20D0, - 0x20F1, - 0x261D, - 0x261E, - 0x26F9, - 0x26FA, - 0x270A, - 0x270E, - 0x2764, - 0x2765, + 0x1F16, + 0x1F18, + 0x1F1E, + 0x1F20, + 0x1F46, + 0x1F48, + 0x1F4E, + 0x1F50, + 0x1F58, + 0x1F59, + 0x1F5A, + 0x1F5B, + 0x1F5C, + 0x1F5D, + 0x1F5E, + 0x1F5F, + 0x1F7E, + 0x1F80, + 0x1FB5, + 0x1FB6, + 0x1FBD, + 0x1FBE, + 0x1FBF, + 0x1FC2, + 0x1FC5, + 0x1FC6, + 0x1FCD, + 0x1FD0, + 0x1FD4, + 0x1FD6, + 0x1FDC, + 0x1FE0, + 0x1FED, + 0x1FF2, + 0x1FF5, + 0x1FF6, + 0x1FFD, + 0x2071, + 0x2072, + 0x207F, + 0x2080, + 0x2090, + 0x209D, + 0x2102, + 0x2103, + 0x2107, + 0x2108, + 0x210A, + 0x2114, + 0x2115, + 0x2116, + 0x2119, + 0x211E, + 0x2124, + 0x2125, + 0x2126, + 0x2127, + 0x2128, + 0x2129, + 0x212A, + 0x212E, + 0x212F, + 0x2135, + 0x2139, + 0x213A, + 0x213C, + 0x2140, + 0x2145, + 0x214A, + 0x214E, + 0x214F, + 0x2160, + 0x2180, + 0x2183, + 0x2185, + 0x24B6, + 0x24EA, + 0x2C00, + 0x2C2F, + 0x2C30, + 0x2C5F, + 0x2C60, + 0x2CE5, + 0x2CEB, 0x2CEF, 0x2CF2, - 0x2D7F, - 0x2D80, - 0x2DE0, - 0x2E00, - 0x302A, - 0x3030, - 0x3099, - 0x309B, - 0xA66F, - 0xA673, - 0xA674, - 0xA67E, + 0x2CF4, + 0x2D00, + 0x2D26, + 0x2D27, + 0x2D28, + 0x2D2D, + 0x2D2E, + 0xA640, + 0xA66E, + 0xA680, 0xA69E, - 0xA6A0, - 0xA6F0, - 0xA6F2, - 0xA802, - 0xA803, - 0xA806, - 0xA807, - 0xA80B, - 0xA80C, - 0xA823, - 0xA825, - 0xA827, - 0xA828, - 0xA880, - 0xA882, - 0xA8B4, - 0xA8C4, - 0xA8C6, - 0xA8E0, - 0xA8F2, - 0xA926, - 0xA92E, - 0xA947, - 0xA952, - 0xA954, - 0xA960, - 0xA97D, - 0xA980, - 0xA983, - 0xA984, - 0xA9B3, - 0xA9B4, - 0xA9B6, - 0xA9BA, - 0xA9BC, - 0xA9BD, - 0xA9C1, - 0xA9E5, - 0xA9E6, - 0xAA29, - 0xAA2F, - 0xAA31, - 0xAA33, - 0xAA35, - 0xAA37, - 0xAA43, - 0xAA44, - 0xAA4C, - 0xAA4D, - 0xAA4E, - 0xAA7C, - 0xAA7D, - 0xAAB0, - 0xAAB1, - 0xAAB2, - 0xAAB5, - 0xAAB7, - 0xAAB9, - 0xAABE, - 0xAAC0, - 0xAAC1, - 0xAAC2, - 0xAAEB, - 0xAAEC, - 0xAAEE, - 0xAAF0, - 0xAAF5, - 0xAAF6, - 0xAAF7, - 0xABE3, - 0xABE5, - 0xABE6, - 0xABE8, - 0xABE9, - 0xABEB, - 0xABEC, - 0xABED, - 0xABEE, - 0xAC00, - 0xAC01, - 0xAC1C, - 0xAC1D, - 0xAC38, - 0xAC39, - 0xAC54, - 0xAC55, - 0xAC70, - 0xAC71, - 0xAC8C, - 0xAC8D, - 0xACA8, - 0xACA9, - 0xACC4, - 0xACC5, - 0xACE0, - 0xACE1, - 0xACFC, - 0xACFD, + 0xA722, + 0xA788, + 0xA78B, + 0xA78F, + 0xA790, + 0xA7AF, + 0xA7B0, + 0xA7B8, + 0xA7F8, + 0xA7FB, + 0xAB30, + 0xAB5B, + 0xAB5C, + 0xAB66, + 0xAB70, + 0xABC0, + 0xFB00, + 0xFB07, + 0xFB13, + 0xFB18, + 0xFF21, + 0xFF3B, + 0xFF41, + 0xFF5B, + 0x10400, + 0x10450, + 0x104B0, + 0x104D4, + 0x104D8, + 0x104FC, + 0x10C80, + 0x10CB3, + 0x10CC0, + 0x10CF3, + 0x118A0, + 0x118E0, + 0x1D400, + 0x1D455, + 0x1D456, + 0x1D49D, + 0x1D49E, + 0x1D4A0, + 0x1D4A2, + 0x1D4A3, + 0x1D4A5, + 0x1D4A7, + 0x1D4A9, + 0x1D4AD, + 0x1D4AE, + 0x1D4BA, + 0x1D4BB, + 0x1D4BC, + 0x1D4BD, + 0x1D4C4, + 0x1D4C5, + 0x1D506, + 0x1D507, + 0x1D50B, + 0x1D50D, + 0x1D515, + 0x1D516, + 0x1D51D, + 0x1D51E, + 0x1D53A, + 0x1D53B, + 0x1D53F, + 0x1D540, + 0x1D545, + 0x1D546, + 0x1D547, + 0x1D54A, + 0x1D551, + 0x1D552, + 0x1D6A6, + 0x1D6A8, + 0x1D6C1, + 0x1D6C2, + 0x1D6DB, + 0x1D6DC, + 0x1D6FB, + 0x1D6FC, + 0x1D715, + 0x1D716, + 0x1D735, + 0x1D736, + 0x1D74F, + 0x1D750, + 0x1D76F, + 0x1D770, + 0x1D789, + 0x1D78A, + 0x1D7A9, + 0x1D7AA, + 0x1D7C3, + 0x1D7C4, + 0x1D7CC, + 0x1E900, + 0x1E944, + 0x1F130, + 0x1F14A, + 0x1F150, + 0x1F16A, + 0x1F170, + 0x1F18A +}; + +#endif /* defined(PERL_IN_PERL_C) */ + +#if defined(PERL_IN_REGCOMP_C) + +static const UV NonL1_Perl_Non_Final_Folds_invlist[] = { /* for EBCDIC 1047 */ + 45, /* Number of elements */ + 148565664, /* Version and data structure type */ + 1, /* 0 if the list starts at 0; + 1 if it starts at the element beyond 0 */ + 0x0, + 0x2BC, + 0x2BD, + 0x308, + 0x309, + 0x313, + 0x314, + 0x342, + 0x343, + 0x3AC, + 0x3AD, + 0x3AE, + 0x3AF, + 0x3B1, + 0x3B2, + 0x3B7, + 0x3B8, + 0x3B9, + 0x3BA, + 0x3C1, + 0x3C2, + 0x3C5, + 0x3C6, + 0x3C9, + 0x3CA, + 0x3CE, + 0x3CF, + 0x565, + 0x566, + 0x574, + 0x575, + 0x57E, + 0x57F, + 0x1F00, + 0x1F08, + 0x1F20, + 0x1F28, + 0x1F60, + 0x1F68, + 0x1F70, + 0x1F71, + 0x1F74, + 0x1F75, + 0x1F7C, + 0x1F7D +}; + +static const UV _Perl_Any_Folds_invlist[] = { /* for EBCDIC 1047 */ + 285, /* Number of elements */ + 148565664, /* Version and data structure type */ + 1, /* 0 if the list starts at 0; + 1 if it starts at the element beyond 0 */ + 0x0, + 0x42, + 0x4A, + 0x51, + 0x5A, + 0x62, + 0x6A, + 0x70, + 0x79, + 0x80, + 0x8A, + 0x8C, + 0x8F, + 0x91, + 0x9A, + 0x9C, + 0x9D, + 0x9E, + 0x9F, + 0xA0, + 0xA1, + 0xA2, + 0xAA, + 0xAC, + 0xAD, + 0xAE, + 0xAF, + 0xBA, + 0xBB, + 0xC1, + 0xCA, + 0xCB, + 0xD0, + 0xD1, + 0xDA, + 0xDB, + 0xE0, + 0xE2, + 0xEA, + 0xEB, + 0xF0, + 0xFB, + 0xFF, + 0x100, + 0x131, + 0x132, + 0x138, + 0x139, + 0x18D, + 0x18E, + 0x19B, + 0x19C, + 0x1AA, + 0x1AC, + 0x1BA, + 0x1BC, + 0x1BE, + 0x1BF, + 0x1C0, + 0x1C4, + 0x221, + 0x222, + 0x234, + 0x23A, + 0x255, + 0x256, + 0x258, + 0x259, + 0x25A, + 0x25B, + 0x25D, + 0x260, + 0x262, + 0x263, + 0x264, + 0x265, + 0x267, + 0x268, + 0x26D, + 0x26F, + 0x270, + 0x271, + 0x273, + 0x275, + 0x276, + 0x27D, + 0x27E, + 0x280, + 0x281, + 0x283, + 0x284, + 0x287, + 0x28D, + 0x292, + 0x293, + 0x29D, + 0x29F, + 0x2BC, + 0x2BD, + 0x2BE, + 0x2BF, + 0x300, + 0x302, + 0x307, + 0x309, + 0x30A, + 0x30B, + 0x30C, + 0x30D, + 0x313, + 0x314, + 0x331, + 0x332, + 0x342, + 0x343, + 0x345, + 0x346, + 0x370, + 0x374, + 0x376, + 0x378, + 0x37B, + 0x37E, + 0x37F, + 0x380, + 0x386, + 0x387, + 0x388, + 0x38B, + 0x38C, + 0x38D, + 0x38E, + 0x3A2, + 0x3A3, + 0x3D2, + 0x3D5, + 0x3F6, + 0x3F7, + 0x3FC, + 0x3FD, + 0x482, + 0x48A, + 0x530, + 0x531, + 0x557, + 0x561, + 0x588, + 0x10A0, + 0x10C6, + 0x10C7, + 0x10C8, + 0x10CD, + 0x10CE, + 0x13A0, + 0x13F6, + 0x13F8, + 0x13FE, + 0x1C80, + 0x1C89, + 0x1D79, + 0x1D7A, + 0x1D7D, + 0x1D7E, + 0x1E00, + 0x1E9C, + 0x1E9E, + 0x1E9F, + 0x1EA0, + 0x1F16, + 0x1F18, + 0x1F1E, + 0x1F20, + 0x1F46, + 0x1F48, + 0x1F4E, + 0x1F50, + 0x1F58, + 0x1F59, + 0x1F5A, + 0x1F5B, + 0x1F5C, + 0x1F5D, + 0x1F5E, + 0x1F5F, + 0x1F7E, + 0x1F80, + 0x1FB5, + 0x1FB6, + 0x1FBD, + 0x1FBE, + 0x1FBF, + 0x1FC2, + 0x1FC5, + 0x1FC6, + 0x1FCD, + 0x1FD0, + 0x1FD4, + 0x1FD6, + 0x1FDC, + 0x1FE0, + 0x1FED, + 0x1FF2, + 0x1FF5, + 0x1FF6, + 0x1FFD, + 0x2126, + 0x2127, + 0x212A, + 0x212C, + 0x2132, + 0x2133, + 0x214E, + 0x214F, + 0x2160, + 0x2180, + 0x2183, + 0x2185, + 0x24B6, + 0x24EA, + 0x2C00, + 0x2C2F, + 0x2C30, + 0x2C5F, + 0x2C60, + 0x2C71, + 0x2C72, + 0x2C74, + 0x2C75, + 0x2C77, + 0x2C7E, + 0x2CE4, + 0x2CEB, + 0x2CEF, + 0x2CF2, + 0x2CF4, + 0x2D00, + 0x2D26, + 0x2D27, + 0x2D28, + 0x2D2D, + 0x2D2E, + 0xA640, + 0xA66E, + 0xA680, + 0xA69C, + 0xA722, + 0xA730, + 0xA732, + 0xA770, + 0xA779, + 0xA788, + 0xA78B, + 0xA78E, + 0xA790, + 0xA794, + 0xA796, + 0xA7AF, + 0xA7B0, + 0xA7B8, + 0xAB53, + 0xAB54, + 0xAB70, + 0xABC0, + 0xFB00, + 0xFB07, + 0xFB13, + 0xFB18, + 0xFF21, + 0xFF3B, + 0xFF41, + 0xFF5B, + 0x10400, + 0x10450, + 0x104B0, + 0x104D4, + 0x104D8, + 0x104FC, + 0x10C80, + 0x10CB3, + 0x10CC0, + 0x10CF3, + 0x118A0, + 0x118E0, + 0x1E900, + 0x1E944 +}; + +static const UV _Perl_Folds_To_Multi_Char_invlist[] = { /* for EBCDIC 1047 */ + 59, /* Number of elements */ + 148565664, /* Version and data structure type */ + 1, /* 0 if the list starts at 0; + 1 if it starts at the element beyond 0 */ + 0x0, + 0x59, + 0x5A, + 0x130, + 0x131, + 0x149, + 0x14A, + 0x1F0, + 0x1F1, + 0x390, + 0x391, + 0x3B0, + 0x3B1, + 0x587, + 0x588, + 0x1E96, + 0x1E9B, + 0x1E9E, + 0x1E9F, + 0x1F50, + 0x1F51, + 0x1F52, + 0x1F53, + 0x1F54, + 0x1F55, + 0x1F56, + 0x1F57, + 0x1F80, + 0x1FB0, + 0x1FB2, + 0x1FB5, + 0x1FB6, + 0x1FB8, + 0x1FBC, + 0x1FBD, + 0x1FC2, + 0x1FC5, + 0x1FC6, + 0x1FC8, + 0x1FCC, + 0x1FCD, + 0x1FD2, + 0x1FD4, + 0x1FD6, + 0x1FD8, + 0x1FE2, + 0x1FE5, + 0x1FE6, + 0x1FE8, + 0x1FF2, + 0x1FF5, + 0x1FF6, + 0x1FF8, + 0x1FFC, + 0x1FFD, + 0xFB00, + 0xFB07, + 0xFB13, + 0xFB18 +}; + +#endif /* defined(PERL_IN_REGCOMP_C) */ + +#if defined(PERL_IN_PERL_C) + +static const UV _Perl_GCB_invlist[] = { /* for EBCDIC 1047 */ + 1615, /* Number of elements */ + 148565664, /* Version and data structure type */ + 0, /* 0 if the list starts at 0; + 1 if it starts at the element beyond 0 */ + 0x0, + 0xD, + 0xE, + 0x15, + 0x16, + 0x40, + 0xCA, + 0xCB, + 0xFF, + 0x100, + 0x300, + 0x370, + 0x483, + 0x48A, + 0x591, + 0x5BE, + 0x5BF, + 0x5C0, + 0x5C1, + 0x5C3, + 0x5C4, + 0x5C6, + 0x5C7, + 0x5C8, + 0x600, + 0x606, + 0x610, + 0x61B, + 0x61C, + 0x61D, + 0x64B, + 0x660, + 0x670, + 0x671, + 0x6D6, + 0x6DD, + 0x6DE, + 0x6DF, + 0x6E5, + 0x6E7, + 0x6E9, + 0x6EA, + 0x6EE, + 0x70F, + 0x710, + 0x711, + 0x712, + 0x730, + 0x74B, + 0x7A6, + 0x7B1, + 0x7EB, + 0x7F4, + 0x816, + 0x81A, + 0x81B, + 0x824, + 0x825, + 0x828, + 0x829, + 0x82E, + 0x859, + 0x85C, + 0x8D4, + 0x8E2, + 0x8E3, + 0x903, + 0x904, + 0x93A, + 0x93B, + 0x93C, + 0x93D, + 0x93E, + 0x941, + 0x949, + 0x94D, + 0x94E, + 0x950, + 0x951, + 0x958, + 0x962, + 0x964, + 0x981, + 0x982, + 0x984, + 0x9BC, + 0x9BD, + 0x9BE, + 0x9BF, + 0x9C1, + 0x9C5, + 0x9C7, + 0x9C9, + 0x9CB, + 0x9CD, + 0x9CE, + 0x9D7, + 0x9D8, + 0x9E2, + 0x9E4, + 0xA01, + 0xA03, + 0xA04, + 0xA3C, + 0xA3D, + 0xA3E, + 0xA41, + 0xA43, + 0xA47, + 0xA49, + 0xA4B, + 0xA4E, + 0xA51, + 0xA52, + 0xA70, + 0xA72, + 0xA75, + 0xA76, + 0xA81, + 0xA83, + 0xA84, + 0xABC, + 0xABD, + 0xABE, + 0xAC1, + 0xAC6, + 0xAC7, + 0xAC9, + 0xACA, + 0xACB, + 0xACD, + 0xACE, + 0xAE2, + 0xAE4, + 0xB01, + 0xB02, + 0xB04, + 0xB3C, + 0xB3D, + 0xB3E, + 0xB40, + 0xB41, + 0xB45, + 0xB47, + 0xB49, + 0xB4B, + 0xB4D, + 0xB4E, + 0xB56, + 0xB58, + 0xB62, + 0xB64, + 0xB82, + 0xB83, + 0xBBE, + 0xBBF, + 0xBC0, + 0xBC1, + 0xBC3, + 0xBC6, + 0xBC9, + 0xBCA, + 0xBCD, + 0xBCE, + 0xBD7, + 0xBD8, + 0xC00, + 0xC01, + 0xC04, + 0xC3E, + 0xC41, + 0xC45, + 0xC46, + 0xC49, + 0xC4A, + 0xC4E, + 0xC55, + 0xC57, + 0xC62, + 0xC64, + 0xC81, + 0xC82, + 0xC84, + 0xCBC, + 0xCBD, + 0xCBE, + 0xCBF, + 0xCC0, + 0xCC2, + 0xCC3, + 0xCC5, + 0xCC6, + 0xCC7, + 0xCC9, + 0xCCA, + 0xCCC, + 0xCCE, + 0xCD5, + 0xCD7, + 0xCE2, + 0xCE4, + 0xD01, + 0xD02, + 0xD04, + 0xD3E, + 0xD3F, + 0xD41, + 0xD45, + 0xD46, + 0xD49, + 0xD4A, + 0xD4D, + 0xD4E, + 0xD4F, + 0xD57, + 0xD58, + 0xD62, + 0xD64, + 0xD82, + 0xD84, + 0xDCA, + 0xDCB, + 0xDCF, + 0xDD0, + 0xDD2, + 0xDD5, + 0xDD6, + 0xDD7, + 0xDD8, + 0xDDF, + 0xDE0, + 0xDF2, + 0xDF4, + 0xE31, + 0xE32, + 0xE33, + 0xE34, + 0xE3B, + 0xE47, + 0xE4F, + 0xEB1, + 0xEB2, + 0xEB3, + 0xEB4, + 0xEBA, + 0xEBB, + 0xEBD, + 0xEC8, + 0xECE, + 0xF18, + 0xF1A, + 0xF35, + 0xF36, + 0xF37, + 0xF38, + 0xF39, + 0xF3A, + 0xF3E, + 0xF40, + 0xF71, + 0xF7F, + 0xF80, + 0xF85, + 0xF86, + 0xF88, + 0xF8D, + 0xF98, + 0xF99, + 0xFBD, + 0xFC6, + 0xFC7, + 0x102D, + 0x1031, + 0x1032, + 0x1038, + 0x1039, + 0x103B, + 0x103D, + 0x103F, + 0x1056, + 0x1058, + 0x105A, + 0x105E, + 0x1061, + 0x1071, + 0x1075, + 0x1082, + 0x1083, + 0x1084, + 0x1085, + 0x1087, + 0x108D, + 0x108E, + 0x109D, + 0x109E, + 0x1100, + 0x1160, + 0x11A8, + 0x1200, + 0x135D, + 0x1360, + 0x1712, + 0x1715, + 0x1732, + 0x1735, + 0x1752, + 0x1754, + 0x1772, + 0x1774, + 0x17B4, + 0x17B6, + 0x17B7, + 0x17BE, + 0x17C6, + 0x17C7, + 0x17C9, + 0x17D4, + 0x17DD, + 0x17DE, + 0x180B, + 0x180E, + 0x180F, + 0x1885, + 0x1887, + 0x18A9, + 0x18AA, + 0x1920, + 0x1923, + 0x1927, + 0x1929, + 0x192C, + 0x1930, + 0x1932, + 0x1933, + 0x1939, + 0x193C, + 0x1A17, + 0x1A19, + 0x1A1B, + 0x1A1C, + 0x1A55, + 0x1A56, + 0x1A57, + 0x1A58, + 0x1A5F, + 0x1A60, + 0x1A61, + 0x1A62, + 0x1A63, + 0x1A65, + 0x1A6D, + 0x1A73, + 0x1A7D, + 0x1A7F, + 0x1A80, + 0x1AB0, + 0x1ABF, + 0x1B00, + 0x1B04, + 0x1B05, + 0x1B34, + 0x1B35, + 0x1B36, + 0x1B3B, + 0x1B3C, + 0x1B3D, + 0x1B42, + 0x1B43, + 0x1B45, + 0x1B6B, + 0x1B74, + 0x1B80, + 0x1B82, + 0x1B83, + 0x1BA1, + 0x1BA2, + 0x1BA6, + 0x1BA8, + 0x1BAA, + 0x1BAB, + 0x1BAE, + 0x1BE6, + 0x1BE7, + 0x1BE8, + 0x1BEA, + 0x1BED, + 0x1BEE, + 0x1BEF, + 0x1BF2, + 0x1BF4, + 0x1C24, + 0x1C2C, + 0x1C34, + 0x1C36, + 0x1C38, + 0x1CD0, + 0x1CD3, + 0x1CD4, + 0x1CE1, + 0x1CE2, + 0x1CE9, + 0x1CED, + 0x1CEE, + 0x1CF2, + 0x1CF4, + 0x1CF5, + 0x1CF8, + 0x1CFA, + 0x1DC0, + 0x1DF6, + 0x1DFB, + 0x1E00, + 0x200B, + 0x200C, + 0x200D, + 0x200E, + 0x2010, + 0x2028, + 0x202F, + 0x2060, + 0x2070, + 0x20D0, + 0x20F1, + 0x261D, + 0x261E, + 0x26F9, + 0x26FA, + 0x270A, + 0x270E, + 0x2764, + 0x2765, + 0x2CEF, + 0x2CF2, + 0x2D7F, + 0x2D80, + 0x2DE0, + 0x2E00, + 0x302A, + 0x3030, + 0x3099, + 0x309B, + 0xA66F, + 0xA673, + 0xA674, + 0xA67E, + 0xA69E, + 0xA6A0, + 0xA6F0, + 0xA6F2, + 0xA802, + 0xA803, + 0xA806, + 0xA807, + 0xA80B, + 0xA80C, + 0xA823, + 0xA825, + 0xA827, + 0xA828, + 0xA880, + 0xA882, + 0xA8B4, + 0xA8C4, + 0xA8C6, + 0xA8E0, + 0xA8F2, + 0xA926, + 0xA92E, + 0xA947, + 0xA952, + 0xA954, + 0xA960, + 0xA97D, + 0xA980, + 0xA983, + 0xA984, + 0xA9B3, + 0xA9B4, + 0xA9B6, + 0xA9BA, + 0xA9BC, + 0xA9BD, + 0xA9C1, + 0xA9E5, + 0xA9E6, + 0xAA29, + 0xAA2F, + 0xAA31, + 0xAA33, + 0xAA35, + 0xAA37, + 0xAA43, + 0xAA44, + 0xAA4C, + 0xAA4D, + 0xAA4E, + 0xAA7C, + 0xAA7D, + 0xAAB0, + 0xAAB1, + 0xAAB2, + 0xAAB5, + 0xAAB7, + 0xAAB9, + 0xAABE, + 0xAAC0, + 0xAAC1, + 0xAAC2, + 0xAAEB, + 0xAAEC, + 0xAAEE, + 0xAAF0, + 0xAAF5, + 0xAAF6, + 0xAAF7, + 0xABE3, + 0xABE5, + 0xABE6, + 0xABE8, + 0xABE9, + 0xABEB, + 0xABEC, + 0xABED, + 0xABEE, + 0xAC00, + 0xAC01, + 0xAC1C, + 0xAC1D, + 0xAC38, + 0xAC39, + 0xAC54, + 0xAC55, + 0xAC70, + 0xAC71, + 0xAC8C, + 0xAC8D, + 0xACA8, + 0xACA9, + 0xACC4, + 0xACC5, + 0xACE0, + 0xACE1, + 0xACFC, + 0xACFD, 0xAD18, 0xAD19, 0xAD34, @@ -57983,447 +60549,1483 @@ static const UV XPosixPunct_invlist[] = { /* for EBCDIC 1047 */ 0xFF1F, 0xFF21, 0xFF3B, - 0xFF3E, - 0xFF3F, - 0xFF40, - 0xFF5B, - 0xFF5C, - 0xFF5D, - 0xFF5E, - 0xFF5F, - 0xFF66, - 0x10100, - 0x10103, - 0x1039F, - 0x103A0, - 0x103D0, - 0x103D1, - 0x1056F, - 0x10570, - 0x10857, - 0x10858, - 0x1091F, - 0x10920, - 0x1093F, - 0x10940, - 0x10A50, - 0x10A59, - 0x10A7F, - 0x10A80, - 0x10AF0, - 0x10AF7, - 0x10B39, - 0x10B40, - 0x10B99, - 0x10B9D, - 0x11047, - 0x1104E, - 0x110BB, - 0x110BD, - 0x110BE, - 0x110C2, - 0x11140, - 0x11144, - 0x11174, - 0x11176, - 0x111C5, - 0x111CA, - 0x111CD, - 0x111CE, - 0x111DB, - 0x111DC, - 0x111DD, - 0x111E0, - 0x11238, - 0x1123E, - 0x112A9, - 0x112AA, - 0x1144B, - 0x11450, - 0x1145B, - 0x1145C, - 0x1145D, - 0x1145E, - 0x114C6, - 0x114C7, - 0x115C1, - 0x115D8, - 0x11641, - 0x11644, - 0x11660, - 0x1166D, - 0x1173C, - 0x1173F, - 0x11C41, - 0x11C46, - 0x11C70, - 0x11C72, - 0x12470, - 0x12475, - 0x16A6E, - 0x16A70, - 0x16AF5, - 0x16AF6, - 0x16B37, - 0x16B3C, - 0x16B44, - 0x16B45, - 0x1BC9F, - 0x1BCA0, - 0x1DA87, - 0x1DA8C, - 0x1E95E, - 0x1E960 -}; - -static const UV XPosixSpace_invlist[] = { /* for EBCDIC 1047 */ - 23, /* Number of elements */ - 148565664, /* Version and data structure type */ - 1, /* 0 if the list starts at 0; - 1 if it starts at the element beyond 0 */ - 0x0, - 0x5, - 0x6, - 0xB, - 0xE, - 0x15, - 0x16, - 0x25, - 0x26, - 0x40, - 0x42, - 0x1680, - 0x1681, - 0x2000, - 0x200B, - 0x2028, - 0x202A, - 0x202F, - 0x2030, - 0x205F, - 0x2060, - 0x3000, - 0x3001 -}; - -static const UV XPosixUpper_invlist[] = { /* for EBCDIC 1047 */ - 1283, /* Number of elements */ - 148565664, /* Version and data structure type */ - 1, /* 0 if the list starts at 0; - 1 if it starts at the element beyond 0 */ - 0x0, - 0x62, - 0x6A, - 0x71, - 0x79, - 0x80, - 0x81, - 0x9E, - 0x9F, - 0xAC, - 0xAD, - 0xAE, - 0xAF, - 0xBA, - 0xBB, - 0xC1, - 0xCA, - 0xD1, - 0xDA, - 0xE2, - 0xEA, - 0xEB, - 0xF0, - 0xFB, - 0xFF, - 0x100, - 0x101, - 0x102, - 0x103, - 0x104, - 0x105, - 0x106, - 0x107, - 0x108, - 0x109, - 0x10A, - 0x10B, - 0x10C, - 0x10D, - 0x10E, - 0x10F, - 0x110, - 0x111, - 0x112, - 0x113, - 0x114, - 0x115, - 0x116, - 0x117, - 0x118, - 0x119, - 0x11A, - 0x11B, - 0x11C, - 0x11D, - 0x11E, - 0x11F, - 0x120, - 0x121, - 0x122, - 0x123, - 0x124, - 0x125, - 0x126, - 0x127, - 0x128, - 0x129, - 0x12A, - 0x12B, - 0x12C, - 0x12D, - 0x12E, - 0x12F, - 0x130, - 0x131, - 0x132, - 0x133, - 0x134, - 0x135, - 0x136, - 0x137, - 0x139, - 0x13A, - 0x13B, - 0x13C, - 0x13D, - 0x13E, - 0x13F, - 0x140, - 0x141, - 0x142, - 0x143, - 0x144, - 0x145, - 0x146, - 0x147, - 0x148, - 0x14A, - 0x14B, - 0x14C, - 0x14D, - 0x14E, - 0x14F, - 0x150, - 0x151, - 0x152, - 0x153, - 0x154, - 0x155, - 0x156, - 0x157, - 0x158, - 0x159, - 0x15A, - 0x15B, - 0x15C, - 0x15D, - 0x15E, - 0x15F, - 0x160, - 0x161, - 0x162, - 0x163, - 0x164, - 0x165, - 0x166, - 0x167, - 0x168, - 0x169, - 0x16A, - 0x16B, - 0x16C, - 0x16D, - 0x16E, - 0x16F, - 0x170, - 0x171, - 0x172, - 0x173, - 0x174, - 0x175, - 0x176, - 0x177, - 0x178, - 0x17A, - 0x17B, - 0x17C, - 0x17D, - 0x17E, - 0x181, - 0x183, - 0x184, - 0x185, - 0x186, - 0x188, - 0x189, - 0x18C, - 0x18E, - 0x192, - 0x193, - 0x195, - 0x196, - 0x199, - 0x19C, - 0x19E, - 0x19F, - 0x1A1, - 0x1A2, - 0x1A3, - 0x1A4, - 0x1A5, - 0x1A6, - 0x1A8, - 0x1A9, - 0x1AA, - 0x1AC, - 0x1AD, - 0x1AE, - 0x1B0, - 0x1B1, - 0x1B4, - 0x1B5, - 0x1B6, - 0x1B7, - 0x1B9, - 0x1BC, - 0x1BD, - 0x1C4, - 0x1C5, - 0x1C7, - 0x1C8, - 0x1CA, - 0x1CB, - 0x1CD, - 0x1CE, - 0x1CF, - 0x1D0, - 0x1D1, - 0x1D2, - 0x1D3, - 0x1D4, - 0x1D5, - 0x1D6, - 0x1D7, - 0x1D8, - 0x1D9, - 0x1DA, - 0x1DB, - 0x1DC, - 0x1DE, - 0x1DF, - 0x1E0, - 0x1E1, - 0x1E2, - 0x1E3, - 0x1E4, - 0x1E5, - 0x1E6, - 0x1E7, - 0x1E8, - 0x1E9, - 0x1EA, - 0x1EB, - 0x1EC, - 0x1ED, - 0x1EE, - 0x1EF, - 0x1F1, - 0x1F2, - 0x1F4, - 0x1F5, - 0x1F6, - 0x1F9, - 0x1FA, - 0x1FB, - 0x1FC, - 0x1FD, - 0x1FE, - 0x1FF, - 0x200, - 0x201, - 0x202, - 0x203, - 0x204, - 0x205, - 0x206, - 0x207, - 0x208, - 0x209, - 0x20A, - 0x20B, - 0x20C, - 0x20D, - 0x20E, - 0x20F, - 0x210, - 0x211, - 0x212, - 0x213, - 0x214, - 0x215, - 0x216, - 0x217, - 0x218, - 0x219, - 0x21A, - 0x21B, - 0x21C, - 0x21D, - 0x21E, - 0x21F, - 0x220, - 0x221, - 0x222, - 0x223, - 0x224, - 0x225, - 0x226, - 0x227, - 0x228, - 0x229, - 0x22A, - 0x22B, - 0x22C, - 0x22D, - 0x22E, - 0x22F, - 0x230, - 0x231, - 0x232, - 0x233, - 0x23A, - 0x23C, - 0x23D, - 0x23F, - 0x241, - 0x242, - 0x243, - 0x247, - 0x248, - 0x249, - 0x24A, - 0x24B, - 0x24C, - 0x24D, - 0x24E, - 0x24F, - 0x370, - 0x371, - 0x372, - 0x373, + 0xFF3E, + 0xFF3F, + 0xFF40, + 0xFF5B, + 0xFF5C, + 0xFF5D, + 0xFF5E, + 0xFF5F, + 0xFF66, + 0x10100, + 0x10103, + 0x1039F, + 0x103A0, + 0x103D0, + 0x103D1, + 0x1056F, + 0x10570, + 0x10857, + 0x10858, + 0x1091F, + 0x10920, + 0x1093F, + 0x10940, + 0x10A50, + 0x10A59, + 0x10A7F, + 0x10A80, + 0x10AF0, + 0x10AF7, + 0x10B39, + 0x10B40, + 0x10B99, + 0x10B9D, + 0x11047, + 0x1104E, + 0x110BB, + 0x110BD, + 0x110BE, + 0x110C2, + 0x11140, + 0x11144, + 0x11174, + 0x11176, + 0x111C5, + 0x111CA, + 0x111CD, + 0x111CE, + 0x111DB, + 0x111DC, + 0x111DD, + 0x111E0, + 0x11238, + 0x1123E, + 0x112A9, + 0x112AA, + 0x1144B, + 0x11450, + 0x1145B, + 0x1145C, + 0x1145D, + 0x1145E, + 0x114C6, + 0x114C7, + 0x115C1, + 0x115D8, + 0x11641, + 0x11644, + 0x11660, + 0x1166D, + 0x1173C, + 0x1173F, + 0x11C41, + 0x11C46, + 0x11C70, + 0x11C72, + 0x12470, + 0x12475, + 0x16A6E, + 0x16A70, + 0x16AF5, + 0x16AF6, + 0x16B37, + 0x16B3C, + 0x16B44, + 0x16B45, + 0x1BC9F, + 0x1BCA0, + 0x1DA87, + 0x1DA8C, + 0x1E95E, + 0x1E960 +}; + +static const UV XPosixSpace_invlist[] = { /* for EBCDIC 1047 */ + 23, /* Number of elements */ + 148565664, /* Version and data structure type */ + 1, /* 0 if the list starts at 0; + 1 if it starts at the element beyond 0 */ + 0x0, + 0x5, + 0x6, + 0xB, + 0xE, + 0x15, + 0x16, + 0x25, + 0x26, + 0x40, + 0x42, + 0x1680, + 0x1681, + 0x2000, + 0x200B, + 0x2028, + 0x202A, + 0x202F, + 0x2030, + 0x205F, + 0x2060, + 0x3000, + 0x3001 +}; + +static const UV XPosixUpper_invlist[] = { /* for EBCDIC 1047 */ + 1283, /* Number of elements */ + 148565664, /* Version and data structure type */ + 1, /* 0 if the list starts at 0; + 1 if it starts at the element beyond 0 */ + 0x0, + 0x62, + 0x6A, + 0x71, + 0x79, + 0x80, + 0x81, + 0x9E, + 0x9F, + 0xAC, + 0xAD, + 0xAE, + 0xAF, + 0xBA, + 0xBB, + 0xC1, + 0xCA, + 0xD1, + 0xDA, + 0xE2, + 0xEA, + 0xEB, + 0xF0, + 0xFB, + 0xFF, + 0x100, + 0x101, + 0x102, + 0x103, + 0x104, + 0x105, + 0x106, + 0x107, + 0x108, + 0x109, + 0x10A, + 0x10B, + 0x10C, + 0x10D, + 0x10E, + 0x10F, + 0x110, + 0x111, + 0x112, + 0x113, + 0x114, + 0x115, + 0x116, + 0x117, + 0x118, + 0x119, + 0x11A, + 0x11B, + 0x11C, + 0x11D, + 0x11E, + 0x11F, + 0x120, + 0x121, + 0x122, + 0x123, + 0x124, + 0x125, + 0x126, + 0x127, + 0x128, + 0x129, + 0x12A, + 0x12B, + 0x12C, + 0x12D, + 0x12E, + 0x12F, + 0x130, + 0x131, + 0x132, + 0x133, + 0x134, + 0x135, + 0x136, + 0x137, + 0x139, + 0x13A, + 0x13B, + 0x13C, + 0x13D, + 0x13E, + 0x13F, + 0x140, + 0x141, + 0x142, + 0x143, + 0x144, + 0x145, + 0x146, + 0x147, + 0x148, + 0x14A, + 0x14B, + 0x14C, + 0x14D, + 0x14E, + 0x14F, + 0x150, + 0x151, + 0x152, + 0x153, + 0x154, + 0x155, + 0x156, + 0x157, + 0x158, + 0x159, + 0x15A, + 0x15B, + 0x15C, + 0x15D, + 0x15E, + 0x15F, + 0x160, + 0x161, + 0x162, + 0x163, + 0x164, + 0x165, + 0x166, + 0x167, + 0x168, + 0x169, + 0x16A, + 0x16B, + 0x16C, + 0x16D, + 0x16E, + 0x16F, + 0x170, + 0x171, + 0x172, + 0x173, + 0x174, + 0x175, + 0x176, + 0x177, + 0x178, + 0x17A, + 0x17B, + 0x17C, + 0x17D, + 0x17E, + 0x181, + 0x183, + 0x184, + 0x185, + 0x186, + 0x188, + 0x189, + 0x18C, + 0x18E, + 0x192, + 0x193, + 0x195, + 0x196, + 0x199, + 0x19C, + 0x19E, + 0x19F, + 0x1A1, + 0x1A2, + 0x1A3, + 0x1A4, + 0x1A5, + 0x1A6, + 0x1A8, + 0x1A9, + 0x1AA, + 0x1AC, + 0x1AD, + 0x1AE, + 0x1B0, + 0x1B1, + 0x1B4, + 0x1B5, + 0x1B6, + 0x1B7, + 0x1B9, + 0x1BC, + 0x1BD, + 0x1C4, + 0x1C5, + 0x1C7, + 0x1C8, + 0x1CA, + 0x1CB, + 0x1CD, + 0x1CE, + 0x1CF, + 0x1D0, + 0x1D1, + 0x1D2, + 0x1D3, + 0x1D4, + 0x1D5, + 0x1D6, + 0x1D7, + 0x1D8, + 0x1D9, + 0x1DA, + 0x1DB, + 0x1DC, + 0x1DE, + 0x1DF, + 0x1E0, + 0x1E1, + 0x1E2, + 0x1E3, + 0x1E4, + 0x1E5, + 0x1E6, + 0x1E7, + 0x1E8, + 0x1E9, + 0x1EA, + 0x1EB, + 0x1EC, + 0x1ED, + 0x1EE, + 0x1EF, + 0x1F1, + 0x1F2, + 0x1F4, + 0x1F5, + 0x1F6, + 0x1F9, + 0x1FA, + 0x1FB, + 0x1FC, + 0x1FD, + 0x1FE, + 0x1FF, + 0x200, + 0x201, + 0x202, + 0x203, + 0x204, + 0x205, + 0x206, + 0x207, + 0x208, + 0x209, + 0x20A, + 0x20B, + 0x20C, + 0x20D, + 0x20E, + 0x20F, + 0x210, + 0x211, + 0x212, + 0x213, + 0x214, + 0x215, + 0x216, + 0x217, + 0x218, + 0x219, + 0x21A, + 0x21B, + 0x21C, + 0x21D, + 0x21E, + 0x21F, + 0x220, + 0x221, + 0x222, + 0x223, + 0x224, + 0x225, + 0x226, + 0x227, + 0x228, + 0x229, + 0x22A, + 0x22B, + 0x22C, + 0x22D, + 0x22E, + 0x22F, + 0x230, + 0x231, + 0x232, + 0x233, + 0x23A, + 0x23C, + 0x23D, + 0x23F, + 0x241, + 0x242, + 0x243, + 0x247, + 0x248, + 0x249, + 0x24A, + 0x24B, + 0x24C, + 0x24D, + 0x24E, + 0x24F, + 0x370, + 0x371, + 0x372, + 0x373, + 0x376, + 0x377, + 0x37F, + 0x380, + 0x386, + 0x387, + 0x388, + 0x38B, + 0x38C, + 0x38D, + 0x38E, + 0x390, + 0x391, + 0x3A2, + 0x3A3, + 0x3AC, + 0x3CF, + 0x3D0, + 0x3D2, + 0x3D5, + 0x3D8, + 0x3D9, + 0x3DA, + 0x3DB, + 0x3DC, + 0x3DD, + 0x3DE, + 0x3DF, + 0x3E0, + 0x3E1, + 0x3E2, + 0x3E3, + 0x3E4, + 0x3E5, + 0x3E6, + 0x3E7, + 0x3E8, + 0x3E9, + 0x3EA, + 0x3EB, + 0x3EC, + 0x3ED, + 0x3EE, + 0x3EF, + 0x3F4, + 0x3F5, + 0x3F7, + 0x3F8, + 0x3F9, + 0x3FB, + 0x3FD, + 0x430, + 0x460, + 0x461, + 0x462, + 0x463, + 0x464, + 0x465, + 0x466, + 0x467, + 0x468, + 0x469, + 0x46A, + 0x46B, + 0x46C, + 0x46D, + 0x46E, + 0x46F, + 0x470, + 0x471, + 0x472, + 0x473, + 0x474, + 0x475, + 0x476, + 0x477, + 0x478, + 0x479, + 0x47A, + 0x47B, + 0x47C, + 0x47D, + 0x47E, + 0x47F, + 0x480, + 0x481, + 0x48A, + 0x48B, + 0x48C, + 0x48D, + 0x48E, + 0x48F, + 0x490, + 0x491, + 0x492, + 0x493, + 0x494, + 0x495, + 0x496, + 0x497, + 0x498, + 0x499, + 0x49A, + 0x49B, + 0x49C, + 0x49D, + 0x49E, + 0x49F, + 0x4A0, + 0x4A1, + 0x4A2, + 0x4A3, + 0x4A4, + 0x4A5, + 0x4A6, + 0x4A7, + 0x4A8, + 0x4A9, + 0x4AA, + 0x4AB, + 0x4AC, + 0x4AD, + 0x4AE, + 0x4AF, + 0x4B0, + 0x4B1, + 0x4B2, + 0x4B3, + 0x4B4, + 0x4B5, + 0x4B6, + 0x4B7, + 0x4B8, + 0x4B9, + 0x4BA, + 0x4BB, + 0x4BC, + 0x4BD, + 0x4BE, + 0x4BF, + 0x4C0, + 0x4C2, + 0x4C3, + 0x4C4, + 0x4C5, + 0x4C6, + 0x4C7, + 0x4C8, + 0x4C9, + 0x4CA, + 0x4CB, + 0x4CC, + 0x4CD, + 0x4CE, + 0x4D0, + 0x4D1, + 0x4D2, + 0x4D3, + 0x4D4, + 0x4D5, + 0x4D6, + 0x4D7, + 0x4D8, + 0x4D9, + 0x4DA, + 0x4DB, + 0x4DC, + 0x4DD, + 0x4DE, + 0x4DF, + 0x4E0, + 0x4E1, + 0x4E2, + 0x4E3, + 0x4E4, + 0x4E5, + 0x4E6, + 0x4E7, + 0x4E8, + 0x4E9, + 0x4EA, + 0x4EB, + 0x4EC, + 0x4ED, + 0x4EE, + 0x4EF, + 0x4F0, + 0x4F1, + 0x4F2, + 0x4F3, + 0x4F4, + 0x4F5, + 0x4F6, + 0x4F7, + 0x4F8, + 0x4F9, + 0x4FA, + 0x4FB, + 0x4FC, + 0x4FD, + 0x4FE, + 0x4FF, + 0x500, + 0x501, + 0x502, + 0x503, + 0x504, + 0x505, + 0x506, + 0x507, + 0x508, + 0x509, + 0x50A, + 0x50B, + 0x50C, + 0x50D, + 0x50E, + 0x50F, + 0x510, + 0x511, + 0x512, + 0x513, + 0x514, + 0x515, + 0x516, + 0x517, + 0x518, + 0x519, + 0x51A, + 0x51B, + 0x51C, + 0x51D, + 0x51E, + 0x51F, + 0x520, + 0x521, + 0x522, + 0x523, + 0x524, + 0x525, + 0x526, + 0x527, + 0x528, + 0x529, + 0x52A, + 0x52B, + 0x52C, + 0x52D, + 0x52E, + 0x52F, + 0x531, + 0x557, + 0x10A0, + 0x10C6, + 0x10C7, + 0x10C8, + 0x10CD, + 0x10CE, + 0x13A0, + 0x13F6, + 0x1E00, + 0x1E01, + 0x1E02, + 0x1E03, + 0x1E04, + 0x1E05, + 0x1E06, + 0x1E07, + 0x1E08, + 0x1E09, + 0x1E0A, + 0x1E0B, + 0x1E0C, + 0x1E0D, + 0x1E0E, + 0x1E0F, + 0x1E10, + 0x1E11, + 0x1E12, + 0x1E13, + 0x1E14, + 0x1E15, + 0x1E16, + 0x1E17, + 0x1E18, + 0x1E19, + 0x1E1A, + 0x1E1B, + 0x1E1C, + 0x1E1D, + 0x1E1E, + 0x1E1F, + 0x1E20, + 0x1E21, + 0x1E22, + 0x1E23, + 0x1E24, + 0x1E25, + 0x1E26, + 0x1E27, + 0x1E28, + 0x1E29, + 0x1E2A, + 0x1E2B, + 0x1E2C, + 0x1E2D, + 0x1E2E, + 0x1E2F, + 0x1E30, + 0x1E31, + 0x1E32, + 0x1E33, + 0x1E34, + 0x1E35, + 0x1E36, + 0x1E37, + 0x1E38, + 0x1E39, + 0x1E3A, + 0x1E3B, + 0x1E3C, + 0x1E3D, + 0x1E3E, + 0x1E3F, + 0x1E40, + 0x1E41, + 0x1E42, + 0x1E43, + 0x1E44, + 0x1E45, + 0x1E46, + 0x1E47, + 0x1E48, + 0x1E49, + 0x1E4A, + 0x1E4B, + 0x1E4C, + 0x1E4D, + 0x1E4E, + 0x1E4F, + 0x1E50, + 0x1E51, + 0x1E52, + 0x1E53, + 0x1E54, + 0x1E55, + 0x1E56, + 0x1E57, + 0x1E58, + 0x1E59, + 0x1E5A, + 0x1E5B, + 0x1E5C, + 0x1E5D, + 0x1E5E, + 0x1E5F, + 0x1E60, + 0x1E61, + 0x1E62, + 0x1E63, + 0x1E64, + 0x1E65, + 0x1E66, + 0x1E67, + 0x1E68, + 0x1E69, + 0x1E6A, + 0x1E6B, + 0x1E6C, + 0x1E6D, + 0x1E6E, + 0x1E6F, + 0x1E70, + 0x1E71, + 0x1E72, + 0x1E73, + 0x1E74, + 0x1E75, + 0x1E76, + 0x1E77, + 0x1E78, + 0x1E79, + 0x1E7A, + 0x1E7B, + 0x1E7C, + 0x1E7D, + 0x1E7E, + 0x1E7F, + 0x1E80, + 0x1E81, + 0x1E82, + 0x1E83, + 0x1E84, + 0x1E85, + 0x1E86, + 0x1E87, + 0x1E88, + 0x1E89, + 0x1E8A, + 0x1E8B, + 0x1E8C, + 0x1E8D, + 0x1E8E, + 0x1E8F, + 0x1E90, + 0x1E91, + 0x1E92, + 0x1E93, + 0x1E94, + 0x1E95, + 0x1E9E, + 0x1E9F, + 0x1EA0, + 0x1EA1, + 0x1EA2, + 0x1EA3, + 0x1EA4, + 0x1EA5, + 0x1EA6, + 0x1EA7, + 0x1EA8, + 0x1EA9, + 0x1EAA, + 0x1EAB, + 0x1EAC, + 0x1EAD, + 0x1EAE, + 0x1EAF, + 0x1EB0, + 0x1EB1, + 0x1EB2, + 0x1EB3, + 0x1EB4, + 0x1EB5, + 0x1EB6, + 0x1EB7, + 0x1EB8, + 0x1EB9, + 0x1EBA, + 0x1EBB, + 0x1EBC, + 0x1EBD, + 0x1EBE, + 0x1EBF, + 0x1EC0, + 0x1EC1, + 0x1EC2, + 0x1EC3, + 0x1EC4, + 0x1EC5, + 0x1EC6, + 0x1EC7, + 0x1EC8, + 0x1EC9, + 0x1ECA, + 0x1ECB, + 0x1ECC, + 0x1ECD, + 0x1ECE, + 0x1ECF, + 0x1ED0, + 0x1ED1, + 0x1ED2, + 0x1ED3, + 0x1ED4, + 0x1ED5, + 0x1ED6, + 0x1ED7, + 0x1ED8, + 0x1ED9, + 0x1EDA, + 0x1EDB, + 0x1EDC, + 0x1EDD, + 0x1EDE, + 0x1EDF, + 0x1EE0, + 0x1EE1, + 0x1EE2, + 0x1EE3, + 0x1EE4, + 0x1EE5, + 0x1EE6, + 0x1EE7, + 0x1EE8, + 0x1EE9, + 0x1EEA, + 0x1EEB, + 0x1EEC, + 0x1EED, + 0x1EEE, + 0x1EEF, + 0x1EF0, + 0x1EF1, + 0x1EF2, + 0x1EF3, + 0x1EF4, + 0x1EF5, + 0x1EF6, + 0x1EF7, + 0x1EF8, + 0x1EF9, + 0x1EFA, + 0x1EFB, + 0x1EFC, + 0x1EFD, + 0x1EFE, + 0x1EFF, + 0x1F08, + 0x1F10, + 0x1F18, + 0x1F1E, + 0x1F28, + 0x1F30, + 0x1F38, + 0x1F40, + 0x1F48, + 0x1F4E, + 0x1F59, + 0x1F5A, + 0x1F5B, + 0x1F5C, + 0x1F5D, + 0x1F5E, + 0x1F5F, + 0x1F60, + 0x1F68, + 0x1F70, + 0x1FB8, + 0x1FBC, + 0x1FC8, + 0x1FCC, + 0x1FD8, + 0x1FDC, + 0x1FE8, + 0x1FED, + 0x1FF8, + 0x1FFC, + 0x2102, + 0x2103, + 0x2107, + 0x2108, + 0x210B, + 0x210E, + 0x2110, + 0x2113, + 0x2115, + 0x2116, + 0x2119, + 0x211E, + 0x2124, + 0x2125, + 0x2126, + 0x2127, + 0x2128, + 0x2129, + 0x212A, + 0x212E, + 0x2130, + 0x2134, + 0x213E, + 0x2140, + 0x2145, + 0x2146, + 0x2160, + 0x2170, + 0x2183, + 0x2184, + 0x24B6, + 0x24D0, + 0x2C00, + 0x2C2F, + 0x2C60, + 0x2C61, + 0x2C62, + 0x2C65, + 0x2C67, + 0x2C68, + 0x2C69, + 0x2C6A, + 0x2C6B, + 0x2C6C, + 0x2C6D, + 0x2C71, + 0x2C72, + 0x2C73, + 0x2C75, + 0x2C76, + 0x2C7E, + 0x2C81, + 0x2C82, + 0x2C83, + 0x2C84, + 0x2C85, + 0x2C86, + 0x2C87, + 0x2C88, + 0x2C89, + 0x2C8A, + 0x2C8B, + 0x2C8C, + 0x2C8D, + 0x2C8E, + 0x2C8F, + 0x2C90, + 0x2C91, + 0x2C92, + 0x2C93, + 0x2C94, + 0x2C95, + 0x2C96, + 0x2C97, + 0x2C98, + 0x2C99, + 0x2C9A, + 0x2C9B, + 0x2C9C, + 0x2C9D, + 0x2C9E, + 0x2C9F, + 0x2CA0, + 0x2CA1, + 0x2CA2, + 0x2CA3, + 0x2CA4, + 0x2CA5, + 0x2CA6, + 0x2CA7, + 0x2CA8, + 0x2CA9, + 0x2CAA, + 0x2CAB, + 0x2CAC, + 0x2CAD, + 0x2CAE, + 0x2CAF, + 0x2CB0, + 0x2CB1, + 0x2CB2, + 0x2CB3, + 0x2CB4, + 0x2CB5, + 0x2CB6, + 0x2CB7, + 0x2CB8, + 0x2CB9, + 0x2CBA, + 0x2CBB, + 0x2CBC, + 0x2CBD, + 0x2CBE, + 0x2CBF, + 0x2CC0, + 0x2CC1, + 0x2CC2, + 0x2CC3, + 0x2CC4, + 0x2CC5, + 0x2CC6, + 0x2CC7, + 0x2CC8, + 0x2CC9, + 0x2CCA, + 0x2CCB, + 0x2CCC, + 0x2CCD, + 0x2CCE, + 0x2CCF, + 0x2CD0, + 0x2CD1, + 0x2CD2, + 0x2CD3, + 0x2CD4, + 0x2CD5, + 0x2CD6, + 0x2CD7, + 0x2CD8, + 0x2CD9, + 0x2CDA, + 0x2CDB, + 0x2CDC, + 0x2CDD, + 0x2CDE, + 0x2CDF, + 0x2CE0, + 0x2CE1, + 0x2CE2, + 0x2CE3, + 0x2CEB, + 0x2CEC, + 0x2CED, + 0x2CEE, + 0x2CF2, + 0x2CF3, + 0xA640, + 0xA641, + 0xA642, + 0xA643, + 0xA644, + 0xA645, + 0xA646, + 0xA647, + 0xA648, + 0xA649, + 0xA64A, + 0xA64B, + 0xA64C, + 0xA64D, + 0xA64E, + 0xA64F, + 0xA650, + 0xA651, + 0xA652, + 0xA653, + 0xA654, + 0xA655, + 0xA656, + 0xA657, + 0xA658, + 0xA659, + 0xA65A, + 0xA65B, + 0xA65C, + 0xA65D, + 0xA65E, + 0xA65F, + 0xA660, + 0xA661, + 0xA662, + 0xA663, + 0xA664, + 0xA665, + 0xA666, + 0xA667, + 0xA668, + 0xA669, + 0xA66A, + 0xA66B, + 0xA66C, + 0xA66D, + 0xA680, + 0xA681, + 0xA682, + 0xA683, + 0xA684, + 0xA685, + 0xA686, + 0xA687, + 0xA688, + 0xA689, + 0xA68A, + 0xA68B, + 0xA68C, + 0xA68D, + 0xA68E, + 0xA68F, + 0xA690, + 0xA691, + 0xA692, + 0xA693, + 0xA694, + 0xA695, + 0xA696, + 0xA697, + 0xA698, + 0xA699, + 0xA69A, + 0xA69B, + 0xA722, + 0xA723, + 0xA724, + 0xA725, + 0xA726, + 0xA727, + 0xA728, + 0xA729, + 0xA72A, + 0xA72B, + 0xA72C, + 0xA72D, + 0xA72E, + 0xA72F, + 0xA732, + 0xA733, + 0xA734, + 0xA735, + 0xA736, + 0xA737, + 0xA738, + 0xA739, + 0xA73A, + 0xA73B, + 0xA73C, + 0xA73D, + 0xA73E, + 0xA73F, + 0xA740, + 0xA741, + 0xA742, + 0xA743, + 0xA744, + 0xA745, + 0xA746, + 0xA747, + 0xA748, + 0xA749, + 0xA74A, + 0xA74B, + 0xA74C, + 0xA74D, + 0xA74E, + 0xA74F, + 0xA750, + 0xA751, + 0xA752, + 0xA753, + 0xA754, + 0xA755, + 0xA756, + 0xA757, + 0xA758, + 0xA759, + 0xA75A, + 0xA75B, + 0xA75C, + 0xA75D, + 0xA75E, + 0xA75F, + 0xA760, + 0xA761, + 0xA762, + 0xA763, + 0xA764, + 0xA765, + 0xA766, + 0xA767, + 0xA768, + 0xA769, + 0xA76A, + 0xA76B, + 0xA76C, + 0xA76D, + 0xA76E, + 0xA76F, + 0xA779, + 0xA77A, + 0xA77B, + 0xA77C, + 0xA77D, + 0xA77F, + 0xA780, + 0xA781, + 0xA782, + 0xA783, + 0xA784, + 0xA785, + 0xA786, + 0xA787, + 0xA78B, + 0xA78C, + 0xA78D, + 0xA78E, + 0xA790, + 0xA791, + 0xA792, + 0xA793, + 0xA796, + 0xA797, + 0xA798, + 0xA799, + 0xA79A, + 0xA79B, + 0xA79C, + 0xA79D, + 0xA79E, + 0xA79F, + 0xA7A0, + 0xA7A1, + 0xA7A2, + 0xA7A3, + 0xA7A4, + 0xA7A5, + 0xA7A6, + 0xA7A7, + 0xA7A8, + 0xA7A9, + 0xA7AA, + 0xA7AF, + 0xA7B0, + 0xA7B5, + 0xA7B6, + 0xA7B7, + 0xFF21, + 0xFF3B, + 0x10400, + 0x10428, + 0x104B0, + 0x104D4, + 0x10C80, + 0x10CB3, + 0x118A0, + 0x118C0, + 0x1D400, + 0x1D41A, + 0x1D434, + 0x1D44E, + 0x1D468, + 0x1D482, + 0x1D49C, + 0x1D49D, + 0x1D49E, + 0x1D4A0, + 0x1D4A2, + 0x1D4A3, + 0x1D4A5, + 0x1D4A7, + 0x1D4A9, + 0x1D4AD, + 0x1D4AE, + 0x1D4B6, + 0x1D4D0, + 0x1D4EA, + 0x1D504, + 0x1D506, + 0x1D507, + 0x1D50B, + 0x1D50D, + 0x1D515, + 0x1D516, + 0x1D51D, + 0x1D538, + 0x1D53A, + 0x1D53B, + 0x1D53F, + 0x1D540, + 0x1D545, + 0x1D546, + 0x1D547, + 0x1D54A, + 0x1D551, + 0x1D56C, + 0x1D586, + 0x1D5A0, + 0x1D5BA, + 0x1D5D4, + 0x1D5EE, + 0x1D608, + 0x1D622, + 0x1D63C, + 0x1D656, + 0x1D670, + 0x1D68A, + 0x1D6A8, + 0x1D6C1, + 0x1D6E2, + 0x1D6FB, + 0x1D71C, + 0x1D735, + 0x1D756, + 0x1D76F, + 0x1D790, + 0x1D7A9, + 0x1D7CA, + 0x1D7CB, + 0x1E900, + 0x1E922, + 0x1F130, + 0x1F14A, + 0x1F150, + 0x1F16A, + 0x1F170, + 0x1F18A +}; + +static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ + 1385, /* Number of elements */ + 148565664, /* Version and data structure type */ + 1, /* 0 if the list starts at 0; + 1 if it starts at the element beyond 0 */ + 0x0, + 0x42, + 0x4A, + 0x51, + 0x5A, + 0x62, + 0x6A, + 0x6D, + 0x6E, + 0x70, + 0x79, + 0x80, + 0x8A, + 0x8C, + 0x8F, + 0x91, + 0x9D, + 0x9E, + 0x9F, + 0xA0, + 0xA1, + 0xA2, + 0xAA, + 0xAC, + 0xAD, + 0xAE, + 0xAF, + 0xBA, + 0xBB, + 0xC1, + 0xCA, + 0xCB, + 0xD0, + 0xD1, + 0xDA, + 0xDB, + 0xE0, + 0xE2, + 0xEA, + 0xEB, + 0xFA, + 0xFB, + 0xFF, + 0x100, + 0x2C2, + 0x2C6, + 0x2D2, + 0x2E0, + 0x2E5, + 0x2EC, + 0x2ED, + 0x2EE, + 0x2EF, + 0x300, + 0x375, 0x376, - 0x377, + 0x378, + 0x37A, + 0x37E, 0x37F, 0x380, 0x386, @@ -58433,513 +62035,541 @@ static const UV XPosixUpper_invlist[] = { /* for EBCDIC 1047 */ 0x38C, 0x38D, 0x38E, - 0x390, - 0x391, 0x3A2, 0x3A3, - 0x3AC, - 0x3CF, - 0x3D0, - 0x3D2, - 0x3D5, - 0x3D8, - 0x3D9, - 0x3DA, - 0x3DB, - 0x3DC, - 0x3DD, - 0x3DE, - 0x3DF, - 0x3E0, - 0x3E1, - 0x3E2, - 0x3E3, - 0x3E4, - 0x3E5, - 0x3E6, - 0x3E7, - 0x3E8, - 0x3E9, - 0x3EA, - 0x3EB, - 0x3EC, - 0x3ED, - 0x3EE, - 0x3EF, - 0x3F4, - 0x3F5, + 0x3F6, 0x3F7, - 0x3F8, - 0x3F9, - 0x3FB, - 0x3FD, - 0x430, - 0x460, - 0x461, - 0x462, - 0x463, - 0x464, - 0x465, - 0x466, - 0x467, - 0x468, - 0x469, - 0x46A, - 0x46B, - 0x46C, - 0x46D, - 0x46E, - 0x46F, - 0x470, - 0x471, - 0x472, - 0x473, - 0x474, - 0x475, - 0x476, - 0x477, - 0x478, - 0x479, - 0x47A, - 0x47B, - 0x47C, - 0x47D, - 0x47E, - 0x47F, - 0x480, - 0x481, - 0x48A, - 0x48B, - 0x48C, - 0x48D, - 0x48E, - 0x48F, - 0x490, - 0x491, - 0x492, - 0x493, - 0x494, - 0x495, - 0x496, - 0x497, - 0x498, - 0x499, - 0x49A, - 0x49B, - 0x49C, - 0x49D, - 0x49E, - 0x49F, - 0x4A0, - 0x4A1, - 0x4A2, - 0x4A3, - 0x4A4, - 0x4A5, - 0x4A6, - 0x4A7, - 0x4A8, - 0x4A9, - 0x4AA, - 0x4AB, - 0x4AC, - 0x4AD, - 0x4AE, - 0x4AF, - 0x4B0, - 0x4B1, - 0x4B2, - 0x4B3, - 0x4B4, - 0x4B5, - 0x4B6, - 0x4B7, - 0x4B8, - 0x4B9, - 0x4BA, - 0x4BB, - 0x4BC, - 0x4BD, - 0x4BE, - 0x4BF, - 0x4C0, - 0x4C2, - 0x4C3, - 0x4C4, - 0x4C5, - 0x4C6, - 0x4C7, - 0x4C8, - 0x4C9, - 0x4CA, - 0x4CB, - 0x4CC, - 0x4CD, - 0x4CE, - 0x4D0, - 0x4D1, - 0x4D2, - 0x4D3, - 0x4D4, - 0x4D5, - 0x4D6, - 0x4D7, - 0x4D8, - 0x4D9, - 0x4DA, - 0x4DB, - 0x4DC, - 0x4DD, - 0x4DE, - 0x4DF, - 0x4E0, - 0x4E1, - 0x4E2, - 0x4E3, - 0x4E4, - 0x4E5, - 0x4E6, - 0x4E7, - 0x4E8, - 0x4E9, - 0x4EA, - 0x4EB, - 0x4EC, - 0x4ED, - 0x4EE, - 0x4EF, - 0x4F0, - 0x4F1, - 0x4F2, - 0x4F3, - 0x4F4, - 0x4F5, - 0x4F6, - 0x4F7, - 0x4F8, - 0x4F9, - 0x4FA, - 0x4FB, - 0x4FC, - 0x4FD, - 0x4FE, - 0x4FF, - 0x500, - 0x501, - 0x502, - 0x503, - 0x504, - 0x505, - 0x506, - 0x507, - 0x508, - 0x509, - 0x50A, - 0x50B, - 0x50C, - 0x50D, - 0x50E, - 0x50F, - 0x510, - 0x511, - 0x512, - 0x513, - 0x514, - 0x515, - 0x516, - 0x517, - 0x518, - 0x519, - 0x51A, - 0x51B, - 0x51C, - 0x51D, - 0x51E, - 0x51F, - 0x520, - 0x521, - 0x522, - 0x523, - 0x524, - 0x525, - 0x526, - 0x527, - 0x528, - 0x529, - 0x52A, - 0x52B, - 0x52C, - 0x52D, - 0x52E, - 0x52F, + 0x482, + 0x483, + 0x530, 0x531, 0x557, + 0x559, + 0x55A, + 0x561, + 0x588, + 0x591, + 0x5BE, + 0x5BF, + 0x5C0, + 0x5C1, + 0x5C3, + 0x5C4, + 0x5C6, + 0x5C7, + 0x5C8, + 0x5D0, + 0x5EB, + 0x5F0, + 0x5F3, + 0x610, + 0x61B, + 0x620, + 0x66A, + 0x66E, + 0x6D4, + 0x6D5, + 0x6DD, + 0x6DF, + 0x6E9, + 0x6EA, + 0x6FD, + 0x6FF, + 0x700, + 0x710, + 0x74B, + 0x74D, + 0x7B2, + 0x7C0, + 0x7F6, + 0x7FA, + 0x7FB, + 0x800, + 0x82E, + 0x840, + 0x85C, + 0x8A0, + 0x8B5, + 0x8B6, + 0x8BE, + 0x8D4, + 0x8E2, + 0x8E3, + 0x964, + 0x966, + 0x970, + 0x971, + 0x984, + 0x985, + 0x98D, + 0x98F, + 0x991, + 0x993, + 0x9A9, + 0x9AA, + 0x9B1, + 0x9B2, + 0x9B3, + 0x9B6, + 0x9BA, + 0x9BC, + 0x9C5, + 0x9C7, + 0x9C9, + 0x9CB, + 0x9CF, + 0x9D7, + 0x9D8, + 0x9DC, + 0x9DE, + 0x9DF, + 0x9E4, + 0x9E6, + 0x9F2, + 0xA01, + 0xA04, + 0xA05, + 0xA0B, + 0xA0F, + 0xA11, + 0xA13, + 0xA29, + 0xA2A, + 0xA31, + 0xA32, + 0xA34, + 0xA35, + 0xA37, + 0xA38, + 0xA3A, + 0xA3C, + 0xA3D, + 0xA3E, + 0xA43, + 0xA47, + 0xA49, + 0xA4B, + 0xA4E, + 0xA51, + 0xA52, + 0xA59, + 0xA5D, + 0xA5E, + 0xA5F, + 0xA66, + 0xA76, + 0xA81, + 0xA84, + 0xA85, + 0xA8E, + 0xA8F, + 0xA92, + 0xA93, + 0xAA9, + 0xAAA, + 0xAB1, + 0xAB2, + 0xAB4, + 0xAB5, + 0xABA, + 0xABC, + 0xAC6, + 0xAC7, + 0xACA, + 0xACB, + 0xACE, + 0xAD0, + 0xAD1, + 0xAE0, + 0xAE4, + 0xAE6, + 0xAF0, + 0xAF9, + 0xAFA, + 0xB01, + 0xB04, + 0xB05, + 0xB0D, + 0xB0F, + 0xB11, + 0xB13, + 0xB29, + 0xB2A, + 0xB31, + 0xB32, + 0xB34, + 0xB35, + 0xB3A, + 0xB3C, + 0xB45, + 0xB47, + 0xB49, + 0xB4B, + 0xB4E, + 0xB56, + 0xB58, + 0xB5C, + 0xB5E, + 0xB5F, + 0xB64, + 0xB66, + 0xB70, + 0xB71, + 0xB72, + 0xB82, + 0xB84, + 0xB85, + 0xB8B, + 0xB8E, + 0xB91, + 0xB92, + 0xB96, + 0xB99, + 0xB9B, + 0xB9C, + 0xB9D, + 0xB9E, + 0xBA0, + 0xBA3, + 0xBA5, + 0xBA8, + 0xBAB, + 0xBAE, + 0xBBA, + 0xBBE, + 0xBC3, + 0xBC6, + 0xBC9, + 0xBCA, + 0xBCE, + 0xBD0, + 0xBD1, + 0xBD7, + 0xBD8, + 0xBE6, + 0xBF0, + 0xC00, + 0xC04, + 0xC05, + 0xC0D, + 0xC0E, + 0xC11, + 0xC12, + 0xC29, + 0xC2A, + 0xC3A, + 0xC3D, + 0xC45, + 0xC46, + 0xC49, + 0xC4A, + 0xC4E, + 0xC55, + 0xC57, + 0xC58, + 0xC5B, + 0xC60, + 0xC64, + 0xC66, + 0xC70, + 0xC80, + 0xC84, + 0xC85, + 0xC8D, + 0xC8E, + 0xC91, + 0xC92, + 0xCA9, + 0xCAA, + 0xCB4, + 0xCB5, + 0xCBA, + 0xCBC, + 0xCC5, + 0xCC6, + 0xCC9, + 0xCCA, + 0xCCE, + 0xCD5, + 0xCD7, + 0xCDE, + 0xCDF, + 0xCE0, + 0xCE4, + 0xCE6, + 0xCF0, + 0xCF1, + 0xCF3, + 0xD01, + 0xD04, + 0xD05, + 0xD0D, + 0xD0E, + 0xD11, + 0xD12, + 0xD3B, + 0xD3D, + 0xD45, + 0xD46, + 0xD49, + 0xD4A, + 0xD4F, + 0xD54, + 0xD58, + 0xD5F, + 0xD64, + 0xD66, + 0xD70, + 0xD7A, + 0xD80, + 0xD82, + 0xD84, + 0xD85, + 0xD97, + 0xD9A, + 0xDB2, + 0xDB3, + 0xDBC, + 0xDBD, + 0xDBE, + 0xDC0, + 0xDC7, + 0xDCA, + 0xDCB, + 0xDCF, + 0xDD5, + 0xDD6, + 0xDD7, + 0xDD8, + 0xDE0, + 0xDE6, + 0xDF0, + 0xDF2, + 0xDF4, + 0xE01, + 0xE3B, + 0xE40, + 0xE4F, + 0xE50, + 0xE5A, + 0xE81, + 0xE83, + 0xE84, + 0xE85, + 0xE87, + 0xE89, + 0xE8A, + 0xE8B, + 0xE8D, + 0xE8E, + 0xE94, + 0xE98, + 0xE99, + 0xEA0, + 0xEA1, + 0xEA4, + 0xEA5, + 0xEA6, + 0xEA7, + 0xEA8, + 0xEAA, + 0xEAC, + 0xEAD, + 0xEBA, + 0xEBB, + 0xEBE, + 0xEC0, + 0xEC5, + 0xEC6, + 0xEC7, + 0xEC8, + 0xECE, + 0xED0, + 0xEDA, + 0xEDC, + 0xEE0, + 0xF00, + 0xF01, + 0xF18, + 0xF1A, + 0xF20, + 0xF2A, + 0xF35, + 0xF36, + 0xF37, + 0xF38, + 0xF39, + 0xF3A, + 0xF3E, + 0xF48, + 0xF49, + 0xF6D, + 0xF71, + 0xF85, + 0xF86, + 0xF98, + 0xF99, + 0xFBD, + 0xFC6, + 0xFC7, + 0x1000, + 0x104A, + 0x1050, + 0x109E, 0x10A0, 0x10C6, 0x10C7, 0x10C8, 0x10CD, 0x10CE, - 0x13A0, - 0x13F6, - 0x1E00, - 0x1E01, - 0x1E02, - 0x1E03, - 0x1E04, - 0x1E05, - 0x1E06, - 0x1E07, - 0x1E08, - 0x1E09, - 0x1E0A, - 0x1E0B, - 0x1E0C, - 0x1E0D, - 0x1E0E, - 0x1E0F, - 0x1E10, - 0x1E11, - 0x1E12, - 0x1E13, - 0x1E14, - 0x1E15, - 0x1E16, - 0x1E17, - 0x1E18, - 0x1E19, - 0x1E1A, - 0x1E1B, - 0x1E1C, - 0x1E1D, - 0x1E1E, - 0x1E1F, - 0x1E20, - 0x1E21, - 0x1E22, - 0x1E23, - 0x1E24, - 0x1E25, - 0x1E26, - 0x1E27, - 0x1E28, - 0x1E29, - 0x1E2A, - 0x1E2B, - 0x1E2C, - 0x1E2D, - 0x1E2E, - 0x1E2F, - 0x1E30, - 0x1E31, - 0x1E32, - 0x1E33, - 0x1E34, - 0x1E35, - 0x1E36, - 0x1E37, - 0x1E38, - 0x1E39, - 0x1E3A, - 0x1E3B, - 0x1E3C, - 0x1E3D, - 0x1E3E, - 0x1E3F, - 0x1E40, - 0x1E41, - 0x1E42, - 0x1E43, - 0x1E44, - 0x1E45, - 0x1E46, - 0x1E47, - 0x1E48, - 0x1E49, - 0x1E4A, - 0x1E4B, - 0x1E4C, - 0x1E4D, - 0x1E4E, - 0x1E4F, - 0x1E50, - 0x1E51, - 0x1E52, - 0x1E53, - 0x1E54, - 0x1E55, - 0x1E56, - 0x1E57, - 0x1E58, - 0x1E59, - 0x1E5A, - 0x1E5B, - 0x1E5C, - 0x1E5D, - 0x1E5E, - 0x1E5F, - 0x1E60, - 0x1E61, - 0x1E62, - 0x1E63, - 0x1E64, - 0x1E65, - 0x1E66, - 0x1E67, - 0x1E68, - 0x1E69, - 0x1E6A, - 0x1E6B, - 0x1E6C, - 0x1E6D, - 0x1E6E, - 0x1E6F, - 0x1E70, - 0x1E71, - 0x1E72, - 0x1E73, - 0x1E74, - 0x1E75, - 0x1E76, - 0x1E77, - 0x1E78, - 0x1E79, - 0x1E7A, - 0x1E7B, - 0x1E7C, - 0x1E7D, - 0x1E7E, - 0x1E7F, - 0x1E80, - 0x1E81, - 0x1E82, - 0x1E83, - 0x1E84, - 0x1E85, - 0x1E86, - 0x1E87, - 0x1E88, - 0x1E89, - 0x1E8A, - 0x1E8B, - 0x1E8C, - 0x1E8D, - 0x1E8E, - 0x1E8F, - 0x1E90, - 0x1E91, - 0x1E92, - 0x1E93, - 0x1E94, - 0x1E95, - 0x1E9E, - 0x1E9F, - 0x1EA0, - 0x1EA1, - 0x1EA2, - 0x1EA3, - 0x1EA4, - 0x1EA5, - 0x1EA6, - 0x1EA7, - 0x1EA8, - 0x1EA9, - 0x1EAA, - 0x1EAB, - 0x1EAC, - 0x1EAD, - 0x1EAE, - 0x1EAF, - 0x1EB0, - 0x1EB1, - 0x1EB2, - 0x1EB3, - 0x1EB4, - 0x1EB5, - 0x1EB6, - 0x1EB7, - 0x1EB8, - 0x1EB9, - 0x1EBA, - 0x1EBB, - 0x1EBC, - 0x1EBD, - 0x1EBE, - 0x1EBF, - 0x1EC0, - 0x1EC1, - 0x1EC2, - 0x1EC3, - 0x1EC4, - 0x1EC5, - 0x1EC6, - 0x1EC7, - 0x1EC8, - 0x1EC9, - 0x1ECA, - 0x1ECB, - 0x1ECC, - 0x1ECD, - 0x1ECE, - 0x1ECF, - 0x1ED0, - 0x1ED1, - 0x1ED2, - 0x1ED3, - 0x1ED4, - 0x1ED5, - 0x1ED6, - 0x1ED7, - 0x1ED8, - 0x1ED9, - 0x1EDA, - 0x1EDB, - 0x1EDC, - 0x1EDD, - 0x1EDE, - 0x1EDF, - 0x1EE0, - 0x1EE1, - 0x1EE2, - 0x1EE3, - 0x1EE4, - 0x1EE5, - 0x1EE6, - 0x1EE7, - 0x1EE8, - 0x1EE9, - 0x1EEA, - 0x1EEB, - 0x1EEC, - 0x1EED, - 0x1EEE, - 0x1EEF, - 0x1EF0, - 0x1EF1, - 0x1EF2, - 0x1EF3, - 0x1EF4, - 0x1EF5, - 0x1EF6, - 0x1EF7, - 0x1EF8, - 0x1EF9, - 0x1EFA, - 0x1EFB, - 0x1EFC, - 0x1EFD, - 0x1EFE, - 0x1EFF, - 0x1F08, - 0x1F10, + 0x10D0, + 0x10FB, + 0x10FC, + 0x1249, + 0x124A, + 0x124E, + 0x1250, + 0x1257, + 0x1258, + 0x1259, + 0x125A, + 0x125E, + 0x1260, + 0x1289, + 0x128A, + 0x128E, + 0x1290, + 0x12B1, + 0x12B2, + 0x12B6, + 0x12B8, + 0x12BF, + 0x12C0, + 0x12C1, + 0x12C2, + 0x12C6, + 0x12C8, + 0x12D7, + 0x12D8, + 0x1311, + 0x1312, + 0x1316, + 0x1318, + 0x135B, + 0x135D, + 0x1360, + 0x1380, + 0x1390, + 0x13A0, + 0x13F6, + 0x13F8, + 0x13FE, + 0x1401, + 0x166D, + 0x166F, + 0x1680, + 0x1681, + 0x169B, + 0x16A0, + 0x16EB, + 0x16EE, + 0x16F9, + 0x1700, + 0x170D, + 0x170E, + 0x1715, + 0x1720, + 0x1735, + 0x1740, + 0x1754, + 0x1760, + 0x176D, + 0x176E, + 0x1771, + 0x1772, + 0x1774, + 0x1780, + 0x17D4, + 0x17D7, + 0x17D8, + 0x17DC, + 0x17DE, + 0x17E0, + 0x17EA, + 0x180B, + 0x180E, + 0x1810, + 0x181A, + 0x1820, + 0x1878, + 0x1880, + 0x18AB, + 0x18B0, + 0x18F6, + 0x1900, + 0x191F, + 0x1920, + 0x192C, + 0x1930, + 0x193C, + 0x1946, + 0x196E, + 0x1970, + 0x1975, + 0x1980, + 0x19AC, + 0x19B0, + 0x19CA, + 0x19D0, + 0x19DA, + 0x1A00, + 0x1A1C, + 0x1A20, + 0x1A5F, + 0x1A60, + 0x1A7D, + 0x1A7F, + 0x1A8A, + 0x1A90, + 0x1A9A, + 0x1AA7, + 0x1AA8, + 0x1AB0, + 0x1ABF, + 0x1B00, + 0x1B4C, + 0x1B50, + 0x1B5A, + 0x1B6B, + 0x1B74, + 0x1B80, + 0x1BF4, + 0x1C00, + 0x1C38, + 0x1C40, + 0x1C4A, + 0x1C4D, + 0x1C7E, + 0x1C80, + 0x1C89, + 0x1CD0, + 0x1CD3, + 0x1CD4, + 0x1CF7, + 0x1CF8, + 0x1CFA, + 0x1D00, + 0x1DF6, + 0x1DFB, + 0x1F16, 0x1F18, 0x1F1E, - 0x1F28, - 0x1F30, - 0x1F38, - 0x1F40, + 0x1F20, + 0x1F46, 0x1F48, 0x1F4E, + 0x1F50, + 0x1F58, 0x1F59, 0x1F5A, 0x1F5B, @@ -58947,27 +62577,47 @@ static const UV XPosixUpper_invlist[] = { /* for EBCDIC 1047 */ 0x1F5D, 0x1F5E, 0x1F5F, - 0x1F60, - 0x1F68, - 0x1F70, - 0x1FB8, - 0x1FBC, - 0x1FC8, - 0x1FCC, - 0x1FD8, + 0x1F7E, + 0x1F80, + 0x1FB5, + 0x1FB6, + 0x1FBD, + 0x1FBE, + 0x1FBF, + 0x1FC2, + 0x1FC5, + 0x1FC6, + 0x1FCD, + 0x1FD0, + 0x1FD4, + 0x1FD6, 0x1FDC, - 0x1FE8, + 0x1FE0, 0x1FED, - 0x1FF8, - 0x1FFC, + 0x1FF2, + 0x1FF5, + 0x1FF6, + 0x1FFD, + 0x200C, + 0x200E, + 0x203F, + 0x2041, + 0x2054, + 0x2055, + 0x2071, + 0x2072, + 0x207F, + 0x2080, + 0x2090, + 0x209D, + 0x20D0, + 0x20F1, 0x2102, 0x2103, 0x2107, 0x2108, - 0x210B, - 0x210E, - 0x2110, - 0x2113, + 0x210A, + 0x2114, 0x2115, 0x2116, 0x2119, @@ -58980,357 +62630,555 @@ static const UV XPosixUpper_invlist[] = { /* for EBCDIC 1047 */ 0x2129, 0x212A, 0x212E, - 0x2130, - 0x2134, - 0x213E, + 0x212F, + 0x213A, + 0x213C, 0x2140, 0x2145, - 0x2146, + 0x214A, + 0x214E, + 0x214F, 0x2160, - 0x2170, - 0x2183, - 0x2184, + 0x2189, 0x24B6, - 0x24D0, + 0x24EA, 0x2C00, 0x2C2F, + 0x2C30, + 0x2C5F, 0x2C60, - 0x2C61, - 0x2C62, - 0x2C65, - 0x2C67, - 0x2C68, - 0x2C69, - 0x2C6A, - 0x2C6B, - 0x2C6C, - 0x2C6D, - 0x2C71, - 0x2C72, - 0x2C73, - 0x2C75, - 0x2C76, - 0x2C7E, - 0x2C81, - 0x2C82, - 0x2C83, - 0x2C84, - 0x2C85, - 0x2C86, - 0x2C87, - 0x2C88, - 0x2C89, - 0x2C8A, - 0x2C8B, - 0x2C8C, - 0x2C8D, - 0x2C8E, - 0x2C8F, - 0x2C90, - 0x2C91, - 0x2C92, - 0x2C93, - 0x2C94, - 0x2C95, - 0x2C96, - 0x2C97, - 0x2C98, - 0x2C99, - 0x2C9A, - 0x2C9B, - 0x2C9C, - 0x2C9D, - 0x2C9E, - 0x2C9F, - 0x2CA0, - 0x2CA1, - 0x2CA2, - 0x2CA3, - 0x2CA4, - 0x2CA5, - 0x2CA6, - 0x2CA7, - 0x2CA8, - 0x2CA9, - 0x2CAA, - 0x2CAB, - 0x2CAC, - 0x2CAD, - 0x2CAE, - 0x2CAF, - 0x2CB0, - 0x2CB1, - 0x2CB2, - 0x2CB3, - 0x2CB4, - 0x2CB5, - 0x2CB6, - 0x2CB7, - 0x2CB8, - 0x2CB9, - 0x2CBA, - 0x2CBB, - 0x2CBC, - 0x2CBD, - 0x2CBE, - 0x2CBF, - 0x2CC0, - 0x2CC1, - 0x2CC2, - 0x2CC3, - 0x2CC4, - 0x2CC5, - 0x2CC6, - 0x2CC7, - 0x2CC8, - 0x2CC9, - 0x2CCA, - 0x2CCB, - 0x2CCC, - 0x2CCD, - 0x2CCE, - 0x2CCF, - 0x2CD0, - 0x2CD1, - 0x2CD2, - 0x2CD3, - 0x2CD4, - 0x2CD5, - 0x2CD6, - 0x2CD7, - 0x2CD8, - 0x2CD9, - 0x2CDA, - 0x2CDB, - 0x2CDC, - 0x2CDD, - 0x2CDE, - 0x2CDF, - 0x2CE0, - 0x2CE1, - 0x2CE2, - 0x2CE3, + 0x2CE5, 0x2CEB, - 0x2CEC, - 0x2CED, - 0x2CEE, - 0x2CF2, - 0x2CF3, - 0xA640, - 0xA641, - 0xA642, - 0xA643, - 0xA644, - 0xA645, - 0xA646, - 0xA647, - 0xA648, - 0xA649, - 0xA64A, - 0xA64B, - 0xA64C, - 0xA64D, - 0xA64E, - 0xA64F, - 0xA650, - 0xA651, - 0xA652, - 0xA653, - 0xA654, - 0xA655, - 0xA656, - 0xA657, - 0xA658, - 0xA659, - 0xA65A, - 0xA65B, - 0xA65C, - 0xA65D, - 0xA65E, - 0xA65F, - 0xA660, - 0xA661, - 0xA662, - 0xA663, - 0xA664, - 0xA665, - 0xA666, - 0xA667, - 0xA668, - 0xA669, - 0xA66A, - 0xA66B, - 0xA66C, - 0xA66D, - 0xA680, - 0xA681, - 0xA682, - 0xA683, - 0xA684, - 0xA685, - 0xA686, - 0xA687, - 0xA688, - 0xA689, - 0xA68A, - 0xA68B, - 0xA68C, - 0xA68D, - 0xA68E, - 0xA68F, - 0xA690, - 0xA691, - 0xA692, - 0xA693, - 0xA694, - 0xA695, - 0xA696, - 0xA697, - 0xA698, - 0xA699, - 0xA69A, - 0xA69B, - 0xA722, - 0xA723, - 0xA724, - 0xA725, - 0xA726, - 0xA727, - 0xA728, - 0xA729, - 0xA72A, - 0xA72B, - 0xA72C, - 0xA72D, - 0xA72E, - 0xA72F, - 0xA732, - 0xA733, - 0xA734, - 0xA735, - 0xA736, - 0xA737, - 0xA738, - 0xA739, - 0xA73A, - 0xA73B, - 0xA73C, - 0xA73D, - 0xA73E, - 0xA73F, - 0xA740, - 0xA741, - 0xA742, - 0xA743, - 0xA744, - 0xA745, - 0xA746, - 0xA747, - 0xA748, - 0xA749, - 0xA74A, - 0xA74B, - 0xA74C, - 0xA74D, - 0xA74E, - 0xA74F, - 0xA750, - 0xA751, - 0xA752, - 0xA753, - 0xA754, - 0xA755, - 0xA756, - 0xA757, - 0xA758, - 0xA759, - 0xA75A, - 0xA75B, - 0xA75C, - 0xA75D, - 0xA75E, - 0xA75F, - 0xA760, - 0xA761, - 0xA762, - 0xA763, - 0xA764, - 0xA765, - 0xA766, - 0xA767, - 0xA768, - 0xA769, - 0xA76A, - 0xA76B, - 0xA76C, - 0xA76D, - 0xA76E, - 0xA76F, - 0xA779, - 0xA77A, - 0xA77B, - 0xA77C, - 0xA77D, - 0xA77F, - 0xA780, - 0xA781, - 0xA782, - 0xA783, - 0xA784, - 0xA785, - 0xA786, - 0xA787, + 0x2CF4, + 0x2D00, + 0x2D26, + 0x2D27, + 0x2D28, + 0x2D2D, + 0x2D2E, + 0x2D30, + 0x2D68, + 0x2D6F, + 0x2D70, + 0x2D7F, + 0x2D97, + 0x2DA0, + 0x2DA7, + 0x2DA8, + 0x2DAF, + 0x2DB0, + 0x2DB7, + 0x2DB8, + 0x2DBF, + 0x2DC0, + 0x2DC7, + 0x2DC8, + 0x2DCF, + 0x2DD0, + 0x2DD7, + 0x2DD8, + 0x2DDF, + 0x2DE0, + 0x2E00, + 0x2E2F, + 0x2E30, + 0x3005, + 0x3008, + 0x3021, + 0x3030, + 0x3031, + 0x3036, + 0x3038, + 0x303D, + 0x3041, + 0x3097, + 0x3099, + 0x309B, + 0x309D, + 0x30A0, + 0x30A1, + 0x30FB, + 0x30FC, + 0x3100, + 0x3105, + 0x312E, + 0x3131, + 0x318F, + 0x31A0, + 0x31BB, + 0x31F0, + 0x3200, + 0x3400, + 0x4DB6, + 0x4E00, + 0x9FD6, + 0xA000, + 0xA48D, + 0xA4D0, + 0xA4FE, + 0xA500, + 0xA60D, + 0xA610, + 0xA62C, + 0xA640, + 0xA673, + 0xA674, + 0xA67E, + 0xA67F, + 0xA6F2, + 0xA717, + 0xA720, + 0xA722, + 0xA789, 0xA78B, - 0xA78C, - 0xA78D, - 0xA78E, - 0xA790, - 0xA791, - 0xA792, - 0xA793, - 0xA796, - 0xA797, - 0xA798, - 0xA799, - 0xA79A, - 0xA79B, - 0xA79C, - 0xA79D, - 0xA79E, - 0xA79F, - 0xA7A0, - 0xA7A1, - 0xA7A2, - 0xA7A3, - 0xA7A4, - 0xA7A5, - 0xA7A6, - 0xA7A7, - 0xA7A8, - 0xA7A9, - 0xA7AA, 0xA7AF, 0xA7B0, - 0xA7B5, - 0xA7B6, - 0xA7B7, + 0xA7B8, + 0xA7F7, + 0xA828, + 0xA840, + 0xA874, + 0xA880, + 0xA8C6, + 0xA8D0, + 0xA8DA, + 0xA8E0, + 0xA8F8, + 0xA8FB, + 0xA8FC, + 0xA8FD, + 0xA8FE, + 0xA900, + 0xA92E, + 0xA930, + 0xA954, + 0xA960, + 0xA97D, + 0xA980, + 0xA9C1, + 0xA9CF, + 0xA9DA, + 0xA9E0, + 0xA9FF, + 0xAA00, + 0xAA37, + 0xAA40, + 0xAA4E, + 0xAA50, + 0xAA5A, + 0xAA60, + 0xAA77, + 0xAA7A, + 0xAAC3, + 0xAADB, + 0xAADE, + 0xAAE0, + 0xAAF0, + 0xAAF2, + 0xAAF7, + 0xAB01, + 0xAB07, + 0xAB09, + 0xAB0F, + 0xAB11, + 0xAB17, + 0xAB20, + 0xAB27, + 0xAB28, + 0xAB2F, + 0xAB30, + 0xAB5B, + 0xAB5C, + 0xAB66, + 0xAB70, + 0xABEB, + 0xABEC, + 0xABEE, + 0xABF0, + 0xABFA, + 0xAC00, + 0xD7A4, + 0xD7B0, + 0xD7C7, + 0xD7CB, + 0xD7FC, + 0xF900, + 0xFA6E, + 0xFA70, + 0xFADA, + 0xFB00, + 0xFB07, + 0xFB13, + 0xFB18, + 0xFB1D, + 0xFB29, + 0xFB2A, + 0xFB37, + 0xFB38, + 0xFB3D, + 0xFB3E, + 0xFB3F, + 0xFB40, + 0xFB42, + 0xFB43, + 0xFB45, + 0xFB46, + 0xFBB2, + 0xFBD3, + 0xFD3E, + 0xFD50, + 0xFD90, + 0xFD92, + 0xFDC8, + 0xFDF0, + 0xFDFC, + 0xFE00, + 0xFE10, + 0xFE20, + 0xFE30, + 0xFE33, + 0xFE35, + 0xFE4D, + 0xFE50, + 0xFE70, + 0xFE75, + 0xFE76, + 0xFEFD, + 0xFF10, + 0xFF1A, 0xFF21, 0xFF3B, + 0xFF3F, + 0xFF40, + 0xFF41, + 0xFF5B, + 0xFF66, + 0xFFBF, + 0xFFC2, + 0xFFC8, + 0xFFCA, + 0xFFD0, + 0xFFD2, + 0xFFD8, + 0xFFDA, + 0xFFDD, + 0x10000, + 0x1000C, + 0x1000D, + 0x10027, + 0x10028, + 0x1003B, + 0x1003C, + 0x1003E, + 0x1003F, + 0x1004E, + 0x10050, + 0x1005E, + 0x10080, + 0x100FB, + 0x10140, + 0x10175, + 0x101FD, + 0x101FE, + 0x10280, + 0x1029D, + 0x102A0, + 0x102D1, + 0x102E0, + 0x102E1, + 0x10300, + 0x10320, + 0x10330, + 0x1034B, + 0x10350, + 0x1037B, + 0x10380, + 0x1039E, + 0x103A0, + 0x103C4, + 0x103C8, + 0x103D0, + 0x103D1, + 0x103D6, 0x10400, - 0x10428, + 0x1049E, + 0x104A0, + 0x104AA, 0x104B0, 0x104D4, + 0x104D8, + 0x104FC, + 0x10500, + 0x10528, + 0x10530, + 0x10564, + 0x10600, + 0x10737, + 0x10740, + 0x10756, + 0x10760, + 0x10768, + 0x10800, + 0x10806, + 0x10808, + 0x10809, + 0x1080A, + 0x10836, + 0x10837, + 0x10839, + 0x1083C, + 0x1083D, + 0x1083F, + 0x10856, + 0x10860, + 0x10877, + 0x10880, + 0x1089F, + 0x108E0, + 0x108F3, + 0x108F4, + 0x108F6, + 0x10900, + 0x10916, + 0x10920, + 0x1093A, + 0x10980, + 0x109B8, + 0x109BE, + 0x109C0, + 0x10A00, + 0x10A04, + 0x10A05, + 0x10A07, + 0x10A0C, + 0x10A14, + 0x10A15, + 0x10A18, + 0x10A19, + 0x10A34, + 0x10A38, + 0x10A3B, + 0x10A3F, + 0x10A40, + 0x10A60, + 0x10A7D, + 0x10A80, + 0x10A9D, + 0x10AC0, + 0x10AC8, + 0x10AC9, + 0x10AE7, + 0x10B00, + 0x10B36, + 0x10B40, + 0x10B56, + 0x10B60, + 0x10B73, + 0x10B80, + 0x10B92, + 0x10C00, + 0x10C49, 0x10C80, 0x10CB3, + 0x10CC0, + 0x10CF3, + 0x11000, + 0x11047, + 0x11066, + 0x11070, + 0x1107F, + 0x110BB, + 0x110D0, + 0x110E9, + 0x110F0, + 0x110FA, + 0x11100, + 0x11135, + 0x11136, + 0x11140, + 0x11150, + 0x11174, + 0x11176, + 0x11177, + 0x11180, + 0x111C5, + 0x111CA, + 0x111CD, + 0x111D0, + 0x111DB, + 0x111DC, + 0x111DD, + 0x11200, + 0x11212, + 0x11213, + 0x11238, + 0x1123E, + 0x1123F, + 0x11280, + 0x11287, + 0x11288, + 0x11289, + 0x1128A, + 0x1128E, + 0x1128F, + 0x1129E, + 0x1129F, + 0x112A9, + 0x112B0, + 0x112EB, + 0x112F0, + 0x112FA, + 0x11300, + 0x11304, + 0x11305, + 0x1130D, + 0x1130F, + 0x11311, + 0x11313, + 0x11329, + 0x1132A, + 0x11331, + 0x11332, + 0x11334, + 0x11335, + 0x1133A, + 0x1133C, + 0x11345, + 0x11347, + 0x11349, + 0x1134B, + 0x1134E, + 0x11350, + 0x11351, + 0x11357, + 0x11358, + 0x1135D, + 0x11364, + 0x11366, + 0x1136D, + 0x11370, + 0x11375, + 0x11400, + 0x1144B, + 0x11450, + 0x1145A, + 0x11480, + 0x114C6, + 0x114C7, + 0x114C8, + 0x114D0, + 0x114DA, + 0x11580, + 0x115B6, + 0x115B8, + 0x115C1, + 0x115D8, + 0x115DE, + 0x11600, + 0x11641, + 0x11644, + 0x11645, + 0x11650, + 0x1165A, + 0x11680, + 0x116B8, + 0x116C0, + 0x116CA, + 0x11700, + 0x1171A, + 0x1171D, + 0x1172C, + 0x11730, + 0x1173A, 0x118A0, - 0x118C0, - 0x1D400, - 0x1D41A, - 0x1D434, - 0x1D44E, - 0x1D468, - 0x1D482, - 0x1D49C, + 0x118EA, + 0x118FF, + 0x11900, + 0x11AC0, + 0x11AF9, + 0x11C00, + 0x11C09, + 0x11C0A, + 0x11C37, + 0x11C38, + 0x11C41, + 0x11C50, + 0x11C5A, + 0x11C72, + 0x11C90, + 0x11C92, + 0x11CA8, + 0x11CA9, + 0x11CB7, + 0x12000, + 0x1239A, + 0x12400, + 0x1246F, + 0x12480, + 0x12544, + 0x13000, + 0x1342F, + 0x14400, + 0x14647, + 0x16800, + 0x16A39, + 0x16A40, + 0x16A5F, + 0x16A60, + 0x16A6A, + 0x16AD0, + 0x16AEE, + 0x16AF0, + 0x16AF5, + 0x16B00, + 0x16B37, + 0x16B40, + 0x16B44, + 0x16B50, + 0x16B5A, + 0x16B63, + 0x16B78, + 0x16B7D, + 0x16B90, + 0x16F00, + 0x16F45, + 0x16F50, + 0x16F7F, + 0x16F8F, + 0x16FA0, + 0x16FE0, + 0x16FE1, + 0x17000, + 0x187ED, + 0x18800, + 0x18AF3, + 0x1B000, + 0x1B002, + 0x1BC00, + 0x1BC6B, + 0x1BC70, + 0x1BC7D, + 0x1BC80, + 0x1BC89, + 0x1BC90, + 0x1BC9A, + 0x1BC9D, + 0x1BC9F, + 0x1D165, + 0x1D16A, + 0x1D16D, + 0x1D173, + 0x1D17B, + 0x1D183, + 0x1D185, + 0x1D18C, + 0x1D1AA, + 0x1D1AE, + 0x1D242, + 0x1D245, + 0x1D400, + 0x1D455, + 0x1D456, 0x1D49D, 0x1D49E, 0x1D4A0, @@ -59341,10 +63189,12 @@ static const UV XPosixUpper_invlist[] = { /* for EBCDIC 1047 */ 0x1D4A9, 0x1D4AD, 0x1D4AE, - 0x1D4B6, - 0x1D4D0, - 0x1D4EA, - 0x1D504, + 0x1D4BA, + 0x1D4BB, + 0x1D4BC, + 0x1D4BD, + 0x1D4C4, + 0x1D4C5, 0x1D506, 0x1D507, 0x1D50B, @@ -59352,7 +63202,7 @@ static const UV XPosixUpper_invlist[] = { /* for EBCDIC 1047 */ 0x1D515, 0x1D516, 0x1D51D, - 0x1D538, + 0x1D51E, 0x1D53A, 0x1D53B, 0x1D53F, @@ -59362,177 +63212,298 @@ static const UV XPosixUpper_invlist[] = { /* for EBCDIC 1047 */ 0x1D547, 0x1D54A, 0x1D551, - 0x1D56C, - 0x1D586, - 0x1D5A0, - 0x1D5BA, - 0x1D5D4, - 0x1D5EE, - 0x1D608, - 0x1D622, - 0x1D63C, - 0x1D656, - 0x1D670, - 0x1D68A, + 0x1D552, + 0x1D6A6, 0x1D6A8, 0x1D6C1, - 0x1D6E2, + 0x1D6C2, + 0x1D6DB, + 0x1D6DC, 0x1D6FB, - 0x1D71C, + 0x1D6FC, + 0x1D715, + 0x1D716, 0x1D735, - 0x1D756, + 0x1D736, + 0x1D74F, + 0x1D750, 0x1D76F, - 0x1D790, + 0x1D770, + 0x1D789, + 0x1D78A, 0x1D7A9, - 0x1D7CA, - 0x1D7CB, + 0x1D7AA, + 0x1D7C3, + 0x1D7C4, + 0x1D7CC, + 0x1D7CE, + 0x1D800, + 0x1DA00, + 0x1DA37, + 0x1DA3B, + 0x1DA6D, + 0x1DA75, + 0x1DA76, + 0x1DA84, + 0x1DA85, + 0x1DA9B, + 0x1DAA0, + 0x1DAA1, + 0x1DAB0, + 0x1E000, + 0x1E007, + 0x1E008, + 0x1E019, + 0x1E01B, + 0x1E022, + 0x1E023, + 0x1E025, + 0x1E026, + 0x1E02B, + 0x1E800, + 0x1E8C5, + 0x1E8D0, + 0x1E8D7, 0x1E900, - 0x1E922, + 0x1E94B, + 0x1E950, + 0x1E95A, + 0x1EE00, + 0x1EE04, + 0x1EE05, + 0x1EE20, + 0x1EE21, + 0x1EE23, + 0x1EE24, + 0x1EE25, + 0x1EE27, + 0x1EE28, + 0x1EE29, + 0x1EE33, + 0x1EE34, + 0x1EE38, + 0x1EE39, + 0x1EE3A, + 0x1EE3B, + 0x1EE3C, + 0x1EE42, + 0x1EE43, + 0x1EE47, + 0x1EE48, + 0x1EE49, + 0x1EE4A, + 0x1EE4B, + 0x1EE4C, + 0x1EE4D, + 0x1EE50, + 0x1EE51, + 0x1EE53, + 0x1EE54, + 0x1EE55, + 0x1EE57, + 0x1EE58, + 0x1EE59, + 0x1EE5A, + 0x1EE5B, + 0x1EE5C, + 0x1EE5D, + 0x1EE5E, + 0x1EE5F, + 0x1EE60, + 0x1EE61, + 0x1EE63, + 0x1EE64, + 0x1EE65, + 0x1EE67, + 0x1EE6B, + 0x1EE6C, + 0x1EE73, + 0x1EE74, + 0x1EE78, + 0x1EE79, + 0x1EE7D, + 0x1EE7E, + 0x1EE7F, + 0x1EE80, + 0x1EE8A, + 0x1EE8B, + 0x1EE9C, + 0x1EEA1, + 0x1EEA4, + 0x1EEA5, + 0x1EEAA, + 0x1EEAB, + 0x1EEBC, 0x1F130, 0x1F14A, 0x1F150, 0x1F16A, 0x1F170, - 0x1F18A + 0x1F18A, + 0x20000, + 0x2A6D7, + 0x2A700, + 0x2B735, + 0x2B740, + 0x2B81E, + 0x2B820, + 0x2CEA2, + 0x2F800, + 0x2FA1E, + 0xE0100, + 0xE01F0 }; -static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ - 1385, /* Number of elements */ +static const UV XPosixXDigit_invlist[] = { /* for EBCDIC 1047 */ + 13, /* Number of elements */ 148565664, /* Version and data structure type */ 1, /* 0 if the list starts at 0; 1 if it starts at the element beyond 0 */ 0x0, - 0x42, - 0x4A, + 0x81, + 0x87, + 0xC1, + 0xC7, + 0xF0, + 0xFA, + 0xFF10, + 0xFF1A, + 0xFF21, + 0xFF27, + 0xFF41, + 0xFF47 +}; + +#endif /* defined(PERL_IN_PERL_C) */ + +#endif /* EBCDIC 1047 */ + +#if 'A' == 193 /* EBCDIC 037 */ \ + && '\\' == 224 && '[' == 186 && ']' == 187 && '{' == 192 && '}' == 208 \ + && '^' == 176 && '~' == 161 && '!' == 90 && '#' == 123 && '|' == 79 \ + && '$' == 91 && '@' == 124 && '`' == 121 + +#if defined(PERL_IN_PERL_C) + +static const UV ASCII_invlist[] = { /* for EBCDIC 037 */ + 56, /* Number of elements */ + 148565664, /* Version and data structure type */ + 0, /* 0 if the list starts at 0; + 1 if it starts at the element beyond 0 */ + 0x0, + 0x4, + 0x5, + 0x6, + 0x7, + 0x8, + 0xB, + 0x14, + 0x16, + 0x17, + 0x18, + 0x1A, + 0x1C, + 0x20, + 0x25, + 0x28, + 0x2D, + 0x30, + 0x32, + 0x33, + 0x37, + 0x38, + 0x3C, + 0x3E, + 0x3F, + 0x41, + 0x4B, 0x51, 0x5A, + 0x5F, + 0x60, 0x62, - 0x6A, - 0x6D, - 0x6E, + 0x6B, 0x70, 0x79, 0x80, + 0x81, 0x8A, - 0x8C, - 0x8F, 0x91, - 0x9D, - 0x9E, - 0x9F, - 0xA0, + 0x9A, 0xA1, - 0xA2, 0xAA, - 0xAC, - 0xAD, - 0xAE, - 0xAF, + 0xB0, + 0xB1, 0xBA, - 0xBB, - 0xC1, + 0xBC, + 0xC0, 0xCA, - 0xCB, 0xD0, - 0xD1, 0xDA, - 0xDB, 0xE0, + 0xE1, 0xE2, 0xEA, - 0xEB, - 0xFA, - 0xFB, - 0xFF, - 0x100, - 0x2C2, - 0x2C6, - 0x2D2, - 0x2E0, - 0x2E5, - 0x2EC, - 0x2ED, - 0x2EE, - 0x2EF, - 0x300, - 0x375, - 0x376, + 0xF0, + 0xFA +}; + +static const UV Assigned_invlist[] = { /* for EBCDIC 037 */ + 1276, /* Number of elements */ + 148565664, /* Version and data structure type */ + 0, /* 0 if the list starts at 0; + 1 if it starts at the element beyond 0 */ + 0x0, 0x378, 0x37A, - 0x37E, - 0x37F, 0x380, - 0x386, - 0x387, - 0x388, + 0x384, 0x38B, 0x38C, 0x38D, 0x38E, 0x3A2, 0x3A3, - 0x3F6, - 0x3F7, - 0x482, - 0x483, 0x530, 0x531, 0x557, 0x559, - 0x55A, + 0x560, 0x561, 0x588, + 0x589, + 0x58B, + 0x58D, + 0x590, 0x591, - 0x5BE, - 0x5BF, - 0x5C0, - 0x5C1, - 0x5C3, - 0x5C4, - 0x5C6, - 0x5C7, 0x5C8, 0x5D0, 0x5EB, 0x5F0, - 0x5F3, - 0x610, - 0x61B, - 0x620, - 0x66A, - 0x66E, - 0x6D4, - 0x6D5, - 0x6DD, - 0x6DF, - 0x6E9, - 0x6EA, - 0x6FD, - 0x6FF, - 0x700, - 0x710, + 0x5F5, + 0x600, + 0x61D, + 0x61E, + 0x70E, + 0x70F, 0x74B, 0x74D, 0x7B2, 0x7C0, - 0x7F6, - 0x7FA, 0x7FB, 0x800, 0x82E, + 0x830, + 0x83F, 0x840, 0x85C, + 0x85E, + 0x85F, 0x8A0, 0x8B5, 0x8B6, 0x8BE, 0x8D4, - 0x8E2, - 0x8E3, - 0x964, - 0x966, - 0x970, - 0x971, 0x984, 0x985, 0x98D, @@ -59559,7 +63530,7 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x9DF, 0x9E4, 0x9E6, - 0x9F2, + 0x9FC, 0xA01, 0xA04, 0xA05, @@ -59617,7 +63588,7 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xAE0, 0xAE4, 0xAE6, - 0xAF0, + 0xAF2, 0xAF9, 0xAFA, 0xB01, @@ -59647,9 +63618,7 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xB5F, 0xB64, 0xB66, - 0xB70, - 0xB71, - 0xB72, + 0xB78, 0xB82, 0xB84, 0xB85, @@ -59681,7 +63650,7 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xBD7, 0xBD8, 0xBE6, - 0xBF0, + 0xBFB, 0xC00, 0xC04, 0xC05, @@ -59706,7 +63675,7 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xC64, 0xC66, 0xC70, - 0xC80, + 0xC78, 0xC84, 0xC85, 0xC8D, @@ -59747,14 +63716,10 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xD46, 0xD49, 0xD4A, - 0xD4F, + 0xD50, 0xD54, - 0xD58, - 0xD5F, 0xD64, 0xD66, - 0xD70, - 0xD7A, 0xD80, 0xD82, 0xD84, @@ -59779,13 +63744,11 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xDE6, 0xDF0, 0xDF2, - 0xDF4, + 0xDF5, 0xE01, 0xE3B, - 0xE40, - 0xE4F, - 0xE50, - 0xE5A, + 0xE3F, + 0xE5C, 0xE81, 0xE83, 0xE84, @@ -59823,42 +63786,24 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xEDC, 0xEE0, 0xF00, - 0xF01, - 0xF18, - 0xF1A, - 0xF20, - 0xF2A, - 0xF35, - 0xF36, - 0xF37, - 0xF38, - 0xF39, - 0xF3A, - 0xF3E, 0xF48, 0xF49, 0xF6D, 0xF71, - 0xF85, - 0xF86, 0xF98, 0xF99, 0xFBD, - 0xFC6, - 0xFC7, + 0xFBE, + 0xFCD, + 0xFCE, + 0xFDB, 0x1000, - 0x104A, - 0x1050, - 0x109E, - 0x10A0, 0x10C6, 0x10C7, 0x10C8, 0x10CD, 0x10CE, 0x10D0, - 0x10FB, - 0x10FC, 0x1249, 0x124A, 0x124E, @@ -59891,29 +63836,23 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1318, 0x135B, 0x135D, - 0x1360, + 0x137D, 0x1380, - 0x1390, + 0x139A, 0x13A0, 0x13F6, 0x13F8, 0x13FE, - 0x1401, - 0x166D, - 0x166F, - 0x1680, - 0x1681, - 0x169B, + 0x1400, + 0x169D, 0x16A0, - 0x16EB, - 0x16EE, 0x16F9, 0x1700, 0x170D, 0x170E, 0x1715, 0x1720, - 0x1735, + 0x1737, 0x1740, 0x1754, 0x1760, @@ -59923,15 +63862,13 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1772, 0x1774, 0x1780, - 0x17D4, - 0x17D7, - 0x17D8, - 0x17DC, 0x17DE, 0x17E0, 0x17EA, - 0x180B, - 0x180E, + 0x17F0, + 0x17FA, + 0x1800, + 0x180F, 0x1810, 0x181A, 0x1820, @@ -59946,7 +63883,9 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x192C, 0x1930, 0x193C, - 0x1946, + 0x1940, + 0x1941, + 0x1944, 0x196E, 0x1970, 0x1975, @@ -59955,10 +63894,10 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x19B0, 0x19CA, 0x19D0, - 0x19DA, - 0x1A00, + 0x19DB, + 0x19DE, 0x1A1C, - 0x1A20, + 0x1A1E, 0x1A5F, 0x1A60, 0x1A7D, @@ -59966,29 +63905,25 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1A8A, 0x1A90, 0x1A9A, - 0x1AA7, - 0x1AA8, + 0x1AA0, + 0x1AAE, 0x1AB0, 0x1ABF, 0x1B00, 0x1B4C, 0x1B50, - 0x1B5A, - 0x1B6B, - 0x1B74, + 0x1B7D, 0x1B80, 0x1BF4, - 0x1C00, + 0x1BFC, 0x1C38, - 0x1C40, + 0x1C3B, 0x1C4A, 0x1C4D, - 0x1C7E, - 0x1C80, 0x1C89, + 0x1CC0, + 0x1CC8, 0x1CD0, - 0x1CD3, - 0x1CD4, 0x1CF7, 0x1CF8, 0x1CFA, @@ -60015,76 +63950,56 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1F80, 0x1FB5, 0x1FB6, - 0x1FBD, - 0x1FBE, - 0x1FBF, - 0x1FC2, 0x1FC5, 0x1FC6, - 0x1FCD, - 0x1FD0, 0x1FD4, 0x1FD6, 0x1FDC, - 0x1FE0, - 0x1FED, + 0x1FDD, + 0x1FF0, 0x1FF2, 0x1FF5, 0x1FF6, - 0x1FFD, - 0x200C, - 0x200E, - 0x203F, - 0x2041, - 0x2054, - 0x2055, - 0x2071, + 0x1FFF, + 0x2000, + 0x2065, + 0x2066, 0x2072, - 0x207F, - 0x2080, + 0x2074, + 0x208F, 0x2090, 0x209D, + 0x20A0, + 0x20BF, 0x20D0, 0x20F1, - 0x2102, - 0x2103, - 0x2107, - 0x2108, - 0x210A, - 0x2114, - 0x2115, - 0x2116, - 0x2119, - 0x211E, - 0x2124, - 0x2125, - 0x2126, - 0x2127, - 0x2128, - 0x2129, - 0x212A, - 0x212E, - 0x212F, - 0x213A, - 0x213C, - 0x2140, - 0x2145, - 0x214A, - 0x214E, - 0x214F, - 0x2160, - 0x2189, - 0x24B6, - 0x24EA, + 0x2100, + 0x218C, + 0x2190, + 0x23FF, + 0x2400, + 0x2427, + 0x2440, + 0x244B, + 0x2460, + 0x2B74, + 0x2B76, + 0x2B96, + 0x2B98, + 0x2BBA, + 0x2BBD, + 0x2BC9, + 0x2BCA, + 0x2BD2, + 0x2BEC, + 0x2BF0, 0x2C00, 0x2C2F, 0x2C30, 0x2C5F, 0x2C60, - 0x2CE5, - 0x2CEB, 0x2CF4, - 0x2D00, + 0x2CF9, 0x2D26, 0x2D27, 0x2D28, @@ -60093,7 +64008,7 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x2D30, 0x2D68, 0x2D6F, - 0x2D70, + 0x2D71, 0x2D7F, 0x2D97, 0x2DA0, @@ -60113,86 +64028,70 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x2DD8, 0x2DDF, 0x2DE0, - 0x2E00, - 0x2E2F, - 0x2E30, - 0x3005, - 0x3008, - 0x3021, - 0x3030, - 0x3031, - 0x3036, - 0x3038, - 0x303D, + 0x2E45, + 0x2E80, + 0x2E9A, + 0x2E9B, + 0x2EF4, + 0x2F00, + 0x2FD6, + 0x2FF0, + 0x2FFC, + 0x3000, + 0x3040, 0x3041, 0x3097, 0x3099, - 0x309B, - 0x309D, - 0x30A0, - 0x30A1, - 0x30FB, - 0x30FC, 0x3100, 0x3105, 0x312E, 0x3131, 0x318F, - 0x31A0, + 0x3190, 0x31BB, + 0x31C0, + 0x31E4, 0x31F0, - 0x3200, - 0x3400, + 0x321F, + 0x3220, + 0x32FF, + 0x3300, 0x4DB6, - 0x4E00, + 0x4DC0, 0x9FD6, 0xA000, 0xA48D, + 0xA490, + 0xA4C7, 0xA4D0, - 0xA4FE, - 0xA500, - 0xA60D, - 0xA610, 0xA62C, 0xA640, - 0xA673, - 0xA674, - 0xA67E, - 0xA67F, - 0xA6F2, - 0xA717, - 0xA720, - 0xA722, - 0xA789, - 0xA78B, + 0xA6F8, + 0xA700, 0xA7AF, 0xA7B0, 0xA7B8, 0xA7F7, - 0xA828, + 0xA82C, + 0xA830, + 0xA83A, 0xA840, - 0xA874, + 0xA878, 0xA880, 0xA8C6, - 0xA8D0, + 0xA8CE, 0xA8DA, 0xA8E0, - 0xA8F8, - 0xA8FB, - 0xA8FC, - 0xA8FD, 0xA8FE, 0xA900, - 0xA92E, - 0xA930, 0xA954, - 0xA960, + 0xA95F, 0xA97D, 0xA980, - 0xA9C1, + 0xA9CE, 0xA9CF, 0xA9DA, - 0xA9E0, + 0xA9DE, 0xA9FF, 0xAA00, 0xAA37, @@ -60200,15 +64099,9 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xAA4E, 0xAA50, 0xAA5A, - 0xAA60, - 0xAA77, - 0xAA7A, + 0xAA5C, 0xAAC3, 0xAADB, - 0xAADE, - 0xAAE0, - 0xAAF0, - 0xAAF2, 0xAAF7, 0xAB01, 0xAB07, @@ -60221,12 +64114,8 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xAB28, 0xAB2F, 0xAB30, - 0xAB5B, - 0xAB5C, 0xAB66, 0xAB70, - 0xABEB, - 0xABEC, 0xABEE, 0xABF0, 0xABFA, @@ -60236,7 +64125,7 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xD7C7, 0xD7CB, 0xD7FC, - 0xF900, + 0xD800, 0xFA6E, 0xFA70, 0xFADA, @@ -60245,8 +64134,6 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xFB13, 0xFB18, 0xFB1D, - 0xFB29, - 0xFB2A, 0xFB37, 0xFB38, 0xFB3D, @@ -60257,36 +64144,30 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xFB43, 0xFB45, 0xFB46, - 0xFBB2, + 0xFBC2, 0xFBD3, - 0xFD3E, + 0xFD40, 0xFD50, 0xFD90, 0xFD92, 0xFDC8, 0xFDF0, - 0xFDFC, + 0xFDFE, 0xFE00, - 0xFE10, + 0xFE1A, 0xFE20, - 0xFE30, - 0xFE33, - 0xFE35, - 0xFE4D, - 0xFE50, + 0xFE53, + 0xFE54, + 0xFE67, + 0xFE68, + 0xFE6C, 0xFE70, 0xFE75, 0xFE76, 0xFEFD, - 0xFF10, - 0xFF1A, - 0xFF21, - 0xFF3B, - 0xFF3F, - 0xFF40, - 0xFF41, - 0xFF5B, - 0xFF66, + 0xFEFF, + 0xFF00, + 0xFF01, 0xFFBF, 0xFFC2, 0xFFC8, @@ -60296,6 +64177,12 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0xFFD8, 0xFFDA, 0xFFDD, + 0xFFE0, + 0xFFE7, + 0xFFE8, + 0xFFEF, + 0xFFF9, + 0xFFFE, 0x10000, 0x1000C, 0x1000D, @@ -60310,29 +64197,35 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1005E, 0x10080, 0x100FB, - 0x10140, - 0x10175, - 0x101FD, + 0x10100, + 0x10103, + 0x10107, + 0x10134, + 0x10137, + 0x1018F, + 0x10190, + 0x1019C, + 0x101A0, + 0x101A1, + 0x101D0, 0x101FE, 0x10280, 0x1029D, 0x102A0, 0x102D1, 0x102E0, - 0x102E1, + 0x102FC, 0x10300, - 0x10320, + 0x10324, 0x10330, 0x1034B, 0x10350, 0x1037B, 0x10380, 0x1039E, - 0x103A0, + 0x1039F, 0x103C4, 0x103C8, - 0x103D0, - 0x103D1, 0x103D6, 0x10400, 0x1049E, @@ -60346,6 +64239,8 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x10528, 0x10530, 0x10564, + 0x1056F, + 0x10570, 0x10600, 0x10737, 0x10740, @@ -60364,23 +64259,25 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1083D, 0x1083F, 0x10856, - 0x10860, - 0x10877, - 0x10880, + 0x10857, 0x1089F, + 0x108A7, + 0x108B0, 0x108E0, 0x108F3, 0x108F4, 0x108F6, - 0x10900, - 0x10916, - 0x10920, + 0x108FB, + 0x1091C, + 0x1091F, 0x1093A, + 0x1093F, + 0x10940, 0x10980, 0x109B8, - 0x109BE, - 0x109C0, - 0x10A00, + 0x109BC, + 0x109D0, + 0x109D2, 0x10A04, 0x10A05, 0x10A07, @@ -60393,35 +64290,43 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x10A38, 0x10A3B, 0x10A3F, - 0x10A40, + 0x10A48, + 0x10A50, + 0x10A59, 0x10A60, - 0x10A7D, - 0x10A80, - 0x10A9D, + 0x10AA0, 0x10AC0, - 0x10AC8, - 0x10AC9, 0x10AE7, + 0x10AEB, + 0x10AF7, 0x10B00, 0x10B36, - 0x10B40, + 0x10B39, 0x10B56, - 0x10B60, + 0x10B58, 0x10B73, - 0x10B80, + 0x10B78, 0x10B92, + 0x10B99, + 0x10B9D, + 0x10BA9, + 0x10BB0, 0x10C00, 0x10C49, 0x10C80, 0x10CB3, 0x10CC0, 0x10CF3, + 0x10CFA, + 0x10D00, + 0x10E60, + 0x10E7F, 0x11000, - 0x11047, - 0x11066, + 0x1104E, + 0x11052, 0x11070, 0x1107F, - 0x110BB, + 0x110C2, 0x110D0, 0x110E9, 0x110F0, @@ -60429,24 +64334,18 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x11100, 0x11135, 0x11136, - 0x11140, + 0x11144, 0x11150, - 0x11174, - 0x11176, 0x11177, 0x11180, - 0x111C5, - 0x111CA, - 0x111CD, + 0x111CE, 0x111D0, - 0x111DB, - 0x111DC, - 0x111DD, + 0x111E0, + 0x111E1, + 0x111F5, 0x11200, 0x11212, 0x11213, - 0x11238, - 0x1123E, 0x1123F, 0x11280, 0x11287, @@ -60457,7 +64356,7 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1128F, 0x1129E, 0x1129F, - 0x112A9, + 0x112AA, 0x112B0, 0x112EB, 0x112F0, @@ -60493,27 +64392,25 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x11370, 0x11375, 0x11400, - 0x1144B, - 0x11450, 0x1145A, + 0x1145B, + 0x1145C, + 0x1145D, + 0x1145E, 0x11480, - 0x114C6, - 0x114C7, 0x114C8, 0x114D0, 0x114DA, 0x11580, 0x115B6, 0x115B8, - 0x115C1, - 0x115D8, 0x115DE, 0x11600, - 0x11641, - 0x11644, 0x11645, 0x11650, 0x1165A, + 0x11660, + 0x1166D, 0x11680, 0x116B8, 0x116C0, @@ -60523,9 +64420,9 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1171D, 0x1172C, 0x11730, - 0x1173A, + 0x11740, 0x118A0, - 0x118EA, + 0x118F3, 0x118FF, 0x11900, 0x11AC0, @@ -60535,10 +64432,10 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x11C0A, 0x11C37, 0x11C38, - 0x11C41, + 0x11C46, 0x11C50, - 0x11C5A, - 0x11C72, + 0x11C6D, + 0x11C70, 0x11C90, 0x11C92, 0x11CA8, @@ -60548,6 +64445,8 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1239A, 0x12400, 0x1246F, + 0x12470, + 0x12475, 0x12480, 0x12544, 0x13000, @@ -60560,16 +64459,18 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x16A5F, 0x16A60, 0x16A6A, + 0x16A6E, + 0x16A70, 0x16AD0, 0x16AEE, 0x16AF0, - 0x16AF5, + 0x16AF6, 0x16B00, - 0x16B37, - 0x16B40, - 0x16B44, + 0x16B46, 0x16B50, 0x16B5A, + 0x16B5B, + 0x16B62, 0x16B63, 0x16B78, 0x16B7D, @@ -60596,20 +64497,20 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1BC89, 0x1BC90, 0x1BC9A, - 0x1BC9D, - 0x1BC9F, - 0x1D165, - 0x1D16A, - 0x1D16D, - 0x1D173, - 0x1D17B, - 0x1D183, - 0x1D185, - 0x1D18C, - 0x1D1AA, - 0x1D1AE, - 0x1D242, - 0x1D245, + 0x1BC9C, + 0x1BCA4, + 0x1D000, + 0x1D0F6, + 0x1D100, + 0x1D127, + 0x1D129, + 0x1D1E9, + 0x1D200, + 0x1D246, + 0x1D300, + 0x1D357, + 0x1D360, + 0x1D372, 0x1D400, 0x1D455, 0x1D456, @@ -60649,37 +64550,9 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1D552, 0x1D6A6, 0x1D6A8, - 0x1D6C1, - 0x1D6C2, - 0x1D6DB, - 0x1D6DC, - 0x1D6FB, - 0x1D6FC, - 0x1D715, - 0x1D716, - 0x1D735, - 0x1D736, - 0x1D74F, - 0x1D750, - 0x1D76F, - 0x1D770, - 0x1D789, - 0x1D78A, - 0x1D7A9, - 0x1D7AA, - 0x1D7C3, - 0x1D7C4, 0x1D7CC, 0x1D7CE, - 0x1D800, - 0x1DA00, - 0x1DA37, - 0x1DA3B, - 0x1DA6D, - 0x1DA75, - 0x1DA76, - 0x1DA84, - 0x1DA85, + 0x1DA8C, 0x1DA9B, 0x1DAA0, 0x1DAA1, @@ -60696,12 +64569,14 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1E02B, 0x1E800, 0x1E8C5, - 0x1E8D0, + 0x1E8C7, 0x1E8D7, 0x1E900, 0x1E94B, 0x1E950, 0x1E95A, + 0x1E95E, + 0x1E960, 0x1EE00, 0x1EE04, 0x1EE05, @@ -60768,12 +64643,72 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x1EEAA, 0x1EEAB, 0x1EEBC, + 0x1EEF0, + 0x1EEF2, + 0x1F000, + 0x1F02C, + 0x1F030, + 0x1F094, + 0x1F0A0, + 0x1F0AF, + 0x1F0B1, + 0x1F0C0, + 0x1F0C1, + 0x1F0D0, + 0x1F0D1, + 0x1F0F6, + 0x1F100, + 0x1F10D, + 0x1F110, + 0x1F12F, 0x1F130, - 0x1F14A, - 0x1F150, - 0x1F16A, + 0x1F16C, 0x1F170, - 0x1F18A, + 0x1F1AD, + 0x1F1E6, + 0x1F203, + 0x1F210, + 0x1F23C, + 0x1F240, + 0x1F249, + 0x1F250, + 0x1F252, + 0x1F300, + 0x1F6D3, + 0x1F6E0, + 0x1F6ED, + 0x1F6F0, + 0x1F6F7, + 0x1F700, + 0x1F774, + 0x1F780, + 0x1F7D5, + 0x1F800, + 0x1F80C, + 0x1F810, + 0x1F848, + 0x1F850, + 0x1F85A, + 0x1F860, + 0x1F888, + 0x1F890, + 0x1F8AE, + 0x1F910, + 0x1F91F, + 0x1F920, + 0x1F928, + 0x1F930, + 0x1F931, + 0x1F933, + 0x1F93F, + 0x1F940, + 0x1F94C, + 0x1F950, + 0x1F95F, + 0x1F980, + 0x1F992, + 0x1F9C0, + 0x1F9C1, 0x20000, 0x2A6D7, 0x2A700, @@ -60784,102 +64719,16 @@ static const UV XPosixWord_invlist[] = { /* for EBCDIC 1047 */ 0x2CEA2, 0x2F800, 0x2FA1E, + 0xE0001, + 0xE0002, + 0xE0020, + 0xE0080, 0xE0100, - 0xE01F0 -}; - -static const UV XPosixXDigit_invlist[] = { /* for EBCDIC 1047 */ - 13, /* Number of elements */ - 148565664, /* Version and data structure type */ - 1, /* 0 if the list starts at 0; - 1 if it starts at the element beyond 0 */ - 0x0, - 0x81, - 0x87, - 0xC1, - 0xC7, - 0xF0, - 0xFA, - 0xFF10, - 0xFF1A, - 0xFF21, - 0xFF27, - 0xFF41, - 0xFF47 -}; - -#endif /* defined(PERL_IN_PERL_C) */ - -#endif /* EBCDIC 1047 */ - -#if 'A' == 193 /* EBCDIC 037 */ \ - && '\\' == 224 && '[' == 186 && ']' == 187 && '{' == 192 && '}' == 208 \ - && '^' == 176 && '~' == 161 && '!' == 90 && '#' == 123 && '|' == 79 \ - && '$' == 91 && '@' == 124 && '`' == 121 - -#if defined(PERL_IN_PERL_C) - -static const UV ASCII_invlist[] = { /* for EBCDIC 037 */ - 56, /* Number of elements */ - 148565664, /* Version and data structure type */ - 0, /* 0 if the list starts at 0; - 1 if it starts at the element beyond 0 */ - 0x0, - 0x4, - 0x5, - 0x6, - 0x7, - 0x8, - 0xB, - 0x14, - 0x16, - 0x17, - 0x18, - 0x1A, - 0x1C, - 0x20, - 0x25, - 0x28, - 0x2D, - 0x30, - 0x32, - 0x33, - 0x37, - 0x38, - 0x3C, - 0x3E, - 0x3F, - 0x41, - 0x4B, - 0x51, - 0x5A, - 0x5F, - 0x60, - 0x62, - 0x6B, - 0x70, - 0x79, - 0x80, - 0x81, - 0x8A, - 0x91, - 0x9A, - 0xA1, - 0xAA, - 0xB0, - 0xB1, - 0xBA, - 0xBC, - 0xC0, - 0xCA, - 0xD0, - 0xDA, - 0xE0, - 0xE1, - 0xE2, - 0xEA, - 0xF0, - 0xFA + 0xE01F0, + 0xF0000, + 0xFFFFE, + 0x100000, + 0x10FFFE }; static const UV Cased_invlist[] = { /* for EBCDIC 037 */ @@ -91515,7 +95364,7 @@ static const U8 WB_table[24][24] = { #endif /* defined(PERL_IN_REGEXEC_C) */ /* Generated from: - * f1951e655fd5fa35478f641663ef164146d743362998b01378327afac5f20270 lib/Unicode/UCD.pm + * 59e717586b720a821ee0d7397679d5322e38b49f6fb7840545aedf669c733b70 lib/Unicode/UCD.pm * 47cb62a53beea6d0263e2147331c7e751853c9327225d95bbe2d9e1dc3e1aa44 lib/unicore/ArabicShaping.txt * 153f0a100c315f9f3945e78f57137611d36c44b3a975919c499fd403413fede8 lib/unicore/BidiBrackets.txt * fbe806975c1bf9fc9960bbaa39ff6290c42c7da8315f9cd459109b024cc1c485 lib/unicore/BidiMirroring.txt @@ -91558,8 +95407,8 @@ 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 - * 066d6e75f95cf6794161c8ac0b1a40990277de90eefb913be2e675a7cba38d59 lib/unicore/mktables + * 4bcfb4545be21663ca38a2acbfcbf2b0f3252652a34b50f1a56ef76cb959861b lib/unicore/mktables * cdecb300baad839a6f62791229f551a4fa33f3cbdca08e378dc976466354e778 lib/unicore/version * 913d2f93f3cb6cdf1664db888bf840bc4eb074eef824e082fceda24a9445e60c regen/charset_translations.pl - * 6697977221bf632720408ca9a1a934e43d5d8e51c870532cec3ebdb3e3ba80c6 regen/mk_invlists.pl + * 9534d0cc3914fa1f5d574332c3199605c3d14f8691a0729d68d8498ac2b36280 regen/mk_invlists.pl * ex: set ro: */ diff --git a/configpm b/configpm index d2ba35c..877bff1 100755 --- a/configpm +++ b/configpm @@ -216,7 +216,7 @@ my $quote; my %seen_quotes; { my ($name, $val); - open(CONFIG_SH, $Config_SH) || die "Can't open $Config_SH: $!"; + open(CONFIG_SH, '<', $Config_SH) || die "Can't open $Config_SH: $!"; while () { next if m:^#!/bin/sh:; @@ -527,7 +527,7 @@ $heavy_txt .= join('', @non_v) . "\n"; # copy config summary format from the myconfig.SH script $heavy_txt .= "our \$summary = <<'!END!';\n"; -open(MYCONFIG,") && !/^Summary of/; do { $heavy_txt .= $_ } until !defined($_ = ) || /^\s*$/; close(MYCONFIG); @@ -632,7 +632,7 @@ foreach my $prefix (qw(libs libswanted)) { $heavy_txt .= "${prefix}_nolargefiles='$value'\n"; } -if (open(my $fh, "cflags")) { +if (open(my $fh, '<', 'cflags')) { my $ccwarnflags; my $ccstdflags; while (<$fh>) { @@ -838,7 +838,7 @@ tie %%Config, 'Config', { ENDOFTIE -open(CONFIG_POD, ">$Config_POD") or die "Can't open $Config_POD: $!"; +open(CONFIG_POD, '>', $Config_POD) or die "Can't open $Config_POD: $!"; print CONFIG_POD <<'ENDOFTAIL'; =head1 NAME @@ -991,7 +991,7 @@ in such cases. ENDOFTAIL if ($Opts{glossary}) { - open(GLOS, "<$Glossary") or die "Can't open $Glossary: $!"; + open(GLOS, '<', $Glossary) or die "Can't open $Glossary: $!"; } my %seen = (); my $text = 0; diff --git a/configure.com b/configure.com index 2e5b810..2cc41e1 100644 --- a/configure.com +++ b/configure.com @@ -7407,7 +7407,6 @@ $ ENDIF $ WRITE CONFIG "$!" $ WRITE CONFIG "$! Symbols for Perl-based utility programs:" $ WRITE CONFIG "$!" -$ WRITE CONFIG "$ c2ph == """ + perl_setup_perl + " ''vms_prefix':[utils]c2ph.com""" $ WRITE CONFIG "$ corelist == """ + perl_setup_perl + " ''vms_prefix':[utils]corelist.com""" $ WRITE CONFIG "$ cpan == """ + perl_setup_perl + " ''vms_prefix':[utils]cpan.com""" $ WRITE CONFIG "$ enc2xs == """ + perl_setup_perl + " ''vms_prefix':[utils]enc2xs.com""" @@ -7430,7 +7429,6 @@ $ WRITE CONFIG "$ pod2usage == """ + perl_setup_perl + " ''vms_prefix':[utils]p $ WRITE CONFIG "$ podchecker == """ + perl_setup_perl + " ''vms_prefix':[utils]podchecker.com""" $ WRITE CONFIG "$ podselect == """ + perl_setup_perl + " ''vms_prefix':[utils]podselect.com""" $ WRITE CONFIG "$ prove == """ + perl_setup_perl + " ''vms_prefix':[utils]prove.com""" -$ WRITE CONFIG "$ pstruct == """ + perl_setup_perl + " ''vms_prefix':[utils]pstruct.com""" $ WRITE CONFIG "$ ptar == """ + perl_setup_perl + " ''vms_prefix':[utils]ptar.com""" $ WRITE CONFIG "$ ptardiff == """ + perl_setup_perl + " ''vms_prefix':[utils]ptardiff.com""" $ WRITE CONFIG "$ ptargrep == """ + perl_setup_perl + " ''vms_prefix':[utils]ptargrep.com""" diff --git a/cpan/CPAN/lib/App/Cpan.pm b/cpan/CPAN/lib/App/Cpan.pm index 4856018..3ddcbe8 100644 --- a/cpan/CPAN/lib/App/Cpan.pm +++ b/cpan/CPAN/lib/App/Cpan.pm @@ -6,7 +6,7 @@ use vars qw($VERSION); use if $] < 5.008 => 'IO::Scalar'; -$VERSION = '1.64_01'; +$VERSION = '1.66'; =head1 NAME @@ -552,12 +552,12 @@ sub DESTROY { 1 } # load a module without searching the default entry for the current # directory sub _safe_load_module { - my $name = shift; + my $name = shift; - local @INC = @INC; - pop @INC if $INC[-1] eq '.'; + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; - eval "require $name; 1"; + eval "require $name; 1"; } sub _init_logger @@ -1033,7 +1033,7 @@ sub _load_local_lib # -I my $rc = _safe_load_module("local::lib"); unless( $rc ) { - $logger->die( "Could not load local::lib" ); + $logger->logdie( "Could not load local::lib" ); } local::lib->import; @@ -1045,7 +1045,7 @@ sub _use_these_mirrors # -M { $logger->debug( "Setting per session mirrors" ); unless( $_[0] ) { - $logger->die( "The -M switch requires a comma-separated list of mirrors" ); + $logger->logdie( "The -M switch requires a comma-separated list of mirrors" ); } $CPAN::Config->{urllist} = [ split /,/, $_[0] ]; @@ -1347,7 +1347,8 @@ sub _show_out_of_date foreach my $module ( @$modules ) { - next unless $module->inst_file; + next unless $module = _expand_module($module); + next unless $module->inst_file; next if $module->uptodate; printf "%-40s %.4f %.4f\n", $module->id, @@ -1491,7 +1492,9 @@ sub _expand_module { my( $module ) = @_; - my $expanded = CPAN::Shell->expand( "Module", $module ); + my $expanded = CPAN::Shell->expandany( $module ); + return $expanded if $expanded; + $expanded = CPAN::Shell->expand( "Module", $module ); unless( defined $expanded ) { $logger->error( "Could not expand [$module]. Check the module name." ); my $threshold = ( diff --git a/cpan/CPAN/lib/CPAN.pm b/cpan/CPAN/lib/CPAN.pm index 49e3352..1fba5c1 100644 --- a/cpan/CPAN/lib/CPAN.pm +++ b/cpan/CPAN/lib/CPAN.pm @@ -2,7 +2,7 @@ # vim: ts=4 sts=4 sw=4: use strict; package CPAN; -$CPAN::VERSION = '2.14_01'; +$CPAN::VERSION = '2.16'; $CPAN::VERSION =~ s/_//; # we need to run chdir all over and we would get at wrong libraries @@ -1064,6 +1064,16 @@ sub has_usable { }, ], 'Net::FTP' => [ + sub { + my $var = $CPAN::Config->{ftp_proxy} || $ENV{ftp_proxy}; + if ($var and $var =~ /^http:/i) { + # rt #110833 + for ("Net::FTP cannot handle http proxy") { + $CPAN::Frontend->mywarn($_); + die $_; + } + } + }, sub {require Net::FTP}, sub {require Net::Config}, ], @@ -2111,6 +2121,9 @@ currently defined: bzip2 path to external prg cache_metadata use serializer to cache metadata check_sigs if signatures should be verified + cleanup_after_install + remove build directory immediately after a + successful install colorize_debug Term::ANSIColor attributes for debugging output colorize_output boolean if Term::ANSIColor should colorize output colorize_print Term::ANSIColor attributes for normal output diff --git a/cpan/CPAN/lib/CPAN/Bundle.pm b/cpan/CPAN/lib/CPAN/Bundle.pm index 1525dde..3f17b54 100644 --- a/cpan/CPAN/lib/CPAN/Bundle.pm +++ b/cpan/CPAN/lib/CPAN/Bundle.pm @@ -8,7 +8,7 @@ use CPAN::Module; use vars qw( $VERSION ); -$VERSION = "5.5001"; +$VERSION = "5.5002"; sub look { my $self = shift; @@ -39,7 +39,12 @@ sub color_cmd_tmps { && $color==1 && $self->{incommandcolor}==$color; if ($depth>=$CPAN::MAX_RECURSION) { - die(CPAN::Exception::RecursiveDependency->new($ancestors)); + my $e = CPAN::Exception::RecursiveDependency->new($ancestors); + if ($e->is_resolvable) { + return $self->{incommandcolor}=2; + } else { + die $e; + } } # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1; diff --git a/cpan/CPAN/lib/CPAN/Distribution.pm b/cpan/CPAN/lib/CPAN/Distribution.pm index 1ec84a7..b5744fd 100644 --- a/cpan/CPAN/lib/CPAN/Distribution.pm +++ b/cpan/CPAN/lib/CPAN/Distribution.pm @@ -8,7 +8,7 @@ use CPAN::InfoObj; use File::Path (); @CPAN::Distribution::ISA = qw(CPAN::InfoObj); use vars qw($VERSION); -$VERSION = "2.12"; +$VERSION = "2.16"; # no prepare, because prepare is not a command on the shell command line # TODO: clear instance cache on reload @@ -207,7 +207,12 @@ sub color_cmd_tmps { && $self->{incommandcolor}==$color; $CPAN::MAX_RECURSION||=0; # silence 'once' warnings if ($depth>=$CPAN::MAX_RECURSION) { - die(CPAN::Exception::RecursiveDependency->new($ancestors)); + my $e = CPAN::Exception::RecursiveDependency->new($ancestors); + if ($e->is_resolvable) { + return $self->{incommandcolor}=2; + } else { + die $e; + } } # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1; my $prereq_pm = $self->prereq_pm; @@ -569,7 +574,14 @@ See also http://rt.cpan.org/Ticket/Display.html?id=38932\n"); unless (File::Copy::move($from,$to)) { my $err = $!; $from = File::Spec->rel2abs($from); - $CPAN::Frontend->mydie("Couldn't move $from to $to: $err"); + $CPAN::Frontend->mydie( + "Couldn't move $from to $to: $err; #82295? ". + "CPAN::VERSION=$CPAN::VERSION; ". + "File::Copy::VERSION=$File::Copy::VERSION; ". + "$from " . (-e $from ? "exists; " : "does not exist; "). + "$to " . (-e $to ? "exists; " : "does not exist; "). + "cwd=" . CPAN::anycwd() . ";" + ); } } $self->{build_dir} = $packagedir; @@ -2826,9 +2838,23 @@ sub unsat_prereq { $CPAN::SQLite->search("CPAN::Module",$need_module); } $nmo = $CPAN::META->instance("CPAN::Module",$need_module); - next if $nmo->uptodate; $inst_file = $nmo->inst_file || ''; $available_file = $nmo->available_file || ''; + $available_version = $nmo->available_version; + if ($nmo->uptodate) { + my $accepts = eval { + $merged->accepts_module($need_module, $available_version); + }; + unless ($accepts) { + my $rq = $merged->requirements_for_module( $need_module ); + $CPAN::Frontend->mywarn( + "Warning: Version '$available_version' of ". + "'$need_module' is up to date but does not ". + "fulfill requirements ($rq). I will continue, ". + "but chances to succeed are low.\n"); + } + next NEED; + } # if they have not specified a version, we accept any installed one if ( $available_file @@ -2841,8 +2867,6 @@ sub unsat_prereq { next NEED; } } - - $available_version = $nmo->available_version; } # We only want to install prereqs if either they're not installed @@ -3950,6 +3974,15 @@ sub install { $CPAN::Frontend->myprint(" $system -- OK\n"); $CPAN::META->is_installed($self->{build_dir}); $self->{install} = CPAN::Distrostatus->new("YES"); + if ($CPAN::Config->{'cleanup_after_install'}) { + my $parent = File::Spec->catdir( $self->{build_dir}, File::Spec->updir ); + chdir $parent or $CPAN::Frontend->mydie("Couldn't chdir to $parent: $!\n"); + File::Path::rmtree($self->{build_dir}); + my $yml = "$self->{build_dir}.yml"; + if (-e $yml) { + unlink $yml or $CPAN::Frontend->mydie("Couldn't unlink $yml: $!\n"); + } + } } else { $self->{install} = CPAN::Distrostatus->new("NO"); $CPAN::Frontend->mywarn(" $system -- NOT OK\n"); @@ -3976,7 +4009,9 @@ sub install { } } delete $self->{force_update}; - $self->store_persistent_state; + unless ($CPAN::Config->{'cleanup_after_install'}) { + $self->store_persistent_state; + } $self->post_install(); diff --git a/cpan/CPAN/lib/CPAN/Exception/RecursiveDependency.pm b/cpan/CPAN/lib/CPAN/Exception/RecursiveDependency.pm index b928ad7..82e8234 100644 --- a/cpan/CPAN/lib/CPAN/Exception/RecursiveDependency.pm +++ b/cpan/CPAN/lib/CPAN/Exception/RecursiveDependency.pm @@ -7,7 +7,16 @@ use overload '""' => "as_string"; use vars qw( $VERSION ); -$VERSION = "5.5"; +$VERSION = "5.5001"; + +{ + package CPAN::Exception::RecursiveDependency::na; + use overload '""' => "as_string"; + sub new { bless {}, shift }; + sub as_string { "N/A" }; +} + +my $NA = CPAN::Exception::RecursiveDependency::na->new; # a module sees its distribution (no version) # a distribution sees its prereqs (which are module names) (usually with versions) @@ -25,12 +34,13 @@ sub new { } } my $in_loop = 0; - for my $i (0..$#deps) { + my %mark; + DWALK: for my $i (0..$#deps) { my $x = $deps[$i]{name}; $in_loop ||= $loop_starts_with && $x eq $loop_starts_with; my $xo = CPAN::Shell->expandany($x) or next; if ($xo->isa("CPAN::Module")) { - my $have = $xo->inst_version || "N/A"; + my $have = $xo->inst_version || $NA; my($want,$d,$want_type); if ($i>0 and $d = $deps[$i-1]{name}) { my $do = CPAN::Shell->expandany($d); @@ -54,13 +64,27 @@ sub new { $deps[$i]{want_type} = $want_type; $deps[$i]{want} = $want; $deps[$i]{display_as} = "$x (have: $have; $want_type$want)"; + if ((! ref $have || !$have->isa('CPAN::Exception::RecursiveDependency::na')) + && CPAN::Version->vge($have, $want)) { + # https://rt.cpan.org/Ticket/Display.html?id=115340 + undef $loop_starts_with; + last DWALK; + } } elsif ($xo->isa("CPAN::Distribution")) { - $deps[$i]{display_as} = $xo->pretty_id; + my $pretty = $deps[$i]{display_as} = $xo->pretty_id; + my $mark_as; if ($in_loop) { - $xo->{make} = CPAN::Distrostatus->new("NO cannot resolve circular dependency"); + $mark_as = CPAN::Distrostatus->new("NO cannot resolve circular dependency"); } else { - $xo->{make} = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency"); + $mark_as = CPAN::Distrostatus->new("NO one dependency ($loop_starts_with) is a circular dependency"); } + $mark{$pretty} = { xo => $xo, mark_as => $mark_as }; + } + } + if ($loop_starts_with) { + while (my($k,$v) = each %mark) { + my $xo = $v->{xo}; + $xo->{make} = $v->{mark_as}; $xo->store_persistent_state; # otherwise I will not reach # all involved parties for # the next session @@ -69,6 +93,10 @@ sub new { bless { deps => \@deps, loop_starts_with => $loop_starts_with }, $class; } +sub is_resolvable { + ! defined shift->{loop_starts_with}; +} + sub as_string { my($self) = shift; my $deps = $self->{deps}; diff --git a/cpan/CPAN/lib/CPAN/FTP.pm b/cpan/CPAN/lib/CPAN/FTP.pm index 0c338c5..a43ea02 100644 --- a/cpan/CPAN/lib/CPAN/FTP.pm +++ b/cpan/CPAN/lib/CPAN/FTP.pm @@ -14,7 +14,7 @@ use vars qw($connect_to_internet_ok $Ua $Thesite $ThesiteURL $Themethod); use vars qw( $VERSION ); -$VERSION = "5.5007"; +$VERSION = "5.5008"; #-> sub CPAN::FTP::ftp_statistics # if they want to rewrite, they need to pass in a filehandle @@ -665,7 +665,7 @@ sub hostdleasy { #called from hostdlxxx # Net::FTP can still succeed where LWP fails. So we do not # skip Net::FTP anymore when LWP is available. } - } elsif ($url =~ /^http:/ && $CPAN::META->has_usable('HTTP::Tiny')) { + } elsif ($url =~ /^http:/i && $CPAN::META->has_usable('HTTP::Tiny')) { require CPAN::HTTP::Client; my $chc = CPAN::HTTP::Client->new( proxy => $CPAN::Config->{http_proxy} || $ENV{http_proxy}, diff --git a/cpan/CPAN/lib/CPAN/FirstTime.pm b/cpan/CPAN/lib/CPAN/FirstTime.pm index fb6b7eb..531c115 100644 --- a/cpan/CPAN/lib/CPAN/FirstTime.pm +++ b/cpan/CPAN/lib/CPAN/FirstTime.pm @@ -10,7 +10,7 @@ use File::Path (); use File::Spec (); use CPAN::Mirrors (); use vars qw($VERSION $auto_config); -$VERSION = "5.5309"; +$VERSION = "5.5310"; =head1 NAME @@ -124,6 +124,14 @@ checks will be performed at all. Always try to check and verify signatures if a SIGNATURE file is in the package and Module::Signature is installed (yes/no)? +=item cleanup_after_install + +Users who install modules and do not intend to look back, can free +occupied disk space quickly by letting CPAN.pm cleanup each build +directory immediately after a successful install. + +Remove build directory after a successful install? (yes/no)? + =item colorize_output When you have Term::ANSIColor installed, you can turn on colorized @@ -881,6 +889,7 @@ sub init { my_dflt_prompt(index_expire => 1, $matcher); my_prompt_loop(scan_cache => 'atstart', $matcher, 'atstart|atexit|never'); + my_yn_prompt(cleanup_after_install => 0, $matcher); # #= cache_metadata diff --git a/cpan/CPAN/lib/CPAN/HandleConfig.pm b/cpan/CPAN/lib/CPAN/HandleConfig.pm index bd28948..c72439f 100644 --- a/cpan/CPAN/lib/CPAN/HandleConfig.pm +++ b/cpan/CPAN/lib/CPAN/HandleConfig.pm @@ -12,7 +12,7 @@ CPAN::HandleConfig - internal configuration handling for CPAN.pm =cut -$VERSION = "5.5007"; # see also CPAN::Config::VERSION at end of file +$VERSION = "5.5008"; # see also CPAN::Config::VERSION at end of file %can = ( commit => "Commit changes to disk", @@ -42,6 +42,7 @@ $VERSION = "5.5007"; # see also CPAN::Config::VERSION at end of file "bzip2", "cache_metadata", "check_sigs", + "cleanup_after_install", "colorize_debug", "colorize_output", "colorize_print", @@ -769,7 +770,7 @@ sub prefs_lookup { use strict; use vars qw($AUTOLOAD $VERSION); - $VERSION = "5.5007"; + $VERSION = "5.5008"; # formerly CPAN::HandleConfig was known as CPAN::Config sub AUTOLOAD { ## no critic diff --git a/cpan/CPAN/lib/CPAN/Module.pm b/cpan/CPAN/lib/CPAN/Module.pm index bf1226c..62ca42c 100644 --- a/cpan/CPAN/lib/CPAN/Module.pm +++ b/cpan/CPAN/lib/CPAN/Module.pm @@ -7,7 +7,7 @@ use strict; use vars qw( $VERSION ); -$VERSION = "5.5002"; +$VERSION = "5.5003"; BEGIN { # alarm() is not implemented in perl 5.6.x and earlier under Windows @@ -104,7 +104,12 @@ sub color_cmd_tmps { # so we can break it } if ($depth>=$CPAN::MAX_RECURSION) { - die(CPAN::Exception::RecursiveDependency->new($ancestors)); + my $e = CPAN::Exception::RecursiveDependency->new($ancestors); + if ($e->is_resolvable) { + return $self->{incommandcolor}=2; + } else { + die $e; + } } # warn "color_cmd_tmps $depth $color " . $self->id; # sleep 1; diff --git a/cpan/Compress-Raw-Bzip2/Bzip2.xs b/cpan/Compress-Raw-Bzip2/Bzip2.xs index e47dbae..b4e9ab5 100644 --- a/cpan/Compress-Raw-Bzip2/Bzip2.xs +++ b/cpan/Compress-Raw-Bzip2/Bzip2.xs @@ -558,7 +558,7 @@ bzclose(s, output) if (DO_UTF8(output) && !sv_utf8_downgrade(output, 1)) croak("Wide character in " COMPRESS_CLASS "::bzclose input parameter"); #endif - if(! s->flags & FLAG_APPEND_OUTPUT) { + if((s->flags & FLAG_APPEND_OUTPUT) != FLAG_APPEND_OUTPUT) { SvCUR_set(output, 0); /* sv_setpvn(output, "", 0); */ } @@ -619,7 +619,7 @@ bzflush(s, output) if (DO_UTF8(output) && !sv_utf8_downgrade(output, 1)) croak("Wide character in " COMPRESS_CLASS "::bzflush input parameter"); #endif - if(! s->flags & FLAG_APPEND_OUTPUT) { + if((s->flags & FLAG_APPEND_OUTPUT) != FLAG_APPEND_OUTPUT) { SvCUR_set(output, 0); /* sv_setpvn(output, "", 0); */ } diff --git a/cpan/Compress-Raw-Bzip2/bzip2-src/compress.c b/cpan/Compress-Raw-Bzip2/bzip2-src/compress.c index 522e06a..0733078 100644 --- a/cpan/Compress-Raw-Bzip2/bzip2-src/compress.c +++ b/cpan/Compress-Raw-Bzip2/bzip2-src/compress.c @@ -353,7 +353,7 @@ void sendMTFValues ( EState* s ) Calculate the cost of this group as coded by each of the coding tables. --*/ - for (t = 0; t < nGroups; t++) cost[t] = 0; + for (t = 0; t < BZ_N_GROUPS; t++) cost[t] = 0; if (nGroups == 6 && 50 == ge-gs+1) { /*--- fast track the common case ---*/ diff --git a/cpan/Compress-Raw-Bzip2/lib/Compress/Raw/Bzip2.pm b/cpan/Compress-Raw-Bzip2/lib/Compress/Raw/Bzip2.pm index d9e25bd..0d806b9 100644 --- a/cpan/Compress-Raw-Bzip2/lib/Compress/Raw/Bzip2.pm +++ b/cpan/Compress-Raw-Bzip2/lib/Compress/Raw/Bzip2.pm @@ -11,7 +11,7 @@ use Carp ; use bytes ; our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD); -$VERSION = '2.069'; +$VERSION = '2.070'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -364,13 +364,13 @@ L, L, L, L -The primary site for the bzip2 program is F. +The primary site for the bzip2 program is L. See the module L =head1 AUTHOR -This module was written by Paul Marquess, F. +This module was written by Paul Marquess, C. =head1 MODIFICATION HISTORY @@ -378,7 +378,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2015 Paul Marquess. All rights reserved. +Copyright (c) 2005-2016 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/cpan/Compress-Raw-Bzip2/t/000prereq.t b/cpan/Compress-Raw-Bzip2/t/000prereq.t index ebe0f50..63945c3 100644 --- a/cpan/Compress-Raw-Bzip2/t/000prereq.t +++ b/cpan/Compress-Raw-Bzip2/t/000prereq.t @@ -19,7 +19,7 @@ BEGIN if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; - my $VERSION = '2.069'; + my $VERSION = '2.070'; my @NAMES = qw( ); diff --git a/cpan/Compress-Raw-Zlib/Zlib.xs b/cpan/Compress-Raw-Zlib/Zlib.xs index 664c26c..d379f78 100644 --- a/cpan/Compress-Raw-Zlib/Zlib.xs +++ b/cpan/Compress-Raw-Zlib/Zlib.xs @@ -1088,7 +1088,7 @@ flush(s, output, f=Z_FINISH) if (DO_UTF8(output) && !sv_utf8_downgrade(output, 1)) croak("Wide character in Compress::Raw::Zlib::Deflate::flush input parameter"); #endif - if(! s->flags & FLAG_APPEND) { + if((s->flags & FLAG_APPEND) != FLAG_APPEND) { SvCUR_set(output, 0); /* sv_setpvn(output, "", 0); */ } diff --git a/cpan/Compress-Raw-Zlib/lib/Compress/Raw/Zlib.pm b/cpan/Compress-Raw-Zlib/lib/Compress/Raw/Zlib.pm index 59a6100..175462f 100644 --- a/cpan/Compress-Raw-Zlib/lib/Compress/Raw/Zlib.pm +++ b/cpan/Compress-Raw-Zlib/lib/Compress/Raw/Zlib.pm @@ -10,7 +10,7 @@ use warnings ; use bytes ; our ($VERSION, $XS_VERSION, @ISA, @EXPORT, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD, %DEFLATE_CONSTANTS, @DEFLATE_CONSTANTS); -$VERSION = '2.069'; +$VERSION = '2.070'; $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -1568,21 +1568,21 @@ L, L For RFC 1950, 1951 and 1952 see -F, -F and -F +L, +L and +L The I compression library was written by Jean-loup Gailly -F and Mark Adler F. +C and Mark Adler C. The primary site for the I compression library is -F. +L. -The primary site for gzip is F. +The primary site for gzip is L. =head1 AUTHOR -This module was written by Paul Marquess, F. +This module was written by Paul Marquess, C. =head1 MODIFICATION HISTORY @@ -1590,7 +1590,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2015 Paul Marquess. All rights reserved. +Copyright (c) 2005-2016 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/cpan/Compress-Raw-Zlib/zlib-src/inflate.c b/cpan/Compress-Raw-Zlib/zlib-src/inflate.c index c938f49..c8dca0b 100644 --- a/cpan/Compress-Raw-Zlib/zlib-src/inflate.c +++ b/cpan/Compress-Raw-Zlib/zlib-src/inflate.c @@ -1490,8 +1490,8 @@ int ZEXPORT inflateUndermine( if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; state = (struct inflate_state FAR *)strm->state; -#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR state->sane = !subvert; +#ifdef INFLATE_ALLOW_INVALID_DISTANCE_TOOFAR_ARRR return Z_OK; #else state->sane = 1; diff --git a/cpan/DB_File/DB_File.pm b/cpan/DB_File/DB_File.pm index 8e40902..5f4b764 100644 --- a/cpan/DB_File/DB_File.pm +++ b/cpan/DB_File/DB_File.pm @@ -163,7 +163,7 @@ our ($db_version, $use_XSLoader, $splice_end_array_no_length, $splice_end_array, use Carp; -$VERSION = "1.838" ; +$VERSION = "1.840" ; $VERSION = eval $VERSION; # needed for dev releases { diff --git a/cpan/DB_File/DB_File.xs b/cpan/DB_File/DB_File.xs index f417b22..04c8f74 100644 --- a/cpan/DB_File/DB_File.xs +++ b/cpan/DB_File/DB_File.xs @@ -607,6 +607,9 @@ const DBT * key2 ; #ifdef AT_LEAST_DB_3_2 PERL_UNUSED_ARG(db); #endif +#ifdef AT_LEAST_DB_6_0 + PERL_UNUSED_ARG(locp); +#endif if (CurrentDB->in_compare) { tidyUp(CurrentDB); diff --git a/cpan/Scalar-List-Utils/t/tainted.t b/cpan/Scalar-List-Utils/t/tainted.t index e483dfd..9e0df5e 100644 --- a/cpan/Scalar-List-Utils/t/tainted.t +++ b/cpan/Scalar-List-Utils/t/tainted.t @@ -15,10 +15,13 @@ ok( !tainted($var), 'known variable'); my $key = (grep { !/^PERL/ } keys %ENV)[0]; +SKIP: { # Skip these to get blead to pass, but the skip expires soon +skip 'is randomly failing', 2 unless $] gt 5.025009; ok( tainted($ENV{$key}), 'environment variable'); $var = $ENV{$key}; ok( tainted($var), 'copy of environment variable'); +} { package Tainted; diff --git a/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t b/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t index 0e79101..367d0ef 100644 --- a/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t +++ b/cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t @@ -160,11 +160,13 @@ ok(!-d $tmpdir, "cleaned up temp dir"); if (opendir(my $d, $tmpdir)) { for my $f (readdir($d)) { next if $f =~ m/^\.+$/; - next unless -f "$tmpdir/$f"; - unlink("$tmpdir/$f"); + my $file = File::Spec->catfile($tmpdir, $f); + next unless -f $file; + 1 while unlink $file; } + closedir($d); + rmdir($tmpdir) or warn "Could not remove temp dir '$tmpdir': $!"; } - rmdir($tmpdir) or warn "Could not remove temp dir '$tmpdir': $!"; }; $cleanup->(); diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm index 78efd44..00f6326 100644 --- a/dist/Data-Dumper/Dumper.pm +++ b/dist/Data-Dumper/Dumper.pm @@ -10,7 +10,7 @@ package Data::Dumper; BEGIN { - $VERSION = '2.166'; # Don't forget to set version and release + $VERSION = '2.167'; # Don't forget to set version and release } # date in POD below! #$| = 1; @@ -1459,13 +1459,13 @@ be to use the C filter of Data::Dumper. Gurusamy Sarathy gsar@activestate.com -Copyright (c) 1996-2016 Gurusamy Sarathy. All rights reserved. +Copyright (c) 1996-2017 Gurusamy Sarathy. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 VERSION -Version 2.166 (November 14 2016) +Version 2.167 (January 4 2017) =head1 SEE ALSO diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs index d288bbd..0e7142e 100644 --- a/dist/Data-Dumper/Dumper.xs +++ b/dist/Data-Dumper/Dumper.xs @@ -548,6 +548,8 @@ deparsed_output(pTHX_ SV *val) FREETMPS; + PUTBACK; + return text; } diff --git a/dist/Data-Dumper/t/bugs.t b/dist/Data-Dumper/t/bugs.t index 0a1ee8f..5db82da 100644 --- a/dist/Data-Dumper/t/bugs.t +++ b/dist/Data-Dumper/t/bugs.t @@ -12,7 +12,7 @@ BEGIN { } use strict; -use Test::More tests => 23; +use Test::More tests => 24; use Data::Dumper; { @@ -168,4 +168,15 @@ SKIP: { } } +# RT#130487 - stack management bug in XS deparse +SKIP: { + skip "No XS available", 1 if !defined &Data::Dumper::Dumpxs; + sub rt130487_args { 0 + @_ } + my $code = sub {}; + local $Data::Dumper::Useperl = 0; + local $Data::Dumper::Deparse = 1; + my $got = rt130487_args( Dumper($code) ); + is($got, 1, "stack management in XS deparse works, rt 130487"); +} + # EOF diff --git a/dist/Devel-SelfStubber/lib/Devel/SelfStubber.pm b/dist/Devel-SelfStubber/lib/Devel/SelfStubber.pm index e47cd3a..781dd9f 100644 --- a/dist/Devel-SelfStubber/lib/Devel/SelfStubber.pm +++ b/dist/Devel-SelfStubber/lib/Devel/SelfStubber.pm @@ -4,7 +4,7 @@ require SelfLoader; @ISA = qw(SelfLoader); @EXPORT = 'AUTOLOAD'; $JUST_STUBS = 1; -$VERSION = 1.05; +$VERSION = 1.06; sub Version {$VERSION} # Use as @@ -39,7 +39,7 @@ sub stub { my (@BEFORE_DATA, @AFTER_DATA, @AFTER_END); @DATA = @STUBS = (); - open($fh,$mod_file) || die "Unable to open $mod_file"; + open($fh,'<',$mod_file) || die "Unable to open $mod_file"; local $/ = "\n"; while(defined ($line = <$fh>) and $line !~ m/^__DATA__/) { push(@BEFORE_DATA,$line); diff --git a/dist/Devel-SelfStubber/t/Devel-SelfStubber.t b/dist/Devel-SelfStubber/t/Devel-SelfStubber.t index 4d69090..48e27cd 100644 --- a/dist/Devel-SelfStubber/t/Devel-SelfStubber.t +++ b/dist/Devel-SelfStubber/t/Devel-SelfStubber.t @@ -30,7 +30,7 @@ while () { my $f = $1; my $file = catfile(curdir(),$inlib,$f); push @cleanup, $file; - open FH, ">$file" or die $!; + open FH, '>', $file or die $!; } else { print FH; } @@ -40,14 +40,14 @@ close FH; { my $file = "A-$$"; push @cleanup, $file; - open FH, ">$file" or die $!; + open FH, '>', $file or die $!; select FH; Devel::SelfStubber->stub('xChild', $inlib); select STDOUT; print "ok 1\n"; close FH or die $!; - open FH, $file or die $!; + open FH, '<', $file or die $!; my @A = ; if (@A == 1 && $A[0] =~ /^\s*sub\s+xChild::foo\s*;\s*$/) { @@ -61,14 +61,14 @@ close FH; { my $file = "B-$$"; push @cleanup, $file; - open FH, ">$file" or die $!; + open FH, '>', $file or die $!; select FH; Devel::SelfStubber->stub('Proto', $inlib); select STDOUT; print "ok 3\n"; # Checking that we did not die horribly. close FH or die $!; - open FH, $file or die $!; + open FH, '<', $file or die $!; my @B = ; if (@B == 1 && $B[0] =~ /^\s*sub\s+Proto::bar\s*\(\$\$\);\s*$/) { @@ -84,14 +84,14 @@ close FH; { my $file = "C-$$"; push @cleanup, $file; - open FH, ">$file" or die $!; + open FH, '>', $file or die $!; select FH; Devel::SelfStubber->stub('Attribs', $inlib); select STDOUT; print "ok 5\n"; # Checking that we did not die horribly. close FH or die $!; - open FH, $file or die $!; + open FH, '<', $file or die $!; my @C = ; if (@C == 2 && $C[0] =~ /^\s*sub\s+Attribs::baz\s+:\s*locked\s*;\s*$/ @@ -137,7 +137,7 @@ sub faildump { foreach my $module (@module) { my $file = "$module--$$"; push @cleanup, $file; - open FH, ">$file" or die $!; + open FH, '>', $file or die $!; print FH "use $module; print ${module}->foo; "; @@ -168,11 +168,11 @@ undef $/; foreach my $module (@module, 'Data', 'End') { my $file = catfile(curdir(),$lib,"$module.pm"); my $fileo = catfile(curdir(),$inlib,"$module.pm"); - open FH, $fileo or die "Can't open $fileo: $!"; + open FH, '<', $fileo or die "Can't open $fileo: $!"; my $contents = ; close FH or die $!; push @cleanup, $file; - open FH, ">$file" or die $!; + open FH, '>', $file or die $!; select FH; if ($contents =~ /__DATA__/) { # This will die for any module with no __DATA__ @@ -208,7 +208,7 @@ system "$runperl -w \"-I$lib\" \"-MData\" -e \"Data::ok\""; system "$runperl -w \"-I$lib\" \"-MEnd\" -e \"End::lime\""; # But check that the documentation after the __END__ survived. -open FH, catfile(curdir(),$lib,"End.pm") or die $!; +open FH, '<', catfile(curdir(),$lib,"End.pm") or die $!; $_ = ; close FH or die $!; diff --git a/dist/Dumpvalue/t/Dumpvalue.t b/dist/Dumpvalue/t/Dumpvalue.t index 8e9da19..64cf52e 100644 --- a/dist/Dumpvalue/t/Dumpvalue.t +++ b/dist/Dumpvalue/t/Dumpvalue.t @@ -189,7 +189,7 @@ is( $out->read, "\%baz = (\n 'one' => 1, 'two' => 2\n)\n", 'dumped glob for %baz fine' ); SKIP: { - skip( "Couldn't open $0 for reading", 1 ) unless open(FILE, $0); + skip( "Couldn't open $0 for reading", 1 ) unless open(FILE, '<', $0); my $fileno = fileno(FILE); $d->dumpglob( '', 0, 'FILE', *FILE ); is( $out->read, "FileHandle(FILE) => fileno($fileno)\n", diff --git a/dist/ExtUtils-CBuilder/t/01-basic.t b/dist/ExtUtils-CBuilder/t/01-basic.t index b99382f..3db8581 100644 --- a/dist/ExtUtils-CBuilder/t/01-basic.t +++ b/dist/ExtUtils-CBuilder/t/01-basic.t @@ -33,7 +33,7 @@ ok $b->have_compiler, "have_compiler"; $source_file = File::Spec->catfile('t', 'basict.c'); { local *FH; - open FH, "> $source_file" or die "Can't create $source_file: $!"; + open FH, '>', $source_file or die "Can't create $source_file: $!"; print FH "int boot_basict(void) { return 1; }\n"; close FH; } diff --git a/dist/ExtUtils-CBuilder/t/02-link.t b/dist/ExtUtils-CBuilder/t/02-link.t index 0c64619..6160c26 100644 --- a/dist/ExtUtils-CBuilder/t/02-link.t +++ b/dist/ExtUtils-CBuilder/t/02-link.t @@ -33,7 +33,7 @@ ok $b, "created EU::CB object"; $source_file = File::Spec->catfile('t', 'linkt.c'); { - open my $FH, "> $source_file" or die "Can't create $source_file: $!"; + open my $FH, '>', $source_file or die "Can't create $source_file: $!"; print $FH "int main(void) { return 11; }\n"; close $FH; } diff --git a/dist/ExtUtils-CBuilder/t/03-cplusplus.t b/dist/ExtUtils-CBuilder/t/03-cplusplus.t index 78290d3..0c05ae2 100644 --- a/dist/ExtUtils-CBuilder/t/03-cplusplus.t +++ b/dist/ExtUtils-CBuilder/t/03-cplusplus.t @@ -32,7 +32,7 @@ ok $b->have_cplusplus, "have_cplusplus"; $source_file = File::Spec->catfile('t', 'cplust.cc'); { - open my $FH, "> $source_file" or die "Can't create $source_file: $!"; + open my $FH, '>', $source_file or die "Can't create $source_file: $!"; print $FH "class Bogus { public: int boot_cplust() { return 1; } };\n"; close $FH; } diff --git a/dist/I18N-LangTags/lib/I18N/LangTags.pm b/dist/I18N-LangTags/lib/I18N/LangTags.pm index 2193208..c4d9cea 100644 --- a/dist/I18N-LangTags/lib/I18N/LangTags.pm +++ b/dist/I18N-LangTags/lib/I18N/LangTags.pm @@ -19,7 +19,7 @@ require Exporter; ); %EXPORT_TAGS = ('ALL' => \@EXPORT_OK); -$VERSION = "0.41"; +$VERSION = "0.42"; sub uniq { my %seen; return grep(!($seen{$_}++), @_); } # a util function @@ -460,7 +460,7 @@ interaction looks like: So far so good. But suppose the way you're implementing this is: my %greetings; - die unless open(IN, ") { chomp; next unless /^([^=]+)=(.+)/s; @@ -502,7 +502,7 @@ program with: use I18N::LangTags qw(encode_language_tag); my %greetings; - die unless open(IN, ") { chomp; next unless /^([^=]+)=(.+)/s; diff --git a/dist/IO/Makefile.PL b/dist/IO/Makefile.PL index 7783cf9..383eccb 100644 --- a/dist/IO/Makefile.PL +++ b/dist/IO/Makefile.PL @@ -20,7 +20,7 @@ unless ($PERL_CORE or exists $Config{'i_poll'}) { } if ($] < 5.008 and !$PERL_CORE) { - open(FH,">typemap"); + open(FH,'>','typemap'); print FH "const char * T_PV\n"; close(FH); } diff --git a/dist/IO/t/IO.t b/dist/IO/t/IO.t index 2551b24..247940f 100644 --- a/dist/IO/t/IO.t +++ b/dist/IO/t/IO.t @@ -93,7 +93,7 @@ my $fakemod = File::Spec->catfile( $fakedir, 'fakemod.pm' ); my $flag; if ( -d $fakedir or mkpath( $fakedir )) { - if (open( OUT, ">$fakemod")) + if (open( OUT, '>', $fakemod )) { (my $package = <<' END_HERE') =~ tr/\t//d; package IO::fakemod; diff --git a/dist/IO/t/io_dir.t b/dist/IO/t/io_dir.t index 5472daa..dc8eb43 100644 --- a/dist/IO/t/io_dir.t +++ b/dist/IO/t/io_dir.t @@ -42,7 +42,7 @@ ok(!$dot->rewind, "rewind on closed"); ok(!defined($dot->read)); } -open(FH,'>X') || die "Can't create x"; +open(FH,'>','X') || die "Can't create x"; print FH "X"; close(FH) or die "Can't close: $!"; diff --git a/dist/IO/t/io_file.t b/dist/IO/t/io_file.t index 1cf60f5..a3d79c9 100644 --- a/dist/IO/t/io_file.t +++ b/dist/IO/t/io_file.t @@ -16,7 +16,7 @@ can_ok( $Class, "binmode" ); ### use standard open to make sure we can compare binmodes ### on both. { my $tmp; - open $tmp, ">$File" or die "Could not open '$File': $!"; + open $tmp, '>', $File or die "Could not open '$File': $!"; binmode $tmp; print $tmp $All_Chars; close $tmp; diff --git a/dist/IO/t/io_linenum.t b/dist/IO/t/io_linenum.t index 2d44f50..734854b 100644 --- a/dist/IO/t/io_linenum.t +++ b/dist/IO/t/io_linenum.t @@ -26,7 +26,7 @@ sub lineno my $t; -open (F, $File) or die $!; +open (F, '<', $File) or die $!; my $io = IO::File->new($File) or die $!; for (1 .. 10); diff --git a/dist/IO/t/io_sock.t b/dist/IO/t/io_sock.t index c9c443b..630b856 100644 --- a/dist/IO/t/io_sock.t +++ b/dist/IO/t/io_sock.t @@ -214,7 +214,7 @@ if ( $^O eq 'qnx' ) { ### the client. We'll use own source code ... # local @data; -if( !open( SRC, "< $0")) { +if( !open( SRC, '<', $0)) { print "not ok 15 - $!\n"; } else { @data = ; diff --git a/dist/IO/t/io_unix.t b/dist/IO/t/io_unix.t index 61ba363..a6cd05c 100644 --- a/dist/IO/t/io_unix.t +++ b/dist/IO/t/io_unix.t @@ -39,7 +39,7 @@ if ($^O eq 'os2') { # Can't create sockets with relative path... } # Test if we can create the file within the tmp directory -if (-e $PATH or not open(TEST, ">$PATH") and $^O ne 'os2') { +if (-e $PATH or not open(TEST, '>', $PATH) and $^O ne 'os2') { print "1..0 # Skip: cannot open '$PATH' for write\n"; exit 0; } diff --git a/dist/Module-CoreList/Changes b/dist/Module-CoreList/Changes index c739a07..18726a3 100644 --- a/dist/Module-CoreList/Changes +++ b/dist/Module-CoreList/Changes @@ -1,3 +1,12 @@ +5.20170120 + - Updated for v5.25.9 + +5.20170114_24 + - Updated for v5.24.1 + +5.20170114_22 + - Updated for v5.22.3 + 5.20161220 - Updated for v5.25.8 diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index f61914f..2d8b2a4 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -3,20 +3,17 @@ use strict; use vars qw/$VERSION %released %version %families %upstream %bug_tracker %deprecated %delta/; use version; -$VERSION = '5.20161220'; +$VERSION = '5.20170120'; sub _undelta { my ($delta) = @_; - my %expanded; - for my $version (sort { $a cmp $b } keys %$delta) { - my $data = $delta->{$version}; - my $from = $data->{delta_from}; - my %full = ( - ( $from ? %{$expanded{$from}} : () ), - %{$data->{changed} || {}}, - ); - delete @full{ keys %{$data->{removed}} }; - $expanded{$version} = \%full; + my (%expanded, $delta_from, $base, $changed, $removed); + for my $v (sort keys %$delta) { + ($delta_from, $changed, $removed) = @{$delta->{$v}}{qw( delta_from changed removed )}; + $base = $delta_from ? $expanded{$delta_from} : {}; + my %full = ( %$base, %{$changed || {}} ); + delete @full{ keys %$removed }; + $expanded{$v} = \%full; } return %expanded; } @@ -317,6 +314,9 @@ sub changes_between { 5.025006 => '2016-10-20', 5.025007 => '2016-11-20', 5.025008 => '2016-12-20', + 5.022003 => '2017-01-14', + 5.024001 => '2017-01-14', + 5.025009 => '2017-01-20', ); for my $version ( sort { $a <=> $b } keys %released ) { @@ -13534,6 +13534,397 @@ for my $version ( sort { $a <=> $b } keys %released ) { removed => { } }, + 5.022003 => { + delta_from => 5.022002, + changed => { + 'App::Cpan' => '1.63_01', + 'App::Prove' => '3.35_01', + 'App::Prove::State' => '3.35_01', + 'App::Prove::State::Result'=> '3.35_01', + 'App::Prove::State::Result::Test'=> '3.35_01', + 'Archive::Tar' => '2.04_01', + 'Archive::Tar::Constant'=> '2.04_01', + 'Archive::Tar::File' => '2.04_01', + 'B::Op_private' => '5.022003', + 'CPAN' => '2.11_01', + 'Compress::Zlib' => '2.068_001', + 'Config' => '5.022003', + 'Cwd' => '3.56_02', + 'Digest' => '1.17_01', + 'Digest::SHA' => '5.95_01', + 'Encode' => '2.72_01', + 'ExtUtils::Command' => '1.20_01', + 'ExtUtils::Command::MM' => '7.04_02', + 'ExtUtils::Liblist' => '7.04_02', + 'ExtUtils::Liblist::Kid'=> '7.04_02', + 'ExtUtils::MM' => '7.04_02', + 'ExtUtils::MM_AIX' => '7.04_02', + 'ExtUtils::MM_Any' => '7.04_02', + 'ExtUtils::MM_BeOS' => '7.04_02', + 'ExtUtils::MM_Cygwin' => '7.04_02', + 'ExtUtils::MM_DOS' => '7.04_02', + 'ExtUtils::MM_Darwin' => '7.04_02', + 'ExtUtils::MM_MacOS' => '7.04_02', + 'ExtUtils::MM_NW5' => '7.04_02', + 'ExtUtils::MM_OS2' => '7.04_02', + 'ExtUtils::MM_QNX' => '7.04_02', + 'ExtUtils::MM_UWIN' => '7.04_02', + 'ExtUtils::MM_Unix' => '7.04_02', + 'ExtUtils::MM_VMS' => '7.04_02', + 'ExtUtils::MM_VOS' => '7.04_02', + 'ExtUtils::MM_Win32' => '7.04_02', + 'ExtUtils::MM_Win95' => '7.04_02', + 'ExtUtils::MY' => '7.04_02', + 'ExtUtils::MakeMaker' => '7.04_02', + 'ExtUtils::MakeMaker::Config'=> '7.04_02', + 'ExtUtils::Mkbootstrap' => '7.04_02', + 'ExtUtils::Mksymlists' => '7.04_02', + 'ExtUtils::testlib' => '7.04_02', + 'File::Fetch' => '0.48_01', + 'File::Spec' => '3.56_02', + 'File::Spec::Cygwin' => '3.56_02', + 'File::Spec::Epoc' => '3.56_02', + 'File::Spec::Functions' => '3.56_02', + 'File::Spec::Mac' => '3.56_02', + 'File::Spec::OS2' => '3.56_02', + 'File::Spec::Unix' => '3.56_02', + 'File::Spec::VMS' => '3.56_02', + 'File::Spec::Win32' => '3.56_02', + 'HTTP::Tiny' => '0.054_01', + 'I18N::LangTags::Detect'=> '1.05_01', + 'IO' => '1.35_01', + 'IO::Compress::Adapter::Bzip2'=> '2.068_001', + 'IO::Compress::Adapter::Deflate'=> '2.068_001', + 'IO::Compress::Adapter::Identity'=> '2.068_001', + 'IO::Compress::Base' => '2.068_001', + 'IO::Compress::Base::Common'=> '2.068_001', + 'IO::Compress::Bzip2' => '2.068_001', + 'IO::Compress::Deflate' => '2.068_001', + 'IO::Compress::Gzip' => '2.068_001', + 'IO::Compress::Gzip::Constants'=> '2.068_001', + 'IO::Compress::RawDeflate'=> '2.068_001', + 'IO::Compress::Zip' => '2.068_001', + 'IO::Compress::Zip::Constants'=> '2.068_001', + 'IO::Compress::Zlib::Constants'=> '2.068_001', + 'IO::Compress::Zlib::Extra'=> '2.068_001', + 'IO::Uncompress::Adapter::Bunzip2'=> '2.068_001', + 'IO::Uncompress::Adapter::Identity'=> '2.068_001', + 'IO::Uncompress::Adapter::Inflate'=> '2.068_001', + 'IO::Uncompress::AnyInflate'=> '2.068_001', + 'IO::Uncompress::AnyUncompress'=> '2.068_001', + 'IO::Uncompress::Base' => '2.068_001', + 'IO::Uncompress::Bunzip2'=> '2.068_001', + 'IO::Uncompress::Gunzip'=> '2.068_001', + 'IO::Uncompress::Inflate'=> '2.068_001', + 'IO::Uncompress::RawInflate'=> '2.068_001', + 'IO::Uncompress::Unzip' => '2.068_001', + 'IPC::Cmd' => '0.92_01', + 'JSON::PP' => '2.27300_01', + 'Locale::Maketext' => '1.26_01', + 'Locale::Maketext::Simple'=> '0.21_01', + 'Memoize' => '1.03_01', + 'Module::CoreList' => '5.20170114_22', + 'Module::CoreList::TieHashDelta'=> '5.20170114_22', + 'Module::CoreList::Utils'=> '5.20170114_22', + 'Module::Metadata::corpus::BOMTest::UTF16BE'=> undef, + 'Module::Metadata::corpus::BOMTest::UTF16LE'=> undef, + 'Module::Metadata::corpus::BOMTest::UTF8'=> '1', + 'Net::Cmd' => '3.05_01', + 'Net::Config' => '3.05_01', + 'Net::Domain' => '3.05_01', + 'Net::FTP' => '3.05_01', + 'Net::FTP::A' => '3.05_01', + 'Net::FTP::E' => '3.05_01', + 'Net::FTP::I' => '3.05_01', + 'Net::FTP::L' => '3.05_01', + 'Net::FTP::dataconn' => '3.05_01', + 'Net::NNTP' => '3.05_01', + 'Net::Netrc' => '3.05_01', + 'Net::POP3' => '3.05_01', + 'Net::Ping' => '2.43_01', + 'Net::SMTP' => '3.05_01', + 'Net::Time' => '3.05_01', + 'Parse::CPAN::Meta' => '1.4414_001', + 'Pod::Html' => '1.2201', + 'Pod::Perldoc' => '3.25_01', + 'Storable' => '2.53_02', + 'Sys::Syslog' => '0.33_01', + 'TAP::Base' => '3.35_01', + 'TAP::Formatter::Base' => '3.35_01', + 'TAP::Formatter::Color' => '3.35_01', + 'TAP::Formatter::Console'=> '3.35_01', + 'TAP::Formatter::Console::ParallelSession'=> '3.35_01', + 'TAP::Formatter::Console::Session'=> '3.35_01', + 'TAP::Formatter::File' => '3.35_01', + 'TAP::Formatter::File::Session'=> '3.35_01', + 'TAP::Formatter::Session'=> '3.35_01', + 'TAP::Harness' => '3.35_01', + 'TAP::Harness::Env' => '3.35_01', + 'TAP::Object' => '3.35_01', + 'TAP::Parser' => '3.35_01', + 'TAP::Parser::Aggregator'=> '3.35_01', + 'TAP::Parser::Grammar' => '3.35_01', + 'TAP::Parser::Iterator' => '3.35_01', + 'TAP::Parser::Iterator::Array'=> '3.35_01', + 'TAP::Parser::Iterator::Process'=> '3.35_01', + 'TAP::Parser::Iterator::Stream'=> '3.35_01', + 'TAP::Parser::IteratorFactory'=> '3.35_01', + 'TAP::Parser::Multiplexer'=> '3.35_01', + 'TAP::Parser::Result' => '3.35_01', + 'TAP::Parser::Result::Bailout'=> '3.35_01', + 'TAP::Parser::Result::Comment'=> '3.35_01', + 'TAP::Parser::Result::Plan'=> '3.35_01', + 'TAP::Parser::Result::Pragma'=> '3.35_01', + 'TAP::Parser::Result::Test'=> '3.35_01', + 'TAP::Parser::Result::Unknown'=> '3.35_01', + 'TAP::Parser::Result::Version'=> '3.35_01', + 'TAP::Parser::Result::YAML'=> '3.35_01', + 'TAP::Parser::ResultFactory'=> '3.35_01', + 'TAP::Parser::Scheduler'=> '3.35_01', + 'TAP::Parser::Scheduler::Job'=> '3.35_01', + 'TAP::Parser::Scheduler::Spinner'=> '3.35_01', + 'TAP::Parser::Source' => '3.35_01', + 'TAP::Parser::SourceHandler'=> '3.35_01', + 'TAP::Parser::SourceHandler::Executable'=> '3.35_01', + 'TAP::Parser::SourceHandler::File'=> '3.35_01', + 'TAP::Parser::SourceHandler::Handle'=> '3.35_01', + 'TAP::Parser::SourceHandler::Perl'=> '3.35_01', + 'TAP::Parser::SourceHandler::RawTAP'=> '3.35_01', + 'TAP::Parser::YAMLish::Reader'=> '3.35_01', + 'TAP::Parser::YAMLish::Writer'=> '3.35_01', + 'Test' => '1.26_01', + 'Test::Harness' => '3.35_01', + 'XSLoader' => '0.20_01', + 'bigint' => '0.39_01', + 'bignum' => '0.39_01', + 'bigrat' => '0.39_01', + }, + removed => { + } + }, + 5.024001 => { + delta_from => 5.024000, + changed => { + 'App::Cpan' => '1.63_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.04_01', + 'Archive::Tar::Constant'=> '2.04_01', + 'Archive::Tar::File' => '2.04_01', + 'B::Op_private' => '5.024001', + 'CPAN' => '2.11_01', + 'Compress::Zlib' => '2.069_001', + 'Config' => '5.024001', + 'Cwd' => '3.63_01', + 'Digest' => '1.17_01', + 'Digest::SHA' => '5.95_01', + 'Encode' => '2.80_01', + 'ExtUtils::Command' => '7.10_02', + 'ExtUtils::Command::MM' => '7.10_02', + 'ExtUtils::Liblist' => '7.10_02', + 'ExtUtils::Liblist::Kid'=> '7.10_02', + 'ExtUtils::MM' => '7.10_02', + 'ExtUtils::MM_AIX' => '7.10_02', + 'ExtUtils::MM_Any' => '7.10_02', + 'ExtUtils::MM_BeOS' => '7.10_02', + 'ExtUtils::MM_Cygwin' => '7.10_02', + 'ExtUtils::MM_DOS' => '7.10_02', + 'ExtUtils::MM_Darwin' => '7.10_02', + 'ExtUtils::MM_MacOS' => '7.10_02', + 'ExtUtils::MM_NW5' => '7.10_02', + 'ExtUtils::MM_OS2' => '7.10_02', + 'ExtUtils::MM_QNX' => '7.10_02', + 'ExtUtils::MM_UWIN' => '7.10_02', + 'ExtUtils::MM_Unix' => '7.10_02', + 'ExtUtils::MM_VMS' => '7.10_02', + 'ExtUtils::MM_VOS' => '7.10_02', + 'ExtUtils::MM_Win32' => '7.10_02', + 'ExtUtils::MM_Win95' => '7.10_02', + 'ExtUtils::MY' => '7.10_02', + 'ExtUtils::MakeMaker' => '7.10_02', + 'ExtUtils::MakeMaker::Config'=> '7.10_02', + 'ExtUtils::Mkbootstrap' => '7.10_02', + 'ExtUtils::Mksymlists' => '7.10_02', + 'ExtUtils::testlib' => '7.10_02', + 'File::Fetch' => '0.48_01', + 'File::Spec' => '3.63_01', + 'File::Spec::Cygwin' => '3.63_01', + 'File::Spec::Epoc' => '3.63_01', + 'File::Spec::Functions' => '3.63_01', + 'File::Spec::Mac' => '3.63_01', + 'File::Spec::OS2' => '3.63_01', + 'File::Spec::Unix' => '3.63_01', + 'File::Spec::VMS' => '3.63_01', + 'File::Spec::Win32' => '3.63_01', + 'HTTP::Tiny' => '0.056_001', + 'I18N::LangTags::Detect'=> '1.05_01', + 'IO' => '1.36_01', + 'IO::Compress::Adapter::Bzip2'=> '2.069_001', + 'IO::Compress::Adapter::Deflate'=> '2.069_001', + 'IO::Compress::Adapter::Identity'=> '2.069_001', + 'IO::Compress::Base' => '2.069_001', + 'IO::Compress::Base::Common'=> '2.069_001', + 'IO::Compress::Bzip2' => '2.069_001', + 'IO::Compress::Deflate' => '2.069_001', + 'IO::Compress::Gzip' => '2.069_001', + 'IO::Compress::Gzip::Constants'=> '2.069_001', + 'IO::Compress::RawDeflate'=> '2.069_001', + 'IO::Compress::Zip' => '2.069_001', + 'IO::Compress::Zip::Constants'=> '2.069_001', + 'IO::Compress::Zlib::Constants'=> '2.069_001', + 'IO::Compress::Zlib::Extra'=> '2.069_001', + 'IO::Uncompress::Adapter::Bunzip2'=> '2.069_001', + 'IO::Uncompress::Adapter::Identity'=> '2.069_001', + 'IO::Uncompress::Adapter::Inflate'=> '2.069_001', + 'IO::Uncompress::AnyInflate'=> '2.069_001', + 'IO::Uncompress::AnyUncompress'=> '2.069_001', + 'IO::Uncompress::Base' => '2.069_001', + 'IO::Uncompress::Bunzip2'=> '2.069_001', + 'IO::Uncompress::Gunzip'=> '2.069_001', + 'IO::Uncompress::Inflate'=> '2.069_001', + 'IO::Uncompress::RawInflate'=> '2.069_001', + 'IO::Uncompress::Unzip' => '2.069_001', + 'IPC::Cmd' => '0.92_01', + 'JSON::PP' => '2.27300_01', + 'Locale::Maketext' => '1.26_01', + 'Locale::Maketext::Simple'=> '0.21_01', + 'Math::BigFloat::Trace' => '0.42_01', + 'Math::BigInt::Trace' => '0.42_01', + 'Memoize' => '1.03_01', + 'Module::CoreList' => '5.20170114_24', + 'Module::CoreList::TieHashDelta'=> '5.20170114_24', + 'Module::CoreList::Utils'=> '5.20170114_24', + 'Module::Metadata::corpus::BOMTest::UTF16BE'=> undef, + 'Module::Metadata::corpus::BOMTest::UTF16LE'=> undef, + 'Module::Metadata::corpus::BOMTest::UTF8'=> '1', + 'Net::Cmd' => '3.08_01', + 'Net::Config' => '3.08_01', + 'Net::Domain' => '3.08_01', + 'Net::FTP' => '3.08_01', + 'Net::FTP::A' => '3.08_01', + 'Net::FTP::E' => '3.08_01', + 'Net::FTP::I' => '3.08_01', + 'Net::FTP::L' => '3.08_01', + 'Net::FTP::dataconn' => '3.08_01', + 'Net::NNTP' => '3.08_01', + 'Net::Netrc' => '3.08_01', + 'Net::POP3' => '3.08_01', + 'Net::Ping' => '2.43_01', + 'Net::SMTP' => '3.08_01', + 'Net::Time' => '3.08_01', + 'Parse::CPAN::Meta' => '1.4417_001', + 'Pod::Html' => '1.2201', + 'Pod::Perldoc' => '3.25_03', + 'Storable' => '2.56_01', + 'Sys::Syslog' => '0.33_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.28_01', + 'Test::Harness' => '3.36_01', + 'XSLoader' => '0.22', + 'bigint' => '0.42_01', + 'bignum' => '0.42_01', + 'bigrat' => '0.42_01', + }, + removed => { + } + }, + 5.025009 => { + delta_from => 5.025008, + changed => { + 'App::Cpan' => '1.66', + 'B::Deparse' => '1.40', + 'B::Op_private' => '5.025009', + 'B::Terse' => '1.07', + 'B::Xref' => '1.06', + 'CPAN' => '2.16', + 'CPAN::Bundle' => '5.5002', + 'CPAN::Distribution' => '2.16', + 'CPAN::Exception::RecursiveDependency'=> '5.5001', + 'CPAN::FTP' => '5.5008', + 'CPAN::FirstTime' => '5.5310', + 'CPAN::HandleConfig' => '5.5008', + 'CPAN::Module' => '5.5003', + 'Compress::Raw::Bzip2' => '2.070', + 'Compress::Raw::Zlib' => '2.070', + 'Config' => '5.025009', + 'DB_File' => '1.840', + 'Data::Dumper' => '2.167', + 'Devel::SelfStubber' => '1.06', + 'DynaLoader' => '1.41', + 'Errno' => '1.28', + 'ExtUtils::Embed' => '1.34', + 'File::Glob' => '1.28', + 'I18N::LangTags' => '0.42', + 'Module::CoreList' => '5.20170120', + 'Module::CoreList::TieHashDelta'=> '5.20170120', + 'Module::CoreList::Utils'=> '5.20170120', + 'OS2::Process' => '1.12', + 'PerlIO::scalar' => '0.26', + 'Pod::Html' => '1.2202', + 'Storable' => '2.61', + 'Symbol' => '1.08', + 'Term::ReadLine' => '1.16', + 'Test' => '1.30', + 'Unicode::UCD' => '0.68', + 'VMS::DCLsym' => '1.08', + 'XS::APItest' => '0.88', + 'XSLoader' => '0.26', + 'attributes' => '0.29', + 'diagnostics' => '1.36', + 'feature' => '1.46', + 'lib' => '0.64', + 'overload' => '1.28', + 're' => '0.34', + 'threads' => '2.12', + 'threads::shared' => '1.54', + }, + removed => { + } + }, ); sub is_core @@ -14244,6 +14635,27 @@ sub is_core removed => { } }, + 5.022003 => { + delta_from => 5.022002, + changed => { + }, + removed => { + } + }, + 5.024001 => { + delta_from => 5.024000, + changed => { + }, + removed => { + } + }, + 5.025009 => { + delta_from => 5.025008, + changed => { + }, + removed => { + } + }, ); %deprecated = _undelta(\%deprecated); diff --git a/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm b/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm index 79e344c..b088512 100644 --- a/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm +++ b/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm @@ -3,7 +3,7 @@ package Module::CoreList::TieHashDelta; use strict; use vars qw($VERSION); -$VERSION = '5.20161220'; +$VERSION = '5.20170120'; sub TIEHASH { my ($class, $changed, $removed, $parent) = @_; diff --git a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm index 94dac5e..4cfbd5f 100644 --- a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm +++ b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm @@ -5,7 +5,7 @@ use warnings; use vars qw[$VERSION %utilities]; use Module::CoreList; -$VERSION = '5.20161220'; +$VERSION = '5.20170120'; sub utilities { my $perl = shift; @@ -1212,6 +1212,29 @@ my %delta = ( removed => { } }, + 5.022003 => { + delta_from => 5.022002, + changed => { + }, + removed => { + } + }, + 5.024001 => { + delta_from => 5.024000, + changed => { + }, + removed => { + } + }, + 5.025009 => { + delta_from => 5.025008, + changed => { + }, + removed => { + 'c2ph' => 1, + 'pstruct' => 1, + } + }, ); %utilities = Module::CoreList::_undelta(\%delta); diff --git a/dist/Safe/t/safe2.t b/dist/Safe/t/safe2.t index fc519ff..b3f2dac 100644 --- a/dist/Safe/t/safe2.t +++ b/dist/Safe/t/safe2.t @@ -131,7 +131,7 @@ like($@, qr/foo bar/); $! = 0; my $nosuch = '/non/existent/file.name'; -open(NOSUCH, $nosuch); +open(NOSUCH, '<', $nosuch); if ($@) { my $errno = $!; die "Eek! Attempting to open $nosuch failed, but \$! is still 0" unless $!; diff --git a/dist/Safe/t/safeops.t b/dist/Safe/t/safeops.t index 9094a00..0b696a8 100644 --- a/dist/Safe/t/safeops.t +++ b/dist/Safe/t/safeops.t @@ -286,7 +286,7 @@ return return last last next next redo redo THIS -dump dump +dump CORE::dump goto goto THERE exit exit 0 open open FOO diff --git a/dist/Search-Dict/t/Dict.t b/dist/Search-Dict/t/Dict.t index bc997b0..21b226e 100644 --- a/dist/Search-Dict/t/Dict.t +++ b/dist/Search-Dict/t/Dict.t @@ -38,7 +38,7 @@ EOT use Tie::Handle; # loads Tie::StdHandle use Search::Dict; -open(DICT, "+>dict-$$") or die "Can't create dict-$$: $!"; +open(DICT, '+>', "dict-$$") or die "Can't create dict-$$: $!"; binmode DICT; # To make length expected one. print DICT $DICT; diff --git a/dist/Storable/Storable.pm b/dist/Storable/Storable.pm index 7101641..397d584 100644 --- a/dist/Storable/Storable.pm +++ b/dist/Storable/Storable.pm @@ -22,7 +22,7 @@ package Storable; @ISA = qw(Exporter); use vars qw($canonical $forgive_me $VERSION); -$VERSION = '2.59'; +$VERSION = '2.61'; BEGIN { if (eval { @@ -119,7 +119,7 @@ sub file_magic { my $file = shift; my $fh = IO::File->new; - open($fh, "<". $file) || die "Can't open '$file': $!"; + open($fh, "<", $file) || die "Can't open '$file': $!"; binmode($fh); defined(sysread($fh, my $buf, 32)) || die "Can't read from '$file': $!"; close($fh); @@ -245,7 +245,7 @@ sub _store { logcroak "wrong argument number" unless @_ == 2; # No @foo in arglist local *FILE; if ($use_locking) { - open(FILE, ">>$file") || logcroak "can't write into $file: $!"; + open(FILE, '>>', $file) || logcroak "can't write into $file: $!"; unless (&CAN_FLOCK) { logcarp "Storable::lock_store: fcntl/flock emulation broken on $^O"; @@ -256,7 +256,7 @@ sub _store { truncate FILE, 0; # Unlocking will happen when FILE is closed } else { - open(FILE, ">$file") || logcroak "can't create $file: $!"; + open(FILE, '>', $file) || logcroak "can't create $file: $!"; } binmode FILE; # Archaic systems... my $da = $@; # Don't mess if called from exception handler @@ -373,7 +373,7 @@ sub lock_retrieve { sub _retrieve { my ($file, $use_locking) = @_; local *FILE; - open(FILE, $file) || logcroak "can't open $file: $!"; + open(FILE, '<', $file) || logcroak "can't open $file: $!"; binmode FILE; # Archaic systems... my $self; my $da = $@; # Could be from exception handler diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs index 3788f57..a72d84c 100644 --- a/dist/Storable/Storable.xs +++ b/dist/Storable/Storable.xs @@ -5660,6 +5660,10 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname) CROAK(("Unexpected type %d in retrieve_code\n", type)); } + if (!text) { + CROAK(("Unable to retrieve code\n")); + } + /* * prepend "sub " to the source */ @@ -5780,7 +5784,7 @@ static SV *old_retrieve_array(pTHX_ stcxt_t *cxt, const char *cname) continue; /* av_extend() already filled us with undef */ } if (c != SX_ITEM) - (void) retrieve_other(aTHX_ (stcxt_t *) 0, 0); /* Will croak out */ + (void) retrieve_other(aTHX_ cxt, 0); /* Will croak out */ TRACEME(("(#%d) item", i)); sv = retrieve(aTHX_ cxt, 0); /* Retrieve item */ if (!sv) @@ -5857,7 +5861,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname) if (!sv) return (SV *) 0; } else - (void) retrieve_other(aTHX_ (stcxt_t *) 0, 0); /* Will croak out */ + (void) retrieve_other(aTHX_ cxt, 0); /* Will croak out */ /* * Get key. @@ -5868,7 +5872,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname) GETMARK(c); if (c != SX_KEY) - (void) retrieve_other(aTHX_ (stcxt_t *) 0, 0); /* Will croak out */ + (void) retrieve_other(aTHX_ cxt, 0); /* Will croak out */ RLEN(size); /* Get key size */ KBUFCHK((STRLEN)size); /* Grow hash key read pool if needed */ if (size) diff --git a/dist/Storable/t/code.t b/dist/Storable/t/code.t index 7fc40ba..d31e231 100644 --- a/dist/Storable/t/code.t +++ b/dist/Storable/t/code.t @@ -71,7 +71,7 @@ local *FOO; \&dclone, # XS function - sub { open FOO, "/" }, + sub { open FOO, '<', "/" }, ); $Storable::Deparse = 1; @@ -191,7 +191,7 @@ is(prototype($thawed->[4]), prototype($obj[0]->[4])); my $devnull = File::Spec->devnull; open(SAVEERR, ">&STDERR"); - open(STDERR, ">$devnull") or + open(STDERR, '>', $devnull) or ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) ); eval { $freezed = freeze $obj[0]->[0] }; diff --git a/dist/Storable/t/compat01.t b/dist/Storable/t/compat01.t index 2827676..56d7df6 100644 --- a/dist/Storable/t/compat01.t +++ b/dist/Storable/t/compat01.t @@ -33,7 +33,7 @@ my $testno; for my $dump (@dumps) { $testno++; - open(FH, ">$file") || die "Can't create $file: $!"; + open(FH, '>', $file) || die "Can't create $file: $!"; binmode(FH); print FH $dump; close(FH) || die "Can't write $file: $!"; diff --git a/dist/Storable/t/destroy.t b/dist/Storable/t/destroy.t index e9464fb..dcc3600 100644 --- a/dist/Storable/t/destroy.t +++ b/dist/Storable/t/destroy.t @@ -7,7 +7,7 @@ BEGIN { package foo; sub new { return bless {} } DESTROY { - open FH, "$file") || die "Can't create $file: $!"; + open(FH, '>', $file) || die "Can't create $file: $!"; binmode(FH); print FH $data; close(FH) || die "Can't write $file: $!"; diff --git a/dist/Storable/t/forgive.t b/dist/Storable/t/forgive.t index c994211..af7aa1d 100644 --- a/dist/Storable/t/forgive.t +++ b/dist/Storable/t/forgive.t @@ -45,7 +45,7 @@ $Storable::forgive_me=1; my $devnull = File::Spec->devnull; open(SAVEERR, ">&STDERR"); -open(STDERR, ">$devnull") or +open(STDERR, '>', $devnull) or ( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) ); eval {$result = store ($bad , 'store')}; diff --git a/dist/Storable/t/store.t b/dist/Storable/t/store.t index be43299..3a4b9dc 100644 --- a/dist/Storable/t/store.t +++ b/dist/Storable/t/store.t @@ -1,7 +1,7 @@ #!./perl # # Copyright (c) 1995-2000, Raphael Manfredi -# +# # You may redistribute only under the same terms as Perl 5, as specified # in the README file that comes with the distribution. # @@ -19,7 +19,7 @@ sub BEGIN { use Storable qw(store retrieve store_fd nstore_fd fd_retrieve); -use Test::More tests => 21; +use Test::More tests => 24; $a = 'toto'; $b = \$a; @@ -87,5 +87,19 @@ is(&dump($r), &dump(\%a)); eval { $r = fd_retrieve(::OUT); }; isnt($@, ''); +{ + my %test = ( + old_retrieve_array => "\x70\x73\x74\x30\x01\x0a\x02\x02\x02\x02\x00\x3d\x08\x84\x08\x85\x08\x06\x04\x00\x00\x01\x1b", + old_retrieve_hash => "\x70\x73\x74\x30\x01\x0a\x03\x00\xe8\x03\x00\x00\x81\x00\x00\x00\x01\x61", + retrieve_code => "\x70\x73\x74\x30\x05\x0a\x19\xf0\x00\xff\xe8\x03\x1a\x0a\x0e\x01", + ); + + for my $k (sort keys %test) { + open my $fh, '<', \$test{$k}; + eval { Storable::fd_retrieve($fh); }; + is($?, 0, 'RT 130098: no segfault in Storable::fd_retrieve()'); + } +} + close OUT or die "Could not close: $!"; END { 1 while unlink 'store' } diff --git a/dist/Storable/t/testlib.pl b/dist/Storable/t/testlib.pl index 6d885d7..9b07dd4 100644 --- a/dist/Storable/t/testlib.pl +++ b/dist/Storable/t/testlib.pl @@ -12,7 +12,7 @@ use Storable qw (store retrieve freeze thaw nstore nfreeze); sub slurp { my $file = shift; local (*FH, $/); - open FH, "<$file" or die "Can't open '$file': $!"; + open FH, '<', $file or die "Can't open '$file': $!"; binmode FH; my $contents = ; die "Can't read $file: $!" unless defined $contents; @@ -22,7 +22,7 @@ sub slurp { sub store_and_retrieve { my $data = shift; unlink $file or die "Can't unlink '$file': $!"; - open FH, ">$file" or die "Can't open '$file': $!"; + open FH, '>', $file or die "Can't open '$file': $!"; binmode FH; print FH $data or die "Can't print to '$file': $!"; close FH or die "Can't close '$file': $!"; @@ -35,4 +35,4 @@ sub freeze_and_thaw { return eval {thaw $data}; } -$file; +1; diff --git a/dist/Term-ReadLine/lib/Term/ReadLine.pm b/dist/Term-ReadLine/lib/Term/ReadLine.pm index db08947..88d5a75 100644 --- a/dist/Term-ReadLine/lib/Term/ReadLine.pm +++ b/dist/Term-ReadLine/lib/Term/ReadLine.pm @@ -269,9 +269,8 @@ sub new { # the Windows CONIN$ needs GENERIC_WRITE mode to allow # a SetConsoleMode() if we end up using Term::ReadKey - open FIN, ( $^O eq 'MSWin32' && $console eq 'CONIN$' ) ? "+<$console" : - "<$console"; - open FOUT,">$consoleOUT"; + open FIN, (( $^O eq 'MSWin32' && $console eq 'CONIN$' ) ? '+<' : '<' ), $console; + open FOUT,'>', $consoleOUT; #OUT->autoflush(1); # Conflicts with debugger? my $sel = select(FOUT); @@ -320,7 +319,7 @@ sub Features { \%features } package Term::ReadLine; # So late to allow the above code be defined? -our $VERSION = '1.15'; +our $VERSION = '1.16'; my ($which) = exists $ENV{PERL_RL} ? split /\s+/, $ENV{PERL_RL} : undef; if ($which) { diff --git a/dist/Test/lib/Test.pm b/dist/Test/lib/Test.pm index 84db5f3..ce544ff 100644 --- a/dist/Test/lib/Test.pm +++ b/dist/Test/lib/Test.pm @@ -20,7 +20,7 @@ sub _reset_globals { $planned = 0; } -$VERSION = '1.29'; +$VERSION = '1.30'; require Exporter; @ISA=('Exporter'); @@ -199,7 +199,7 @@ sub _read_program { my($file) = shift; return unless defined $file and length $file and -e $file and -f _ and -r _; - open(SOURCEFILE, "<$file") || return; + open(SOURCEFILE, '<', $file) || return; $Program_Lines{$file} = []; close(SOURCEFILE); @@ -346,7 +346,7 @@ If either (or both!) is a subroutine reference, it is run and used as the value for comparing. For example: ok sub { - open(OUT, ">x.dat") || die $!; + open(OUT, '>', 'x.dat') || die $!; print OUT "\x{e000}"; close OUT; my $bytecount = -s 'x.dat'; @@ -540,7 +540,7 @@ sub _diff_complain_external { if (close($got_fh) && close($exp_fh)) { my $diff_cmd = "$diff $exp_filename $got_filename"; print $TESTERR "#\n# $prefix $diff_cmd\n"; - if (open(DIFF, "$diff_cmd |")) { + if (open(DIFF, '-|', $diff_cmd)) { local $_; while () { print $TESTERR "# $prefix $_"; diff --git a/dist/Test/t/mix.t b/dist/Test/t/mix.t index 5298338..12607d7 100644 --- a/dist/Test/t/mix.t +++ b/dist/Test/t/mix.t @@ -6,7 +6,7 @@ use Test qw(:DEFAULT $TESTOUT $TESTERR $ntest); ### seeing the todo tests, otherwise you get people sending in bug reports ### about Test.pm having "UNEXPECTEDLY SUCCEEDED" tests. -open F, ">mix"; +open F, ">", "mix"; $TESTOUT = *F{IO}; $TESTERR = *F{IO}; @@ -31,7 +31,7 @@ $TESTOUT = *STDOUT{IO}; $TESTERR = *STDERR{IO}; $ntest = 1; -open F, "mix"; +open F, "<", "mix"; my $out = join '', ; close F; unlink "mix"; diff --git a/dist/Test/t/onfail.t b/dist/Test/t/onfail.t index 85fe9eb..dd6b83e 100644 --- a/dist/Test/t/onfail.t +++ b/dist/Test/t/onfail.t @@ -10,7 +10,7 @@ $mycnt = 0; my $why = "zero != one"; # sneak in a test that Test::Harness wont see -open J, ">junk"; +open J, ">", "junk"; $TESTOUT = *J{IO}; $TESTERR = *J{IO}; ok(0, 1, $why); diff --git a/dist/Test/t/todo.t b/dist/Test/t/todo.t index 74f9aef..8d3d794 100644 --- a/dist/Test/t/todo.t +++ b/dist/Test/t/todo.t @@ -6,7 +6,7 @@ use Test qw(:DEFAULT $TESTOUT $TESTERR $ntest); ### seeing the todo tests, otherwise you get people sending in bug reports ### about Test.pm having "UNEXPECTEDLY SUCCEEDED" tests. -open F, ">todo"; +open F, ">", "todo"; $TESTOUT = *F{IO}; $TESTERR = *F{IO}; my $tests = 5; @@ -25,7 +25,7 @@ $TESTOUT = *STDOUT{IO}; $TESTERR = *STDERR{IO}; $ntest = 1; -open F, "todo"; +open F, "<", "todo"; my $out = join '', ; close F; unlink "todo"; diff --git a/dist/Tie-File/t/01_gen.t b/dist/Tie-File/t/01_gen.t index 202b09c..e9504d3 100644 --- a/dist/Tie-File/t/01_gen.t +++ b/dist/Tie-File/t/01_gen.t @@ -119,7 +119,7 @@ sub check_contents { my $x = join $:, @c, ''; local *FH = $o->{fh}; seek FH, 0, SEEK_SET; -# my $open = open FH, "< $file"; +# my $open = open FH, "<", $file; my $a; { local $/; $a = } $a = "" unless defined $a; diff --git a/dist/Tie-File/t/02_fetchsize.t b/dist/Tie-File/t/02_fetchsize.t index 12d2b51..146a91a 100644 --- a/dist/Tie-File/t/02_fetchsize.t +++ b/dist/Tie-File/t/02_fetchsize.t @@ -10,7 +10,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/03_longfetch.t b/dist/Tie-File/t/03_longfetch.t index 7d5a388..63dad4f 100644 --- a/dist/Tie-File/t/03_longfetch.t +++ b/dist/Tie-File/t/03_longfetch.t @@ -18,7 +18,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/04_splice.t b/dist/Tie-File/t/04_splice.t index b3880b7..8d23c58 100644 --- a/dist/Tie-File/t/04_splice.t +++ b/dist/Tie-File/t/04_splice.t @@ -222,7 +222,7 @@ check_contents("0$:1$:2$:"); sub init_file { my $data = shift; - open F, "> $file" or die $!; + open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/05_size.t b/dist/Tie-File/t/05_size.t index 44c69f9..72774c8 100644 --- a/dist/Tie-File/t/05_size.t +++ b/dist/Tie-File/t/05_size.t @@ -16,7 +16,7 @@ use Tie::File; print "ok $N\n"; $N++; # 2-3 FETCHSIZE 0-length file -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; close F; $o = tie @a, 'Tie::File', $file; @@ -34,7 +34,7 @@ undef $o; untie @a; my $data = "rec0$:rec1$:rec2$:"; -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/07_rv_splice.t b/dist/Tie-File/t/07_rv_splice.t index e5c09b1..141383a 100644 --- a/dist/Tie-File/t/07_rv_splice.t +++ b/dist/Tie-File/t/07_rv_splice.t @@ -177,7 +177,7 @@ check_result(); sub init_file { my $data = shift; - open F, "> $file" or die $!; + open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/08_ro.t b/dist/Tie-File/t/08_ro.t index 5fd8933..a38e7fa 100644 --- a/dist/Tie-File/t/08_ro.t +++ b/dist/Tie-File/t/08_ro.t @@ -30,7 +30,7 @@ for my $i (0..$#items) { sub init_file { my $data = shift; - open F, "> $file" or die $!; + open F, '>', $file or die $!; binmode F; print F $data; close F; @@ -56,7 +56,7 @@ if (setup_badly_terminated_file(4)) { sub setup_badly_terminated_file { my $NTESTS = shift; - open F, "> $file" or die "Couldn't open $file: $!"; + open F, '>', $file or die "Couldn't open $file: $!"; binmode F; print F $badrec; close F; diff --git a/dist/Tie-File/t/09_gen_rs.t b/dist/Tie-File/t/09_gen_rs.t index e590210..88d8250 100644 --- a/dist/Tie-File/t/09_gen_rs.t +++ b/dist/Tie-File/t/09_gen_rs.t @@ -161,7 +161,7 @@ if (setup_badly_terminated_file(1)) { sub setup_badly_terminated_file { my $NTESTS = shift; - open F, "> $file" or die "Couldn't open $file: $!"; + open F, '>', $file or die "Couldn't open $file: $!"; binmode F; print F $badrec; close F; diff --git a/dist/Tie-File/t/10_splice_rs.t b/dist/Tie-File/t/10_splice_rs.t index 50b8b0a..da981db 100644 --- a/dist/Tie-File/t/10_splice_rs.t +++ b/dist/Tie-File/t/10_splice_rs.t @@ -175,7 +175,7 @@ check_contents(""); sub init_file { my $data = shift; - open F, "> $file" or die $!; + open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/11_rv_splice_rs.t b/dist/Tie-File/t/11_rv_splice_rs.t index ae10538..2fc9f2c 100644 --- a/dist/Tie-File/t/11_rv_splice_rs.t +++ b/dist/Tie-File/t/11_rv_splice_rs.t @@ -154,7 +154,7 @@ check_result(0..3); sub init_file { my $data = shift; - open F, "> $file" or die $!; + open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/12_longfetch_rs.t b/dist/Tie-File/t/12_longfetch_rs.t index 6f1905d..4e5d57b 100644 --- a/dist/Tie-File/t/12_longfetch_rs.t +++ b/dist/Tie-File/t/12_longfetch_rs.t @@ -15,7 +15,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/13_size_rs.t b/dist/Tie-File/t/13_size_rs.t index a2a8d53..b2e534c 100644 --- a/dist/Tie-File/t/13_size_rs.t +++ b/dist/Tie-File/t/13_size_rs.t @@ -17,7 +17,7 @@ use Tie::File; print "ok $N\n"; $N++; # 2-3 FETCHSIZE 0-length file -open F, "> $file" or die $!; +open F, '>', $file or die $!; close F; $o = tie @a, 'Tie::File', $file, recsep => 'blah'; print $o ? "ok $N\n" : "not ok $N\n"; @@ -31,7 +31,7 @@ undef $o; untie @a; # 4-5 FETCHSIZE positive-length file -open F, "> $file" or die $!; +open F, '>', $file or die $!; print F $data; close F; $o = tie @a, 'Tie::File', $file, recsep => 'blah'; diff --git a/dist/Tie-File/t/14_lock.t b/dist/Tie-File/t/14_lock.t index cab4812..c523458 100644 --- a/dist/Tie-File/t/14_lock.t +++ b/dist/Tie-File/t/14_lock.t @@ -29,7 +29,7 @@ use Tie::File; print "ok $N\n"; $N++; # 2-4 Who the heck knows? -open F, "> $file" or die $!; +open F, '>', $file or die $!; close F; $o = tie @a, 'Tie::File', $file, recsep => 'blah'; print $o ? "ok $N\n" : "not ok $N\n"; diff --git a/dist/Tie-File/t/16_handle.t b/dist/Tie-File/t/16_handle.t index f799496..21a3fce 100644 --- a/dist/Tie-File/t/16_handle.t +++ b/dist/Tie-File/t/16_handle.t @@ -117,7 +117,7 @@ sub check_contents { my $x = join $:, @c, ''; local *FH = $o->{fh}; seek FH, 0, SEEK_SET; -# my $open = open FH, "< $file"; +# my $open = open FH, '<', $file; my $a; { local $/; $a = } $a = "" unless defined $a; diff --git a/dist/Tie-File/t/19_cache.t b/dist/Tie-File/t/19_cache.t index 81c6932..a8b6e69 100644 --- a/dist/Tie-File/t/19_cache.t +++ b/dist/Tie-File/t/19_cache.t @@ -15,7 +15,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; print F $data; close F; @@ -169,7 +169,7 @@ check(); sub init_file { my $data = shift; - open F, "> $file" or die $!; + open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/20_cache_full.t b/dist/Tie-File/t/20_cache_full.t index 8b3bf0b..bd4d6a7 100644 --- a/dist/Tie-File/t/20_cache_full.t +++ b/dist/Tie-File/t/20_cache_full.t @@ -14,7 +14,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; print F $data; close F; @@ -192,7 +192,7 @@ check(); sub init_file { my $data = shift; - open F, "> $file" or die $!; + open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/21_win32.t b/dist/Tie-File/t/21_win32.t index d068544..0ccf669 100644 --- a/dist/Tie-File/t/21_win32.t +++ b/dist/Tie-File/t/21_win32.t @@ -31,7 +31,7 @@ my $n; @a = qw(fish dog carrot); undef $o; untie @a; -open F, "< $file" or die "Couldn't open file $file: $!"; +open F, '<', $file or die "Couldn't open file $file: $!"; binmode F; my $a = do {local $/ ; }; my $x = "fish\r\ndog\r\ncarrot\r\n" ; diff --git a/dist/Tie-File/t/22_autochomp.t b/dist/Tie-File/t/22_autochomp.t index dee07a8..ebf3eac 100644 --- a/dist/Tie-File/t/22_autochomp.t +++ b/dist/Tie-File/t/22_autochomp.t @@ -105,7 +105,7 @@ sub check_contents { my $x = join $:, @c, ''; local *FH = $o->{fh}; seek FH, 0, SEEK_SET; -# my $open = open FH, "< $file"; +# my $open = open FH, '<', $file; my $a; { local $/; $a = } $a = "" unless defined $a; diff --git a/dist/Tie-File/t/23_rv_ac_splice.t b/dist/Tie-File/t/23_rv_ac_splice.t index be22957..104045a 100644 --- a/dist/Tie-File/t/23_rv_ac_splice.t +++ b/dist/Tie-File/t/23_rv_ac_splice.t @@ -155,7 +155,7 @@ check_result(0..3); sub init_file { my $data = shift; - open F, "> $file" or die $!; + open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/24_cache_loop.t b/dist/Tie-File/t/24_cache_loop.t index 0bc66be..42c002c 100644 --- a/dist/Tie-File/t/24_cache_loop.t +++ b/dist/Tie-File/t/24_cache_loop.t @@ -19,7 +19,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/25_gen_nocache.t b/dist/Tie-File/t/25_gen_nocache.t index 78e5506..ce55d27 100644 --- a/dist/Tie-File/t/25_gen_nocache.t +++ b/dist/Tie-File/t/25_gen_nocache.t @@ -91,7 +91,7 @@ sub check_contents { my $x = join $:, @c, ''; local *FH = $o->{fh}; seek FH, 0, SEEK_SET; -# my $open = open FH, "< $file"; +# my $open = open FH, '<', $file; my $a; { local $/; $a = } $a = "" unless defined $a; diff --git a/dist/Tie-File/t/26_twrite.t b/dist/Tie-File/t/26_twrite.t index e2a925f..d827f1c 100644 --- a/dist/Tie-File/t/26_twrite.t +++ b/dist/Tie-File/t/26_twrite.t @@ -27,7 +27,7 @@ $: = Tie::File::_default_recsep(); # The problem was premature termination in the inner loop # because you had $more_data scoped *inside* the block instead of outside. # 20020331 -open F, "> $file" or die "Couldn't open $file: $!"; +open F, '>', $file or die "Couldn't open $file: $!"; binmode F; for (1..100) { print F "$_ ", 'a'x150, $: ; @@ -263,7 +263,7 @@ try(42000, 0, 0); # old=0 , new=0 ; old = new sub try { my ($pos, $len, $newlen) = @_; - open F, "> $file" or die "Couldn't open file $file: $!"; + open F, '>', $file or die "Couldn't open file $file: $!"; binmode F; # The record has exactly 17 characters. This will help ensure that @@ -289,7 +289,7 @@ sub try { $o->_twrite($newdata, $pos, $len); undef $o; untie @lines; - open F, "< $file" or die "Couldn't open file $file: $!"; + open F, '<', $file or die "Couldn't open file $file: $!"; binmode F; my $actual; { local $/; @@ -313,7 +313,7 @@ sub check_contents { my $x = join $:, @c, ''; local *FH = $o->{fh}; seek FH, 0, SEEK_SET; -# my $open = open FH, "< $file"; +# my $open = open FH, '<', $file; my $a; { local $/; $a = } $a = "" unless defined $a; diff --git a/dist/Tie-File/t/27_iwrite.t b/dist/Tie-File/t/27_iwrite.t index db591a8..04ad436 100644 --- a/dist/Tie-File/t/27_iwrite.t +++ b/dist/Tie-File/t/27_iwrite.t @@ -179,7 +179,7 @@ sub try { my ($s, $len, $newlen) = @_; my $e = $s + $len; - open F, "> $file" or die "Couldn't open file $file: $!"; + open F, '>', $file or die "Couldn't open file $file: $!"; binmode F; print F $oldfile; @@ -197,7 +197,7 @@ sub try { my $actual_return = $o->_iwrite($newdata, $s, $e); undef $o; untie @lines; - open F, "< $file" or die "Couldn't open file $file: $!"; + open F, '<', $file or die "Couldn't open file $file: $!"; binmode F; my $actual; { local $/; diff --git a/dist/Tie-File/t/28_mtwrite.t b/dist/Tie-File/t/28_mtwrite.t index 50e306d..3146369 100644 --- a/dist/Tie-File/t/28_mtwrite.t +++ b/dist/Tie-File/t/28_mtwrite.t @@ -198,7 +198,7 @@ sub mkrand { sub try { push @TRIES, [@_] if @_ == 3; - open F, "> $file" or die "Couldn't open file $file: $!"; + open F, '>', $file or die "Couldn't open file $file: $!"; binmode F; print F $oldfile; close F; @@ -220,7 +220,7 @@ sub try { my $actual_return = $o->_mtwrite(@mt_args); undef $o; untie @lines; - open F, "< $file" or die "Couldn't open file $file: $!"; + open F, '<', $file or die "Couldn't open file $file: $!"; binmode F; my $actual; { local $/; diff --git a/dist/Tie-File/t/29_downcopy.t b/dist/Tie-File/t/29_downcopy.t index 51c941c..793116a 100644 --- a/dist/Tie-File/t/29_downcopy.t +++ b/dist/Tie-File/t/29_downcopy.t @@ -237,7 +237,7 @@ try(42000, 0, 0); # old=0 , new=0 ; old = new sub try { my ($pos, $len, $newlen) = @_; - open F, "> $file" or die "Couldn't open file $file: $!"; + open F, '>', $file or die "Couldn't open file $file: $!"; binmode F; # The record has exactly 17 characters. This will help ensure that @@ -291,7 +291,7 @@ sub try { } } - open F, "< $file" or die "Couldn't open file $file: $!"; + open F, '<', $file or die "Couldn't open file $file: $!"; binmode F; my $actual; { local $/; @@ -323,7 +323,7 @@ sub check_contents { my $x = join $:, @c, ''; local *FH = $o->{fh}; seek FH, 0, SEEK_SET; -# my $open = open FH, "< $file"; +# my $open = open FH, '<', $file; my $a; { local $/; $a = } $a = "" unless defined $a; diff --git a/dist/Tie-File/t/29a_upcopy.t b/dist/Tie-File/t/29a_upcopy.t index 1130615..9840af4 100644 --- a/dist/Tie-File/t/29a_upcopy.t +++ b/dist/Tie-File/t/29a_upcopy.t @@ -98,7 +98,7 @@ try($FLEN-20000, 200, undef); sub try { my ($src, $dst, $len) = @_; - open F, "> $file" or die "Couldn't open file $file: $!"; + open F, '>', $file or die "Couldn't open file $file: $!"; binmode F; # The record has exactly 17 characters. This will help ensure that @@ -141,7 +141,7 @@ sub try { } } - open F, "< $file" or die "Couldn't open file $file: $!"; + open F, '<', $file or die "Couldn't open file $file: $!"; binmode F; my $actual; { local $/; @@ -165,7 +165,7 @@ sub check_contents { my $x = join $:, @c, ''; local *FH = $o->{fh}; seek FH, 0, SEEK_SET; -# my $open = open FH, "< $file"; +# my $open = open FH, '<', $file; my $a; { local $/; $a = } $a = "" unless defined $a; diff --git a/dist/Tie-File/t/30_defer.t b/dist/Tie-File/t/30_defer.t index 063b3a7..975cdfb 100644 --- a/dist/Tie-File/t/30_defer.t +++ b/dist/Tie-File/t/30_defer.t @@ -19,7 +19,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; print F $data; close F; @@ -89,7 +89,7 @@ check_contents(join $:, "r0".."r2", "", "r4".."r6", ""); # undef $o; untie @a; $data = join "$:", map("record$_", 0..7), ""; # records are 8 or 9 bytes long -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; print F $data; close F; @@ -221,7 +221,7 @@ check_contents(join("$:", qw(recordF recordB recordC undef $o; untie @a; # (79) We can't use check_contents any more, because the object is dead -open F, "< $file" or die; +open F, '<', $file or die; binmode F; { local $/ ; $z = } close F; diff --git a/dist/Tie-File/t/31_autodefer.t b/dist/Tie-File/t/31_autodefer.t index ea929a4..baf72c2 100644 --- a/dist/Tie-File/t/31_autodefer.t +++ b/dist/Tie-File/t/31_autodefer.t @@ -19,7 +19,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/32_defer_misc.t b/dist/Tie-File/t/32_defer_misc.t index e0e3f15..f4ee110 100644 --- a/dist/Tie-File/t/32_defer_misc.t +++ b/dist/Tie-File/t/32_defer_misc.t @@ -17,7 +17,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Tie-File/t/33_defer_vs.t b/dist/Tie-File/t/33_defer_vs.t index 071af77..b68541c 100644 --- a/dist/Tie-File/t/33_defer_vs.t +++ b/dist/Tie-File/t/33_defer_vs.t @@ -21,7 +21,7 @@ my $N = 1; use Tie::File; print "ok $N\n"; $N++; -open F, "> $file" or die $!; +open F, '>', $file or die $!; binmode F; print F $data; close F; diff --git a/dist/Time-HiRes/Makefile.PL b/dist/Time-HiRes/Makefile.PL index 9060fa2..ccad6a3 100644 --- a/dist/Time-HiRes/Makefile.PL +++ b/dist/Time-HiRes/Makefile.PL @@ -88,7 +88,7 @@ sub try_compile_and_link { my $obj_ext = $Config{obj_ext} || ".o"; unlink("$tmp.c", "$tmp$obj_ext"); - if (open(TMPC, ">$tmp.c")) { + if (open(TMPC, '>', "$tmp.c")) { print TMPC $c; close(TMPC); @@ -132,7 +132,7 @@ __EOD__ unless defined $cccmd; if ($^O eq 'VMS') { - open( CMDFILE, ">$tmp.com" ); + open( CMDFILE, '>', "$tmp.com" ); print CMDFILE "\$ SET MESSAGE/NOFACILITY/NOSEVERITY/NOIDENT/NOTEXT\n"; print CMDFILE "\$ $cccmd\n"; print CMDFILE "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n"; # escalate @@ -864,7 +864,7 @@ EOM if ($DEFINE) { $DEFINE =~ s/^\s+//; - if (open(XDEFINE, ">xdefine")) { + if (open(XDEFINE, '>', 'xdefine')) { print XDEFINE $DEFINE, "\n"; close(XDEFINE); } @@ -1015,8 +1015,8 @@ sub doConstants { foreach $file ('const-c.inc', 'const-xs.inc') { my $fallback = File::Spec->catfile('fallback', $file); local $/; - open IN, "<$fallback" or die "Can't open $fallback: $!"; - open OUT, ">$file" or die "Can't open $file: $!"; + open IN, '<', $fallback or die "Can't open $fallback: $!"; + open OUT, '>', $file or die "Can't open $file: $!"; print OUT or die $!; close OUT or die "Can't close $file: $!"; close IN or die "Can't close $fallback: $!"; @@ -1035,7 +1035,7 @@ sub main { DEFINE('SELECT_IS_BROKEN'); $LIBS = []; print "System is $^O, skipping full configure...\n"; - open(XDEFINE, ">xdefine") or die "$0: Cannot create xdefine: $!\n"; + open(XDEFINE, '>', 'xdefine') or die "$0: Cannot create xdefine: $!\n"; close(XDEFINE); } else { init(); diff --git a/dist/Time-HiRes/t/alarm.t b/dist/Time-HiRes/t/alarm.t index f600f99..4935410 100644 --- a/dist/Time-HiRes/t/alarm.t +++ b/dist/Time-HiRes/t/alarm.t @@ -10,7 +10,7 @@ use Config; my $limit = 0.25; # 25% is acceptable slosh for testing timers my $xdefine = ''; -if (open(XDEFINE, "xdefine")) { +if (open(XDEFINE, "<", "xdefine")) { chomp($xdefine = || ""); close(XDEFINE); } diff --git a/dist/Time-HiRes/t/sleep.t b/dist/Time-HiRes/t/sleep.t index c4d802b..b84b4c6 100644 --- a/dist/Time-HiRes/t/sleep.t +++ b/dist/Time-HiRes/t/sleep.t @@ -8,7 +8,7 @@ BEGIN { require_ok "Time::HiRes"; } use Config; my $xdefine = ''; -if (open(XDEFINE, "xdefine")) { +if (open(XDEFINE, "<", "xdefine")) { chomp($xdefine = || ""); close(XDEFINE); } diff --git a/dist/Time-HiRes/t/stat.t b/dist/Time-HiRes/t/stat.t index e7552b5..a59a342 100644 --- a/dist/Time-HiRes/t/stat.t +++ b/dist/Time-HiRes/t/stat.t @@ -20,7 +20,7 @@ my @atime; my @mtime; for (1..5) { Time::HiRes::sleep(rand(0.1) + 0.1); - open(X, ">$$"); + open(X, '>', $$); print X $$; close(X); my($a, $stat, $b) = ("a", [Time::HiRes::stat($$)], "b"); @@ -33,7 +33,7 @@ for (1..5) { is $b, "b"; is_deeply $lstat, $stat; Time::HiRes::sleep(rand(0.1) + 0.1); - open(X, "<$$"); + open(X, '<', $$); ; close(X); $stat = [Time::HiRes::stat($$)]; @@ -75,7 +75,7 @@ SKIP: { my $targetname = "tgt$$"; my $linkname = "link$$"; SKIP: { - open(X, ">$targetname"); + open(X, '>', $targetname); print X $$; close(X); eval { symlink $targetname, $linkname or die "can't symlink: $!"; }; diff --git a/dist/Time-HiRes/t/utime.t b/dist/Time-HiRes/t/utime.t index e64f99b..f84bccf 100644 --- a/dist/Time-HiRes/t/utime.t +++ b/dist/Time-HiRes/t/utime.t @@ -25,10 +25,10 @@ BEGIN { sub getfstype { my ($fn) = @_; my $cmd = "df $fn"; - open(my $df, "$cmd |") or die "$cmd: $!"; + open(my $df, '-|', $cmd) or die "$cmd: $!"; my @df = <$df>; # Assume $df[0] is header line. my $dev = +(split(" ", $df[1]))[0]; - open(my $mounts, "/proc/mounts") or die "/proc/mounts: $!"; + open(my $mounts, '<', '/proc/mounts') or die "/proc/mounts: $!"; while (<$mounts>) { my @m = split(" "); if ($m[0] eq $dev) { return $m[2] } diff --git a/dist/XSLoader/XSLoader_pm.PL b/dist/XSLoader/XSLoader_pm.PL index 2d00930..ddf68f8 100644 --- a/dist/XSLoader/XSLoader_pm.PL +++ b/dist/XSLoader/XSLoader_pm.PL @@ -4,14 +4,14 @@ use Config; eval { require DynaLoader }; 1 while unlink "XSLoader.pm"; -open OUT, ">XSLoader.pm" or die $!; +open OUT, '>', 'XSLoader.pm' or die $!; print OUT <<'EOT'; -# Generated from XSLoader.pm.PL (resolved %Config::Config value) +# Generated from XSLoader_pm.PL (resolved %Config::Config value) # This file is unique for every OS package XSLoader; -$VERSION = "0.24"; +$VERSION = "0.26"; #use strict; diff --git a/dist/lib/lib_pm.PL b/dist/lib/lib_pm.PL index 8706e82..a4c5cc3 100644 --- a/dist/lib/lib_pm.PL +++ b/dist/lib/lib_pm.PL @@ -61,7 +61,7 @@ if ($expand_config_vars) { q(reverse split / /, $Config{inc_version_list}); } -open OUT,">$file" or die "Can't create $file: $!"; +open OUT,'>', $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -86,7 +86,7 @@ my \@inc_version_list = $Config_inc_version_list; print OUT <<'!NO!SUBS!'; our @ORIG_INC = @INC; # take a handy copy of 'original' value -our $VERSION = '0.63'; +our $VERSION = '0.64'; sub import { shift; diff --git a/dist/lib/t/01lib.t b/dist/lib/t/01lib.t index 7cf644d..a1b023d 100644 --- a/dist/lib/t/01lib.t +++ b/dist/lib/t/01lib.t @@ -27,7 +27,7 @@ BEGIN { mkpath [$Auto_Dir]; - open(MOD, ">$Module") || DIE $!; + open(MOD, '>', $Module) || DIE $!; print MOD <<'MODULE'; package Yup; $Plan = 9; diff --git a/dist/threads-shared/lib/threads/shared.pm b/dist/threads-shared/lib/threads/shared.pm index 9fd55d6..d42981b 100644 --- a/dist/threads-shared/lib/threads/shared.pm +++ b/dist/threads-shared/lib/threads/shared.pm @@ -7,7 +7,7 @@ use warnings; use Scalar::Util qw(reftype refaddr blessed); -our $VERSION = '1.52'; # Please update the pod, too. +our $VERSION = '1.54'; # Please update the pod, too. my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -195,7 +195,7 @@ threads::shared - Perl extension for sharing data structures between threads =head1 VERSION -This document describes threads::shared version 1.52 +This document describes threads::shared version 1.54 =head1 SYNOPSIS diff --git a/dist/threads-shared/shared.xs b/dist/threads-shared/shared.xs index a019732..dab5e36 100644 --- a/dist/threads-shared/shared.xs +++ b/dist/threads-shared/shared.xs @@ -656,7 +656,17 @@ Perl_sharedsv_cond_timedwait(perl_cond *cond, perl_mutex *mut, double abs) abs -= (NV)ts.tv_sec; ts.tv_nsec = (long)(abs * 1000000000.0); +#if defined(__clang__) || defined(__clang) + CLANG_DIAG_IGNORE(-Wthread-safety); + /* warning: calling function 'pthread_cond_timedwait' requires holding mutex 'mut' exclusively [-Wthread-safety-analysis] */ +#endif + switch (pthread_cond_timedwait(cond, mut, &ts)) { + +#if defined(__clang__) || defined(__clang) +CLANG_DIAG_RESTORE; +#endif + case 0: got_it = 1; break; case ETIMEDOUT: break; #ifdef OEMVS diff --git a/dist/threads/lib/threads.pm b/dist/threads/lib/threads.pm index 9217439..14bf920 100644 --- a/dist/threads/lib/threads.pm +++ b/dist/threads/lib/threads.pm @@ -5,7 +5,7 @@ use 5.008; use strict; use warnings; -our $VERSION = '2.10'; +our $VERSION = '2.12'; my $XS_VERSION = $VERSION; $VERSION = eval $VERSION; @@ -134,7 +134,7 @@ threads - Perl interpreter-based threads =head1 VERSION -This document describes threads version 2.09 +This document describes threads version 2.12 =head1 WARNING diff --git a/dist/threads/t/exit.t b/dist/threads/t/exit.t index 9e9b7f5..c50bf98 100644 --- a/dist/threads/t/exit.t +++ b/dist/threads/t/exit.t @@ -48,7 +48,7 @@ my $rc = $thr->join(); ok(! defined($rc), 'Exited: threads->exit()'); -run_perl(prog => 'use threads 2.09;' . +run_perl(prog => 'use threads 2.12;' . 'threads->exit(86);' . 'exit(99);', nolib => ($ENV{PERL_CORE}) ? 0 : 1, @@ -98,7 +98,7 @@ $rc = $thr->join(); ok(! defined($rc), 'Exited: $thr->set_thread_exit_only'); -run_perl(prog => 'use threads 2.09 qw(exit thread_only);' . +run_perl(prog => 'use threads 2.12 qw(exit thread_only);' . 'threads->create(sub { exit(99); })->join();' . 'exit(86);', nolib => ($ENV{PERL_CORE}) ? 0 : 1, @@ -108,7 +108,7 @@ run_perl(prog => 'use threads 2.09 qw(exit thread_only);' . is($?>>8, 86, "'use threads 'exit' => 'thread_only'"); } -my $out = run_perl(prog => 'use threads 2.09;' . +my $out = run_perl(prog => 'use threads 2.12;' . 'threads->create(sub {' . ' exit(99);' . '});' . @@ -124,7 +124,7 @@ my $out = run_perl(prog => 'use threads 2.09;' . like($out, qr/1 finished and unjoined/, "exit(status) in thread"); -$out = run_perl(prog => 'use threads 2.09 qw(exit thread_only);' . +$out = run_perl(prog => 'use threads 2.12 qw(exit thread_only);' . 'threads->create(sub {' . ' threads->set_thread_exit_only(0);' . ' exit(99);' . @@ -141,7 +141,7 @@ $out = run_perl(prog => 'use threads 2.09 qw(exit thread_only);' . like($out, qr/1 finished and unjoined/, "set_thread_exit_only(0)"); -run_perl(prog => 'use threads 2.09;' . +run_perl(prog => 'use threads 2.12;' . 'threads->create(sub {' . ' $SIG{__WARN__} = sub { exit(99); };' . ' die();' . diff --git a/dist/threads/t/kill3.t b/dist/threads/t/kill3.t new file mode 100644 index 0000000..15e3f16 --- /dev/null +++ b/dist/threads/t/kill3.t @@ -0,0 +1,113 @@ +use strict; +use warnings; + +BEGIN { + require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl'); + + use Config; + if (! $Config{'useithreads'}) { + skip_all(q/Perl not compiled with 'useithreads'/); + } +} + +use ExtUtils::testlib; +use Cwd; +my $cwd = cwd(); + +use threads; + +BEGIN { + if (! eval 'use threads::shared; 1') { + skip_all('threads::shared not available'); + } + + local $SIG{'HUP'} = sub {}; + my $thr = threads->create(sub {}); + eval { $thr->kill('HUP') }; + $thr->join(); + if ($@ && $@ =~ /safe signals/) { + skip_all('Not using safe signals'); + } + + plan(2); +}; + +{ + $SIG{'KILL'} = undef; + chdir '/tmp'; + mkdir "toberead$$"; + chdir "toberead$$"; + for ('a'..'e') { + open my $THING, ">$_"; + close $THING or die "$_: $!"; + } + chdir $cwd; + + local $ARGV[0] = undef; + fresh_perl_is(<<'EOI', 'ok', { }, 'RT #77934: Case: Perl-false $ARGV[0]'); + local $@; + my $DIRH; + my $thr; + $thr = async { + # Thread 'cancellation' signal handler + $SIG{'KILL'} = sub { threads->exit(); }; + + opendir $DIRH, "."; + my $start = telldir $DIRH; + while (1) { + readdir $DIRH or seekdir $DIRH, 0; + } + } if $ARGV[0]; + + opendir $DIRH, "."; + for(1..5) { + select undef, undef, undef, .25; + } + + if ($ARGV[0]) { + $thr->kill('KILL')->detach(); + } + print($@ ? 'not ok' : 'ok'); +EOI +} + +{ + $SIG{'KILL'} = undef; + chdir '/tmp'; + mkdir "shouldberead$$"; + chdir "shouldberead$$"; + for ('a'..'e') { + open my $THING, ">$_"; + close $THING or die "$_: $!"; + } + chdir $cwd; + + local $ARGV[0] = 1; + fresh_perl_is(<<'EOI', 'ok', { }, 'RT #77934: Case: Perl-true $ARGV[0]'); + local $@; + my $DIRH; + my $thr; + $thr = async { + # Thread 'cancellation' signal handler + $SIG{'KILL'} = sub { threads->exit(); }; + + opendir $DIRH, "."; + my $start = telldir $DIRH; + while (1) { + readdir $DIRH or seekdir $DIRH, 0; + } + } if $ARGV[0]; + + opendir $DIRH, "."; + for(1..5) { + select undef, undef, undef, .25; + } + + if ($ARGV[0]) { + $thr->kill('KILL')->detach(); + } + print($@ ? 'not ok' : 'ok'); +EOI +} + +exit(0); diff --git a/dist/threads/t/thread.t b/dist/threads/t/thread.t index 4bd96d0..466fb13 100644 --- a/dist/threads/t/thread.t +++ b/dist/threads/t/thread.t @@ -161,7 +161,7 @@ package main; # bugid #24165 -run_perl(prog => 'use threads 2.09;' . +run_perl(prog => 'use threads 2.12;' . 'sub a{threads->create(shift)} $t = a sub{};' . '$t->tid; $t->join; $t->tid', nolib => ($ENV{PERL_CORE}) ? 0 : 1, diff --git a/dist/threads/threads.xs b/dist/threads/threads.xs index 56e61ea..579fff3 100644 --- a/dist/threads/threads.xs +++ b/dist/threads/threads.xs @@ -1016,8 +1016,10 @@ S_ithread_create( MUTEX_UNLOCK(&my_pool->create_destruct_mutex); return (thread); +#if defined(__clang__) || defined(__clang) CLANG_DIAG_IGNORE(-Wthread-safety); /* warning: mutex 'thread->mutex' is not held on every path through here [-Wthread-safety-analysis] */ +#endif } #if defined(__clang__) || defined(__clang) CLANG_DIAG_RESTORE; diff --git a/djgpp/fixpmain b/djgpp/fixpmain index 8ebbf78..9ff2ad6 100644 --- a/djgpp/fixpmain +++ b/djgpp/fixpmain @@ -5,8 +5,8 @@ use Config; -open (PERLM,"; $makefile=; @@ -29,5 +29,5 @@ for $realname (@exts) #DynaLoader is special $perlmain =~ s/(DynaLoader:\:boot)strap/$1_DynaLoader/gm; -open (PERLM,">perlmain.c") or die "Can't write perlmain.c: $!"; +open (PERLM, '>', 'perlmain.c') or die "Can't write perlmain.c: $!"; print PERLM $perlmain; diff --git a/doio.c b/doio.c index 67966b5..8ca9c4b 100644 --- a/doio.c +++ b/doio.c @@ -2080,7 +2080,7 @@ nothing in the core. #undef APPLY_TAINT_PROPER } -/* Do the permissions allow some operation? Assumes statcache already set. */ +/* Do the permissions in *statbufp allow some operation? */ #ifndef VMS /* VMS' cando is in vms.c */ bool Perl_cando(pTHX_ Mode_t mode, bool effective, const Stat_t *statbufp) diff --git a/dosish.h b/dosish.h index c1305cd..1dc9322 100644 --- a/dosish.h +++ b/dosish.h @@ -56,7 +56,7 @@ HINTS_REFCNT_TERM; OP_CHECK_MUTEX_TERM; \ OP_REFCNT_TERM; PERLIO_TERM; MALLOC_TERM; LOCALE_TERM; #endif -#define dXSUB_SYS +#define dXSUB_SYS dNOOP /* USEMYBINMODE * This symbol, if defined, indicates that the program should diff --git a/dquote.c b/dquote.c index e02308e..ef03046 100644 --- a/dquote.c +++ b/dquote.c @@ -46,10 +46,10 @@ Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning) clearer[i++] = result; clearer[i++] = '\0'; - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "\"\\c%c\" is more clearly written simply as \"%s\"", - source, - clearer); + Perl_ck_warner_d(aTHX_ packWARN2(WARN_SYNTAX,WARN_DEPRECATED), + "\"\\c%c\" is more clearly written simply as \"%s\". " + "This will be a fatal error in Perl 5.28", + source, clearer); } return result; diff --git a/embed.fnc b/embed.fnc index ca15006..656afe5 100644 --- a/embed.fnc +++ b/embed.fnc @@ -529,7 +529,7 @@ i |void |op_relocate_sv |NN SV** svp|NN PADOFFSET* targp i |OP* |newMETHOP_internal |I32 type|I32 flags|NULLOK OP* dynamic_meth \ |NULLOK SV* const_meth : FIXME -s |OP* |fold_constants |NN OP *o +s |OP* |fold_constants |NN OP * const o #endif Afpd |char* |form |NN const char* pat|... Ap |char* |vform |NN const char* pat|NULLOK va_list* args @@ -738,7 +738,8 @@ AMp |UV |to_uni_title |UV c|NN U8 *p|NN STRLEN *lenp ADMpR |bool |isIDFIRST_lazy |NN const char* p ADMpR |bool |isALNUM_lazy |NN const char* p #ifdef PERL_IN_UTF8_C -snR |U8 |to_lower_latin1|const U8 c|NULLOK U8 *p|NULLOK STRLEN *lenp +snR |U8 |to_lower_latin1|const U8 c|NULLOK U8 *p|NULLOK STRLEN *lenp \ + |const char dummy inR |bool |is_utf8_cp_above_31_bits|NN const U8 * const s|NN const U8 * const e #endif #if defined(PERL_IN_UTF8_C) || defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) @@ -811,7 +812,13 @@ AmndP |bool |is_utf8_valid_partial_char \ AnidR |bool |is_utf8_valid_partial_char_flags \ |NN const U8 * const s|NN const U8 * const e|const U32 flags AMpR |bool |_is_uni_FOO|const U8 classnum|const UV c -AMpR |bool |_is_utf8_FOO|const U8 classnum|NN const U8 *p +AMpR |bool |_is_utf8_FOO|U8 classnum|NN const U8 * const p \ + |NN const char * const name \ + |NN const char * const alternative \ + |const bool use_utf8|const bool use_locale \ + |NN const char * const file|const unsigned line +AMpR |bool |_is_utf8_FOO_with_len|const U8 classnum|NN const U8 *p \ + |NN const U8 * const e ADMpR |bool |is_utf8_alnum |NN const U8 *p ADMpR |bool |is_utf8_alnumc |NN const U8 *p ADMpR |bool |is_utf8_idfirst|NN const U8 *p @@ -820,8 +827,10 @@ AMpR |bool |_is_utf8_idcont|NN const U8 *p AMpR |bool |_is_utf8_idstart|NN const U8 *p AMpR |bool |_is_utf8_xidcont|NN const U8 *p AMpR |bool |_is_utf8_xidstart|NN const U8 *p -AMpR |bool |_is_utf8_perl_idcont|NN const U8 *p -AMpR |bool |_is_utf8_perl_idstart|NN const U8 *p +AMpR |bool |_is_utf8_perl_idcont_with_len|NN const U8 *p \ + |NN const U8 * const e +AMpR |bool |_is_utf8_perl_idstart_with_len|NN const U8 *p \ + |NN const U8 * const e ADMpR |bool |is_utf8_idcont |NN const U8 *p ADMpR |bool |is_utf8_xidcont |NN const U8 *p ADMpR |bool |is_utf8_alpha |NN const U8 *p @@ -1714,6 +1723,19 @@ sMR |char * |unexpected_non_continuation_text \ |const STRLEN non_cont_byte_pos \ |const STRLEN expect_len sM |char * |_byte_dump_string|NN const U8 * s|const STRLEN len +s |void |warn_on_first_deprecated_use \ + |NN const char * const name \ + |NN const char * const alternative \ + |const bool use_locale \ + |NN const char * const file \ + |const unsigned line +s |U32 |check_and_deprecate \ + |NN const U8 * p \ + |NN const U8 ** e \ + |const unsigned type \ + |const bool use_locale \ + |NN const char * const file \ + |const unsigned line s |UV |_to_utf8_case |const UV uv1 \ |NN const U8 *p \ |NN U8* ustrp \ @@ -1722,18 +1744,22 @@ s |UV |_to_utf8_case |const UV uv1 \ |NN const char *normal \ |NULLOK const char *special #endif -Apbmd |UV |to_utf8_lower |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp -AMp |UV |_to_utf8_lower_flags |NN const U8 *p|NN U8* ustrp \ - |NULLOK STRLEN *lenp|bool flags -Apbmd |UV |to_utf8_upper |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp -AMp |UV |_to_utf8_upper_flags |NN const U8 *p|NN U8* ustrp \ - |NULLOK STRLEN *lenp|bool flags -Apbmd |UV |to_utf8_title |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp -AMp |UV |_to_utf8_title_flags |NN const U8 *p|NN U8* ustrp \ - |NULLOK STRLEN *lenp|bool flags -Apbmd |UV |to_utf8_fold |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp -AMp |UV |_to_utf8_fold_flags|NN const U8 *p|NN U8* ustrp \ - |NULLOK STRLEN *lenp|U8 flags +ApbmdD |UV |to_utf8_lower |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +AMp |UV |_to_utf8_lower_flags|NN const U8 *p|NULLOK const U8* e \ + |NN U8* ustrp|NULLOK STRLEN *lenp|bool flags \ + |NN const char * const file|const int line +ApbmdD |UV |to_utf8_upper |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +AMp |UV |_to_utf8_upper_flags |NN const U8 *p|NULLOK const U8 *e \ + |NN U8* ustrp|NULLOK STRLEN *lenp|bool flags \ + |NN const char * const file|const int line +ApbmdD |UV |to_utf8_title |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +AMp |UV |_to_utf8_title_flags |NN const U8 *p|NULLOK const U8* e \ + |NN U8* ustrp|NULLOK STRLEN *lenp|bool flags \ + |NN const char * const file|const int line +ApbmdD |UV |to_utf8_fold |NN const U8 *p|NN U8* ustrp|NULLOK STRLEN *lenp +AMp |UV |_to_utf8_fold_flags|NN const U8 *p|NULLOK const U8 *e \ + |NN U8* ustrp|NULLOK STRLEN *lenp|U8 flags \ + |NN const char * const file|const int line #if defined(PERL_IN_MG_C) || defined(PERL_IN_PP_C) pn |bool |translate_substr_offsets|STRLEN curlen|IV pos1_iv \ |bool pos1_is_uv|IV len_iv \ @@ -1753,6 +1779,9 @@ Ap |void |unsharepvn |NULLOK const char* sv|I32 len|U32 hash p |void |unshare_hek |NULLOK HEK* hek : Used in perly.y p |void |utilize |int aver|I32 floor|NULLOK OP* version|NN OP* idop|NULLOK OP* arg +ApM |void |_force_out_malformed_utf8_message \ + |NN const U8 *const p|NN const U8 * const e|const U32 flags \ + |const bool die_here Ap |U8* |utf16_to_utf8 |NN U8* p|NN U8 *d|I32 bytelen|NN I32 *newlen Ap |U8* |utf16_to_utf8_reversed|NN U8* p|NN U8 *d|I32 bytelen|NN I32 *newlen AdpPR |STRLEN |utf8_length |NN const U8* s|NN const U8 *e @@ -1788,7 +1817,7 @@ Ap |UV |utf8n_to_uvuni|NN const U8 *s|STRLEN curlen|NULLOK STRLEN *retlen|U32 fl Adm |U8* |uvchr_to_utf8 |NN U8 *d|UV uv Ap |U8* |uvuni_to_utf8 |NN U8 *d|UV uv Adm |U8* |uvchr_to_utf8_flags |NN U8 *d|UV uv|UV flags -Apd |U8* |uvoffuni_to_utf8_flags |NN U8 *d|UV uv|UV flags +Apd |U8* |uvoffuni_to_utf8_flags |NN U8 *d|UV uv|const UV flags Ap |U8* |uvuni_to_utf8_flags |NN U8 *d|UV uv|UV flags Apd |char* |pv_uni_display |NN SV *dsv|NN const U8 *spv|STRLEN len|STRLEN pvlim|UV flags ApdR |char* |sv_uni_display |NN SV *dsv|NN SV *ssv|STRLEN pvlim|UV flags @@ -2433,8 +2462,15 @@ Es |U8 |regtail_study |NN RExC_state_t *pRExC_state \ # endif #endif +#if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C) +EXRpM |bool |isFOO_lc |const U8 classnum|const U8 character +#endif + +#if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) +ERp |bool |_is_grapheme |NN const U8 * strbeg|NN const U8 * s|NN const U8 *strend|const UV cp +#endif + #if defined(PERL_IN_REGEXEC_C) -ERs |bool |isFOO_lc |const U8 classnum|const U8 character ERs |bool |isFOO_utf8_lc |const U8 classnum|NN const U8* character ERs |SSize_t|regmatch |NN regmatch_info *reginfo|NN char *startpos|NN regnode *prog WERs |I32 |regrepeat |NN regexp *prog|NN char **startposp \ @@ -2604,7 +2640,7 @@ s |char* |force_word |NN char *start|int token|int check_keyword \ |int allow_pack s |SV* |tokeq |NN SV *sv sR |char* |scan_const |NN char *start -iR |SV* |get_and_check_backslash_N_name|NN const char* s \ +sR |SV* |get_and_check_backslash_N_name|NN const char* s \ |NN const char* const e sR |char* |scan_formline |NN char *s sR |char* |scan_heredoc |NN char *s @@ -2722,7 +2758,15 @@ sRM |UV |check_locale_boundary_crossing \ |const UV result \ |NN U8* const ustrp \ |NN STRLEN *lenp -iR |bool |is_utf8_common |NN const U8 *const p|NN SV **swash|NN const char * const swashname|NULLOK SV* const invlist +iR |bool |is_utf8_common |NN const U8 *const p \ + |NN SV **swash \ + |NN const char * const swashname \ + |NULLOK SV* const invlist +iR |bool |is_utf8_common_with_len|NN const U8 *const p \ + |NN const U8 *const e \ + |NN SV **swash \ + |NN const char * const swashname \ + |NULLOK SV* const invlist sR |SV* |swatch_get |NN SV* swash|UV start|UV span sRM |U8* |swash_scan_list_line|NN U8* l|NN U8* const lend|NN UV* min \ |NN UV* max|NN UV* val|const bool wants_value \ diff --git a/embed.h b/embed.h index 2ea48e3..ba7b2ca 100644 --- a/embed.h +++ b/embed.h @@ -27,23 +27,25 @@ /* Hide global symbols */ #define Gv_AMupdate(a,b) Perl_Gv_AMupdate(aTHX_ a,b) +#define _force_out_malformed_utf8_message(a,b,c,d) Perl__force_out_malformed_utf8_message(aTHX_ a,b,c,d) #define _is_in_locale_category(a,b) Perl__is_in_locale_category(aTHX_ a,b) #define _is_uni_FOO(a,b) Perl__is_uni_FOO(aTHX_ a,b) #define _is_uni_perl_idcont(a) Perl__is_uni_perl_idcont(aTHX_ a) #define _is_uni_perl_idstart(a) Perl__is_uni_perl_idstart(aTHX_ a) -#define _is_utf8_FOO(a,b) Perl__is_utf8_FOO(aTHX_ a,b) +#define _is_utf8_FOO(a,b,c,d,e,f,g,h) Perl__is_utf8_FOO(aTHX_ a,b,c,d,e,f,g,h) +#define _is_utf8_FOO_with_len(a,b,c) Perl__is_utf8_FOO_with_len(aTHX_ a,b,c) #define _is_utf8_idcont(a) Perl__is_utf8_idcont(aTHX_ a) #define _is_utf8_idstart(a) Perl__is_utf8_idstart(aTHX_ a) #define _is_utf8_mark(a) Perl__is_utf8_mark(aTHX_ a) -#define _is_utf8_perl_idcont(a) Perl__is_utf8_perl_idcont(aTHX_ a) -#define _is_utf8_perl_idstart(a) Perl__is_utf8_perl_idstart(aTHX_ a) +#define _is_utf8_perl_idcont_with_len(a,b) Perl__is_utf8_perl_idcont_with_len(aTHX_ a,b) +#define _is_utf8_perl_idstart_with_len(a,b) Perl__is_utf8_perl_idstart_with_len(aTHX_ a,b) #define _is_utf8_xidcont(a) Perl__is_utf8_xidcont(aTHX_ a) #define _is_utf8_xidstart(a) Perl__is_utf8_xidstart(aTHX_ a) #define _to_uni_fold_flags(a,b,c,d) Perl__to_uni_fold_flags(aTHX_ a,b,c,d) -#define _to_utf8_fold_flags(a,b,c,d) Perl__to_utf8_fold_flags(aTHX_ a,b,c,d) -#define _to_utf8_lower_flags(a,b,c,d) Perl__to_utf8_lower_flags(aTHX_ a,b,c,d) -#define _to_utf8_title_flags(a,b,c,d) Perl__to_utf8_title_flags(aTHX_ a,b,c,d) -#define _to_utf8_upper_flags(a,b,c,d) Perl__to_utf8_upper_flags(aTHX_ a,b,c,d) +#define _to_utf8_fold_flags(a,b,c,d,e,f,g) Perl__to_utf8_fold_flags(aTHX_ a,b,c,d,e,f,g) +#define _to_utf8_lower_flags(a,b,c,d,e,f,g) Perl__to_utf8_lower_flags(aTHX_ a,b,c,d,e,f,g) +#define _to_utf8_title_flags(a,b,c,d,e,f,g) Perl__to_utf8_title_flags(aTHX_ a,b,c,d,e,f,g) +#define _to_utf8_upper_flags(a,b,c,d,e,f,g) Perl__to_utf8_upper_flags(aTHX_ a,b,c,d,e,f,g) #define amagic_call(a,b,c,d) Perl_amagic_call(aTHX_ a,b,c,d) #define amagic_deref_call(a,b) Perl_amagic_deref_call(aTHX_ a,b) #define apply_attrs_string(a,b,c,d) Perl_apply_attrs_string(aTHX_ a,b,c,d) @@ -1129,7 +1131,6 @@ #define backup_one_SB(a,b,c) S_backup_one_SB(aTHX_ a,b,c) #define backup_one_WB(a,b,c,d) S_backup_one_WB(aTHX_ a,b,c,d) #define find_byclass(a,b,c,d,e) S_find_byclass(aTHX_ a,b,c,d,e) -#define isFOO_lc(a,b) S_isFOO_lc(aTHX_ a,b) #define isFOO_utf8_lc(a,b) S_isFOO_utf8_lc(aTHX_ a,b) #define isGCB(a,b,c,d,e) S_isGCB(aTHX_ a,b,c,d,e) #define isLB(a,b,c,d,e,f) S_isLB(aTHX_ a,b,c,d,e,f) @@ -1149,6 +1150,12 @@ #define to_byte_substr(a) S_to_byte_substr(aTHX_ a) #define to_utf8_substr(a) S_to_utf8_substr(aTHX_ a) # endif +# if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) +#define _is_grapheme(a,b,c,d) Perl__is_grapheme(aTHX_ a,b,c,d) +# endif +# if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C) +#define isFOO_lc(a,b) Perl_isFOO_lc(aTHX_ a,b) +# endif # if defined(PERL_IN_UTF8_C) || defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) #define _to_fold_latin1(a,b,c,d) Perl__to_fold_latin1(aTHX_ a,b,c,d) # endif @@ -1830,16 +1837,19 @@ # if defined(PERL_IN_UTF8_C) #define _byte_dump_string(a,b) S__byte_dump_string(aTHX_ a,b) #define _to_utf8_case(a,b,c,d,e,f,g) S__to_utf8_case(aTHX_ a,b,c,d,e,f,g) +#define check_and_deprecate(a,b,c,d,e,f) S_check_and_deprecate(aTHX_ a,b,c,d,e,f) #define check_locale_boundary_crossing(a,b,c,d) S_check_locale_boundary_crossing(aTHX_ a,b,c,d) #define does_utf8_overflow S_does_utf8_overflow #define isFF_OVERLONG S_isFF_OVERLONG #define is_utf8_common(a,b,c,d) S_is_utf8_common(aTHX_ a,b,c,d) +#define is_utf8_common_with_len(a,b,c,d,e) S_is_utf8_common_with_len(aTHX_ a,b,c,d,e) #define is_utf8_cp_above_31_bits S_is_utf8_cp_above_31_bits #define is_utf8_overlong_given_start_byte_ok S_is_utf8_overlong_given_start_byte_ok #define swash_scan_list_line(a,b,c,d,e,f,g) S_swash_scan_list_line(aTHX_ a,b,c,d,e,f,g) #define swatch_get(a,b,c) S_swatch_get(aTHX_ a,b,c) #define to_lower_latin1 S_to_lower_latin1 #define unexpected_non_continuation_text(a,b,c,d) S_unexpected_non_continuation_text(aTHX_ a,b,c,d) +#define warn_on_first_deprecated_use(a,b,c,d,e) S_warn_on_first_deprecated_use(aTHX_ a,b,c,d,e) # endif # if defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C) #define _to_upper_title_latin1(a,b,c,d) Perl__to_upper_title_latin1(aTHX_ a,b,c,d) diff --git a/embedvar.h b/embedvar.h index c413932..a33f213 100644 --- a/embedvar.h +++ b/embedvar.h @@ -42,6 +42,7 @@ #define PL_AboveLatin1 (vTHX->IAboveLatin1) #define PL_Argv (vTHX->IArgv) +#define PL_Assigned_invlist (vTHX->IAssigned_invlist) #define PL_Cmd (vTHX->ICmd) #define PL_DBcontrol (vTHX->IDBcontrol) #define PL_DBcv (vTHX->IDBcv) @@ -279,6 +280,7 @@ #define PL_scopestack_max (vTHX->Iscopestack_max) #define PL_scopestack_name (vTHX->Iscopestack_name) #define PL_secondgv (vTHX->Isecondgv) +#define PL_seen_deprecated_macro (vTHX->Iseen_deprecated_macro) #define PL_sharehook (vTHX->Isharehook) #define PL_sig_pending (vTHX->Isig_pending) #define PL_sighandlerp (vTHX->Isighandlerp) diff --git a/ext/B/B/Terse.pm b/ext/B/B/Terse.pm index 8e551c5..1749f32 100644 --- a/ext/B/B/Terse.pm +++ b/ext/B/B/Terse.pm @@ -1,6 +1,6 @@ package B::Terse; -our $VERSION = '1.06'; +our $VERSION = '1.07'; use strict; use B qw(class @specialsv_name); @@ -33,7 +33,7 @@ sub indent { # Don't use this, at least on OPs in subroutines: it has no way of # getting to the pad, and will give wrong answers or crash. sub B::OP::terse { - carp "B::OP::terse is deprecated; use B::Concise instead"; + carp "B::OP::terse is deprecated and will go away in Perl 5.28; use B::Concise instead"; B::Concise::b_terse(@_); } diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm index 8beb243..255ee89 100644 --- a/ext/B/B/Xref.pm +++ b/ext/B/B/Xref.pm @@ -1,6 +1,6 @@ package B::Xref; -our $VERSION = '1.05'; +our $VERSION = '1.06'; =head1 NAME @@ -449,7 +449,7 @@ sub compile { last OPTION; } elsif ($opt eq "o") { $arg ||= shift @options; - open(STDOUT, ">$arg") or return "$arg: $!\n"; + open(STDOUT, '>', $arg) or return "$arg: $!\n"; } elsif ($opt eq "d") { $nodefs = 1; } elsif ($opt eq "r") { diff --git a/ext/B/t/OptreeCheck.pm b/ext/B/t/OptreeCheck.pm index 3ae1930..e7af99e 100644 --- a/ext/B/t/OptreeCheck.pm +++ b/ext/B/t/OptreeCheck.pm @@ -5,7 +5,7 @@ use warnings; use vars qw($TODO $Level $using_open); require "test.pl"; -our $VERSION = '0.14'; +our $VERSION = '0.15'; # now export checkOptree, and those test.pl functions used by tests our @EXPORT = qw( checkOptree plan skip skip_all pass is like unlike @@ -1001,7 +1001,7 @@ sub OptreeCheck::processExamples { # turned into optreeCheck tests, foreach my $file (@files) { - open (my $fh, $file) or die "cant open $file: $!\n"; + open (my $fh, '<', $file) or die "cant open $file: $!\n"; $/ = ""; my @chunks = <$fh>; print preamble (scalar @chunks); diff --git a/ext/B/t/xref.t b/ext/B/t/xref.t index 32a80e7..3e201c1 100644 --- a/ext/B/t/xref.t +++ b/ext/B/t/xref.t @@ -32,7 +32,7 @@ open STDOUT, ">&SAVEOUT" or diag $!; # line 200 my ($curfile, $cursub, $curpack) = ('') x 3; our %xreftable = (); -open XREF, $file or die "# Can't open $file: $!\n"; +open XREF, '<', $file or die "# Can't open $file: $!\n"; while () { print STDERR $_ if $ENV{PERL_DEBUG}; chomp; diff --git a/ext/Devel-Peek/t/Peek.t b/ext/Devel-Peek/t/Peek.t index 07f6510..4775c1c 100644 --- a/ext/Devel-Peek/t/Peek.t +++ b/ext/Devel-Peek/t/Peek.t @@ -37,7 +37,7 @@ sub do_test { my $repeat_todo = $_[4]; my $pattern = $_[2]; my $do_eval = $_[5]; - if (open(OUT,">peek$$")) { + if (open(OUT,'>', "peek$$")) { open(STDERR, ">&OUT") or die "Can't dup OUT: $!"; if ($do_eval) { my $sub = eval "sub { Dump $_[1] }"; @@ -56,7 +56,7 @@ sub do_test { } open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!"; close(OUT); - if (open(IN, "peek$$")) { + if (open(IN, '<', "peek$$")) { local $/; $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g; $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g; @@ -77,7 +77,7 @@ sub do_test { # Could do this is in a s///mge but seems clearer like this: $pattern = join '', map { # If we identify the version condition, take *it* out whatever - s/\s*# (\$].*)$// + s/\s*# (\$\].*)$// ? (eval $1 ? $_ : '') : $_ # Didn't match, so this line is in } split /^/, $pattern; @@ -1146,7 +1146,7 @@ unless ($Config{useithreads}) { # (One block of study tests removed when study was made a no-op.) { - open(OUT,">peek$$") or die "Failed to open peek $$: $!"; + open(OUT, '>', "peek$$") or die "Failed to open peek $$: $!"; open(STDERR, ">&OUT") or die "Can't dup OUT: $!"; DeadCode(); open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!"; @@ -1232,12 +1232,12 @@ do_test('UTF-8 in a regular expression', use utf8; sub _dump { - open(OUT,">peek$$") or die $!; + open(OUT, '>', "peek$$") or die $!; open(STDERR, ">&OUT") or die "Can't dup OUT: $!"; Dump($_[0]); open(STDERR, ">&SAVERR") or die "Can't restore STDERR: $!"; close(OUT); - open(IN, "peek$$") or die $!; + open(IN, '<', "peek$$") or die $!; my $dump = do { local $/; }; close(IN); 1 while unlink "peek$$"; diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL index ee348c8..24c8bea 100644 --- a/ext/DynaLoader/DynaLoader_pm.PL +++ b/ext/DynaLoader/DynaLoader_pm.PL @@ -65,7 +65,7 @@ sub expand_os_specific { } unlink "DynaLoader.pm" if -f "DynaLoader.pm"; -open OUT, ">DynaLoader.pm" or die $!; +open OUT, '>', "DynaLoader.pm" or die $!; print OUT <<'EOT'; # Generated from DynaLoader_pm.PL, this file is unique for every OS @@ -85,7 +85,7 @@ package DynaLoader; # Tim.Bunce@ig.co.uk, August 1994 BEGIN { - $VERSION = '1.40'; + $VERSION = '1.41'; } EOT diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL index 8b1286d..d345e98 100644 --- a/ext/Errno/Errno_pm.PL +++ b/ext/Errno/Errno_pm.PL @@ -2,7 +2,7 @@ use ExtUtils::MakeMaker; use Config; use strict; -our $VERSION = "1.27"; +our $VERSION = "1.28"; my %err = (); @@ -13,7 +13,7 @@ my $IsMSWin32 = $^O eq 'MSWin32' && !$IsSymbian; unlink "Errno.pm" if -f "Errno.pm"; unlink "Errno.tmp" if -f "Errno.tmp"; -open OUT, ">Errno.tmp" or die "Cannot open Errno.tmp: $!"; +open OUT, '>', 'Errno.tmp' or die "Cannot open Errno.tmp: $!"; select OUT; my $file; my @files = get_files(); @@ -21,7 +21,7 @@ if ($Config{gccversion} ne '' && $^O eq 'MSWin32') { # MinGW complains "warning: #pragma system_header ignored outside include # file" if the header files are processed individually, so include them # all in .c file and process that instead. - open INCS, '>includes.c' or + open INCS, '>', 'includes.c' or die "Cannot open includes.c"; foreach $file (@files) { next if $file eq 'errno.c'; @@ -68,7 +68,7 @@ sub process_file { return; } } else { - unless(open(FH,"< $file")) { + unless(open(FH, '<', $file)) { # This file could be a temporary file created by cppstdin # so only warn under -w, and return warn "Cannot open '$file'" if $^W; @@ -149,7 +149,7 @@ sub get_files { $SDK =~ s!\\!/!g; $file{"$SDK/epoc32/include/libc/sys/errno.h"} = 1; } else { - open(CPPI,"> errno.c") or + open(CPPI, '>', 'errno.c') or die "Cannot open errno.c"; if ($^O eq 'NetWare') { @@ -200,7 +200,7 @@ sub write_errno_pm { # create the CPP input - open(CPPI,"> errno.c") or + open(CPPI, '>', 'errno.c') or die "Cannot open errno.c"; if ($^O eq 'NetWare') { diff --git a/ext/Fcntl/t/syslfs.t b/ext/Fcntl/t/syslfs.t index 09dea10..00e072b 100644 --- a/ext/Fcntl/t/syslfs.t +++ b/ext/Fcntl/t/syslfs.t @@ -234,7 +234,7 @@ explain() unless Test::Builder->new()->is_passing(); END { # unlink may fail if applied directly to a large file # be paranoid about leaving 5 gig files lying around - open(BIG, ">$big0"); # truncate + open(BIG, '>', $big0); # truncate close(BIG); } diff --git a/ext/File-Glob/Glob.pm b/ext/File-Glob/Glob.pm index c9c2d29..c619749 100644 --- a/ext/File-Glob/Glob.pm +++ b/ext/File-Glob/Glob.pm @@ -37,7 +37,7 @@ pop @{$EXPORT_TAGS{bsd_glob}}; # no "glob" @EXPORT_OK = (@{$EXPORT_TAGS{'glob'}}, 'csh_glob'); -$VERSION = '1.27'; +$VERSION = '1.28'; sub import { require Exporter; @@ -75,6 +75,12 @@ if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos)$/) { # File::Glob::glob() is deprecated because its prototype is different from # CORE::glob() (use bsd_glob() instead) sub glob { + use 5.024; + use warnings (); + warnings::warnif (deprecated => + "File::Glob::glob() will disappear in perl 5.30. " . + "Use File::Glob::bsd_glob() instead.") unless state $warned ++; + splice @_, 1; # no flags goto &bsd_glob; } diff --git a/ext/File-Glob/t/basic.t b/ext/File-Glob/t/basic.t index 2e6a474..f0363cd 100644 --- a/ext/File-Glob/t/basic.t +++ b/ext/File-Glob/t/basic.t @@ -44,7 +44,7 @@ if (opendir(D, ".")) { @correct = grep { !/^\./ } sort readdir(D); closedir D; } -my @a = File::Glob::glob("*", 0); +my @a = do {no warnings 'deprecated'; File::Glob::glob("*", 0);}; @a = sort @a; if (GLOB_ERROR) { fail(GLOB_ERROR); @@ -192,7 +192,7 @@ if ($^O eq 'VMS') { # VMS is happily caseignorant } for (@f_names) { - open T, "> $_"; + open T, '>', $_; close T; } diff --git a/ext/FileCache/t/02maxopen.t b/ext/FileCache/t/02maxopen.t index c95ba73..00dbb1b 100644 --- a/ext/FileCache/t/02maxopen.t +++ b/ext/FileCache/t/02maxopen.t @@ -19,7 +19,7 @@ use Test::More tests => 5; next unless fileno($path); print $path "$path 2\n"; close($path); - open($path, $path); + open($path, '<', $path); <$path>; push @cat, <$path>; close($path); diff --git a/ext/GDBM_File/t/fatal.t b/ext/GDBM_File/t/fatal.t index b7045ba..0e426d4 100644 --- a/ext/GDBM_File/t/fatal.t +++ b/ext/GDBM_File/t/fatal.t @@ -18,7 +18,7 @@ BEGIN { unlink ; -open my $fh, $^X or die "Can't open $^X: $!"; +open my $fh, '<', $^X or die "Can't open $^X: $!"; my $fileno = fileno $fh; isnt($fileno, undef, "Can find next available file descriptor"); close $fh or die $!; diff --git a/ext/IPC-Open3/t/IPC-Open3.t b/ext/IPC-Open3/t/IPC-Open3.t index 25cfdfb..aa196e5 100644 --- a/ext/IPC-Open3/t/IPC-Open3.t +++ b/ext/IPC-Open3/t/IPC-Open3.t @@ -210,7 +210,7 @@ foreach my $handle (qw (DUMMY STDIN STDOUT STDERR)) { my $out = IO::Handle->new(); my $pid = eval { local $SIG{__WARN__} = sub { - open my $fh, '>/dev/tty'; + open my $fh, '>', '/dev/tty'; return if "@_" =~ m!^Use of uninitialized value \$fd.*IO/Handle\.pm!; print $fh "@_"; die @_ diff --git a/ext/IPC-Open3/t/fd.t b/ext/IPC-Open3/t/fd.t index 2a71b13..adb1f5c 100644 --- a/ext/IPC-Open3/t/fd.t +++ b/ext/IPC-Open3/t/fd.t @@ -36,7 +36,7 @@ plan 3; fresh_perl_like(<<"EOP", use IPC::Open3; -open FOO, '$file' or die \$!; +open FOO, '<', '$file' or die \$!; open3('<&' . fileno FOO, my \$out, undef, \$ENV{PERLEXE}, '-eprint scalar '); print <\$out>; EOP diff --git a/ext/POSIX/t/posix.t b/ext/POSIX/t/posix.t index ea43bc0..7b456c1 100644 --- a/ext/POSIX/t/posix.t +++ b/ext/POSIX/t/posix.t @@ -155,7 +155,7 @@ if ( $unix_mode ) { $pat = qr#[\\/]POSIX$#i; } else { - $pat = qr/\.POSIX]/i; + $pat = qr/\.POSIX\]/i; } like( getcwd(), qr/$pat/, 'getcwd' ); diff --git a/ext/POSIX/t/sigaction.t b/ext/POSIX/t/sigaction.t index ddcc021..99bbb9f 100644 --- a/ext/POSIX/t/sigaction.t +++ b/ext/POSIX/t/sigaction.t @@ -204,7 +204,9 @@ SKIP: { || ($^O.$Config{osvers}) =~ /^openbsd[0-6]\./ || - ($^O eq 'gnu')); + ($^O eq 'gnu') + || + ($^O eq 'dragonfly')); my $tests = keys %{{ %siginfo, %opt_val }}; eval 'use POSIX qw(SA_SIGINFO); SA_SIGINFO'; skip("no SA_SIGINFO", $tests) if $@; diff --git a/ext/POSIX/t/sysconf.t b/ext/POSIX/t/sysconf.t index f23e0d3..29cf20f 100644 --- a/ext/POSIX/t/sysconf.t +++ b/ext/POSIX/t/sysconf.t @@ -110,7 +110,7 @@ SKIP: { -c $TTY or skip("$TTY not a character file", $n); - open(TTY, $TTY) + open(TTY, '<', $TTY) or skip("failed to open $TTY: $!", $n); -t TTY or skip("TTY ($TTY) not a terminal file", $n); diff --git a/ext/PerlIO-encoding/t/encoding.t b/ext/PerlIO-encoding/t/encoding.t index cba14a8..088f89e 100644 --- a/ext/PerlIO-encoding/t/encoding.t +++ b/ext/PerlIO-encoding/t/encoding.t @@ -25,7 +25,7 @@ my $fail2 = "fb$$"; my $russki = "koi8r$$"; my $threebyte = "3byte$$"; -if (open(GRK, ">$grk")) { +if (open(GRK, '>', $grk)) { binmode(GRK, ":bytes"); # alpha beta gamma in ISO 8859-7 print GRK "\xe1\xe2\xe3"; @@ -40,7 +40,7 @@ if (open(GRK, ">$grk")) { close($i); } -if (open(UTF, "<$utf")) { +if (open(UTF, '<', $utf)) { binmode(UTF, ":bytes"); # alpha beta gamma in UTF-8 Unicode (0x3b1 0x3b2 0x3b3) @@ -57,7 +57,7 @@ if (open(UTF, "<$utf")) { close($i); } -if (open(GRK, "<$grk")) { +if (open(GRK, '<', $grk)) { binmode(GRK, ":bytes"); is(scalar , "\xe1\xe2\xe3"); close GRK; @@ -68,10 +68,10 @@ $SIG{__WARN__} = sub {$warn .= $_[0]}; is (open(FAIL, ">:encoding(NoneSuch)", $fail1), undef, 'Open should fail'); like($warn, qr/^Cannot find encoding "NoneSuch" at/); -is(open(RUSSKI, ">$russki"), 1); +is(open(RUSSKI, '>', $russki), 1); print RUSSKI "\x3c\x3f\x78"; close RUSSKI or die "Could not close: $!"; -open(RUSSKI, "$russki"); +open(RUSSKI, '<', $russki); binmode(RUSSKI, ":raw"); my $buf1; read(RUSSKI, $buf1, 1); diff --git a/ext/PerlIO-encoding/t/fallback.t b/ext/PerlIO-encoding/t/fallback.t index cf3fdc3..3abdfd3 100644 --- a/ext/PerlIO-encoding/t/fallback.t +++ b/ext/PerlIO-encoding/t/fallback.t @@ -33,7 +33,7 @@ my $file = "fallback$$.txt"; like($message, qr/does not map to iso-8859-1/o, "FB_WARN message"); } -open($fh,$file) || die "File cannot be re-opened"; +open($fh,'<',$file) || die "File cannot be re-opened"; my $line = <$fh>; is($line,"\\x{20ac}0.02\n","perlqq escapes"); close($fh); @@ -45,14 +45,14 @@ my $str = "\x{20AC}"; print $fh $str,"0.02\n"; close($fh); -open($fh,$file) || die "File cannot be re-opened"; +open($fh,'<',$file) || die "File cannot be re-opened"; my $line = <$fh>; is($line,"€0.02\n","HTML escapes"); close($fh); { no utf8; - open($fh,">$file") || die "File cannot be re-opened"; + open($fh,'>',$file) || die "File cannot be re-opened"; binmode($fh); print $fh "\xA30.02\n"; close($fh); diff --git a/ext/PerlIO-scalar/scalar.pm b/ext/PerlIO-scalar/scalar.pm index dcba127..ce328ed 100644 --- a/ext/PerlIO-scalar/scalar.pm +++ b/ext/PerlIO-scalar/scalar.pm @@ -1,5 +1,5 @@ package PerlIO::scalar; -our $VERSION = '0.25'; +our $VERSION = '0.26'; require XSLoader; XSLoader::load(); 1; diff --git a/ext/PerlIO-scalar/scalar.xs b/ext/PerlIO-scalar/scalar.xs index dcb8283..c9a24db 100644 --- a/ext/PerlIO-scalar/scalar.xs +++ b/ext/PerlIO-scalar/scalar.xs @@ -20,9 +20,8 @@ PerlIOScalar_eof(pTHX_ PerlIO * f) { if (PerlIOBase(f)->flags & PERLIO_F_CANREAD) { PerlIOScalar *s = PerlIOSelf(f, PerlIOScalar); - char *p; STRLEN len; - p = SvPV(s->var, len); + (void)SvPV(s->var, len); return len - (STRLEN)(s->posn) <= 0; } return 1; diff --git a/ext/PerlIO-via/t/via.t b/ext/PerlIO-via/t/via.t index 0619592..6787e11 100644 --- a/ext/PerlIO-via/t/via.t +++ b/ext/PerlIO-via/t/via.t @@ -44,7 +44,7 @@ is($a, $b, 'compare original data with filtered version'); use warnings 'layer'; # Find fd number we should be using - my $fd = open($fh,">$tmp") && fileno($fh); + my $fd = open($fh,'>',$tmp) && fileno($fh); print $fh "Hello\n"; close($fh); @@ -52,7 +52,7 @@ is($a, $b, 'compare original data with filtered version'); like( $warnings, qr/^Cannot find package 'Unknown::Module'/, 'warn about unknown package' ); # Now open normally again to see if we get right fileno - my $fd2 = open($fh,"<$tmp") && fileno($fh); + my $fd2 = open($fh,'<',$tmp) && fileno($fh); is($fd2,$fd,"Wrong fd number after failed open"); my $data = <$fh>; diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index cef329e..5b34636 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -3,7 +3,7 @@ use strict; require Exporter; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); -$VERSION = 1.2201; +$VERSION = 1.2202; @ISA = qw(Exporter); @EXPORT = qw(pod2html htmlify); @EXPORT_OK = qw(anchorify); @@ -486,7 +486,7 @@ sub parse_command_line { my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header, $opt_help,$opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile, $opt_outfile,$opt_poderrors,$opt_podpath,$opt_podroot, - $opt_quiet,$opt_recurse,$opt_title,$opt_verbose,$opt_libpods); + $opt_quiet,$opt_recurse,$opt_title,$opt_verbose); unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html}; my $result = GetOptions( @@ -500,7 +500,6 @@ sub parse_command_line { 'htmlroot=s' => \$opt_htmlroot, 'index!' => \$opt_index, 'infile=s' => \$opt_infile, - 'libpods=s' => \$opt_libpods, # deprecated 'outfile=s' => \$opt_outfile, 'poderrors!' => \$opt_poderrors, 'podpath=s' => \$opt_podpath, @@ -516,7 +515,6 @@ sub parse_command_line { $opt_help = ""; # just to make -w shut-up. @Podpath = split(":", $opt_podpath) if defined $opt_podpath; - warn "--libpods is no longer supported" if defined $opt_libpods; $Backlink = $opt_backlink if defined $opt_backlink; $Cachedir = _unixify($opt_cachedir) if defined $opt_cachedir; diff --git a/ext/Pod-Html/t/pod2html-lib.pl b/ext/Pod-Html/t/pod2html-lib.pl index 27e3e94..dfe309a 100644 --- a/ext/Pod-Html/t/pod2html-lib.pl +++ b/ext/Pod-Html/t/pod2html-lib.pl @@ -70,7 +70,7 @@ sub convert_n_test { } # result - open my $in, $outfile or die "cannot open $outfile: $!"; + open my $in, '<', $outfile or die "cannot open $outfile: $!"; $result = <$in>; close $in; } @@ -88,7 +88,7 @@ sub convert_n_test { open my $tmpfile, ">", $expectfile or die $!; print $tmpfile $expect; close $tmpfile; - open my $diff_fh, "$diff $diffopt $expectfile $outfile |" or die $!; + open my $diff_fh, "-|", "$diff $diffopt $expectfile $outfile" or die $!; print STDERR "# $_" while <$diff_fh>; close $diff_fh; unlink $expectfile; diff --git a/ext/VMS-DCLsym/DCLsym.pm b/ext/VMS-DCLsym/DCLsym.pm index b239e15..6990e2a 100644 --- a/ext/VMS-DCLsym/DCLsym.pm +++ b/ext/VMS-DCLsym/DCLsym.pm @@ -7,7 +7,7 @@ use strict; # Package globals @ISA = ( 'DynaLoader' ); -$VERSION = '1.07'; +$VERSION = '1.08'; my(%Locsyms) = ( ':ID' => 'LOCAL' ); my(%Gblsyms) = ( ':ID' => 'GLOBAL'); my $DoCache = 1; @@ -105,7 +105,7 @@ sub FIRSTKEY { if (!$DoCache || !$Cache_set) { # We should eventually replace this with a C routine which walks the # CLI symbol table directly. If I ever get 'hold of an I&DS manual . . . - open(P,'Show Symbol * |'); + open(P, '-|', 'Show Symbol *'); while (

) { ($name,$eqs,$val) = /^\s+(\S+) (=+) (.+)/ or carp "VMS::DCLsym: unparseable line $_"; diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 473d4a3..1be0116 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '0.87'; +our $VERSION = '0.88'; require XSLoader; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index c58e248..e3e1593 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -4372,6 +4372,13 @@ test_isBLANK_uni(UV ord) RETVAL bool +test_isBLANK_uvchr(UV ord) + CODE: + RETVAL = isBLANK_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isBLANK_LC_uvchr(UV ord) CODE: RETVAL = isBLANK_LC_uvchr(ord); @@ -4379,6 +4386,13 @@ test_isBLANK_LC_uvchr(UV ord) RETVAL bool +test_isBLANK(UV ord) + CODE: + RETVAL = isBLANK(ord); + OUTPUT: + RETVAL + +bool test_isBLANK_A(UV ord) CODE: RETVAL = isBLANK_A(ord); @@ -4400,16 +4414,36 @@ test_isBLANK_LC(UV ord) RETVAL bool -test_isBLANK_utf8(unsigned char * p) +test_isBLANK_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isBLANK_utf8(p); + + /* In this function and those that follow, the boolean 'type' + * indicates if to pass a malformed UTF-8 string to the tested macro + * (malformed by making it too short) */ + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isBLANK_utf8_safe(p, e); + } + else { + RETVAL = isBLANK_utf8(p); + } OUTPUT: RETVAL bool -test_isBLANK_LC_utf8(unsigned char * p) +test_isBLANK_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isBLANK_LC_utf8(p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isBLANK_LC_utf8_safe(p, e); + } + else { + RETVAL = isBLANK_LC_utf8(p); + } OUTPUT: RETVAL @@ -4421,9 +4455,24 @@ test_isVERTWS_uni(UV ord) RETVAL bool -test_isVERTWS_utf8(unsigned char * p) +test_isVERTWS_uvchr(UV ord) CODE: - RETVAL = isVERTWS_utf8(p); + RETVAL = isVERTWS_uvchr(ord); + OUTPUT: + RETVAL + +bool +test_isVERTWS_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; + CODE: + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isVERTWS_utf8_safe(p, e); + } + else { + RETVAL = isVERTWS_utf8(p); + } OUTPUT: RETVAL @@ -4435,6 +4484,13 @@ test_isUPPER_uni(UV ord) RETVAL bool +test_isUPPER_uvchr(UV ord) + CODE: + RETVAL = isUPPER_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isUPPER_LC_uvchr(UV ord) CODE: RETVAL = isUPPER_LC_uvchr(ord); @@ -4442,6 +4498,13 @@ test_isUPPER_LC_uvchr(UV ord) RETVAL bool +test_isUPPER(UV ord) + CODE: + RETVAL = isUPPER(ord); + OUTPUT: + RETVAL + +bool test_isUPPER_A(UV ord) CODE: RETVAL = isUPPER_A(ord); @@ -4463,16 +4526,32 @@ test_isUPPER_LC(UV ord) RETVAL bool -test_isUPPER_utf8(unsigned char * p) +test_isUPPER_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isUPPER_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isUPPER_utf8_safe(p, e); + } + else { + RETVAL = isUPPER_utf8(p); + } OUTPUT: RETVAL bool -test_isUPPER_LC_utf8(unsigned char * p) +test_isUPPER_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isUPPER_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isUPPER_LC_utf8_safe(p, e); + } + else { + RETVAL = isUPPER_LC_utf8(p); + } OUTPUT: RETVAL @@ -4484,6 +4563,13 @@ test_isLOWER_uni(UV ord) RETVAL bool +test_isLOWER_uvchr(UV ord) + CODE: + RETVAL = isLOWER_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isLOWER_LC_uvchr(UV ord) CODE: RETVAL = isLOWER_LC_uvchr(ord); @@ -4491,6 +4577,13 @@ test_isLOWER_LC_uvchr(UV ord) RETVAL bool +test_isLOWER(UV ord) + CODE: + RETVAL = isLOWER(ord); + OUTPUT: + RETVAL + +bool test_isLOWER_A(UV ord) CODE: RETVAL = isLOWER_A(ord); @@ -4512,16 +4605,32 @@ test_isLOWER_LC(UV ord) RETVAL bool -test_isLOWER_utf8(unsigned char * p) +test_isLOWER_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isLOWER_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isLOWER_utf8_safe(p, e); + } + else { + RETVAL = isLOWER_utf8(p); + } OUTPUT: RETVAL bool -test_isLOWER_LC_utf8(unsigned char * p) +test_isLOWER_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isLOWER_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isLOWER_LC_utf8_safe(p, e); + } + else { + RETVAL = isLOWER_LC_utf8(p); + } OUTPUT: RETVAL @@ -4533,6 +4642,13 @@ test_isALPHA_uni(UV ord) RETVAL bool +test_isALPHA_uvchr(UV ord) + CODE: + RETVAL = isALPHA_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isALPHA_LC_uvchr(UV ord) CODE: RETVAL = isALPHA_LC_uvchr(ord); @@ -4540,6 +4656,13 @@ test_isALPHA_LC_uvchr(UV ord) RETVAL bool +test_isALPHA(UV ord) + CODE: + RETVAL = isALPHA(ord); + OUTPUT: + RETVAL + +bool test_isALPHA_A(UV ord) CODE: RETVAL = isALPHA_A(ord); @@ -4561,16 +4684,32 @@ test_isALPHA_LC(UV ord) RETVAL bool -test_isALPHA_utf8(unsigned char * p) +test_isALPHA_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isALPHA_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isALPHA_utf8_safe(p, e); + } + else { + RETVAL = isALPHA_utf8(p); + } OUTPUT: RETVAL bool -test_isALPHA_LC_utf8(unsigned char * p) +test_isALPHA_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isALPHA_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isALPHA_LC_utf8_safe(p, e); + } + else { + RETVAL = isALPHA_LC_utf8(p); + } OUTPUT: RETVAL @@ -4582,6 +4721,13 @@ test_isWORDCHAR_uni(UV ord) RETVAL bool +test_isWORDCHAR_uvchr(UV ord) + CODE: + RETVAL = isWORDCHAR_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isWORDCHAR_LC_uvchr(UV ord) CODE: RETVAL = isWORDCHAR_LC_uvchr(ord); @@ -4589,6 +4735,13 @@ test_isWORDCHAR_LC_uvchr(UV ord) RETVAL bool +test_isWORDCHAR(UV ord) + CODE: + RETVAL = isWORDCHAR(ord); + OUTPUT: + RETVAL + +bool test_isWORDCHAR_A(UV ord) CODE: RETVAL = isWORDCHAR_A(ord); @@ -4610,16 +4763,32 @@ test_isWORDCHAR_LC(UV ord) RETVAL bool -test_isWORDCHAR_utf8(unsigned char * p) +test_isWORDCHAR_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isWORDCHAR_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isWORDCHAR_utf8_safe(p, e); + } + else { + RETVAL = isWORDCHAR_utf8(p); + } OUTPUT: RETVAL bool -test_isWORDCHAR_LC_utf8(unsigned char * p) +test_isWORDCHAR_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isWORDCHAR_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isWORDCHAR_LC_utf8_safe(p, e); + } + else { + RETVAL = isWORDCHAR_LC_utf8(p); + } OUTPUT: RETVAL @@ -4631,6 +4800,13 @@ test_isALPHANUMERIC_uni(UV ord) RETVAL bool +test_isALPHANUMERIC_uvchr(UV ord) + CODE: + RETVAL = isALPHANUMERIC_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isALPHANUMERIC_LC_uvchr(UV ord) CODE: RETVAL = isALPHANUMERIC_LC_uvchr(ord); @@ -4638,6 +4814,13 @@ test_isALPHANUMERIC_LC_uvchr(UV ord) RETVAL bool +test_isALPHANUMERIC(UV ord) + CODE: + RETVAL = isALPHANUMERIC(ord); + OUTPUT: + RETVAL + +bool test_isALPHANUMERIC_A(UV ord) CODE: RETVAL = isALPHANUMERIC_A(ord); @@ -4659,16 +4842,39 @@ test_isALPHANUMERIC_LC(UV ord) RETVAL bool -test_isALPHANUMERIC_utf8(unsigned char * p) +test_isALPHANUMERIC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isALPHANUMERIC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isALPHANUMERIC_utf8_safe(p, e); + } + else { + RETVAL = isALPHANUMERIC_utf8(p); + } OUTPUT: RETVAL bool -test_isALPHANUMERIC_LC_utf8(unsigned char * p) +test_isALPHANUMERIC_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isALPHANUMERIC_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isALPHANUMERIC_LC_utf8_safe(p, e); + } + else { + RETVAL = isALPHANUMERIC_LC_utf8(p); + } + OUTPUT: + RETVAL + +bool +test_isALNUM(UV ord) + CODE: + RETVAL = isALNUM(ord); OUTPUT: RETVAL @@ -4694,16 +4900,32 @@ test_isALNUM_LC(UV ord) RETVAL bool -test_isALNUM_utf8(unsigned char * p) +test_isALNUM_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isALNUM_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isWORDCHAR_utf8_safe(p, e); + } + else { + RETVAL = isWORDCHAR_utf8(p); + } OUTPUT: RETVAL bool -test_isALNUM_LC_utf8(unsigned char * p) +test_isALNUM_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isALNUM_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isWORDCHAR_LC_utf8_safe(p, e); + } + else { + RETVAL = isWORDCHAR_LC_utf8(p); + } OUTPUT: RETVAL @@ -4715,6 +4937,13 @@ test_isDIGIT_uni(UV ord) RETVAL bool +test_isDIGIT_uvchr(UV ord) + CODE: + RETVAL = isDIGIT_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isDIGIT_LC_uvchr(UV ord) CODE: RETVAL = isDIGIT_LC_uvchr(ord); @@ -4722,16 +4951,39 @@ test_isDIGIT_LC_uvchr(UV ord) RETVAL bool -test_isDIGIT_utf8(unsigned char * p) +test_isDIGIT_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isDIGIT_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isDIGIT_utf8_safe(p, e); + } + else { + RETVAL = isDIGIT_utf8(p); + } OUTPUT: RETVAL bool -test_isDIGIT_LC_utf8(unsigned char * p) +test_isDIGIT_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isDIGIT_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isDIGIT_LC_utf8_safe(p, e); + } + else { + RETVAL = isDIGIT_LC_utf8(p); + } + OUTPUT: + RETVAL + +bool +test_isDIGIT(UV ord) + CODE: + RETVAL = isDIGIT(ord); OUTPUT: RETVAL @@ -4757,6 +5009,13 @@ test_isDIGIT_LC(UV ord) RETVAL bool +test_isOCTAL(UV ord) + CODE: + RETVAL = isOCTAL(ord); + OUTPUT: + RETVAL + +bool test_isOCTAL_A(UV ord) CODE: RETVAL = isOCTAL_A(ord); @@ -4778,6 +5037,13 @@ test_isIDFIRST_uni(UV ord) RETVAL bool +test_isIDFIRST_uvchr(UV ord) + CODE: + RETVAL = isIDFIRST_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isIDFIRST_LC_uvchr(UV ord) CODE: RETVAL = isIDFIRST_LC_uvchr(ord); @@ -4785,6 +5051,13 @@ test_isIDFIRST_LC_uvchr(UV ord) RETVAL bool +test_isIDFIRST(UV ord) + CODE: + RETVAL = isIDFIRST(ord); + OUTPUT: + RETVAL + +bool test_isIDFIRST_A(UV ord) CODE: RETVAL = isIDFIRST_A(ord); @@ -4806,16 +5079,32 @@ test_isIDFIRST_LC(UV ord) RETVAL bool -test_isIDFIRST_utf8(unsigned char * p) +test_isIDFIRST_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isIDFIRST_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isIDFIRST_utf8_safe(p, e); + } + else { + RETVAL = isIDFIRST_utf8(p); + } OUTPUT: RETVAL bool -test_isIDFIRST_LC_utf8(unsigned char * p) +test_isIDFIRST_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isIDFIRST_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isIDFIRST_LC_utf8_safe(p, e); + } + else { + RETVAL = isIDFIRST_LC_utf8(p); + } OUTPUT: RETVAL @@ -4827,6 +5116,13 @@ test_isIDCONT_uni(UV ord) RETVAL bool +test_isIDCONT_uvchr(UV ord) + CODE: + RETVAL = isIDCONT_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isIDCONT_LC_uvchr(UV ord) CODE: RETVAL = isIDCONT_LC_uvchr(ord); @@ -4834,6 +5130,13 @@ test_isIDCONT_LC_uvchr(UV ord) RETVAL bool +test_isIDCONT(UV ord) + CODE: + RETVAL = isIDCONT(ord); + OUTPUT: + RETVAL + +bool test_isIDCONT_A(UV ord) CODE: RETVAL = isIDCONT_A(ord); @@ -4855,16 +5158,32 @@ test_isIDCONT_LC(UV ord) RETVAL bool -test_isIDCONT_utf8(unsigned char * p) +test_isIDCONT_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isIDCONT_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isIDCONT_utf8_safe(p, e); + } + else { + RETVAL = isIDCONT_utf8(p); + } OUTPUT: RETVAL bool -test_isIDCONT_LC_utf8(unsigned char * p) +test_isIDCONT_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isIDCONT_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isIDCONT_LC_utf8_safe(p, e); + } + else { + RETVAL = isIDCONT_LC_utf8(p); + } OUTPUT: RETVAL @@ -4876,6 +5195,13 @@ test_isSPACE_uni(UV ord) RETVAL bool +test_isSPACE_uvchr(UV ord) + CODE: + RETVAL = isSPACE_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isSPACE_LC_uvchr(UV ord) CODE: RETVAL = isSPACE_LC_uvchr(ord); @@ -4883,6 +5209,13 @@ test_isSPACE_LC_uvchr(UV ord) RETVAL bool +test_isSPACE(UV ord) + CODE: + RETVAL = isSPACE(ord); + OUTPUT: + RETVAL + +bool test_isSPACE_A(UV ord) CODE: RETVAL = isSPACE_A(ord); @@ -4904,16 +5237,32 @@ test_isSPACE_LC(UV ord) RETVAL bool -test_isSPACE_utf8(unsigned char * p) +test_isSPACE_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isSPACE_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isSPACE_utf8_safe(p, e); + } + else { + RETVAL = isSPACE_utf8(p); + } OUTPUT: RETVAL bool -test_isSPACE_LC_utf8(unsigned char * p) +test_isSPACE_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isSPACE_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isSPACE_LC_utf8_safe(p, e); + } + else { + RETVAL = isSPACE_LC_utf8(p); + } OUTPUT: RETVAL @@ -4925,6 +5274,13 @@ test_isASCII_uni(UV ord) RETVAL bool +test_isASCII_uvchr(UV ord) + CODE: + RETVAL = isASCII_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isASCII_LC_uvchr(UV ord) CODE: RETVAL = isASCII_LC_uvchr(ord); @@ -4932,6 +5288,13 @@ test_isASCII_LC_uvchr(UV ord) RETVAL bool +test_isASCII(UV ord) + CODE: + RETVAL = isASCII(ord); + OUTPUT: + RETVAL + +bool test_isASCII_A(UV ord) CODE: RETVAL = isASCII_A(ord); @@ -4953,16 +5316,38 @@ test_isASCII_LC(UV ord) RETVAL bool -test_isASCII_utf8(unsigned char * p) +test_isASCII_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isASCII_utf8( p); +#ifndef DEBUGGING + PERL_UNUSED_VAR(e); +#endif + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isASCII_utf8_safe(p, e); + } + else { + RETVAL = isASCII_utf8(p); + } OUTPUT: RETVAL bool -test_isASCII_LC_utf8(unsigned char * p) +test_isASCII_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isASCII_LC_utf8( p); +#ifndef DEBUGGING + PERL_UNUSED_VAR(e); +#endif + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isASCII_LC_utf8_safe(p, e); + } + else { + RETVAL = isASCII_LC_utf8(p); + } OUTPUT: RETVAL @@ -4974,6 +5359,13 @@ test_isCNTRL_uni(UV ord) RETVAL bool +test_isCNTRL_uvchr(UV ord) + CODE: + RETVAL = isCNTRL_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isCNTRL_LC_uvchr(UV ord) CODE: RETVAL = isCNTRL_LC_uvchr(ord); @@ -4981,6 +5373,13 @@ test_isCNTRL_LC_uvchr(UV ord) RETVAL bool +test_isCNTRL(UV ord) + CODE: + RETVAL = isCNTRL(ord); + OUTPUT: + RETVAL + +bool test_isCNTRL_A(UV ord) CODE: RETVAL = isCNTRL_A(ord); @@ -5002,16 +5401,32 @@ test_isCNTRL_LC(UV ord) RETVAL bool -test_isCNTRL_utf8(unsigned char * p) +test_isCNTRL_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isCNTRL_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isCNTRL_utf8_safe(p, e); + } + else { + RETVAL = isCNTRL_utf8(p); + } OUTPUT: RETVAL bool -test_isCNTRL_LC_utf8(unsigned char * p) +test_isCNTRL_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isCNTRL_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isCNTRL_LC_utf8_safe(p, e); + } + else { + RETVAL = isCNTRL_LC_utf8(p); + } OUTPUT: RETVAL @@ -5023,6 +5438,13 @@ test_isPRINT_uni(UV ord) RETVAL bool +test_isPRINT_uvchr(UV ord) + CODE: + RETVAL = isPRINT_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isPRINT_LC_uvchr(UV ord) CODE: RETVAL = isPRINT_LC_uvchr(ord); @@ -5030,6 +5452,13 @@ test_isPRINT_LC_uvchr(UV ord) RETVAL bool +test_isPRINT(UV ord) + CODE: + RETVAL = isPRINT(ord); + OUTPUT: + RETVAL + +bool test_isPRINT_A(UV ord) CODE: RETVAL = isPRINT_A(ord); @@ -5051,16 +5480,32 @@ test_isPRINT_LC(UV ord) RETVAL bool -test_isPRINT_utf8(unsigned char * p) +test_isPRINT_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isPRINT_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isPRINT_utf8_safe(p, e); + } + else { + RETVAL = isPRINT_utf8(p); + } OUTPUT: RETVAL bool -test_isPRINT_LC_utf8(unsigned char * p) +test_isPRINT_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isPRINT_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isPRINT_LC_utf8_safe(p, e); + } + else { + RETVAL = isPRINT_LC_utf8(p); + } OUTPUT: RETVAL @@ -5072,6 +5517,13 @@ test_isGRAPH_uni(UV ord) RETVAL bool +test_isGRAPH_uvchr(UV ord) + CODE: + RETVAL = isGRAPH_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isGRAPH_LC_uvchr(UV ord) CODE: RETVAL = isGRAPH_LC_uvchr(ord); @@ -5079,6 +5531,13 @@ test_isGRAPH_LC_uvchr(UV ord) RETVAL bool +test_isGRAPH(UV ord) + CODE: + RETVAL = isGRAPH(ord); + OUTPUT: + RETVAL + +bool test_isGRAPH_A(UV ord) CODE: RETVAL = isGRAPH_A(ord); @@ -5100,16 +5559,32 @@ test_isGRAPH_LC(UV ord) RETVAL bool -test_isGRAPH_utf8(unsigned char * p) +test_isGRAPH_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isGRAPH_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isGRAPH_utf8_safe(p, e); + } + else { + RETVAL = isGRAPH_utf8(p); + } OUTPUT: RETVAL bool -test_isGRAPH_LC_utf8(unsigned char * p) +test_isGRAPH_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isGRAPH_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isGRAPH_LC_utf8_safe(p, e); + } + else { + RETVAL = isGRAPH_LC_utf8(p); + } OUTPUT: RETVAL @@ -5121,6 +5596,13 @@ test_isPUNCT_uni(UV ord) RETVAL bool +test_isPUNCT_uvchr(UV ord) + CODE: + RETVAL = isPUNCT_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isPUNCT_LC_uvchr(UV ord) CODE: RETVAL = isPUNCT_LC_uvchr(ord); @@ -5128,6 +5610,13 @@ test_isPUNCT_LC_uvchr(UV ord) RETVAL bool +test_isPUNCT(UV ord) + CODE: + RETVAL = isPUNCT(ord); + OUTPUT: + RETVAL + +bool test_isPUNCT_A(UV ord) CODE: RETVAL = isPUNCT_A(ord); @@ -5149,16 +5638,32 @@ test_isPUNCT_LC(UV ord) RETVAL bool -test_isPUNCT_utf8(unsigned char * p) +test_isPUNCT_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isPUNCT_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isPUNCT_utf8_safe(p, e); + } + else { + RETVAL = isPUNCT_utf8(p); + } OUTPUT: RETVAL bool -test_isPUNCT_LC_utf8(unsigned char * p) +test_isPUNCT_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isPUNCT_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isPUNCT_LC_utf8_safe(p, e); + } + else { + RETVAL = isPUNCT_LC_utf8(p); + } OUTPUT: RETVAL @@ -5170,6 +5675,13 @@ test_isXDIGIT_uni(UV ord) RETVAL bool +test_isXDIGIT_uvchr(UV ord) + CODE: + RETVAL = isXDIGIT_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isXDIGIT_LC_uvchr(UV ord) CODE: RETVAL = isXDIGIT_LC_uvchr(ord); @@ -5177,6 +5689,13 @@ test_isXDIGIT_LC_uvchr(UV ord) RETVAL bool +test_isXDIGIT(UV ord) + CODE: + RETVAL = isXDIGIT(ord); + OUTPUT: + RETVAL + +bool test_isXDIGIT_A(UV ord) CODE: RETVAL = isXDIGIT_A(ord); @@ -5198,16 +5717,32 @@ test_isXDIGIT_LC(UV ord) RETVAL bool -test_isXDIGIT_utf8(unsigned char * p) +test_isXDIGIT_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isXDIGIT_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isXDIGIT_utf8_safe(p, e); + } + else { + RETVAL = isXDIGIT_utf8(p); + } OUTPUT: RETVAL bool -test_isXDIGIT_LC_utf8(unsigned char * p) +test_isXDIGIT_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isXDIGIT_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isXDIGIT_LC_utf8_safe(p, e); + } + else { + RETVAL = isXDIGIT_LC_utf8(p); + } OUTPUT: RETVAL @@ -5219,6 +5754,13 @@ test_isPSXSPC_uni(UV ord) RETVAL bool +test_isPSXSPC_uvchr(UV ord) + CODE: + RETVAL = isPSXSPC_uvchr(ord); + OUTPUT: + RETVAL + +bool test_isPSXSPC_LC_uvchr(UV ord) CODE: RETVAL = isPSXSPC_LC_uvchr(ord); @@ -5226,6 +5768,13 @@ test_isPSXSPC_LC_uvchr(UV ord) RETVAL bool +test_isPSXSPC(UV ord) + CODE: + RETVAL = isPSXSPC(ord); + OUTPUT: + RETVAL + +bool test_isPSXSPC_A(UV ord) CODE: RETVAL = isPSXSPC_A(ord); @@ -5247,16 +5796,32 @@ test_isPSXSPC_LC(UV ord) RETVAL bool -test_isPSXSPC_utf8(unsigned char * p) +test_isPSXSPC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isPSXSPC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isPSXSPC_utf8_safe(p, e); + } + else { + RETVAL = isPSXSPC_utf8(p); + } OUTPUT: RETVAL bool -test_isPSXSPC_LC_utf8(unsigned char * p) +test_isPSXSPC_LC_utf8(unsigned char * p, int type) + PREINIT: + const unsigned char * e; CODE: - RETVAL = isPSXSPC_LC_utf8( p); + if (type >= 0) { + e = p + UTF8SKIP(p) - type; + RETVAL = isPSXSPC_LC_utf8_safe(p, e); + } + else { + RETVAL = isPSXSPC_LC_utf8(p); + } OUTPUT: RETVAL @@ -5618,17 +6183,51 @@ test_toLOWER_uni(UV ord) RETVAL AV * -test_toLOWER_utf8(SV * p) +test_toLOWER_uvchr(UV ord) + PREINIT: + U8 s[UTF8_MAXBYTES_CASE + 1]; + STRLEN len; + AV *av; + SV *utf8; + CODE: + av = newAV(); + av_push(av, newSVuv(toLOWER_uvchr(ord, s, &len))); + + utf8 = newSVpvn((char *) s, len); + SvUTF8_on(utf8); + av_push(av, utf8); + + av_push(av, newSVuv(len)); + RETVAL = av; + OUTPUT: + RETVAL + +AV * +test_toLOWER_utf8(SV * p, int type) PREINIT: U8 *input; U8 s[UTF8_MAXBYTES_CASE + 1]; STRLEN len; AV *av; SV *utf8; + const unsigned char * e; + UV resultant_cp = UV_MAX; /* Initialized because of dumb compilers */ CODE: input = (U8 *) SvPV(p, len); av = newAV(); - av_push(av, newSVuv(toLOWER_utf8(input, s, &len))); + if (type >= 0) { + e = input + UTF8SKIP(input) - type; + resultant_cp = toLOWER_utf8_safe(input, e, s, &len); + } + else if (type == -1) { + resultant_cp = toLOWER_utf8(input, s, &len); + } +#ifndef NO_MATHOMS + else { + resultant_cp = Perl_to_utf8_lower(aTHX_ input, s, &len); + } +#endif + av_push(av, newSVuv(resultant_cp)); utf8 = newSVpvn((char *) s, len); SvUTF8_on(utf8); @@ -5674,17 +6273,51 @@ test_toFOLD_uni(UV ord) RETVAL AV * -test_toFOLD_utf8(SV * p) +test_toFOLD_uvchr(UV ord) + PREINIT: + U8 s[UTF8_MAXBYTES_CASE + 1]; + STRLEN len; + AV *av; + SV *utf8; + CODE: + av = newAV(); + av_push(av, newSVuv(toFOLD_uvchr(ord, s, &len))); + + utf8 = newSVpvn((char *) s, len); + SvUTF8_on(utf8); + av_push(av, utf8); + + av_push(av, newSVuv(len)); + RETVAL = av; + OUTPUT: + RETVAL + +AV * +test_toFOLD_utf8(SV * p, int type) PREINIT: U8 *input; U8 s[UTF8_MAXBYTES_CASE + 1]; STRLEN len; AV *av; SV *utf8; + const unsigned char * e; + UV resultant_cp = UV_MAX; CODE: input = (U8 *) SvPV(p, len); av = newAV(); - av_push(av, newSVuv(toFOLD_utf8(input, s, &len))); + if (type >= 0) { + e = input + UTF8SKIP(input) - type; + resultant_cp = toFOLD_utf8_safe(input, e, s, &len); + } + else if (type == -1) { + resultant_cp = toFOLD_utf8(input, s, &len); + } +#ifndef NO_MATHOMS + else { + resultant_cp = Perl_to_utf8_fold(aTHX_ input, s, &len); + } +#endif + av_push(av, newSVuv(resultant_cp)); utf8 = newSVpvn((char *) s, len); SvUTF8_on(utf8); @@ -5730,17 +6363,51 @@ test_toUPPER_uni(UV ord) RETVAL AV * -test_toUPPER_utf8(SV * p) +test_toUPPER_uvchr(UV ord) + PREINIT: + U8 s[UTF8_MAXBYTES_CASE + 1]; + STRLEN len; + AV *av; + SV *utf8; + CODE: + av = newAV(); + av_push(av, newSVuv(toUPPER_uvchr(ord, s, &len))); + + utf8 = newSVpvn((char *) s, len); + SvUTF8_on(utf8); + av_push(av, utf8); + + av_push(av, newSVuv(len)); + RETVAL = av; + OUTPUT: + RETVAL + +AV * +test_toUPPER_utf8(SV * p, int type) PREINIT: U8 *input; U8 s[UTF8_MAXBYTES_CASE + 1]; STRLEN len; AV *av; SV *utf8; + const unsigned char * e; + UV resultant_cp = UV_MAX; CODE: input = (U8 *) SvPV(p, len); av = newAV(); - av_push(av, newSVuv(toUPPER_utf8(input, s, &len))); + if (type >= 0) { + e = input + UTF8SKIP(input) - type; + resultant_cp = toUPPER_utf8_safe(input, e, s, &len); + } + else if (type == -1) { + resultant_cp = toUPPER_utf8(input, s, &len); + } +#ifndef NO_MATHOMS + else { + resultant_cp = Perl_to_utf8_upper(aTHX_ input, s, &len); + } +#endif + av_push(av, newSVuv(resultant_cp)); utf8 = newSVpvn((char *) s, len); SvUTF8_on(utf8); @@ -5779,17 +6446,51 @@ test_toTITLE_uni(UV ord) RETVAL AV * -test_toTITLE_utf8(SV * p) +test_toTITLE_uvchr(UV ord) + PREINIT: + U8 s[UTF8_MAXBYTES_CASE + 1]; + STRLEN len; + AV *av; + SV *utf8; + CODE: + av = newAV(); + av_push(av, newSVuv(toTITLE_uvchr(ord, s, &len))); + + utf8 = newSVpvn((char *) s, len); + SvUTF8_on(utf8); + av_push(av, utf8); + + av_push(av, newSVuv(len)); + RETVAL = av; + OUTPUT: + RETVAL + +AV * +test_toTITLE_utf8(SV * p, int type) PREINIT: U8 *input; U8 s[UTF8_MAXBYTES_CASE + 1]; STRLEN len; AV *av; SV *utf8; + const unsigned char * e; + UV resultant_cp = UV_MAX; CODE: input = (U8 *) SvPV(p, len); av = newAV(); - av_push(av, newSVuv(toTITLE_utf8(input, s, &len))); + if (type >= 0) { + e = input + UTF8SKIP(input) - type; + resultant_cp = toTITLE_utf8_safe(input, e, s, &len); + } + else if (type == -1) { + resultant_cp = toTITLE_utf8(input, s, &len); + } +#ifndef NO_MATHOMS + else { + resultant_cp = Perl_to_utf8_title(aTHX_ input, s, &len); + } +#endif + av_push(av, newSVuv(resultant_cp)); utf8 = newSVpvn((char *) s, len); SvUTF8_on(utf8); diff --git a/ext/XS-APItest/Makefile.PL b/ext/XS-APItest/Makefile.PL index c06fac6..24078a6 100644 --- a/ext/XS-APItest/Makefile.PL +++ b/ext/XS-APItest/Makefile.PL @@ -31,7 +31,7 @@ my @names = (qw(HV_DELETE HV_DISABLE_UVAR_XKEY HV_FETCH_ISSTORE ), {name=>"G_WANT", default=>["IV", "G_ARRAY|G_VOID"]}); -open my $fh, '../../overload.h' or die "Can't open ../../overload.h: $!"; +open my $fh, '<', '../../overload.h' or die "Can't open ../../overload.h: $!"; while (<$fh>) { push @names, {name => $1, macro => 1} if /^\s+([A-Za-z_0-9]+_amg),/; } @@ -59,7 +59,8 @@ sub MY::postamble DTRACE_D = ../../perldtrace.d dtrace\$(OBJ_EXT): \$(DTRACE_D) core\$(OBJ_EXT) - $Config{dtrace} -G -s \$(DTRACE_D) -o dtrace\$(OBJ_EXT) core\$(OBJ_EXT) + $Config{dtrace} -G -s \$(DTRACE_D) -o dtrace\$(OBJ_EXT) core\$(OBJ_EXT) || \\ + ( \$(ECHO) >dtrace.c && \$(CCCMD) \$(CCCDLFLAGS) dtrace.c && rm -f dtrace.c ) POSTAMBLE return $post; diff --git a/ext/XS-APItest/t/handy.t b/ext/XS-APItest/t/handy.t index a85f701..5ae97cd 100644 --- a/ext/XS-APItest/t/handy.t +++ b/ext/XS-APItest/t/handy.t @@ -11,33 +11,126 @@ use Config; use XS::APItest; -use Unicode::UCD qw(prop_invlist prop_invmap); +my $tab = " " x 4; # Indent subsidiary tests this much + +use Unicode::UCD qw(search_invlist prop_invmap prop_invlist); +my ($charname_list, $charname_map, $format, $default) = prop_invmap("Name Alias"); + +sub get_charname($) { + my $cp = shift; + + # If there is a an abbreviation for the code point name, use it + my $name_index = search_invlist(\@{$charname_list}, $cp); + if (defined $name_index) { + my $synonyms = $charname_map->[$name_index]; + if (ref $synonyms) { + my $pat = qr/: abbreviation/; + my @abbreviations = grep { $_ =~ $pat } @$synonyms; + if (@abbreviations) { + return $abbreviations[0] =~ s/$pat//r; + } + } + } + + # Otherwise, use the full name + use charnames (); + return charnames::viacode($cp) // "No name"; +} sub truth($) { # Converts values so is() works return (shift) ? 1 : 0; } -my $locale; +my $base_locale; my $utf8_locale; if(locales_enabled('LC_ALL')) { require POSIX; - $locale = POSIX::setlocale( &POSIX::LC_ALL, "C"); - if (defined $locale && $locale eq 'C') { + $base_locale = POSIX::setlocale( &POSIX::LC_ALL, "C"); + if (defined $base_locale && $base_locale eq 'C') { use locale; # make \w work right in non-ASCII lands # Some locale implementations don't have the 128-255 characters all # mean nothing. Skip the locale tests in that situation - for my $i (128 .. 255) { - if (chr(utf8::unicode_to_native($i)) =~ /[[:print:]]/) { - undef $locale; + for my $u (128 .. 255) { + if (chr(utf8::unicode_to_native($u)) =~ /[[:print:]]/) { + undef $base_locale; last; } } - $utf8_locale = find_utf8_ctype_locale(); + $utf8_locale = find_utf8_ctype_locale() if $base_locale; } } +sub get_display_locale_or_skip($$) { + + # Helper function intimately tied to its callers. It knows the loop + # iterates with a locale of "", meaning don't use locale; $base_locale + # meaning to use a non-UTF-8 locale; and $utf8_locale. + # + # It checks to see if the current test should be skipped or executed, + # returning an empty list for the former, and for the latter: + # ( 'locale display name', + # bool of is this a UTF-8 locale ) + # + # The display name is the empty string if not using locale. Functions + # with _LC in their name are skipped unless in locale, and functions + # without _LC are executed only outside locale. + + my ($locale, $suffix) = @_; + + # The test should be skipped if the input is for a non-existent locale + return unless defined $locale; + + # Here the input is defined, either a locale name or "". If the test is + # for not using locales, we want to do the test for non-LC functions, + # and skip it for LC ones. + if ($locale eq "") { + return ("", 0) if $suffix !~ /LC/; + return; + } + + # Here the input is for a real locale. We don't test the non-LC functions + # for locales. + return if $suffix !~ /LC/; + + # Here is for a LC function and a real locale. The base locale is not + # UTF-8. + return (" ($locale locale)", 0) if $locale eq $base_locale; + + # The only other possibility is that we have a UTF-8 locale + return (" ($locale)", 1); +} + +sub try_malforming($$$) +{ + # Determines if the tests for malformed UTF-8 should be done. When done, + # the .xs code creates malformations by pretending the length is shorter + # than it actually is. Some things can't be malformed, and sometimes this + # test knows that the current code doesn't look for a malformation under + # various circumstances. + + my ($u, $function, $using_locale) = @_; + # $u is unicode code point; + + # Single bytes can't be malformed + return 0 if $u < ((ord "A" == 65) ? 128 : 160); + + # ASCII doesn't need to ever look beyond the first byte. + return 0 if $function eq "ASCII"; + + # Nor, on EBCDIC systems, does CNTRL + return 0 if ord "A" != 65 && $function eq "CNTRL"; + + # No controls above 255, so the code doesn't look at those + return 0 if $u > 255 && $function eq "CNTRL"; + + # No non-ASCII digits below 256, except if using locales. + return 0 if $u < 256 && ! $using_locale && $function =~ /X?DIGIT/; + + return 1; +} + my %properties = ( # name => Lookup-property name alnum => 'Word', @@ -62,20 +155,34 @@ my %properties = ( xdigit => 'XDigit', ); +my %seen; my @warnings; local $SIG{__WARN__} = sub { push @warnings, @_ }; -use charnames (); -foreach my $name (sort keys %properties) { - my $property = $properties{$name}; - my @invlist = prop_invlist($property, '_perl_core_internal_ok'); - if (! @invlist) { - - # An empty return could mean an unknown property, or merely that it is - # empty. Call in scalar context to differentiate - if (! prop_invlist($property, '_perl_core_internal_ok')) { - fail("No inversion list found for $property"); - next; +my %utf8_param_code = ( + "_safe" => 0, + "_safe, malformed" => 1, + "deprecated unsafe" => -1, + "deprecated mathoms" => -2, + ); + +foreach my $name (sort keys %properties, 'octal') { + my @invlist; + if ($name eq 'octal') { + # Hand-roll an inversion list with 0-7 in it and nothing else. + push @invlist, ord "0", ord "8"; + } + else { + my $property = $properties{$name}; + @invlist = prop_invlist($property, '_perl_core_internal_ok'); + if (! @invlist) { + + # An empty return could mean an unknown property, or merely that + # it is empty. Call in scalar context to differentiate + if (! prop_invlist($property, '_perl_core_internal_ok')) { + fail("No inversion list found for $property"); + next; + } } } @@ -103,11 +210,15 @@ foreach my $name (sort keys %properties) { push @code_points, 0x110000; # Above Unicode, no prop should match no warnings 'non_unicode'; - for my $j (@code_points) { - my $i = utf8::native_to_unicode($j); + for my $n (@code_points) { + my $u = utf8::native_to_unicode($n); my $function = uc($name); - my $matches = Unicode::UCD::search_invlist(\@invlist, $i); + is (@warnings, 0, "Got no unexpected warnings in previous iteration") + or diag("@warnings"); + undef @warnings; + + my $matches = search_invlist(\@invlist, $n); if (! defined $matches) { $matches = 0; } @@ -116,165 +227,163 @@ foreach my $name (sort keys %properties) { } my $ret; - my $char_name = charnames::viacode($i) // "No name"; - my $display_name = sprintf "\\x{%02X, %s}", $i, $char_name; - - if ($name eq 'quotemeta') { # There is only one macro for this, and is - # defined only for Latin1 range - $ret = truth eval "test_is${function}($i)"; - if ($@) { - fail $@; - } - else { - my $truth = truth($matches && $i < 256); - is ($ret, $truth, "is${function}( $display_name ) == $truth"); - } - next; - } - - # vertws is always all of Unicode; ALNUM_A and ALNUM_L1 are not - # defined as they were added later, after WORDCHAR was created to be a - # clearer synonym for ALNUM - if ($name ne 'vertws') { - if ($name ne 'alnum') { - $ret = truth eval "test_is${function}_A($i)"; - if ($@) { - fail($@); - } - else { - my $truth = truth($matches && utf8::native_to_unicode($i) < 128); - is ($ret, $truth, "is${function}_A( $display_name ) == $truth"); - } - $ret = truth eval "test_is${function}_L1($i)"; - if ($@) { - fail($@); - } - else { - my $truth = truth($matches && $i < 256); - is ($ret, $truth, "is${function}_L1( $display_name ) == $truth"); - } - } - - if (defined $locale) { - use locale; - POSIX::setlocale( &POSIX::LC_ALL, "C"); - $ret = truth eval "test_is${function}_LC($i)"; - if ($@) { - fail($@); - } - else { - my $truth = truth($matches && utf8::native_to_unicode($i) < 128); - is ($ret, $truth, "is${function}_LC( $display_name ) == $truth (C locale)"); - } - } - - if (defined $utf8_locale) { - use locale; + my $char_name = get_charname($n); + my $display_name = sprintf "\\x{%02X, %s}", $n, $char_name; + my $display_call = "is${function}( $display_name )"; - POSIX::setlocale( &POSIX::LC_ALL, $utf8_locale); - $ret = truth eval "test_is${function}_LC($i)"; - if ($@) { - fail($@); - } - else { - - # UTF-8 locale works on full range 0-255 - my $truth = truth($matches && $i < 256); - is ($ret, $truth, "is${function}_LC( $display_name ) == $truth ($utf8_locale)"); - } - } - } - - $ret = truth eval "test_is${function}_uni($i)"; - if ($@) { - fail($@); - } - else { - is ($ret, $matches, "is${function}_uni( $display_name ) == $matches"); - } - - if (defined $locale && $name ne 'vertws') { - use locale; - POSIX::setlocale( &POSIX::LC_ALL, "C"); - $ret = truth eval "test_is${function}_LC_uvchr('$i')"; - if ($@) { - fail($@); - } - else { - my $truth = truth($matches && (utf8::native_to_unicode($i) < 128 || $i > 255)); - is ($ret, $truth, "is${function}_LC_uvchr( $display_name ) == $truth (C locale)"); - } - } + foreach my $suffix ("", "_A", "_L1", "_LC", "_uni", "_uvchr", + "_LC_uvchr", "_utf8", "_LC_utf8") + { - if (defined $utf8_locale && $name ne 'vertws') { - use locale; + # Not all possible macros have been defined + if ($name eq 'vertws') { - POSIX::setlocale( &POSIX::LC_ALL, $utf8_locale); - $ret = truth eval "test_is${function}_LC_uvchr('$i')"; - if ($@) { - fail($@); + # vertws is always all of Unicode + next if $suffix !~ / ^ _ ( uni | uvchr | utf8 ) $ /x; } - else { - my $truth = truth($matches); - is ($ret, $truth, "is${function}_LC_uvchr( $display_name ) == $truth ($utf8_locale)"); + elsif ($name eq 'alnum') { + + # ALNUM_A, ALNUM_L1, and ALNUM_uvchr are not defined as these + # suffixes were added later, after WORDCHAR was created to be + # a clearer synonym for ALNUM + next if $suffix eq '_A' + || $suffix eq '_L1' + || $suffix eq '_uvchr'; } - } - - my $char = chr($i); - utf8::upgrade($char); - $char = quotemeta $char if $char eq '\\' || $char eq "'"; - $ret = truth eval "test_is${function}_utf8('$char')"; - if ($@) { - fail($@); - } - else { - is ($ret, $matches, "is${function}_utf8( $display_name ) == $matches"); - } - - if ($name ne 'vertws' && defined $locale) { - use locale; - POSIX::setlocale( &POSIX::LC_ALL, "C"); - $ret = truth eval "test_is${function}_LC_utf8('$char')"; - if ($@) { - fail($@); + elsif ($name eq 'octal') { + next if $suffix ne "" && $suffix ne '_A' && $suffix ne '_L1'; } - else { - my $truth = truth($matches && (utf8::native_to_unicode($i) < 128 || $i > 255)); - is ($ret, $truth, "is${function}_LC_utf8( $display_name ) == $truth (C locale)"); + elsif ($name eq 'quotemeta') { + # There is only one macro for this, and is defined only for + # Latin1 range + next if $suffix ne "" } - } - if ($name ne 'vertws' && defined $utf8_locale) { - use locale; + foreach my $locale ("", $base_locale, $utf8_locale) { + + my ($display_locale, $locale_is_utf8) + = get_display_locale_or_skip($locale, $suffix); + next unless defined $display_locale; + + use if $locale, "locale"; + POSIX::setlocale( &POSIX::LC_ALL, $locale) if $locale; + + if ($suffix !~ /utf8/) { # _utf8 has to handled specially + my $display_call + = "is${function}$suffix( $display_name )$display_locale"; + $ret = truth eval "test_is${function}$suffix($n)"; + if (is ($@, "", "$display_call didn't give error")) { + my $truth = $matches; + if ($truth) { + + # The single byte functions are false for + # above-Latin1 + if ($n >= 256) { + $truth = 0 + if $suffix=~ / ^ ( _A | _L [1C] )? $ /x; + } + elsif ( $u >= 128 + && $name ne 'quotemeta') + { + + # The no-suffix and _A functions are false + # for non-ASCII. So are _LC functions on a + # non-UTF-8 locale + $truth = 0 if $suffix eq "_A" + || $suffix eq "" + || ( $suffix =~ /LC/ + && ! $locale_is_utf8); + } + } + + is ($ret, $truth, "${tab}And correctly returns $truth"); + } + } + else { # _utf8 suffix + my $char = chr($n); + utf8::upgrade($char); + $char = quotemeta $char if $char eq '\\' || $char eq "'"; + my $truth; + if ( $suffix =~ /LC/ + && ! $locale_is_utf8 + && $n < 256 + && $u >= 128) + { # The C-locale _LC function returns FALSE for Latin1 + # above ASCII + $truth = 0; + } + else { + $truth = $matches; + } - POSIX::setlocale( &POSIX::LC_ALL, $utf8_locale); - $ret = truth eval "test_is${function}_LC_utf8('$char')"; - if ($@) { - fail($@); - } - else { - my $truth = truth($matches); - is ($ret, $truth, "is${function}_LC_utf8( $display_name ) == $truth ($utf8_locale)"); + foreach my $utf8_param("_safe", + "_safe, malformed", + "deprecated unsafe" + ) + { + my $utf8_param_code = $utf8_param_code{$utf8_param}; + my $expect_error = $utf8_param_code > 0; + next if $expect_error + && ! try_malforming($u, $function, + $suffix =~ /LC/); + + my $display_call = "is${function}$suffix( $display_name" + . ", $utf8_param )$display_locale"; + $ret = truth eval "test_is${function}$suffix('$char'," + . " $utf8_param_code)"; + if ($expect_error) { + isnt ($@, "", + "expected and got error in $display_call"); + like($@, qr/Malformed UTF-8 character/, + "${tab}And got expected message"); + if (is (@warnings, 1, + "${tab}Got a single warning besides")) + { + like($warnings[0], + qr/Malformed UTF-8 character.*short/, + "${tab}Got expected warning"); + } + else { + diag("@warnings"); + } + undef @warnings; + } + elsif (is ($@, "", "$display_call didn't give error")) { + is ($ret, $truth, + "${tab}And correctly returned $truth"); + if ($utf8_param_code < 0) { + my $warnings_ok; + my $unique_function = "is" . $function . $suffix; + if (! $seen{$unique_function}++) { + $warnings_ok = is(@warnings, 1, + "${tab}This is first call to" + . " $unique_function; Got a single" + . " warning"); + if ($warnings_ok) { + $warnings_ok = like($warnings[0], + qr/starting in Perl .* will require an additional parameter/, + "${tab}The warning was the expected" + . " deprecation one"); + } + } + else { + $warnings_ok = is(@warnings, 0, + "${tab}This subsequent call to" + . " $unique_function did not warn"); + } + $warnings_ok or diag("@warnings"); + undef @warnings; + } + } + } + } } } } } -# 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', + FOLD => 'Case_Folding', LOWER => 'Lowercase_Mapping', TITLE => 'Titlecase_Mapping', UPPER => 'Uppercase_Mapping', @@ -305,12 +414,14 @@ foreach my $name (sort keys %to_properties) { my $range_start = $list_ref->[$i]; next if $range_start < 257; if (ref $map_ref->[$i] && $multi_char < 5) { - push @code_points, $range_start - 1 if $code_points[-1] != $range_start - 1; + push @code_points, $range_start - 1 + if $code_points[-1] != $range_start - 1; push @code_points, $range_start; $multi_char++; } elsif ($above_latins < 5) { - push @code_points, $range_start - 1 if $code_points[-1] != $range_start - 1; + push @code_points, $range_start - 1 + if $code_points[-1] != $range_start - 1; push @code_points, $range_start; $above_latins++; } @@ -321,140 +432,177 @@ foreach my $name (sort keys %to_properties) { push @code_points, 0x110000; # Above Unicode, no prop should match no warnings 'non_unicode'; - # $j is native; $i unicode. - for my $j (@code_points) { - my $i = utf8::native_to_unicode($j); + # $n is native; $u unicode. + for my $n (@code_points) { + my $u = utf8::native_to_unicode($n); my $function = $name; - my $index = Unicode::UCD::search_invlist(\@{$list_ref}, $j); + my $index = search_invlist(\@{$list_ref}, $n); my $ret; - my $char_name = charnames::viacode($j) // "No name"; - my $display_name = sprintf "\\N{U+%02X, %s}", $i, $char_name; + my $char_name = get_charname($n); + my $display_name = sprintf "\\N{U+%02X, %s}", $n, $char_name; - # Test the base function - $ret = eval "test_to${function}($j)"; - if ($@) { - fail($@); - } - else { - my $should_be = ($i < 128 && $map_ref->[$index] != $missing) - ? $map_ref->[$index] + $j - $list_ref->[$index] - : $j; - is ($ret, $should_be, sprintf("to${function}( $display_name ) == 0x%02X", $should_be)); - } + foreach my $suffix ("", "_L1", "_LC") { - # Test _L1 - if ($name eq 'LOWER') { - $ret = eval "test_to${function}_L1($j)"; - if ($@) { - fail($@); - } - else { - my $should_be = ($i < 256 && $map_ref->[$index] != $missing) - ? $map_ref->[$index] + $j - $list_ref->[$index] - : $j; - is ($ret, $should_be, sprintf("to${function}_L1( $display_name ) == 0x%02X", $should_be)); - } - } + # This is the only macro defined for L1 + next if $suffix eq "_L1" && $function ne "LOWER"; - if ($name ne 'TITLE') { # Test _LC; titlecase is not defined in locales. - if (defined $locale) { - use locale; - POSIX::setlocale( &POSIX::LC_ALL, "C"); - $ret = eval "test_to${function}_LC($j)"; - if ($@) { - fail($@); - } - else { - my $should_be = ($i < 128 && $map_ref->[$index] != $missing) - ? $map_ref->[$index] + $j - $list_ref->[$index] - : $j; - is ($ret, $should_be, sprintf("to${function}_LC( $display_name ) == 0x%02X (C locale)", $should_be)); - } - } + SKIP: + foreach my $locale ("", $base_locale, $utf8_locale) { - if (defined $utf8_locale) { - use locale; + # titlecase is not defined in locales. + next if $name eq 'TITLE' && $suffix eq "_LC"; - SKIP: { - skip "to${property}_LC does not work for LATIN SMALL LETTER SHARP S", 1 - if $j == 0xDF && ($name eq 'FOLD' || $name eq 'UPPER'); + my ($display_locale, $locale_is_utf8) + = get_display_locale_or_skip($locale, $suffix); + next unless defined $display_locale; - POSIX::setlocale( &POSIX::LC_ALL, $utf8_locale); - $ret = eval "test_to${function}_LC($j)"; - if ($@) { - fail($@); + skip("to${name}_LC does not work for LATIN SMALL LETTER SHARP S" + . "$display_locale", 1) + if $u == 0xDF && $name =~ / FOLD | UPPER /x + && $suffix eq "_LC" && $locale_is_utf8; + + use if $locale, "locale"; + POSIX::setlocale( &POSIX::LC_ALL, $locale) if $locale; + + my $display_call = "to${function}$suffix(" + . " $display_name )$display_locale"; + $ret = eval "test_to${function}$suffix($n)"; + if (is ($@, "", "$display_call didn't give error")) { + my $should_be; + if ($n > 255) { + $should_be = $n; + } + elsif ( $u > 127 + && ( $suffix eq "" + || ($suffix eq "_LC" && ! $locale_is_utf8))) + { + $should_be = $n; + } + elsif ($map_ref->[$index] != $missing) { + $should_be = $map_ref->[$index] + $n - $list_ref->[$index] } else { - my $should_be = ($i < 256 - && ! ref $map_ref->[$index] - && $map_ref->[$index] != $missing - ) - ? $map_ref->[$index] + $j - $list_ref->[$index] - : $j; - is ($ret, $should_be, sprintf("to${function}_LC( $display_name ) == 0x%02X ($utf8_locale)", $should_be)); + $should_be = $n; } + + is ($ret, $should_be, + sprintf("${tab}And correctly returned 0x%02X", + $should_be)); } } } - # The _uni and _utf8 functions return both the ordinal of the first - # code point of the result, and the result in utf8. The .xs tests - # return these in an array, in [0] and [1] respectively, with [2] the - # length of the utf8 in bytes. + # The _uni, uvchr, and _utf8 functions return both the ordinal of the + # first code point of the result, and the result in utf8. The .xs + # tests return these in an array, in [0] and [1] respectively, with + # [2] the length of the utf8 in bytes. my $utf8_should_be = ""; my $first_ord_should_be; if (ref $map_ref->[$index]) { # A multi-char result - for my $j (0 .. @{$map_ref->[$index]} - 1) { - $utf8_should_be .= chr $map_ref->[$index][$j]; + for my $n (0 .. @{$map_ref->[$index]} - 1) { + $utf8_should_be .= chr $map_ref->[$index][$n]; } $first_ord_should_be = $map_ref->[$index][0]; } else { # A single-char result $first_ord_should_be = ($map_ref->[$index] != $missing) - ? $map_ref->[$index] + $j - $list_ref->[$index] - : $j; + ? $map_ref->[$index] + $n + - $list_ref->[$index] + : $n; $utf8_should_be = chr $first_ord_should_be; } utf8::upgrade($utf8_should_be); - # Test _uni - my $s; - my $len; - $ret = eval "test_to${function}_uni($j)"; - if ($@) { - fail($@); - } - else { - is ($ret->[0], $first_ord_should_be, sprintf("to${function}_uni( $display_name ) == 0x%02X", $first_ord_should_be)); - is ($ret->[1], $utf8_should_be, sprintf("utf8 of to${function}_uni( $display_name )")); - use bytes; - is ($ret->[2], length $utf8_should_be, sprintf("number of bytes in utf8 of to${function}_uni( $display_name )")); + # Test _uni, uvchr + foreach my $suffix ('_uni', '_uvchr') { + my $s; + my $len; + my $display_call = "to${function}$suffix( $display_name )"; + $ret = eval "test_to${function}$suffix($n)"; + if (is ($@, "", "$display_call didn't give error")) { + is ($ret->[0], $first_ord_should_be, + sprintf("${tab}And correctly returned 0x%02X", + $first_ord_should_be)); + is ($ret->[1], $utf8_should_be, "${tab}Got correct utf8"); + use bytes; + is ($ret->[2], length $utf8_should_be, + "${tab}Got correct number of bytes for utf8 length"); + } } # Test _utf8 - my $char = chr($j); + my $char = chr($n); utf8::upgrade($char); $char = quotemeta $char if $char eq '\\' || $char eq "'"; - $ret = eval "test_to${function}_utf8('$char')"; - if ($@) { - fail($@); - } - else { - is ($ret->[0], $first_ord_should_be, sprintf("to${function}_utf8( $display_name ) == 0x%02X", $first_ord_should_be)); - is ($ret->[1], $utf8_should_be, sprintf("utf8 of to${function}_utf8( $display_name )")); - use bytes; - is ($ret->[2], length $utf8_should_be, sprintf("number of bytes in utf8 of to${function}_uni( $display_name )")); + foreach my $utf8_param("_safe", + "_safe, malformed", + "deprecated unsafe", + "deprecated mathoms", + ) + { + use Config; + next if $utf8_param eq 'deprecated mathoms' + && $Config{'ccflags'} =~ /-DNO_MATHOMS/; + + my $utf8_param_code = $utf8_param_code{$utf8_param}; + my $expect_error = $utf8_param_code > 0; + + # Skip if can't malform (because is a UTF-8 invariant) + next if $expect_error && $u < ((ord "A" == 65) ? 128 : 160); + + my $display_call = "to${function}_utf8($display_name, $utf8_param )"; + $ret = eval "test_to${function}_utf8('$char', $utf8_param_code)"; + if ($expect_error) { + isnt ($@, "", "expected and got error in $display_call"); + like($@, qr/Malformed UTF-8 character/, + "${tab}And got expected message"); + undef @warnings; + } + elsif (is ($@, "", "$display_call didn't give error")) { + is ($ret->[0], $first_ord_should_be, + sprintf("${tab}And correctly returned 0x%02X", + $first_ord_should_be)); + is ($ret->[1], $utf8_should_be, "${tab}Got correct utf8"); + use bytes; + is ($ret->[2], length $utf8_should_be, + "${tab}Got correct number of bytes for utf8 length"); + if ($utf8_param_code < 0) { + my $warnings_ok; + if (! $seen{"${function}_utf8$utf8_param"}++) { + $warnings_ok = is(@warnings, 1, + "${tab}Got a single warning"); + if ($warnings_ok) { + my $expected; + if ($utf8_param_code == -2) { + my $lc_func = lc $function; + $expected + = qr/starting in Perl .* to_utf8_$lc_func\(\) will be removed/; + } + else { + $expected + = qr/starting in Perl .* will require an additional parameter/; + } + $warnings_ok = like($warnings[0], $expected, + "${tab}Got expected deprecation warning"); + } + } + else { + $warnings_ok = is(@warnings, 0, + "${tab}Deprecation warned only the one time"); + } + $warnings_ok or diag("@warnings"); + undef @warnings; + } + } } - } } # This is primarily to make sure that no non-Unicode warnings get generated -unless (is(scalar @warnings, 0, "No warnings were generated")) { - diag @warnings; -} +is(scalar @warnings, 0, "No unexpected warnings were generated in the tests") + or diag @warnings; done_testing; diff --git a/ext/XS-APItest/t/printf.t b/ext/XS-APItest/t/printf.t index 8f43ee2..968fdc4 100644 --- a/ext/XS-APItest/t/printf.t +++ b/ext/XS-APItest/t/printf.t @@ -34,7 +34,7 @@ print_flush(); # Now redirect STDOUT and read from the file ok open(STDOUT, ">&", $oldout), "restore STDOUT"; -ok open(my $foo, "; diff --git a/ext/XS-APItest/t/utf8.t b/ext/XS-APItest/t/utf8.t index 05693c0..c7f2c1d 100644 --- a/ext/XS-APItest/t/utf8.t +++ b/ext/XS-APItest/t/utf8.t @@ -98,21 +98,23 @@ my $UTF8_GOT_NON_CONTINUATION = $UTF8_ALLOW_NON_CONTINUATION; my $UTF8_ALLOW_SHORT = 0x0008; my $UTF8_GOT_SHORT = $UTF8_ALLOW_SHORT; my $UTF8_ALLOW_LONG = 0x0010; +my $UTF8_ALLOW_LONG_AND_ITS_VALUE = $UTF8_ALLOW_LONG|0x0020; my $UTF8_GOT_LONG = $UTF8_ALLOW_LONG; -my $UTF8_GOT_OVERFLOW = 0x0020; -my $UTF8_DISALLOW_SURROGATE = 0x0040; +my $UTF8_ALLOW_OVERFLOW = 0x0080; +my $UTF8_GOT_OVERFLOW = $UTF8_ALLOW_OVERFLOW; +my $UTF8_DISALLOW_SURROGATE = 0x0100; my $UTF8_GOT_SURROGATE = $UTF8_DISALLOW_SURROGATE; -my $UTF8_WARN_SURROGATE = 0x0080; -my $UTF8_DISALLOW_NONCHAR = 0x0100; +my $UTF8_WARN_SURROGATE = 0x0200; +my $UTF8_DISALLOW_NONCHAR = 0x0400; my $UTF8_GOT_NONCHAR = $UTF8_DISALLOW_NONCHAR; -my $UTF8_WARN_NONCHAR = 0x0200; -my $UTF8_DISALLOW_SUPER = 0x0400; +my $UTF8_WARN_NONCHAR = 0x0800; +my $UTF8_DISALLOW_SUPER = 0x1000; my $UTF8_GOT_SUPER = $UTF8_DISALLOW_SUPER; -my $UTF8_WARN_SUPER = 0x0800; -my $UTF8_DISALLOW_ABOVE_31_BIT = 0x1000; +my $UTF8_WARN_SUPER = 0x2000; +my $UTF8_DISALLOW_ABOVE_31_BIT = 0x4000; my $UTF8_GOT_ABOVE_31_BIT = $UTF8_DISALLOW_ABOVE_31_BIT; -my $UTF8_WARN_ABOVE_31_BIT = 0x2000; -my $UTF8_CHECK_ONLY = 0x4000; +my $UTF8_WARN_ABOVE_31_BIT = 0x8000; +my $UTF8_CHECK_ONLY = 0x10000; my $UTF8_DISALLOW_ILLEGAL_C9_INTERCHANGE = $UTF8_DISALLOW_SUPER|$UTF8_DISALLOW_SURROGATE; my $UTF8_DISALLOW_ILLEGAL_INTERCHANGE @@ -1199,10 +1201,12 @@ my $REPLACEMENT = 0xFFFD; my @malformations = ( # ($testname, $bytes, $length, $allow_flags, $expected_error_flags, # $allowed_uv, $expected_len, $needed_to_discern_len, $message ) - [ "zero length string malformation", "", 0, - $UTF8_ALLOW_EMPTY, $UTF8_GOT_EMPTY, 0, 0, 0, - qr/empty string/ - ], + +# Now considered a program bug, and asserted against + #[ "zero length string malformation", "", 0, + # $UTF8_ALLOW_EMPTY, $UTF8_GOT_EMPTY, $REPLACEMENT, 0, 0, + # qr/empty string/ + #], [ "orphan continuation byte malformation", I8_to_native("${I8c}a"), 2, $UTF8_ALLOW_CONTINUATION, $UTF8_GOT_CONTINUATION, $REPLACEMENT, 1, 1, @@ -1344,8 +1348,7 @@ if (isASCII && ! $is64bit) { # 32-bit ASCII platform [ "overflow malformation", "\xfe\x84\x80\x80\x80\x80\x80", # Represents 2**32 7, - 0, # There is no way to allow this malformation - $UTF8_GOT_OVERFLOW, + $UTF8_ALLOW_OVERFLOW, $UTF8_GOT_OVERFLOW, $REPLACEMENT, 7, 2, qr/overflows/ @@ -1353,8 +1356,7 @@ if (isASCII && ! $is64bit) { # 32-bit ASCII platform [ "overflow malformation", "\xff\x80\x80\x80\x80\x80\x81\x80\x80\x80\x80\x80\x80", $max_bytes, - 0, # There is no way to allow this malformation - $UTF8_GOT_OVERFLOW, + $UTF8_ALLOW_OVERFLOW, $UTF8_GOT_OVERFLOW, $REPLACEMENT, $max_bytes, 1, qr/overflows/ @@ -1396,8 +1398,7 @@ else { # 64-bit ASCII, or EBCDIC of any size. I8_to_native( "\xff\xa0\xa0\xa0\xa0\xa0\xa0\xa4\xa0\xa0\xa0\xa0\xa0\xa0"), $max_bytes, - 0, # There is no way to allow this malformation - $UTF8_GOT_OVERFLOW, + $UTF8_ALLOW_OVERFLOW, $UTF8_GOT_OVERFLOW, $REPLACEMENT, $max_bytes, 8, qr/overflows/ @@ -1411,8 +1412,7 @@ else { # 64-bit ASCII, or EBCDIC of any size. : I8_to_native( "\xff\xb0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0\xa0"), $max_bytes, - 0, # There is no way to allow this malformation - $UTF8_GOT_OVERFLOW, + $UTF8_ALLOW_OVERFLOW, $UTF8_GOT_OVERFLOW, $REPLACEMENT, $max_bytes, (isASCII) ? 3 : 2, qr/overflows/ @@ -1420,6 +1420,29 @@ else { # 64-bit ASCII, or EBCDIC of any size. } } +# For each overlong malformation in the list, we modify it, so that there are +# two tests. The first one returns the replacement character given the input +# flags, and the second test adds a flag that causes the actual code point the +# malformation represents to be returned. +my @added_overlongs; +foreach my $test (@malformations) { + my ($testname, $bytes, $length, $allow_flags, $expected_error_flags, + $allowed_uv, $expected_len, $needed_to_discern_len, $message ) = @$test; + next unless $testname =~ /overlong/; + + $test->[0] .= "; use REPLACEMENT CHAR"; + $test->[5] = $REPLACEMENT; + + push @added_overlongs, + [ $testname . "; use actual value", + $bytes, $length, + $allow_flags | $UTF8_ALLOW_LONG_AND_ITS_VALUE, + $expected_error_flags, $allowed_uv, $expected_len, + $needed_to_discern_len, $message + ]; +} +push @malformations, @added_overlongs; + foreach my $test (@malformations) { my ($testname, $bytes, $length, $allow_flags, $expected_error_flags, $allowed_uv, $expected_len, $needed_to_discern_len, $message ) = @$test; diff --git a/ext/XS-Typemap/t/Typemap.t b/ext/XS-Typemap/t/Typemap.t index 46ab20f..3e56b57 100644 --- a/ext/XS-Typemap/t/Typemap.t +++ b/ext/XS-Typemap/t/Typemap.t @@ -381,7 +381,7 @@ if (defined $fh) { ok( $Config{useperlio} ? T_STDIO_close( $fh ) : close( $fh ) ); # open from perl, and check contents - open($fh, "< $testfile"); + open($fh, '<', $testfile); ok($fh); my $line = <$fh>; is($line,$lines[0]); diff --git a/ext/attributes/attributes.pm b/ext/attributes/attributes.pm index 67662e4..7eb8e30 100644 --- a/ext/attributes/attributes.pm +++ b/ext/attributes/attributes.pm @@ -1,6 +1,6 @@ package attributes; -our $VERSION = 0.28; +our $VERSION = 0.29; @EXPORT_OK = qw(get reftype); @EXPORT = (); @@ -38,7 +38,8 @@ sub _modify_attrs_and_deprecate { grep { $deprecated{$svtype} && /$deprecated{$svtype}/ ? do { require warnings; - warnings::warnif('deprecated', "Attribute \"$1\" is deprecated"); + warnings::warnif('deprecated', "Attribute \"$1\" is deprecated, " . + "and will disappear in Perl 5.28"); 0; } : $svtype eq 'CODE' && exists $msg{$_} ? do { require warnings; @@ -258,7 +259,8 @@ attribute will be sanity checked at compile time. =item locked The "locked" attribute is deprecated, and has no effect in 5.10.0 and later. -It was used as part of the now-removed "Perl 5.005 threads". +It was used as part of the now-removed "Perl 5.005 threads". It will +disappear in Perl 5.28, after which its use will be fatal. =item const @@ -283,7 +285,8 @@ when used in conjunction with the L and L modules. The "unique" attribute is deprecated, and has no effect in 5.10.0 and later. It used to indicate that a single copy of an C variable was to be used by all interpreters should the program happen to be running in a -multi-interpreter environment. +multi-interpreter environment. It will disappear in 5.28, after which its +use will be fatal. =back diff --git a/ext/re/re.pm b/ext/re/re.pm index b924fd9..c416b94 100644 --- a/ext/re/re.pm +++ b/ext/re/re.pm @@ -4,7 +4,7 @@ package re; use strict; use warnings; -our $VERSION = "0.33"; +our $VERSION = "0.34"; our @ISA = qw(Exporter); our @EXPORT_OK = ('regmust', qw(is_regexp regexp_pattern @@ -23,6 +23,7 @@ my %reflags = ( s => 1 << ($PMMOD_SHIFT + 1), i => 1 << ($PMMOD_SHIFT + 2), x => 1 << ($PMMOD_SHIFT + 3), + xx => 1 << ($PMMOD_SHIFT + 4), n => 1 << ($PMMOD_SHIFT + 5), p => 1 << ($PMMOD_SHIFT + 6), strict => 1 << ($PMMOD_SHIFT + 10), @@ -112,7 +113,6 @@ sub bits { my $on = shift; my $bits = 0; my $turning_all_off = ! @_ && ! $on; - my %seen; # Has flag already been seen? if ($turning_all_off) { # Pretend were called with certain parameters, which are best dealt @@ -180,6 +180,7 @@ sub bits { } elsif ($s =~ s/^\///) { my $reflags = $^H{reflags} || 0; my $seen_charset; + my $x_count = 0; while ($s =~ m/( . )/gx) { local $_ = $1; if (/[adul]/) { @@ -225,7 +226,19 @@ sub bits { && $^H{reflags_charset} == $reflags{$_}; } } elsif (exists $reflags{$_}) { - $seen{$_}++; + if ($_ eq 'x') { + $x_count++; + if ($x_count > 2) { + require Carp; + Carp::carp( + qq 'The "x" flag may only appear a maximum of twice' + ); + } + elsif ($x_count == 2) { + $_ = 'xx'; # First time through got the /x + } + } + $on ? $reflags |= $reflags{$_} : ($reflags &= ~$reflags{$_}); @@ -247,10 +260,6 @@ sub bits { ")"); } } - if (exists $seen{'x'} && $seen{'x'} > 1) { - require Carp; - Carp::croak("Only one /x regex modifier is allowed"); - } if ($turning_all_off) { _load_unload(0); @@ -323,7 +332,7 @@ re - Perl pragma to alter regular expression behaviour use re qw(is_regexp regexp_pattern); # import utility functions my ($pat,$mods)=regexp_pattern(qr/foo/i); - if (is_regexp($obj)) { + if (is_regexp($obj)) { print "Got regexp: ", scalar regexp_pattern($obj); # just as perl would stringify } # it but no hassle with blessed @@ -412,20 +421,34 @@ under non-strict. =head2 '/flags' mode -When C is specified, the given flags are automatically +When C'> is specified, the given I are automatically added to every regular expression till the end of the lexical scope. - -C will turn off the effect of C for the +I can be any combination of +C<'a'>, +C<'aa'>, +C<'d'>, +C<'i'>, +C<'l'>, +C<'m'>, +C<'n'>, +C<'p'>, +C<'s'>, +C<'u'>, +C<'x'>, +and/or +C<'xx'>. + +C'> will turn off the effect of C'> for the given flags. -For example, if you want all your regular expressions to have /msx on by +For example, if you want all your regular expressions to have /msxx on by default, simply put - use re '/msx'; + use re '/msxx'; at the top of your code. -The character set /adul flags cancel each other out. So, in this example, +The character set C flags cancel each other out. So, in this example, use re "/u"; "ss" =~ /\xdf/; @@ -434,6 +457,13 @@ The character set /adul flags cancel each other out. So, in this example, the second C does an implicit C. +Similarly, + + use re "/xx"; # Doubled-x + ... + use re "/x"; # Single x from here on + ... + Turning on one of the character set flags with C takes precedence over the C pragma and the 'unicode_strings' C, for regular expressions. Turning off one of these flags when it is active reverts to @@ -459,7 +489,7 @@ strings on/off, pre-point part on/off. See L for additional info. As of 5.9.5 the directive C and its equivalents are -lexically scoped, as the other directives are. However they have both +lexically scoped, as the other directives are. However they have both compile-time and run-time effects. See L. diff --git a/ext/re/t/reflags.t b/ext/re/t/reflags.t index a481c98..595b4b2 100644 --- a/ext/re/t/reflags.t +++ b/ext/re/t/reflags.t @@ -11,7 +11,7 @@ BEGIN { use strict; -use Test::More tests => 67; +use Test::More tests => 74; my @flags = qw( a d l u ); @@ -24,10 +24,19 @@ ok "Foo" !~ /(??{'foo'})/, 'no re "/i" (??{})'; use re '/x'; ok "foo" =~ / foo /, 'use re "/x"'; ok "foo" =~ / (??{' foo '}) /, 'use re "/x" (??{})'; +like " ", qr/[a b]/, 'use re "/x" [a b]'; no re '/x'; ok "foo" !~ / foo /, 'no re "/x"'; ok "foo" !~ /(??{' foo '})/, 'no re "/x" (??{})'; ok "foo" !~ / (??{'foo'}) /, 'no re "/x" (??{})'; +use re '/xx'; +ok "foo" =~ / foo /, 'use re "/xx"'; +ok "foo" =~ / (??{' foo '}) /, 'use re "/xx" (??{})'; +unlike " ", qr/[a b]/, 'use re "/xx" [a b] # Space in [] gobbled up'; +no re '/xx'; +ok "foo" !~ / foo /, 'no re "/xx"'; +ok "foo" !~ /(??{' foo '})/, 'no re "/xx" (??{})'; +ok "foo" !~ / (??{'foo'}) /, 'no re "/xx" (??{})'; use re '/s'; ok "\n" =~ /./, 'use re "/s"'; ok "\n" =~ /(??{'.'})/, 'use re "/s" (??{})'; @@ -178,8 +187,8 @@ is qr//, '(?^:)', 'no re "/aai"'; "warning with eval \"use re \"/amaa\""; $w = ""; - eval "use re '/xamax'"; - like $@, qr/Only one \/x regex modifier is allowed/, - "error with eval \"use re \"/xamax\""; + eval "use re '/xamaxx'"; + like $w, qr/The "x" flag may only appear a maximum of twice/, + "warning with eval \"use re \"/xamaxx\""; } diff --git a/gv.c b/gv.c index 775951b..fff8e95 100644 --- a/gv.c +++ b/gv.c @@ -1217,7 +1217,8 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) ) Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), "Use of inherited AUTOLOAD for non-method %" SVf - "::%" UTF8f "() is deprecated", + "::%" UTF8f "() is deprecated. This will be " + "fatal in Perl 5.28", SVfARG(packname), UTF8fARG(is_utf8, len, name)); @@ -1591,7 +1592,10 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, PERL_ARGS_ASSERT_PARSE_GV_STASH_NAME; - if (full_len > 2 && **name == '*' && isIDFIRST_lazy_if(*name + 1, is_utf8)) { + if ( full_len > 2 + && **name == '*' + && isIDFIRST_lazy_if_safe(*name + 1, name_end, is_utf8)) + { /* accidental stringify on a GV? */ (*name)++; } @@ -1676,7 +1680,7 @@ S_gv_is_in_main(pTHX_ const char *name, STRLEN len, const U32 is_utf8) PERL_ARGS_ASSERT_GV_IS_IN_MAIN; /* If it's an alphanumeric variable */ - if ( len && isIDFIRST_lazy_if(name, is_utf8) ) { + if ( len && isIDFIRST_lazy_if_safe(name, name + len, is_utf8) ) { /* Some "normal" variables are always in main::, * like INC or STDOUT. */ @@ -2153,9 +2157,10 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, case '*': /* $* */ case '#': /* $# */ if (sv_type == SVt_PV) - /* diag_listed_as: $* is no longer supported */ + /* diag_listed_as: $* is no longer supported. Its use will be fatal in Perl 5.30 */ Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "$%c is no longer supported", *name); + "$%c is no longer supported. Its use " + "will be fatal in Perl 5.30", *name); break; case '\010': /* $^H */ { @@ -2265,10 +2270,11 @@ S_maybe_multimagic_gv(pTHX_ GV *gv, const char *name, const svtype sv_type) require_tie_mod_s(gv, *name, "Tie::Hash::NamedCapture", 0); } else if (sv_type == SVt_PV) { if (*name == '*' || *name == '#') { - /* diag_listed_as: $* is no longer supported */ + /* diag_listed_as: $# is no longer supported. Its use will be fatal in Perl 5.30 */ Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), - "$%c is no longer supported", *name); + "$%c is no longer supported. Its use " + "will be fatal in Perl 5.30", *name); } } if (sv_type==SVt_PV || sv_type==SVt_PVGV) { @@ -2400,8 +2406,12 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, UTF8fARG(is_utf8, name_end-nambeg, nambeg)); gv_init_pvn(gv, stash, name, len, (add & GV_ADDMULTI)|is_utf8); - if ( isIDFIRST_lazy_if(name, is_utf8) && !ckWARN(WARN_ONCE) ) + if ( full_len != 0 + && isIDFIRST_lazy_if_safe(name, name + full_len, is_utf8) + && !ckWARN(WARN_ONCE) ) + { GvMULTI_on(gv) ; + } /* set up magic where warranted */ if ( gv_magicalize(gv, stash, name, len, sv_type) ) { @@ -2492,8 +2502,12 @@ Perl_gv_check(pTHX_ HV *stash) ) gv_check(hv); /* nested package */ } - else if ( *HeKEY(entry) != '_' - && isIDFIRST_lazy_if(HeKEY(entry), HeUTF8(entry)) ) { + else if ( HeKLEN(entry) != 0 + && *HeKEY(entry) != '_' + && isIDFIRST_lazy_if_safe(HeKEY(entry), + HeKEY(entry) + HeKLEN(entry), + HeUTF8(entry)) ) + { const char *file; gv = MUTABLE_GV(HeVAL(entry)); if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv)) diff --git a/h2pl/mksizes b/h2pl/mksizes index cb4b8ab..f28ba9e 100644 --- a/h2pl/mksizes +++ b/h2pl/mksizes @@ -2,7 +2,7 @@ ($iam = $0) =~ s%.*/%%; $tmp = "$iam.$$"; -open (CODE,">$tmp.c") || die "$iam: cannot create $tmp.c: $!\n"; +open (CODE, '>', "$tmp.c") || die "$iam: cannot create $tmp.c: $!\n"; $mask = q/printf ("$sizeof{'%s'} = %d;\n"/; diff --git a/h2pl/mkvars b/h2pl/mkvars index ffb0f0b..219c005 100644 --- a/h2pl/mkvars +++ b/h2pl/mkvars @@ -8,7 +8,7 @@ foreach $include (@ARGV) { printf STDERR "including %s\n", $include; do $include; warn "sourcing $include: $@\n" if ($@); - if (!open (INCLUDE,"$LIB/$include")) { + if (!open (INCLUDE,'<',"$LIB/$include")) { warn "can't open $LIB/$include: $!\n"; next; } diff --git a/handy.h b/handy.h index 848050f..4d2f4bc 100644 --- a/handy.h +++ b/handy.h @@ -548,29 +548,50 @@ represented by that octet is (or on non-ASCII platforms, corresponds to) an ASCII character in the named class based on platform, Unicode, and Perl rules. If the input is a number that doesn't fit in an octet, FALSE is returned. -Variant C (e.g., C) is identical to the base function +Variant C_A> (e.g., C) is identical to the base function with no suffix C<"_A">. This variant is used to emphasize by its name that only ASCII-range characters can return TRUE. -Variant C imposes the Latin-1 (or EBCDIC equivlalent) character set +Variant C_L1> imposes the Latin-1 (or EBCDIC equivalent) character set onto the platform. That is, the code points that are ASCII are unaffected, since ASCII is a subset of Latin-1. But the non-ASCII code points are treated as if they are Latin-1 characters. For example, C will return true when called with the code point 0xDF, which is a word character in both ASCII and EBCDIC (though it represents different characters in each). -Variant C is like the C variant, but accepts any UV code +Variant C_uvchr> is like the C_L1> variant, but accepts any UV code point as input. If the code point is larger than 255, Unicode rules are used to determine if it is in the character class. For example, C returns TRUE, since 0x100 is LATIN CAPITAL LETTER A WITH MACRON in Unicode, and is a word character. -Variant C is like C, but the input is a pointer to a -(known to be well-formed) UTF-8 encoded string (C or C, and -possibly containing embedded C characters). The classification of just -the first (possibly multi-byte) character in the string is tested. - -Variant C is like the C and C variants, but the +Variant C_utf8_safe> is like C_uvchr>, but is used for UTF-8 +encoded strings. Each call classifies one character, even if the string +contains many. This variant takes two parameters. The first, C

, is a +pointer to the first byte of the character to be classified. (Recall that it +may take more than one byte to represent a character in UTF-8 strings.) The +second parameter, C, points to anywhere in the string beyond the first +character, up to one byte past the end of the entire string. The suffix +C<_safe> in the function's name indicates that it will not attempt to read +beyond S>, provided that the constraint S e>> is true (this +is asserted for in C<-DDEBUGGING> builds). If the UTF-8 for the input +character is malformed in some way, the program may croak, or the function may +return FALSE, at the discretion of the implementation, and subject to change in +future releases. + +Variant C_utf8> is like C_utf8_safe>, but takes just a single +parameter, C

, which has the same meaning as the corresponding parameter does +in C_utf8_safe>. The function therefore can't check if it is reading +beyond the end of the string. Starting in Perl v5.30, it will take a second +parameter, becoming a synonym for C_utf8_safe>. At that time every +program that uses it will have to be changed to successfully compile. In the +meantime, the first runtime call to C_utf8> from each call point in the +program will raise a deprecation warning, enabled by default. You can convert +your program now to use C_utf8_safe>, and avoid the warnings, and get an +extra measure of protection, or you can wait until v5.30, when you'll be forced +to add the C parameter. + +Variant C_LC> is like the C_A> and C_L1> variants, but the result is based on the current locale, which is what C in the name stands for. If Perl can determine that the current locale is a UTF-8 locale, it uses the published Unicode rules; otherwise, it uses the C library function that @@ -580,22 +601,43 @@ returned if the input won't fit into an octet. On some platforms where the C library function is known to be defective, Perl changes its result to follow the POSIX standard's rules. -Variant C is like C, but is defined on any UV. It -returns the same as C for input code points less than 256, and +Variant C_LC_uvchr> is like C_LC>, but is defined on any UV. It +returns the same as C_LC> for input code points less than 256, and returns the hard-coded, not-affected-by-locale, Unicode results for larger ones. -Variant C is like C, but the input is a pointer -to a (known to be well-formed) UTF-8 encoded string (C or C, and -possibly containing embedded C characters). The classification of just -the first (possibly multi-byte) character in the string is tested. +Variant C_LC_utf8_safe> is like C_LC_uvchr>, but is used for UTF-8 +encoded strings. Each call classifies one character, even if the string +contains many. This variant takes two parameters. The first, C

, is a +pointer to the first byte of the character to be classified. (Recall that it +may take more than one byte to represent a character in UTF-8 strings.) The +second parameter, C, points to anywhere in the string beyond the first +character, up to one byte past the end of the entire string. The suffix +C<_safe> in the function's name indicates that it will not attempt to read +beyond S>, provided that the constraint S e>> is true (this +is asserted for in C<-DDEBUGGING> builds). If the UTF-8 for the input +character is malformed in some way, the program may croak, or the function may +return FALSE, at the discretion of the implementation, and subject to change in +future releases. + +Variant C_LC_utf8> is like C_LC_utf8_safe>, but takes just a single +parameter, C

, which has the same meaning as the corresponding parameter does +in C_LC_utf8_safe>. The function therefore can't check if it is reading +beyond the end of the string. Starting in Perl v5.30, it will take a second +parameter, becoming a synonym for C_LC_utf8_safe>. At that time every +program that uses it will have to be changed to successfully compile. In the +meantime, the first runtime call to C_LC_utf8> from each call point in +the program will raise a deprecation warning, enabled by default. You can +convert your program now to use C_LC_utf8_safe>, and avoid the warnings, +and get an extra measure of protection, or you can wait until v5.30, when +you'll be forced to add the C parameter. =for apidoc Am|bool|isALPHA|char ch Returns a boolean indicating whether the specified character is an alphabetic character, analogous to C. See the L for an explanation of variants -C, C, C, C, C, -C, and C. +C, C, C, C, +C, C, and C. =for apidoc Am|bool|isALPHANUMERIC|char ch Returns a boolean indicating whether the specified character is a either an @@ -603,8 +645,8 @@ alphabetic character or decimal digit, analogous to C. See the L for an explanation of variants C, C, C, -C, C, C, and -C. +C, C, C, +and C. =for apidoc Am|bool|isASCII|char ch Returns a boolean indicating whether the specified character is one of the 128 @@ -614,36 +656,36 @@ character corresponds to an ASCII character. Variants C and C are identical to C. See the L for an explanation of variants -C, C, C, C, and -C. Note, however, that some platforms do not have the C +C, C, C, C, and +C. Note, however, that some platforms do not have the C library routine C. In these cases, the variants whose names contain C are the same as the corresponding ones without. Also note, that because all ASCII characters are UTF-8 invariant (meaning they have the exact same representation (always a single byte) whether encoded in UTF-8 or not), C will give the correct results when called with any -byte in any string encoded or not in UTF-8. And similarly C will -work properly on any string encoded or not in UTF-8. +byte in any string encoded or not in UTF-8. And similarly C +will work properly on any string encoded or not in UTF-8. =for apidoc Am|bool|isBLANK|char ch Returns a boolean indicating whether the specified character is a character considered to be a blank, analogous to C. See the L for an explanation of variants -C, C, C, C, C, -C, and C. Note, however, that some -platforms do not have the C library routine C. In these cases, the -variants whose names contain C are the same as the corresponding ones -without. +C, C, C, C, +C, C, and C. Note, +however, that some platforms do not have the C library routine +C. In these cases, the variants whose names contain C are +the same as the corresponding ones without. =for apidoc Am|bool|isCNTRL|char ch Returns a boolean indicating whether the specified character is a control character, analogous to C. See the L for an explanation of variants -C, C, C, C, C, -C, and C -On EBCDIC platforms, you almost always want to use the C variant. +C, C, C, C, +C, C, and C On EBCDIC +platforms, you almost always want to use the C variant. =for apidoc Am|bool|isDIGIT|char ch Returns a boolean indicating whether the specified character is a @@ -651,24 +693,23 @@ digit, analogous to C. Variants C and C are identical to C. See the L for an explanation of variants -C, C, C, C, and -C. +C, C, C, C, and +C. =for apidoc Am|bool|isGRAPH|char ch Returns a boolean indicating whether the specified character is a graphic character, analogous to C. See the L for an explanation of -variants -C, C, C, C, C, -C, and C. +variants C, C, C, C, +C, C, and C. =for apidoc Am|bool|isLOWER|char ch Returns a boolean indicating whether the specified character is a lowercase character, analogous to C. See the L for an explanation of variants -C, C, C, C, C, -C, and C. +C, C, C, C, +C, C, and C. =for apidoc Am|bool|isOCTAL|char ch Returns a boolean indicating whether the specified character is an @@ -683,9 +724,8 @@ Note that the definition of what is punctuation isn't as straightforward as one might desire. See L for details. See the L for an explanation of -variants -C, C, C, C, C, -C, and C. +variants C, C, C, C, +C, C, and C. =for apidoc Am|bool|isSPACE|char ch Returns a boolean indicating whether the specified character is a @@ -698,8 +738,8 @@ in the non-locale variants, was that C did not match a vertical tab. (See L for a macro that matches a vertical tab in all releases.) See the L for an explanation of variants -C, C, C, C, C, -C, and C. +C, C, C, C, +C, C, and C. =for apidoc Am|bool|isPSXSPC|char ch (short for Posix Space) @@ -712,24 +752,23 @@ C forms don't match a Vertical Tab, and the C forms do. Otherwise they are identical. Thus this macro is analogous to what C matches in a regular expression. See the L for an explanation of -variants C, C, C, C, -C, C, and C. +variants C, C, C, C, +C, C, and C. =for apidoc Am|bool|isUPPER|char ch Returns a boolean indicating whether the specified character is an uppercase character, analogous to C. See the L for an explanation of -variants -C, C, C, C, C, -C, and C. +variants C, C, C, C, +C, C, and C. =for apidoc Am|bool|isPRINT|char ch Returns a boolean indicating whether the specified character is a printable character, analogous to C. See the L for an explanation of variants -C, C, C, C, C, -C, and C. +C, C, C, C, +C, C, and C. =for apidoc Am|bool|isWORDCHAR|char ch Returns a boolean indicating whether the specified character is a character @@ -741,10 +780,10 @@ C is a synonym provided for backward compatibility, even though a word character includes more than the standard C language meaning of alphanumeric. See the L for an explanation of -variants -C, C, C, and C. -C, C, and C are also as -described there, but additionally include the platform's native underscore. +variants C, C, C, and +C. C, C, and +C are also as described there, but additionally +include the platform's native underscore. =for apidoc Am|bool|isXDIGIT|char ch Returns a boolean indicating whether the specified character is a hexadecimal @@ -752,8 +791,8 @@ digit. In the ASCII range these are C<[0-9A-Fa-f]>. Variants C and C are identical to C. See the L for an explanation of variants -C, C, C, C, and -C. +C, C, C, C, +and C. =for apidoc Am|bool|isIDFIRST|char ch Returns a boolean indicating whether the specified character can be the first @@ -762,8 +801,8 @@ the official Unicode property C. The difference is that this returns true only if the input character also matches L. See the L for an explanation of variants -C, C, C, C, -C, C, and C. +C, C, C, C, +C, C, and C. =for apidoc Am|bool|isIDCONT|char ch Returns a boolean indicating whether the specified character can be the @@ -773,8 +812,8 @@ difference is that this returns true only if the input character also matches L. See the L for an explanation of variants C, C, C, -C, C, C, and -C. +C, C, C, and +C. =head1 Miscellaneous Functions @@ -810,8 +849,9 @@ The first code point of the uppercased version is returned (but note, as explained at L, that there may be more.) -=for apidoc Am|UV|toUPPER_utf8|U8* p|U8* s|STRLEN* lenp -Converts the UTF-8 encoded character at C

to its uppercase version, and +=for apidoc Am|UV|toUPPER_utf8_safe|U8* p|U8* e|U8* s|STRLEN* lenp +Converts the first UTF-8 encoded character in the sequence starting at C

and +extending no further than S> to its uppercase version, and stores that in UTF-8 in C, and its length in bytes in C. Note that the buffer pointed to by C needs to be at least C bytes since the uppercase version may be longer than the original character. @@ -820,7 +860,24 @@ The first code point of the uppercased version is returned (but note, as explained at L, that there may be more). -The input character at C

is assumed to be well-formed. +The suffix C<_safe> in the function's name indicates that it will not attempt +to read beyond S>, provided that the constraint S e>> is +true (this is asserted for in C<-DDEBUGGING> builds). If the UTF-8 for the +input character is malformed in some way, the program may croak, or the +function may return the REPLACEMENT CHARACTER, at the discretion of the +implementation, and subject to change in future releases. + +=for apidoc Am|UV|toUPPER_utf8|U8* p|U8* s|STRLEN* lenp +This is like C>, but doesn't have the C +parameter The function therefore can't check if it is reading +beyond the end of the string. Starting in Perl v5.30, it will take the C +parameter, becoming a synonym for C. At that time every +program that uses it will have to be changed to successfully compile. In the +meantime, the first runtime call to C from each call point in the +program will raise a deprecation warning, enabled by default. You can convert +your program now to use C, and avoid the warnings, and get an +extra measure of protection, or you can wait until v5.30, when you'll be forced +to add the C parameter. =for apidoc Am|U8|toFOLD|U8 ch Converts the specified character to foldcase. If the input is anything but an @@ -839,8 +896,9 @@ The first code point of the foldcased version is returned (but note, as explained at L, that there may be more). -=for apidoc Am|UV|toFOLD_utf8|U8* p|U8* s|STRLEN* lenp -Converts the UTF-8 encoded character at C

to its foldcase version, and +=for apidoc Am|UV|toFOLD_utf8_safe|U8* p|U8* e|U8* s|STRLEN* lenp +Converts the first UTF-8 encoded character in the sequence starting at C

and +extending no further than S> to its foldcase version, and stores that in UTF-8 in C, and its length in bytes in C. Note that the buffer pointed to by C needs to be at least C bytes since the foldcase version may be longer than the original character. @@ -849,7 +907,24 @@ The first code point of the foldcased version is returned (but note, as explained at L, that there may be more). -The input character at C

is assumed to be well-formed. +The suffix C<_safe> in the function's name indicates that it will not attempt +to read beyond S>, provided that the constraint S e>> is +true (this is asserted for in C<-DDEBUGGING> builds). If the UTF-8 for the +input character is malformed in some way, the program may croak, or the +function may return the REPLACEMENT CHARACTER, at the discretion of the +implementation, and subject to change in future releases. + +=for apidoc Am|UV|toFOLD_utf8|U8* p|U8* s|STRLEN* lenp +This is like C>, but doesn't have the C +parameter The function therefore can't check if it is reading +beyond the end of the string. Starting in Perl v5.30, it will take the C +parameter, becoming a synonym for C. At that time every +program that uses it will have to be changed to successfully compile. In the +meantime, the first runtime call to C from each call point in the +program will raise a deprecation warning, enabled by default. You can convert +your program now to use C, and avoid the warnings, and get an +extra measure of protection, or you can wait until v5.30, when you'll be forced +to add the C parameter. =for apidoc Am|U8|toLOWER|U8 ch Converts the specified character to lowercase. If the input is anything but an @@ -875,8 +950,10 @@ The first code point of the lowercased version is returned (but note, as explained at L, that there may be more). -=for apidoc Am|UV|toLOWER_utf8|U8* p|U8* s|STRLEN* lenp -Converts the UTF-8 encoded character at C

to its lowercase version, and + +=for apidoc Am|UV|toLOWER_utf8_safe|U8* p|U8* e|U8* s|STRLEN* lenp +Converts the first UTF-8 encoded character in the sequence starting at C

and +extending no further than S> to its lowercase version, and stores that in UTF-8 in C, and its length in bytes in C. Note that the buffer pointed to by C needs to be at least C bytes since the lowercase version may be longer than the original character. @@ -885,7 +962,24 @@ The first code point of the lowercased version is returned (but note, as explained at L, that there may be more). -The input character at C

is assumed to be well-formed. +The suffix C<_safe> in the function's name indicates that it will not attempt +to read beyond S>, provided that the constraint S e>> is +true (this is asserted for in C<-DDEBUGGING> builds). If the UTF-8 for the +input character is malformed in some way, the program may croak, or the +function may return the REPLACEMENT CHARACTER, at the discretion of the +implementation, and subject to change in future releases. + +=for apidoc Am|UV|toLOWER_utf8|U8* p|U8* s|STRLEN* lenp +This is like C>, but doesn't have the C +parameter The function therefore can't check if it is reading +beyond the end of the string. Starting in Perl v5.30, it will take the C +parameter, becoming a synonym for C. At that time every +program that uses it will have to be changed to successfully compile. In the +meantime, the first runtime call to C from each call point in the +program will raise a deprecation warning, enabled by default. You can convert +your program now to use C, and avoid the warnings, and get an +extra measure of protection, or you can wait until v5.30, when you'll be forced +to add the C parameter. =for apidoc Am|U8|toTITLE|U8 ch Converts the specified character to titlecase. If the input is anything but an @@ -905,8 +999,9 @@ The first code point of the titlecased version is returned (but note, as explained at L, that there may be more). -=for apidoc Am|UV|toTITLE_utf8|U8* p|U8* s|STRLEN* lenp -Converts the UTF-8 encoded character at C

to its titlecase version, and +=for apidoc Am|UV|toTITLE_utf8_safe|U8* p|U8* e|U8* s|STRLEN* lenp +Converts the first UTF-8 encoded character in the sequence starting at C

and +extending no further than S> to its titlecase version, and stores that in UTF-8 in C, and its length in bytes in C. Note that the buffer pointed to by C needs to be at least C bytes since the titlecase version may be longer than the original character. @@ -915,12 +1010,30 @@ The first code point of the titlecased version is returned (but note, as explained at L, that there may be more). -The input character at C

is assumed to be well-formed. +The suffix C<_safe> in the function's name indicates that it will not attempt +to read beyond S>, provided that the constraint S e>> is +true (this is asserted for in C<-DDEBUGGING> builds). If the UTF-8 for the +input character is malformed in some way, the program may croak, or the +function may return the REPLACEMENT CHARACTER, at the discretion of the +implementation, and subject to change in future releases. + +=for apidoc Am|UV|toTITLE_utf8|U8* p|U8* s|STRLEN* lenp +This is like C>, but doesn't have the C +parameter The function therefore can't check if it is reading +beyond the end of the string. Starting in Perl v5.30, it will take the C +parameter, becoming a synonym for C. At that time every +program that uses it will have to be changed to successfully compile. In the +meantime, the first runtime call to C from each call point in the +program will raise a deprecation warning, enabled by default. You can convert +your program now to use C, and avoid the warnings, and get an +extra measure of protection, or you can wait until v5.30, when you'll be forced +to add the C parameter. =cut XXX Still undocumented isVERTWS_uvchr and _utf8; it's unclear what their names -really should be. Also toUPPER_LC and toFOLD_LC, which are subject to change. +really should be. Also toUPPER_LC and toFOLD_LC, which are subject to change, +and aren't general purpose as they don't work on U+DF, and assert against that. Note that these macros are repeated in Devel::PPPort, so should also be patched there. The file as of this writing is cpan/Devel-PPPort/parts/inc/misc @@ -1018,6 +1131,9 @@ patched there. The file as of this writing is cpan/Devel-PPPort/parts/inc/misc * above ASCII in the latter case) */ # define _CC_SPACE 10 /* \s, [:space:] */ +# define _CC_PSXSPC _CC_SPACE /* XXX Temporary, can be removed + when the deprecated isFOO_utf8() + functions are removed */ # define _CC_BLANK 11 /* [:blank:] */ # define _CC_XDIGIT 12 /* [:xdigit:] */ # define _CC_CNTRL 13 /* [:cntrl:] */ @@ -1037,6 +1153,9 @@ patched there. The file as of this writing is cpan/Devel-PPPort/parts/inc/misc # define _CC_IS_IN_SOME_FOLD 22 # define _CC_MNEMONIC_CNTRL 23 +# define _CC_IDCONT 24 /* XXX Temporary, can be removed when the deprecated + isFOO_utf8() functions are removed */ + /* This next group is only used on EBCDIC platforms, so theoretically could be * shared with something entirely different that's only on ASCII platforms */ # define _CC_UTF8_START_BYTE_IS_FOR_AT_LEAST_SURROGATE 28 @@ -1575,11 +1694,11 @@ END_EXTERN_C * don't, but experiments show that gcc optimizes them out anyway. */ /* Note that all ignore 'use bytes' */ -#define _generic_uvchr(classnum, above_latin1, c) ((c) < 256 \ - ? _generic_isCC(c, classnum) \ +#define _generic_uvchr(classnum, above_latin1, c) ((c) < 256 \ + ? _generic_isCC(c, classnum) \ : above_latin1(c)) -#define _generic_swash_uvchr(classnum, c) ((c) < 256 \ - ? _generic_isCC(c, classnum) \ +#define _generic_swash_uvchr(classnum, c) ((c) < 256 \ + ? _generic_isCC(c, classnum) \ : _is_uni_FOO(classnum, c)) #define isALPHA_uvchr(c) _generic_swash_uvchr(_CC_ALPHA, c) #define isALPHANUMERIC_uvchr(c) _generic_swash_uvchr(_CC_ALPHANUMERIC, c) @@ -1588,8 +1707,10 @@ END_EXTERN_C #define isCNTRL_uvchr(c) isCNTRL_L1(c) /* All controls are in Latin1 */ #define isDIGIT_uvchr(c) _generic_swash_uvchr(_CC_DIGIT, c) #define isGRAPH_uvchr(c) _generic_swash_uvchr(_CC_GRAPH, c) -#define isIDCONT_uvchr(c) _generic_uvchr(_CC_WORDCHAR, _is_uni_perl_idcont, c) -#define isIDFIRST_uvchr(c) _generic_uvchr(_CC_IDFIRST, _is_uni_perl_idstart, c) +#define isIDCONT_uvchr(c) \ + _generic_uvchr(_CC_WORDCHAR, _is_uni_perl_idcont, c) +#define isIDFIRST_uvchr(c) \ + _generic_uvchr(_CC_IDFIRST, _is_uni_perl_idstart, c) #define isLOWER_uvchr(c) _generic_swash_uvchr(_CC_LOWER, c) #define isPRINT_uvchr(c) _generic_swash_uvchr(_CC_PRINT, c) @@ -1676,33 +1797,75 @@ END_EXTERN_C * 'utf8' parameter. This relies on the fact that ASCII characters have the * same representation whether utf8 or not. Note that it assumes that the utf8 * has been validated, and ignores 'use bytes' */ -#define _generic_utf8(classnum, p, utf8) (UTF8_IS_INVARIANT(*(p)) \ - ? _generic_isCC(*(p), classnum) \ - : (UTF8_IS_DOWNGRADEABLE_START(*(p))) \ - ? _generic_isCC( \ - EIGHT_BIT_UTF8_TO_NATIVE(*(p), \ - *((p)+1 )), \ - classnum) \ - : utf8) +#define _base_generic_utf8(enum_name, name, p, use_locale ) \ + _is_utf8_FOO(CAT2(_CC_, enum_name), \ + (const U8 *) p, \ + "is" STRINGIFY(name) "_utf8", \ + "is" STRINGIFY(name) "_utf8_safe", \ + 1, use_locale, __FILE__,__LINE__) + +#define _generic_utf8(name, p) _base_generic_utf8(name, name, p, 0) + +/* The "_safe" macros make sure that we don't attempt to read beyond 'e', but + * they don't otherwise go out of their way to look for malformed UTF-8. If + * they can return accurate results without knowing if the input is otherwise + * malformed, they do so. For example isASCII is accurate in spite of any + * non-length malformations because it looks only at a single byte. Likewise + * isDIGIT looks just at the first byte for code points 0-255, as all UTF-8 + * variant ones return FALSE. But, if the input has to be well-formed in order + * for the results to be accurate, the macros will test and if malformed will + * call a routine to die + * + * Except for toke.c, the macros do assume that e > p, asserting that on + * DEBUGGING builds. Much code that calls these depends on this being true, + * for other reasons. toke.c is treated specially as using the regular + * assertion breaks it in many ways. All strings that these operate on there + * are supposed to have an extra NUL character at the end, so that *e = \0. A + * bunch of code in toke.c assumes that this is true, so the assertion allows + * for that */ +#ifdef PERL_IN_TOKE_C +# define _utf8_safe_assert(p,e) ((e) > (p) || ((e) == (p) && *(p) == '\0')) +#else +# define _utf8_safe_assert(p,e) ((e) > (p)) +#endif + +#define _generic_utf8_safe(classnum, p, e, above_latin1) \ + (__ASSERT_(_utf8_safe_assert(p, e)) \ + (UTF8_IS_INVARIANT(*(p))) \ + ? _generic_isCC(*(p), classnum) \ + : (UTF8_IS_DOWNGRADEABLE_START(*(p)) \ + ? ((LIKELY((e) - (p) > 1 && UTF8_IS_CONTINUATION(*((p)+1)))) \ + ? _generic_isCC(EIGHT_BIT_UTF8_TO_NATIVE(*(p), *((p)+1 )), \ + classnum) \ + : (_force_out_malformed_utf8_message( \ + (U8 *) (p), (U8 *) (e), 0, 1), 0)) \ + : above_latin1)) /* Like the above, but calls 'above_latin1(p)' to get the utf8 value. * 'above_latin1' can be a macro */ -#define _generic_func_utf8(classnum, above_latin1, p) \ - _generic_utf8(classnum, p, above_latin1(p)) +#define _generic_func_utf8_safe(classnum, above_latin1, p, e) \ + _generic_utf8_safe(classnum, p, e, above_latin1(p, e)) +#define _generic_non_swash_utf8_safe(classnum, above_latin1, p, e) \ + _generic_utf8_safe(classnum, p, e, \ + (UNLIKELY((e) - (p) < UTF8SKIP(p)) \ + ? (_force_out_malformed_utf8_message( \ + (U8 *) (p), (U8 *) (e), 0, 1), 0) \ + : above_latin1(p))) /* Like the above, but passes classnum to _isFOO_utf8(), instead of having an * 'above_latin1' parameter */ -#define _generic_swash_utf8(classnum, p) \ - _generic_utf8(classnum, p, _is_utf8_FOO(classnum, p)) +#define _generic_swash_utf8_safe(classnum, p, e) \ +_generic_utf8_safe(classnum, p, e, _is_utf8_FOO_with_len(classnum, p, e)) /* Like the above, but should be used only when it is known that there are no * characters in the upper-Latin1 range (128-255 on ASCII platforms) which the * class is TRUE for. Hence it can skip the tests for this range. * 'above_latin1' should include its arguments */ -#define _generic_utf8_no_upper_latin1(classnum, p, above_latin1) \ - (UTF8_IS_INVARIANT(*(p)) \ - ? _generic_isCC(*(p), classnum) \ - : (UTF8_IS_ABOVE_LATIN1(*(p))) \ - ? above_latin1 \ - : 0) +#define _generic_utf8_safe_no_upper_latin1(classnum, p, e, above_latin1) \ + (__ASSERT_(_utf8_safe_assert(p, e)) \ + (UTF8_IS_INVARIANT(*(p))) \ + ? _generic_isCC(*(p), classnum) \ + : (UTF8_IS_DOWNGRADEABLE_START(*(p))) \ + ? 0 /* Note that doesn't check validity for latin1 */ \ + : above_latin1) /* NOTE that some of these macros have very similar ones in regcharclass.h. * For example, there is (at the time of this writing) an 'is_SPACE_utf8()' @@ -1712,26 +1875,50 @@ END_EXTERN_C * points; the regcharclass.h ones are implemented as a series of * "if-else-if-else ..." */ -#define isALPHA_utf8(p) _generic_swash_utf8(_CC_ALPHA, p) -#define isALPHANUMERIC_utf8(p) _generic_swash_utf8(_CC_ALPHANUMERIC, p) -#define isASCII_utf8(p) isASCII(*p) /* Because ASCII is invariant under - utf8, the non-utf8 macro works - */ -#define isBLANK_utf8(p) _generic_func_utf8(_CC_BLANK, is_HORIZWS_high, p) +#define isALPHA_utf8(p) _generic_utf8(ALPHA, p) +#define isALPHANUMERIC_utf8(p) _generic_utf8(ALPHANUMERIC, p) +#define isASCII_utf8(p) _generic_utf8(ASCII, p) +#define isBLANK_utf8(p) _generic_utf8(BLANK, p) +#define isCNTRL_utf8(p) _generic_utf8(CNTRL, p) +#define isDIGIT_utf8(p) _generic_utf8(DIGIT, p) +#define isGRAPH_utf8(p) _generic_utf8(GRAPH, p) +#define isIDCONT_utf8(p) _generic_utf8(IDCONT, p) +#define isIDFIRST_utf8(p) _generic_utf8(IDFIRST, p) +#define isLOWER_utf8(p) _generic_utf8(LOWER, p) +#define isPRINT_utf8(p) _generic_utf8(PRINT, p) +#define isPSXSPC_utf8(p) _generic_utf8(PSXSPC, p) +#define isPUNCT_utf8(p) _generic_utf8(PUNCT, p) +#define isSPACE_utf8(p) _generic_utf8(SPACE, p) +#define isUPPER_utf8(p) _generic_utf8(UPPER, p) +#define isVERTWS_utf8(p) _generic_utf8(VERTSPACE, p) +#define isWORDCHAR_utf8(p) _generic_utf8(WORDCHAR, p) +#define isXDIGIT_utf8(p) _generic_utf8(XDIGIT, p) + +#define isALPHA_utf8_safe(p, e) _generic_swash_utf8_safe(_CC_ALPHA, p, e) +#define isALPHANUMERIC_utf8_safe(p, e) \ + _generic_swash_utf8_safe(_CC_ALPHANUMERIC, p, e) +#define isASCII_utf8_safe(p, e) \ + /* Because ASCII is invariant under utf8, the non-utf8 macro \ + * works */ \ + (__ASSERT_(_utf8_safe_assert(p, e)) isASCII(*(p))) +#define isBLANK_utf8_safe(p, e) \ + _generic_non_swash_utf8_safe(_CC_BLANK, is_HORIZWS_high, p, e) #ifdef EBCDIC /* Because all controls are UTF-8 invariants in EBCDIC, we can use this * more efficient macro instead of the more general one */ -# define isCNTRL_utf8(p) isCNTRL_L1(*(p)) +# define isCNTRL_utf8_safe(p, e) \ + (__ASSERT_(_utf8_safe_assert(p, e)) isCNTRL_L1(*(p))) #else -# define isCNTRL_utf8(p) _generic_utf8(_CC_CNTRL, p, 0) +# define isCNTRL_utf8_safe(p, e) _generic_utf8_safe(_CC_CNTRL, p, e, 0) #endif -#define isDIGIT_utf8(p) _generic_utf8_no_upper_latin1(_CC_DIGIT, p, \ - _is_utf8_FOO(_CC_DIGIT, p)) -#define isGRAPH_utf8(p) _generic_swash_utf8(_CC_GRAPH, p) -#define isIDCONT_utf8(p) _generic_func_utf8(_CC_WORDCHAR, \ - _is_utf8_perl_idcont, p) +#define isDIGIT_utf8_safe(p, e) \ + _generic_utf8_safe_no_upper_latin1(_CC_DIGIT, p, e, \ + _is_utf8_FOO_with_len(_CC_DIGIT, p, e)) +#define isGRAPH_utf8_safe(p, e) _generic_swash_utf8_safe(_CC_GRAPH, p, e) +#define isIDCONT_utf8_safe(p, e) _generic_func_utf8_safe(_CC_WORDCHAR, \ + _is_utf8_perl_idcont_with_len, p, e) /* To prevent S_scan_word in toke.c from hanging, we have to make sure that * IDFIRST is an alnum. See @@ -1739,65 +1926,133 @@ END_EXTERN_C * ever wanted to know about. (In the ASCII range, there isn't a difference.) * This used to be not the XID version, but we decided to go with the more * modern Unicode definition */ -#define isIDFIRST_utf8(p) _generic_func_utf8(_CC_IDFIRST, \ - _is_utf8_perl_idstart, p) - -#define isLOWER_utf8(p) _generic_swash_utf8(_CC_LOWER, p) -#define isPRINT_utf8(p) _generic_swash_utf8(_CC_PRINT, p) -#define isPSXSPC_utf8(p) isSPACE_utf8(p) -#define isPUNCT_utf8(p) _generic_swash_utf8(_CC_PUNCT, p) -#define isSPACE_utf8(p) _generic_func_utf8(_CC_SPACE, is_XPERLSPACE_high, p) -#define isUPPER_utf8(p) _generic_swash_utf8(_CC_UPPER, p) -#define isVERTWS_utf8(p) _generic_func_utf8(_CC_VERTSPACE, is_VERTWS_high, p) -#define isWORDCHAR_utf8(p) _generic_swash_utf8(_CC_WORDCHAR, p) -#define isXDIGIT_utf8(p) _generic_utf8_no_upper_latin1(_CC_XDIGIT, p, \ - is_XDIGIT_high(p)) +#define isIDFIRST_utf8_safe(p, e) \ + _generic_func_utf8_safe(_CC_IDFIRST, \ + _is_utf8_perl_idstart_with_len, (U8 *) (p), (U8 *) (e)) + +#define isLOWER_utf8_safe(p, e) _generic_swash_utf8_safe(_CC_LOWER, p, e) +#define isPRINT_utf8_safe(p, e) _generic_swash_utf8_safe(_CC_PRINT, p, e) +#define isPSXSPC_utf8_safe(p, e) isSPACE_utf8_safe(p, e) +#define isPUNCT_utf8_safe(p, e) _generic_swash_utf8_safe(_CC_PUNCT, p, e) +#define isSPACE_utf8_safe(p, e) \ + _generic_non_swash_utf8_safe(_CC_SPACE, is_XPERLSPACE_high, p, e) +#define isUPPER_utf8_safe(p, e) _generic_swash_utf8_safe(_CC_UPPER, p, e) +#define isVERTWS_utf8_safe(p, e) \ + _generic_non_swash_utf8_safe(_CC_VERTSPACE, is_VERTWS_high, p, e) +#define isWORDCHAR_utf8_safe(p, e) \ + _generic_swash_utf8_safe(_CC_WORDCHAR, p, e) +#define isXDIGIT_utf8_safe(p, e) \ + _generic_utf8_safe_no_upper_latin1(_CC_XDIGIT, p, e, \ + (UNLIKELY((e) - (p) < UTF8SKIP(p)) \ + ? (_force_out_malformed_utf8_message( \ + (U8 *) (p), (U8 *) (e), 0, 1), 0) \ + : is_XDIGIT_high(p))) #define toFOLD_utf8(p,s,l) to_utf8_fold(p,s,l) #define toLOWER_utf8(p,s,l) to_utf8_lower(p,s,l) #define toTITLE_utf8(p,s,l) to_utf8_title(p,s,l) #define toUPPER_utf8(p,s,l) to_utf8_upper(p,s,l) +/* For internal core use only, subject to change */ +#define _toFOLD_utf8_flags(p,e,s,l,f) _to_utf8_fold_flags (p,e,s,l,f, "", 0) +#define _toLOWER_utf8_flags(p,e,s,l,f) _to_utf8_lower_flags(p,e,s,l,f, "", 0) +#define _toTITLE_utf8_flags(p,e,s,l,f) _to_utf8_title_flags(p,e,s,l,f, "", 0) +#define _toUPPER_utf8_flags(p,e,s,l,f) _to_utf8_upper_flags(p,e,s,l,f, "", 0) + +#define toFOLD_utf8_safe(p,e,s,l) _toFOLD_utf8_flags(p,e,s,l, FOLD_FLAGS_FULL) +#define toLOWER_utf8_safe(p,e,s,l) _toLOWER_utf8_flags(p,e,s,l, 0) +#define toTITLE_utf8_safe(p,e,s,l) _toTITLE_utf8_flags(p,e,s,l, 0) +#define toUPPER_utf8_safe(p,e,s,l) _toUPPER_utf8_flags(p,e,s,l, 0) + /* For internal core Perl use only: the base macros for defining macros like * isALPHA_LC_utf8. These are like _generic_utf8, but if the first code point * in 'p' is within the 0-255 range, it uses locale rules from the passed-in * 'macro' parameter */ -#define _generic_LC_utf8(macro, p, utf8) \ - (UTF8_IS_INVARIANT(*(p)) \ - ? macro(*(p)) \ - : (UTF8_IS_DOWNGRADEABLE_START(*(p))) \ - ? macro(EIGHT_BIT_UTF8_TO_NATIVE(*(p), *((p)+1)))\ - : utf8) - -#define _generic_LC_swash_utf8(macro, classnum, p) \ - _generic_LC_utf8(macro, p, _is_utf8_FOO(classnum, p)) -#define _generic_LC_func_utf8(macro, above_latin1, p) \ - _generic_LC_utf8(macro, p, above_latin1(p)) - -#define isALPHANUMERIC_LC_utf8(p) _generic_LC_swash_utf8(isALPHANUMERIC_LC, \ - _CC_ALPHANUMERIC, p) -#define isALPHA_LC_utf8(p) _generic_LC_swash_utf8(isALPHA_LC, _CC_ALPHA, p) -#define isASCII_LC_utf8(p) isASCII_LC(*p) -#define isBLANK_LC_utf8(p) _generic_LC_func_utf8(isBLANK_LC, \ - is_HORIZWS_high, p) -#define isCNTRL_LC_utf8(p) _generic_LC_utf8(isCNTRL_LC, p, 0) -#define isDIGIT_LC_utf8(p) _generic_LC_swash_utf8(isDIGIT_LC, _CC_DIGIT, p) -#define isGRAPH_LC_utf8(p) _generic_LC_swash_utf8(isGRAPH_LC, _CC_GRAPH, p) -#define isIDCONT_LC_utf8(p) _generic_LC_func_utf8(isIDCONT_LC, \ - _is_utf8_perl_idcont, p) -#define isIDFIRST_LC_utf8(p) _generic_LC_func_utf8(isIDFIRST_LC, \ - _is_utf8_perl_idstart, p) -#define isLOWER_LC_utf8(p) _generic_LC_swash_utf8(isLOWER_LC, _CC_LOWER, p) -#define isPRINT_LC_utf8(p) _generic_LC_swash_utf8(isPRINT_LC, _CC_PRINT, p) -#define isPSXSPC_LC_utf8(p) isSPACE_LC_utf8(p) -#define isPUNCT_LC_utf8(p) _generic_LC_swash_utf8(isPUNCT_LC, _CC_PUNCT, p) -#define isSPACE_LC_utf8(p) _generic_LC_func_utf8(isSPACE_LC, \ - is_XPERLSPACE_high, p) -#define isUPPER_LC_utf8(p) _generic_LC_swash_utf8(isUPPER_LC, _CC_UPPER, p) -#define isWORDCHAR_LC_utf8(p) _generic_LC_swash_utf8(isWORDCHAR_LC, \ - _CC_WORDCHAR, p) -#define isXDIGIT_LC_utf8(p) _generic_LC_func_utf8(isXDIGIT_LC, \ - is_XDIGIT_high, p) +#define _generic_LC_utf8(name, p) _base_generic_utf8(name, name, p, 1) + +#define isALPHA_LC_utf8(p) _generic_LC_utf8(ALPHA, p) +#define isALPHANUMERIC_LC_utf8(p) _generic_LC_utf8(ALPHANUMERIC, p) +#define isASCII_LC_utf8(p) _generic_LC_utf8(ASCII, p) +#define isBLANK_LC_utf8(p) _generic_LC_utf8(BLANK, p) +#define isCNTRL_LC_utf8(p) _generic_LC_utf8(CNTRL, p) +#define isDIGIT_LC_utf8(p) _generic_LC_utf8(DIGIT, p) +#define isGRAPH_LC_utf8(p) _generic_LC_utf8(GRAPH, p) +#define isIDCONT_LC_utf8(p) _generic_LC_utf8(IDCONT, p) +#define isIDFIRST_LC_utf8(p) _generic_LC_utf8(IDFIRST, p) +#define isLOWER_LC_utf8(p) _generic_LC_utf8(LOWER, p) +#define isPRINT_LC_utf8(p) _generic_LC_utf8(PRINT, p) +#define isPSXSPC_LC_utf8(p) _generic_LC_utf8(PSXSPC, p) +#define isPUNCT_LC_utf8(p) _generic_LC_utf8(PUNCT, p) +#define isSPACE_LC_utf8(p) _generic_LC_utf8(SPACE, p) +#define isUPPER_LC_utf8(p) _generic_LC_utf8(UPPER, p) +#define isWORDCHAR_LC_utf8(p) _generic_LC_utf8(WORDCHAR, p) +#define isXDIGIT_LC_utf8(p) _generic_LC_utf8(XDIGIT, p) + +/* For internal core Perl use only: the base macros for defining macros like + * isALPHA_LC_utf8_safe. These are like _generic_utf8, but if the first code + * point in 'p' is within the 0-255 range, it uses locale rules from the + * passed-in 'macro' parameter */ +#define _generic_LC_utf8_safe(macro, p, e, above_latin1) \ + (__ASSERT_(_utf8_safe_assert(p, e)) \ + (UTF8_IS_INVARIANT(*(p))) \ + ? macro(*(p)) \ + : (UTF8_IS_DOWNGRADEABLE_START(*(p)) \ + ? ((LIKELY((e) - (p) > 1 && UTF8_IS_CONTINUATION(*((p)+1)))) \ + ? macro(EIGHT_BIT_UTF8_TO_NATIVE(*(p), *((p)+1))) \ + : (_force_out_malformed_utf8_message( \ + (U8 *) (p), (U8 *) (e), 0, 1), 0)) \ + : above_latin1)) + +#define _generic_LC_swash_utf8_safe(macro, classnum, p, e) \ + _generic_LC_utf8_safe(macro, p, e, \ + _is_utf8_FOO_with_len(classnum, p, e)) + +#define _generic_LC_func_utf8_safe(macro, above_latin1, p, e) \ + _generic_LC_utf8_safe(macro, p, e, above_latin1(p, e)) + +#define _generic_LC_non_swash_utf8_safe(classnum, above_latin1, p, e) \ + _generic_LC_utf8_safe(classnum, p, e, \ + (UNLIKELY((e) - (p) < UTF8SKIP(p)) \ + ? (_force_out_malformed_utf8_message( \ + (U8 *) (p), (U8 *) (e), 0, 1), 0) \ + : above_latin1(p))) + +#define isALPHANUMERIC_LC_utf8_safe(p, e) \ + _generic_LC_swash_utf8_safe(isALPHANUMERIC_LC, \ + _CC_ALPHANUMERIC, p, e) +#define isALPHA_LC_utf8_safe(p, e) \ + _generic_LC_swash_utf8_safe(isALPHA_LC, _CC_ALPHA, p, e) +#define isASCII_LC_utf8_safe(p, e) \ + (__ASSERT_(_utf8_safe_assert(p, e)) isASCII_LC(*(p))) +#define isBLANK_LC_utf8_safe(p, e) \ + _generic_LC_non_swash_utf8_safe(isBLANK_LC, is_HORIZWS_high, p, e) +#define isCNTRL_LC_utf8_safe(p, e) \ + _generic_LC_utf8_safe(isCNTRL_LC, p, e, 0) +#define isDIGIT_LC_utf8_safe(p, e) \ + _generic_LC_swash_utf8_safe(isDIGIT_LC, _CC_DIGIT, p, e) +#define isGRAPH_LC_utf8_safe(p, e) \ + _generic_LC_swash_utf8_safe(isGRAPH_LC, _CC_GRAPH, p, e) +#define isIDCONT_LC_utf8_safe(p, e) \ + _generic_LC_func_utf8_safe(isIDCONT_LC, \ + _is_utf8_perl_idcont_with_len, p, e) +#define isIDFIRST_LC_utf8_safe(p, e) \ + _generic_LC_func_utf8_safe(isIDFIRST_LC, \ + _is_utf8_perl_idstart_with_len, p, e) +#define isLOWER_LC_utf8_safe(p, e) \ + _generic_LC_swash_utf8_safe(isLOWER_LC, _CC_LOWER, p, e) +#define isPRINT_LC_utf8_safe(p, e) \ + _generic_LC_swash_utf8_safe(isPRINT_LC, _CC_PRINT, p, e) +#define isPSXSPC_LC_utf8_safe(p, e) isSPACE_LC_utf8_safe(p, e) +#define isPUNCT_LC_utf8_safe(p, e) \ + _generic_LC_swash_utf8_safe(isPUNCT_LC, _CC_PUNCT, p, e) +#define isSPACE_LC_utf8_safe(p, e) \ + _generic_LC_non_swash_utf8_safe(isSPACE_LC, is_XPERLSPACE_high, p, e) +#define isUPPER_LC_utf8_safe(p, e) \ + _generic_LC_swash_utf8_safe(isUPPER_LC, _CC_UPPER, p, e) +#define isWORDCHAR_LC_utf8_safe(p, e) \ + _generic_LC_swash_utf8_safe(isWORDCHAR_LC, _CC_WORDCHAR, p, e) +#define isXDIGIT_LC_utf8_safe(p, e) \ + _generic_LC_non_swash_utf8_safe(isXDIGIT_LC, is_XDIGIT_high, p, e) /* Macros for backwards compatibility and for completeness when the ASCII and * Latin1 values are identical */ @@ -2222,6 +2477,12 @@ void Perl_mem_log_del_sv(const SV *sv, const char *filename, const int linenumbe #ifdef PERL_CORE # define deprecate(s) Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \ "Use of " s " is deprecated") +# define deprecate_disappears_in(when,message) \ + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \ + message ", and will disappear in Perl " when) +# define deprecate_fatal_in(when,message) \ + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \ + message ". Its use will be fatal in Perl " when) #endif /* Internal macros to deal with gids and uids */ diff --git a/hints/catamount.sh b/hints/catamount.sh index 3a0ca1b..0c075fd 100644 --- a/hints/catamount.sh +++ b/hints/catamount.sh @@ -31,11 +31,11 @@ # 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.8 +# mkdir -p /opt/perl-catamount/lib/perl5/5.25.9 # 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.8 +# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.25.9 # 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 diff --git a/hints/freebsd.sh b/hints/freebsd.sh index 135129f..e5ecea8 100644 --- a/hints/freebsd.sh +++ b/hints/freebsd.sh @@ -105,6 +105,14 @@ case "$osvers" in ;; esac +case "$osvers" in +10.*) + # dtrace on 10.x needs libelf symbols, but we don't know if the + # user is going to request usedtrace and there's no .cbu for usedtrace + libswanted="$libswanted elf" + ;; +esac + # Dynamic Loading flags have not changed much, so they are separated # out here to avoid duplicating them everywhere. case "$osvers" in @@ -304,7 +312,7 @@ esac # XXX Under FreeBSD 6.0 (and probably most other similar versions) # Perl_die(NULL) generates a warning: # pp_sys.c:491: warning: null format string -# Configure supposedely tests for this, but apparently the test doesn't +# Configure supposedly tests for this, but apparently the test doesn't # work. Volunteers with FreeBSD are needed to improving the Configure test. # Meanwhile, the following workaround should be safe on all versions # of FreeBSD. diff --git a/installhtml b/installhtml index 06342a8..1094c6a 100644 --- a/installhtml +++ b/installhtml @@ -23,8 +23,9 @@ installhtml - converts a collection of POD pages to HTML format. =head1 DESCRIPTION I converts a collection of POD pages to a corresponding -collection of HTML pages. This is primarily used to convert the pod -pages found in the perl distribution. +collection of HTML pages. This is used to convert the pod pages found in the +perl distribution. (It is not intended as a general-purpose +converter/installer of POD pages in HTML format. See L.) =head1 OPTIONS @@ -67,10 +68,11 @@ relative to podroot. =item B<--splititem> POD files to split on =item directive -Comma-separated list of all pod files to split by the =item directive. -The .pod suffix is optional. I does not do the actual -split, rather it invokes I to do the dirty work. As with ---splithead, these files should have names specified relative to podroot. +Comma-separated list of all pod files to split by the =item directive. The +.pod suffix is optional. I does not do the actual split, rather +it invokes I, a separate program in the Perl 5 core distribution, +to do the dirty work. As with --splithead, these files should have names +specified relative to podroot. =item B<--splitpod> Directory containing the splitpod program @@ -233,7 +235,7 @@ foreach my $dir (@splithead) { # read in everything until what would have been the first =head # directive, patching the index as we go. - open(H, "<$file.html") || + open(H, '<', "$file.html") || die "$0: error opening $file.html for input: $!\n"; $/ = ""; my @data = (); @@ -250,7 +252,7 @@ foreach my $dir (@splithead) { close(H); # now rewrite the file - open(H, ">$file.html") || + open(H, '>', "$file.html") || die "$0: error opening $file.html for output: $!\n"; print H "@data", "\n"; close(H); @@ -298,7 +300,7 @@ sub create_index { my @files = sort(grep(/\.html?$/, readdir(DIR))); closedir(DIR); - open(HTML, ">$html") || + open(HTML, '>', $html) || die "$0: error opening $html for output: $!\n"; # for each .html file in the directory, extract the index @@ -307,7 +309,7 @@ sub create_index { foreach my $file (@files) { my $filedata = do { - open(my $in, "<$dir/$file") || + open(my $in, '<', "$dir/$file") || die "$0: error opening $dir/$file for input: $!\n"; local $/ = undef; <$in>; @@ -406,7 +408,7 @@ sub splitpod { # read the file in paragraphs $/ = ""; - open(SPLITIN, "<$pod") || + open(SPLITIN, '<', $pod) || die "$0: error opening $pod for input: $!\n"; @filedata = ; close(SPLITIN) || @@ -462,7 +464,7 @@ sub splitpod { # create the new .pod file print "\tcreating $poddir/$file\n" if $verbose; - open(SPLITOUT, ">$poddir/$file") || + open(SPLITOUT, '>', "$poddir/$file") || die "$0: error opening $poddir/$file for output: $!\n"; $poddata[$i] =~ s,L<([^<>]*)>, defined $heads{anchorify($1)} ? "L<$dir/$1>" : "L<$1>" diff --git a/intrpvar.h b/intrpvar.h index 1aa94f7..d203855 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -98,9 +98,11 @@ PERLVAR(I, in_eval, U8) /* trap "fatal" errors? */ PERLVAR(I, defgv, GV *) /* the *_ glob */ /* -=for apidoc mn|bool|PL_dowarn +=for apidoc mn|U8|PL_dowarn -The C variable which corresponds to Perl's C<$^W> warning variable. +The C variable that roughly corresponds to Perl's C<$^W> warning variable. +However, C<$^W> is treated as a boolean, whereas C is a +collection of flag bits. =cut */ @@ -628,6 +630,8 @@ PERLVAR(I, GCB_invlist, SV *) PERLVAR(I, LB_invlist, SV *) PERLVAR(I, SB_invlist, SV *) PERLVAR(I, WB_invlist, SV *) +PERLVAR(I, Assigned_invlist, SV *) +PERLVAR(I, seen_deprecated_macro, HV *) PERLVAR(I, last_swash_hv, HV *) PERLVAR(I, last_swash_tmps, U8 *) diff --git a/lib/B/Deparse-core.t b/lib/B/Deparse-core.t index 247869c..2ed797a 100644 --- a/lib/B/Deparse-core.t +++ b/lib/B/Deparse-core.t @@ -107,7 +107,7 @@ sub testit { use feature [^\n]+ (?: (?:CORE::)?state sub \w+; )? \Q$vars\E\(\) = (.*) -}/s) { +\}/s) { ::fail($desc); ::diag("couldn't extract line from boilerplate\n"); ::diag($got_text); diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index e14620b..3166415 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -47,7 +47,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring MDEREF_SHIFT ); -$VERSION = '1.39'; +$VERSION = '1.40'; use strict; use vars qw/$AUTOLOAD/; use warnings (); @@ -558,7 +558,7 @@ sub next_todo { # makes use of a lexical var that's not in scope. # So strip it out. return $pragmata - if $use_dec =~ /^use \S+ \(@\{\$args\[0\];}\);/; + if $use_dec =~ /^use \S+ \(@\{\$args\[0\];\}\);/; $use_dec =~ s/^(use|no)\b/$self->keyword($1)/e; } diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index 9b07ca0..cd4f15b 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -118,7 +118,7 @@ package B::Op_private; our %bits; -our $VERSION = "5.025008"; +our $VERSION = "5.025009"; $bits{$_}{3} = 'OPpENTERSUB_AMPER' for qw(entersub rv2cv); $bits{$_}{6} = 'OPpENTERSUB_DB' for qw(entersub rv2cv); diff --git a/lib/DBM_Filter/t/01error.t b/lib/DBM_Filter/t/01error.t index 1aff972..33173f3 100644 --- a/lib/DBM_Filter/t/01error.t +++ b/lib/DBM_Filter/t/01error.t @@ -24,7 +24,7 @@ sub writeFile { my $filename = shift ; my $content = shift; - open F, ">$filename" or croak "Cannot open $filename: $!" ; + open F, '>', $filename or croak "Cannot open $filename: $!" ; print F $content ; close F; } diff --git a/lib/DBM_Filter/t/02core.t b/lib/DBM_Filter/t/02core.t index a9538e5..1f5fef9 100644 --- a/lib/DBM_Filter/t/02core.t +++ b/lib/DBM_Filter/t/02core.t @@ -22,7 +22,7 @@ sub writeFile { my $filename = shift ; my $content = shift; - open F, ">DBM_Filter/$filename.pm" or croak "Cannot open $filename: $!" ; + open F, '>', "DBM_Filter/$filename.pm" or croak "Cannot open $filename: $!" ; print F $content ; close F; $files{"DBM_Filter/$filename.pm"} ++; diff --git a/lib/English.t b/lib/English.t index bed1162..35a06ca 100644 --- a/lib/English.t +++ b/lib/English.t @@ -36,7 +36,7 @@ $ORS = "\n"; if ($^O ne 'dos') { pipe(IN, OUT); } else { - open(OUT, ">en.tmp"); + open(OUT, ">", "en.tmp"); } select(OUT); $| = 1; @@ -48,7 +48,7 @@ $ORS = "\n"; my $close = close OUT; ok( !($close) == $CHILD_ERROR, '$CHILD_ERROR should be false' ); - open(IN, "; like( $foo, qr/ok 7/, '$OFS' ); @@ -129,7 +129,7 @@ is( $keys[1], 'd|e|f', '$SUBSCRIPT_SEPARATOR' ); eval { is( $EXCEPTIONS_BEING_CAUGHT, 1, '$EXCEPTIONS_BEING_CAUGHT' ) }; ok( !$EXCEPTIONS_BEING_CAUGHT, '$EXCEPTIONS_BEING_CAUGHT should be false' ); -eval { local *F; my $f = 'asdasdasd'; ++$f while -e $f; open(F, $f); }; +eval { local *F; my $f = 'asdasdasd'; ++$f while -e $f; open(F, '<', $f); }; is( $OS_ERROR, $ERRNO, '$OS_ERROR' ); ok( $OS_ERROR{ENOENT}, '%OS_ERROR (ENOENT should be set)' ); diff --git a/lib/ExtUtils/Embed.pm b/lib/ExtUtils/Embed.pm index 9305b5d..b26bf73 100644 --- a/lib/ExtUtils/Embed.pm +++ b/lib/ExtUtils/Embed.pm @@ -10,7 +10,7 @@ use vars qw(@ISA @EXPORT $VERSION use strict; # This is not a dual-life module, so no need for development version numbers -$VERSION = '1.33'; +$VERSION = '1.34'; @ISA = qw(Exporter); @EXPORT = qw(&xsinit &ldopts @@ -199,7 +199,7 @@ sub ldopts { push @archives, $archive; if(-e ($extra = File::Spec->catdir($_,"auto",$root,"extralibs.ld"))) { local(*FH); - if(open(FH, $extra)) { + if(open(FH, '<', $extra)) { my($libs) = ; chomp $libs; push @potential_libs, split /\s+/, $libs; } diff --git a/lib/File/Compare.t b/lib/File/Compare.t index c8c730d..b7c9d9f 100644 --- a/lib/File/Compare.t +++ b/lib/File/Compare.t @@ -73,7 +73,7 @@ eval { { local $/; #slurp my $fh; - open($fh,$README); + open($fh,'<',$README); binmode($fh); my $data = <$fh>; print $tfh $data; diff --git a/lib/File/Copy.t b/lib/File/Copy.t index 9e49c7d..05590b2 100644 --- a/lib/File/Copy.t +++ b/lib/File/Copy.t @@ -43,14 +43,14 @@ for my $cross_partition_test (0..1) { } # First we create a file - open(F, ">file-$$") or die $!; + open(F, ">", "file-$$") or die $!; binmode F; # for DOSISH platforms, because test 3 copies to stdout printf F "ok\n"; close F; copy "file-$$", "copy-$$"; - open(F, "copy-$$") or die $!; + open(F, "<", "copy-$$") or die $!; my $foo = ; close(F); @@ -65,16 +65,16 @@ for my $cross_partition_test (0..1) { $TB->current_test($TB->current_test + 1); unlink "copy-$$" or die "unlink: $!"; - open(F,"file-$$"); + open(F, "<", "file-$$"); copy(*F, "copy-$$"); - open(R, "copy-$$") or die "open copy-$$: $!"; $foo = ; close(R); + open(R, "<", "copy-$$") or die "open copy-$$: $!"; $foo = ; close(R); is $foo, "ok\n", 'copy(*F, fn): same contents'; unlink "copy-$$" or die "unlink: $!"; - open(F,"file-$$"); + open(F, "<", "file-$$"); copy(\*F, "copy-$$"); close(F) or die "close: $!"; - open(R, "copy-$$") or die; $foo = ; close(R) or die "close: $!"; + open(R, "<", "copy-$$") or die; $foo = ; close(R) or die "close: $!"; is $foo, "ok\n", 'copy(\*F, fn): same contents'; unlink "copy-$$" or die "unlink: $!"; @@ -83,7 +83,7 @@ for my $cross_partition_test (0..1) { binmode $fh or die $!; copy("file-$$",$fh); $fh->close or die "close: $!"; - open(R, "copy-$$") or die; $foo = ; close(R); + open(R, "<", "copy-$$") or die; $foo = ; close(R); is $foo, "ok\n", 'copy(fn, io): same contents'; unlink "copy-$$" or die "unlink: $!"; @@ -92,7 +92,7 @@ for my $cross_partition_test (0..1) { binmode $fh or die $!; copy("file-$$",$fh); $fh->close; - open(R, "copy-$$") or die $!; $foo = ; close(R); + open(R, "<", "copy-$$") or die $!; $foo = ; close(R); is $foo, "ok\n", 'copy(fn, fh): same contents'; unlink "file-$$" or die "unlink: $!"; @@ -111,7 +111,7 @@ for my $cross_partition_test (0..1) { ok move("copy-$$", "file-$$"), 'move'; ok -e "file-$$", ' destination exists'; ok !-e "copy-$$", ' source does not'; - open(R, "file-$$") or die $!; $foo = ; close(R); + open(R, "<", "file-$$") or die $!; $foo = ; close(R); is $foo, "ok\n", 'contents preserved'; TODO: { @@ -126,13 +126,13 @@ for my $cross_partition_test (0..1) { # trick: create lib/ if not exists - not needed in Perl core unless (-d 'lib') { mkdir 'lib' or die $!; } copy "file-$$", "lib"; - open(R, "lib/file-$$") or die $!; $foo = ; close(R); + open(R, "<", "lib/file-$$") or die $!; $foo = ; close(R); is $foo, "ok\n", 'copy(fn, dir): same contents'; unlink "lib/file-$$" or die "unlink: $!"; # Do it twice to ensure copying over the same file works. copy "file-$$", "lib"; - open(R, "lib/file-$$") or die $!; $foo = ; close(R); + open(R, "<", "lib/file-$$") or die $!; $foo = ; close(R); is $foo, "ok\n", 'copy over the same file works'; unlink "lib/file-$$" or die "unlink: $!"; @@ -146,7 +146,7 @@ for my $cross_partition_test (0..1) { } move "file-$$", "lib"; - open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = ; close(R); + open(R, "<", "lib/file-$$") or die "open lib/file-$$: $!"; $foo = ; close(R); is $foo, "ok\n", 'move(fn, dir): same contents'; ok !-e "file-$$", 'file moved indeed'; unlink "lib/file-$$" or die "unlink: $!"; @@ -154,7 +154,7 @@ for my $cross_partition_test (0..1) { SKIP: { skip "Testing symlinks", 3 unless $Config{d_symlink}; - open(F, ">file-$$") or die $!; + open(F, ">", "file-$$") or die $!; print F "dummy content\n"; close F; symlink("file-$$", "symlink-$$") or die $!; @@ -175,7 +175,7 @@ for my $cross_partition_test (0..1) { skip "Testing hard links", 3 if !$Config{d_link} or $^O eq 'MSWin32' or $^O eq 'cygwin'; - open(F, ">file-$$") or die $!; + open(F, ">", "file-$$") or die $!; print F "dummy content\n"; close F; link("file-$$", "hardlink-$$") or die $!; @@ -192,13 +192,13 @@ for my $cross_partition_test (0..1) { unlink "file-$$" or die $!; } - open(F, ">file-$$") or die $!; + open(F, ">", "file-$$") or die $!; binmode F; print F "this is file\n"; close F; my $copy_msg = "this is copy\n"; - open(F, ">copy-$$") or die $!; + open(F, ">", "copy-$$") or die $!; binmode F; print F $copy_msg; close F; @@ -216,7 +216,7 @@ for my $cross_partition_test (0..1) { } is -s "copy-$$", length $copy_msg, "but does not truncate the destination"; - open(F, "copy-$$") or die $!; + open(F, "<", "copy-$$") or die $!; $foo = ; close(F); is $foo, $copy_msg, "nor change the destination's contents"; @@ -228,7 +228,7 @@ for my $cross_partition_test (0..1) { TODO: { local $TODO = 'spaces in filenames require DECC$EFS_CHARSET enabled' if $^O eq 'VMS'; - open(F, ">file-$$") or die $!; + open(F, ">", "file-$$") or die $!; close F; copy "file-$$", " copy-$$"; ok -e " copy-$$", "copy with leading whitespace"; diff --git a/lib/File/stat.t b/lib/File/stat.t index 7c9b9cc..c403fc4 100644 --- a/lib/File/stat.t +++ b/lib/File/stat.t @@ -144,7 +144,7 @@ for (split //, "tTB") { SKIP: { local *STAT; - skip("Could not open file: $!", 2) unless open(STAT, $file); + skip("Could not open file: $!", 2) unless open(STAT, '<', $file); isa_ok(File::stat::stat('STAT'), 'File::stat', '... should be able to find filehandle'); diff --git a/lib/SelectSaver.t b/lib/SelectSaver.t index 3b58d70..757f0cd 100644 --- a/lib/SelectSaver.t +++ b/lib/SelectSaver.t @@ -9,7 +9,7 @@ print "1..3\n"; use SelectSaver; -open(FOO, ">foo-$$") || die; +open(FOO, ">", "foo-$$") || die; print "ok 1\n"; { @@ -18,7 +18,7 @@ print "ok 1\n"; } # Get data written to file -open(FOO, "foo-$$") || die; +open(FOO, "<", "foo-$$") || die; chomp($foo = ); close FOO; unlink "foo-$$"; diff --git a/lib/Symbol.pm b/lib/Symbol.pm index 1e408b5..0e8d67f 100644 --- a/lib/Symbol.pm +++ b/lib/Symbol.pm @@ -9,7 +9,7 @@ Symbol - manipulate Perl symbols and their names use Symbol; $sym = gensym; - open($sym, "filename"); + open($sym, '<', "filename"); $_ = <$sym>; # etc. @@ -85,7 +85,7 @@ require Exporter; @EXPORT = qw(gensym ungensym qualify qualify_to_ref); @EXPORT_OK = qw(delete_package geniosym); -$VERSION = '1.07'; +$VERSION = '1.08'; my $genpkg = "Symbol::"; my $genseq = 0; diff --git a/lib/Tie/Handle/stdhandle.t b/lib/Tie/Handle/stdhandle.t index 228004f..d2f04bc 100644 --- a/lib/Tie/Handle/stdhandle.t +++ b/lib/Tie/Handle/stdhandle.t @@ -15,7 +15,7 @@ $f = 'tst'; unlink("afile") if -f "afile"; -ok(open($f,"+>afile"), "open +>afile"); +ok(open($f, "+>", "afile"), "open +>, afile"); ok(open($f, "+<", "afile"), "open +<, afile"); ok(binmode($f), "binmode") or diag("binmode: $!\n"); diff --git a/lib/Unicode/UCD.pm b/lib/Unicode/UCD.pm index 75b2b80..4939677 100644 --- a/lib/Unicode/UCD.pm +++ b/lib/Unicode/UCD.pm @@ -5,7 +5,7 @@ use warnings; no warnings 'surrogate'; # surrogates can be inputs to this use charnames (); -our $VERSION = '0.67'; +our $VERSION = '0.68'; require Exporter; @@ -154,7 +154,7 @@ sub openunicode { for my $d (@INC) { use File::Spec; $f = File::Spec->catfile($d, "unicore", @path); - last if open($$rfh, $f); + last if open($$rfh, '<', $f); undef $f; } croak __PACKAGE__, ": failed to find ", diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index 731b1a0..860a0aa 100644 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -186,7 +186,7 @@ use 5.009001; use Carp; $Carp::Internal{__PACKAGE__.""}++; -our $VERSION = '1.35'; +our $VERSION = '1.36'; our $DEBUG; our $VERBOSE; our $PRETTY; @@ -231,7 +231,7 @@ CONFIG: { $PRETTY = $opt_p; } - if (open(POD_DIAG, $PODFILE)) { + if (open(POD_DIAG, '<', $PODFILE)) { warn "Happy happy podfile from real $PODFILE\n" if $DEBUG; last CONFIG; } @@ -240,7 +240,7 @@ CONFIG: { INCPATH: { for my $file ( (map { "$_/".__PACKAGE__.".pm" } @INC), $0) { warn "Checking $file\n" if $DEBUG; - if (open(POD_DIAG, $file)) { + if (open(POD_DIAG, '<', $file)) { while () { next unless /^__END__\s*# wish diag dbase were more accessible/; diff --git a/lib/feature.pm b/lib/feature.pm index e97ffff..fe5c513 100644 --- a/lib/feature.pm +++ b/lib/feature.pm @@ -5,7 +5,7 @@ package feature; -our $VERSION = '1.45'; +our $VERSION = '1.46'; our %feature = ( fc => 'feature_fc', @@ -174,7 +174,9 @@ potentially using Unicode in your program, the C subpragma is B recommended. This feature is available starting with Perl 5.12; was almost fully -implemented in Perl 5.14; and extended in Perl 5.16 to cover C. +implemented in Perl 5.14; and extended in Perl 5.16 to cover C; +and extended further in Perl 5.26 to cover L. =head2 The 'unicode_eval' and 'evalbytes' features diff --git a/lib/h2ph.t b/lib/h2ph.t index bdcc389..377cc63 100644 --- a/lib/h2ph.t +++ b/lib/h2ph.t @@ -23,7 +23,7 @@ plan(6); sub txt_compare { local $/; my ($A, $B); - for (($A,$B) = @_) { open(_,"<$_") ? $_ = <_> : die "$_ : $!"; close _ } + for (($A,$B) = @_) { open(_,"<",$_) ? $_ = <_> : die "$_ : $!"; close _ } $A cmp $B; } diff --git a/lib/h2xs.t b/lib/h2xs.t index 25502da..69746a5 100644 --- a/lib/h2xs.t +++ b/lib/h2xs.t @@ -167,7 +167,7 @@ for (my $i = $#tests; $i > 0; $i-=3) { plan tests => $total_tests; -ok (open (HEADER, ">$header"), "open '$header'"); +ok (open (HEADER, '>', $header), "open '$header'"); print HEADER <

catfile('lib', "$name.pm"), 'Makefile.PL') { my $file = File::Spec->catfile($name, $leaf); - if (ok (open (FILE, $file), "open $file")) { + if (ok (open (FILE, '<', $file), "open $file")) { my $match = qr/use $version;/; my $found; while () { diff --git a/lib/overload.pm b/lib/overload.pm index 758b67d..ba56314 100644 --- a/lib/overload.pm +++ b/lib/overload.pm @@ -1,6 +1,6 @@ package overload; -our $VERSION = '1.27'; +our $VERSION = '1.28'; %ops = ( with_assign => "+ - * / % ** << >> x .", @@ -63,7 +63,7 @@ sub unimport { *{$package . "::(("} = \&nil; for (@_) { warnings::warnif("overload arg '$_' is invalid") - unless $ops_seen{$_}; + unless exists $ops_seen{$_}; delete $ {$package . "::"}{$_ eq 'fallback' ? '()' : "(" .$_}; } } diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 07ee636..265b444 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -529,7 +529,7 @@ BEGIN { use vars qw($VERSION $header); # bump to X.XX in blead, only use X.XX_XX in maint -$VERSION = '1.50'; +$VERSION = '1.51'; $header = "perl5db.pl version $VERSION"; @@ -1533,14 +1533,6 @@ We then determine what the console should be on various systems: undef $console; } -=item * Unix - use F. - -=cut - - elsif ( -e "/dev/tty" ) { - $console = "/dev/tty"; - } - =item * Windows or MSDOS - use C. =cut @@ -1565,6 +1557,17 @@ We then determine what the console should be on various systems: $console = 'sys$command'; } +# Keep this penultimate, on the grounds that it satisfies a wide variety of +# Unix-like systems that would otherwise need to be identified individually. + +=item * Unix - use F. + +=cut + + elsif ( -e "/dev/tty" ) { + $console = "/dev/tty"; + } + # Keep this last. else { @@ -1656,14 +1659,14 @@ and if we can. $o = $i unless defined $o; # read/write on in, or just read, or read on STDIN. - open( IN, "+<$i" ) - || open( IN, "<$i" ) + open( IN, '+<', $i ) + || open( IN, '<', $i ) || open( IN, "<&STDIN" ); # read/write/create/clobber out, or write/create/clobber out, # or merge with STDERR, or merge with STDOUT. - open( OUT, "+>$o" ) - || open( OUT, ">$o" ) + open( OUT, '+>', $o ) + || open( OUT, '>', $o ) || open( OUT, ">&STDERR" ) || open( OUT, ">&STDOUT" ); # so we don't dongle stdout @@ -6828,8 +6831,8 @@ sub setterm { if ($tty) { my ( $i, $o ) = split $tty, /,/; $o = $i unless defined $o; - open( IN, "<$i" ) or die "Cannot open TTY '$i' for read: $!"; - open( OUT, ">$o" ) or die "Cannot open TTY '$o' for write: $!"; + open( IN, '<', $i ) or die "Cannot open TTY '$i' for read: $!"; + open( OUT, '>', $o ) or die "Cannot open TTY '$o' for write: $!"; $IN = \*IN; $OUT = \*OUT; _autoflush($OUT); @@ -7752,8 +7755,8 @@ sub TTY { } # Open file onto the debugger's filehandles, if you can. - open IN, $in or die "cannot open '$in' for read: $!"; - open OUT, ">$out" or die "cannot open '$out' for write: $!"; + open IN, '<', $in or die "cannot open '$in' for read: $!"; + open OUT, '>', $out or die "cannot open '$out' for write: $!"; # Swap to the new filehandles. reset_IN_OUT( \*IN, \*OUT ); diff --git a/lib/perl5db.t b/lib/perl5db.t index e216685..a2dccc6 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -10,6 +10,8 @@ use strict; use warnings; use Config; +delete $ENV{PERLDB_OPTS}; + BEGIN { if (! -c "/dev/null") { print "1..0 # Skip: no /dev/null\n"; diff --git a/lib/unicore/mktables b/lib/unicore/mktables index fa1f1f4..5424617 100644 --- a/lib/unicore/mktables +++ b/lib/unicore/mktables @@ -13699,6 +13699,18 @@ numerals. END )); + # Make sure this assumption in perl core code is valid in this Unicode + # release, with known exceptions + foreach my $range (property_ref('Numeric-Type')->table('Decimal')->ranges) { + next if $range->end - $range->start == 9; + next if $range->start == 0x1D7CE; # This whole range was added in 3.1 + next if $range->end == 0x19DA && $v_version eq v5.2.0; + next if $range->end - $range->start < 9 && $v_version le 4.0.0; + Carp::my_carp("Range $range unexpectedly doesn't contain 10" + . " decimal digits. Code in regcomp.c assumes it does," + . " and will have to be fixed. Proceeding anyway."); + } + Property->new('Legacy_Case_Folding', File => "Fold", Directory => $map_directory, diff --git a/lib/utf8.t b/lib/utf8.t index 06d9a84..6b28eae 100644 --- a/lib/utf8.t +++ b/lib/utf8.t @@ -170,7 +170,7 @@ BANG ); foreach (@tests) { my ($why, $prog, $expect) = @$_; - open P, ">$progfile" or die "Can't open '$progfile': $!"; + open P, ">", $progfile or die "Can't open '$progfile': $!"; binmode(P, ":bytes") if $has_perlio; print P $show, $prog, '; print $b' or die "Print to 'progfile' failed: $!"; diff --git a/lib/vmsish.t b/lib/vmsish.t index f2b451d..7681f07 100644 --- a/lib/vmsish.t +++ b/lib/vmsish.t @@ -106,7 +106,7 @@ is($?,0,"outer lex scope of vmsish [POSIX status]"); ok(($msg !~ /ABORT/),"vmsish ERR exit, vmsish hushed at runtime, DCL error message check"); local *TEST; - open(TEST,'>vmsish_test.pl') || die('not ok ?? : unable to open "vmsish_test.pl" for writing'); + open(TEST,'>','vmsish_test.pl') || die('not ok ?? : unable to open "vmsish_test.pl" for writing'); print TEST "#! perl\n"; print TEST "use vmsish qw(hushed);\n"; print TEST "\$obvious = (\$compile(\$error;\n"; @@ -137,7 +137,7 @@ is($?,0,"outer lex scope of vmsish [POSIX status]"); # we create a file rather than using an existing one for the stat() test. my $file = 'sys$scratch:vmsish_t_flirble.tmp'; - open TMP, ">$file" or die "Couldn't open file $file"; + open TMP, '>', $file or die "Couldn't open file $file"; close TMP; END { 1 while unlink $file; } @@ -187,7 +187,7 @@ is($?,0,"outer lex scope of vmsish [POSIX status]"); # they were turned off in invoking procedure sub do_a_perl { local *P; - open(P,'>vmsish_test.com') || die('not ok ?? : unable to open "vmsish_test.com" for writing'); + open(P,'>','vmsish_test.com') || die('not ok ?? : unable to open "vmsish_test.com" for writing'); print P "\$ set message/facil/sever/ident/text\n"; print P "\$ define/nolog/user sys\$error _nla0:\n"; print P "\$ $Invoke_Perl @_\n"; diff --git a/locale.c b/locale.c index 07f599c..8521ffd 100644 --- a/locale.c +++ b/locale.c @@ -420,10 +420,10 @@ Perl_new_ctype(pTHX_ const char *newctype) : "" ); /* If we are actually in the scope of the locale or are debugging, - * output the message now. Otherwise we save it to be output at - * the first operation using this locale, if that actually happens. - * Most programs don't use locales, so they are immune to bad ones. - * */ + * output the message now. If not in that scope, we save the + * message to be output at the first operation using this locale, + * if that actually happens. Most programs don't use locales, so + * they are immune to bad ones. */ if (IN_LC(LC_CTYPE) || UNLIKELY(DEBUG_L_TEST)) { /* We have to save 'newctype' because the setlocale() just @@ -436,10 +436,14 @@ Perl_new_ctype(pTHX_ const char *newctype) /* The '0' below suppresses a bogus gcc compiler warning */ Perl_warner(aTHX_ packWARN(WARN_LOCALE), SvPVX(PL_warn_locale), 0); + setlocale(LC_CTYPE, badlocale); Safefree(badlocale); - SvREFCNT_dec_NN(PL_warn_locale); - PL_warn_locale = NULL; + + if (IN_LC(LC_CTYPE)) { + SvREFCNT_dec_NN(PL_warn_locale); + PL_warn_locale = NULL; + } } } } @@ -549,7 +553,7 @@ Perl_new_collate(pTHX_ const char *newcoll) * This has the desired effect that strcmp() will look at the secondary * or tertiary weights only if the strings compare equal at all higher * priority weights. The spaces shown here, like in - * "A¹B¹C¹ * A²B²C² " + * "A¹B¹C¹ A²B²C² " * are not just for readability. In the general case, these must * actually be bytes, which we will call here 'separator weights'; and * they must be smaller than any other weight value, but since these @@ -1723,13 +1727,14 @@ Perl__mem_collxfrm(pTHX_ const char *input_string, { STRLEN i; STRLEN d= 0; + char * e = (char *) t + len; for (i = 0; i < len; i+= UTF8SKIP(t + i)) { U8 cur_char = t[i]; if (UTF8_IS_INVARIANT(cur_char)) { s[d++] = cur_char; } - else if (UTF8_IS_DOWNGRADEABLE_START(cur_char)) { + else if (UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(t + i, e)) { s[d++] = EIGHT_BIT_UTF8_TO_NATIVE(cur_char, t[i+1]); } else { /* Replace illegal cp with highest collating diff --git a/make_ext.pl b/make_ext.pl index 8270092..c129a34 100644 --- a/make_ext.pl +++ b/make_ext.pl @@ -287,7 +287,7 @@ sub build_extension { if (-f $makefile) { $makefile_no_minus_f = 0; - open my $mfh, $makefile or die "Cannot open $makefile: $!"; + open my $mfh, '<', $makefile or die "Cannot open $makefile: $!"; while (<$mfh>) { # Plagiarised from CPAN::Distribution last if /MakeMaker post_initialize section/; diff --git a/makedef.pl b/makedef.pl index 68ae706..8e29f2a 100644 --- a/makedef.pl +++ b/makedef.pl @@ -1227,7 +1227,7 @@ if ($ARGS{PLATFORM} =~ /^win(?:32|ce)$/) { if ($ARGS{PLATFORM} eq 'os2') { my (%mapped, @missing); - open MAP, 'miniperl.map' or die 'Cannot read miniperl.map'; + open MAP, '<', 'miniperl.map' or die 'Cannot read miniperl.map'; /^\s*[\da-f:]+\s+(\w+)/i and $mapped{$1}++ foreach ; close MAP or die 'Cannot close miniperl.map'; diff --git a/makedepend.SH b/makedepend.SH index e4efae5..600288f 100755 --- a/makedepend.SH +++ b/makedepend.SH @@ -130,7 +130,7 @@ for file in `$cat .clist`; do */*) finc="-I`echo $file | sed 's#/[^/]*$##'`" ;; *) finc= ;; esac - $echo "Finding dependencies for $filebase$_o." + $echo "Finding dependencies for $filebase$_o" # Below, we strip out all but preprocessor directives. # We have to take care of situations like # #if defined(FOO) BAR /* comment line 1 diff --git a/mathoms.c b/mathoms.c index c74a386..92cd77a 100644 --- a/mathoms.c +++ b/mathoms.c @@ -1145,7 +1145,7 @@ Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) { PERL_ARGS_ASSERT_TO_UTF8_FOLD; - return _to_utf8_fold_flags(p, ustrp, lenp, FOLD_FLAGS_FULL); + return toFOLD_utf8(p, ustrp, lenp); } UV @@ -1153,7 +1153,7 @@ Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) { PERL_ARGS_ASSERT_TO_UTF8_LOWER; - return _to_utf8_lower_flags(p, ustrp, lenp, FALSE); + return toLOWER_utf8(p, ustrp, lenp); } UV @@ -1161,7 +1161,7 @@ Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) { PERL_ARGS_ASSERT_TO_UTF8_TITLE; - return _to_utf8_title_flags(p, ustrp, lenp, FALSE); + return toTITLE_utf8(p, ustrp, lenp); } UV @@ -1169,7 +1169,7 @@ Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) { PERL_ARGS_ASSERT_TO_UTF8_UPPER; - return _to_utf8_upper_flags(p, ustrp, lenp, FALSE); + return toUPPER_utf8(p, ustrp, lenp); } SV * diff --git a/mg.c b/mg.c index cbabcc6..69fdc93 100644 --- a/mg.c +++ b/mg.c @@ -2557,7 +2557,7 @@ S_set_dollarzero(pTHX_ SV *sv) * the setproctitle() routine to manipulate that. */ if (PL_origalen != 1) { s = SvPV_const(sv, len); -# if __FreeBSD_version > 410001 +# if __FreeBSD_version > 410001 || defined(__DragonFly__) /* The leading "-" removes the "perl: " prefix, * but not the "(perl) suffix from the ps(1) * output, because that's what ps(1) shows if the @@ -2709,8 +2709,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) else { if (strEQ(mg->mg_ptr + 1, "NCODING") && SvOK(sv)) if (PL_localizing != 2) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), - "${^ENCODING} is no longer supported"); + deprecate_fatal_in("5.28", + "${^ENCODING} is no longer supported"); } } break; @@ -2890,17 +2890,19 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) if (SvROK(sv)) { SV *referent= SvRV(sv); const char *reftype= sv_reftype(referent, 0); - /* XXX: dodgy type check: This leaves me feeling dirty, but the alternative - * is to copy pretty much the entire sv_reftype() into this routine, or to do - * a full string comparison on the return of sv_reftype() both of which - * make me feel worse! NOTE, do not modify this comment without reviewing the - * corresponding comment in sv_reftype(). - Yves */ + /* XXX: dodgy type check: This leaves me feeling dirty, but + * the alternative is to copy pretty much the entire + * sv_reftype() into this routine, or to do a full string + * comparison on the return of sv_reftype() both of which + * make me feel worse! NOTE, do not modify this comment + * without reviewing the corresponding comment in + * sv_reftype(). - Yves */ if (reftype[0] == 'S' || reftype[0] == 'L') { IV val= SvIV(referent); if (val <= 0) { tmpsv= &PL_sv_undef; Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), - "Setting $/ to a reference to %s as a form of slurp is deprecated, treating as undef", + "Setting $/ to a reference to %s as a form of slurp is deprecated, treating as undef. This will be fatal in Perl 5.28", SvIV(SvRV(sv)) < 0 ? "a negative integer" : "zero" ); } diff --git a/op.c b/op.c index 722ee35..118c519 100644 --- a/op.c +++ b/op.c @@ -652,11 +652,12 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags) (UV)flags); /* complain about "my $" etc etc */ - if (len && - !(is_our || - isALPHA(name[1]) || - ((flags & SVf_UTF8) && isIDFIRST_utf8((U8 *)name+1)) || - (name[1] == '_' && len > 2))) + if ( len + && !( is_our + || isALPHA(name[1]) + || ( (flags & SVf_UTF8) + && isIDFIRST_utf8_safe((U8 *)name+1, name + len)) + || (name[1] == '_' && len > 2))) { if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1])) && isASCII(name[1]) @@ -1669,10 +1670,12 @@ static void S_scalar_slice_warning(pTHX_ const OP *o) { OP *kid; + const bool h = o->op_type == OP_HSLICE + || (o->op_type == OP_NULL && o->op_targ == OP_HSLICE); const char lbrack = - o->op_type == OP_HSLICE ? '{' : '['; + h ? '{' : '['; const char rbrack = - o->op_type == OP_HSLICE ? '}' : ']'; + h ? '}' : ']'; SV *name; SV *keysv = NULL; /* just to silence compiler warnings */ const char *key = NULL; @@ -2447,6 +2450,39 @@ S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op) } +/* do all the final processing on an optree (e.g. running the peephole + * optimiser on it), then attach it to cv (if cv is non-null) + */ + +static void +S_process_optree(pTHX_ CV *cv, OP *optree, OP* start) +{ + OP **startp; + + /* XXX for some reason, evals, require and main optrees are + * never attached to their CV; instead they just hang off + * PL_main_root + PL_main_start or PL_eval_root + PL_eval_start + * and get manually freed when appropriate */ + if (cv) + startp = &CvSTART(cv); + else + startp = PL_in_eval? &PL_eval_start : &PL_main_start; + + *startp = start; + optree->op_private |= OPpREFCOUNTED; + OpREFCNT_set(optree, 1); + CALL_PEEP(*startp); + finalize_optree(optree); + S_prune_chain_head(startp); + + if (cv) { + /* now that optimizer has done its work, adjust pad values */ + pad_tidy(optree->op_type == OP_LEAVEWRITE ? padtidy_FORMAT + : CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB); + } +} + + /* =for apidoc finalize_optree @@ -2595,6 +2631,10 @@ S_finalize_op(pTHX_ OP* o) S_check_hash_fields_and_hekify(aTHX_ rop, key_op); break; } + case OP_NULL: + if (o->op_targ != OP_HSLICE && o->op_targ != OP_ASLICE) + break; + /* FALLTHROUGH */ case OP_ASLICE: S_scalar_slice_warning(aTHX_ o); break; @@ -3163,9 +3203,32 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) goto nomod; else if (!(o->op_flags & OPf_KIDS)) break; + if (o->op_targ != OP_LIST) { - op_lvalue(cBINOPo->op_first, type); - break; + OP *sib = OpSIBLING(cLISTOPo->op_first); + /* OP_TRANS and OP_TRANSR with argument have a weird optree + * that looks like + * + * null + * arg + * trans + * + * compared with things like OP_MATCH which have the argument + * as a child: + * + * match + * arg + * + * so handle specially to correctly get "Can't modify" croaks etc + */ + + if (sib && (sib->op_type == OP_TRANS || sib->op_type == OP_TRANSR)) + { + /* this should trigger a "Can't modify transliteration" err */ + op_lvalue(sib, type); + } + op_lvalue(cBINOPo->op_first, type); + break; } /* FALLTHROUGH */ case OP_LIST: @@ -4167,6 +4230,8 @@ Perl_blockhook_register(pTHX_ BHK *hk) void Perl_newPROG(pTHX_ OP *o) { + OP *start; + PERL_ARGS_ASSERT_NEWPROG; if (PL_in_eval) { @@ -4188,16 +4253,12 @@ Perl_newPROG(pTHX_ OP *o) else scalar(PL_eval_root); - PL_eval_start = op_linklist(PL_eval_root); - PL_eval_root->op_private |= OPpREFCOUNTED; - OpREFCNT_set(PL_eval_root, 1); + start = op_linklist(PL_eval_root); PL_eval_root->op_next = 0; i = PL_savestack_ix; SAVEFREEOP(o); ENTER; - CALL_PEEP(PL_eval_start); - finalize_optree(PL_eval_root); - S_prune_chain_head(&PL_eval_start); + S_process_optree(aTHX_ NULL, PL_eval_root, start); LEAVE; PL_savestack_ix = i; } @@ -4236,13 +4297,9 @@ Perl_newPROG(pTHX_ OP *o) } PL_main_root = op_scope(sawparens(scalarvoid(o))); PL_curcop = &PL_compiling; - PL_main_start = LINKLIST(PL_main_root); - PL_main_root->op_private |= OPpREFCOUNTED; - OpREFCNT_set(PL_main_root, 1); + start = LINKLIST(PL_main_root); PL_main_root->op_next = 0; - CALL_PEEP(PL_main_start); - finalize_optree(PL_main_root); - S_prune_chain_head(&PL_main_start); + S_process_optree(aTHX_ NULL, PL_main_root, start); cv_forget_slab(PL_compcv); PL_compcv = 0; @@ -6944,7 +7001,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) && !(o2->op_private & OPpPAD_STATE)) { Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), - "Deprecated use of my() in false conditional"); + "Deprecated use of my() in false conditional. " + "This will be a fatal error in Perl 5.30"); } *otherp = NULL; @@ -8321,8 +8379,6 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) PL_breakable_sub_gen++; CvROOT(cv) = block; - CvROOT(cv)->op_private |= OPpREFCOUNTED; - OpREFCNT_set(CvROOT(cv), 1); /* The cv no longer needs to hold a refcount on the slab, as CvROOT itself has a refcount. */ CvSLABBED_off(cv); @@ -8330,14 +8386,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) #ifdef PERL_DEBUG_READONLY_OPS slab = (OPSLAB *)CvSTART(cv); #endif - CvSTART(cv) = start; - CALL_PEEP(start); - finalize_optree(CvROOT(cv)); - S_prune_chain_head(&CvSTART(cv)); - - /* now that optimizer has done its work, adjust pad values */ - - pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB); + S_process_optree(aTHX_ cv, block, start); } attrs: @@ -8814,8 +8863,6 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, PL_breakable_sub_gen++; CvROOT(cv) = block; - CvROOT(cv)->op_private |= OPpREFCOUNTED; - OpREFCNT_set(CvROOT(cv), 1); /* The cv no longer needs to hold a refcount on the slab, as CvROOT itself has a refcount. */ CvSLABBED_off(cv); @@ -8823,14 +8870,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, #ifdef PERL_DEBUG_READONLY_OPS slab = (OPSLAB *)CvSTART(cv); #endif - CvSTART(cv) = start; - CALL_PEEP(start); - finalize_optree(CvROOT(cv)); - S_prune_chain_head(&CvSTART(cv)); - - /* now that optimizer has done its work, adjust pad values */ - - pad_tidy(CvCLONE(cv) ? padtidy_SUBCLONE : padtidy_SUB); + S_process_optree(aTHX_ cv, block, start); } attrs: @@ -9236,8 +9276,9 @@ void Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) { CV *cv; - GV *gv; + OP *root; + OP *start; if (PL_parser && PL_parser->error_count) { op_free(block); @@ -9272,15 +9313,11 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) CvFILE_set_from_cop(cv, PL_curcop); - pad_tidy(padtidy_FORMAT); - CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block)); - CvROOT(cv)->op_private |= OPpREFCOUNTED; - OpREFCNT_set(CvROOT(cv), 1); - CvSTART(cv) = LINKLIST(CvROOT(cv)); - CvROOT(cv)->op_next = 0; - CALL_PEEP(CvSTART(cv)); - finalize_optree(CvROOT(cv)); - S_prune_chain_head(&CvSTART(cv)); + root = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block)); + CvROOT(cv) = root; + start = LINKLIST(root); + root->op_next = 0; + S_process_optree(aTHX_ cv, root, start); cv_forget_slab(cv); finish: @@ -13359,6 +13396,79 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints) } /* for (pass = ...) */ } +/* See if the ops following o are such that o will always be executed in + * boolean context: that is, the SV which o pushes onto the stack will + * only ever be used by later ops with SvTRUE(sv) or similar. + * If so, set a suitable private flag on o. Normally this will be + * bool_flag; but if it's only possible to determine booleaness at run + * time (e.g. sub f { ....; (%h || $y) }), then set maybe_flag instead. + */ + +static void +S_check_for_bool_cxt(pTHX_ OP*o, U8 bool_flag, U8 maybe_flag) +{ + OP *lop; + + assert((o->op_flags & OPf_WANT) == OPf_WANT_SCALAR); + + lop = o->op_next; + + while (lop) { + switch (lop->op_type) { + case OP_NULL: + case OP_SCALAR: + break; + + /* these two consume the stack argument in the scalar case, + * and treat it as a boolean in the non linenumber case */ + case OP_FLIP: + case OP_FLOP: + if ( ((lop->op_flags & OPf_WANT) == OPf_WANT_LIST) + || (lop->op_private & OPpFLIP_LINENUM)) + { + lop = NULL; + break; + } + /* FALLTHROUGH */ + /* these never leave the original value on the stack */ + case OP_NOT: + case OP_XOR: + case OP_COND_EXPR: + case OP_GREPWHILE: + o->op_private |= bool_flag; + lop = NULL; + break; + + /* OR DOR and AND evaluate their arg as a boolean, but then may + * leave the original scalar value on the stack when following the + * op_next route. If not in void context, we need to ensure + * that whatever follows consumes the arg only in boolean context + * too. + */ + case OP_OR: + case OP_DOR: + case OP_AND: + if ((lop->op_flags & OPf_WANT) == OPf_WANT_VOID) { + o->op_private |= bool_flag; + lop = NULL; + } + else if (!(lop->op_flags & OPf_WANT)) { + /* unknown context - decide at runtime */ + o->op_private |= maybe_flag; + lop = NULL; + } + break; + + default: + lop = NULL; + break; + } + + if (lop) + lop = lop->op_next; + } +} + /* mechanism for deferring recursion in rpeep() */ @@ -13394,8 +13504,6 @@ Perl_rpeep(pTHX_ OP *o) OP** defer_queue[MAX_DEFERRED]; /* small queue of deferred branches */ int defer_base = 0; int defer_ix = -1; - OP *fop; - OP *sop; if (!o || o->op_opt) return; @@ -14090,19 +14198,26 @@ Perl_rpeep(pTHX_ OP *o) break; } + case OP_RV2HV: + case OP_PADHV: + /* see if %h is used in boolean context */ + if ((o->op_flags & OPf_WANT) == OPf_WANT_SCALAR) + S_check_for_bool_cxt(aTHX_ o, OPpTRUEBOOL, OPpMAYBE_TRUEBOOL); + if (o->op_type != OP_PADHV) + break; + /* FALLTHROUGH */ case OP_PADAV: case OP_PADSV: - case OP_PADHV: - /* Skip over state($x) in void context. */ - if (oldop && o->op_private == (OPpPAD_STATE|OPpLVAL_INTRO) - && (o->op_flags & OPf_WANT) == OPf_WANT_VOID) - { - oldop->op_next = o->op_next; - goto redo_nextstate; - } - if (o->op_type != OP_PADAV) - break; - /* FALLTHROUGH */ + /* Skip over state($x) in void context. */ + if (oldop && o->op_private == (OPpPAD_STATE|OPpLVAL_INTRO) + && (o->op_flags & OPf_WANT) == OPf_WANT_VOID) + { + oldop->op_next = o->op_next; + goto redo_nextstate; + } + if (o->op_type != OP_PADAV) + break; + /* FALLTHROUGH */ case OP_GV: if (o->op_type == OP_PADAV || o->op_next->op_type == OP_RV2AV) { OP* const pop = (o->op_type == OP_PADAV) ? @@ -14182,25 +14297,12 @@ Perl_rpeep(pTHX_ OP *o) break; -#define HV_OR_SCALARHV(op) \ - ( (op)->op_type == OP_PADHV || (op)->op_type == OP_RV2HV \ - ? (op) \ - : (op)->op_type == OP_SCALAR && (op)->op_flags & OPf_KIDS \ - && ( cUNOPx(op)->op_first->op_type == OP_PADHV \ - || cUNOPx(op)->op_first->op_type == OP_RV2HV) \ - ? cUNOPx(op)->op_first \ - : NULL) - case OP_NOT: - if ((fop = HV_OR_SCALARHV(cUNOP->op_first))) - fop->op_private |= OPpTRUEBOOL; break; case OP_AND: case OP_OR: case OP_DOR: - fop = cLOGOP->op_first; - sop = OpSIBLING(fop); while (cLOGOP->op_other->op_type == OP_NULL) cLOGOP->op_other = cLOGOP->op_other->op_next; while (o->op_next && ( o->op_type == o->op_next->op_type @@ -14222,53 +14324,10 @@ Perl_rpeep(pTHX_ OP *o) o->op_next = ((LOGOP*)o->op_next)->op_other; } DEFER(cLOGOP->op_other); - o->op_opt = 1; - fop = HV_OR_SCALARHV(fop); - if (sop) sop = HV_OR_SCALARHV(sop); - if (fop || sop - ){ - OP * nop = o; - OP * lop = o; - if (!((nop->op_flags & OPf_WANT) == OPf_WANT_VOID)) { - while (nop && nop->op_next) { - switch (nop->op_next->op_type) { - case OP_NOT: - case OP_AND: - case OP_OR: - case OP_DOR: - lop = nop = nop->op_next; - break; - case OP_NULL: - nop = nop->op_next; - break; - default: - nop = NULL; - break; - } - } - } - if (fop) { - if ( (lop->op_flags & OPf_WANT) == OPf_WANT_VOID - || o->op_type == OP_AND ) - fop->op_private |= OPpTRUEBOOL; - else if (!(lop->op_flags & OPf_WANT)) - fop->op_private |= OPpMAYBE_TRUEBOOL; - } - if ( (lop->op_flags & OPf_WANT) == OPf_WANT_VOID - && sop) - sop->op_private |= OPpTRUEBOOL; - } - - break; case OP_COND_EXPR: - if ((fop = HV_OR_SCALARHV(cLOGOP->op_first))) - fop->op_private |= OPpTRUEBOOL; -#undef HV_OR_SCALARHV - /* GERONIMO! */ /* FALLTHROUGH */ - case OP_MAPWHILE: case OP_GREPWHILE: case OP_ANDASSIGN: diff --git a/op.h b/op.h index c0e6386..90f63e3 100644 --- a/op.h +++ b/op.h @@ -1075,7 +1075,8 @@ C is non-null. For a higher-level interface, see C>. #if defined(PERL_IN_DOOP_C) || defined(PERL_IN_PP_C) static const char * const deprecated_above_ff_msg = "Use of strings with code points over 0xFF as arguments to " - "%s operator is deprecated"; + "%s operator is deprecated. This will be a fatal error in " + "Perl 5.28"; #endif diff --git a/os2/OS2/OS2-Process/Process.pm b/os2/OS2/OS2-Process/Process.pm index 08b619f..7c41903 100644 --- a/os2/OS2/OS2-Process/Process.pm +++ b/os2/OS2/OS2-Process/Process.pm @@ -20,7 +20,7 @@ BEGIN { #require AutoLoader; our @ISA = qw(Exporter); - our $VERSION = "1.11"; + our $VERSION = "1.12"; XSLoader::load('OS2::Process', $VERSION); } @@ -756,7 +756,7 @@ sub __term_mirror { close IN if defined $out; $pid > 0 or die "Cannot start a grandkid"; - open STDIN, ' contains the screen contents, then - open IN, $file or die; + open IN, '<', $file or die; binmode IN; read IN, $in, -s IN; $s = screen; diff --git a/os2/os2ish.h b/os2/os2ish.h index 70c8cbe..fb71cd0 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -274,7 +274,7 @@ void Perl_OS2_term(void **excH, int exitstatus, int flags); /* #define PERL_SYS_TERM_BODY() STMT_START { \ if (Perl_HAB_set) WinTerminate(Perl_hab); } STMT_END */ -#define dXSUB_SYS OS2_XS_init() +#define dXSUB_SYS int fake = OS2_XS_init() PERL_UNUSED_DECL #ifdef PERL_IS_AOUT /* # define HAS_FORK */ diff --git a/pad.c b/pad.c index 6d2d008..5bbb07a 100644 --- a/pad.c +++ b/pad.c @@ -2159,7 +2159,8 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned, "Constants from lexical " "variables potentially " "modified elsewhere are " - "deprecated"); + "deprecated. This will not " + "be allowed in Perl 5.32"); /* We *copy* the lexical variable, and donate the copy to newCONSTSUB. Yes, this is ugly, and should be killed. We need to do this for the diff --git a/patchlevel.h b/patchlevel.h index 34f0d75..fbf74f9 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -15,7 +15,7 @@ #define PERL_REVISION 5 /* age */ #define PERL_VERSION 25 /* epoch */ -#define PERL_SUBVERSION 8 /* generation */ +#define PERL_SUBVERSION 9 /* 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 8 +#define PERL_API_SUBVERSION 9 /* XXX Note: The selection of non-default Configure options, such as -Duselonglong may invalidate these settings. Currently, Configure @@ -90,8 +90,8 @@ #!perl die "Usage: perl -x patchlevel.h comment ..." unless @ARGV; -open PLIN, "patchlevel.h" or die "Couldn't open patchlevel.h : $!"; -open PLOUT, ">patchlevel.new" or die "Couldn't write on patchlevel.new : $!"; +open PLIN, "<", "patchlevel.h" or die "Couldn't open patchlevel.h : $!"; +open PLOUT, ">", "patchlevel.new" or die "Couldn't write on patchlevel.new : $!"; my $seen=0; while () { if (/\t,NULL/ and $seen) { diff --git a/perl.c b/perl.c index 3a647f7..09eb2f4 100644 --- a/perl.c +++ b/perl.c @@ -3,7 +3,7 @@ * * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 - * 2013, 2014, 2015, 2016 by Larry Wall and others + * 2013, 2014, 2015, 2016, 2017 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -420,6 +420,7 @@ 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); + PL_Assigned_invlist = _new_invlist_C_array(Assigned_invlist); #ifdef USE_THREAD_SAFE_LOCALE PL_C_locale_obj = newlocale(LC_ALL_MASK, "C", NULL); #endif @@ -1127,6 +1128,7 @@ perl_destruct(pTHXx) PL_LB_invlist = NULL; PL_SB_invlist = NULL; PL_WB_invlist = NULL; + PL_Assigned_invlist = NULL; if (!specialWARN(PL_compiling.cop_warnings)) PerlMemShared_free(PL_compiling.cop_warnings); @@ -1535,7 +1537,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) #ifndef MULTIPLICITY PERL_UNUSED_ARG(my_perl); #endif -#if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) || defined(USE_HASH_SEED_DEBUG) +#if (defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) || defined(USE_HASH_SEED_DEBUG)) && !defined(NO_PERL_HASH_SEED_DEBUG) { const char * const s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG"); @@ -1554,7 +1556,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) PerlIO_printf(Perl_debug_log, "\n"); } } -#endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */ +#endif /* #if (defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) ... */ #ifdef __amigaos4__ { @@ -3595,7 +3597,7 @@ S_minus_v(pTHX) #endif PerlIO_printf(PIO_stdout, - "\n\nCopyright 1987-2016, Larry Wall\n"); + "\n\nCopyright 1987-2017, Larry Wall\n"); #ifdef MSDOS PerlIO_printf(PIO_stdout, "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n"); diff --git a/plan9/config.plan9 b/plan9/config.plan9 index f716b93..6b03c08 100644 --- a/plan9/config.plan9 +++ b/plan9/config.plan9 @@ -3329,8 +3329,8 @@ * 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.8" /**/ -#define PRIVLIB_EXP "/sys/lib/perl/5.25.8" /**/ +#define PRIVLIB "/sys/lib/perl/5.25.9" /**/ +#define PRIVLIB_EXP "/sys/lib/perl/5.25.9" /**/ /* PTRSIZE: * This symbol contains the size of a pointer, so that the C preprocessor @@ -3457,9 +3457,9 @@ * 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.8/site_perl" /**/ -#define SITELIB_EXP "/sys/lib/perl/5.25.8/site_perl" /**/ -#define SITELIB_STEM "/sys/lib/perl/5.25.8/site_perl" /**/ +#define SITELIB "/sys/lib/perl/5.25.9/site_perl" /**/ +#define SITELIB_EXP "/sys/lib/perl/5.25.9/site_perl" /**/ +#define SITELIB_STEM "/sys/lib/perl/5.25.9/site_perl" /**/ /* Size_t_size: * This symbol holds the size of a Size_t in bytes. diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample index de35675..c9b4735 100644 --- a/plan9/config_sh.sample +++ b/plan9/config_sh.sample @@ -32,12 +32,12 @@ alignbytes='4' ansi2knr='' aphostname='/bin/uname -n' api_revision='5' -api_subversion='8' +api_subversion='9' api_version='25' -api_versionstring='5.25.8' +api_versionstring='5.25.9' ar='ar' -archlib='/sys/lib/perl5/5.25.8/386' -archlibexp='/sys/lib/perl5/5.25.8/386' +archlib='/sys/lib/perl5/5.25.9/386' +archlibexp='/sys/lib/perl5/5.25.9/386' archname64='' archname='386' archobjs='' @@ -820,17 +820,17 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='/sys/lib/perl/5.25.8/386' +installarchlib='/sys/lib/perl/5.25.9/386' installbin='/usr/bin' installman1dir='/sys/man/1pub' installman3dir='/sys/man/2pub' installprefix='/usr' installprefixexp='/usr' -installprivlib='/sys/lib/perl/5.25.8' +installprivlib='/sys/lib/perl/5.25.9' installscript='/usr/bin' -installsitearch='/sys/lib/perl/5.25.8/site_perl/386' +installsitearch='/sys/lib/perl/5.25.9/site_perl/386' installsitebin='/usr/bin' -installsitelib='/sys/lib/perl/5.25.8/site_perl' +installsitelib='/sys/lib/perl/5.25.9/site_perl' installstyle='lib/perl5' installusrbinperl='undef' installvendorarch='' @@ -955,8 +955,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/sys/lib/perl/5.25.8' -privlibexp='/sys/lib/perl/5.25.8' +privlib='/sys/lib/perl/5.25.9' +privlibexp='/sys/lib/perl/5.25.9' procselfexe='' prototype='define' ptrsize='4' @@ -1021,13 +1021,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.8/site_perl/386' +sitearch='/sys/lib/perl/5.25.9/site_perl/386' sitearchexp='/sys/lib/perl/site_perl/386' sitebin='/usr/bin' sitebinexp='/usr/bin' -sitelib='/sys/lib/perl/5.25.8/site_perl' -sitelib_stem='/sys/lib/perl/5.25.8/site_perl' -sitelibexp='/sys/lib/perl/5.25.8/site_perl' +sitelib='/sys/lib/perl/5.25.9/site_perl' +sitelib_stem='/sys/lib/perl/5.25.9/site_perl' +sitelibexp='/sys/lib/perl/5.25.9/site_perl' siteprefix='/usr' siteprefixexp='/usr' sizesize='4' @@ -1060,7 +1060,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/sys/include/ape/string.h' submit='' -subversion='8' +subversion='9' sysman='/sys/man/1pub' tail='' tar='' @@ -1142,8 +1142,8 @@ vendorlib_stem='' vendorlibexp='' vendorprefix='' vendorprefixexp='' -version='5.25.8' -version_patchlevel_string='version 25 subversion 8' +version='5.25.9' +version_patchlevel_string='version 25 subversion 9' versiononly='undef' vi='' xlibpth='' @@ -1157,9 +1157,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=25 -PERL_SUBVERSION=8 +PERL_SUBVERSION=9 PERL_API_REVISION=5 PERL_API_VERSION=25 -PERL_API_SUBVERSION=8 +PERL_API_SUBVERSION=9 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/plan9/genconfig.pl b/plan9/genconfig.pl index 623423d..ebd97db 100644 --- a/plan9/genconfig.pl +++ b/plan9/genconfig.pl @@ -28,7 +28,7 @@ unshift(@INC,'lib'); # In case someone didn't define Perl_Root # before the build if ($ARGV[0] eq '-f') { - open(ARGS,$ARGV[1]) or die "Can't read data from $ARGV[1]: $!\n"; + open(ARGS,'<',$ARGV[1]) or die "Can't read data from $ARGV[1]: $!\n"; @ARGV = (); while () { push(@ARGV,split(/\|/,$_)); @@ -47,8 +47,8 @@ Can't find config.h to read! EndOfGasp } $outdir = ''; -open(IN,"$infile") || die "Can't open $infile: $!\n"; -open(OUT,">${outdir}config.sh") || die "Can't open ${outdir}config.sh: $!\n"; +open(IN,'<',$infile) || die "Can't open $infile: $!\n"; +open(OUT,'>',"${outdir}config.sh") || die "Can't open ${outdir}config.sh: $!\n"; $time = localtime; $cf_by = $ENV{'user'}; @@ -174,7 +174,7 @@ print OUT "myuname='Plan9 $myname $osvers $p9p_objtype'\n"; # Before we read the C header file, find out what config.sh constants are # equivalent to the C preprocessor macros -if (open(SH,"${outdir}config_h.SH")) { +if (open(SH,'<',"${outdir}config_h.SH")) { while () { next unless m%^#(?!if).*\$%; s/^#//; s!(.*?)\s*/\*.*!$1!; @@ -267,7 +267,7 @@ foreach (sort keys %val_vars) { # print OUT "libs='",join(' ',@libs),"'\n"; # print OUT "libc='",join(' ',@crtls),"'\n"; -if (open(PL,"${outdir}patchlevel.h")) { +if (open(PL,'<',"${outdir}patchlevel.h")) { while () { if (/^#define PERL_VERSION\s+(\S+)/) { print OUT "PERL_VERSION='$1'\n"; diff --git a/plan9/plan9ish.h b/plan9/plan9ish.h index 0fdce12..5c326f6 100644 --- a/plan9/plan9ish.h +++ b/plan9/plan9ish.h @@ -106,7 +106,7 @@ #define BIT_BUCKET "/dev/null" #define PERL_SYS_INIT_BODY(c,v) \ MALLOC_CHECK_TAINT2(*c,*v) PERLIO_INIT; MALLOC_INIT -#define dXSUB_SYS +#define dXSUB_SYS dNOOP #define PERL_SYS_TERM_BODY() PERLIO_TERM; MALLOC_TERM /* diff --git a/pod/.gitignore b/pod/.gitignore index 874cc72..14ac7be 100644 --- a/pod/.gitignore +++ b/pod/.gitignore @@ -50,7 +50,7 @@ /roffitall # generated -/perl5258delta.pod +/perl5259delta.pod /perlapi.pod /perlintern.pod /perlmodlib.pod diff --git a/pod/perl.pod b/pod/perl.pod index bfbb74a..7ba8f61 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -44,7 +44,7 @@ path perlglossary cpan/perlfaq/lib/ path perlxs(?:tut|typemap)? dist/ExtUtils-ParseXS/lib/ path perldoc cpan/Pod-Perldoc/ -aux c2ph h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp +aux h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp =end buildtoc @@ -98,6 +98,7 @@ aux c2ph h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp perlpodspec Perl plain old documentation format specification perlpodstyle Perl POD style guide perldiag Perl diagnostic messages + perldeprecation Perl deprecations perllexwarn Perl warnings and their control perldebug Perl debugging perlvar Perl predefined variables @@ -180,6 +181,7 @@ aux c2ph h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp perlhist Perl history records perldelta Perl changes since previous version + perl5258delta Perl changes in version 5.25.8 perl5257delta Perl changes in version 5.25.7 perl5256delta Perl changes in version 5.25.6 perl5255delta Perl changes in version 5.25.5 @@ -188,7 +190,9 @@ aux c2ph h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp perl5252delta Perl changes in version 5.25.2 perl5251delta Perl changes in version 5.25.1 perl5250delta Perl changes in version 5.25.0 + perl5241delta Perl changes in version 5.24.1 perl5240delta Perl changes in version 5.24.0 + perl5223delta Perl changes in version 5.22.3 perl5222delta Perl changes in version 5.22.2 perl5221delta Perl changes in version 5.22.1 perl5220delta Perl changes in version 5.22.0 diff --git a/pod/perl5223delta.pod b/pod/perl5223delta.pod new file mode 100644 index 0000000..e1322b7 --- /dev/null +++ b/pod/perl5223delta.pod @@ -0,0 +1,314 @@ +=encoding utf8 + +=head1 NAME + +perl5223delta - what is new for perl v5.22.3 + +=head1 DESCRIPTION + +This document describes differences between the 5.22.2 release and the 5.22.3 +release. + +If you are upgrading from an earlier release such as 5.22.1, first read +L, which describes differences between 5.22.1 and 5.22.2. + +=head1 Security + +=head2 B<-Di> switch is now required for PerlIO debugging output + +Previously PerlIO debugging output would be sent to the file specified by the +C environment variable if perl wasn't running setuid and the +B<-T> or B<-t> switches hadn't been parsed yet. + +If perl performed output at a point where it hadn't yet parsed its switches +this could result in perl creating or overwriting the file named by +C even when the B<-T> switch had been supplied. + +Perl now requires the B<-Di> switch to produce PerlIO debugging output. By +default this is written to C, but can optionally be redirected to a +file by setting the C environment variable. + +If perl is running setuid or the B<-T> switch was supplied C is +ignored and the debugging output is sent to C as for any other B<-D> +switch. + +=head2 Core modules and tools no longer search F<"."> for optional modules + +The tools and many modules supplied in core no longer search the default +current directory entry in L|perlvar/@INC> for optional modules. For +example, L will remove the final F<"."> from C<@INC> before trying to +load L. + +This prevents an attacker injecting an optional module into a process run by +another user where the current directory is writable by the attacker, e.g. the +F directory. + +In most cases this removal should not cause problems, but difficulties were +encountered with L, which treats every module name supplied as optional. +These difficulties have not yet been resolved, so for this release there are no +changes to L. We hope to have a fix for L in Perl 5.22.4. + +To protect your own code from this attack, either remove the default F<"."> +entry from C<@INC> at the start of your script, so: + + #!/usr/bin/perl + use strict; + ... + +becomes: + + #!/usr/bin/perl + BEGIN { pop @INC if $INC[-1] eq '.' } + use strict; + ... + +or for modules, remove F<"."> from a localized C<@INC>, so: + + my $can_foo = eval { require Foo; } + +becomes: + + my $can_foo = eval { + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; + require Foo; + }; + +=head1 Incompatible Changes + +Other than the security changes above there are no changes intentionally +incompatible with Perl 5.22.2. If any exist, they are bugs, and we request +that you submit a report. See L below. + +=head1 Modules and Pragmata + +=head2 Updated Modules and Pragmata + +=over 4 + +=item * + +L has been upgraded from version 2.04 to 2.04_01. + +=item * + +L has been upgraded from version 0.39 to 0.39_01. + +=item * + +L has been upgraded from version 2.11 to 2.11_01. + +=item * + +L has been upgraded from version 1.17 to 1.17_01. + +=item * + +L has been upgraded from version 5.95 to 5.95_01. + +=item * + +L has been upgraded from version 2.72 to 2.72_01. + +=item * + +L has been upgraded from version 1.20 to 1.20_01. + +=item * + +L has been upgraded from version 7.04_01 to 7.04_02. + +=item * + +L has been upgraded from version 0.48 to 0.48_01. + +=item * + +L has been upgraded from version 3.56_01 to 3.56_02. + +=item * + +L has been upgraded from version 0.054 to 0.054_01. + +=item * + +L has been upgraded from version 1.35 to 1.35_01. + +=item * + +The IO-Compress modules have been upgraded from version 2.068 to 2.068_001. + +=item * + +L has been upgraded from version 0.92 to 0.92_01. + +=item * + +L has been upgraded from version 2.27300 to 2.27300_01. + +=item * + +L has been upgraded from version 1.26 to 1.26_01. + +=item * + +L has been upgraded from version 0.21 to 0.21_01. + +=item * + +L has been upgraded from version 1.03 to 1.03_01. + +=item * + +L has been upgraded from version 5.20160429 to 5.20170114_22. + +=item * + +L has been upgraded from version 2.43 to 2.43_01. + +=item * + +L has been upgraded from version 1.4414 to 1.4414_001. + +=item * + +L has been upgraded from version 1.22 to 1.2201. + +=item * + +L has been upgraded from version 3.25 to 3.25_01. + +=item * + +L has been upgraded from version 2.53_01 to 2.53_02. + +=item * + +L has been upgraded from version 0.33 to 0.33_01. + +=item * + +L has been upgraded from version 1.26 to 1.26_01. + +=item * + +L has been upgraded from version 3.35 to 3.35_01. + +=item * + +L has been upgraded from version 0.20 to 0.20_01, fixing a security +hole in which binary files could be loaded from a path outside of C<@INC>. +L<[perl #128528]|https://rt.perl.org/Public/Bug/Display.html?id=128528> + +=back + +=head1 Documentation + +=head2 Changes to Existing Documentation + +=head3 L + +=over 4 + +=item * + +The documentation of C has been updated. + +=back + +=head3 L + +=over 4 + +=item * + +The new B<-Di> switch has been documented, and the documentation of +C has been updated. + +=back + +=head1 Testing + +=over 4 + +=item * + +A new test script, F, has been added to test that the new +B<-Di> switch is working correctly. + +=back + +=head1 Selected Bug Fixes + +=over 4 + +=item * + +The C macro is an lvalue again. + +=back + +=head1 Acknowledgements + +Perl 5.22.3 represents approximately 9 months of development since Perl 5.22.2 +and contains approximately 4,400 lines of changes across 240 files from 20 +authors. + +Excluding auto-generated files, documentation and release tools, there were +approximately 2,200 lines of changes to 170 .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.22.3: + +Aaron Crane, Abigail, Alex Vandiver, Aristotle Pagaltzis, Chad Granum, Chris +'BinGOs' Williams, Craig A. Berry, David Mitchell, Father Chrysostomos, James E +Keenan, Jarkko Hietaniemi, Karen Etheridge, Karl Williamson, Matthew Horsfall, +Niko Tyni, Ricardo Signes, Sawyer X, Stevan Little, Steve Hay, Tony Cook. + +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 file in the Perl source distribution. + +=head1 Reporting Bugs + +If you find what you think is a bug, you might check the articles recently +posted to the comp.lang.perl.misc newsgroup and the Perl bug database at +https://rt.perl.org/ . There may also be information at http://www.perl.org/ , +the Perl Home Page. + +If you believe you have an unreported bug, please run the L 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, +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 please send it +to perl5-security-report@perl.org. This points to a closed subscription +unarchived mailing list, which includes all the core committers, who will be +able to help assess the impact of issues, figure out a resolution, and help +co-ordinate the release of patches to mitigate or fix the problem across all +platforms on which Perl is supported. Please only use this address for +security issues in the Perl core, not for modules independently distributed on +CPAN. + +=head1 SEE ALSO + +The F file for an explanation of how to view exhaustive details on +what changed. + +The F file for how to build Perl. + +The F file for general stuff. + +The F and F files for copyright information. + +=cut diff --git a/pod/perl5241delta.pod b/pod/perl5241delta.pod new file mode 100644 index 0000000..5c50730 --- /dev/null +++ b/pod/perl5241delta.pod @@ -0,0 +1,308 @@ +=encoding utf8 + +=head1 NAME + +perl5241delta - what is new for perl v5.24.1 + +=head1 DESCRIPTION + +This document describes differences between the 5.24.0 release and the 5.24.1 +release. + +If you are upgrading from an earlier release such as 5.22.0, first read +L, which describes differences between 5.22.0 and 5.24.0. + +=head1 Security + +=head2 B<-Di> switch is now required for PerlIO debugging output + +Previously PerlIO debugging output would be sent to the file specified by the +C environment variable if perl wasn't running setuid and the +B<-T> or B<-t> switches hadn't been parsed yet. + +If perl performed output at a point where it hadn't yet parsed its switches +this could result in perl creating or overwriting the file named by +C even when the B<-T> switch had been supplied. + +Perl now requires the B<-Di> switch to produce PerlIO debugging output. By +default this is written to C, but can optionally be redirected to a +file by setting the C environment variable. + +If perl is running setuid or the B<-T> switch was supplied C is +ignored and the debugging output is sent to C as for any other B<-D> +switch. + +=head2 Core modules and tools no longer search F<"."> for optional modules + +The tools and many modules supplied in core no longer search the default +current directory entry in L|perlvar/@INC> for optional modules. For +example, L will remove the final F<"."> from C<@INC> before trying to +load L. + +This prevents an attacker injecting an optional module into a process run by +another user where the current directory is writable by the attacker, e.g. the +F directory. + +In most cases this removal should not cause problems, but difficulties were +encountered with L, which treats every module name supplied as optional. +These difficulties have not yet been resolved, so for this release there are no +changes to L. We hope to have a fix for L in Perl 5.24.2. + +To protect your own code from this attack, either remove the default F<"."> +entry from C<@INC> at the start of your script, so: + + #!/usr/bin/perl + use strict; + ... + +becomes: + + #!/usr/bin/perl + BEGIN { pop @INC if $INC[-1] eq '.' } + use strict; + ... + +or for modules, remove F<"."> from a localized C<@INC>, so: + + my $can_foo = eval { require Foo; } + +becomes: + + my $can_foo = eval { + local @INC = @INC; + pop @INC if $INC[-1] eq '.'; + require Foo; + }; + +=head1 Incompatible Changes + +Other than the security changes above there are no changes intentionally +incompatible with Perl 5.24.0. If any exist, they are bugs, and we request +that you submit a report. See L below. + +=head1 Modules and Pragmata + +=head2 Updated Modules and Pragmata + +=over 4 + +=item * + +L has been upgraded from version 2.04 to 2.04_01. + +=item * + +L has been upgraded from version 0.42 to 0.42_01. + +=item * + +L has been upgraded from version 2.11 to 2.11_01. + +=item * + +L has been upgraded from version 1.17 to 1.17_01. + +=item * + +L has been upgraded from version 5.95 to 5.95_01. + +=item * + +L has been upgraded from version 2.80 to 2.80_01. + +=item * + +L has been upgraded from version 7.10_01 to 7.10_02. + +=item * + +L has been upgraded from version 0.48 to 0.48_01. + +=item * + +L has been upgraded from version 3.63 to 3.63_01. + +=item * + +L has been upgraded from version 0.056 to 0.056_001. + +=item * + +L has been upgraded from version 1.36 to 1.36_01. + +=item * + +The IO-Compress modules have been upgraded from version 2.069 to 2.069_001. + +=item * + +L has been upgraded from version 0.92 to 0.92_01. + +=item * + +L has been upgraded from version 2.27300 to 2.27300_01. + +=item * + +L has been upgraded from version 1.26 to 1.26_01. + +=item * + +L has been upgraded from version 0.21 to 0.21_01. + +=item * + +L has been upgraded from version 1.03 to 1.03_01. + +=item * + +L has been upgraded from version 5.20160506 to 5.20170114_24. + +=item * + +L has been upgraded from version 2.43 to 2.43_01. + +=item * + +L has been upgraded from version 1.4417 to 1.4417_001. + +=item * + +L has been upgraded from version 1.22 to 1.2201. + +=item * + +L has been upgraded from version 3.25_02 to 3.25_03. + +=item * + +L has been upgraded from version 2.56 to 2.56_01. + +=item * + +L has been upgraded from version 0.33 to 0.33_01. + +=item * + +L has been upgraded from version 1.28 to 1.28_01. + +=item * + +L has been upgraded from version 3.36 to 3.36_01. + +=item * + +L 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 C<@INC>. +L<[perl #128528]|https://rt.perl.org/Public/Bug/Display.html?id=128528> + +=back + +=head1 Documentation + +=head2 Changes to Existing Documentation + +=head3 L + +=over 4 + +=item * + +The documentation of C has been updated. + +=back + +=head3 L + +=over 4 + +=item * + +The new B<-Di> switch has been documented, and the documentation of +C has been updated. + +=back + +=head1 Testing + +=over 4 + +=item * + +A new test script, F, has been added to test that the new +B<-Di> switch is working correctly. + +=back + +=head1 Selected Bug Fixes + +=over 4 + +=item * + +The change to hashbang redirection introduced in Perl 5.24.0, whereby perl +would redirect to another interpreter (Perl 6) if it found a hashbang path +which contains "perl" followed by "6", has been reverted because it broke in +cases such as C<#!/opt/perl64/bin/perl>. + +=back + +=head1 Acknowledgements + +Perl 5.24.1 represents approximately 8 months of development since Perl 5.24.0 +and contains approximately 8,100 lines of changes across 240 files from 18 +authors. + +Excluding auto-generated files, documentation and release tools, there were +approximately 2,200 lines of changes to 170 .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.24.1: + +Aaron Crane, Alex Vandiver, Aristotle Pagaltzis, Chad Granum, Chris 'BinGOs' +Williams, Craig A. Berry, Father Chrysostomos, James E Keenan, Jarkko +Hietaniemi, Karen Etheridge, Leon Timmermans, Matthew Horsfall, Ricardo Signes, +Sawyer X, Sébastien Aperghis-Tramoni, Stevan Little, Steve Hay, Tony Cook. + +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 file in the Perl source distribution. + +=head1 Reporting Bugs + +If you find what you think is a bug, you might check the articles recently +posted to the comp.lang.perl.misc newsgroup and the Perl bug database at +L . There may also be information at +L , the Perl Home Page. + +If you believe you have an unreported bug, please run the L 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, +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 for details of how to +report the issue. + +=head1 SEE ALSO + +The F file for an explanation of how to view exhaustive details on +what changed. + +The F file for how to build Perl. + +The F file for general stuff. + +The F and F files for copyright information. + +=cut diff --git a/pod/perl5258delta.pod b/pod/perl5258delta.pod new file mode 100644 index 0000000..e2a458c --- /dev/null +++ b/pod/perl5258delta.pod @@ -0,0 +1,213 @@ +=encoding utf8 + +=head1 NAME + +perl5258delta - what is new for perl v5.25.8 + +=head1 DESCRIPTION + +This document describes differences between the 5.25.7 release and the 5.25.8 +release. + +If you are upgrading from an earlier release such as 5.25.6, first read +L, which describes differences between 5.25.6 and 5.25.7. + +=head1 Core Enhancements + +=head2 New Hash Function For 64-bit Builds + +We have switched to a hybrid hash function to better balance +performance for short and long keys. + +For short keys, 16 bytes and under, we use an optimised variant of +One At A Time Hard, and for longer keys we use Siphash 1-3. For very +long keys this is a big improvement in performance. For shorter keys +there is a modest improvement. + +=head1 Performance Enhancements + +=over 4 + +=item * New Faster Hash Function on 64 bit builds + +We use a different hash function for short and long keys. This should +improve performance and security, especially for long keys. + +=item * readline is faster + +Reading from a file line-by-line with C or C<< EE >> should +now typically be faster due to a better implementation of the code that +searches for the next newline character. + +=back + +=head1 Modules and Pragmata + +=head2 Updated Modules and Pragmata + +=over 4 + +=item * + +L has been upgraded from version 2.18 to 2.24. + +=item * + +L has been upgraded from version 1.23 to 1.24. + +=item * + +L has been upgraded from version 0.43_01 to 0.47. + +=item * + +L has been upgraded from version 2.165 to 2.166. + +=item * + +L has been upgraded from version 2.86 to 2.88. + +=item * + +L has been upgraded from version 2.18 to 2.19. + +=item * + +L has been upgraded from version 1.37 to 1.38. + +=item * + +L has been upgraded from version 3.40 to 3.42. + +=item * + +L has been upgraded from version 1.999727 to 1.999806. + +=item * + +L has been upgraded from version 0.42 to 0.5005. + +=item * + +L has been upgraded from version 0.260804 to 0.2611. + +=item * + +L has been upgraded from version 5.20161120 to 5.20161220. + +=item * + +L has been upgraded from version 0.24 to 0.25. + +=item * + +L has been upgraded from version 3.32 to 3.35. + +=item * + +L has been upgraded from version 1.75 to 1.76. + +=item * + +L has been upgraded from version 1.302062 to 1.302073. + +=item * + +L has been upgraded from version 1.9740_03 to 1.9741. + +=item * + +L has been upgraded from version 1.24 to 1.25. + +=item * + +L has been upgraded from version 1.18 to 1.19. + +=back + +=head1 Configuration and Compilation + +=over 4 + +=item * + +Zero out the alignment bytes when calculating the bytes for 80-bit C +and C to make builds more reproducible. [perl #130133] + +=item * + +Since 5.18 for testing purposes we have included support for +building perl with a variety of non-standard, and non-recommended +hash functions. Since we do not recommend the use of these functions +we have removed them and their corresponding build options. Specifically +this includes the following build options: + + PERL_HASH_FUNC_SDBM + PERL_HASH_FUNC_DJB2 + PERL_HASH_FUNC_SUPERFAST + PERL_HASH_FUNC_MURMUR3 + PERL_HASH_FUNC_ONE_AT_A_TIME + PERL_HASH_FUNC_ONE_AT_A_TIME_OLD + PERL_HASH_FUNC_MURMUR_HASH_64A + PERL_HASH_FUNC_MURMUR_HASH_64B + +=back + +=head1 Acknowledgements + +Perl 5.25.8 represents approximately 4 weeks of development since Perl 5.25.7 +and contains approximately 21,000 lines of changes across 500 files from 19 +authors. + +Excluding auto-generated files, documentation and release tools, there were +approximately 18,000 lines of changes to 340 .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.8: + +Andy Lester, Aristotle Pagaltzis, Chad Granum, Chris 'BinGOs' Williams, +Christian Hansen, Craig A. Berry, David Mitchell, Hugo van der Sanden, James E +Keenan, J. Nick Koston, Karl Williamson, Matthew Horsfall, Niko Tyni, Petr +Písař, Sawyer X, Steve Hay, Sullivan Beck, 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 +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 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 . There may also be information at +L , the Perl Home Page. + +If you believe you have an unreported bug, please run the L 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, +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 +for details of how to report the issue. + +=head1 SEE ALSO + +The F file for an explanation of how to view exhaustive details on +what changed. + +The F file for how to build Perl. + +The F file for general stuff. + +The F and F files for copyright information. + +=cut diff --git a/pod/perlcheat.pod b/pod/perlcheat.pod index 6e4e919..99a8dfc 100644 --- a/pod/perlcheat.pod +++ b/pod/perlcheat.pod @@ -41,7 +41,7 @@ already be overwhelming. && /i case insensitive ^ string begin || // /m line based ^$ $ str end (bfr \n) .. ... /s . includes \n + one or more - ?: /x ignore wh.space * zero or more + ?: /x /xx ign. wh.space * zero or more = += last goto /p preserve ? zero or one , => /a ASCII /aa safe {3,7} repeat in range list ops /l locale /d dual | alternation diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 495be84..cab65be 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2,42 +2,54 @@ =head1 NAME -perldelta - what is new for perl v5.25.8 +perldelta - what is new for perl v5.25.9 =head1 DESCRIPTION -This document describes differences between the 5.25.7 release and the 5.25.8 +This document describes differences between the 5.25.8 release and the 5.25.9 release. -If you are upgrading from an earlier release such as 5.25.6, first read -L, which describes differences between 5.25.6 and 5.25.7. +If you are upgrading from an earlier release such as 5.25.7, first read +L, which describes differences between 5.25.7 and 5.25.8. =head1 Core Enhancements -=head2 New Hash Function For 64-bit Builds +=head2 New regular expression modifier C -We have switched to a hybrid hash function to better balance -performance for short and long keys. +Specifying two C characters to modify a regular expression pattern +does everything that a single one does, but additionally TAB and SPACE +characters within a bracketed character class are generally ignored and +can be added to improve readability, like +S>. Details are at +Lx and Exx>. -For short keys, 16 bytes and under, we use an optimised variant of -One At A Time Hard, and for longer keys we use Siphash 1-3. For very -long keys this is a big improvement in performance. For shorter keys -there is a modest improvement. +=head1 Deprecations + +=head2 String delimiters that aren't stand-alone graphemes are now deprecated + +In order for Perl to eventually allow string delimiters to be Unicode +grapheme clusters (which look like a single character, but may be +a sequence of several ones), we have to stop allowing a single char +delimiter that isn't a grapheme by itself. These are unlikely to exist +in actual code, as they would typically display as attached to the +character in front of them. =head1 Performance Enhancements =over 4 -=item * New Faster Hash Function on 64 bit builds +=item * -We use a different hash function for short and long keys. This should -improve performance and security, especially for long keys. +A hash in boolean context is now sometimes faster, e.g. -=item * readline is faster + if (!%h) { ... } -Reading from a file line-by-line with C or C<< EE >> should -now typically be faster due to a better implementation of the code that -searches for the next newline character. +This was already special-cased, but some cases were missed, and even the +ones which weren't have been improved. + +=item * + +Several other ops may now also be faster in boolean context. =back @@ -49,127 +61,580 @@ searches for the next newline character. =item * -L has been upgraded from version 2.18 to 2.24. +L has been upgraded from version 0.28 to 0.29. + +The deprecation message for the C<:unique> and C<:locked> attributes +now mention they will disappear in Perl 5.28. + +=item * + +L has been upgraded from version 1.39 to 1.40. + +=item * + +L has been upgraded from version 1.05 to 1.06. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=item * + +L has been upgraded from version 2.069 to 2.070. + +=item * + +L has been upgraded from version 2.069 to 2.070. + +=item * + +L has been upgraded from version 2.14_01 to 2.16. + +=item * + +L was upgraded from version 2.166 to 2.167. + +This fixes a stack management bug. [perl #130487]. + +=item * + +L has been upgraded from version 1.838 to 1.840. + +=item * + +L has been upgraded from version 1.05 to 1.06. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=item * + +L has been upgraded from version 1.35 to 1.36. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=item * + +L has been upgraded from version 1.40 to 1.41. + +=item * + +L has been upgraded from version 1.27 to 1.28. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=item * + +L has been upgraded from version 1.33 to 1.34. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=item * + +L has been upgraded from version 1.45 to 1.46. + +Fixes the Unicode Bug in the range operator. + +=item * + +L has been upgraded from version 1.27 to 1.28. + +Issue a deprecation message for C. + +=item * + +L has been upgraded from version 0.41 to 0.42. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=item * + +L has been upgraded from version 0.63 to 0.64. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=item * + +L has been upgraded from version 5.20161220 to 5.20170120. + +=item * + +L has been upgraded from version 1.11 to 1.12. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=item * + +L has been upgraded from version 1.27 to 1.28. + +=item * + +L has been upgraded from version 1.50 to 1.51. + +Ignore F on non-Unix systems. [perl #113960] + +=item * + +L has been upgraded from version 0.25 to 0.26. + +=item * + +L has been upgraded from version 1.2201 to 1.2202. + +=item * + +L has been upgraded from version 0.33 to 0.34 + +This adds support for the new Lxx>|perlre/Ex and Exx> +regular expression pattern modifier, and a change to the L>|re/'strict' mode> experimental feature. When S> is enabled, a warning now will be generated for all +unescaped uses of the two characters C<}> and C<]> in regular +expression patterns (outside bracketed character classes) that are taken +literally. This brings them more in line with the C<)> character which +is always a metacharacter unless escaped. Being a metacharacter only +sometimes, depending on action at a distance, can lead to silently +having the pattern mean something quite different than was intended, +which the S> mode is intended to minimize. + +=item * + +L has been upgraded from version 2.59 to 2.61. + +Fixes [perl #130098]. + +=item * + +L has been upgraded from version 1.07 to 1.08. + +=item * + +L has been upgraded from version 1.15 to 1.16. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=item * + +L has been upgraded from version 1.29 to 1.30. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=item * + +L has been upgraded from version 2.10 to 2.12. + +Fixes [perl #130469]. + +=item * + +L has been upgraded from version 1.52 to 1.54. + +This fixes [cpan #119529], [perl #130457] + +=item * + +L has been upgraded from version 0.67 to 0.68. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=item * + +L has been upgraded from version 1.07 to 1.08. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=item * + +L has been upgraded from version 0.24 to 0.26. + +It now uses 3-arg C instead of 2-arg C. [perl #130122] + +=back + +=head1 Documentation + +=head2 New Documentation + +=head3 L + +This file documents all upcoming deprecations, and some of the deprecations +which already have been removed. The purpose of this documentation is +two-fold: document what will disappear, and by which version, and serve +as a guide for people dealing with code which has features that no longer +work after an upgrade of their perl. + +=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. + +=head2 New Diagnostics + +=head3 New Warnings + +=over 4 + +=item * + +L + +See L + +=back + +=head2 Changes to Existing Diagnostics + +As of Perl 5.25.9, all new deprecations will come with a version in +which the feature will disappear. And with a few exceptions, most +existing deprecations will state when they'll disappear. As such, most +deprecation messages have changed. + +=over 4 + +=item * + +Attribute "locked" is deprecated, and will disappear in Perl 5.28 + +=item * + +Attribute "unique" is deprecated, and will disappear in Perl 5.28 + +=item * + +"\c%c" is more clearly written simply as "%s". This will be a fatal error +in Perl 5.28 =item * -L has been upgraded from version 1.23 to 1.24. +Constants from lexical variables potentially modified elsewhere are +deprecated. This will not be allowed in Perl 5.32 =item * -L has been upgraded from version 0.43_01 to 0.47. +Deprecated use of my() in false conditional. This will be a fatal error +in Perl 5.30 =item * -L has been upgraded from version 2.165 to 2.166. +dump() better written as CORE::dump(). dump() will no longer be available +in Perl 5.30 =item * -L has been upgraded from version 2.86 to 2.88. +${^ENCODING} is no longer supported. Its use will be fatal in Perl 5.28 =item * -L has been upgraded from version 2.18 to 2.19. +File::Glob::glob() will disappear in perl 5.30. Use File::Glob::bsd_glob() +instead. =item * -L has been upgraded from version 1.37 to 1.38. +%s() is deprecated on :utf8 handles. This will be a fatal error in Perl 5.30 =item * -L has been upgraded from version 3.40 to 3.42. +$* is no longer supported. Its use will be fatal in Perl 5.30 =item * -L has been upgraded from version 1.999727 to 1.999806. +$* is no longer supported. Its use will be fatal in Perl 5.30 =item * -L has been upgraded from version 0.42 to 0.5005. +Opening dirhandle %s also as a file. This will be a fatal error in Perl 5.28 =item * -L has been upgraded from version 0.260804 to 0.2611. +Opening filehandle %s also as a directory. This will be a fatal +error in Perl 5.28 =item * -L has been upgraded from version 5.20161120 to 5.20161220. +Setting $/ to a reference to %s as a form of slurp is deprecated, +treating as undef. This will be fatal in Perl 5.28 =item * -L has been upgraded from version 0.24 to 0.25. +Unescaped left brace in regex is deprecated here (and will be fatal +in Perl 5.30), passed through in regex; marked by S<< E-- HERE >> in m/%s/ =item * -L has been upgraded from version 3.32 to 3.35. +Unknown charname '' is deprecated. Its use will be fatal in Perl 5.28 =item * -L has been upgraded from version 1.75 to 1.76. +Use of bare EE to mean EE"" is deprecated. Its use will be fatal in Perl 5.28 =item * -L has been upgraded from version 1.302062 to 1.302073. +Use of code point 0x%s is deprecated; the permissible max is 0x%s. +This will be fatal in Perl 5.28 =item * -L has been upgraded from version 1.9740_03 to 1.9741. +Use of comma-less variable list is deprecated. Its use will be fatal +in Perl 5.28 =item * -L has been upgraded from version 1.24 to 1.25. +Use of inherited AUTOLOAD for non-method %s() is deprecated. This +will be fatal in Perl 5.28 + +=item * + +Use of strings with code points over 0xFF as arguments to %s operator +is deprecated. This will be a fatal error in Perl 5.28 + +=back + +=head1 Utility Changes + +=head2 F and F + +=over 4 + +=item * + +These old utilities have long since superceded by L, and are +now gone from the distribution. + +=back + +=head2 F + +=over 4 =item * -L has been upgraded from version 1.18 to 1.19. +Many improvements =back + =head1 Configuration and Compilation =over 4 =item * -Zero out the alignment bytes when calculating the bytes for 80-bit C -and C to make builds more reproducible. [perl #130133] +The C build process has further changes: + +=over + +=item * + +If the C<-xnolibs> is available, use that so a F perl can be +built within a FreeBSD jail. + +=item * + +On systems that build a dtrace object file (FreeBSD, Solaris and +SystemTap's dtrace emulation), copy the input objects to a separate +directory and process them there, and use those objects in the link, +since C also modifies these objects. + +=item * + +Add libelf to the build on FreeBSD 10.x, since dtrace adds references +to libelf symbols. + +=item * + +Generate a dummy dtrace_main.o if C fails to build it. A +default build on Solaris generates probes from the unused inline +functions, while they don't on FreeBSD, which causes C to +fail. + +=back + +[perl #130108] + +=item * + +You can now disable perl's use of the PERL_HASH_SEED and +PERL_PERTURB_KEYS environment variables by configuring perl with +C<-Accflags=NO_PERL_HASH_ENV>. + +=item * + +You can now disable perl's use of the PERL_HASH_SEED_DEBUG environment +variable by configuring perl with +C<-Accflags=-DNO_PERL_HASH_SEED_DEBUG>. + +=back + +=head1 Internal Changes + +=over 4 + +=item * + +New versions of macros like C and C have +been added, each with the +suffix C<_safe>, like C. These take an extra +parameter, giving an upper limit of how far into the string it is safe +to read. Using the old versions could cause attempts to read beyond the +end of the input buffer if the UTF-8 is not well-formed, and their use +now raises a deprecation warning. Details are at +L. + +=item * + +Calling macros like C on malformed UTF-8 have issued a +deprecation warning since Perl v5.18. They now die. +Similarly, macros like C on malformed UTF-8 now die. + +=item * + +Calling the functions C and its derivatives, while +passing a string length of 0 is now asserted against in DEBUGGING +builds, and otherwise returns the Unicode REPLACEMENT CHARACTER. If +you have nothing to decode, you shouldn't call the decode function. + +=item * + +The functions C and its derivatives now return the +Unicode REPLACEMENT CHARACTER if called with UTF-8 that has the overlong +malformation, and that malformation is allowed by the input parameters. +This malformation is where the UTF-8 looks valid syntactically, but +there is a shorter sequence that yields the same code point. This has +been forbidden since Unicode version 3.1. + +=item * + +The functions C and its derivatives now accept an input +flag to allow the overflow malformation. This malformation is when the +UTF-8 may be syntactically valid, but the code point it represents is +not capable of being represented in the word length on the platform. +What "allowed" means in this case is that the function doesn't return an +error, and advances the parse pointer to beyond the UTF-8 in question, +but it returns the Unicode REPLACEMENT CHARACTER as the value of the +code point (since the real value is not representable). + +=back + +=head1 Selected Bug Fixes + +=over 4 + +=item * + +Under C, the entire Perl program is now checked that the UTF-8 +is wellformed. This resolves [perl #126310]. + +=item * + +The range operator C<..> on strings now handles its arguments correctly when in +the scope of the L<< C|feature/"The 'unicode_strings' feature" >> +feature. The previous behaviour was sufficiently unexpected that we believe no +correct program could have made use of it. + +=item * + +The S operator did not ensure enough space was allocated for +its return value in scalar context. It could then write a single +pointer immediately beyond the end of the memory block allocated for +the stack. [perl #130262] + +=item * + +Using a large code point with the C pack template character with +the current output position aligned at just the right point could +cause a write a single zero byte immediately beyond the end of an +allocated buffer. [perl #129149] + +=item * + +Supplying the form picture argument as part of the form argument list +where the picture specifies modifying the argument could cause an +access to the new freed compiled form. [perl #129125] + +=item * + +Fix a problem with sort's build-in compare, where it would not sort +correctly with 64-bit integers, and non-long doubles. [perl #130335] + +=item * + +Fix issues with /(?{ ... EEEOF })/ that broke Method-Signatures. [perl #130398] + +=item * + +Fix a macro which caused syntax error on an EBCDIC build. + +=item * + +Prevent tests from getting hung up on 'NonStop' option. [perl #130445] + +=item * + +Fixed an assertion failure with C and C, which +could be triggered by C. [perl #130198]. + +=item * + +Fixed a comment skipping error under C; it could stop skipping a +byte early, which could be in the middle of a UTF-8 character. +[perl #130495]. + +=item * + +F now ignores F on non-Unix systems. [perl #113960]; + +=item * + +Fix assertion failure for C<{}-E$x> when C<$x> isn't defined. [perl #130496]. + +=item * + +DragonFly BSD now has support for setproctitle(). [perl #130068]. =item * -Since 5.18 for testing purposes we have included support for -building perl with a variety of non-standard, and non-recommended -hash functions. Since we do not recommend the use of these functions -we have removed them and their corresponding build options. Specifically -this includes the following build options: +Fix an assertion error which could be triggered when lookahead string +in patterns exceeded a minimum length. [perl #130522]. - PERL_HASH_FUNC_SDBM - PERL_HASH_FUNC_DJB2 - PERL_HASH_FUNC_SUPERFAST - PERL_HASH_FUNC_MURMUR3 - PERL_HASH_FUNC_ONE_AT_A_TIME - PERL_HASH_FUNC_ONE_AT_A_TIME_OLD - PERL_HASH_FUNC_MURMUR_HASH_64A - PERL_HASH_FUNC_MURMUR_HASH_64B +=item * + +Only warn once per literal about a misplaced C<_>. [perl #70878]. + +=item * + +Ensure range-start is set after error in C. [perl #129342]. + +=item * + +Don't read past start of string for unmatched backref; otherwise, +we may have heap buffer overflow. [perl #129377]. + +=item * + +Properly recognize mathematical digit ranges starting at U+1D7E. +C is supposed to warn if you use a range whose start +and end digit aren't from the same group of 10. It didn't do that +for five groups of mathematical digits starting at U+1D7E. =back + =head1 Acknowledgements -Perl 5.25.8 represents approximately 4 weeks of development since Perl 5.25.7 -and contains approximately 21,000 lines of changes across 500 files from 19 +Perl 5.25.9 represents approximately 4 weeks of development since Perl 5.25.8 +and contains approximately 24,000 lines of changes across 400 files from 23 authors. Excluding auto-generated files, documentation and release tools, there were -approximately 18,000 lines of changes to 340 .pm, .t, .c and .h files. +approximately 17,000 lines of changes to 220 .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.8: +improvements that became Perl 5.25.9: -Andy Lester, Aristotle Pagaltzis, Chad Granum, Chris 'BinGOs' Williams, -Christian Hansen, Craig A. Berry, David Mitchell, Hugo van der Sanden, James E -Keenan, J. Nick Koston, Karl Williamson, Matthew Horsfall, Niko Tyni, Petr -Písař, Sawyer X, Steve Hay, Sullivan Beck, Tony Cook, Yves Orton. +Aaron Crane, Abigail, Andreas König, Andy Lester, Aristotle Pagaltzis +Chris 'BinGOs' Williams, Craig A. Berry, Dagfinn Ilmari Mannsåker, Dan Collins, +David Mitchell, Father Chrysostomos, Hugo van der Sanden, James E Keenan, +Jerry D. Hedden, John Lightsey, Karl Williamson, Paul Marquess, Peter Avalos, +Sawyer X, Steve Hay, Tomasz Konojacki, Tony Cook, Zefram. 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 diff --git a/pod/perldeprecation.pod b/pod/perldeprecation.pod new file mode 100644 index 0000000..0a13504 --- /dev/null +++ b/pod/perldeprecation.pod @@ -0,0 +1,455 @@ +=head1 NAME + +perldeprecation - list Perl deprecations + +=head1 DESCRIPTION + +The purpose of this document is to document what has been deprecated +in Perl, and by which version the deprecated feature will disappear, +or, for already removed features, when it was removed. + +This document will try to discuss what alternatives for the deprecated +features are available. + +The deprecated features will be grouped by the version of Perl in +which they will be removed. + +=head2 Perl 5.32 + +=head3 Constants from lexical variables potentially modified elsewhere + +You wrote something like + + my $var; + $sub = sub () { $var }; + +but $var is referenced elsewhere and could be modified after the C +expression is evaluated. Either it is explicitly modified elsewhere +(C<$var = 3>) or it is passed to a subroutine or to an operator like +C or C, which may or may not modify the variable. + +Traditionally, Perl has captured the value of the variable at that +point and turned the subroutine into a constant eligible for inlining. +In those cases where the variable can be modified elsewhere, this +breaks the behavior of closures, in which the subroutine captures +the variable itself, rather than its value, so future changes to the +variable are reflected in the subroutine's return value. + +If you intended for the subroutine to be eligible for inlining, then +make sure the variable is not referenced elsewhere, possibly by +copying it: + + my $var2 = $var; + $sub = sub () { $var2 }; + +If you do want this subroutine to be a closure that reflects future +changes to the variable that it closes over, add an explicit C: + + my $var; + $sub = sub () { return $var }; + +This usage has been deprecated, and will no longer be allowed in Perl 5.32. + +=head2 Perl 5.30 + +=head3 C<< $* >> is no longer supported + +Before Perl 5.10, setting C<< $* >> to a true value globally enabled +multi-line matching within a string. This relique from the past lost +its special meaning in 5.10. Use of this variable will be a fatal error +in Perl 5.30, freeing the variable up for a future special meaning. + +To enable multiline matching one should use the C<< /m >> regexp +modifier (possibly in combination with C<< /s >>). This can be set +on a per match bases, or can be enabled per lexical scope (including +a whole file) with C<< use re '/m' >>. + +=head3 C<< $# >> is no longer supported + +This variable used to have a special meaning -- it could be used +to control how numbers were formatted when printed. This seldom +used functionality was removed in Perl 5.10. In order to free up +the variable for a future special meaning, its use will be a fatal +error in Perl 5.30. + +To specify how numbers are formatted when printed, one is adviced +to use C<< printf >> or C<< sprintf >> instead. + +=head3 C<< File::Glob::glob() >> will disappear + +C<< File::Glob >> has a function called C<< glob >>, which just calls +C<< bsd_glob >>. However, its prototype is different from the prototype +of C<< CORE::glob >>, and hence, C<< File::Glob::glob >> should not +be used. + +C<< File::Glob::glob() >> was deprecated in Perl 5.8. A deprecation +message was issued from Perl 5.26 onwards, and the function will +disappear in Perl 5.30. + +Code using C<< File::Glob::glob() >> should call +C<< File::Glob::bsd_glob() >> instead. + + +=head3 Unescaped left braces in regular expressions + +The simple rule to remember, if you want to match a literal C<{> +character (U+007B C) in a regular expression +pattern, is to escape each literal instance of it in some way. +Generally easiest is to precede it with a backslash, like C<\{> +or enclose it in square brackets (C<[{]>). If the pattern +delimiters are also braces, any matching right brace (C<}>) should +also be escaped to avoid confusing the parser, for example, + + qr{abc\{def\}ghi} + +Forcing literal C<{> characters to be escaped will enable the Perl +language to be extended in various ways in future releases. To avoid +needlessly breaking existing code, the restriction is is not enforced in +contexts where there are unlikely to ever be extensions that could +conflict with the use there of C<{> as a literal. + +Literal uses of C<{> were deprecated in Perl 5.20, and some uses of it +started to give deprecation warnings since. These cases were made fatal +in Perl 5.26. Due to an oversight, not all cases of a use of a literal +C<{> got a deprecation warning. These cases started warning in Perl 5.26, +and they will be fatal by Perl 5.30. + +=head3 Unqualified C + +Use of C instead of C was deprecated in Perl 5.8, +and an unqualified C will no longer be available in Perl 5.30. + +See L. + + +=head3 Using my() in false conditional. + +There has been a long-standing bug in Perl that causes a lexical variable +not to be cleared at scope exit when its declaration includes a false +conditional. Some people have exploited this bug to achieve a kind of +static variable. Since we intend to fix this bug, we don't want people +relying on this behavior. + +Instead, it's recommended one uses C variables to achieve the +same effect: + + use 5.10.0; + sub count {state $counter; return ++ $counter} + say count (); # Prints 1 + say count (); # Prints 2 + +C variables were introduced in Perl 5.10. + +Alternatively, you can achieve a similar static effect by +declaring the variable in a separate block outside the function, eg + + sub f { my $x if 0; return $x++ } + +becomes + + { my $x; sub f { return $x++ } } + +The use of C in a false conditional has been deprecated in +Perl 5.10, and it will become a fatal error in Perl 5.30. + + +=head3 Reading/writing bytes from/to :utf8 handles. + +The sysread(), recv(), syswrite() and send() operators are +deprecated on handles that have the C<:utf8> layer, either explicitly, or +implicitly, eg., with the C<:encoding(UTF-16LE)> layer. + +Both sysread() and recv() currently use only the C<:utf8> flag for the stream, +ignoring the actual layers. Since sysread() and recv() do no UTF-8 +validation they can end up creating invalidly encoded scalars. + +Similarly, syswrite() and send() use only the C<:utf8> flag, otherwise ignoring +any layers. If the flag is set, both write the value UTF-8 encoded, even if +the layer is some different encoding, such as the example above. + +Ideally, all of these operators would completely ignore the C<:utf8> state, +working only with bytes, but this would result in silently breaking existing +code. To avoid this a future version of perl will throw an exception when +any of sysread(), recv(), syswrite() or send() are called on handle with the +C<:utf8> layer. + +In Perl 5.30, it will no longer be possible to use sysread(), recv(), +syswrite() or send() to read or send bytes from/to :utf8 handles. + + +=head3 Use of unassigned code point or non-standalone grapheme for a delimiter. + +A grapheme is what appears to a native-speaker of a language to be a +character. In Unicode (and hence Perl) a grapheme may actually be +several adjacent characters that together form a complete grapheme. For +example, there can be a base character, like "R" and an accent, like a +circumflex "^", that appear when displayed to be a single character with +the circumflex hovering over the "R". Perl currently allows things like +that circumflex to be delimiters of strings, patterns, I. When +displayed, the circumflex would look like it belongs to the character +just to the left of it. In order to move the language to be able to +accept graphemes as delimiters, we have to deprecate the use of +delimiters which aren't graphemes by themselves. Also, a delimiter must +already be assigned (or known to be never going to be assigned) to try +to future-proof code, for otherwise code that works today would fail to +compile if the currently unassigned delimiter ends up being something +that isn't a stand-alone grapheme. Because Unicode is never going to +assign +L, nor +L, those can be delimiters, and +their use won't raise this warning. + +In Perl 5.30, delimiters which are unassigned code points, or which +are non-standalone graphemes will be fatal. + + +=head2 Perl 5.28 + +=head3 Attribute "%s" is deprecated, and will disappear in 5.28 + +The attributes C<< :locked >> (on code references) and C<< :unique >> +(on array, hash and scalar references) have had no effect since +Perl 5.005 and Perl 5.8.8 respectively. Their use has been deprecated +since. + +These attributes will no longer be recognized in Perl 5.28, and will +then result in a syntax error. Since the attributes do not do anything, +removing them from your code fixes the deprecation warning; and removing +them will not influence the behaviour of your code. + + +=head3 Bare here-document terminators + +Perl has allowed you to use a bare here-document terminator to have the +here-document end at the first empty line. This practise was deprecated +in Perl 5.000, and this will be a fatal error in Perl 5.28. + +You are encouraged to use the explictly quoted form if you wish to +use an empty line as the terminator of the here-document: + + print <<""; + Print this line. + + # Previous blank line ends the here-document. + + +=head3 Setting $/ to a reference to a non-positive integer + +You assigned a reference to a scalar to C<$/> where the +referenced item is not a positive integer. In older perls this B +to work the same as setting it to C but was in fact internally +different, less efficient and with very bad luck could have resulted in +your file being split by a stringified form of the reference. + +In Perl 5.20.0 this was changed so that it would be B the same as +setting C<$/> to undef, with the exception that this warning would be +thrown. + +In Perl 5.28, this will throw a fatal error. + +You are recommended to change your code to set C<$/> to C explicitly +if you wish to slurp the file. + + +=head3 Limit on the value of Unicode code points. + +Unicode only allows code points up to 0x10FFFF, but Perl allows much +larger ones. However, using code points exceeding the maximum value +of an integer (C) may break the perl interpreter in some constructs, +including causing it to hang in a few cases. The known problem areas +are in C, regular expression pattern matching using quantifiers, +as quote delimiters in C...I> (where I is the C of a large +code point), and as the upper limits in loops. + +The use of out of range code points was deprecated in Perl 5.24, and +it will be a fatal error in Perl 5.28. + +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 +than 32-bit ones. + + +=head3 Use of comma-less variable list in formats. + +It's allowed to use a list of variables in a format, without +separating them with commas. This usage has been deprecated +for a long time, and it will be a fatal error in Perl 5.28. + + + +=head3 Use of C<\N{}> + +Use of C<\N{}> with nothing between the braces was deprecated in +Perl 5.24, and will throw a fatal error in Perl 5.28. + +Since such a construct is equivalent to using an empty string, +you are recommended to remove such C<\N{}> constructs. + + +=head3 Using the same symbol to open a filehandle and a dirhandle + +It used to be legal to use C to associate both a +filehandle and a dirhandle to the same symbol (glob or scalar). +This idiom is likely to be confusing, and it was deprecated in +Perl 5.10. + +Using the same symbol to C a filehandle and a dirhandle +will be a fatal error in Perl 5.28. + +You should be using two different symbols instead. + +=head3 ${^ENCODING} is no longer supported. + +The special variable C<${^ENCODING}> was used to implement +the C pragma. Setting this variable to anything other +than C was deprecated in Perl 5.22. Full deprecation +of the variable happened in Perl 5.25.3. + +Setting this variable will become a fatal error in Perl 5.28. + + +=head3 C<< B::OP::terse >> + +This method, which just calls C<< B::Concise::b_terse >>, has been +deprecated, and will disappear in Perl 5.28. Please use +C<< B::Concise >> instead. + + + +=head3 Use of inherited AUTOLOAD for non-method %s() is deprecated + +As an (ahem) accidental feature, C subroutines are looked +up as methods (using the C<@ISA> hierarchy) even when the subroutines +to be autoloaded were called as plain functions (e.g. C), +not as methods (e.g. C<< Foo->bar() >> or C<< $obj->bar() >>). + +This bug will be rectified in future by using method lookup only for +methods' Cs. + +The simple rule is: Inheritance will not work when autoloading +non-methods. The simple fix for old code is: In any module that used +to depend on inheriting C for non-methods from a base class +named C, execute C<*AUTOLOAD = \&BaseClass::AUTOLOAD> during +startup. + +In code that currently says C +you should remove AutoLoader from @ISA and change C to +C. + +This feature was deprecated in Perl 5.004, and will be fatal in Perl 5.28. + + +=head3 Use of C<< \cI >> to specify a printable character. + +In a double quoted context, Perl has the C<< \c >> construct to write +control characters in a readable way. For instance, the tab character +can be written as C<< \cI >> (I<< control-I >>), and the escape +character can be written as C<< \c[ >>. + +Due to implementation details, the C<< \c >> construct can be used +to create regular, printable, characters as well. For instance, +C<< \c >> maps a C<< , >> to C<< l >>; that is C<< \c, >> is an +obscure way of writing C<< l >>. And not only that, it's also not +portable between ASCII and EBCDIC platforms. + +Using the C<< \c >> construct with an argument which maps to a +printable character was deprecated in Perl 5.14, and will be a fatal +error in Perl 5.28. You're recommended to just write the intended +character instead. + + +=head3 Use of code points over 0xFF in string bitwise operators + +The string bitwise operators, C<&>, C<|>, C<^>, and C<~>, treat +their operands as strings of bytes. As such, values above 0xFF +are nonsensical. Using such code points with these operators +was deprecated in Perl 5.24, and will be fatal in Perl 5.28. + + +=head2 Perl 5.26 + +=head3 C<< --libpods >> in C<< Pod::Html >> + +Since Perl 5.18, the option C<< --libpods >> has been deprecated, and +using this option did not do anything other than producing a warning. + +The C<< --libpods >> option is no longer recognized in Perl 5.26. + + +=head3 The utilities C<< c2ph >> and C<< pstruct >> + +These old, perl3-era utilities have been deprecated in favour of +C<< h2xs >> for a long time. In Perl 5.26, they have been removed. + + +=head3 Trapping C<< $SIG {__DIE__} >> other than during program exit. + +The C<$SIG{__DIE__}> hook is called even inside an C. It was +never intended to happen this way, but an implementation glitch made +this possible. This used to be deprecated, as it allowed strange action +at a distance like rewriting a pending exception in C<$@>. Plans to +rectify this have been scrapped, as users found that rewriting a +pending exception is actually a useful feature, and not a bug. + +Perl never issued a deprecation warning for this; the deprecation +was by documentation policy only. But this deprecation has been +lifted in Perl 5.26. + + +=head3 Malformed UTF-8 string in "%s" + +This message indicates a bug either in the Perl core or in XS +code. Such code was trying to find out if a character, allegedly +stored internally encoded as UTF-8, was of a given type, such as +being punctuation or a digit. But the character was not encoded +in legal UTF-8. The C<%s> is replaced by a string that can be used +by knowledgeable people to determine what the type being checked +against was. + +Passing malformed strings was deprecated in Perl 5.18, and +became fatal in Perl 5.26. + + +=head2 Perl 5.24 + +=head3 Use of C<< *glob{FILEHANDLE} >> + +The use of C<< *glob{FILEHANDLE} >> was deprecated in Perl 5.8. +The intention was to use C<< *glob{IO} >> instead, for which +C<< *glob{FILEHANDLE} >> is an alias. + +However, this feature was undeprecated in Perl 5.24. + +=head3 Calling POSIX::%s() is deprecated + +The following functions in the C module are no longer available: +C, C, C, C, C, C, +C, C, C, C, and C. The +functions are buggy and don't work on UTF-8 encoded strings. See their +entries in L for more information. + +The functions were deprecated in Perl 5.20, and removed in Perl 5.24. + + +=head2 Perl 5.16 + +=head3 Use of %s on a handle without * is deprecated + +It used to be possible to use C, C or C on a scalar +while the scalar holds a typeglob. This caused its filehandle to be +tied. It left no way to tie the scalar itself when it held a typeglob, +and no way to untie a scalar that had had a typeglob assigned to it. + +This was deprecated in Perl 5.14, and the bug was fixed in Perl 5.16. + +So now C will always tie the scalar, not the handle it holds. +To tie the handle, use C (with an explicit asterisk). The same +applies to C and C. + + +=head1 SEE ALSO + +L, L. + +=cut diff --git a/pod/perldiag.pod b/pod/perldiag.pod index c0a717c..afdcb73 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -418,12 +418,12 @@ assigning through that reference. For example used as an lvalue, which is pretty strange. Perhaps you forgot to dereference it first. See L. -=item Attribute "locked" is deprecated +=item Attribute "locked" is deprecated, and will disappear in Perl 5.28 (D deprecated) You have used the attributes pragma to modify the "locked" attribute on a code reference. The :locked attribute is obsolete, has had no effect since 5005 threads were removed, and -will be removed in a future release of Perl 5. +will be removed in a Perl 5.28. =item Attribute prototype(%s) discards earlier prototype attribute in same sub @@ -431,12 +431,12 @@ will be removed in a future release of Perl 5. example. Since each sub can only have one prototype, the earlier declaration(s) are discarded while the last one is applied. -=item Attribute "unique" is deprecated +=item Attribute "unique" is deprecated, and will disappear in Perl 5.28 (D deprecated) You have used the attributes pragma to modify the "unique" attribute on an array, hash or scalar reference. The :unique attribute has had no effect since Perl 5.8.8, and -will be removed in a future release of Perl 5. +will be removed in a Perl 5.28. =item av_reify called on tied array @@ -666,11 +666,6 @@ checking. Alternatively, if you are certain that you're calling the function correctly, you may put an ampersand before the name to avoid the warning. See L. -=item Calling POSIX::%s() is deprecated - -(D deprecated) You called a function whose use is deprecated. See -the function's name in L for details. - =item Cannot chr %f (F) You passed an invalid number (like an infinity or not-a-number) to C. @@ -1544,7 +1539,7 @@ Perhaps you need to copy the value to a temporary, and repeat that. Note that ASCII characters that don't map to control characters are discouraged, and will generate the warning (when enabled) -L. +L. =item Character following \%c must be '{' or a single-character Unicode property name in regex; marked by <-- HERE in m/%s/ @@ -1651,13 +1646,15 @@ See L. (W unopened) You tried chdir() on a filehandle that was never opened. -=item "\c%c" is more clearly written simply as "%s" +=item "\c%c" is more clearly written simply as "%s". This will be a fatal error in Perl 5.28 -(W syntax) The C<\cI> construct is intended to be a way to specify -non-printable characters. You used it for a printable one, which -is better written as simply itself, perhaps preceded by a backslash -for non-word characters. Doing it the way you did is not portable -between ASCII and EBCDIC platforms. +(D deprecated, syntax) The C<\cI> construct is intended to be a +way to specify non-printable characters. You used it for a printable +one, which is better written as simply itself, perhaps preceded by +a backslash for non-word characters. Doing it the way you did is +not portable between ASCII and EBCDIC platforms. + +This usage is going to result in a fatal error in Perl 5.28. =item Cloning substitution context is unimplemented @@ -1797,7 +1794,7 @@ usually indicates a syntax error in dereferencing the constant value. See L and L. =item Constants from lexical variables potentially modified elsewhere are -deprecated +deprecated. This will not be allowed in Perl 5.32 (D deprecated) You wrote something like @@ -1816,8 +1813,8 @@ breaks the behavior of closures, in which the subroutine captures the variable itself, rather than its value, so future changes to the variable are reflected in the subroutine's return value. -This usage is deprecated, because the behavior is likely to change -in a future version of Perl. +This usage is deprecated, and will no longer be allowed in Perl 5.32, +making it possible to change the behavior in the future. If you intended for the subroutine to be eligible for inlining, then make sure the variable is not referenced elsewhere, possibly by @@ -1982,7 +1979,7 @@ or a hash or array slice, such as: long for Perl to handle. You have to be seriously twisted to write code that triggers this error. -=item Deprecated use of my() in false conditional +=item Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 (D deprecated) You used a declaration similar to C. There has been a long-standing bug in Perl that causes a lexical variable @@ -2003,6 +2000,9 @@ lexicals that are initialized only once (see L): sub f { state $x; return $x++ } +This use of C in a false conditional has been deprecated since +Perl 5.10, and it will become a fatal error in Perl 5.30. + =item DESTROY created new reference to dead object '%s' (F) A DESTROY() method created a new reference to the object which is @@ -2011,7 +2011,7 @@ than to create a dangling reference. =item Did not produce a valid header -See Server error. +See L. =item %s did not return a true value @@ -2044,7 +2044,7 @@ you called it with no args and C<$@> was empty. =item Document contains no data -See Server error. +See L. =item %s does not define %s::VERSION--version check failed @@ -2080,10 +2080,15 @@ something that isn't defined yet, you don't actually have to define the subroutine or package before the current location. You can use an empty "sub foo;" or "package FOO;" to enter a "forward" declaration. -=item dump() better written as CORE::dump() +=item dump() better written as CORE::dump(). dump() will no longer be available in Perl 5.30 -(W misc) You used the obsolescent C built-in function, without fully -qualifying it as C. Maybe it's a typo. See L. +(D deprecated, misc) You used the obsolescent C built-in function, +without fully qualifying it as C. Maybe it's a typo. + +Use of a unqualified C was deprecated in Perl 5.30, and this +will not be available in Perl 5.30. + +See L. =item dump is not supported @@ -2114,11 +2119,13 @@ unlikely to be what you want. described in L and L. You used C<\p> or C<\P> in a regular expression without specifying the property name. -=item ${^ENCODING} is no longer supported +=item ${^ENCODING} is no longer supported. Its use will be fatal in Perl 5.28 (D deprecated) The special variable C<${^ENCODING}>, formerly used to implement the C pragma, is no longer supported as of Perl 5.26.0. +Setting this variable will become a fatal error in Perl 5.28. + =item entering effective %s failed (F) While under the C pragma, switching the real and @@ -2325,6 +2332,20 @@ which can't encode values above 63. So there is no point in asking for a line length bigger than that. Perl will behave as if you specified C as the format. +=item File::Glob::glob() will disappear in perl 5.30. Use File::Glob::bsd_glob() instead. + +(D deprecated) C<< File::Glob >> has a function called C<< glob >>, which +just calls C<< bsd_glob >>. However, its prototype is different from the +prototype of C<< CORE::glob >>, and hence, C<< File::Glob::glob >> should +not be used. + +C<< File::Glob::glob() >> was deprecated in perl 5.8.0. A deprecation +message was issued from perl 5.26.0 onwards, and the function will +disappear in perl 5.30.0. + +Code using C<< File::Glob::glob() >> should call +C<< File::Glob::bsd_glob() >> instead. + =item Filehandle %s opened only for input (W io) You tried to write on a read-only filehandle. If you intended @@ -3091,7 +3112,7 @@ neither as a system call nor an ioctl call (SIOCATMARK). Perl. The current valid ones are given in L. -=item %s() is deprecated on :utf8 handles +=item %s() is deprecated on :utf8 handles. This will be a fatal error in Perl 5.30 (D deprecated) The sysread(), recv(), syswrite() and send() operators are deprecated on handles that have the C<:utf8> layer, either explicitly, or @@ -3107,19 +3128,20 @@ the layer is some different encoding, such as the example above. Ideally, all of these operators would completely ignore the C<:utf8> state, working only with bytes, but this would result in silently breaking existing -code. To avoid this a future version of perl will throw an exception when -any of sysread(), recv(), syswrite() or send() are called on handle with the -C<:utf8> layer. +code. -=item "%s" is more clearly written simply as "%s" in regex; marked by S<<-- HERE> in m/%s/ +In Perl 5.30, it will no longer be possible to use sysread(), recv(), +syswrite() or send() to read or send bytes from/to :utf8 handles. -(W regexp) (only under C> or within C<(?[...])>) +=item "%s" is more clearly written simply as "%s" in regex. This will be a fatal error in Perl 5.28; marked by S<<-- HERE> in m/%s/ + +(W deprecated, regexp) (only under C> or within C<(?[...])>) You specified a character that has the given plainer way of writing it, and which is also portable to platforms running with different character -sets. +sets. This usage is deprecated, and will be a fatal error in Perl 5.28. -=item $* is no longer supported +=item $* is no longer supported. Its use will be fatal in Perl 5.30 (D deprecated, syntax) The special variable C<$*>, deprecated in older perls, has been removed as of 5.10.0 and is no longer supported. In @@ -3131,12 +3153,16 @@ modifiers. You can enable C for a lexical scope (even a whole file) with C. (In older versions: when C<$*> was set to a true value then all regular expressions behaved as if they were written using C.) -=item $# is no longer supported +Use of this variable will be a fatal error in Perl 5.30. + +=item $# is no longer supported. Its use will be fatal in Perl 5.30 (D deprecated, syntax) The special variable C<$#>, deprecated in older perls, has been removed as of 5.10.0 and is no longer supported. You should use the printf/sprintf functions instead. +Use of this variable will be a fatal error in Perl 5.30. + =item '%s' is not a code reference (W overload) The second (fourth, sixth, ...) argument of @@ -3410,6 +3436,19 @@ rules and perl was unable to guess how to make more progress. (F) You tried to unpack something that didn't comply with UTF-8 encoding rules and perl was unable to guess how to make more progress. +=item Malformed UTF-8 string in "%s" + +(F) This message indicates a bug either in the Perl core or in XS +code. Such code was trying to find out if a character, allegedly +stored internally encoded as UTF-8, was of a given type, such as +being punctuation or a digit. But the character was not encoded +in legal UTF-8. The C<%s> is replaced by a string that can be used +by knowledgeable people to determine what the type being checked +against was. + +Passing malformed strings was deprecated in Perl 5.18, and +became fatal in Perl 5.26. + =item Malformed UTF-16 surrogate (F) Perl thought it was reading UTF-16 encoded character data but while @@ -3490,7 +3529,7 @@ doesn't resolve to a valid subroutine. See L. =item Method %s not permitted -See Server error. +See L. =item Might be a runaway multi-line %s string starting on line %d @@ -4230,14 +4269,6 @@ Cing a file, or when seeking past the end of a scalar opened for I/O (in anticipation of future reads and to imitate the behavior with real files). -=item Only one /x regex modifier is allowed - -=item Only one /x regex modifier is allowed in regex; marked by <-- HERE in m/%s/ - -(F) You used the C regular expression pattern modifier at least twice in a -string of modifiers. This has been made illegal, in order to allow future -extensions to the Perl language. - =item %s() on unopened %s (W unopened) An I/O operation was attempted on a filehandle that was @@ -4257,19 +4288,21 @@ that isn't open. Check your control flow. See also L. (S internal) An internal warning that the grammar is screwed up. -=item Opening dirhandle %s also as a file +=item Opening dirhandle %s also as a file. This will be a fatal error in Perl 5.28 (D io, deprecated) You used open() to associate a filehandle to a symbol (glob or scalar) that already holds a dirhandle. Although legal, this idiom might render your code confusing -and is deprecated. +and this was deprecated in Perl 5.10. In Perl 5.28, this +will be a fatal error. -=item Opening filehandle %s also as a directory +=item Opening filehandle %s also as a directory. This will be a fatal error in Perl 5.28 (D io, deprecated) You used opendir() to associate a dirhandle to a symbol (glob or scalar) that already holds a filehandle. Although legal, this idiom might render your code confusing -and is deprecated. +and this was deprecated in Perl 5.10. In Perl 5.28, this +will be a fatal error. =item Operand with no preceding operator in regex; marked by S<<-- HERE> in m/%s/ @@ -4671,17 +4704,6 @@ Remember that "my", "our", "local" and "state" bind tighter than comma. (F) Parsing code supplied by an extension violated the parser's API in a detectable way. -=item Passing malformed UTF-8 to "%s" is deprecated - -(D deprecated, utf8) This message indicates a bug either in the Perl -core or in XS code. Such code was trying to find out if a character, -allegedly stored internally encoded as UTF-8, was of a given type, such -as being punctuation or a digit. But the character was not encoded in -legal UTF-8. The C<%s> is replaced by a string that can be used by -knowledgeable people to determine what the type being checked against -was. If C warnings are enabled, a further message is raised, -giving details of the malformation. - =item Pattern subroutine nesting without pos change exceeded limit in regex (F) You used a pattern that uses too many nested subpattern calls without @@ -4985,7 +5007,7 @@ of "||". =item Premature end of script headers -See Server error. +See L. =item printf() on closed filehandle %s @@ -5481,7 +5503,7 @@ in the regular expression the problem was discovered. (F) An C<(?R)> or C<(?0)> sequence in a regular expression was missing the final parenthesis. -=item Server error (a.k.a. "500 Server error") +=item Z<>500 Server error (A) This is the error message generally seen in a browser window when trying to run a CGI program (including SSI) over the web. The @@ -5541,12 +5563,7 @@ didn't think so. forget to check the return value of your socket() call? See L. -=item Setting ${^ENCODING} is deprecated - -(D deprecated) You assigned a non-C value to C<${^ENCODING}>. -This is deprecated; see C> for details. - -=item Setting $/ to a reference to %s as a form of slurp is deprecated, treating as undef +=item Setting $/ to a reference to %s as a form of slurp is deprecated, treating as undef. This will be fatal in Perl 5.28 (D deprecated) You assigned a reference to a scalar to C<$/> where the referenced item is not a positive integer. In older perls this B @@ -5559,8 +5576,8 @@ 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 explicitly -if you wish to slurp the file. In future versions of Perl assigning -a reference to will throw a fatal error. +if you wish to slurp the file. In Perl 5.28 assigning C<$/> to a +reference to an integer which isn't positive will throw a fatal error. =item Setting $/ to %s reference is forbidden @@ -6234,30 +6251,30 @@ C. (A) You've accidentally run your script through B instead of Perl. Check the #! line, or manually feed your script into Perl yourself. -=item Unescaped left brace in regex is deprecated here, passed through in -regex; marked by S<<-- HERE> in m/%s/ +=item Unescaped left brace in regex is deprecated here (and will be fatal in Perl 5.30), passed through in regex; marked by S<<-- HERE> in m/%s/ (D deprecated, regexp) The simple rule to remember, if you want to -match a literal C<"{"> character (U+007B C) in a +match a literal C<{> character (U+007B C) in a regular expression pattern, is to escape each literal instance of it in some way. Generally easiest is to precede it with a backslash, like -C<"\{"> or enclose it in square brackets (C<"[{]">). If the pattern -delimiters are also braces, any matching right brace (C<"}">) should +C<\{> or enclose it in square brackets (C<[{]>). If the pattern +delimiters are also braces, any matching right brace (C<}>) should also be escaped to avoid confusing the parser, for example, qr{abc\{def\}ghi} -Forcing literal C<"{"> characters to be escaped will enable the Perl +Forcing literal C<{> characters to be escaped will enable the Perl language to be extended in various ways in future releases. To avoid needlessly breaking existing code, the restriction is is not enforced in contexts where there are unlikely to ever be extensions that could -conflict with the use there of C<"{"> as a literal. +conflict with the use there of C<{> as a literal. -In this release of Perl, some literal uses of C<"{"> are fatal, and some +In this release of Perl, some literal uses of C<{> are fatal, and some still just deprecated. This is because of an oversight: some uses of a -literal C<"{"> that should have raised a deprecation warning starting in +literal C<{> that should have raised a deprecation warning starting in v5.20 did not warn until v5.26. By making the already-warned uses fatal now, some of the planned extensions can be made to the language sooner. +The cases which are still allowed will be fatal in Perl 5.30. The contexts where no warnings or errors are raised are: @@ -6265,12 +6282,12 @@ The contexts where no warnings or errors are raised are: =item * -as the first character in a pattern, or following C<"^"> indicating to +as the first character in a pattern, or following C<^> indicating to anchor the match to the beginning of a line. =item * -as the first character following a C<"|"> indicating alternation. +as the first character following a C<|> indicating alternation. =item * @@ -6346,6 +6363,26 @@ as the first character following a quantifier =back +=item Unescaped literal '%c' in regex; marked by <-- HERE in m/%s/ + +(W regexp) (only under C>) + +Within the scope of C> in a regular expression +pattern, you included an unescaped C<}> or C<]> which was interpreted +literally. These two characters are sometimes metacharacters, and +sometimes literals, depending on what precedes them in the +pattern. This is unlike the similar C<)> which is always a +metacharacter unless escaped. + +This action at a distance, perhaps a large distance, can lead to Perl +silently misinterpreting what you meant, so when you specify that you +want extra checking by C>, this warning is generated. +If you meant the character as a literal, simply confirm that to Perl by +preceding the character with a backslash, or make it into a bracketed +character class (like C<[}]>). If you meant it as closing a +corresponding C<[> or C<{>, you'll need to look back through the pattern +to find out why that isn't happening. + =item unexec of %s into %s failed! (F) The unexec() routine failed for some reason. See your local FSF @@ -6446,11 +6483,11 @@ exactly, regardless of whether C<:loose> is used or not.) This error may also happen if the C<\N{}> is not in the scope of the corresponding C>. -=item Unknown charname '' is deprecated +=item Unknown charname '' is deprecated. Its use will be fatal in Perl 5.28 (D deprecated) You had a C<\N{}> with nothing between the braces. This -usage is deprecated, and will be made a syntax error in a future Perl -version. +usage was deprecated in Perl 5.24, and will be made a syntax error in +in Perl 5.28. =item Unknown error @@ -6892,12 +6929,15 @@ returns no useful value. See L. (D deprecated) The C<$[> variable (index of the first element in an array) is deprecated. See L. -=item Use of bare << to mean <<"" is deprecated +=item Use of bare << to mean <<"" is deprecated. Its use will be fatal in Perl 5.28 (D deprecated) You are now encouraged to use the explicitly quoted form if you wish to use an empty line as the terminator of the here-document. +Use of a bare terminator was deprecated in Perl 5.000, and +will be a fatal error in Perl 5.28. + =item Use of /c modifier is meaningless in s/// (W regexp) You used the /c modifier in a substitution. The /c @@ -6909,7 +6949,7 @@ modifier is not presently meaningful in substitutions. use the /g modifier. Currently, /c is meaningful only when /g is used. (This may change in the future.) -=item Use of code point 0x%s is deprecated; the permissible max is 0x%s +=item Use of code point 0x%s is deprecated; the permissible max is 0x%s. This will be fatal in Perl 5.28 (D deprecated) You used a code point that will not be allowed in a future perl version, because it is too large. Unicode only allows code @@ -6926,11 +6966,16 @@ 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 than 32-bit ones. -=item Use of comma-less variable list is deprecated +The use of out of range code points was deprecated in Perl 5.24, and +it will be a fatal error in Perl 5.28. + +=item Use of comma-less variable list is deprecated. Its use will be fatal in Perl 5.28 (D deprecated) The values you give to a format should be separated by commas, not just aligned on a line. +This usage will be fatal in Perl 5.28. + =item Use of each() on hash after insertion without resetting hash iterator results in undefined behavior (S internal) The behavior of C after insertion is undefined; @@ -6975,11 +7020,6 @@ For speed and efficiency reasons, Perl internally does not do full reference-counting of iterated items, hence deleting such an item in the middle of an iteration causes Perl to see a freed value. -=item Use of *glob{FILEHANDLE} is deprecated - -(D deprecated) You are now encouraged to use the shorter *glob{IO} form -to access the filehandle slot within a typeglob. - =item Use of /g modifier is meaningless in split (W regexp) You used the /g modifier on the pattern for a C @@ -6991,7 +7031,9 @@ repeatedly, the C has no effect. (D deprecated) Using C to jump from an outer scope into an inner scope is deprecated and should be avoided. -=item Use of inherited AUTOLOAD for non-method %s() is deprecated +This was deprecated in Perl 5.12. + +=item Use of inherited AUTOLOAD for non-method %s() is deprecated. This will be fatal in Perl 5.28 (D deprecated) As an (ahem) accidental feature, C subroutines are looked up as methods (using the C<@ISA> hierarchy) @@ -7015,34 +7057,19 @@ In code that currently says C you should remove AutoLoader from @ISA and change C to C. +This feature was deprecated in Perl 5.004, and will be fatal in Perl 5.28. + =item Use of %s in printf format not supported (F) You attempted to use a feature of printf that is accessible from only C. This usually means there's a better way to do it in Perl. -=item Use of %s is deprecated - -(D deprecated) The construct indicated is no longer recommended for use, -generally because there's a better way to do it, and also because the -old way has bad side effects. - =item Use of -l on filehandle%s (W io) A filehandle represents an opened file, and when you opened the file it already went past any symlink you are presumably trying to look for. The operation returned C. Use a filename instead. -=item Use of %s on a handle without * is deprecated - -(D deprecated) You used C, C or C on a scalar but that scalar -happens to hold a typeglob, which means its filehandle will be tied. If -you mean to tie a handle, use an explicit * as in C. - -This was a long-standing bug that was removed in Perl 5.16, as there was -no way to tie the scalar itself when it held a typeglob, and no way to -untie a scalar that had had a typeglob assigned to it. If you see this -message, you must be using an older version. - =item Use of reference "%s" as array index (W misc) You tried to use a reference as an array index; this probably @@ -7061,13 +7088,15 @@ its behavior may change or even be removed in any future release of perl. See the explanation under L. =item Use of strings with code points over 0xFF as arguments to %s -operator is deprecated +operator is deprecated. This will be a fatal error in Perl 5.28 (D deprecated) You tried to use one of the string bitwise operators (C<&> or C<|> or C<^> or C<~>) on a string containing a code point over 0xFF. The string bitwise operators treat their operands as strings of bytes, and values beyond 0xFF are nonsensical in this context. +Such usage will be a fatal error in Perl 5.28. + =item Use of tainted arguments in %s is deprecated (W taint, deprecated) You have supplied C or C with multiple @@ -7075,6 +7104,31 @@ arguments and at least one of them is tainted. This used to be allowed but will become a fatal error in a future version of perl. Untaint your arguments. See L. +=item Use of unassigned code point or non-standalone grapheme for a +delimiter will be a fatal error starting in Perl v5.30 + +(D deprecated) +A grapheme is what appears to a native-speaker of a language to be a +character. In Unicode (and hence Perl) a grapheme may actually be +several adjacent characters that together form a complete grapheme. For +example, there can be a base character, like "R" and an accent, like a +circumflex "^", that appear when displayed to be a single character with +the circumflex hovering over the "R". Perl currently allows things like +that circumflex to be delimiters of strings, patterns, I. When +displayed, the circumflex would look like it belongs to the character +just to the left of it. In order to move the language to be able to +accept graphemes as delimiters, we have to deprecate the use of +delimiters which aren't graphemes by themselves. Also, a delimiter must +already be assigned (or known to be never going to be assigned) to try +to future-proof code, for otherwise code that works today would fail to +compile if the currently unassigned delimiter ends up being something +that isn't a stand-alone grapheme. Because Unicode is never going to +assign +L, nor +L, those can be delimiters, and +their use won't raise this warning. + =item Use of uninitialized value%s (W uninitialized) An undefined value was used as if it were already diff --git a/pod/perlebcdic.pod b/pod/perlebcdic.pod index 6dd8e10..288a71f 100644 --- a/pod/perlebcdic.pod +++ b/pod/perlebcdic.pod @@ -1855,9 +1855,6 @@ EBCDIC platforms. And some of the failures are real bugs. If you compile and do a C on Perl, all tests on the C directory are skipped. -In particular, the (now deprecated) L pragma is not supported -under EBCDIC. - L partially works. =item * diff --git a/pod/perlhacktips.pod b/pod/perlhacktips.pod index 8b3392d..e12e81c 100644 --- a/pod/perlhacktips.pod +++ b/pod/perlhacktips.pod @@ -1627,8 +1627,10 @@ bugs in the past. =head2 When is a bool not a bool? On pre-C99 compilers, C is defined as equivalent to C. -Consequently assignment of any larger type to a C is unsafe and may -be truncated. The C macro exists to cast it correctly. +Consequently assignment of any larger type to a C is unsafe and may be +truncated. The C macro exists to cast it correctly; you may also find +that using it is shorter and clearer than writing out the equivalent +conditional expression longhand. On those platforms and compilers where C really is a boolean (C++, C99), it is easy to forget the cast. You can force C to be a C @@ -1640,6 +1642,10 @@ run C with something like or your compiler's equivalent to make it easier to spot any unsafe truncations that show up. +The C and C macros are available for situations where using them +would clarify intent. (But they always just mean the same as the integers 1 and +0 regardless, so using them isn't compulsory.) + =head2 The .i Targets You can expand the macros in a F file by saying diff --git a/pod/perlhist.pod b/pod/perlhist.pod index 49c75f7..72efc7b 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -571,6 +571,8 @@ the strings?). Steve 5.22.3-RC2 2016-Jul-25 Steve 5.22.3-RC3 2016-Aug-11 Steve 5.22.3-RC4 2016-Oct-12 + Steve 5.22.3-RC5 2017-Jan-02 + Steve 5.22.3 2017-Jan-14 Ricardo 5.23.0 2015-Jun-20 The 5.23 development track Matthew 5.23.1 2015-Jul-20 @@ -593,6 +595,8 @@ the strings?). Steve 5.24.1-RC2 2016-Jul-25 Steve 5.24.1-RC3 2016-Aug-11 Steve 5.24.1-RC4 2016-Oct-12 + Steve 5.24.1-RC5 2017-Jan-02 + Steve 5.24.1 2017-Jan-14 Ricardo 5.25.0 2016-May-09 The 5.25 development track Sawyer X 5.25.1 2016-May-20 @@ -602,7 +606,8 @@ the strings?). Stevan 5.25.5 2016-Sep-20 Aaron 5.25.6 2016-Oct-20 Chad 5.25.7 2016-Nov-20 - Sawyer 5.25.8 2016-Dec-20 + Sawyer X 5.25.8 2016-Dec-20 + Abigail 5.25.9 2017-Jan-20 =head2 SELECTED RELEASE SIZES diff --git a/pod/perlop.pod b/pod/perlop.pod index 8fefc4e..6550133 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -1074,6 +1074,12 @@ If the final value specified is not in the sequence that the magical increment would produce, the sequence goes until the next value would be longer than the final value specified. +As of Perl 5.26, the list-context range operator on strings works as expected +in the scope of L<< S>|feature/The +'unicode_strings' feature >>. In previous versions, and outside the scope of +that feature, it exhibits L: its behavior +depends on the internal encoding of the range endpoint. + If the initial value specified isn't part of a magical increment sequence (that is, a non-empty string matching C), only the initial value will be returned. So the following will only @@ -1389,7 +1395,8 @@ Note, however, that this does not always work for quoting Perl code: is a syntax error. The C> module (standard as of v5.8, and from CPAN before then) is able to do this properly. -There can be whitespace between the operator and the quoting +There can (and in some cases, must) be whitespace between the operator +and the quoting characters, except when C<#> is being used as the quoting character. C is parsed as the string C, while S> is the operator C followed by a comment. Its argument will be taken @@ -1398,6 +1405,12 @@ from the next line. This allows you to write: s {foo} # Replace foo {bar} # with bar. +The cases where whitespace must be used are when the quoting character +is a word character (meaning it matches C): + + q XfooX # Works: means the string 'foo' + qXfooX # WRONG! + The following escape sequences are available in constructs that interpolate, and in transliterations: X<\t> X<\n> X<\r> X<\f> X<\b> X<\a> X<\e> X<\x> X<\0> X<\c> X<\N> X<\N{}> @@ -1556,12 +1569,9 @@ as a Unicode code point no matter what the native encoding is. The name of the character in the 256th position (indexed by 0) in Unicode is C. -There are a couple of exceptions to the above rule. S}>> is +An exception to the above rule is that S}>> is always interpreted as a Unicode code point, so that C<\N{U+0050}> is C<"P"> even -on EBCDIC platforms. And if C>> is in effect, the -number is considered to be in that encoding, and is translated from that into -the platform's native encoding if there is a corresponding native character; -otherwise to Unicode. +on EBCDIC platforms. =back @@ -1730,7 +1740,9 @@ Options (specified by the following modifiers) are: m Treat string as multiple lines. s Treat string as single line. (Make . match a newline) i Do case-insensitive pattern matching. - x Use extended regular expressions. + x Use extended regular expressions; specifying two + x's means \t and the SPACE character are ignored within + square-bracketed character classes p When matching preserve a copy of the matched string so that ${^PREMATCH}, ${^MATCH}, ${^POSTMATCH} will be defined (ignored starting in v5.20) as these are always diff --git a/pod/perlpodspec.pod b/pod/perlpodspec.pod index d1ea880..4fea607 100644 --- a/pod/perlpodspec.pod +++ b/pod/perlpodspec.pod @@ -837,7 +837,7 @@ is noncompliant behavior.) Authors of Pod formatters/processors should make every effort to avoid writing their own Pod parser. There are already several in CPAN, with a wide range of interface styles -- and one of them, -Pod::Parser, comes with modern versions of Perl. +Pod::Simple, comes with modern versions of Perl. =item * diff --git a/pod/perlport.pod b/pod/perlport.pod index cc47774..c03e279 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -984,6 +984,29 @@ The very portable L|POSIX/C> will work too: c:\> perl -MPOSIX -we "print join '|', uname" Windows NT|moonru|5.0|Build 2195 (Service Pack 2)|x86 +Errors set by Winsock functions are now put directly into C<$^E>, +and the relevant C error codes are now exported from the +L and L modules for testing this against. + +The previous behavior of putting the errors (converted to POSIX-style +C error codes since Perl 5.20.0) into C<$!> was buggy due to +the non-equivalence of like-named Winsock and POSIX error constants, +a relationship between which has unfortunately been established +in one way or another since Perl 5.8.0. + +The new behavior provides a much more robust solution for checking +Winsock errors in portable software without accidentally matching +POSIX tests that were intended for other OSes and may have different +meanings for Winsock. + +The old behavior is currently retained, warts and all, for backwards +compatibility, but users are encouraged to change any code that +tests C<$!> against C constants for Winsock errors to instead +test C<$^E> against C constants. After a suitable deprecation +period, which started with Perl 5.24, the old behavior may be +removed, leaving C<$!> unchanged after Winsock function calls, to +avoid any possible confusion over which error variable to check. + Also see: =over 4 @@ -2496,7 +2519,7 @@ L, L, L, L, and L. =head1 AUTHORS / CONTRIBUTORS -Abigail , +Abigail , Charles Bailey , Graham Barr , Tom Christiansen , diff --git a/pod/perlre.pod b/pod/perlre.pod index 6f0c5e2..e3fc62d 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -7,14 +7,15 @@ perlre - Perl regular expressions This page describes the syntax of regular expressions in Perl. -If you haven't used regular expressions before, a quick-start -introduction is available in L, and a longer tutorial -introduction is available in L. - -For reference on how regular expressions are used in matching -operations, plus various examples of the same, see discussions of -C, C, C and C<"??"> in L. +If you haven't used regular expressions before, a tutorial introduction +is available in L. If you know just a little about them, +a quick-start introduction is available in L. + +This page assumes you are familiar with regular expression basics, like +what is a "pattern", what does it look like, and how is it basically used. +For a reference on how they are used, plus various examples of the same, +see discussions of C, C, C and C<"??"> in +L. New in v5.22, L|re/'strict' mode> applies stricter rules than otherwise when compiling regular expression patterns. It can @@ -85,11 +86,11 @@ inverted, which otherwise could be highly confusing. See L, and L. -=item B> +=item B> and B> X Extend your pattern's legibility by permitting whitespace and comments. -Details in L +Details in Lx and Exx> =item B> X

X X @@ -143,7 +144,6 @@ L are: g - globally match the pattern repeatedly in the string Substitution-specific modifiers described in - L are: e - evaluate the right-hand side as an expression @@ -164,12 +164,12 @@ the C<(?...)> construct, see L below. Some of the modifiers require more explanation than given in the L above. -=head4 /x +=head4 C and C -C tells +A single C tells the regular expression parser to ignore most whitespace that is neither backslashed nor within a bracketed character class. You can use this to -break up your regular expression into (slightly) more readable parts. +break up your regular expression into more readable parts. Also, the C<"#"> character is treated as a metacharacter introducing a comment that runs up to the pattern's closing delimiter, or to the end of the current line if the pattern extends onto the next line. Hence, @@ -189,6 +189,24 @@ You can use L to create a comment that ends earlier than the end of the current line, but C also can't contain the closing delimiter unless escaped with a backslash. +A common pitfall is to forget that C<#> characters begin a comment under +C and are not matched literally. Just keep that in mind when trying +to puzzle out why a particular C pattern isn't working as expected. + +Starting in Perl v5.26, if the modifier has a second C within it, +it does everything that a single C does, but additionally +non-backslashed SPACE and TAB characters within bracketed character +classes are also generally ignored, and hence can be added to make the +classes more readable. + + / [d-e g-i 3-7]/xx + /[ ! @ " # $ % ^ & * () = ? <> ' ]/xx + +may be easier to grasp than the squashed equivalents + + /[d-eg-i3-7]/ + /[!@"#$%^&*()=?<>']/ + Taken together, these features go a long way towards making Perl's regular expressions more readable. Here's an example: @@ -553,7 +571,6 @@ meanings: X X<\> X<^> X<.> X<$> X<|> X<(> X<()> X<[> X<[]> - \ Quote the next metacharacter ^ Match the beginning of the line . Match any character (except newline) @@ -1074,13 +1091,30 @@ a backslash if it appears in the comment. See Lx> for another way to have comments in patterns. +Note that a comment can go just about anywhere, except in the middle of +an escape sequence. Examples: + + qr/foo(?#comment)bar/' # Matches 'foobar' + + # The pattern below matches 'abcd', 'abccd', or 'abcccd' + qr/abc(?#comment between literal and its quantifier){1,3}d/ + + # The pattern below generates a syntax error, because the '\p' must + # be followed immediately by a '{'. + qr/\p(?#comment between \p and its property name){Any}/ + + # The pattern below generates a syntax error, because the initial + # '\(' is a literal opening parenthesis, and so there is nothing + # for the closing ')' to match + qr/\(?#the backslash means this isn't a comment)p{Any}/ + =item C<(?adlupimnsx-imnsx)> =item C<(?^alupimnsx)> X<(?)> X<(?^)> One or more embedded pattern-match modifiers, to be turned on (or -turned off, if preceded by C<"-">) for the remainder of the pattern or +turned off if preceded by C<"-">) for the remainder of the pattern or the remainder of the enclosing pattern group (if any). This is particularly useful for dynamically-generated patterns, @@ -1110,6 +1144,29 @@ These modifiers do not carry over into named subpatterns called in the enclosing group. In other words, a pattern such as C<((?i)(?&NAME))> does not change the case-sensitivity of the C<"NAME"> pattern. +A modifier is overridden by later occurrences of this construct in the +same scope containing the same modifier, so that + + /((?im)foo(?-m)bar)/ + +matches all of C case insensitively, but uses C rules for +only the C portion. The C flag overrides C as well; +likewise C overrides C. The same goes for C and C. +Hence, in + + /(?-x)foo/xx + +both C and C are turned off during matching C. And in + + /(?x)foo/x + +C but NOT C is turned on for matching C. (One might +mistakenly think that since the inner C<(?x)> is already in the scope of +C, that the result would effectively be the sum of them, yielding +C. It doesn't work that way.) Similarly, doing something like +C<(?xx-x)foo> turns off all C behavior for matching C, it is not +that you subtract 1 C from 2 to get 1 C remaining. + Any of these modifiers can be set to apply globally to all regular expressions compiled within the scope of a C. See L. @@ -1164,6 +1221,11 @@ is equivalent to the more verbose Note that any C<()> constructs enclosed within this one will still capture unless the C modifier is in effect. +Like the L construct, C and C override each +other, as do C and C. They are not additive. So, doing +something like C<(?xx-x:foo)> turns off all C behavior for matching +C. + Starting in Perl 5.14, a C<"^"> (caret or circumflex accent) immediately after the C<"?"> is a shorthand equivalent to C. Any positive flags (except C<"d">) may follow the caret, so diff --git a/pod/perlrecharclass.pod b/pod/perlrecharclass.pod index 93bb2e5..1c07632 100644 --- a/pod/perlrecharclass.pod +++ b/pod/perlrecharclass.pod @@ -576,6 +576,29 @@ Examples: # containing just [, and the character class is # followed by a ]. +=head3 Bracketed Character Classes and the C pattern modifier + +Normally SPACE and TAB characters have no special meaning inside a +bracketed character class; they are just added to the list of characters +matched by the class. But if the L|perlre/Ex and Exx> +pattern modifier is in effect, they are generally ignored and can be +added to improve readability. They can't be added in the middle of a +single construct: + + / [ \x{10 FFFF} ] /xx # WRONG! + +The SPACE in the middle of the hex constant is illegal. + +To specify a literal SPACE character, you can escape it with a +backslash, like: + + /[ a e i o u \ ]/xx + +This matches the English vowels plus the SPACE character. + +For clarity, you should already have been using C<\t> to specify a +literal tab, and C<\t> is unaffected by C. + =head3 Character Ranges It is not uncommon to want to match a range of characters. Luckily, instead @@ -1016,7 +1039,7 @@ We can extend the example above: This matches digits that are in either the Thai or Laotian scripts. Notice the white space in these examples. This construct always has -the Cx> modifier turned on within it. +the Cxx> modifier turned on within it. The available binary operators are: @@ -1061,18 +1084,9 @@ C<\N{...}>, etc.) This last example shows the use of this construct to specify an ordinary bracketed character class without additional set operations. Note the -white space within it; a limited version of Cx> is turned on even -within bracketed character classes, with only the SPACE and TAB (C<\t>) -characters allowed, and no comments. Hence, - - (?[ [#] ]) +white space within it. This is allowed because Cxx> is +automatically turned on within this construct. -matches the literal character "#". To specify a literal white space character, -you can escape it with a backslash, like: - - /(?[ [ a e i o u \ ] ])/ - -This matches the English vowels plus the SPACE character. All the other escapes accepted by normal bracketed character classes are accepted here as well; but unrecognized escapes that generate warnings in normal classes are fatal errors here. diff --git a/pod/perlref.pod b/pod/perlref.pod index dfbb52c..fa9e033 100644 --- a/pod/perlref.pod +++ b/pod/perlref.pod @@ -718,7 +718,7 @@ outer() at the time outer is invoked. This has the interesting effect of creating a function local to another function, something not normally supported in Perl. -=head1 WARNING +=head1 WARNING: Don't use references as hash keys X X You may not (usefully) use a reference as the key to a hash. It will be @@ -738,7 +738,7 @@ real refs, instead of the keys(), which won't. The standard Tie::RefHash module provides a convenient workaround to this. -=head1 Postfix Dereference Syntax +=head2 Postfix Dereference Syntax Beginning in v5.20.0, a postfix syntax for using references is available. It behaves as described in L, but instead @@ -798,7 +798,7 @@ As with postfix array, postfix value slice dereferencing I be used in interpolating strings (double quotes or the C operator), but only if the C L is enabled. -=head1 Assigning to References +=head2 Assigning to References Beginning in v5.22.0, the referencing operator can be assigned to. It performs an aliasing operation, so that the variable name referenced on the diff --git a/pod/perlrequick.pod b/pod/perlrequick.pod index d72bd2b..3cda44a 100644 --- a/pod/perlrequick.pod +++ b/pod/perlrequick.pod @@ -10,6 +10,9 @@ using regular expressions ('regexes') in Perl. =head1 The Guide +This page assumes you already know things, like what a "pattern" is, and +the basic syntax of using them. If you don't, see L. + =head2 Simple word matching The simplest regex is simply a word, or more generally, a string of diff --git a/pod/perlretut.pod b/pod/perlretut.pod index 734ca5c..9c7ab56 100644 --- a/pod/perlretut.pod +++ b/pod/perlretut.pod @@ -17,21 +17,42 @@ expressions display an efficiency and flexibility unknown in most other computer languages. Mastering even the basics of regular expressions will allow you to manipulate text with surprising ease. -What is a regular expression? A regular expression is simply a string -that describes a pattern. Patterns are in common use these days; +What is a regular expression? At its most basic, a regular expression +is a template that is used to determine if a string has certain +characteristics. The string is most often some text, such as a line, +sentence, web page, or even a whole book, but less commonly it could be +some binary data as well. +Suppose we want to determine if the text in variable, C<$var> contains +the sequence of characters C C C C C C C C +(blanks added for legibility). We can write in Perl + + $var =~ m/mushroom/ + +The value of this expression will be TRUE if C<$var> contains that +sequence of characters, and FALSE otherwise. The portion enclosed in +C<"E"> characters denotes the characteristic we are looking for. +We use the term I for it. The process of looking to see if the +pattern occurs in the string is called I, and the C<"=~"> +operator along with the C<"m//"> tell Perl to try to match the pattern +against the string. Note that the pattern is also a string, but a very +special kind of one, as we will see. Patterns are in common use these +days; examples are the patterns typed into a search engine to find web pages and the patterns used to list files in a directory, e.g., C or C. In Perl, the patterns described by regular expressions -are used to search strings, extract desired parts of strings, and to -do search and replace operations. +are used not only to search strings, but to also extract desired parts +of strings, and to do search and replace operations. Regular expressions have the undeserved reputation of being abstract -and difficult to understand. Regular expressions are constructed using +and difficult to understand. This really stems simply because the +notation used to express them tends to be terse and dense, and not +because of inherent complexity. We recommend using the C<"/x"> regular +expression modifier (described below) along with plenty of white space +to make them less dense, and easier to read. Regular expressions are +constructed using simple concepts like conditionals and loops and are no more difficult to understand than the corresponding C conditionals and C -loops in the Perl language itself. In fact, the main challenge in -learning regular expressions is just getting used to the terse -notation used to express these concepts. +loops in the Perl language itself. This tutorial flattens the learning curve by discussing regular expression concepts, along with their notation, one at a time and with @@ -58,7 +79,7 @@ find things that, while legal, may not be what you intended. =head2 Simple word matching The simplest regexp is simply a word, or more generally, a string of -characters. A regexp consisting of a word matches any string that +characters. A regexp consisting of just a word matches any string that contains that word: "Hello World" =~ /World/; # matches @@ -1458,7 +1479,7 @@ we can rewrite our 'extended' regexp in the more pleasing form |\.\d+ # mantissa of the form .b |\d+ # integer of the form a ) - ([eE][+-]?\d+)? # finally, optionally match an exponent + ( [eE] [+-]? \d+ )? # finally, optionally match an exponent $/x; If whitespace is mostly irrelevant, how does one include space @@ -1476,7 +1497,7 @@ this to our regexp as follows: |\.\d+ # mantissa of the form .b |\d+ # integer of the form a ) - ([eE][+-]?\d+)? # finally, optionally match an exponent + ( [eE] [+-]? \d+ )? # finally, optionally match an exponent $/x; In this form, it is easier to see a way to simplify the @@ -1492,10 +1513,28 @@ could be factored out: )? # ? takes care of integers of the form a |\.\d+ # mantissa of the form .b ) - ([eE][+-]?\d+)? # finally, optionally match an exponent + ( [eE] [+-]? \d+ )? # finally, optionally match an exponent $/x; -or written in the compact form, +Starting in Perl v5.26, specifying C changes the square-bracketed +portions of a pattern to ignore tabs and space characters unless they +are escaped by preceding them with a backslash. So, we could write + + /^ + [ + - ]?\ * # first, match an optional sign + ( # then match integers or f.p. mantissas: + \d+ # start out with a ... + ( + \.\d* # mantissa of the form a.b or a. + )? # ? takes care of integers of the form a + |\.\d+ # mantissa of the form .b + ) + ( [ e E ] [ + - ]? \d+ )? # finally, optionally match an exponent + $/xx; + +This doesn't really improve the legibility of this example, but it's +available in case you want it. Squashing the pattern down to the +compact form, we have /^[+-]?\ *(\d+(\.\d*)?|\.\d+)([eE][+-]?\d+)?$/; @@ -2358,7 +2397,7 @@ enclosed in parentheses up to two levels deep. Then the following regexp matches: $x = "abc(de(fg)h"; # unbalanced parentheses - $x =~ /\( ( [^()]+ | \([^()]*\) )+ \)/x; + $x =~ /\( ( [ ^ () ]+ | \( [ ^ () ]* \) )+ \)/xx; The regexp matches an open parenthesis, one or more copies of an alternation, and a close parenthesis. The alternation is two-way, with @@ -2372,7 +2411,7 @@ was no match possible. To prevent the exponential blowup, we need to prevent useless backtracking at some point. This can be done by enclosing the inner quantifier as an independent subexpression: - $x =~ /\( ( (?>[^()]+) | \([^()]*\) )+ \)/x; + $x =~ /\( ( (?> [ ^ () ]+ ) | \([ ^ () ]* \) )+ \)/xx; Here, C<< (?>[^()]+) >> breaks the degeneracy of string partitioning by gobbling up as much of the string as possible and keeping it. Then diff --git a/pod/perlstyle.pod b/pod/perlstyle.pod index 37dfaaf..5c25345 100644 --- a/pod/perlstyle.pod +++ b/pod/perlstyle.pod @@ -210,8 +210,9 @@ function should not be used outside the package that defined it. =item * -If you have a really hairy regular expression, use the C modifier and -put in some whitespace to make it look a little less like line noise. +If you have a really hairy regular expression, use the C or C +modifiers and put in some whitespace to make it look a little less like +line noise. Don't use slash as a delimiter when your regexp has slashes or backslashes. =item * diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index a5e075d..a78c095 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -638,8 +638,8 @@ Starting from Perl 5.16, one can prefix the switch keywords with C to access the feature without a C statement. The keywords C and C are analogous to C and -C in other languages, so the code in the previous section could be -rewritten as +C in other languages -- though C is not -- so the code +in the previous section could be rewritten as use v5.10.1; for ($var) { @@ -1118,7 +1118,7 @@ a C. =head3 Fall-through You can use the C keyword to fall through from one -case to the next: +case to the next immediate C or C: given($foo) { when (/x/) { say '$foo contains an x'; continue } diff --git a/pod/perlunicode.pod b/pod/perlunicode.pod index 152c34b..33e52b3 100644 --- a/pod/perlunicode.pod +++ b/pod/perlunicode.pod @@ -1814,6 +1814,16 @@ Prior to that, or outside its scope, no code points above 127 are quoted in UTF-8 encoded strings, but in byte encoded strings, code points between 128-255 are always quoted. +=item * + +In the C<..> or L operator. + +Starting in Perl 5.26.0, the range operator on strings treats their lengths +consistently within the scope of C. Prior to that, or +outside its scope, it could produce strings whose length in characters +exceeded that of the right-hand side, where the right-hand side took up more +bytes than the correct range endpoint. + =back You can see from the above that the effect of C diff --git a/pod/perluniintro.pod b/pod/perluniintro.pod index beccd3c..cd62d4c 100644 --- a/pod/perluniintro.pod +++ b/pod/perluniintro.pod @@ -151,9 +151,13 @@ serious Unicode work. The maintenance release 5.6.1 fixed many of the problems of the initial Unicode implementation, but for example regular expressions still do not work with Unicode in 5.6.1. Perl v5.14.0 is the first release where Unicode support is -(almost) seamlessly integrable without some gotchas (the exception being -some differences in L, and that is fixed -starting in Perl 5.16.0). To enable this +(almost) seamlessly integrable without some gotchas. (There are two +exceptions. Firstly, some differences in L +were fixed starting in Perl 5.16.0. Secondly, some differences in +L were fixed starting in +Perl 5.26.0.) + +To enable this seamless support, you should C (which is automatically selected if you C or higher). See L. (5.14 also fixes a number of bugs and departures from the Unicode @@ -641,13 +645,12 @@ Starting in v5.22, you can use Unicode code points as the end points of regular expression pattern character ranges, and the range will include all Unicode code points that lie between those end points, inclusive. - qr/ [\N{U+03]-\N{U+20}] /x + qr/ [ \N{U+03} - \N{U+20} ] /xx includes the code points C<\N{U+03}>, C<\N{U+04}>, ..., C<\N{U+20}>. -(It is planned to extend this behavior to ranges in C in Perl -v5.24.) +This also works for ranges in C starting in Perl v5.24. =item * diff --git a/pod/perlutil.pod b/pod/perlutil.pod index 4047b42..b41a611 100644 --- a/pod/perlutil.pod +++ b/pod/perlutil.pod @@ -126,13 +126,6 @@ around - the F<.ph> file should be created by running F on the corresponding F<.h> file. See the F documentation for more on how to convert a whole bunch of header files at once. -=item L and L - -F and F, which are actually the same program but behave -differently depending on how they are called, provide another way of -getting at C with Perl - they'll convert C structures and union declarations -to Perl code. This is deprecated in favour of F these days. - =item L F converts C header files into XS modules, and will try and write @@ -238,7 +231,7 @@ L, L, L, L, L, L, L, L, L, C, L, L, -L, L, L, L, L, +L, L, L, L, L, L, L, L, L, L, L, L, L, L diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 9c5fda7..b8c68b3 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -659,13 +659,12 @@ or a C. The C<__DIE__> handler is explicitly disabled during the call, so that you can die from a C<__DIE__> handler. Similarly for C<__WARN__>. -Due to an implementation glitch, the C<$SIG{__DIE__}> hook is called -even inside an C. Do not use this to rewrite a pending -exception in C<$@>, or as a bizarre substitute for overriding -C. This strange action at a distance may be fixed -in a future release so that C<$SIG{__DIE__}> is only called if your -program is about to exit, as was the original intent. Any other use is -deprecated. +The C<$SIG{__DIE__}> hook is called even inside an C. It was +never intended to happen this way, but an implementation glitch made +this possible. This used to be deprecated, as it allowed strange action +at a distance like rewriting a pending exception in C<$@>. Plans to +rectify this have been scrapped, as users found that rewriting a +pending exception is actually a useful feature, and not a bug. C<__DIE__>/C<__WARN__> handlers are very special in one respect: they may be called to report (probable) errors found by the parser. In such diff --git a/pod/splitman b/pod/splitman index 9fe404a..325e1d9 100644 --- a/pod/splitman +++ b/pod/splitman @@ -14,7 +14,7 @@ while (<>) { if (name($desc) ne $myname) { $myname = name($desc); print $myname, "\n"; - open(MAN, "> $myname.3pl"); + open(MAN, '>', "$myname.3pl"); print MAN < $name.pod") || die "can't open $name.pod: $!"; + open (POD, '>', "$name.pod") || die "can't open $name.pod: $!"; print POD < u && (SvLEN(dest) < (min += ulen - u))) { const UV o = d - (U8*)SvPVX_const(dest); @@ -5794,15 +5794,15 @@ PP(pp_split) orig = s; if (RX_EXTFLAGS(rx) & RXf_SKIPWHITE) { if (do_utf8) { - while (isSPACE_utf8(s)) + while (s < strend && isSPACE_utf8_safe(s, strend)) s += UTF8SKIP(s); } else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) { - while (isSPACE_LC(*s)) + while (s < strend && isSPACE_LC(*s)) s++; } else { - while (isSPACE(*s)) + while (s < strend && isSPACE(*s)) s++; } } @@ -5819,9 +5819,9 @@ PP(pp_split) m = s; /* this one uses 'm' and is a negative test */ if (do_utf8) { - while (m < strend && ! isSPACE_utf8(m) ) { + while (m < strend && ! isSPACE_utf8_safe(m, strend) ) { const int t = UTF8SKIP(m); - /* isSPACE_utf8 returns FALSE for malform utf8 */ + /* isSPACE_utf8_safe returns FALSE for malform utf8 */ if (strend - m < t) m = strend; else @@ -5859,7 +5859,7 @@ PP(pp_split) /* this one uses 's' and is a positive test */ if (do_utf8) { - while (s < strend && isSPACE_utf8(s) ) + while (s < strend && isSPACE_utf8_safe(s, strend) ) s += UTF8SKIP(s); } else if (get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) @@ -6142,7 +6142,7 @@ PP(pp_split) } GETTARGET; - PUSHi(iters); + XPUSHi(iters); RETURN; } diff --git a/pp_ctl.c b/pp_ctl.c index ec0ad7d..2ced82d 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -490,6 +490,7 @@ PP(pp_formline) U8 *source; /* source of bytes to append */ STRLEN to_copy; /* how may bytes to append */ char trans; /* what chars to translate */ + bool copied_form = FALSE; /* have we duplicated the form? */ mg = doparseform(tmpForm); @@ -687,6 +688,23 @@ PP(pp_formline) case FF_CHOP: /* (for ^*) chop the current item */ if (sv != &PL_sv_no) { const char *s = chophere; + if (!copied_form && + ((sv == tmpForm || SvSMAGICAL(sv)) + || (SvGMAGICAL(tmpForm) && !sv_only_taint_gmagic(tmpForm))) ) { + /* sv and tmpForm are either the same SV, or magic might allow modification + of tmpForm when sv is modified, so copy */ + SV *newformsv = sv_mortalcopy(formsv); + U32 *new_compiled; + + f = SvPV_nolen(newformsv) + (f - SvPV_nolen(formsv)); + Newx(new_compiled, mg->mg_len / sizeof(U32), U32); + memcpy(new_compiled, mg->mg_ptr, mg->mg_len); + SAVEFREEPV(new_compiled); + fpc = new_compiled + (fpc - (U32*)mg->mg_ptr); + formsv = newformsv; + + copied_form = TRUE; + } if (chopspace) { while (isSPACE(*s)) s++; @@ -1222,6 +1240,8 @@ PP(pp_flop) const char * const tmps = SvPV_nomg_const(right, len); SV *sv = newSVpvn_flags(lpv, llen, SvUTF8(left)|SVs_TEMP); + if (DO_UTF8(right) && IN_UNI_8_BIT) + len = sv_len_utf8_nomg(right); while (!SvNIOKp(sv) && SvCUR(sv) <= len) { XPUSHs(sv); if (strEQ(SvPVX_const(sv),tmps)) diff --git a/pp_hot.c b/pp_hot.c index dd2c611..aeaecfc 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1039,7 +1039,7 @@ PP(pp_rv2av) || ( PL_op->op_private & OPpMAYBE_TRUEBOOL && block_gimme() == G_VOID )) && (!SvRMAGICAL(sv) || !mg_find(sv, PERL_MAGIC_tied))) - SETs(HvUSEDKEYS(sv) ? &PL_sv_yes : sv_2mortal(newSViv(0))); + SETs(HvUSEDKEYS(sv) ? &PL_sv_yes : &PL_sv_no); else if (gimme == G_SCALAR) { dTARG; TARG = Perl_hv_scalar(aTHX_ MUTABLE_HV(sv)); @@ -2883,6 +2883,8 @@ PP(pp_iter) It has SvPVX of "" and SvCUR of 0, which is what we want. */ STRLEN maxlen = 0; const char *max = SvPV_const(end, maxlen); + if (DO_UTF8(end) && IN_UNI_8_BIT) + maxlen = sv_len_utf8_nomg(end); if (UNLIKELY(SvNIOK(cur) || SvCUR(cur) > maxlen)) goto retno; @@ -4465,7 +4467,7 @@ S_opmethod_stash(pTHX_ SV* meth) && SvOBJECT(ob)))) { Perl_croak(aTHX_ "Can't call method \"%" SVf "\" on unblessed reference", - SVfARG((SvPVX(meth) == PL_isa_DOES) + SVfARG((SvPOK(meth) && SvPVX(meth) == PL_isa_DOES) ? newSVpvs_flags("DOES", SVs_TEMP) : meth)); } diff --git a/pp_pack.c b/pp_pack.c index a75229a..737e019 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -1073,9 +1073,14 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c /* 'A' strips both nulls and spaces */ const char *ptr; if (utf8 && (symptr->flags & FLAG_WAS_UTF8)) { - for (ptr = s+len-1; ptr >= s; ptr--) - if (*ptr != 0 && !UTF8_IS_CONTINUATION(*ptr) && - !isSPACE_utf8(ptr)) break; + for (ptr = s+len-1; ptr >= s; ptr--) { + if ( *ptr != 0 + && !UTF8_IS_CONTINUATION(*ptr) + && !isSPACE_utf8_safe(ptr, strend)) + { + break; + } + } if (ptr >= s) ptr += UTF8SKIP(ptr); else ptr++; if (ptr > s+len) @@ -2582,7 +2587,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) if (in_bytes) auv = auv % 0x100; if (utf8) { W_utf8: - if (cur > end) { + if (cur >= end) { *cur = '\0'; SvCUR_set(cat, cur - start); diff --git a/pp_sort.c b/pp_sort.c index 68e65f9..4ffe224 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -1888,20 +1888,16 @@ S_sortcv_xsub(pTHX_ SV *const a, SV *const b) static I32 S_sv_ncmp(pTHX_ SV *const a, SV *const b) { - const NV nv1 = SvNSIV(a); - const NV nv2 = SvNSIV(b); + I32 cmp = do_ncmp(a, b); PERL_ARGS_ASSERT_SV_NCMP; -#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) - if (Perl_isnan(nv1) || Perl_isnan(nv2)) { -#else - if (nv1 != nv1 || nv2 != nv2) { -#endif + if (cmp == 2) { if (ckWARN(WARN_UNINITIALIZED)) report_uninit(NULL); return 0; } - return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0; + + return cmp; } static I32 diff --git a/pp_sys.c b/pp_sys.c index c0ef298..d8e9c30 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -630,7 +630,7 @@ PP(pp_open) if (IoDIRP(io)) Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED), - "Opening dirhandle %" HEKf " also as a file", + "Opening dirhandle %" HEKf " also as a file. This will be a fatal error in Perl 5.28", HEKfARG(GvENAME_HEK(gv))); mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); @@ -1719,7 +1719,8 @@ PP(pp_sysread) if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) { if (PL_op->op_type == OP_SYSREAD || PL_op->op_type == OP_RECV) { Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), - "%s() is deprecated on :utf8 handles", + "%s() is deprecated on :utf8 handles. " + "This will be a fatal error in Perl 5.30", OP_DESC(PL_op)); } buffer = SvPVutf8_force(bufsv, blen); @@ -1982,7 +1983,8 @@ PP(pp_syswrite) if (PerlIO_isutf8(IoIFP(io))) { Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), - "%s() is deprecated on :utf8 handles", + "%s() is deprecated on :utf8 handles. " + "This will be a fatal error in Perl 5.30", OP_DESC(PL_op)); if (!SvUTF8(bufsv)) { /* We don't modify the original scalar. */ @@ -3598,14 +3600,14 @@ PP(pp_fttext) } else #endif - if (isPRINT_A(*s) - /* VT occurs so rarely in text, that we consider it odd */ - || (isSPACE_A(*s) && *s != VT_NATIVE) + if ( isPRINT_A(*s) + /* VT occurs so rarely in text, that we consider it odd */ + || (isSPACE_A(*s) && *s != VT_NATIVE) /* But there is a fair amount of backspaces and escapes in * some text */ - || *s == '\b' - || *s == ESC_NATIVE) + || *s == '\b' + || *s == ESC_NATIVE) { continue; } @@ -4008,7 +4010,7 @@ PP(pp_open_dir) if ((IoIFP(io) || IoOFP(io))) Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED), - "Opening filehandle %" HEKf " also as a directory", + "Opening filehandle %" HEKf " also as a directory. This will be a fatal error in Perl 5.28", HEKfARG(GvENAME_HEK(gv)) ); if (IoDIRP(io)) PerlDir_close(IoDIRP(io)); diff --git a/proto.h b/proto.h index 7fcb579..2fd8a51 100644 --- a/proto.h +++ b/proto.h @@ -41,6 +41,9 @@ PERL_CALLCONV void* Perl_Slab_Alloc(pTHX_ size_t sz) PERL_CALLCONV void Perl_Slab_Free(pTHX_ void *op); #define PERL_ARGS_ASSERT_SLAB_FREE \ assert(op) +PERL_CALLCONV void Perl__force_out_malformed_utf8_message(pTHX_ const U8 *const p, const U8 * const e, const U32 flags, const bool die_here); +#define PERL_ARGS_ASSERT__FORCE_OUT_MALFORMED_UTF8_MESSAGE \ + assert(p); assert(e) PERL_CALLCONV bool Perl__is_in_locale_category(pTHX_ const bool compiling, const int category); PERL_CALLCONV bool Perl__is_uni_FOO(pTHX_ const U8 classnum, const UV c) __attribute__warn_unused_result__; @@ -51,10 +54,15 @@ PERL_CALLCONV bool Perl__is_uni_perl_idcont(pTHX_ UV c) PERL_CALLCONV bool Perl__is_uni_perl_idstart(pTHX_ UV c) __attribute__warn_unused_result__; -PERL_CALLCONV bool Perl__is_utf8_FOO(pTHX_ const U8 classnum, const U8 *p) +PERL_CALLCONV bool Perl__is_utf8_FOO(pTHX_ U8 classnum, const U8 * const p, const char * const name, const char * const alternative, const bool use_utf8, const bool use_locale, const char * const file, const unsigned line) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT__IS_UTF8_FOO \ - assert(p) + assert(p); assert(name); assert(alternative); assert(file) + +PERL_CALLCONV bool Perl__is_utf8_FOO_with_len(pTHX_ const U8 classnum, const U8 *p, const U8 * const e) + __attribute__warn_unused_result__; +#define PERL_ARGS_ASSERT__IS_UTF8_FOO_WITH_LEN \ + assert(p); assert(e) PERL_CALLCONV bool Perl__is_utf8_idcont(pTHX_ const U8 *p) __attribute__warn_unused_result__; @@ -71,15 +79,15 @@ PERL_CALLCONV bool Perl__is_utf8_mark(pTHX_ const U8 *p) #define PERL_ARGS_ASSERT__IS_UTF8_MARK \ assert(p) -PERL_CALLCONV bool Perl__is_utf8_perl_idcont(pTHX_ const U8 *p) +PERL_CALLCONV bool Perl__is_utf8_perl_idcont_with_len(pTHX_ const U8 *p, const U8 * const e) __attribute__warn_unused_result__; -#define PERL_ARGS_ASSERT__IS_UTF8_PERL_IDCONT \ - assert(p) +#define PERL_ARGS_ASSERT__IS_UTF8_PERL_IDCONT_WITH_LEN \ + assert(p); assert(e) -PERL_CALLCONV bool Perl__is_utf8_perl_idstart(pTHX_ const U8 *p) +PERL_CALLCONV bool Perl__is_utf8_perl_idstart_with_len(pTHX_ const U8 *p, const U8 * const e) __attribute__warn_unused_result__; -#define PERL_ARGS_ASSERT__IS_UTF8_PERL_IDSTART \ - assert(p) +#define PERL_ARGS_ASSERT__IS_UTF8_PERL_IDSTART_WITH_LEN \ + assert(p); assert(e) PERL_CALLCONV bool Perl__is_utf8_xidcont(pTHX_ const U8 *p) __attribute__warn_unused_result__; @@ -94,18 +102,18 @@ PERL_CALLCONV bool Perl__is_utf8_xidstart(pTHX_ const U8 *p) PERL_CALLCONV UV Perl__to_uni_fold_flags(pTHX_ UV c, U8 *p, STRLEN *lenp, U8 flags); #define PERL_ARGS_ASSERT__TO_UNI_FOLD_FLAGS \ assert(p); assert(lenp) -PERL_CALLCONV UV Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags); +PERL_CALLCONV UV Perl__to_utf8_fold_flags(pTHX_ const U8 *p, const U8 *e, U8* ustrp, STRLEN *lenp, U8 flags, const char * const file, const int line); #define PERL_ARGS_ASSERT__TO_UTF8_FOLD_FLAGS \ - assert(p); assert(ustrp) -PERL_CALLCONV UV Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags); + assert(p); assert(ustrp); assert(file) +PERL_CALLCONV UV Perl__to_utf8_lower_flags(pTHX_ const U8 *p, const U8* e, U8* ustrp, STRLEN *lenp, bool flags, const char * const file, const int line); #define PERL_ARGS_ASSERT__TO_UTF8_LOWER_FLAGS \ - assert(p); assert(ustrp) -PERL_CALLCONV UV Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags); + assert(p); assert(ustrp); assert(file) +PERL_CALLCONV UV Perl__to_utf8_title_flags(pTHX_ const U8 *p, const U8* e, U8* ustrp, STRLEN *lenp, bool flags, const char * const file, const int line); #define PERL_ARGS_ASSERT__TO_UTF8_TITLE_FLAGS \ - assert(p); assert(ustrp) -PERL_CALLCONV UV Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags); + assert(p); assert(ustrp); assert(file) +PERL_CALLCONV UV Perl__to_utf8_upper_flags(pTHX_ const U8 *p, const U8 *e, U8* ustrp, STRLEN *lenp, bool flags, const char * const file, const int line); #define PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS \ - assert(p); assert(ustrp) + assert(p); assert(ustrp); assert(file) 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); @@ -3456,25 +3464,33 @@ PERL_CALLCONV UV Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, S assert(p); assert(ustrp); assert(swashp); assert(normal) #ifndef NO_MATHOMS -PERL_CALLCONV UV Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp); +PERL_CALLCONV UV Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) + __attribute__deprecated__; #define PERL_ARGS_ASSERT_TO_UTF8_FOLD \ assert(p); assert(ustrp) #endif + #ifndef NO_MATHOMS -PERL_CALLCONV UV Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp); +PERL_CALLCONV UV Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) + __attribute__deprecated__; #define PERL_ARGS_ASSERT_TO_UTF8_LOWER \ assert(p); assert(ustrp) #endif + #ifndef NO_MATHOMS -PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp); +PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) + __attribute__deprecated__; #define PERL_ARGS_ASSERT_TO_UTF8_TITLE \ assert(p); assert(ustrp) #endif + #ifndef NO_MATHOMS -PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp); +PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) + __attribute__deprecated__; #define PERL_ARGS_ASSERT_TO_UTF8_UPPER \ assert(p); assert(ustrp) #endif + PERL_CALLCONV bool Perl_try_amagic_bin(pTHX_ int method, int flags); PERL_CALLCONV bool Perl_try_amagic_un(pTHX_ int method, int flags); PERL_CALLCONV I32 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s, const char *strbeg, const char *strend, char **new_s, I32 ocnt, U32 flags); @@ -3558,7 +3574,7 @@ PERL_CALLCONV void Perl_utilize(pTHX_ int aver, I32 floor, OP* version, OP* idop assert(idop) /* PERL_CALLCONV U8* uvchr_to_utf8(pTHX_ U8 *d, UV uv); */ /* PERL_CALLCONV U8* uvchr_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags); */ -PERL_CALLCONV U8* Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags); +PERL_CALLCONV U8* Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, const UV flags); #define PERL_ARGS_ASSERT_UVOFFUNI_TO_UTF8_FLAGS \ assert(d) PERL_CALLCONV U8* Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv); @@ -4541,7 +4557,7 @@ STATIC void S_finalize_op(pTHX_ OP* o); STATIC void S_find_and_forget_pmops(pTHX_ OP *o); #define PERL_ARGS_ASSERT_FIND_AND_FORGET_PMOPS \ assert(o) -STATIC OP* S_fold_constants(pTHX_ OP *o); +STATIC OP* S_fold_constants(pTHX_ OP * const o); #define PERL_ARGS_ASSERT_FOLD_CONSTANTS \ assert(o) STATIC OP* S_force_list(pTHX_ OP* arg, bool nullit); @@ -5258,9 +5274,6 @@ STATIC char* S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, cons #define PERL_ARGS_ASSERT_FIND_BYCLASS \ assert(prog); assert(c); assert(s); assert(strend) -STATIC bool S_isFOO_lc(pTHX_ const U8 classnum, const U8 character) - __attribute__warn_unused_result__; - STATIC bool S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* character) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_ISFOO_UTF8_LC \ @@ -5342,6 +5355,18 @@ STATIC void S_to_utf8_substr(pTHX_ regexp * prog); #define PERL_ARGS_ASSERT_TO_UTF8_SUBSTR \ assert(prog) #endif +#if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_TOKE_C) +PERL_CALLCONV bool Perl__is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 *strend, const UV cp) + __attribute__warn_unused_result__; +#define PERL_ARGS_ASSERT__IS_GRAPHEME \ + assert(strbeg); assert(s); assert(strend) + +#endif +#if defined(PERL_IN_REGEXEC_C) || defined(PERL_IN_UTF8_C) +PERL_CALLCONV bool Perl_isFOO_lc(pTHX_ const U8 classnum, const U8 character) + __attribute__warn_unused_result__; + +#endif #if defined(PERL_IN_SCOPE_C) STATIC void S_save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2, const int type); STATIC SV* S_save_scalar_at(pTHX_ SV **sptr, const U32 flags); @@ -5481,7 +5506,7 @@ STATIC char* S_force_version(pTHX_ char *s, int guessing); STATIC char* S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack); #define PERL_ARGS_ASSERT_FORCE_WORD \ assert(start) -PERL_STATIC_INLINE SV* S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) +STATIC SV* S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_GET_AND_CHECK_BACKSLASH_N_NAME \ assert(s); assert(e) @@ -5601,6 +5626,9 @@ STATIC char * S__byte_dump_string(pTHX_ const U8 * s, const STRLEN len); STATIC UV S__to_utf8_case(pTHX_ const UV uv1, const U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp, const char *normal, const char *special); #define PERL_ARGS_ASSERT__TO_UTF8_CASE \ assert(p); assert(ustrp); assert(swashp); assert(normal) +STATIC U32 S_check_and_deprecate(pTHX_ const U8 * p, const U8 ** e, const unsigned type, const bool use_locale, const char * const file, const unsigned line); +#define PERL_ARGS_ASSERT_CHECK_AND_DEPRECATE \ + assert(p); assert(e); assert(file) STATIC UV S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* const ustrp, STRLEN *lenp) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_CHECK_LOCALE_BOUNDARY_CROSSING \ @@ -5621,6 +5649,11 @@ PERL_STATIC_INLINE bool S_is_utf8_common(pTHX_ const U8 *const p, SV **swash, co #define PERL_ARGS_ASSERT_IS_UTF8_COMMON \ assert(p); assert(swash); assert(swashname) +PERL_STATIC_INLINE bool S_is_utf8_common_with_len(pTHX_ const U8 *const p, const U8 *const e, SV **swash, const char * const swashname, SV* const invlist) + __attribute__warn_unused_result__; +#define PERL_ARGS_ASSERT_IS_UTF8_COMMON_WITH_LEN \ + assert(p); assert(e); assert(swash); assert(swashname) + PERL_STATIC_INLINE bool S_is_utf8_cp_above_31_bits(const U8 * const s, const U8 * const e) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_IS_UTF8_CP_ABOVE_31_BITS \ @@ -5641,7 +5674,7 @@ STATIC SV* S_swatch_get(pTHX_ SV* swash, UV start, UV span) #define PERL_ARGS_ASSERT_SWATCH_GET \ assert(swash) -STATIC U8 S_to_lower_latin1(const U8 c, U8 *p, STRLEN *lenp) +STATIC U8 S_to_lower_latin1(const U8 c, U8 *p, STRLEN *lenp, const char dummy) __attribute__warn_unused_result__; STATIC char * S_unexpected_non_continuation_text(pTHX_ const U8 * const s, STRLEN print_len, const STRLEN non_cont_byte_pos, const STRLEN expect_len) @@ -5649,6 +5682,9 @@ STATIC char * S_unexpected_non_continuation_text(pTHX_ const U8 * const s, STRLE #define PERL_ARGS_ASSERT_UNEXPECTED_NON_CONTINUATION_TEXT \ assert(s) +STATIC void S_warn_on_first_deprecated_use(pTHX_ const char * const name, const char * const alternative, const bool use_locale, const char * const file, const unsigned line); +#define PERL_ARGS_ASSERT_WARN_ON_FIRST_DEPRECATED_USE \ + assert(name); assert(alternative); assert(file) #endif #if defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C) PERL_CALLCONV UV Perl__to_upper_title_latin1(pTHX_ const U8 c, U8 *p, STRLEN *lenp, const char S_or_s); diff --git a/regcharclass.h b/regcharclass.h index c26eb27..4be75bc 100644 --- a/regcharclass.h +++ b/regcharclass.h @@ -1854,7 +1854,7 @@ #endif /* H_REGCHARCLASS */ /* Generated from: - * f1951e655fd5fa35478f641663ef164146d743362998b01378327afac5f20270 lib/Unicode/UCD.pm + * 59e717586b720a821ee0d7397679d5322e38b49f6fb7840545aedf669c733b70 lib/Unicode/UCD.pm * 47cb62a53beea6d0263e2147331c7e751853c9327225d95bbe2d9e1dc3e1aa44 lib/unicore/ArabicShaping.txt * 153f0a100c315f9f3945e78f57137611d36c44b3a975919c499fd403413fede8 lib/unicore/BidiBrackets.txt * fbe806975c1bf9fc9960bbaa39ff6290c42c7da8315f9cd459109b024cc1c485 lib/unicore/BidiMirroring.txt @@ -1897,9 +1897,9 @@ * 37f6186253da9824bdb27f4ad867bfe8c25d4dc6bdb2f05585e40a034675a348 lib/unicore/extracted/DLineBreak.txt * ef24061b5a5dc93d7e90c2e34530ec757180ee75d872cba65ffc946e52624ae8 lib/unicore/extracted/DNumType.txt * a197371fec9a1b517058b440841f60f9378d81682084eef8db22a88cb2f96e90 lib/unicore/extracted/DNumValues.txt - * 066d6e75f95cf6794161c8ac0b1a40990277de90eefb913be2e675a7cba38d59 lib/unicore/mktables + * 4bcfb4545be21663ca38a2acbfcbf2b0f3252652a34b50f1a56ef76cb959861b lib/unicore/mktables * cdecb300baad839a6f62791229f551a4fa33f3cbdca08e378dc976466354e778 lib/unicore/version * 913d2f93f3cb6cdf1664db888bf840bc4eb074eef824e082fceda24a9445e60c regen/charset_translations.pl - * cd1fd94a77ea1ce1181f72c8333f9e5bd0cd790d6e8d1f460756a3f9f3f2762d regen/regcharclass.pl + * 1d27ae8b75d81a082b1fc594673e08540280f8169309a7b5047015c8091a2bfb regen/regcharclass.pl * 393f8d882713a3ba227351ad0f00ea4839fda74fcf77dcd1cdf31519925adba5 regen/regcharclass_multi_char_folds.pl * ex: set ro: */ diff --git a/regcomp.c b/regcomp.c index 095b13f..97888ca 100644 --- a/regcomp.c +++ b/regcomp.c @@ -177,7 +177,6 @@ struct RExC_state_t { U32 study_chunk_recursed_bytes; /* bytes in bitmap */ I32 in_lookbehind; I32 contains_locale; - I32 contains_i; I32 override_recoding; #ifdef EBCDIC I32 recode_x_to_native; @@ -272,8 +271,6 @@ struct RExC_state_t { (pRExC_state->study_chunk_recursed_bytes) #define RExC_in_lookbehind (pRExC_state->in_lookbehind) #define RExC_contains_locale (pRExC_state->contains_locale) -#define RExC_contains_i (pRExC_state->contains_i) -#define RExC_override_recoding (pRExC_state->override_recoding) #ifdef EBCDIC # define RExC_recode_x_to_native (pRExC_state->recode_x_to_native) #endif @@ -556,7 +553,6 @@ static const scan_data_t zero_scan_data = #define OOB_UNICODE 0xDEADBEEF #define CHR_SVLEN(sv) (UTF ? sv_len_utf8(sv) : SvCUR(sv)) -#define CHR_DIST(a,b) (UTF ? utf8_distance(a,b) : a - b) /* length of regex to show in messages that don't mark a position within */ @@ -823,6 +819,13 @@ static const scan_data_t zero_scan_data = REPORT_LOCATION_ARGS(loc)); \ } STMT_END +#define vWARN4dep(loc, m, a1, a2, a3) STMT_START { \ + __ASSERT_(PASS2) Perl_warner(aTHX_ packWARN2(WARN_REGEXP,WARN_DEPRECATED), \ + m REPORT_LOCATION, \ + a1, a2, a3, \ + REPORT_LOCATION_ARGS(loc)); \ +} STMT_END + #define ckWARN4reg(loc, m, a1, a2, a3) STMT_START { \ __ASSERT_(PASS2) Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ @@ -3911,7 +3914,7 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, } else { STRLEN len; - _to_utf8_fold_flags(s, d, &len, FOLD_FLAGS_FULL); + _toFOLD_utf8_flags(s, s_end, d, &len, FOLD_FLAGS_FULL); d += len; } s += s_len; @@ -6520,8 +6523,12 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, *p++ = pat[s]; } *p++ = '\''; - if (pRExC_state->pm_flags & RXf_PMf_EXTENDED) + if (pRExC_state->pm_flags & RXf_PMf_EXTENDED) { *p++ = 'x'; + if (pRExC_state->pm_flags & RXf_PMf_EXTENDED_MORE) { + *p++ = 'x'; + } + } *p++ = '\0'; DEBUG_COMPILE_r({ Perl_re_printf( aTHX_ @@ -6922,7 +6929,6 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_uni_semantics = 0; RExC_seen_unfolded_sharp_s = 0; RExC_contains_locale = 0; - RExC_contains_i = 0; RExC_strict = cBOOL(pm_flags & RXf_PMf_STRICT); RExC_study_started = 0; pRExC_state->runtime_code_qr = NULL; @@ -6974,9 +6980,6 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, rx_flags = orig_rx_flags; - if (rx_flags & PMf_FOLD) { - RExC_contains_i = 1; - } if ( initial_charset == REGEX_DEPENDS_CHARSET && (RExC_utf8 ||RExC_uni_semantics)) { @@ -7013,7 +7016,6 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_in_lookbehind = 0; RExC_seen_zerolen = *exp == '^' ? -1 : 0; RExC_extralen = 0; - RExC_override_recoding = 0; #ifdef EBCDIC RExC_recode_x_to_native = 0; #endif @@ -7171,7 +7173,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, == REG_RUN_ON_COMMENT_SEEN); U8 reganch = (U8)((r->extflags & RXf_PMf_STD_PMMOD) >> RXf_PMf_STD_PMMOD_SHIFT); - const char *fptr = STD_PAT_MODS; /*"msixn"*/ + const char *fptr = STD_PAT_MODS; /*"msixxn"*/ char *p; /* We output all the necessary flags; we never output a minus, as all @@ -8271,17 +8273,18 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) assert (RExC_parse <= RExC_end); if (RExC_parse == RExC_end) NOOP; - else if (isIDFIRST_lazy_if(RExC_parse, UTF)) { + else if (isIDFIRST_lazy_if_safe(RExC_parse, RExC_end, UTF)) { /* Note that the code here assumes well-formed UTF-8. Skip IDFIRST by * using do...while */ if (UTF) do { RExC_parse += UTF8SKIP(RExC_parse); - } while (isWORDCHAR_utf8((U8*)RExC_parse)); + } while ( RExC_parse < RExC_end + && isWORDCHAR_utf8_safe((U8*)RExC_parse, (U8*) RExC_end)); else do { RExC_parse++; - } while (isWORDCHAR(*RExC_parse)); + } while (RExC_parse < RExC_end && isWORDCHAR(*RExC_parse)); } else { RExC_parse++; /* so the <- from the vFAIL is after the offending character */ @@ -10044,9 +10047,10 @@ Perl__load_PL_utf8_foldclosures (pTHX) * to force that */ if (! PL_utf8_tofold) { U8 dummy[UTF8_MAXBYTES_CASE+1]; + const U8 hyphen[] = HYPHEN_UTF8; /* This string is just a short named one above \xff */ - to_utf8_fold((U8*) HYPHEN_UTF8, dummy, NULL); + toFOLD_utf8_safe(hyphen, hyphen + sizeof(hyphen) - 1, dummy, NULL); assert(PL_utf8_tofold); /* Verify that worked */ } PL_utf8_foldclosures = _swash_inversion_hash(PL_utf8_tofold); @@ -10066,9 +10070,6 @@ Perl__invlistEQ(pTHX_ SV* const a, SV* const b, const bool complement_b) UV len_a = _invlist_len(a); UV len_b = _invlist_len(b); - UV i = 0; /* current index into the arrays */ - bool retval = TRUE; /* Assume are identical until proven otherwise */ - PERL_ARGS_ASSERT__INVLISTEQ; /* If are to compare 'a' with the complement of b, set it @@ -10098,20 +10099,9 @@ Perl__invlistEQ(pTHX_ SV* const a, SV* const b, const bool complement_b) } } - /* Make sure that the lengths are the same, as well as the final element - * before looping through the remainder. (Thus we test the length, final, - * and first elements right off the bat) */ - if (len_a != len_b || array_a[len_a-1] != array_b[len_a-1]) { - retval = FALSE; - } - else for (i = 0; i < len_a - 1; i++) { - if (array_a[i] != array_b[i]) { - retval = FALSE; - break; - } - } + return len_a == len_b + && memEQ(array_a, array_b, len_a * sizeof(array_a[0])); - return retval; } #endif @@ -10197,7 +10187,7 @@ S__make_exactf_invlist(pTHX_ RExC_state_t *pRExC_state, regnode *node) } else { STRLEN len; - to_utf8_fold(s, d, &len); + toFOLD_utf8_safe(s, e, d, &len); d += len; s += UTF8SKIP(s); } @@ -10447,21 +10437,23 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state) } flagsp = &negflags; wastedflags = 0; /* reset so (?g-c) warns twice */ + x_mod_count = 0; break; case ':': case ')': + + if ((posflags & (RXf_PMf_EXTENDED|RXf_PMf_EXTENDED_MORE)) == RXf_PMf_EXTENDED) { + negflags |= RXf_PMf_EXTENDED_MORE; + } RExC_flags |= posflags; + + if (negflags & RXf_PMf_EXTENDED) { + negflags |= RXf_PMf_EXTENDED_MORE; + } RExC_flags &= ~negflags; set_regex_charset(&RExC_flags, cs); - if (RExC_flags & RXf_PMf_FOLD) { - RExC_contains_i = 1; - } - if (UNLIKELY((x_mod_count) > 1)) { - vFAIL("Only one /x regex modifier is allowed"); - } return; - /*NOTREACHED*/ default: fail_modifiers: RExC_parse += SKIP_IF_CHAR(RExC_parse); @@ -11608,7 +11600,7 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first, U32 depth) } /* - - regpiece - something followed by possible [*+?] + - regpiece - something followed by possible quantifier * + ? {n,m} * * Note that the branching code sequences used for ? and the general cases * of * and + are somewhat optimized: they use the same NOTHING node as @@ -12160,7 +12152,6 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, /* The values are Unicode, and therefore not subject to recoding, but * have to be converted to native on a non-Unicode (meaning non-ASCII) * platform. */ - RExC_override_recoding = 1; #ifdef EBCDIC RExC_recode_x_to_native = 1; #endif @@ -12181,7 +12172,6 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, RExC_start = RExC_adjusted_start = save_start; RExC_parse = endbrace; RExC_end = orig_end; - RExC_override_recoding = 0; #ifdef EBCDIC RExC_recode_x_to_native = 0; #endif @@ -13380,6 +13370,12 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) RExC_parse = p + 1; vFAIL("Unescaped left brace in regex is illegal here"); } + goto normal_default; + case '}': + case ']': + if (PASS2 && p > RExC_parse && RExC_strict) { + ckWARN2reg(p + 1, "Unescaped literal '%c'", *p); + } /*FALLTHROUGH*/ default: /* A literal character */ normal_default: @@ -13799,7 +13795,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) skip_to_be_ignored_text(pRExC_state, &RExC_parse, FALSE /* Don't force to /x */ ); if (PASS2 && *RExC_parse == '{' && OP(ret) != SBOL && ! regcurly(RExC_parse)) { - ckWARNregdep(RExC_parse + 1, "Unescaped left brace in regex is deprecated here, passed through"); + ckWARNregdep(RExC_parse + 1, "Unescaped left brace in regex is deprecated here (and will be fatal in Perl 5.30), passed through"); } return(ret); @@ -15814,8 +15810,10 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, character; used under /i */ UV n; char * stop_ptr = RExC_end; /* where to stop parsing */ - const bool skip_white = cBOOL(ret_invlist); /* ignore unescaped white - space? */ + + /* ignore unescaped whitespace? */ + const bool skip_white = cBOOL( ret_invlist + || (RExC_flags & RXf_PMf_EXTENDED_MORE)); /* Unicode properties are stored in a swash; this holds the current one * being parsed. If this swash is the only above-latin1 component of the @@ -16811,15 +16809,19 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * must be be all digits or all letters of the same case. * Otherwise, the range is non-portable and unclear as to * what it contains */ - if ((isPRINT_A(prevvalue) || isPRINT_A(value)) - && (non_portable_endpoint - || ! ((isDIGIT_A(prevvalue) && isDIGIT_A(value)) - || (isLOWER_A(prevvalue) && isLOWER_A(value)) - || (isUPPER_A(prevvalue) && isUPPER_A(value))))) - { - vWARN(RExC_parse, "Ranges of ASCII printables should be some subset of \"0-9\", \"A-Z\", or \"a-z\""); + if ( (isPRINT_A(prevvalue) || isPRINT_A(value)) + && ( non_portable_endpoint + || ! ( (isDIGIT_A(prevvalue) && isDIGIT_A(value)) + || (isLOWER_A(prevvalue) && isLOWER_A(value)) + || (isUPPER_A(prevvalue) && isUPPER_A(value)) + ))) { + vWARN(RExC_parse, "Ranges of ASCII printables should" + " be some subset of \"0-9\"," + " \"A-Z\", or \"a-z\""); } else if (prevvalue >= 0x660) { /* ARABIC_INDIC_DIGIT_ZERO */ + SSize_t index_start; + SSize_t index_final; /* But the nature of Unicode and languages mean we * can't do the same checks for above-ASCII ranges, @@ -16827,40 +16829,68 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * contain only digits from the same group of 10. The * ASCII case is handled just above. 0x660 is the * first digit character beyond ASCII. Hence here, the - * range could be a range of digits. Find out. */ - IV index_start = _invlist_search(PL_XPosix_ptrs[_CC_DIGIT], - prevvalue); - IV index_final = _invlist_search(PL_XPosix_ptrs[_CC_DIGIT], - value); - - /* If the range start and final points are in the same - * inversion list element, it means that either both - * are not digits, or both are digits in a consecutive - * sequence of digits. (So far, Unicode has kept all - * such sequences as distinct groups of 10, but assert - * to make sure). If the end points are not in the - * same element, neither should be a digit. */ - if (index_start == index_final) { - assert(! ELEMENT_RANGE_MATCHES_INVLIST(index_start) - || (invlist_array(PL_XPosix_ptrs[_CC_DIGIT])[index_start+1] - - invlist_array(PL_XPosix_ptrs[_CC_DIGIT])[index_start] - == 10) - /* But actually Unicode did have one group of 11 - * 'digits' in 5.2, so in case we are operating - * on that version, let that pass */ - || (invlist_array(PL_XPosix_ptrs[_CC_DIGIT])[index_start+1] - - invlist_array(PL_XPosix_ptrs[_CC_DIGIT])[index_start] - == 11 - && invlist_array(PL_XPosix_ptrs[_CC_DIGIT])[index_start] - == 0x19D0) - ); + * range could be a range of digits. First some + * unlikely special cases. Grandfather in that a range + * ending in 19DA (NEW TAI LUE THAM DIGIT ONE) is bad + * if its starting value is one of the 10 digits prior + * to it. This is because it is an alternate way of + * writing 19D1, and some people may expect it to be in + * that group. But it is bad, because it won't give + * the expected results. In Unicode 5.2 it was + * considered to be in that group (of 11, hence), but + * this was fixed in the next version */ + + if (UNLIKELY(value == 0x19DA && prevvalue >= 0x19D0)) { + goto warn_bad_digit_range; } - else if ((index_start >= 0 - && ELEMENT_RANGE_MATCHES_INVLIST(index_start)) - || (index_final >= 0 - && ELEMENT_RANGE_MATCHES_INVLIST(index_final))) + else if (UNLIKELY( prevvalue >= 0x1D7CE + && value <= 0x1D7FF)) { - vWARN(RExC_parse, "Ranges of digits should be from the same group of 10"); + /* This is the only other case currently in Unicode + * where the algorithm below fails. The code + * points just above are the end points of a single + * range containing only decimal digits. It is 5 + * different series of 0-9. All other ranges of + * digits currently in Unicode are just a single + * series. (And mktables will notify us if a later + * Unicode version breaks this.) + * + * If the range being checked is at most 9 long, + * and the digit values represented are in + * numerical order, they are from the same series. + * */ + if ( value - prevvalue > 9 + || ((( value - 0x1D7CE) % 10) + <= (prevvalue - 0x1D7CE) % 10)) + { + goto warn_bad_digit_range; + } + } + else { + + /* For all other ranges of digits in Unicode, the + * algorithm is just to check if both end points + * are in the same series, which is the same range. + * */ + index_start = _invlist_search( + PL_XPosix_ptrs[_CC_DIGIT], + prevvalue); + + /* Warn if the range starts and ends with a digit, + * and they are not in the same group of 10. */ + if ( index_start >= 0 + && ELEMENT_RANGE_MATCHES_INVLIST(index_start) + && (index_final = + _invlist_search(PL_XPosix_ptrs[_CC_DIGIT], + value)) != index_start + && index_final >= 0 + && ELEMENT_RANGE_MATCHES_INVLIST(index_final)) + { + warn_bad_digit_range: + vWARN(RExC_parse, "Ranges of digits should be" + " from the same group of" + " 10"); + } } } } @@ -16875,20 +16905,22 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, literal[d++] = (char) value; literal[d++] = '\0'; - vWARN4(RExC_parse, - "\"%.*s\" is more clearly written simply as \"%s\"", + vWARN4dep(RExC_parse, + "\"%.*s\" is more clearly written simply as \"%s\". " + "This will be a fatal error in Perl 5.28", (int) (RExC_parse - rangebegin), rangebegin, literal - ); + ); } else if isMNEMONIC_CNTRL(value) { - vWARN4(RExC_parse, - "\"%.*s\" is more clearly written simply as \"%s\"", + vWARN4dep(RExC_parse, + "\"%.*s\" is more clearly written simply as \"%s\". " + "This will be a fatal error in Perl 5.28", (int) (RExC_parse - rangebegin), rangebegin, cntrl_to_mnemonic((U8) value) - ); + ); } } } @@ -17030,7 +17062,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, RExC_adjusted_start = RExC_start + prefix_end; RExC_end = RExC_parse + len; RExC_in_multi_char_class = 1; - RExC_override_recoding = 1; RExC_emit = (regnode *)orig_emit; ret = reg(pRExC_state, 1, ®_flags, depth+1); @@ -17043,7 +17074,6 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, RExC_precomp_adj = 0; RExC_end = save_end; RExC_in_multi_char_class = 0; - RExC_override_recoding = 0; SvREFCNT_dec_NN(multi_char_matches); return ret; } diff --git a/regen/embed.pl b/regen/embed.pl index 01bcc78..ea77ecb 100755 --- a/regen/embed.pl +++ b/regen/embed.pl @@ -238,7 +238,7 @@ sub readvars { my ($file, $pre) = @_; local (*FILE, $_); my %seen; - open(FILE, "< $file") + open(FILE, '<', $file) or die "embed.pl: Can't open $file: $!\n"; while () { s/[ \t]*#.*//; # Delete comments. diff --git a/regen/embed_lib.pl b/regen/embed_lib.pl index ca65f45..af991cb 100644 --- a/regen/embed_lib.pl +++ b/regen/embed_lib.pl @@ -55,7 +55,7 @@ sub add_level { sub setup_embed { my $prefix = shift || ''; - open IN, $prefix . 'embed.fnc' or die $!; + open IN, '<', $prefix . 'embed.fnc' or die $!; my @embed; my %seen; @@ -104,7 +104,7 @@ sub setup_embed { close IN or die "Problem reading embed.fnc: $!"; - open IN, $prefix . 'regen/opcodes' or die $!; + open IN, '<', $prefix . 'regen/opcodes' or die $!; { my %syms; diff --git a/regen/feature.pl b/regen/feature.pl index f8cf4a8..66fc017 100755 --- a/regen/feature.pl +++ b/regen/feature.pl @@ -107,7 +107,7 @@ my $HintShift; my $HintMask; my $Uni8Bit; -open "perl.h", "perl.h" or die "$0 cannot open perl.h: $!"; +open "perl.h", "<", "perl.h" or die "$0 cannot open perl.h: $!"; while (readline "perl.h") { next unless /#\s*define\s+(HINT_FEATURE_MASK|HINT_UNI_8_BIT)/; my $is_u8b = $1 =~ 8; @@ -367,7 +367,7 @@ read_only_bottom_close_and_rename($h); __END__ package feature; -our $VERSION = '1.45'; +our $VERSION = '1.46'; FEATURES @@ -484,7 +484,9 @@ potentially using Unicode in your program, the C subpragma is B recommended. This feature is available starting with Perl 5.12; was almost fully -implemented in Perl 5.14; and extended in Perl 5.16 to cover C. +implemented in Perl 5.14; and extended in Perl 5.16 to cover C; +and extended further in Perl 5.26 to cover L. =head2 The 'unicode_eval' and 'evalbytes' features diff --git a/regen/mk_invlists.pl b/regen/mk_invlists.pl index d6ff165..feac27e 100644 --- a/regen/mk_invlists.pl +++ b/regen/mk_invlists.pl @@ -1750,6 +1750,7 @@ for my $charset (get_supported_code_pages()) { no warnings 'qw'; # Ignore non-alpha in sort for my $prop (sort { prop_name_for_cmp($a) cmp prop_name_for_cmp($b) } qw( + Assigned ASCII Cased VertSpace @@ -2148,7 +2149,7 @@ my @sources = ($0, qw(lib/unicore/mktables { # Depend on mktables’ own sources. It’s a shorter list of files than # those that Unicode::UCD uses. - if (! open my $mktables_list, $sources_list) { + if (! open my $mktables_list, '<', $sources_list) { # This should force a rebuild once $sources_list exists push @sources, $sources_list; diff --git a/regen/opcode.pl b/regen/opcode.pl index 0bd62ce..c1c105f 100755 --- a/regen/opcode.pl +++ b/regen/opcode.pl @@ -45,7 +45,7 @@ my $oprivpm = open_new('lib/B/Op_private.pm', '>', my %seen; my (@ops, %desc, %check, %ckname, %flags, %args, %opnum); -open OPS, 'regen/opcodes' or die $!; +open OPS, '<', 'regen/opcodes' or die $!; while () { chop; diff --git a/regen/reentr.pl b/regen/reentr.pl index 564a68f..802b8db 100644 --- a/regen/reentr.pl +++ b/regen/reentr.pl @@ -198,7 +198,7 @@ while () { # Read in the protoypes. } # If given the -U option open up the metaconfig unit for this function. - if ($opts{U} && open(U, ">d_${func}_r.U")) { + if ($opts{U} && open(U, ">", "d_${func}_r.U")) { binmode U; } diff --git a/regen/regcharclass.pl b/regen/regcharclass.pl index 3e2c8b4..0009994 100755 --- a/regen/regcharclass.pl +++ b/regen/regcharclass.pl @@ -1467,7 +1467,7 @@ EOF { # Depend on mktables’ own sources. It’s a shorter list of files than # those that Unicode::UCD uses. - if (! open my $mktables_list, $sources_list) { + if (! open my $mktables_list, '<', $sources_list) { # This should force a rebuild once $sources_list exists push @sources, $sources_list; diff --git a/regen/regcomp.pl b/regen/regcomp.pl index 94aa572..88c0ac9 100644 --- a/regen/regcomp.pl +++ b/regen/regcomp.pl @@ -621,7 +621,7 @@ EOD my $old_fh= select($guts); $~= "GuTS"; - open my $oldguts, "pod/perldebguts.pod" + open my $oldguts, '<', 'pod/perldebguts.pod' or die "$0 cannot open pod/perldebguts.pod for reading: $!"; while (<$oldguts>) { print; diff --git a/regen/regen_lib.pl b/regen/regen_lib.pl index 184d86b..571f519 100644 --- a/regen/regen_lib.pl +++ b/regen/regen_lib.pl @@ -48,9 +48,9 @@ sub open_new { if (-f $name) { unlink $name or die "$name exists but can't unlink: $!"; } - open $fh, ">$name" or die "Can't create $name: $!"; + open $fh, '>', $name or die "Can't create $name: $!"; } elsif ($mode eq '>>') { - open $fh, ">>$name" or die "Can't append to $name: $!"; + open $fh, '>>', $name or die "Can't append to $name: $!"; } else { die "Unhandled open mode '$mode'"; } @@ -219,7 +219,7 @@ sub digest { require Digest::SHA; local ($/, *FH); - open FH, "$file" or die "Can't open $file: $!"; + open FH, '<', $file or die "Can't open $file: $!"; my $raw = ; close FH or die "Can't close $file: $!"; return Digest::SHA::sha256_hex($raw); diff --git a/regexec.c b/regexec.c index f6f293d..811eca2 100644 --- a/regexec.c +++ b/regexec.c @@ -119,7 +119,6 @@ static const char* const non_utf8_target_but_utf8_required */ #define CHR_SVLEN(sv) (utf8_target ? sv_len_utf8(sv) : SvCUR(sv)) -#define CHR_DIST(a,b) (reginfo->is_utf8_target ? utf8_distance(a,b) : a - b) #define HOPc(pos,off) \ (char *)(reginfo->is_utf8_target \ @@ -150,6 +149,7 @@ static const char* const non_utf8_target_but_utf8_required #define HOP3lim(pos,off,lim) (reginfo->is_utf8_target \ ? reghop3((U8*)(pos), off, (U8*)(lim)) \ : (U8*)((pos + off) > lim ? lim : (pos + off))) +#define HOP3clim(pos,off,lim) ((char*)HOP3lim(pos,off,lim)) #define HOP4(pos,off,llim, rlim) (reginfo->is_utf8_target \ ? reghop4((U8*)(pos), off, (U8*)(llim), (U8*)(rlim)) \ @@ -445,8 +445,10 @@ S_regcp_restore(pTHX_ regexp *rex, I32 ix, U32 *maxopenparen_p _pDEPTH) #define regcpblow(cp) LEAVE_SCOPE(cp) /* Ignores regcppush()ed data. */ -STATIC bool -S_isFOO_lc(pTHX_ const U8 classnum, const U8 character) +#ifndef PERL_IN_XSUB_RE + +bool +Perl_isFOO_lc(pTHX_ const U8 classnum, const U8 character) { /* Returns a boolean as to whether or not 'character' is a member of the * Posix character class given by 'classnum' that should be equivalent to a @@ -486,6 +488,8 @@ S_isFOO_lc(pTHX_ const U8 classnum, const U8 character) return FALSE; } +#endif + STATIC bool S_isFOO_utf8_lc(pTHX_ const U8 classnum, const U8* character) { @@ -1288,10 +1292,10 @@ Perl_re_intuit_start(pTHX_ */ if (prog->anchored_substr || prog->anchored_utf8 || ml_anch) - endpos= HOP3c(rx_origin, (prog->minlen ? cl_l : 0), strend); + endpos = HOP3clim(rx_origin, (prog->minlen ? cl_l : 0), strend); else if (prog->float_substr || prog->float_utf8) { rx_max_float = HOP3c(check_at, -start_shift, strbeg); - endpos= HOP3c(rx_max_float, cl_l, strend); + endpos = HOP3clim(rx_max_float, cl_l, strend); } else endpos= strend; @@ -1500,8 +1504,9 @@ STMT_START { uscan += len; \ len=0; \ } else { \ - uvc = _to_utf8_fold_flags( (const U8*) uc, foldbuf, &foldlen, flags); \ len = UTF8SKIP(uc); \ + uvc = _toFOLD_utf8_flags( (const U8*) uc, uc + len, foldbuf, &foldlen, \ + flags); \ skiplen = UVCHR_SKIP( uvc ); \ foldlen -= skiplen; \ uscan = foldbuf + skiplen; \ @@ -1678,7 +1683,7 @@ REXEC_FBC_SCAN( /* Loops while (s < strend) */ \ tmp = TEST_UV(tmp); \ LOAD_UTF8_CHARCLASS_ALNUM(); \ REXEC_FBC_UTF8_SCAN( /* advances s while s < strend */ \ - if (tmp == ! (TEST_UTF8((U8 *) s))) { \ + if (tmp == ! (TEST_UTF8((U8 *) s, (U8 *) reginfo->strend))) { \ tmp = !tmp; \ IF_SUCCESS; \ } \ @@ -1969,10 +1974,8 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, * trying that it will fail; so don't start a match past the * required minimum number from the far end */ e = HOP3c(strend, -((SSize_t)ln), s); - - if (reginfo->intuit && e < s) { - e = s; /* Due to minlen logic of intuit() */ - } + if (e < s) + break; c1 = *pat_string; c2 = fold_array[c1]; @@ -2016,10 +2019,6 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, */ e = HOP3c(strend, -((SSize_t)lnc), s); - if (reginfo->intuit && e < s) { - e = s; /* Due to minlen logic of intuit() */ - } - /* XXX Note that we could recalculate e to stop the loop earlier, * as the worst case expansion above will rarely be met, and as we * go along we would usually find that e moves further to the left. @@ -2050,7 +2049,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, goto do_boundu; } - FBC_BOUND(isWORDCHAR_LC, isWORDCHAR_LC_uvchr, isWORDCHAR_LC_utf8); + FBC_BOUND(isWORDCHAR_LC, isWORDCHAR_LC_uvchr, isWORDCHAR_LC_utf8_safe); break; case NBOUNDL: @@ -2063,14 +2062,14 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, goto do_nboundu; } - FBC_NBOUND(isWORDCHAR_LC, isWORDCHAR_LC_uvchr, isWORDCHAR_LC_utf8); + FBC_NBOUND(isWORDCHAR_LC, isWORDCHAR_LC_uvchr, isWORDCHAR_LC_utf8_safe); break; case BOUND: /* regcomp.c makes sure that this only has the traditional \b meaning */ assert(FLAGS(c) == TRADITIONAL_BOUND); - FBC_BOUND(isWORDCHAR, isWORDCHAR_uni, isWORDCHAR_utf8); + FBC_BOUND(isWORDCHAR, isWORDCHAR_uni, isWORDCHAR_utf8_safe); break; case BOUNDA: /* regcomp.c makes sure that this only has the traditional \b @@ -2084,7 +2083,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, meaning */ assert(FLAGS(c) == TRADITIONAL_BOUND); - FBC_NBOUND(isWORDCHAR, isWORDCHAR_uni, isWORDCHAR_utf8); + FBC_NBOUND(isWORDCHAR, isWORDCHAR_uni, isWORDCHAR_utf8_safe); break; case NBOUNDA: /* regcomp.c makes sure that this only has the traditional \b @@ -2096,7 +2095,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, case NBOUNDU: if ((bound_type) FLAGS(c) == TRADITIONAL_BOUND) { - FBC_NBOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8); + FBC_NBOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8_safe); break; } @@ -2109,7 +2108,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, do_boundu: switch((bound_type) FLAGS(c)) { case TRADITIONAL_BOUND: - FBC_BOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8); + FBC_BOUND(isWORDCHAR_L1, isWORDCHAR_uni, isWORDCHAR_utf8_safe); break; case GCB_BOUND: if (s == reginfo->strbeg) { @@ -2387,7 +2386,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, if (utf8_target) { /* The complement of something that matches only ASCII matches all * non-ASCII, plus everything in ASCII that isn't in the class. */ - REXEC_FBC_UTF8_CLASS_SCAN(! isASCII_utf8(s) + REXEC_FBC_UTF8_CLASS_SCAN( ! isASCII_utf8_safe(s, strend) || ! _generic_isCC_A(*s, FLAGS(c))); break; } @@ -2429,7 +2428,7 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, if ((UTF8_IS_INVARIANT(*s) && to_complement ^ cBOOL(_generic_isCC((U8) *s, classnum))) - || (UTF8_IS_DOWNGRADEABLE_START(*s) + || ( UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(s, strend) && to_complement ^ cBOOL( _generic_isCC(EIGHT_BIT_UTF8_TO_NATIVE(*s, *(s + 1)), @@ -2451,27 +2450,27 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, macros */ case _CC_ENUM_SPACE: REXEC_FBC_UTF8_CLASS_SCAN( - to_complement ^ cBOOL(isSPACE_utf8(s))); + to_complement ^ cBOOL(isSPACE_utf8_safe(s, strend))); break; case _CC_ENUM_BLANK: REXEC_FBC_UTF8_CLASS_SCAN( - to_complement ^ cBOOL(isBLANK_utf8(s))); + to_complement ^ cBOOL(isBLANK_utf8_safe(s, strend))); break; case _CC_ENUM_XDIGIT: REXEC_FBC_UTF8_CLASS_SCAN( - to_complement ^ cBOOL(isXDIGIT_utf8(s))); + to_complement ^ cBOOL(isXDIGIT_utf8_safe(s, strend))); break; case _CC_ENUM_VERTSPACE: REXEC_FBC_UTF8_CLASS_SCAN( - to_complement ^ cBOOL(isVERTWS_utf8(s))); + to_complement ^ cBOOL(isVERTWS_utf8_safe(s, strend))); break; case _CC_ENUM_CNTRL: REXEC_FBC_UTF8_CLASS_SCAN( - to_complement ^ cBOOL(isCNTRL_utf8(s))); + to_complement ^ cBOOL(isCNTRL_utf8_safe(s, strend))); break; default: @@ -2496,9 +2495,10 @@ S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, * FBC macro instead of being expanded out. Since we've loaded the * swash, we don't have to check for that each time through the loop */ REXEC_FBC_UTF8_CLASS_SCAN( - to_complement ^ cBOOL(_generic_utf8( + to_complement ^ cBOOL(_generic_utf8_safe( classnum, s, + strend, swash_fetch(PL_utf8_swash_ptrs[classnum], (U8 *) s, TRUE)))); break; @@ -4132,10 +4132,11 @@ S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, } else { STRLEN len; - _to_utf8_fold_flags(s, - d, - &len, - FOLD_FLAGS_FULL | FOLD_FLAGS_LOCALE); + _toFOLD_utf8_flags(s, + pat_end, + d, + &len, + FOLD_FLAGS_FULL | FOLD_FLAGS_LOCALE); d += len; s += UTF8SKIP(s); } @@ -5342,6 +5343,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) regnode *next; U32 n = 0; /* general value; init to avoid compiler warning */ SSize_t ln = 0; /* len or last; init to avoid compiler warning */ + SSize_t endref = 0; /* offset of end of backref when ln is start */ char *locinput = startpos; char *pushinput; /* where to continue after a PUSH */ I32 nextchr; /* is always set to UCHARAT(locinput), or -1 at EOS */ @@ -6067,12 +6069,14 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) if (locinput == reginfo->strbeg) b1 = isWORDCHAR_LC('\n'); else { - b1 = isWORDCHAR_LC_utf8(reghop3((U8*)locinput, -1, - (U8*)(reginfo->strbeg))); + b1 = isWORDCHAR_LC_utf8_safe(reghop3((U8*)locinput, -1, + (U8*)(reginfo->strbeg)), + (U8*)(reginfo->strend)); } b2 = (NEXTCHR_IS_EOS) ? isWORDCHAR_LC('\n') - : isWORDCHAR_LC_utf8((U8*)locinput); + : isWORDCHAR_LC_utf8_safe((U8*) locinput, + (U8*) reginfo->strend); } else { /* Here the string isn't utf8 */ b1 = (locinput == reginfo->strbeg) @@ -6146,11 +6150,15 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) bool b1, b2; b1 = (locinput == reginfo->strbeg) ? 0 /* isWORDCHAR_L1('\n') */ - : isWORDCHAR_utf8(reghop3((U8*)locinput, -1, - (U8*)(reginfo->strbeg))); + : isWORDCHAR_utf8_safe( + reghop3((U8*)locinput, + -1, + (U8*)(reginfo->strbeg)), + (U8*) reginfo->strend); b2 = (NEXTCHR_IS_EOS) ? 0 /* isWORDCHAR_L1('\n') */ - : isWORDCHAR_utf8((U8*)locinput); + : isWORDCHAR_utf8_safe((U8*)locinput, + (U8*) reginfo->strend); match = cBOOL(b1 != b2); break; } @@ -6366,8 +6374,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) break; } - if (! UTF8_IS_DOWNGRADEABLE_START(nextchr)) { /* An above Latin-1 code point */ - _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput, reginfo->strend); + if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(locinput, reginfo->strend)) { + /* An above Latin-1 code point, or malformed */ + _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(locinput, + reginfo->strend); goto utf8_posix_above_latin1; } @@ -6451,7 +6461,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) } locinput++; } - else if (UTF8_IS_DOWNGRADEABLE_START(nextchr)) { + else if (UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(locinput, reginfo->strend)) { if (! (to_complement ^ cBOOL(_generic_isCC(EIGHT_BIT_UTF8_TO_NATIVE(nextchr, *(locinput + 1)), @@ -6664,10 +6674,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) do_nref_ref_common: ln = rex->offs[n].start; + endref = rex->offs[n].end; reginfo->poscache_iter = reginfo->poscache_maxiter; /* Void cache */ - if (rex->lastparen < n || ln == -1) + if (rex->lastparen < n || ln == -1 || endref == -1) sayNO; /* Do not match unless seen CLOSEn. */ - if (ln == rex->offs[n].end) + if (ln == endref) break; s = reginfo->strbeg + ln; @@ -6681,7 +6692,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) * not going off the end given by reginfo->strend, and * returns in upon success, how much of the * current input was matched */ - if (! foldEQ_utf8_flags(s, NULL, rex->offs[n].end - ln, utf8_target, + if (! foldEQ_utf8_flags(s, NULL, endref - ln, utf8_target, locinput, &limit, 0, utf8_target, utf8_fold_flags)) { sayNO; @@ -6696,7 +6707,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) (type == REF || UCHARAT(s) != fold_array[nextchr])) sayNO; - ln = rex->offs[n].end - ln; + ln = endref - ln; if (locinput + ln > reginfo->strend) sayNO; if (ln > 1 && (type == REF @@ -8969,7 +8980,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, /* The complement of something that matches only ASCII matches all * non-ASCII, plus everything in ASCII that isn't in the class. */ while (hardcount < max && scan < loceol - && (! isASCII_utf8(scan) + && ( ! isASCII_utf8_safe(scan, reginfo->strend) || ! _generic_isCC_A((U8) *scan, FLAGS(p)))) { scan += UTF8SKIP(scan); @@ -9037,7 +9048,8 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, case _CC_ENUM_SPACE: while (hardcount < max && scan < loceol - && (to_complement ^ cBOOL(isSPACE_utf8(scan)))) + && (to_complement + ^ cBOOL(isSPACE_utf8_safe(scan, loceol)))) { scan += UTF8SKIP(scan); hardcount++; @@ -9046,7 +9058,8 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, case _CC_ENUM_BLANK: while (hardcount < max && scan < loceol - && (to_complement ^ cBOOL(isBLANK_utf8(scan)))) + && (to_complement + ^ cBOOL(isBLANK_utf8_safe(scan, loceol)))) { scan += UTF8SKIP(scan); hardcount++; @@ -9055,7 +9068,8 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, case _CC_ENUM_XDIGIT: while (hardcount < max && scan < loceol - && (to_complement ^ cBOOL(isXDIGIT_utf8(scan)))) + && (to_complement + ^ cBOOL(isXDIGIT_utf8_safe(scan, loceol)))) { scan += UTF8SKIP(scan); hardcount++; @@ -9064,7 +9078,8 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, case _CC_ENUM_VERTSPACE: while (hardcount < max && scan < loceol - && (to_complement ^ cBOOL(isVERTWS_utf8(scan)))) + && (to_complement + ^ cBOOL(isVERTWS_utf8_safe(scan, loceol)))) { scan += UTF8SKIP(scan); hardcount++; @@ -9073,7 +9088,8 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, case _CC_ENUM_CNTRL: while (hardcount < max && scan < loceol - && (to_complement ^ cBOOL(isCNTRL_utf8(scan)))) + && (to_complement + ^ cBOOL(isCNTRL_utf8_safe(scan, loceol)))) { scan += UTF8SKIP(scan); hardcount++; @@ -9099,9 +9115,10 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, } while (hardcount < max && scan < loceol - && to_complement ^ cBOOL(_generic_utf8( + && to_complement ^ cBOOL(_generic_utf8_safe( classnum, scan, + loceol, swash_fetch(PL_utf8_swash_ptrs[classnum], (U8 *) scan, TRUE)))) @@ -9225,10 +9242,14 @@ S_reginclass(pTHX_ regexp * const prog, const regnode * const n, const U8* const * UTF8_IS_INVARIANT() works even if not in UTF-8 */ if (! UTF8_IS_INVARIANT(c) && utf8_target) { STRLEN c_len = 0; - c = utf8n_to_uvchr(p, p_end - p, &c_len, ( UTF8_ALLOW_DEFAULT - | UTF8_CHECK_ONLY)); - if (c_len == (STRLEN)-1) - Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)"); + const U32 utf8n_flags = UTF8_ALLOW_DEFAULT; + c = utf8n_to_uvchr(p, p_end - p, &c_len, utf8n_flags | UTF8_CHECK_ONLY); + if (c_len == (STRLEN)-1) { + _force_out_malformed_utf8_message(p, p_end, + utf8n_flags, + 1 /* 1 means die */ ); + NOT_REACHED; /* NOTREACHED */ + } if (c > 255 && OP(n) == ANYOFL && ! ANYOFL_UTF8_LOCALE_REQD(flags)) { _CHECK_AND_OUTPUT_WIDE_LOCALE_CP_MSG(c); } @@ -9683,6 +9704,64 @@ S_to_byte_substr(pTHX_ regexp *prog) return TRUE; } +bool +Perl__is_grapheme(pTHX_ const U8 * strbeg, const U8 * s, const U8 * strend, const UV cp) +{ + /* Temporary helper function for toke.c. Verify that the code point 'cp' + * is a stand-alone grapheme. The UTF-8 for 'cp' begins at position 's' in + * the larger string bounded by 'strbeg' and 'strend'. + * + * 'cp' needs to be assigned (if not a future version of the Unicode + * Standard could make it something that combines with adjacent characters, + * so code using it would then break), and there has to be a GCB break + * before and after the character. */ + + GCB_enum cp_gcb_val, prev_cp_gcb_val, next_cp_gcb_val; + const U8 * prev_cp_start; + + PERL_ARGS_ASSERT__IS_GRAPHEME; + + /* Unassigned code points are forbidden */ + if (UNLIKELY(! ELEMENT_RANGE_MATCHES_INVLIST( + _invlist_search(PL_Assigned_invlist, cp)))) + { + return FALSE; + } + + cp_gcb_val = getGCB_VAL_CP(cp); + + /* Find the GCB value of the previous code point in the input */ + prev_cp_start = utf8_hop_back(s, -1, strbeg); + if (UNLIKELY(prev_cp_start == s)) { + prev_cp_gcb_val = GCB_EDGE; + } + else { + prev_cp_gcb_val = getGCB_VAL_UTF8(prev_cp_start, strend); + } + + /* And check that is a grapheme boundary */ + if (! isGCB(prev_cp_gcb_val, cp_gcb_val, strbeg, s, + TRUE /* is UTF-8 encoded */ )) + { + return FALSE; + } + + /* Similarly verify there is a break between the current character and the + * following one */ + s += UTF8SKIP(s); + if (s >= strend) { + next_cp_gcb_val = GCB_EDGE; + } + else { + next_cp_gcb_val = getGCB_VAL_UTF8(s, strend); + } + + return isGCB(cp_gcb_val, next_cp_gcb_val, strbeg, s, TRUE); +} + + + + /* * ex: set ts=8 sts=4 sw=4 et: */ diff --git a/regexp.h b/regexp.h index 7351afd..08b4fc3 100644 --- a/regexp.h +++ b/regexp.h @@ -278,18 +278,26 @@ and check for NULL. #include "op_reg_common.h" -#define RXf_PMf_STD_PMMOD (RXf_PMf_MULTILINE|RXf_PMf_SINGLELINE|RXf_PMf_FOLD|RXf_PMf_EXTENDED|RXf_PMf_NOCAPTURE) +#define RXf_PMf_STD_PMMOD (RXf_PMf_MULTILINE|RXf_PMf_SINGLELINE|RXf_PMf_FOLD|RXf_PMf_EXTENDED|RXf_PMf_EXTENDED_MORE|RXf_PMf_NOCAPTURE) #define CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl, x_count) \ case IGNORE_PAT_MOD: *(pmfl) |= RXf_PMf_FOLD; break; \ case MULTILINE_PAT_MOD: *(pmfl) |= RXf_PMf_MULTILINE; break; \ case SINGLE_PAT_MOD: *(pmfl) |= RXf_PMf_SINGLELINE; break; \ - case XTENDED_PAT_MOD: *(pmfl) |= RXf_PMf_EXTENDED; (x_count)++; break;\ + case XTENDED_PAT_MOD: if (x_count == 0) { \ + *(pmfl) |= RXf_PMf_EXTENDED; \ + *(pmfl) &= ~RXf_PMf_EXTENDED_MORE; \ + } \ + else { \ + *(pmfl) |= RXf_PMf_EXTENDED \ + |RXf_PMf_EXTENDED_MORE; \ + } \ + (x_count)++; break; \ case NOCAPTURE_PAT_MOD: *(pmfl) |= RXf_PMf_NOCAPTURE; break; /* Note, includes charset ones, assumes 0 is the default for them */ #define STD_PMMOD_FLAGS_CLEAR(pmfl) \ - *(pmfl) &= ~(RXf_PMf_FOLD|RXf_PMf_MULTILINE|RXf_PMf_SINGLELINE|RXf_PMf_EXTENDED|RXf_PMf_CHARSET|RXf_PMf_NOCAPTURE) + *(pmfl) &= ~(RXf_PMf_FOLD|RXf_PMf_MULTILINE|RXf_PMf_SINGLELINE|RXf_PMf_EXTENDED|RXf_PMf_EXTENDED_MORE|RXf_PMf_CHARSET|RXf_PMf_NOCAPTURE) /* chars and strings used as regex pattern modifiers * Singular is a 'c'har, plural is a "string" diff --git a/sv.c b/sv.c index e915e7d..42e3441 100644 --- a/sv.c +++ b/sv.c @@ -2915,8 +2915,8 @@ S_infnan_2pv(NV nv, char* buffer, size_t maxlen, char plus) { return 0; } assert((s == buffer + 3) || (s == buffer + 4)); - *s++ = 0; - return s - buffer - 1; /* -1: excluding the zero byte */ + *s = 0; + return s - buffer; } /* @@ -4808,8 +4808,13 @@ Perl_sv_set_undef(pTHX_ SV *sv) if (type <= SVt_IV) { assert(!SvGMAGICAL(sv)); - if (SvREADONLY(sv)) + if (SvREADONLY(sv)) { + /* does undeffing PL_sv_undef count as modifying a read-only + * variable? Some XS code does this */ + if (sv == &PL_sv_undef) + return; Perl_croak_no_modify(); + } if (SvROK(sv)) { if (SvWEAKREF(sv)) @@ -4834,8 +4839,8 @@ Perl_sv_set_undef(pTHX_ SV *sv) if (isGV_with_GP(sv)) Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Undefined value assigned to typeglob"); - - SvOK_off(sv); + else + SvOK_off(sv); } @@ -15325,6 +15330,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, PL_GCB_invlist = sv_dup_inc(proto_perl->IGCB_invlist, param); PL_SB_invlist = sv_dup_inc(proto_perl->ISB_invlist, param); PL_WB_invlist = sv_dup_inc(proto_perl->IWB_invlist, param); + PL_seen_deprecated_macro = hv_dup_inc(proto_perl->Iseen_deprecated_macro, param); PL_utf8_mark = sv_dup_inc(proto_perl->Iutf8_mark, param); PL_utf8_toupper = sv_dup_inc(proto_perl->Iutf8_toupper, param); PL_utf8_totitle = sv_dup_inc(proto_perl->Iutf8_totitle, param); diff --git a/sv.h b/sv.h index ee65879..6227d46 100644 --- a/sv.h +++ b/sv.h @@ -1806,10 +1806,10 @@ Like C, but doesn't do magic on C. #define SvSHARED_HASH(sv) (0 + SvSHARED_HEK_FROM_PV(SvPVX_const(sv))->hek_hash) /* flag values for sv_*_flags functions */ +#define SV_UTF8_NO_ENCODING 0 /* No longer used */ #define SV_IMMEDIATE_UNREF 1 #define SV_GMAGIC 2 #define SV_COW_DROP_PV 4 -#define SV_UTF8_NO_ENCODING 8 #define SV_NOSTEAL 16 #define SV_CONST_RETURN 32 #define SV_MUTABLE_RETURN 64 @@ -2013,6 +2013,9 @@ Returns a pointer to the character buffer. SV must be of type >= C. One alternative is to call C if you are not sure of the type of SV. +You might mistakenly think that C is the number of bytes to add to the +existing size, but instead it is the total size C should be. + =for apidoc Am|char *|SvPVCLEAR|SV* sv Ensures that sv is a SVt_PV and that its SvCUR is 0, and that it is properly null terminated. Equivalent to sv_setpvs(""), but more efficient. diff --git a/symbian/config.pl b/symbian/config.pl index e82c365..2671df6 100644 --- a/symbian/config.pl +++ b/symbian/config.pl @@ -67,7 +67,7 @@ sub create_mmp { my $mmp = "$target.mmp"; my $targetpath = $miniperl || $perl ? "TARGETPATH\t\\System\\Apps\\Perl" : ""; - if ( open( my $fh, ">$mmp" ) ) { + if ( open( my $fh, '>', $mmp ) ) { print "\t$mmp\n"; push @mmp, $mmp; push @unclean, $mmp; @@ -209,7 +209,7 @@ __EOF__ } sub create_bld_inf { - if ( open( BLD_INF, ">bld.inf" ) ) { + if ( open( BLD_INF, '>', 'bld.inf' ) ) { print "\tbld.inf\n"; push @unclean, "bld.inf"; print BLD_INF <<__EOF__; @@ -228,7 +228,7 @@ __EOF__ my %config; sub load_config_sh { - if ( open( CONFIG_SH, "symbian/config.sh" ) ) { + if ( open( CONFIG_SH, '<', 'symbian/config.sh' ) ) { while () { if (/^(\w+)=['"]?(.*?)["']?$/) { my ( $var, $val ) = ( $1, $2 ); @@ -249,10 +249,10 @@ sub load_config_sh { sub create_config_h { load_config_sh(); - if ( open( CONFIG_H, ">config.h" ) ) { + if ( open( CONFIG_H, '>', 'config.h' ) ) { print "\tconfig.h\n"; push @unclean, "config.h"; - if ( open( CONFIG_H_SH, "config_h.SH" ) ) { + if ( open( CONFIG_H_SH, '<', 'config_h.SH' ) ) { while () { last if /\#ifndef _config_h_/; } @@ -298,7 +298,7 @@ q[xsubpp ext\DynaLoader\dl_symbian.xs >ext\DynaLoader\DynaLoader.cpp] sub create_symbian_port_h { print "\tsymbian\\symbian_port.h\n"; - if ( open( SYMBIAN_PORT_H, ">symbian/symbian_port.h" ) ) { + if ( open( SYMBIAN_PORT_H, '>', 'symbian/symbian_port.h' ) ) { my ($sdkmajor, $sdkminor); if ($SDK_VARIANT eq 'S60') { $S60SDK =~ /^(\d+)\.(\d+)$/; @@ -351,7 +351,7 @@ q[perl -ne "print qq[ char *file = __FILE__;\n] if /dXSUB_SYS/;print unless / sub create_PerlApp_pkg { print "\tsymbian\\PerlApp.pkg\n"; - if ( open( PERLAPP_PKG, ">symbian\\PerlApp.pkg" ) ) { + if ( open( PERLAPP_PKG, '>', 'symbian\\PerlApp.pkg' ) ) { my $ProductId = defined $S60SDK ? qq[;Supports Series 60 v0.9\n(0x101F6F88), 0, 0, 0, {"Series60ProductID"}\n] : @@ -392,7 +392,7 @@ $mdl "$APPS\\PerlApp.rsc"-"!:\\system\\apps\\PerlApp\\PerlApp.rsc" $AIF __EOF__ - if ( open( DEMOS, "perl symbian\\demo_pl list |" ) ) { + if ( open( DEMOS, '-|', "perl symbian\\demo_pl list" ) ) { while () { chomp; if (defined $S90SDK) { @@ -447,7 +447,7 @@ create_symbian_port_h(); create_DynaLoader_cpp(); create_PerlApp_pkg(); -if ( open( PERLAPP_MMP, ">symbian/PerlApp.mmp" ) ) { +if ( open( PERLAPP_MMP, '>', 'symbian/PerlApp.mmp' ) ) { my @MACRO; my @LIB; push @MACRO, 'PERL_IMPLICIT_CONTEXT'; @@ -543,7 +543,7 @@ else { warn "$0: failed to create symbian\\PerlApp.mmp"; } -if ( open( MAKEFILE, ">Makefile" ) ) { +if ( open( MAKEFILE, '>', 'Makefile' ) ) { my $perl = "perl$VERSION"; my $windef1 = "$SYMBIAN_ROOT\\Epoc32\\Build$CWD\\$perl\\$WIN\\$perl.def"; my $windef2 = "..\\BWINS\\${perl}u.def"; @@ -895,7 +895,7 @@ else { warn "$0: failed to create Makefile: $!\n"; } -if ( open( MAKEFILE, ">symbian/Makefile")) { +if ( open( MAKEFILE, '>', 'symbian/Makefile')) { my $wrap = defined $S60SDK && $S60SDK eq '1.2' && $WIN ne '${WIN}cw'; my $ABLD = $wrap ? 'perl b.pl': 'abld'; print "\tsymbian/Makefile\n"; @@ -951,7 +951,7 @@ distclean: clean __EOF__ close(MAKEFILE); if ($wrap) { - if ( open( B_PL, ">symbian/b.pl")) { + if ( open( B_PL, '>', 'symbian/b.pl')) { print B_PL <<'__EOF__'; # abld.pl wrapper. diff --git a/symbian/demo_pl b/symbian/demo_pl index fbba5f4..9759347 100644 --- a/symbian/demo_pl +++ b/symbian/demo_pl @@ -33,7 +33,7 @@ while () { unlink $1 or warn "$0: $1: $!\n"; } elsif ($extract) { defined $fh && close($fh); - open($fh, ">$1") or die "$0: '$1': $!\n"; + open($fh, ">", $1) or die "$0: '$1': $!\n"; print "Extracting $1\n"; } elsif ($list) { print "$1\n"; diff --git a/symbian/hexdump.pl b/symbian/hexdump.pl index 37adff3..d1741f8 100644 --- a/symbian/hexdump.pl +++ b/symbian/hexdump.pl @@ -22,7 +22,7 @@ for my $fn ($EXE, $RSC) { my $newfn = $new{$fn}; unlink($newfn); if (($read = sysread($fh, $buffer, $size)) == $size) { - if (open(my $newfh, ">$newfn")) { + if (open(my $newfh, '>', $newfn)) { binmode($newfh); print $newfh unpack("H*", $buffer); close($newfh); diff --git a/symbian/makesis.pl b/symbian/makesis.pl index 270f6b4..58199ce 100644 --- a/symbian/makesis.pl +++ b/symbian/makesis.pl @@ -72,7 +72,7 @@ for my $target (@target) { print "\tErrno.pm\n"; $copy{"ext\\Errno\\Errno.pm"} = "$lib\\Perl\\$R_V_SV\\Errno.pm"; - open( my $cfg, "symbian/install.cfg" ) + open( my $cfg, '<', "symbian/install.cfg" ) or die "$!: symbian/install.cfg: $!\n"; while (<$cfg>) { next unless /^lib\s+(.+)/; @@ -98,7 +98,7 @@ for my $target (@target) { my $ext = $1; $ext =~ s!-!::!g; print "\t$ext\n"; - if ( open( my $pkg, $lst ) ) { + if ( open( my $pkg, '<', $lst ) ) { while (<$pkg>) { if (m!^"(.+)"-"(.+)"$!) { my ( $src, $dst ) = ( $1, $2 ); @@ -165,7 +165,7 @@ qq[;Supports Series 80 v2.0\n(0x101F8ED2), 0, 0, 0, {"Series80ProductID"}\n] : qq[;Supports Series 90 v1.1\n(0x101FBE05), 0, 0, 0, {"Series90ProductID"}\n] : ";Supports Series NN"; - open PKG, ">$pkg" or die "$0: failed to create $pkg: $!\n"; + open PKG, '>', $pkg or die "$0: failed to create $pkg: $!\n"; print PKG <<__EOF__; ; \u$target installation script ; diff --git a/symbian/sisify.pl b/symbian/sisify.pl index fc82ae7..7b5506c 100644 --- a/symbian/sisify.pl +++ b/symbian/sisify.pl @@ -188,9 +188,9 @@ $OWD =~ s!/!\\!g; chdir($tempdir) or die "$0: chdir('$tempdir')\n"; if (@SisPl) { - if (open(my $fi, "default.pl")) { + if (open(my $fi, "<", "default.pl")) { my $fn = "default.pl.new"; - if (open(my $fo, ">$fn")) { + if (open(my $fo, ">", $fn)) { while (<$fi>) { last unless /^\#/; print $fo $_; @@ -254,7 +254,7 @@ unless ($Library) { my $cmd = "uidcrc $uids |"; - if (open(my $fh, $cmd)) { + if (open(my $fh, '<', $cmd)) { my $line = <$fh>; close($fh); # 0x10000079 0x100039ce 0x0acebabe 0xc82b1900 @@ -285,7 +285,7 @@ unless ($Library) { my $UID_OFFSET = 0x0C7C; # This is where the uid is in the $app. substr($app, $UID_OFFSET, 4) = substr($app, 8, 4); # Copy the uid also here. - if (open(my $fh, ">$AppName.app")) { + if (open(my $fh, '>', "$AppName.app")) { binmode($fh); print $fh $app; close($fh); @@ -295,7 +295,7 @@ unless ($Library) { push @pkg, qq["$AppName.app"-"!:\\system\\apps\\$AppName\\$AppName.app"]; - if (open(my $fh, ">$AppName.rsc")) { + if (open(my $fh, '>', "$AppName.rsc")) { binmode($fh); print $fh hex2data($RSCHEX); close($fh); @@ -311,7 +311,7 @@ if ($ShowPkg) { } } else { my $fn = "$AppName.pkg"; - if (open(my $fh, ">$fn")) { + if (open(my $fh, '>', $fn)) { for my $l (@pkg) { print $fh "$l\r\n"; # Note CRLF! } diff --git a/symbian/symbianish.h b/symbian/symbianish.h index 80c580b..9100405 100644 --- a/symbian/symbianish.h +++ b/symbian/symbianish.h @@ -128,7 +128,7 @@ #define BIT_BUCKET "NUL:" -#define dXSUB_SYS +#define dXSUB_SYS dNOOP #define NO_ENVIRON_ARRAY diff --git a/symbian/version.pl b/symbian/version.pl index c8bb82e..f4208f8 100644 --- a/symbian/version.pl +++ b/symbian/version.pl @@ -2,7 +2,7 @@ use strict; my %VERSION; -if (open(PATCHLEVEL_H, "patchlevel.h")) { +if (open(PATCHLEVEL_H, "<", "patchlevel.h")) { while () { if (/#define\s+PERL_(REVISION|VERSION|SUBVERSION)\s+(\d+)/) { $VERSION{$1} = $2; diff --git a/symbian/xsbuild.pl b/symbian/xsbuild.pl index 939b569..5ccd7c3 100644 --- a/symbian/xsbuild.pl +++ b/symbian/xsbuild.pl @@ -137,7 +137,7 @@ my %EXTCFG; sub write_bld_inf { my ($base) = @_; print "\tbld.inf\n"; - open( BLD_INF, ">bld.inf" ) or die "$0: bld.inf: $!\n"; + open( BLD_INF, '>', 'bld.inf' ) or die "$0: bld.inf: $!\n"; print BLD_INF <<__EOF__; PRJ_MMPFILES $base.mmp @@ -188,7 +188,7 @@ sub uniquefy_filenames { sub read_mmp { my ( $conf, $mmp ) = @_; - if ( -r $mmp && open( MMP, "<$mmp" ) ) { + if ( -r $mmp && open( MMP, '<', $mmp ) ) { print "\tReading $mmp...\n"; while () { chomp; @@ -269,7 +269,7 @@ sub write_mmp { for my $u (qw(SOURCE SOURCEPATH SYSTEMINCLUDE USERINCLUDE LIBRARY MACRO)) { $CONF{$u} = uniquefy_filenames( $CONF{$u} ); } - open( BASE_MMP, ">$base.mmp" ) or die "$0: $base.mmp: $!\n"; + open( BASE_MMP, '>', "$base.mmp" ) or die "$0: $base.mmp: $!\n"; print BASE_MMP <<__EOF__; TARGET $CONF{TARGET} @@ -310,7 +310,7 @@ sub write_makefile { my $wrap = $SYMBIAN_ROOT && defined $SDK_VARIANT eq 'S60' && $SDK_VERSION eq '1.2' && $SYMBIAN_ROOT !~ /_CW$/; my $ABLD = $wrap ? 'perl b.pl' : 'abld'; - open( MAKEFILE, ">Makefile" ) or die "$0: Makefile: $!\n"; + open( MAKEFILE, '>', 'Makefile' ) or die "$0: Makefile: $!\n"; print MAKEFILE <<__EOF__; WIN = $WIN ARM = $ARM @@ -382,7 +382,7 @@ distclean: defrost realclean __EOF__ close(MAKEFILE); if ($wrap) { - if(open(B,">b.pl")) { + if(open(B, '>', 'b.pl')) { print B <<'__EOF__'; # abld.pl wrapper. @@ -420,7 +420,7 @@ sub patch_config { return unless $CoreBuild; my $V = sprintf "%vd", $^V; # create reverse patch script - if (open(RSCRIPT, ">$config_restore_script")) { + if (open(RSCRIPT, '>', $config_restore_script)) { print RSCRIPT <<__EOF__; #!perl -pi.bak s:\\Q$V:$R_V_SV: @@ -590,7 +590,7 @@ sub xsconfig { my @MM = qw(VERSION XS_VERSION); if ( -f "Makefile" ) { print "\tReading MakeMaker Makefile...\n"; - if ( open( MAKEFILE, "Makefile" ) ) { + if ( open( MAKEFILE, '<', 'Makefile' ) ) { while () { for my $m (@MM) { if (m!^$m = (.+)!) { @@ -617,7 +617,7 @@ sub xsconfig { } (&restore_config and die "$0: VERSION or XS_VERSION undefined\n") unless defined $MM{VERSION} && defined $MM{XS_VERSION}; - if ( open( BASE_C, ">$basec" ) ) { + if ( open( BASE_C, '>', $basec ) ) { print BASE_C <<__EOF__; #ifndef VERSION #define VERSION "$MM{VERSION}" @@ -643,7 +643,7 @@ __EOF__ } print "\t_init.c\n"; - open( _INIT_C, ">_init.c" ) + open( _INIT_C, '>', '_init.c' ) or &restore_config and die "$!: _init.c: $!\n"; print _INIT_C <<__EOF__; #include "EXTERN.h" @@ -659,7 +659,7 @@ __EOF__ for my $submf ( glob("*/Makefile") ) { my $d = dirname($submf); print "Configuring Encode::$d...\n"; - if ( open( SUBMF, $submf ) ) { + if ( open( SUBMF, '<', $submf ) ) { if ( update_dir($d) ) { my @subsrc; while () { @@ -715,7 +715,7 @@ __EOF__ print "\t$lstname.lst\n"; my $lstout = $CoreBuild ? "$BUILDROOT/symbian/$lstname.lst" : "$BUILDROOT/$lstname.lst"; - if ( open( my $lst, ">$lstout" ) ) { + if ( open( my $lst, '>', $lstout ) ) { for my $f (@lst) { print $lst qq["$f"-"!:$lst{$f}"\n] } close($lst); } @@ -787,7 +787,7 @@ for my $ext (@ARGV) { if $CoreBuild && $Build && !-f "lib\\Config.pm"; if ($CoreBuild) { - open( my $cfg, "symbian/install.cfg" ) + open( my $cfg, '<', 'symbian/install.cfg' ) or die "$0: symbian/install.cfg: $!\n"; my $extdir = $dir; $extdir =~ s:^ext\\::; @@ -864,7 +864,7 @@ for my $ext (@ARGV) { system_echo("make @TARGET") == 0 or die "$0: make #2 failed\n"; unlink("$base.mmp.bak"); - open( _INIT_C, ">_init.c" ) or die "$0: _init.c: $!\n"; + open( _INIT_C, '>', '_init.c' ) or die "$0: _init.c: $!\n"; print _INIT_C <<'__EOF__'; #include "EXTERN.h" #include "perl.h" @@ -885,7 +885,7 @@ __EOF__ for my $f ("$SYMBIAN_ROOT\\Epoc32\\Build$CWD\\$base\\WINS\\perl$VERSION-$extdash.def", "..\\BMARM\\perl$VERSION-${extdash}u.def") { print "\t($f - "; - if ( open( $def, $f ) ) { + if ( open( $def, '<', $f ) ) { print "OK)\n"; $basef = $f; last; diff --git a/t/base/lex.t b/t/base/lex.t index 87eb0e4..e154aca 100644 --- a/t/base/lex.t +++ b/t/base/lex.t @@ -360,7 +360,7 @@ print "not " if $@; print "ok $test - listop({$_ => 1} + 1)\n"; $test++; print "# $@" if $@; -for(qw< require goto last next redo dump >) { +for(qw< require goto last next redo CORE::dump >) { eval "sub { $_ foo << 2 }"; print "not " if $@; print "ok ", $test++, " - [perl #105924] $_ WORD << ...\n"; diff --git a/t/comp/parser.t b/t/comp/parser.t index 901d66a..8be973b 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -444,7 +444,7 @@ is prototype "Hello::_he_said", '_', 'initial tick in sub declaration'; 'literal -> after an array subscript within ""'); @x = ['string']; # this used to give "string" - like("$x[0]-> [0]", qr/^ARRAY\([^)]*\)-> \[0]\z/, + like("$x[0]-> [0]", qr/^ARRAY\([^)]*\)-> \[0\]\z/, 'literal -> [0] after an array subscript within ""'); } diff --git a/t/lib/croak/pp_ctl b/t/lib/croak/pp_ctl index ee1edba..ec66413 100644 --- a/t/lib/croak/pp_ctl +++ b/t/lib/croak/pp_ctl @@ -1,9 +1,10 @@ __END__ # NAME dump with computed label +no warnings 'deprecated'; my $label = "foo"; dump $label; EXPECT -Can't find label foo at - line 2. +Can't find label foo at - line 3. ######## # NAME when outside given use 5.01; no warnings 'experimental::smartmatch'; diff --git a/t/lib/croak/toke b/t/lib/croak/toke index d35eab6..f1817b3 100644 --- a/t/lib/croak/toke +++ b/t/lib/croak/toke @@ -350,3 +350,10 @@ 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 tr/// handling of mis-formatted \o characters +# may only fail with ASAN +tr/\o-0//; +EXPECT +Missing braces on \o{} at - line 2, within string +Execution of - aborted due to compilation errors. diff --git a/t/lib/overload_fallback.t b/t/lib/overload_fallback.t index a72d499..6672251 100644 --- a/t/lib/overload_fallback.t +++ b/t/lib/overload_fallback.t @@ -5,7 +5,7 @@ BEGIN { chdir 't' if -d 't'; @INC = '../lib'; require './test.pl'; - plan( tests => 3 ); + plan(tests => 4); } use overload '""' => sub { 'stringvalue' }, fallback => 1; @@ -33,3 +33,16 @@ my $value = bless \(my $dummy = 1), __PACKAGE__; print ++$value; EOC } + +{ + my $warned = 0; + local $SIG{__WARN__} = sub { $warned++; }; + + eval q{ + use overload '${}', 'fallback'; + no overload '${}', 'fallback'; + }; + + ok($warned == 0, 'no overload should not warn'); +} + diff --git a/t/lib/warnings/2use b/t/lib/warnings/2use index 4e10d4b..a02505e 100644 --- a/t/lib/warnings/2use +++ b/t/lib/warnings/2use @@ -365,8 +365,8 @@ $*; use warnings "void"; $#; EXPECT -$* is no longer supported at - line 3. -$# is no longer supported at - line 5. +$* is no longer supported. Its use will be fatal in Perl 5.30 at - line 3. +$# is no longer supported. Its use will be fatal in Perl 5.30 at - line 5. Useless use of a variable in void context at - line 5. ######## @@ -375,5 +375,5 @@ $*; no warnings "void"; $#; EXPECT -$* is no longer supported at - line 3. -$# is no longer supported at - line 5. +$* is no longer supported. Its use will be fatal in Perl 5.30 at - line 3. +$# is no longer supported. Its use will be fatal in Perl 5.30 at - line 5. diff --git a/t/lib/warnings/9uninit b/t/lib/warnings/9uninit index c8b843f..1dc7139 100644 --- a/t/lib/warnings/9uninit +++ b/t/lib/warnings/9uninit @@ -411,7 +411,7 @@ chomp ($x, $y); chop ($x, $y); EXPECT Use of uninitialized value $m1 in scalar assignment at - line 4. Use of uninitialized value $m1 in scalar assignment at - line 4. -Setting $/ to a reference to zero as a form of slurp is deprecated, treating as undef at - line 4. +Setting $/ to a reference to zero as a form of slurp is deprecated, treating as undef. This will be fatal in Perl 5.28 at - line 4. Use of uninitialized value $y in chop at - line 8. ######## use warnings 'uninitialized'; @@ -651,8 +651,8 @@ Use of uninitialized value $m1 in sort at - line 6. Use of uninitialized value $g1 in sort at - line 6. Use of uninitialized value $m1 in sort at - line 7. Use of uninitialized value $g1 in sort at - line 7. -Use of uninitialized value $m1 in sort at - line 7. Use of uninitialized value $g1 in sort at - line 7. +Use of uninitialized value $m1 in sort at - line 7. Use of uninitialized value $a in subtraction (-) at - line 8. Use of uninitialized value $b in subtraction (-) at - line 8. Use of uninitialized value $m1 in sort at - line 9. diff --git a/t/lib/warnings/doop b/t/lib/warnings/doop index bcc85a3..a62bc23 100644 --- a/t/lib/warnings/doop +++ b/t/lib/warnings/doop @@ -26,12 +26,12 @@ $_ = "\x{100}" & "\x{103}"; $_ = "\x{101}" | "\x{104}"; $_ = "\x{102}" ^ "\x{105}"; EXPECT -Use of strings with code points over 0xFF as arguments to bitwise and (&) operator is deprecated at - line 1. -Use of strings with code points over 0xFF as arguments to bitwise or (|) operator is deprecated at - line 2. -Use of strings with code points over 0xFF as arguments to bitwise xor (^) operator is deprecated at - line 3. -Use of strings with code points over 0xFF as arguments to bitwise and (&) operator is deprecated at - line 4. -Use of strings with code points over 0xFF as arguments to bitwise or (|) operator is deprecated at - line 5. -Use of strings with code points over 0xFF as arguments to bitwise xor (^) operator is deprecated at - line 6. -Use of strings with code points over 0xFF as arguments to bitwise and (&) operator is deprecated at - line 7. -Use of strings with code points over 0xFF as arguments to bitwise or (|) operator is deprecated at - line 8. -Use of strings with code points over 0xFF as arguments to bitwise xor (^) operator is deprecated at - line 9. +Use of strings with code points over 0xFF as arguments to bitwise and (&) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 1. +Use of strings with code points over 0xFF as arguments to bitwise or (|) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 2. +Use of strings with code points over 0xFF as arguments to bitwise xor (^) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 3. +Use of strings with code points over 0xFF as arguments to bitwise and (&) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 4. +Use of strings with code points over 0xFF as arguments to bitwise or (|) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 5. +Use of strings with code points over 0xFF as arguments to bitwise xor (^) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 6. +Use of strings with code points over 0xFF as arguments to bitwise and (&) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 7. +Use of strings with code points over 0xFF as arguments to bitwise or (|) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 8. +Use of strings with code points over 0xFF as arguments to bitwise xor (^) operator is deprecated. This will be a fatal error in Perl 5.28 at - line 9. diff --git a/t/lib/warnings/gv b/t/lib/warnings/gv index 8a93f8b..c8e2b89 100644 --- a/t/lib/warnings/gv +++ b/t/lib/warnings/gv @@ -46,7 +46,7 @@ fred() ; my $x = \&barney; (bless[])->barney; EXPECT -Use of inherited AUTOLOAD for non-method main::fred() is deprecated at - line 5. +Use of inherited AUTOLOAD for non-method main::fred() is deprecated. This will be fatal in Perl 5.28 at - line 5. ######## # gv.c use utf8; @@ -56,7 +56,7 @@ sub Oᕞʀ::AUTOLOAD { 1 } sub Oᕞʀ::fᕃƌ {} use warnings 'deprecated' ; fᕃƌ() ; EXPECT -Use of inherited AUTOLOAD for non-method main::fᕃƌ() is deprecated at - line 7. +Use of inherited AUTOLOAD for non-method main::fᕃƌ() is deprecated. This will be fatal in Perl 5.28 at - line 7. ######## # gv.c $a = ${"#"}; @@ -65,8 +65,8 @@ no warnings 'deprecated' ; $a = ${"#"}; $a = ${"*"}; EXPECT -$# is no longer supported at - line 2. -$* is no longer supported at - line 3. +$# is no longer supported. Its use will be fatal in Perl 5.30 at - line 2. +$* is no longer supported. Its use will be fatal in Perl 5.30 at - line 3. ######## # gv.c $a = ${#}; @@ -75,8 +75,8 @@ no warnings 'deprecated' ; $a = ${#}; $a = ${*}; EXPECT -$# is no longer supported at - line 2. -$* is no longer supported at - line 3. +$# is no longer supported. Its use will be fatal in Perl 5.30 at - line 2. +$* is no longer supported. Its use will be fatal in Perl 5.30 at - line 3. ######## # gv.c $a = $#; @@ -93,12 +93,12 @@ $* = $a; $a = \$#; $a = \$*; EXPECT -$# is no longer supported at - line 2. -$* is no longer supported at - line 3. -$# is no longer supported at - line 4. -$* is no longer supported at - line 5. -$# is no longer supported at - line 6. -$* is no longer supported at - line 7. +$# is no longer supported. Its use will be fatal in Perl 5.30 at - line 2. +$* is no longer supported. Its use will be fatal in Perl 5.30 at - line 3. +$# is no longer supported. Its use will be fatal in Perl 5.30 at - line 4. +$* is no longer supported. Its use will be fatal in Perl 5.30 at - line 5. +$# is no longer supported. Its use will be fatal in Perl 5.30 at - line 6. +$* is no longer supported. Its use will be fatal in Perl 5.30 at - line 7. ######## # gv.c @a = @#; @@ -106,8 +106,8 @@ $* is no longer supported at - line 7. $a = $#; $a = $*; EXPECT -$# is no longer supported at - line 4. -$* is no longer supported at - line 5. +$# is no longer supported. Its use will be fatal in Perl 5.30 at - line 4. +$* is no longer supported. Its use will be fatal in Perl 5.30 at - line 5. ######## # gv.c $a = $#; @@ -115,8 +115,8 @@ $a = $*; @a = @#; @a = @*; EXPECT -$# is no longer supported at - line 2. -$* is no longer supported at - line 3. +$# is no longer supported. Its use will be fatal in Perl 5.30 at - line 2. +$* is no longer supported. Its use will be fatal in Perl 5.30 at - line 3. ######## # gv.c $a = ${^ENCODING}; @@ -124,7 +124,7 @@ $a = ${^E_NCODING}; ${^ENCODING} = 1; ${^E_NCODING} = 1; # We pretend this variable never existed. EXPECT -${^ENCODING} is no longer supported at - line 4. +${^ENCODING} is no longer supported. Its use will be fatal in Perl 5.28 at - line 4. ######## # gv.c use warnings 'syntax' ; diff --git a/t/lib/warnings/mg b/t/lib/warnings/mg index 5fe2a88..7fdefc2 100644 --- a/t/lib/warnings/mg +++ b/t/lib/warnings/mg @@ -3,7 +3,7 @@ No such signal: SIG%s $SIG{FRED} = sub {} - Setting $/ to a reference to zero as a form of slurp is deprecated, treating as undef + Setting $/ to a reference to zero as a form of slurp is deprecated, treating as undef. This will be fatal in Perl 5.28 SIG%s handler \"%s\" not defined. $SIG{"INT"} = "ok3"; kill "INT",$$; @@ -25,19 +25,19 @@ EXPECT # warnable code, warnings enabled via command line switch $/ = \0; EXPECT -Setting $/ to a reference to zero as a form of slurp is deprecated, treating as undef at - line 3. +Setting $/ to a reference to zero as a form of slurp is deprecated, treating as undef. This will be fatal in Perl 5.28 at - line 3. ######## -w # warnable code, warnings enabled via command line switch $/ = \-1; EXPECT -Setting $/ to a reference to a negative integer as a form of slurp is deprecated, treating as undef at - line 3. +Setting $/ to a reference to a negative integer as a form of slurp is deprecated, treating as undef. This will be fatal in Perl 5.28 at - line 3. ######## $/ = \-1; no warnings 'deprecated'; $/ = \-1; EXPECT -Setting $/ to a reference to a negative integer as a form of slurp is deprecated, treating as undef at - line 1. +Setting $/ to a reference to a negative integer as a form of slurp is deprecated, treating as undef. This will be fatal in Perl 5.28 at - line 1. ######## # mg.c use warnings 'signal' ; @@ -110,5 +110,5 @@ ${^ENCODING} = 42; ${^ENCODING} = undef; { local ${^ENCODING} = 37; } EXPECT -${^ENCODING} is no longer supported at - line 1. -${^ENCODING} is no longer supported at - line 4. +${^ENCODING} is no longer supported. Its use will be fatal in Perl 5.28 at - line 1. +${^ENCODING} is no longer supported. Its use will be fatal in Perl 5.28 at - line 4. diff --git a/t/lib/warnings/op b/t/lib/warnings/op index e8d93e8..46885e2 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -167,9 +167,13 @@ use warnings 'syntax' ; @a{--$_}; @a[$_]; @a[--$_]; +delete @a[$x]; +delete @a{$x}; no warnings 'syntax' ; @a[3]; @a{3}; +delete @a[$x]; +delete @a{$x}; EXPECT Scalar value @a[3] better written as $a[3] at - line 3. Scalar value @a{3} better written as $a{3} at - line 4. @@ -181,6 +185,8 @@ Scalar value @a{...} better written as $a{...} at - line 9. Scalar value @a{...} better written as $a{...} at - line 10. Scalar value @a[...] better written as $a[...] at - line 11. Scalar value @a[...] better written as $a[...] at - line 12. +Scalar value @a[...] better written as $a[...] at - line 13. +Scalar value @a{...} better written as $a{...} at - line 14. ######## # op.c use utf8; @@ -1766,13 +1772,13 @@ if (my $w2) { $a=1 } if ($a && (my $w3 = 1)) {$a = 2} EXPECT -Deprecated use of my() in false conditional at - line 2. -Deprecated use of my() in false conditional at - line 3. -Deprecated use of my() in false conditional at - line 4. -Deprecated use of my() in false conditional at - line 5. -Deprecated use of my() in false conditional at - line 6. -Deprecated use of my() in false conditional at - line 7. -Deprecated use of my() in false conditional at - line 8. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 2. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 3. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 4. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 5. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 6. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 7. +Deprecated use of my() in false conditional. This will be a fatal error in Perl 5.30 at - line 8. ######## # op.c $[ = 1; diff --git a/t/lib/warnings/pp b/t/lib/warnings/pp index 3eef12a..27629a7 100644 --- a/t/lib/warnings/pp +++ b/t/lib/warnings/pp @@ -21,7 +21,7 @@ Constant subroutine (anonymous) undefined $foo = sub () { 3 }; undef &$foo; - Use of strings with code points over 0xFF as arguments to 1's complement (~) operator is deprecated + Use of strings with code points over 0xFF as arguments to 1's complement (~) operator is deprecated. This will be a fatal error in Perl 5.28 Invalid negative number (%s) in chr @@ -138,8 +138,8 @@ $_ = ~ "\xff"; $_ = ~ "\x{100}"; EXPECT OPTION regex -Use of strings with code points over 0xFF as arguments to 1's complement \(~\) operator is deprecated at - line \d+. -Use of code point 0xFF+EFF is deprecated; the permissible max is 0x7F+ at - line \d+. +Use of strings with code points over 0xFF as arguments to 1's complement \(~\) operator is deprecated. This will be a fatal error in Perl 5.28 at - line \d+. +Use of code point 0xFF+EFF is deprecated; the permissible max is 0x7F+\. This will be fatal in Perl 5\.28 at - line \d+. ######## # NAME chr -1 use warnings 'utf8'; diff --git a/t/lib/warnings/pp_sys b/t/lib/warnings/pp_sys index b1451b1..9c544e0 100644 --- a/t/lib/warnings/pp_sys +++ b/t/lib/warnings/pp_sys @@ -771,8 +771,8 @@ no warnings qw(io deprecated); open FOO, "../harness"; open $foo, "../harness"; EXPECT -Opening dirhandle FOO also as a file at - line 5. -Opening dirhandle $foo also as a file at - line 6. +Opening dirhandle FOO also as a file. This will be a fatal error in Perl 5.28 at - line 5. +Opening dirhandle $foo also as a file. This will be a fatal error in Perl 5.28 at - line 6. ######## # pp_sys.c [pp_open] @@ -787,8 +787,8 @@ no warnings qw(io deprecated); open ＦＯＯ, "../harness"; open $ｆｏｏ, "../harness"; EXPECT -Opening dirhandle ＦＯＯ also as a file at - line 8. -Opening dirhandle $ｆｏｏ also as a file at - line 9. +Opening dirhandle ＦＯＯ also as a file. This will be a fatal error in Perl 5.28 at - line 8. +Opening dirhandle $ｆｏｏ also as a file. This will be a fatal error in Perl 5.28 at - line 9. ######## # pp_sys.c [pp_open_dir] use warnings; @@ -800,8 +800,8 @@ no warnings qw(io deprecated); opendir FOO, "."; opendir $foo, "."; EXPECT -Opening filehandle FOO also as a directory at - line 5. -Opening filehandle $foo also as a directory at - line 6. +Opening filehandle FOO also as a directory. This will be a fatal error in Perl 5.28 at - line 5. +Opening filehandle $foo also as a directory. This will be a fatal error in Perl 5.28 at - line 6. ######## # pp_sys.c [pp_open_dir] @@ -817,8 +817,8 @@ no warnings qw(io deprecated); opendir ＦＯＯ, "."; opendir $ｆｏｏ, "."; EXPECT -Opening filehandle ＦＯＯ also as a directory at - line 9. -Opening filehandle $ｆｏｏ also as a directory at - line 10. +Opening filehandle ＦＯＯ also as a directory. This will be a fatal error in Perl 5.28 at - line 9. +Opening filehandle $ｆｏｏ also as a directory. This will be a fatal error in Perl 5.28 at - line 10. ######## # pp_sys.c [pp_*dir] use Config ; @@ -958,7 +958,7 @@ sysread $fh, $buf, 10; no warnings 'deprecated'; sysread $fh, $buf, 10; EXPECT -sysread() is deprecated on :utf8 handles at - line 5. +sysread() is deprecated on :utf8 handles. This will be a fatal error in Perl 5.30 at - line 5. ######## # NAME syswrite() deprecated on :utf8 my $file = "syswwarn.tmp"; @@ -971,4 +971,4 @@ syswrite $fh, 'ABC'; close $fh; unlink $file; EXPECT -syswrite() is deprecated on :utf8 handles at - line 5. +syswrite() is deprecated on :utf8 handles. This will be a fatal error in Perl 5.30 at - line 5. diff --git a/t/lib/warnings/regcomp b/t/lib/warnings/regcomp index 08cb27b..44ef5c3 100644 --- a/t/lib/warnings/regcomp +++ b/t/lib/warnings/regcomp @@ -31,12 +31,12 @@ BEGIN { use warnings; $a = qr/\c,/; $a = qr/[\c,]/; -no warnings 'syntax'; +no warnings 'syntax', 'deprecated'; $a = qr/\c,/; $a = qr/[\c,]/; EXPECT -"\c," is more clearly written simply as "l" at - line 9. -"\c," is more clearly written simply as "l" at - line 10. +"\c," is more clearly written simply as "l". This will be a fatal error in Perl 5.28 at - line 9. +"\c," is more clearly written simply as "l". This will be a fatal error in Perl 5.28 at - line 10. ######## # This is because currently a different error is output under # use re 'strict', so can't go in reg_mesg.t @@ -93,11 +93,11 @@ no warnings 'deprecated'; qr/[\N{}]/; qr/\N{}/; EXPECT -Unknown charname '' is deprecated at - line 2. +Unknown charname '' is deprecated. Its use will be fatal in Perl 5.28 at - line 2. Ignoring zero length \N{} in character class in regex; marked by <-- HERE in m/[\N{} <-- HERE ]/ at - line 2. -Unknown charname '' is deprecated at - line 3. -Unknown charname '' is deprecated at - line 5. -Unknown charname '' is deprecated at - line 6. +Unknown charname '' is deprecated. Its use will be fatal in Perl 5.28 at - line 3. +Unknown charname '' is deprecated. Its use will be fatal in Perl 5.28 at - line 5. +Unknown charname '' is deprecated. Its use will be fatal in Perl 5.28 at - line 6. ######## # NAME [perl #123417] # OPTION fatal @@ -106,7 +106,7 @@ no warnings 'experimental::re_strict'; use re 'strict'; qr/[\N{}]/; EXPECT -Unknown charname '' is deprecated at - line 5. +Unknown charname '' is deprecated. Its use will be fatal in Perl 5.28 at - line 5. Zero length \N{} in regex; marked by <-- HERE in m/[\N{} <-- HERE ]/ at - line 5. ######## # NAME [perl #123417] @@ -116,5 +116,5 @@ no warnings 'experimental::re_strict'; use re 'strict'; qr/\N{}/; EXPECT -Unknown charname '' is deprecated at - line 5. +Unknown charname '' is deprecated. Its use will be fatal in Perl 5.28 at - line 5. Zero length \N{} in regex; marked by <-- HERE in m/\N{} <-- HERE / at - line 5. diff --git a/t/lib/warnings/sv b/t/lib/warnings/sv index ee0fdc2..64f624c 100644 --- a/t/lib/warnings/sv +++ b/t/lib/warnings/sv @@ -341,10 +341,13 @@ Invalid conversion in sprintf: "%+2L\003" at - line 19. # sv.c use warnings 'misc' ; *a = undef ; +(*c) = (); no warnings 'misc' ; *b = undef ; +(*d) = (); EXPECT Undefined value assigned to typeglob at - line 3. +Undefined value assigned to typeglob at - line 4. ######## # sv.c use warnings 'numeric' ; diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index 1eb9f2e..fe8adc5 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -4,7 +4,7 @@ toke.c AOK $a = <<; - Use of comma-less variable list is deprecated + Use of comma-less variable list is deprecated. Its use will be fatal in Perl 5.28 (called 3 times via depcom) \1 better written as $1 @@ -136,9 +136,9 @@ format STDOUT = $a $b "abc" 'def' . EXPECT -Use of comma-less variable list is deprecated at - line 4. -Use of comma-less variable list is deprecated at - line 4. -Use of comma-less variable list is deprecated at - line 4. +Use of comma-less variable list is deprecated. Its use will be fatal in Perl 5.28 at - line 4. +Use of comma-less variable list is deprecated. Its use will be fatal in Perl 5.28 at - line 4. +Use of comma-less variable list is deprecated. Its use will be fatal in Perl 5.28 at - line 4. ######## # toke.c $a = <<; @@ -147,7 +147,7 @@ no warnings 'deprecated' ; $a = <<; EXPECT -Use of bare << to mean <<"" is deprecated at - line 2. +Use of bare << to mean <<"" is deprecated. Its use will be fatal in Perl 5.28 at - line 2. ######## # toke.c $a = <<~; @@ -155,8 +155,8 @@ $a = <<~; $a = <<~ ; EXPECT -Use of bare << to mean <<"" is deprecated at - line 2. -Use of bare << to mean <<"" is deprecated at - line 4. +Use of bare << to mean <<"" is deprecated. Its use will be fatal in Perl 5.28 at - line 2. +Use of bare << to mean <<"" is deprecated. Its use will be fatal in Perl 5.28 at - line 4. ######## # toke.c $a =~ m/$foo/eq; @@ -677,6 +677,34 @@ _123 12340000000000 ######## # toke.c +use warnings 'syntax'; +$a = 1_; print "$a\n"; +$a = 01_; print "$a\n"; +$a = 0_; print "$a\n"; +$a = 0x1_; print "$a\n"; +$a = 0x_; print "$a\n"; +$a = 1.2_; print "$a\n"; +$a = 1._2; print "$a\n"; +$a = 1._; print "$a\n"; +EXPECT +Misplaced _ in number at - line 3. +Misplaced _ in number at - line 4. +Misplaced _ in number at - line 5. +Misplaced _ in number at - line 6. +Misplaced _ in number at - line 7. +Misplaced _ in number at - line 8. +Misplaced _ in number at - line 9. +Misplaced _ in number at - line 10. +1 +1 +0 +1 +0 +1.2 +1.2 +1 +######## +# toke.c use warnings 'bareword' ; #line 25 "bar" $a = FRED:: ; @@ -1078,11 +1106,28 @@ Integer overflow in octal number at - line 11. ######## # toke.c BEGIN { $^C = 1; } +dump; +CORE::dump; +EXPECT +dump() better written as CORE::dump(). dump() will no longer be available in Perl 5.30 at - line 3. +- syntax OK +######## +# toke.c +BEGIN { $^C = 1; } +no warnings 'deprecated'; +dump; +CORE::dump; +EXPECT +- syntax OK +######## +# toke.c +BEGIN { $^C = 1; } +no warnings 'deprecated'; use warnings 'misc'; dump; CORE::dump; EXPECT -dump() better written as CORE::dump() at - line 4. +dump() better written as CORE::dump(). dump() will no longer be available in Perl 5.30 at - line 5. - syntax OK ######## # toke.c @@ -1236,10 +1281,10 @@ sub ker_plop :locked { sub swa_a_p ($) : locked { } EXPECT -Use of :unique is deprecated at - line 2. -Use of :locked is deprecated at - line 3. -Use of :locked is deprecated at - line 4. -Use of :locked is deprecated at - line 6. +Attribute "unique" is deprecated, and will disappear in Perl 5.28 at - line 2. +Attribute "locked" is deprecated, and will disappear in Perl 5.28 at - line 3. +Attribute "locked" is deprecated, and will disappear in Perl 5.28 at - line 4. +Attribute "locked" is deprecated, and will disappear in Perl 5.28 at - line 6. ######## # toke.c use warnings "syntax"; @@ -1340,12 +1385,12 @@ BEGIN { use warnings; $a = "\c,"; $a = "\c`"; -no warnings 'syntax'; +no warnings 'syntax', 'deprecated'; $a = "\c,"; $a = "\c`"; EXPECT -"\c," is more clearly written simply as "l" at - line 9. -"\c`" is more clearly written simply as "\ " at - line 10. +"\c," is more clearly written simply as "l". This will be a fatal error in Perl 5.28 at - line 9. +"\c`" is more clearly written simply as "\ ". This will be a fatal error in Perl 5.28 at - line 10. ######## # toke.c BEGIN { @@ -1563,3 +1608,15 @@ print (...) interpreted as function at - line 3. print (...) interpreted as function at - line 4. ) )) +######## +# NAME Non-grapheme delimiters +BEGIN{ + if (ord('A') == 193) { + print "SKIPPED\n# ebcdic platforms generates different Malformed UTF-8 warnings."; + exit 0; + } +} +use utf8; +my $a = qr ̂foobar̂; +EXPECT +Use of unassigned code point or non-standalone grapheme for a delimiter will be a fatal error starting in Perl v5.30 at - line 8. diff --git a/t/lib/warnings/utf8 b/t/lib/warnings/utf8 index dded118..af04d4c 100644 --- a/t/lib/warnings/utf8 +++ b/t/lib/warnings/utf8 @@ -15,6 +15,7 @@ __END__ # utf8.c [utf8_to_uvchr_buf] -W +# NAME Malformed under 'use utf8' in double-quoted string BEGIN { if (ord('A') == 193) { print "SKIPPED\n# ebcdic platforms generates different Malformed UTF-8 warnings."; @@ -22,16 +23,25 @@ BEGIN { } } use utf8 ; +no warnings; # Malformed is a fatal error, so gets output anyway. my $a = "snøstorm" ; -{ - no warnings 'utf8' ; - my $a = "snøstorm"; - use warnings 'utf8' ; - my $a = "snøstorm"; +EXPECT +Malformed UTF-8 character: \xf8\x73\x74\x6f\x72 (unexpected non-continuation byte 0x73, immediately after start byte 0xf8; need 5 bytes, got 1) at - line 10. +Malformed UTF-8 character (fatal) at - line 10. +######## +# NAME Malformed under 'use utf8' in single-quoted string +BEGIN { + if (ord('A') == 193) { + print "SKIPPED\n# ebcdic platforms generates different Malformed UTF-8 warnings."; + exit 0; + } } +use utf8 ; +no warnings; # Malformed is a fatal error, so gets output anyway. +my $a = 'snøstorm' ; EXPECT Malformed UTF-8 character: \xf8\x73\x74\x6f\x72 (unexpected non-continuation byte 0x73, immediately after start byte 0xf8; need 5 bytes, got 1) at - line 9. -Malformed UTF-8 character: \xf8\x73\x74\x6f\x72 (unexpected non-continuation byte 0x73, immediately after start byte 0xf8; need 5 bytes, got 1) at - line 14. +Malformed UTF-8 character (fatal) at - line 9. ######## use warnings 'utf8'; my $d7ff = uc(chr(0xD7FF)); @@ -746,17 +756,18 @@ print $fh $to_warn_char, "\n"; close $fh; EXPECT OPTION regex -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ in pattern match \(m//\) at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ in regexp compilation at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ in regexp compilation at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ in regexp compilation at - line \d+. +Use of code point 0x80+ is deprecated; the permissible max is 0x7F+\. This will be fatal in Perl 5\.28 at - line \d+. +Use of code point 0x80+ is deprecated; the permissible max is 0x7F+\. This will be fatal in Perl 5\.28 in pattern match \(m//\) at - line \d+. +Use of code point 0x80+ is deprecated; the permissible max is 0x7F+\. This will be fatal in Perl 5\.28 in regexp compilation at - line \d+. +Use of code point 0x80+ is deprecated; the permissible max is 0x7F+\. This will be fatal in Perl 5\.28 in regexp compilation at - line \d+. +Use of code point 0x80+ is deprecated; the permissible max is 0x7F+\. This will be fatal in Perl 5\.28 at - line \d+. +Use of code point 0x80+ is deprecated; the permissible max is 0x7F+\. This will be fatal in Perl 5\.28 in regexp compilation at - line \d+. Operation "uc" returns its argument for non-Unicode code point 0x7F+ at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ at - line \d+. +Use of code point 0x80+ is deprecated; the permissible max is 0x7F+\. This will be fatal in Perl 5\.28 in uc at - line \d+. +Use of code point 0x80+ is deprecated; the permissible max is 0x7F+\. This will be fatal in Perl 5\.28 at - line \d+. Operation "uc" returns its argument for non-Unicode code point 0x80+ at - line \d+. Code point 0x7F+ is not Unicode, may not be portable in print at - line \d+. -Use of code point 0x80+ is deprecated; the permissible max is 0x7F+ in print at - line \d+. +Use of code point 0x80+ is deprecated; the permissible max is 0x7F+\. This will be fatal in Perl 5\.28 in print at - line \d+. ######## # NAME [perl #127262] BEGIN{ diff --git a/t/loc_tools.pl b/t/loc_tools.pl index 50b36d5..4b99c45 100644 --- a/t/loc_tools.pl +++ b/t/loc_tools.pl @@ -59,7 +59,7 @@ sub _trylocale ($$$$) { # For use only by other functions in this file! # Adds the locale given by the first parameter to the list given by the # 3rd iff the platform supports the locale in each of the category numbers # given by the 2nd parameter, which is either a single category or a - # reference to a list of categories. The list must be sorted so that + # reference to a list of categories. The list MUST be sorted so that # CTYPE is first, COLLATE is last unless ALL is present, in which case # that comes after COLLATE. This is because locale.c detects bad locales # only with CTYPE, and COLLATE on some platforms can core dump if it is a @@ -83,8 +83,8 @@ sub _trylocale ($$$$) { # For use only by other functions in this file! use warnings 'locale'; local $SIG{__WARN__} = sub { - $badutf8 = 1 if $_[0] =~ /Malformed UTF-8/; - $plays_well = 0 if $_[0] =~ /Locale .* may not work well/i + $badutf8 = 1 if grep { /Malformed UTF-8/ } @_; + $plays_well = 0 if grep { /Locale .* may not work well/i } @_; }; # Incompatible locales aren't warned about unless using locales. @@ -95,14 +95,14 @@ sub _trylocale ($$$$) { # For use only by other functions in this file! unless $category =~ / ^ -? \d+ $ /x; return unless setlocale($category, $locale); - return if ! $plays_well && ! $allow_incompatible; + last if $badutf8 || ! $plays_well; } if ($badutf8) { ok(0, "Verify locale name doesn't contain malformed utf8"); return; } - push @$list, $locale; + push @$list, $locale if $plays_well || $allow_incompatible; } sub _decode_encodings { # For use only by other functions in this file! @@ -299,7 +299,7 @@ sub find_locales ($;$) { delete local @ENV{qw(IFS CDPATH ENV BASH_ENV)}; if (-x "/usr/bin/locale" - && open(LOCALES, "/usr/bin/locale -a 2>/dev/null|")) + && open(LOCALES, '-|', "/usr/bin/locale -a 2>/dev/null")) { while () { # It seems that /usr/bin/locale steadfastly outputs 8 bit data, which diff --git a/t/op/attrs.t b/t/op/attrs.t index 6f7d014..c3cf439 100644 --- a/t/op/attrs.t +++ b/t/op/attrs.t @@ -52,7 +52,7 @@ like $@, qr/^Invalid SCALAR attribute: ["']?plugh["']? at/; eval '{my $x : plugh}'; like $@, qr/^Invalid SCALAR attribute: ["']?plugh["']? at/; eval '{my ($x,$y) : plugh(})}'; -like $@, qr/^Invalid SCALAR attribute: ["']?plugh\(}\)["']? at/; +like $@, qr/^Invalid SCALAR attribute: ["']?plugh\(\}\)["']? at/; # More syntax tests from the attributes manpage eval 'my $x : switch(10,foo(7,3)) : expensive;'; @@ -177,7 +177,8 @@ foreach my $value (\&foo, \$scalar, \@array, \%hash) { my $attribute = $negate . $attr; eval "use attributes __PACKAGE__, \$value, '$attribute'"; if ($deprecated{$type}{$attr}) { - like $@, qr/^Attribute "$attr" is deprecated at \(eval \d+\)/, + like $@, qr/^Attribute "$attr" is deprecated, (?#: + )and will disappear in Perl 5.28 at \(eval \d+\)/, "$type attribute $attribute deprecated"; } elsif ($valid{$type}{$attr}) { if ($attribute eq '-shared') { diff --git a/t/op/const-optree.t b/t/op/const-optree.t index b378d4a..4d897d2 100644 --- a/t/op/const-optree.t +++ b/t/op/const-optree.t @@ -432,7 +432,8 @@ for \%_ (@tests) { if (exists $_{deprecated}) { if ($_{deprecated}) { like $w, qr/^Constants from lexical variables potentially (?x: - )modified elsewhere are deprecated at /, + )modified elsewhere are deprecated\. This will (?x: + )not be allowed in Perl 5\.32 at /, "$nickname is deprecated"; } else { diff --git a/t/op/coreamp.t b/t/op/coreamp.t index c958654..4b68569 100644 --- a/t/op/coreamp.t +++ b/t/op/coreamp.t @@ -188,23 +188,23 @@ sub test_proto { my $more_args = $3 ? ',1' : ''; eval " &CORE::$o(2$more_args) "; like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x: - ) \[\Q$2\E] at /, + ) \[\Q$2\E\] at /, "&$o with non-ref arg"; eval " &CORE::$o(*STDOUT{IO}$more_args) "; like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x: - ) \[\Q$2\E] at /, + ) \[\Q$2\E\] at /, "&$o with ioref arg"; my $class = ref *DATA{IO}; eval " &CORE::$o(bless(*DATA{IO}, 'hov')$more_args) "; like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one of(?x: - ) \[\Q$2\E] at /, + ) \[\Q$2\E\] at /, "&$o with ioref arg with hash overload (which does not count)"; bless *DATA{IO}, $class; if (do {$2 !~ /&/}) { $tests++; eval " &CORE::$o(\\&scriggle$more_args) "; like $@, qr/^Type of arg 1 to &CORE::$o must be reference to one (?x: - )of \[\Q$2\E] at /, + )of \[\Q$2\E\] at /, "&$o with coderef arg"; } } diff --git a/t/op/dump.t b/t/op/dump.t index 6b53a06..2edba20 100644 --- a/t/op/dump.t +++ b/t/op/dump.t @@ -63,7 +63,13 @@ plan(2); # By do the dump in a child, the parent perl process exits back to sh with # a normal exit value, so sh won't complain. +# An unqualified dump() will give a deprecation warning. Usually, we'd +# do a "no warnings 'deprecated'" to shut this off, but since we have +# chdirred to /tmp, a 'no' won't find the pragma. Hence the fiddling with +# $SIG{__WARN__}. + fresh_perl_like(<<'PROG', qr/\AA(?!B\z)/, {}, "plain dump quits"); +BEGIN {$SIG {__WARN__} = sub {1;}} ++$|; my $pid = fork; die "fork: $!\n" unless defined $pid; @@ -80,6 +86,7 @@ else { PROG fresh_perl_like(<<'PROG', qr/A(?!B\z)/, {}, "dump with label quits"); +BEGIN {$SIG {__WARN__} = sub {1;}} ++$|; my $pid = fork; die "fork: $!\n" unless defined $pid; diff --git a/t/op/heredoc.t b/t/op/heredoc.t index 15b12d9..5166159 100644 --- a/t/op/heredoc.t +++ b/t/op/heredoc.t @@ -102,7 +102,7 @@ HEREDOC fresh_perl_like( qq(<<\n\$ \n), # valgrind and asan reports an error between these two lines - qr/^Use of bare << to mean <<"" is deprecated at - line 1\.\s+Final \$/, + qr/^Use of bare << to mean <<"" is deprecated\. Its use will be fatal in Perl 5\.28 at - line 1\.\s+Final \$/, {}, "don't use an invalid oldoldbufptr (some more)" ); diff --git a/t/op/lex.t b/t/op/lex.t index bd6bb0f..e50f0eb 100644 --- a/t/op/lex.t +++ b/t/op/lex.t @@ -254,8 +254,9 @@ SKIP: or skip "These tests won't work on EBCIDIC", 3; fresh_perl_is( "BEGIN{\$^H=hex ~0}\xF3", - "Integer overflow in hexadecimal number at - line 1.\n" . - "Malformed UTF-8 character: \\xf3 (too short; 1 byte available, need 4) at - line 1.", + "Integer overflow in hexadecimal number at - line 1.\n" + . "Malformed UTF-8 character: \\xf3 (too short; 1 byte available, need 4) at - line 1.\n" + . "Malformed UTF-8 character (fatal) at - line 1.", {}, '[perl #128996] - use of PL_op after op is freed' ); @@ -267,7 +268,7 @@ SKIP: ); fresh_perl_like( qq(BEGIN{\$^H=0x800000}\n 0m 0\xB5\xB500\xB5\0), - qr/Unrecognized character \\x\{0\}; marked by <-- HERE after 0m.*<-- HERE near column 12 at - line 2./, + qr/Malformed UTF-8 character: \\xb5 \(unexpected continuation byte 0xb5, with no preceding start byte\)/, {}, '[perl #129000] read before buffer' ); diff --git a/t/op/method.t b/t/op/method.t index 8795734..ef181c4 100644 --- a/t/op/method.t +++ b/t/op/method.t @@ -13,7 +13,7 @@ BEGIN { use strict; no warnings 'once'; -plan(tests => 150); +plan(tests => 151); @A::ISA = 'B'; @B::ISA = 'C'; @@ -704,6 +704,13 @@ SKIP: { "check unknown import() methods don't corrupt the stack"); } +# RT#130496: assertion failure when looking for a method of undefined name +# on an unblessed reference +fresh_perl_is('eval { {}->$x }; print $@;', + "Can't call method \"\" on unblessed reference at - line 1.", + {}, + "no crash with undef method name on unblessed ref"); + __END__ #FF9900 #F78C08 diff --git a/t/op/pack.t b/t/op/pack.t index 3fc12e4..919e4c5 100644 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -12,7 +12,7 @@ my $no_endianness = $] > 5.009 ? '' : my $no_signedness = $] > 5.009 ? '' : "Signed/unsigned pack modifiers not available on this perl"; -plan tests => 14712; +plan tests => 14713; use strict; use warnings qw(FATAL all); @@ -2047,3 +2047,15 @@ ok(1, "argument underflow did not crash"); is(pack("H40", $up_nul), $twenty_nuls, "check pack H zero fills (utf8 source)"); } + +SKIP: +{ + # [perl #129149] the code below would write one past the end of the output + # buffer, only detected by ASAN, not by valgrind + $Config{ivsize} >= 8 + or skip "[perl #129149] need 64-bit for this test", 1; + fresh_perl_is(<<'EOS', "ok\n", { stderr => 1 }, "pack W overflow"); +print pack("ucW", "0000", 0, 140737488355327) eq "\$,#`P,```\n\0\x{7fffffffffff}" + ? "ok\n" : "not ok\n"; +EOS +} diff --git a/t/op/range.t b/t/op/range.t index f30fa8d..e58a39c 100644 --- a/t/op/range.t +++ b/t/op/range.t @@ -9,7 +9,7 @@ BEGIN { use Config; -plan (141); +plan (145); is(join(':',1..5), '1:2:3:4:5'); @@ -42,6 +42,20 @@ is($x, 'abcdefghijklmnopqrstuvwxyz'); @x = 'A'..'ZZ'; is (scalar @x, 27 * 26); +foreach (0, 1) { + use feature 'unicode_strings'; + $s = "a"; + $e = "\xFF"; + utf8::upgrade($e) if $_; + @x = $s .. $e; + is (scalar @x, 26, "list-context range with rhs 0xFF, utf8=$_"); + @y = (); + foreach ($s .. $e) { + push @y, $_; + } + is(join(",", @y), join(",", @x), "foreach range with rhs 0xFF, utf8=$_"); +} + @x = '09' .. '08'; # should produce '09', '10',... '99' (strange but true) is(join(",", @x), join(",", map {sprintf "%02d",$_} 9..99)); diff --git a/t/op/sort.t b/t/op/sort.t index cd1c6eb..96fad1c 100644 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -7,7 +7,7 @@ BEGIN { set_up_inc('../lib'); } use warnings; -plan(tests => 196); +plan(tests => 197); # these shouldn't hang { @@ -1147,3 +1147,16 @@ pass "no crash when sort block deletes *a and *b"; @a = sort { *a = sub { 1 }; $a <=> $b } 0 .. 1; ok(a(), "*a wasn't localized inadvertantly"); } + +SKIP: +{ + eval { require Config; 1 } + or skip "Cannot load Config", 1; + $Config::Config{ivsize} == 8 + or skip "this test can only fail with 64-bit integers", 1; + # sort's built-in numeric comparison wasn't careful enough in a world + # of integers with more significant digits than NVs + my @in = ( "0", "20000000000000001", "20000000000000000" ); + my @out = sort { $a <=> $b } @in; + is($out[1], "20000000000000000", "check sort order"); +} diff --git a/t/op/split.t b/t/op/split.t index ceaea00..d60bcaf 100644 --- a/t/op/split.t +++ b/t/op/split.t @@ -7,7 +7,7 @@ BEGIN { set_up_inc('../lib'); } -plan tests => 161; +plan tests => 163; $FS = ':'; @@ -621,3 +621,15 @@ is "@a", '1 2 3', 'assignment to split-to-array (stacked)'; ok eval { $a[0] = 'a'; 1; }, "array split filling AvARRAY: assign 0"; is "@a", "a b", "array split filling AvARRAY: result"; } + +# splitting an empty utf8 string gave an assert failure +{ + my $s = "\x{100}"; + chop $s; + my @a = split ' ', $s; + is (+@a, 0, "empty utf8 string"); +} + +fresh_perl_is(<<'CODE', '', {}, "scalar split stack overflow"); +map{int"";split//.0>60for"0000000000000000"}split// for"00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" +CODE diff --git a/t/op/stat.t b/t/op/stat.t index 4df4ac7..323c498 100644 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -43,10 +43,11 @@ $Is_Solaris = $^O eq 'solaris'; $Is_VMS = $^O eq 'VMS'; $Is_MPRAS = $^O =~ /svr4/ && -f '/etc/.relid'; $Is_Android = $^O =~ /android/; +$Is_Dfly = $^O eq 'dragonfly'; $Is_Dosish = $Is_Dos || $Is_OS2 || $Is_MSWin32 || $Is_NetWare; -$Is_UFS = $Is_Darwin && (() = `df -t ufs . 2>/dev/null`) == 2; +$ufs_no_ctime = ($Is_Dfly || $Is_Darwin) && (() = `df -t ufs . 2>/dev/null`) == 2; if ($Is_Cygwin && !is_miniperl) { require Win32; @@ -141,8 +142,7 @@ SKIP: { # no ctime concept $ctime is ALWAYS == $mtime # expect netware to be the same ... skip "No ctime concept on this OS", 2 - if $Is_MSWin32 || - ($Is_Darwin && $Is_UFS); + if $Is_MSWin32 || $ufs_no_ctime; if( !ok($mtime, 'hard link mtime') || !isnt($mtime, $ctime, 'hard link ctime != mtime') ) { @@ -151,8 +151,8 @@ SKIP: { # has this problem. Building on the ClearCase VOBS filesystem may also # cause this failure. # -# Darwin's UFS doesn't have a ctime concept, and thus is expected to fail -# this test. +# Some UFS implementations don't have a ctime concept, and thus are +# expected to fail this test. DIAG } } diff --git a/t/op/taint.t b/t/op/taint.t index 4d69498..c13eaf6 100644 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -152,7 +152,7 @@ my $TEST = 'TEST'; while (my $v = $vars[0]) { local $ENV{$v} = $TAINT; last if eval { `$echo 1` }; - last unless $@ =~ /^Insecure \$ENV\{$v}/; + last unless $@ =~ /^Insecure \$ENV\{$v\}/; shift @vars; } is("@vars", ""); @@ -163,7 +163,7 @@ my $TEST = 'TEST'; is(eval { `$echo 1` }, "1\n"); $ENV{TERM} = 'e=mc2' . $TAINT; is(eval { `$echo 1` }, undef); - like($@, qr/^Insecure \$ENV\{TERM}/); + like($@, qr/^Insecure \$ENV\{TERM\}/); } my $tmp; @@ -184,7 +184,7 @@ my $TEST = 'TEST'; is(eval { `$echo 1` }, undef); # Message can be different depending on whether echo # is a builtin or not - like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/); + like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH\}/); } # Relative paths in $ENV{PATH} are always implicitly tainted. @@ -194,13 +194,13 @@ my $TEST = 'TEST'; local $ENV{PATH} = '.'; is(eval { `$echo 1` }, undef); - like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/); + like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH\}/); # Backslash should not fool perl into thinking that this is one # path. local $ENV{PATH} = '/\:.'; is(eval { `$echo 1` }, undef); - like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH}/); + like($@, qr/^Insecure (?:directory in )?\$ENV\{PATH\}/); } SKIP: { @@ -208,14 +208,14 @@ my $TEST = 'TEST'; $ENV{'DCL$PATH'} = $TAINT; is(eval { `$echo 1` }, undef); - like($@, qr/^Insecure \$ENV\{DCL\$PATH}/); + like($@, qr/^Insecure \$ENV\{DCL\$PATH\}/); SKIP: { skip q[can't find world-writeable directory to test DCL$PATH], 2 unless $tmp; $ENV{'DCL$PATH'} = $tmp; is(eval { `$echo 1` }, undef); - like($@, qr/^Insecure directory in \$ENV\{DCL\$PATH}/); + like($@, qr/^Insecure directory in \$ENV\{DCL\$PATH\}/); } $ENV{'DCL$PATH'} = ''; } @@ -2246,7 +2246,7 @@ end ok("A" =~ /\p{$prop}/, "user-defined property: non-tainted case"); $prop = "IsA$TAINT"; eval { "A" =~ /\p{$prop}/}; - like($@, qr/Insecure user-defined property \\p\{main::IsA}/, + like($@, qr/Insecure user-defined property \\p\{main::IsA\}/, "user-defined property: tainted case"); } diff --git a/t/op/tr.t b/t/op/tr.t index 47acd9e..25c397d 100644 --- a/t/op/tr.t +++ b/t/op/tr.t @@ -13,7 +13,7 @@ BEGIN { use utf8; -plan tests => 166; +plan tests => 215; # 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. @@ -32,14 +32,17 @@ is($_, "abcdefghijklmnopqrstuvwxyz", 'lc'); tr/b-y/B-Y/; is($_, "aBCDEFGHIJKLMNOPQRSTUVWXYz", 'partial uc'); +tr/a-a/AB/; +is($_, "ABCDEFGHIJKLMNOPQRSTUVWXYz", 'single char range a-a'); + eval 'tr/a/\N{KATAKANA LETTER AINU P}/;'; like $@, - qr/\\N\{KATAKANA LETTER AINU P} must not be a named sequence in transliteration operator/, + qr/\\N\{KATAKANA LETTER AINU P\} must not be a named sequence in transliteration operator/, "Illegal to tr/// named sequence"; eval 'tr/\x{101}-\x{100}//;'; like $@, - qr/Invalid range "\\x\{0101}-\\x\{0100}" in transliteration operator/, + qr/Invalid range "\\x\{0101\}-\\x\{0100\}" in transliteration operator/, "UTF-8 range with min > max"; SKIP: { # Test literal range end point special handling @@ -656,4 +659,48 @@ for ("", nullrocow) { is($string, "A", 'tr// of \N{name} works for upper-Latin1'); } +# RT #130198 +# a tr/// that is cho(m)ped, possibly with an array as arg + +{ + use warnings; + + my ($s, @a); + + my $warn; + local $SIG{__WARN__ } = sub { $warn .= "@_" }; + + for my $c (qw(chop chomp)) { + for my $bind ('', '$s =~ ', '@a =~ ') { + for my $arg2 (qw(a b)) { + for my $r ('', 'r') { + $warn = ''; + # tr/a/b/ modifies its LHS, so if the LHS is an + # array, this should die. The special cases of tr/a/a/ + # and tr/a/b/r don't modify their LHS, so instead + # we croak because cho(m)p is trying to modify it. + # + my $exp = + ($r eq '' && $arg2 eq 'b' && $bind =~ /\@a/) + ? qr/Can't modify private array in transliteration/ + : qr{Can't modify transliteration \(tr///\) in $c}; + + my $expr = "$c(${bind}tr/a/$arg2/$r);"; + eval $expr; + like $@, $exp, "RT #130198 eval: $expr"; + + $exp = + $bind =~ /\@a/ + ? qr{^Applying transliteration \(tr///\) to \@a will act on scalar\(\@a\)} + : qr/^$/; + like $warn, $exp, "RT #130198 warn: $expr"; + } + } + } + } + + +} + + 1; diff --git a/t/op/write.t b/t/op/write.t index 93f70fa..3172681 100644 --- a/t/op/write.t +++ b/t/op/write.t @@ -98,7 +98,7 @@ for my $tref ( @NumTests ){ my $bas_tests = 21; # number of tests in section 3 -my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 4 + 2 + 3 + 96 + 11 + 4; +my $bug_tests = 66 + 3 * 3 * 5 * 2 * 3 + 2 + 66 + 6 + 2 + 3 + 96 + 11 + 4; # number of tests in section 4 my $hmb_tests = 37; @@ -1637,6 +1637,23 @@ printf ">%s<\n", ref $zamm; print "$zamm->[0]\n"; EOP +# [perl #129125] - detected by -fsanitize=address or valgrind +# the compiled format would be freed when the format string was modified +# by the chop operator +fresh_perl_is(<<'EOP', "^", { stderr => 1 }, '#129125 - chop on format'); +my $x = '^@'; +formline$x=>$x; +print $^A; +EOP + +fresh_perl_is(<<'EOP', '<^< xx AA><>', { stderr => 1 }, '#129125 - chop on format, later values'); +my $x = '^< xx ^<'; +my $y = 'AA'; +formline $x => $x, $y; +print "<$^A><$x><$y>"; +EOP + + # [perl #73690] select +(select(RT73690), do { diff --git a/t/perf/benchmarks b/t/perf/benchmarks index ac69850..233f1fb 100644 --- a/t/perf/benchmarks +++ b/t/perf/benchmarks @@ -301,6 +301,18 @@ code => 'exists $h{$k1}{$k2}', }, + 'expr::hash::bool_empty' => { + desc => 'empty lexical hash in boolean context', + setup => 'my %h;', + code => '!%h', + }, + 'expr::hash::bool_full' => { + desc => 'non-empty lexical hash in boolean context', + setup => 'my %h = 1..10;', + code => '!%h', + }, + + ( map { sprintf('expr::hash::notexists_lex_keylen%04d',$_) => { diff --git a/t/perf/optree.t b/t/perf/optree.t index 49959ce..f939aff 100644 --- a/t/perf/optree.t +++ b/t/perf/optree.t @@ -3,6 +3,9 @@ # Use B to test that optimisations are not inadvertently removed, # by examining particular nodes in the optree. +use warnings; +use strict; + BEGIN { chdir 't'; require './test.pl'; @@ -10,13 +13,15 @@ BEGIN { @INC = '../lib'; } -plan 59; +plan 695; use v5.10; # state use B qw(svref_2object OPpASSIGN_COMMON_SCALAR OPpASSIGN_COMMON_RC1 OPpASSIGN_COMMON_AGG + OPpTRUEBOOL + OPpMAYBE_TRUEBOOL ); @@ -80,11 +85,18 @@ for my $test ( [ "---", '@a = (split(//, @a), 1)', 'split(@a)' ], [ "--A", 'my @a; my $ar = @a; @a = (@$ar = split())', 'a/ar split' ], ) { + my ($exp, $code, $desc) = @$test; - my $sub = eval "sub { $code }" - or die - "aassign eval('$code') failed: this test needs to be rewritten:\n" - . $@; + my $sub; + { + # package vars used in code snippets + our (@a, %a, @b, %b, $c, $p, $q, $x, $y, @y, @z); + + $sub = eval "sub { $code }" + or die + "aassign eval('$code') failed: this test needs" + . "to be rewritten:\n$@" + } my $last_expr = svref_2object($sub)->ROOT->first->last; if ($last_expr->name ne 'aassign') { @@ -183,3 +195,220 @@ for(['@pkgary' , '@_' ], # stringify with join kid --> join is svref_2object(sub { "@_" })->ROOT->first->last->name, 'join', 'qq"@_" optimised from stringify(join(...)) to join(...)'; + + +# Check that certain ops, when in boolean context, have the +# right private "is boolean" or "maybe boolean" flags set. +# +# A maybe flag is set when the context at the end of a chain of and/or/dor +# ops isn't known till runtime, e.g. +# sub f { ....; ((%h || $x) || $y)) } +# If f() is called in void context, then %h can return a boolean value; +# if in scalar context, %h must return a key count. + +for my $ops ( + # op code op path flag maybe flag + [ 'rv2hv', '%pkg', [], OPpTRUEBOOL, OPpMAYBE_TRUEBOOL ], + [ 'rv2hv', 'scalar(%pkg)', [0], OPpTRUEBOOL, OPpMAYBE_TRUEBOOL ], + [ 'padhv', '%lex', [], OPpTRUEBOOL, OPpMAYBE_TRUEBOOL ], + [ 'padhv', 'scalar(%lex)', [0], OPpTRUEBOOL, OPpMAYBE_TRUEBOOL ], +) { + my ($op_name, $op_code, $post_op_path, $bool_flag, $maybe_flag) = @$ops; + + for my $test ( + # 1st column: what to expect for each $context (void, scalar, unknown), + # 0: expect no flag + # 1: expect bool flag + # 2: expect maybe bool flag + # 9: skip test + # 2nd column: path though the op subtree to the flagged op: + # 0 is first child, 1 is second child etc. + # Will have @$post_op_path from above appended. + # 3rd column: code to execute: %s holds the code for the op + # + # [V S U] PATH CODE + + # INNER PLAIN + + [ [0,0,0], [], '%s' ], + [ [1,9,2], [0,0], 'if (%s) {$x}' ], + [ [1,9,1], [0,0], 'if (%s) {$x} else {$y}' ], + [ [1,9,2], [0,0], 'unless (%s) {$x}' ], + + # INNER NOT + + [ [1,1,1], [0], '!%s' ], + [ [1,9,1], [0,0,0], 'if (!%s) {$x}' ], + [ [1,9,1], [0,0,0], 'if (!%s) {$x} else {$y}' ], + [ [1,9,1], [0,0,0], 'unless (!%s) {$x}' ], + + # INNER COND + + [ [1,1,1], [0,0,], '%s ? $p : $q' ], + [ [1,9,1], [0,0,0,0], 'if (%s ? $p : $q) {$x}' ], + [ [1,9,1], [0,0,0,0], 'if (%s ? $p : $q) {$x} else {$y}' ], + [ [1,9,1], [0,0,0,0], 'unless (%s ? $p : $q) {$x}' ], + + + # INNER OR LHS + + [ [1,0,2], [0,0], '%s || $x' ], + [ [1,1,1], [0,0,0], '!(%s || $x)' ], + [ [1,0,2], [0,1,0,0], '$y && (%s || $x)' ], + [ [1,9,2], [0,0,0,0], 'if (%s || $x) {$x}' ], + [ [1,9,1], [0,0,0,0], 'if (%s || $x) {$x} else {$y}' ], + [ [1,9,2], [0,0,0,0], 'unless (%s || $x) {$x}' ], + + # INNER OR RHS + + [ [0,0,0], [0,1], '$x || %s' ], + [ [1,1,1], [0,0,1], '!($x || %s)' ], + [ [0,0,0], [0,1,0,1], '$y && ($x || %s)' ], + [ [1,9,2], [0,0,0,1], 'if ($x || %s) {$x}' ], + [ [1,9,1], [0,0,0,1], 'if ($x || %s) {$x} else {$y}' ], + [ [1,9,2], [0,0,0,1], 'unless ($x || %s) {$x}' ], + + # INNER DOR LHS + + [ [1,0,2], [0,0], '%s // $x' ], + [ [1,1,1], [0,0,0], '!(%s // $x)' ], + [ [1,0,2], [0,1,0,0], '$y && (%s // $x)' ], + [ [1,9,2], [0,0,0,0], 'if (%s // $x) {$x}' ], + [ [1,9,1], [0,0,0,0], 'if (%s // $x) {$x} else {$y}' ], + [ [1,9,2], [0,0,0,0], 'unless (%s // $x) {$x}' ], + + # INNER DOR RHS + + [ [0,0,0], [0,1], '$x // %s' ], + [ [1,1,1], [0,0,1], '!($x // %s)' ], + [ [0,0,0], [0,1,0,1], '$y && ($x // %s)' ], + [ [1,9,2], [0,0,0,1], 'if ($x // %s) {$x}' ], + [ [1,9,1], [0,0,0,1], 'if ($x // %s) {$x} else {$y}' ], + [ [1,9,2], [0,0,0,1], 'unless ($x // %s) {$x}' ], + + # INNER AND LHS + + [ [1,0,2], [0,0], '%s && $x' ], + [ [1,1,1], [0,0,0], '!(%s && $x)' ], + [ [1,0,2], [0,1,0,0], '$y || (%s && $x)' ], + [ [1,9,2], [0,0,0,0], 'if (%s && $x) {$x}' ], + [ [1,9,1], [0,0,0,0], 'if (%s && $x) {$x} else {$y}' ], + [ [1,9,2], [0,0,0,0], 'unless (%s && $x) {$x}' ], + + # INNER AND RHS + + [ [0,0,0], [0,1], '$x && %s' ], + [ [1,1,1], [0,0,1], '!($x && %s)' ], + [ [0,0,0], [0,1,0,1], '$y || ($x && %s)' ], + [ [1,9,2], [0,0,0,1], 'if ($x && %s) {$x}' ], + [ [1,9,1], [0,0,0,1], 'if ($x && %s) {$x} else {$y}' ], + [ [1,9,2], [0,0,0,1], 'unless ($x && %s) {$x}' ], + + # INNER XOR LHS + + # LHS of XOR is currently too hard to detect as + # being in boolean context + + # INNER XOR RHS + + [ [1,1,1], [1], '($x xor %s)' ], + [ [1,1,1], [0,1], '!($x xor %s)' ], + [ [1,1,1], [0,1,1], '$y || ($x xor %s)' ], + [ [1,9,1], [0,0,1], 'if ($x xor %s) {$x}' ], + [ [1,9,1], [0,0,1], 'if ($x xor %s) {$x} else {$y}' ], + [ [1,9,1], [0,0,1], 'unless ($x xor %s) {$x}' ], + + # GREP + + [ [1,1,1], [0,1,0], 'grep %s,1,2' ], + [ [1,1,1], [0,1,0,0], 'grep !%s,1,2' ], + [ [1,1,1], [0,1,0,0,1],'grep $y || %s,1,2' ], + + # FLIP + + [ [1,1,1], [0,0,0,0], '%s..$x' ], + [ [1,1,1], [0,0,0,0,0], '!%s..$x' ], + [ [1,1,1], [0,0,0,0,0,1], '($y || %s)..$x' ], + + # FLOP + + [ [1,1,1], [0,0,0,1], '$x..%s' ], + [ [1,1,1], [0,0,0,1,0], '$x..!%s' ], + [ [1,1,1], [0,0,0,1,0,1], '$x..($y || %s)' ], + + ) { + my ($expects, $op_path, $code_fmt) = @$test; + + for my $context (0,1,2) { + # 0: void + # 1: scalar + # 2: unknown + # 9: skip test (principally if() can't be in scalar context) + + next if $expects->[$context] == 9; + + my $base_code = sprintf $code_fmt, $op_code; + my $code = $base_code; + my @op_path = @$op_path; + push @op_path, @$post_op_path; + + # where to find the expression in the top-level lineseq + my $seq_offset = -1; + + if ($context == 0) { + $seq_offset -= 2; + $code .= "; 1"; + } + elsif ($context == 1) { + $code = "\$r = ($code)"; + unshift @op_path, 0; + } + + + my $sub; + { + our (%pkg); + my (%lex, $p, $q, $r, $x, $y); + + no warnings 'void'; + $sub = eval "sub { $code }" + or die + "eval'$code' failed: this test needs to be rewritten;\n" + . "Errors were:\n$@"; + } + + # find the expression subtree in the main lineseq of the sub + my $expr = svref_2object($sub)->ROOT->first; + my @ops; + my $next = $expr->first; + while ($$next) { + push @ops, $next; + $next = $next->sibling; + } + $expr = $ops[$seq_offset]; + + # search through the expr subtree looking for the named op - + # this assumes that for all the code examples above, the + # op is always in the LH branch + while (defined (my $p = shift @op_path)) { + $expr = $expr->first; + $expr = $expr->sibling while $p--; + } + + if (!$expr || $expr->name ne $op_name) { + die "Can't find $op_name op in optree for '$code'; " + . "this test needs to be rewritten" + } + + my $exp = $expects->[$context]; + $exp = $exp == 0 ? 0 + : $exp == 1 ? $bool_flag + : $maybe_flag; + + my $got = ($expr->private & ($bool_flag | $maybe_flag)); + my $cxt_name = ('void ', 'scalar ', 'unknown')[$context]; + is $got, $exp, "boolean: $op_name $cxt_name '$base_code'"; + } + } +} + diff --git a/t/porting/customized.dat b/t/porting/customized.dat index a2a953a..24df433 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -107,6 +107,7 @@ Test::Harness cpan/Test-Harness/lib/TAP/Parser/SourceHandler/RawTAP.pm d01e1e2a8 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 +Test::Simple cpan/Test-Simple/t/Test2/modules/IPC/Driver/Files.t 59648b5745fda06177d81c2c21f55b09f6e129bb autodie cpan/autodie/t/mkdir.t 9e70d2282a3cc7d76a78bf8144fccba20fb37dac base dist/base/lib/base.pm 9575442273694d41c8e86cb1d86fa1935a07c8a8 version cpan/version/lib/version.pm a032a751524bdd07a93c945d2a1703abe7ad8ef0 diff --git a/t/porting/diag.t b/t/porting/diag.t index cdd9d64..f3805d5 100644 --- a/t/porting/diag.t +++ b/t/porting/diag.t @@ -685,7 +685,7 @@ Usage: VMS::Filespec::unixrealpath(spec) Usage: VMS::Filespec::vmsify(spec) Usage: VMS::Filespec::vmspath(spec) Usage: VMS::Filespec::vmsrealpath(spec) -Use of inherited AUTOLOAD for non-method %s::%s() is deprecated +Use of inherited AUTOLOAD for non-method %s::%s() is deprecated. This will be fatal in Perl 5.28 utf8 "\x%X" does not map to Unicode Value of logical "%s" too long. Truncating to %i bytes waitpid: process %x is not a child of process %x diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index 3b41fa9..44c13ff 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -1,4 +1,4 @@ -# This file is the data file for t/porting/podcheck.t. +# This file is the data file for porting/podcheck.t. # There are three types of lines. # Comment lines are white-space only or begin with a '#', like this one. Any # changes you make to the comment lines will be lost when the file is @@ -231,7 +231,6 @@ prctl(2) printenv(1) printf(3) provide -pstruct ptar(1) ptargrep(1) pwd_mkdb(8) diff --git a/t/re/anyof.t b/t/re/anyof.t index 978ec73..12ae043 100644 --- a/t/re/anyof.t +++ b/t/re/anyof.t @@ -333,8 +333,8 @@ while (defined (my $test = shift @tests)) { # Convert platform-independent values to what is suitable for the # platform - $test =~ s/{INFINITY}/$highest_cp/g; - $test =~ s/{INFINITY_minus_1}/$next_highest_cp/g; + $test =~ s/\{INFINITY\}/$highest_cp/g; + $test =~ s/\{INFINITY_minus_1\}/$next_highest_cp/g; $test = "qr/$test/"; my $actual_test = "use re qw(Debug COMPILE); $test"; diff --git a/t/re/keep_tabs.t b/t/re/keep_tabs.t new file mode 100644 index 0000000..ec986c4 --- /dev/null +++ b/t/re/keep_tabs.t @@ -0,0 +1,29 @@ +# This file contains tests where \t characters should not be expanded into +# spaces. + +BEGIN { + chdir 't' if -d 't'; + require './test.pl'; +} + +{ + like("\t", qr/[a b]/x, '\t not ignored under /x'); + unlike("\t", qr/[a b]/xx, '\t ignored under /xx'); + like("a", qr/[a b]/xx, '"a" matches qr/[a b]/xx'); + like("b", qr/[a b]/xx, '"b" matches qr/[a b]/xx'); + like("\t", qr/[a\ b]/xx, '"\t" matches qr/[a\ b]/xx'); + like("a", qr/[a\ b]/xx, '"a" matches qr/[a\ b]/xx'); + like("b", qr/[a\ b]/xx, '"b" matches qr/[a\ b]/xx'); + + like("\t", qr/(?x:[a b])/, '\t not ignored under /x'); + unlike("\t", qr/(?xx:[a b])/, '\t ignored under /xx'); + like("a", qr/(?xx:[a b])/, '"a" matches qr/(?xx:[a b])/'); + like("b", qr/(?xx:[a b])/, '"b" matches qr/(?xx:[a b])/'); + like("\t", qr/(?xx:[a\ b])/, '"\t" matches qr/(?xx:[a\ b])/'); + like("a", qr/(?xx:[a\ b])/, '"a" matches qr/(?xx:[a\ b])/'); + like("b", qr/(?xx:[a\ b])/, '"b" matches qr/(?xx:[a\ b])/'); +} + +done_testing; + +# ex softtabstop=0 noexpandtab diff --git a/t/re/pat.t b/t/re/pat.t index b8d7680..d5e5d2f 100644 --- a/t/re/pat.t +++ b/t/re/pat.t @@ -23,7 +23,7 @@ BEGIN { skip_all('no re module') unless defined &DynaLoader::boot_DynaLoader; skip_all_without_unicode_tables(); -plan tests => 827; # Update this when adding/deleting tests. +plan tests => 835; # Update this when adding/deleting tests. run_tests() unless caller; @@ -1860,6 +1860,47 @@ EOF_CODE like($got[5],qr/Error: Infinite recursion via empty pattern/, "empty pattern in regex codeblock: produced the right exception message" ); } + { + # [perl #130495] /x comment skipping stopped a byte short, leading + # to assertion failure or 'malformed utf-8 character" warning + fresh_perl_is( + "use utf8; m{a#\x{124}}x", '', {wide_chars => 1}, + '[perl #130495] utf-8 character at end of /x comment should not misparse', + ); + } + { + # [perl #130522] causes out-of-bounds read detected by clang with + # address=sanitized when length of the STCLASS string is greater than + # length of target string. + my $re = qr{(?=\0z)\0?z?$}i; + my($yes, $no) = (1, ""); + for my $test ( + [ $no, undef, '' ], + [ $no, '', '' ], + [ $no, "\0", '\0' ], + [ $yes, "\0z", '\0z' ], + [ $no, "\0z\0", '\0z\0' ], + [ $yes, "\0z\n", '\0z\n' ], + ) { + my($result, $target, $disp) = @$test; + no warnings qw/uninitialized/; + is($target =~ $re, $result, "[perl #130522] with target '$disp'"); + } + } + { + # [perl #129377] backref to an unmatched capture should not cause + # reading before start of string. + SKIP: { + skip "no re-debug under miniperl" if is_miniperl; + my $prog = <<'EOP'; +use re qw(Debug EXECUTE); +"x" =~ m{ () y | () \1 }x; +EOP + fresh_perl_like($prog, qr{ + \A (?! .* ^ \s+ - ) + }msx, { stderr => 1 }, "Offsets in debug output are not negative"); + } + } } # End of sub run_tests 1; diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t index 08f4f53..5e5cc1f 100644 --- a/t/re/pat_advanced.t +++ b/t/re/pat_advanced.t @@ -947,7 +947,7 @@ sub run_tests { ok "\N{LONG-STR}" =~ /^\N{LONG-STR}$/i, 'Verify under folding that long string works'; eval '/(?[[\N{EMPTY-STR}]])/'; - ok $@ && $@ =~ /Zero length \\N\{}/; + ok $@ && $@ =~ /Zero length \\N\{\}/; undef $w; { diff --git a/t/re/re_tests b/t/re/re_tests index e8a7fa9..f210202 100644 --- a/t/re/re_tests +++ b/t/re/re_tests @@ -1454,8 +1454,8 @@ foo(\h)bar foo\tbar y $1 \t # Verify that \ escapes the { after \N, and causes \N to match non-newline abc\N\{U+BEEF} abc\n{UBEEF} n -abc\N\{U+BEEF} abc.{UBEEF} y $& abc.{UBEEF} -[abc\N\{U+BEEF}] - c - \\N in a character class must be a named character +abc\N\{U+BEEF\} abc.{UBEEF} y $& abc.{UBEEF} +[abc\N\{U+BEEF\}] - c - \\N in a character class must be a named character # Verify that \N can be trailing and causes \N to match non-newline abc\N abcd y $& abcd @@ -1977,5 +1977,17 @@ AB\s+\x{100} AB \x{100}X y - - (^(?:(\d)x)?\d$) 1 y [$1-$2] [1-] # make sure that we reset capture buffers properly (from regtry) (X{2,}[-X]{1,4}){3,}X{2,} XXX-XXX-XXX-- n - - # [perl #130307] +/[a b]/x \N{SPACE} yS $& # Note a space char here +/[a b]/xx \N{SPACE} n - - +/[a\ b]/xx \N{SPACE} y $& # Note a space char here +/[ ^ a b ]/xx a n - - +/[ ^ a b ]/xx b n - - +/[ ^ a b ]/xx A y $& A +/(?x:[a b])/xx \N{SPACE} yS $& # Note a space char here +/(?xx:[a b])/x \N{SPACE} n - - +/(?x)[a b]/xx \N{SPACE} yS $& # Note a space char here +/(?xx)[a b]/x \N{SPACE} n - - +/(?-x:[a b])/xx \N{SPACE} yS $& # Note a space char here + # Keep these lines at the end of the file # vim: softtabstop=0 noexpandtab diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t index 52bec7a..22711d5 100644 --- a/t/re/reg_mesg.t +++ b/t/re/reg_mesg.t @@ -14,19 +14,28 @@ skip_all_without_unicode_tables(); use strict; use open qw(:utf8 :std); -## +# Kind of a kludge to mark warnings to be expected only if we are testing +# under "use re 'strict'" +my $only_strict_marker = ':expected_only_under_strict'; + ## If the markers used are changed (search for "MARKER1" in regcomp.c), ## update only these two regexs, and leave the {#} in the @death/@warning ## arrays below. The {#} is a meta-marker -- it marks where the marker should ## go. -## -## Returns empty string if that is what is expected. Otherwise, handles -## either a scalar, turning it into a single element array; or a ref to an -## array, adjusting each element. If called in array context, returns an -## array, otherwise the join of all elements -sub fixup_expect { - my $expect_ref = shift; +sub fixup_expect ($$) { + + # Fixes up the expected results by inserting the boiler plate text. + # Returns empty string if that is what is expected. Otherwise, handles + # either a scalar, turning it into a single element array; or a ref to an + # array, adjusting each element. If called in array context, returns an + # array, otherwise the join of all elements. + + # The string $only_strict_marker will be removed from any expect line it + # begins, and if $strict is not true, that expect line will be removed + # from the output (hence won't be expected) + + my ($expect_ref, $strict) = @_; return "" if $expect_ref eq ""; my @expect; @@ -37,12 +46,15 @@ sub fixup_expect { @expect = $expect_ref; } + my @new_expect; foreach my $element (@expect) { - $element =~ s/{\#}/in regex; marked by <-- HERE in/; - $element =~ s/{\#}/ <-- HERE /; + $element =~ s/\{\#\}/in regex; marked by <-- HERE in/; + $element =~ s/\{\#\}/ <-- HERE /; $element .= " at "; + next if $element =~ s/ ^ $only_strict_marker \s* //x && ! $strict; + push @new_expect, $element; } - return wantarray ? @expect : join "", @expect; + return wantarray ? @new_expect : join "", @new_expect; } ## Because we don't "use utf8" in this file, we need to do some extra legwork @@ -274,10 +286,10 @@ my @death = '/\A{/' => 'Unescaped left brace in regex is illegal here {#} m/\A{{#}/', '/:{4,a}/' => 'Unescaped left brace in regex is illegal here {#} m/:{{#}4,a}/', '/xa{3\,4}y/' => 'Unescaped left brace in regex is illegal here {#} m/xa{{#}3\,4}y/', - '/abc/xix' => 'Only one /x regex modifier is allowed', - '/(?xmsixp:abc)/' => 'Only one /x regex modifier is allowed {#} m/(?xmsixp{#}:abc)/', - '/(?xmsixp)abc/' => 'Only one /x regex modifier is allowed {#} m/(?xmsixp{#})abc/', - '/(?xxxx:abc)/' => 'Only one /x regex modifier is allowed {#} m/(?xxxx{#}:abc)/', + '/abc/xix' => "", + '/(?xmsixp:abc)/' => "", + '/(?xmsixp)abc/' => "", + '/(?xxxx:abc)/' => "", '/(?<=/' => 'Sequence (?... not terminated {#} m/(?<={#}/', # [perl #128170] ); @@ -520,10 +532,10 @@ my @warning = ( ], '/a{1,1}?\x{100}/' => 'Useless use of greediness modifier \'?\' {#} m/a{1,1}?{#}\x{100}/', "/(?[ [ % - % ] ])/" => "", - "/(?[ [ : - \\x$colon_hex ] ])\\x{100}/" => "\": - \\x$colon_hex \" is more clearly written simply as \":\" {#} m/(?[ [ : - \\x$colon_hex {#}] ])\\x{100}/", - "/(?[ [ \\x$colon_hex - : ] ])\\x{100}/" => "\"\\x$colon_hex\ - : \" is more clearly written simply as \":\" {#} m/(?[ [ \\x$colon_hex - : {#}] ])\\x{100}/", - "/(?[ [ \\t - \\x$tab_hex ] ])\\x{100}/" => "\"\\t - \\x$tab_hex \" is more clearly written simply as \"\\t\" {#} m/(?[ [ \\t - \\x$tab_hex {#}] ])\\x{100}/", - "/(?[ [ \\x$tab_hex - \\t ] ])\\x{100}/" => "\"\\x$tab_hex\ - \\t \" is more clearly written simply as \"\\t\" {#} m/(?[ [ \\x$tab_hex - \\t {#}] ])\\x{100}/", + "/(?[ [ : - \\x$colon_hex ] ])\\x{100}/" => "\": - \\x$colon_hex \" is more clearly written simply as \":\". This will be a fatal error in Perl 5.28 {#} m/(?[ [ : - \\x$colon_hex {#}] ])\\x{100}/", + "/(?[ [ \\x$colon_hex - : ] ])\\x{100}/" => "\"\\x$colon_hex\ - : \" is more clearly written simply as \":\". This will be a fatal error in Perl 5.28 {#} m/(?[ [ \\x$colon_hex - : {#}] ])\\x{100}/", + "/(?[ [ \\t - \\x$tab_hex ] ])\\x{100}/" => "\"\\t - \\x$tab_hex \" is more clearly written simply as \"\\t\". This will be a fatal error in Perl 5.28 {#} m/(?[ [ \\t - \\x$tab_hex {#}] ])\\x{100}/", + "/(?[ [ \\x$tab_hex - \\t ] ])\\x{100}/" => "\"\\x$tab_hex\ - \\t \" is more clearly written simply as \"\\t\". This will be a fatal error in Perl 5.28 {#} m/(?[ [ \\x$tab_hex - \\t {#}] ])\\x{100}/", "/(?[ [ $B_hex - C ] ])/" => "Ranges of ASCII printables should be some subset of \"0-9\", \"A-Z\", or \"a-z\" {#} m/(?[ [ $B_hex - C {#}] ])/", "/(?[ [ A - $B_hex ] ])/" => "Ranges of ASCII printables should be some subset of \"0-9\", \"A-Z\", or \"a-z\" {#} m/(?[ [ A - $B_hex {#}] ])/", "/(?[ [ $low_mixed_alpha - $high_mixed_alpha ] ])/" => "Ranges of ASCII printables should be some subset of \"0-9\", \"A-Z\", or \"a-z\" {#} m/(?[ [ $low_mixed_alpha - $high_mixed_alpha {#}] ])/", @@ -556,6 +568,7 @@ my @warning = ( 'Assuming NOT a POSIX class since no blanks are allowed in one {#} m/[[ ^ {#}: x d i g i t : ] ]\x{100}/', 'Assuming NOT a POSIX class since no blanks are allowed in one {#} m/[[ ^ : {#}x d i g i t : ] ]\x{100}/', 'Assuming NOT a POSIX class since no blanks are allowed in one {#} m/[[ ^ : x d i g i t : ]{#} ]\x{100}/', + $only_strict_marker . 'Unescaped literal \']\' {#} m/[[ ^ : x d i g i t : ] ]{#}\x{100}/', ], '/[foo:lower:]]\x{100}/' => 'Assuming NOT a POSIX class since it doesn\'t start with a \'[\' {#} m/[foo{#}:lower:]]\x{100}/', '/[[;upper;]]\x{100}/' => [ 'Assuming NOT a POSIX class since a semi-colon was found instead of a colon {#} m/[[;{#}upper;]]\x{100}/', @@ -598,14 +611,16 @@ my @warning_only_under_strict = ( '/[\N{U+FF}-\x{100}]/' => 'Both or neither range ends should be Unicode {#} m/[\N{U+FF}-\x{100}{#}]/', '/[\N{U+100}-\x{101}]/' => "", "/[%-%]/" => "", - "/[:-\\x$colon_hex]\\x{100}/" => "\":-\\x$colon_hex\" is more clearly written simply as \":\" {#} m/[:-\\x$colon_hex\{#}]\\x{100}/", - "/[\\x$colon_hex-:]\\x{100}/" => "\"\\x$colon_hex-:\" is more clearly written simply as \":\" {#} m/[\\x$colon_hex\-:{#}]\\x{100}/", - "/[\\t-\\x$tab_hex]\\x{100}/" => "\"\\t-\\x$tab_hex\" is more clearly written simply as \"\\t\" {#} m/[\\t-\\x$tab_hex\{#}]\\x{100}/", - "/[\\x$tab_hex-\\t]\\x{100}/" => "\"\\x$tab_hex-\\t\" is more clearly written simply as \"\\t\" {#} m/[\\x$tab_hex\-\\t{#}]\\x{100}/", + "/[:-\\x$colon_hex]\\x{100}/" => "\":-\\x$colon_hex\" is more clearly written simply as \":\". This will be a fatal error in Perl 5.28 {#} m/[:-\\x$colon_hex\{#}]\\x{100}/", + "/[\\x$colon_hex-:]\\x{100}/" => "\"\\x$colon_hex-:\" is more clearly written simply as \":\". This will be a fatal error in Perl 5.28 {#} m/[\\x$colon_hex\-:{#}]\\x{100}/", + "/[\\t-\\x$tab_hex]\\x{100}/" => "\"\\t-\\x$tab_hex\" is more clearly written simply as \"\\t\". This will be a fatal error in Perl 5.28 {#} m/[\\t-\\x$tab_hex\{#}]\\x{100}/", + "/[\\x$tab_hex-\\t]\\x{100}/" => "\"\\x$tab_hex-\\t\" is more clearly written simply as \"\\t\". This will be a fatal error in Perl 5.28 {#} m/[\\x$tab_hex\-\\t{#}]\\x{100}/", "/[$B_hex-C]/" => "Ranges of ASCII printables should be some subset of \"0-9\", \"A-Z\", or \"a-z\" {#} m/[$B_hex-C{#}]/", "/[A-$B_hex]/" => "Ranges of ASCII printables should be some subset of \"0-9\", \"A-Z\", or \"a-z\" {#} m/[A-$B_hex\{#}]/", "/[$low_mixed_alpha-$high_mixed_alpha]/" => "Ranges of ASCII printables should be some subset of \"0-9\", \"A-Z\", or \"a-z\" {#} m/[$low_mixed_alpha-$high_mixed_alpha\{#}]/", "/[$low_mixed_digit-$high_mixed_digit]/" => "Ranges of ASCII printables should be some subset of \"0-9\", \"A-Z\", or \"a-z\" {#} m/[$low_mixed_digit-$high_mixed_digit\{#}]/", + '/\b 'Unescaped literal \'}\' {#} m/\b 'Unescaped literal \']\' {#} m/[ ]def]{#}/', ); my @warning_utf8_only_under_strict = mark_as_utf8( @@ -613,6 +628,9 @@ my @warning_utf8_only_under_strict = mark_as_utf8( '/ネ(?[ [ ᪉ - ᪐ ] ])/; #no latin1' => "Ranges of digits should be from the same group of 10 {#} m/ネ(?[ [ ᪉ - ᪐ {#}] ])/", '/ネ[᧙-᧚]/; #no latin1' => "Ranges of digits should be from the same group of 10 {#} m/ネ[᧙-᧚{#}]/", '/ネ(?[ [ ᧙ - ᧚ ] ])/; #no latin1' => "Ranges of digits should be from the same group of 10 {#} m/ネ(?[ [ ᧙ - ᧚ {#}] ])/", + '/ネ(?[ [ 𝟘 - 𝟡 ] ])/; #no latin1' => "", + '/ネ(?[ [ 𝟧 - 𝟱 ] ])/; #no latin1' => "Ranges of digits should be from the same group of 10 {#} m/ネ(?[ [ 𝟧 - 𝟱 {#}] ])/", + '/ネ(?[ [ 𝟧 - 𝟰 ] ])/; #no latin1' => "Ranges of digits should be from the same group of 10 {#} m/ネ(?[ [ 𝟧 - 𝟰 {#}] ])/", ); push @warning_only_under_strict, @warning_utf8_only_under_strict; @@ -631,9 +649,9 @@ my @deprecated = ( '/foo(:?{bar)/' => "", '/\s*{/' => "", '/a{3,4}{/' => "", - '/.{/' => 'Unescaped left brace in regex is deprecated here, passed through {#} m/.{{#}/', - '/[x]{/' => 'Unescaped left brace in regex is deprecated here, passed through {#} m/[x]{{#}/', - '/\p{Latin}{/' => 'Unescaped left brace in regex is deprecated here, passed through {#} m/\p{Latin}{{#}/', + '/.{/' => 'Unescaped left brace in regex is deprecated here (and will be fatal in Perl 5.30), passed through {#} m/.{{#}/', + '/[x]{/' => 'Unescaped left brace in regex is deprecated here (and will be fatal in Perl 5.30), passed through {#} m/[x]{{#}/', + '/\p{Latin}{/' => 'Unescaped left brace in regex is deprecated here (and will be fatal in Perl 5.30), passed through {#} m/\p{Latin}{{#}/', ); for my $strict ("", "use re 'strict';") { @@ -655,7 +673,7 @@ for my $strict ("", "use re 'strict';") { } for (my $i = 0; $i < @death; $i += 2) { my $regex = $death[$i]; - my $expect = fixup_expect($death[$i+1]); + my $expect = fixup_expect($death[$i+1], $strict); no warnings 'experimental::regex_sets'; no warnings 'experimental::re_strict'; @@ -678,6 +696,8 @@ for my $strict ("", "no warnings 'experimental::re_strict'; use re 'strict';") } else { for (my $i = 0; $i < @warning_only_under_strict; $i += 2) { + + # (?[ ]) are always under strict if ($warning_only_under_strict[$i] =~ /\Q(?[/) { push @warning_tests, $warning_only_under_strict[$i], # The regex $warning_only_under_strict[$i+1]; @@ -716,7 +736,7 @@ for my $strict ("", "no warnings 'experimental::re_strict'; use re 'strict';") } for (my $i = 0; $i < @$ref; $i += 2) { my $regex = $ref->[$i]; - my @expect = fixup_expect($ref->[$i+1]); + my @expect = fixup_expect($ref->[$i+1], $strict); # A length-1 array with an empty warning means no warning gets # generated at all. diff --git a/t/re/regex_sets.t b/t/re/regex_sets.t index 6a79f9d..994d0a2 100644 --- a/t/re/regex_sets.t +++ b/t/re/regex_sets.t @@ -165,7 +165,13 @@ for my $char ("Ù ", "Ù¥", "Ù©") { like($@, qr/^Syntax error/, '/(?[(\c]) ]\b/ should be a syntax error'); eval { $_ = '(?[\c[]](])'; qr/$_/ }; like($@, qr/^Syntax error/, '/(?[\c[]](])/ should be a syntax error'); - like("\c#", qr/(?[\c#])/, '\c# should match itself'); + { + # This block needs to go after 5.26, as it will be + # fatal in 5.28. But it's not fatal yet, so we ought + # to test it. + no warnings 'deprecated'; + like("\c#", qr/(?[\c#])/, '\c# should match itself'); + } like("\c[", qr/(?[\c[])/, '\c[ should match itself'); like("\c\ ", qr/(?[\c\])/, '\c\ should match itself'); like("\c]", qr/(?[\c]])/, '\c] should match itself'); diff --git a/t/run/runenv.t b/t/run/runenv.t index 6f235d2..611e012 100644 --- a/t/run/runenv.t +++ b/t/run/runenv.t @@ -204,74 +204,87 @@ try({PERL5LIB => "foo", '', ''); -try({PERL_HASH_SEED_DEBUG => 1}, - ['-e','1'], - '', - qr/HASH_FUNCTION =/); - -try({PERL_HASH_SEED_DEBUG => 1}, - ['-e','1'], - '', - qr/HASH_SEED =/); - -# special case, seed "0" implies disabled hash key traversal randomization -try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0"}, - ['-e','1'], - '', - qr/PERTURB_KEYS = 0/); - -# check that setting it to a different value with the same logical value -# triggers the normal "deterministic mode". -try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0x0"}, - ['-e','1'], - '', - qr/PERTURB_KEYS = 2/); - -try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "0"}, - ['-e','1'], - '', - qr/PERTURB_KEYS = 0/); - -try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "1"}, - ['-e','1'], - '', - qr/PERTURB_KEYS = 1/); - -try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "2"}, - ['-e','1'], - '', - qr/PERTURB_KEYS = 2/); - -try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12345678"}, - ['-e','1'], - '', - qr/HASH_SEED = 0x12345678/); - -try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12"}, - ['-e','1'], - '', - qr/HASH_SEED = 0x12000000/); +SKIP: +{ + skip "NO_PERL_HASH_SEED_DEBUG set", 4 + if $Config{ccflags} =~ /-DNO_PERL_HASH_SEED_DEBUG\b/; + + try({PERL_HASH_SEED_DEBUG => 1}, + ['-e','1'], + '', + qr/HASH_FUNCTION =/); + + try({PERL_HASH_SEED_DEBUG => 1}, + ['-e','1'], + '', + qr/HASH_SEED =/); +} -try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "123456789"}, - ['-e','1'], - '', - qr/HASH_SEED = 0x12345678/); - -# Test that PERL_PERTURB_KEYS works as expected. We check that we get the same -# results if we use PERL_PERTURB_KEYS = 0 or 2 and we reuse the seed from previous run. -my @print_keys = ( '-e', '@_{"A".."Z"}=(); print keys %_'); -for my $mode ( 0,1, 2 ) { # disabled and deterministic respectively - my %base_opts = ( PERL_PERTURB_KEYS => $mode, PERL_HASH_SEED_DEBUG => 1 ), - my ($out, $err) = runperl_and_capture( { %base_opts }, [ @print_keys ]); - if ($err=~/HASH_SEED = (0x[a-f0-9]+)/) { - my $seed = $1; - my($out2, $err2) = runperl_and_capture( { %base_opts, PERL_HASH_SEED => $seed }, [ @print_keys ]); - if ( $mode == 1 ) { - isnt ($out,$out2,"PERL_PERTURB_KEYS = $mode results in different key order with the same key"); - } else { - is ($out,$out2,"PERL_PERTURB_KEYS = $mode allows one to recreate a random hash"); +SKIP: +{ + skip "NO_PERL_HASH_ENV or NO_PERL_HASH_SEED_DEBUG set", 16 + if $Config{ccflags} =~ /-DNO_PERL_HASH_ENV\b/ || + $Config{ccflags} =~ /-DNO_PERL_HASH_SEED_DEBUG\b/; + + # special case, seed "0" implies disabled hash key traversal randomization + try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0"}, + ['-e','1'], + '', + qr/PERTURB_KEYS = 0/); + + # check that setting it to a different value with the same logical value + # triggers the normal "deterministic mode". + try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "0x0"}, + ['-e','1'], + '', + qr/PERTURB_KEYS = 2/); + + try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "0"}, + ['-e','1'], + '', + qr/PERTURB_KEYS = 0/); + + try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "1"}, + ['-e','1'], + '', + qr/PERTURB_KEYS = 1/); + + try({PERL_HASH_SEED_DEBUG => 1, PERL_PERTURB_KEYS => "2"}, + ['-e','1'], + '', + qr/PERTURB_KEYS = 2/); + + try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12345678"}, + ['-e','1'], + '', + qr/HASH_SEED = 0x12345678/); + + try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "12"}, + ['-e','1'], + '', + qr/HASH_SEED = 0x12000000/); + + try({PERL_HASH_SEED_DEBUG => 1, PERL_HASH_SEED => "123456789"}, + ['-e','1'], + '', + qr/HASH_SEED = 0x12345678/); + + # Test that PERL_PERTURB_KEYS works as expected. We check that we get the same + # results if we use PERL_PERTURB_KEYS = 0 or 2 and we reuse the seed from previous run. + my @print_keys = ( '-e', '@_{"A".."Z"}=(); print keys %_'); + for my $mode ( 0,1, 2 ) { # disabled and deterministic respectively + my %base_opts = ( PERL_PERTURB_KEYS => $mode, PERL_HASH_SEED_DEBUG => 1 ), + my ($out, $err) = runperl_and_capture( { %base_opts }, [ @print_keys ]); + if ($err=~/HASH_SEED = (0x[a-f0-9]+)/) { + my $seed = $1; + my($out2, $err2) = runperl_and_capture( { %base_opts, PERL_HASH_SEED => $seed }, [ @print_keys ]); + if ( $mode == 1 ) { + isnt ($out,$out2,"PERL_PERTURB_KEYS = $mode results in different key order with the same key"); + } else { + is ($out,$out2,"PERL_PERTURB_KEYS = $mode allows one to recreate a random hash"); + } + is ($err,$err2,"Got the same debug output when we set PERL_HASH_SEED and PERL_PERTURB_KEYS"); } - is ($err,$err2,"Got the same debug output when we set PERL_HASH_SEED and PERL_PERTURB_KEYS"); } } diff --git a/t/test.pl b/t/test.pl index 98e7632..d86f633 100644 --- a/t/test.pl +++ b/t/test.pl @@ -978,7 +978,8 @@ sub fresh_perl { $runperl_args->{progfile} ||= $tmpfile; $runperl_args->{stderr} = 1 unless exists $runperl_args->{stderr}; - open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!"; + open TEST, '>', $tmpfile or die "Cannot open $tmpfile: $!"; + binmode TEST, ':utf8' if $runperl_args->{wide_chars}; print TEST $prog; close TEST or die "Cannot close $tmpfile: $!"; diff --git a/t/uni/attrs.t b/t/uni/attrs.t index 98f676e..81075a0 100644 --- a/t/uni/attrs.t +++ b/t/uni/attrs.t @@ -37,7 +37,7 @@ like $@, qr/^Invalid SCALAR attribute: ["']?plǖgh["']? at/; eval '{my $x : plǖgh}'; like $@, qr/^Invalid SCALAR attribute: ["']?plǖgh["']? at/; eval '{my ($x,$y) : plǖgh(})}'; -like $@, qr/^Invalid SCALAR attribute: ["']?plǖgh\(}\)["']? at/; +like $@, qr/^Invalid SCALAR attribute: ["']?plǖgh\(\}\)["']? at/; # More syntax tests from the attributes manpage eval 'my $x : Şʨᚻ(10,ᕘ(7,3)) : 에ㄒ펜ሲ;'; diff --git a/t/uni/gv.t b/t/uni/gv.t index f518831..427831b 100644 --- a/t/uni/gv.t +++ b/t/uni/gv.t @@ -125,8 +125,8 @@ is (scalar %ᕘ, 0); my $E_grave = utf8::unicode_to_native(0xc8); my $pat = sprintf( # It took a lot of experimentation to get the backslashes right (khw) - "Argument \"\\*main::(?:PW\\\\x\\{%x}MPF" - . "|SKR\\\\x\\{%x}\\\\x\\{%x}\\\\x\\{%x})\" " + "Argument \"\\*main::(?:PW\\\\x\\{%x\\}MPF" + . "|SKR\\\\x\\{%x\\}\\\\x\\{%x\\}\\\\x\\{%x\\})\" " . "isn't numeric in sprintf", $O_grave, $E_grave, $E_grave, $E_grave); $pat = qr/$pat/; diff --git a/t/uni/parser.t b/t/uni/parser.t index 6c524b2..624fdd0 100644 --- a/t/uni/parser.t +++ b/t/uni/parser.t @@ -191,6 +191,8 @@ like( $@, qr/Bad name after Ｆｏｏ'/, 'Bad name after Ｆｏｏ\'' ); { no warnings 'utf8'; + local $SIG{__WARN__} = sub { }; # The eval will also output a warning, + # which we ignore my $malformed_to_be = ($::IS_EBCDIC) # Overlong sequence ? "\x{74}\x{41}" : "\x{c0}\x{a0}"; diff --git a/t/uni/variables.t b/t/uni/variables.t index edeebf4..a1f7cc2 100644 --- a/t/uni/variables.t +++ b/t/uni/variables.t @@ -130,7 +130,7 @@ for ( 0x0 .. 0xff ) { "$name as a length-1 variable generates a syntax error"); $tests++; utf8::upgrade($chr); - evalbytes "no strict; use utf8; \$$chr = 4;", + eval "no strict; \$$chr = 4;", like($@, qr/ syntax\ error | Unrecognized\ character /x, " ... and the same under 'use utf8'"); $tests++; diff --git a/toke.c b/toke.c index cd01255..3f13f76 100644 --- a/toke.c +++ b/toke.c @@ -467,7 +467,7 @@ S_printbuf(pTHX_ const char *const fmt, const char *const s) static int S_deprecate_commaless_var_list(pTHX) { PL_expect = XTERM; - deprecate("comma-less variable list"); + deprecate_fatal_in("5.28", "Use of comma-less variable list is deprecated"); return REPORT(','); /* grandfather non-comma-format format */ } @@ -527,11 +527,17 @@ S_no_op(pTHX_ const char *const what, char *s) if (is_first) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "\t(Missing semicolon on previous line?)\n"); - else if (PL_oldoldbufptr && isIDFIRST_lazy_if(PL_oldoldbufptr,UTF)) { + else if (PL_oldoldbufptr && isIDFIRST_lazy_if_safe(PL_oldoldbufptr, + PL_bufend, + UTF)) + { const char *t; - for (t = PL_oldoldbufptr; (isWORDCHAR_lazy_if(t,UTF) || *t == ':'); - t += UTF ? UTF8SKIP(t) : 1) + for (t = PL_oldoldbufptr; + (isWORDCHAR_lazy_if_safe(t, PL_bufend, UTF) || *t == ':'); + t += UTF ? UTF8SKIP(t) : 1) + { NOOP; + } if (t < PL_bufptr && isSPACE(*t)) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "\t(Do you need to predeclare %" UTF8f "?)\n", @@ -933,7 +939,8 @@ Perl_lex_grow_linestr(pTHX_ STRLEN len) /* Is the lex_shared linestr SV the same as the current linestr SV? * Only in this case does re_eval_start need adjusting, since it * points within lex_shared->ls_linestr's buffer */ - current = (linestr == PL_parser->lex_shared->ls_linestr); + current = ( !PL_parser->lex_shared->ls_linestr + || linestr == PL_parser->lex_shared->ls_linestr); bufend_pos = PL_parser->bufend - buf; bufptr_pos = PL_parser->bufptr - buf; @@ -1032,13 +1039,11 @@ Perl_lex_stuff_pvn(pTHX_ const char *pv, STRLEN len, U32 flags) } else if (UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(p, e)) { p++; highhalf++; - } else if (! UTF8_IS_INVARIANT(c)) { - /* malformed UTF-8 */ - ENTER; - SAVESPTR(PL_warnhook); - PL_warnhook = PERL_WARNHOOK_FATAL; - utf8n_to_uvchr((U8*)p, e-p, NULL, 0); - LEAVE; + } else if (! UTF8_IS_INVARIANT(c)) { + _force_out_malformed_utf8_message((U8 *) p, (U8 *) e, + 0, + 1 /* 1 means die */ ); + NOT_REACHED; /* NOTREACHED */ } } if (!highhalf) @@ -1288,6 +1293,8 @@ Perl_lex_next_chunk(pTHX_ U32 flags) STRLEN linestart_pos, last_uni_pos, last_lop_pos; bool got_some_for_debugger = 0; bool got_some; + const U8* first_bad_char_loc; + if (flags & ~(LEX_KEEP_PREVIOUS|LEX_FAKE_EOF|LEX_NO_TERM)) Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_next_chunk"); if (!(flags & LEX_NO_TERM) && PL_lex_inwhat) @@ -1352,6 +1359,18 @@ Perl_lex_next_chunk(pTHX_ U32 flags) new_bufend_pos = SvCUR(linestr); PL_parser->bufend = buf + new_bufend_pos; PL_parser->bufptr = buf + bufptr_pos; + + if (UTF && ! is_utf8_string_loc((U8 *) PL_parser->bufptr, + PL_parser->bufend - PL_parser->bufptr, + &first_bad_char_loc)) + { + _force_out_malformed_utf8_message(first_bad_char_loc, + (U8 *) PL_parser->bufend, + 0, + 1 /* 1 means die */ ); + NOT_REACHED; /* NOTREACHED */ + } + PL_parser->oldbufptr = buf + oldbufptr_pos; PL_parser->oldoldbufptr = buf + oldoldbufptr_pos; PL_parser->linestart = buf + linestart_pos; @@ -1428,12 +1447,11 @@ Perl_lex_peek_unichar(pTHX_ U32 flags) } unichar = utf8n_to_uvchr((U8*)s, bufend-s, &retlen, UTF8_CHECK_ONLY); if (retlen == (STRLEN)-1) { - /* malformed UTF-8 */ - ENTER; - SAVESPTR(PL_warnhook); - PL_warnhook = PERL_WARNHOOK_FATAL; - utf8n_to_uvchr((U8*)s, bufend-s, NULL, 0); - LEAVE; + _force_out_malformed_utf8_message((U8 *) s, + (U8 *) bufend, + 0, + 1 /* 1 means die */ ); + NOT_REACHED; /* NOTREACHED */ } return unichar; } else { @@ -1874,7 +1892,7 @@ S_check_uni(pTHX) while (isSPACE(*PL_last_uni)) PL_last_uni++; s = PL_last_uni; - while (isWORDCHAR_lazy_if(s,UTF) || *s == '-') + while (isWORDCHAR_lazy_if_safe(s, PL_bufend, UTF) || *s == '-') s += UTF ? UTF8SKIP(s) : 1; if ((t = strchr(s, '(')) && t < PL_bufptr) return; @@ -2044,7 +2062,7 @@ S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack) start = skipspace(start); s = start; - if (isIDFIRST_lazy_if(s,UTF) + if ( isIDFIRST_lazy_if_safe(s, PL_bufend, UTF) || (allow_pack && *s == ':' && s[1] == ':') ) { s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len); @@ -2437,7 +2455,7 @@ S_sublex_push(pTHX) if (is_heredoc) CopLINE_set(PL_curcop, (line_t)PL_multi_start); PL_copline = NOLINE; - + Newxz(shared, 1, LEXSHARED); shared->ls_prev = PL_parser->lex_shared; PL_parser->lex_shared = shared; @@ -2525,7 +2543,7 @@ S_sublex_done(pTHX) } } -PERL_STATIC_INLINE SV* +STATIC SV* S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) { /* points to first character of interior of \N{}, to one beyond the @@ -2545,8 +2563,7 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) PERL_ARGS_ASSERT_GET_AND_CHECK_BACKSLASH_N_NAME; if (!SvCUR(res)) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), - "Unknown charname '' is deprecated"); + deprecate_fatal_in("5.28", "Unknown charname '' is deprecated"); return res; } @@ -2554,15 +2571,10 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) e - backslash_ptr, &first_bad_char_loc)) { - /* If warnings are on, this will print a more detailed analysis of what - * is wrong than the error message below */ - utf8n_to_uvchr(first_bad_char_loc, - e - ((char *) first_bad_char_loc), - NULL, 0); - - /* We deliberately don't try to print the malformed character, which - * might not print very well; it also may be just the first of many - * malformations, so don't print what comes after it */ + _force_out_malformed_utf8_message(first_bad_char_loc, + (U8 *) PL_parser->bufend, + 0, + 0 /* 0 means don't die */ ); yyerror_pv(Perl_form(aTHX_ "Malformed UTF-8 character immediately after '%.*s'", (int) (first_bad_char_loc - (U8 *) backslash_ptr), backslash_ptr), @@ -2695,15 +2707,10 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) STRLEN len; const char* const str = SvPV_const(res, len); if (! is_utf8_string_loc((U8 *) str, len, &first_bad_char_loc)) { - /* If warnings are on, this will print a more detailed analysis of - * what is wrong than the error message below */ - utf8n_to_uvchr(first_bad_char_loc, - (char *) first_bad_char_loc - str, - NULL, 0); - - /* We deliberately don't try to print the malformed character, - * which might not print very well; it also may be just the first - * of many malformations, so don't print what comes after it */ + _force_out_malformed_utf8_message(first_bad_char_loc, + (U8 *) PL_parser->bufend, + 0, + 0 /* 0 means don't die */ ); yyerror_pv( Perl_form(aTHX_ "Malformed UTF-8 returned by %.*s immediately after '%.*s'", @@ -2777,15 +2784,17 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) In transliterations: characters are VERY literal, except for - not at the start or end - of the string, which indicates a range. If the range is in bytes, + of the string, which indicates a range. However some backslash sequences + are recognized: \r, \n, and the like + \007 \o{}, \x{}, \N{} + If all elements in the transliteration are below 256, scan_const expands the range to the full set of intermediate characters. If the range is in utf8, the hyphen is replaced with a certain range mark which will be handled by pmtrans() in op.c. In double-quoted strings: backslashes: - double-quoted style: \r and \n - constants: \x31, etc. + all those recognized in transliterations deprecated backrefs: \1 (in substitution replacements) case and quoting: \U \Q \E stops on @ and $ @@ -2828,7 +2837,7 @@ S_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e) } (end if backslash) handle regular character } (end while character to read) - + */ STATIC char * @@ -2843,11 +2852,18 @@ S_scan_const(pTHX_ char *start) bool didrange = FALSE; /* did we just finish a range? */ bool in_charclass = FALSE; /* within /[...]/ */ bool has_utf8 = FALSE; /* Output constant is UTF8 */ + bool has_above_latin1 = FALSE; /* does something require special + handling in tr/// ? */ bool this_utf8 = cBOOL(UTF); /* Is the source string assumed to be UTF8? But, this can show as true when the source isn't utf8, as for example when it is entirely composed of hex constants */ + STRLEN utf8_variant_count = 0; /* When not in UTF-8, this counts the + number of characters found so far + that will expand (into 2 bytes) + should we have to convert to + UTF-8) */ SV *res; /* result from charnames */ STRLEN offset_to_max; /* The offset in the output to where the range high-end character is temporarily placed */ @@ -2862,7 +2878,7 @@ S_scan_const(pTHX_ char *start) * the needed size, SvGROW() is called. Its size parameter each time is * based on the best guess estimate at the time, namely the length used so * far, plus the length the current construct will occupy, plus room for - * the trailing NUL, plus one byte for every input byte still unscanned */ + * the trailing NUL, plus one byte for every input byte still unscanned */ UV uv = UV_MAX; /* Initialize to weird value to try to catch any uses before set */ @@ -2896,30 +2912,29 @@ S_scan_const(pTHX_ char *start) * range, so for most cases we just drop down and handle the value * as any other. There are two exceptions. * - * 1. A minus sign indicates that we are actually going to have - * a range. In this case, skip the '-', set a flag, then drop + * 1. A hyphen indicates that we are actually going to have a + * range. In this case, skip the '-', set a flag, then drop * down to handle what should be the end range value. * 2. After we've handled that value, the next time through, that * flag is set and we fix up the range. * * Ranges entirely within Latin1 are expanded out entirely, in - * order to avoid the significant overhead of making a swash. - * Ranges that extend above Latin1 have to have a swash, so there - * is no advantage to abbreviating them here, so they are stored - * here as Min, ILLEGAL_UTF8_BYTE, Max. The illegal byte signifies - * a hyphen without any possible ambiguity. On EBCDIC machines, if - * the range is expressed as Unicode, the Latin1 portion is - * expanded out even if the entire range extends above Latin1. - * This is because each code point in it has to be processed here - * individually to get its native translation */ + * order to make the transliteration a simple table look-up. + * Ranges that extend above Latin1 have to be done differently, so + * there is no advantage to expanding them here, so they are + * stored here as Min, ILLEGAL_UTF8_BYTE, Max. The illegal byte + * signifies a hyphen without any possible ambiguity. On EBCDIC + * machines, if the range is expressed as Unicode, the Latin1 + * portion is expanded out even if the range extends above + * Latin1. This is because each code point in it has to be + * processed here individually to get its native translation */ if (! dorange) { - /* Here, we don't think we're in a range. If we've processed - * at least one character, then see if this next one is a '-', - * indicating the previous one was the start of a range. But - * don't bother if we're too close to the end for the minus to - * mean that. */ + /* Here, we don't think we're in a range. If the new character + * is not a hyphen; or if it is a hyphen, but it's too close to + * either edge to indicate a range, then it's a regular + * character. */ if (*s != '-' || s >= send - 1 || s == start) { /* A regular character. Process like any other, but first @@ -2930,16 +2945,26 @@ S_scan_const(pTHX_ char *start) non_portable_endpoint = 0; backslash_N = 0; #endif + /* The tests here for being above Latin1 and similar ones + * in the following 'else' suffice to find all such + * occurences in the constant, except those added by a + * backslash escape sequence, like \x{100}. And all those + * set 'has_above_latin1' as appropriate */ + if (this_utf8 && UTF8_IS_ABOVE_LATIN1(*s)) { + has_above_latin1 = TRUE; + } + /* Drops down to generic code to process current byte */ } - else { + else { /* Is a '-' in the context where it means a range */ if (didrange) { /* Something like y/A-C-Z// */ - Perl_croak(aTHX_ "Ambiguous range in transliteration operator"); + Perl_croak(aTHX_ "Ambiguous range in transliteration" + " operator"); } dorange = TRUE; - s++; /* Skip past the minus */ + s++; /* Skip past the hyphen */ /* d now points to where the end-range character will be * placed. Save it so won't have to go finding it later, @@ -2949,6 +2974,12 @@ S_scan_const(pTHX_ char *start) * pointer). We'll finish processing the range the next * time through the loop */ offset_to_max = d - SvPVX_const(sv); + + if (this_utf8 && UTF8_IS_ABOVE_LATIN1(*s)) { + has_above_latin1 = TRUE; + } + + /* Drops down to generic code to process current byte */ } } /* End of not a range */ else { @@ -2960,20 +2991,21 @@ S_scan_const(pTHX_ char *start) * 'd' points to just beyond the range end in the 'sv' string, * where we would next place something * 'offset_to_max' is the offset in 'sv' at which the character - * before 'd' begins. + * (the range's maximum end point) before 'd' begins. */ - const char * max_ptr = SvPVX_const(sv) + offset_to_max; - const char * min_ptr; + char * max_ptr = SvPVX(sv) + offset_to_max; + char * min_ptr; IV range_min; IV range_max; /* last character in range */ - STRLEN save_offset; STRLEN grow; + Size_t offset_to_min = 0; + Size_t extras = 0; #ifdef EBCDIC bool convert_unicode; IV real_range_max = 0; #endif - /* Get the range-ends code point values. */ + /* Get the code point values of the range ends. */ if (has_utf8) { /* We know the utf8 is valid, because we just constructed * it ourselves in previous loop iterations */ @@ -2987,23 +3019,36 @@ S_scan_const(pTHX_ char *start) range_max = * (U8*) max_ptr; } + /* If the range is just a single code point, like tr/a-a/.../, + * that code point is already in the output, twice. We can + * just back up over the second instance and avoid all the rest + * of the work. But if it is a variant character, it's been + * counted twice, so decrement */ + if (UNLIKELY(range_max == range_min)) { + d = max_ptr; + if (! has_utf8 && ! UVCHR_IS_INVARIANT(range_max)) { + utf8_variant_count--; + } + goto range_done; + } + #ifdef EBCDIC /* On EBCDIC platforms, we may have to deal with portable * ranges. These happen if at least one range endpoint is a * Unicode value (\N{...}), or if the range is a subset of * [A-Z] or [a-z], and both ends are literal characters, * like 'A', and not like \x{C1} */ - if ((convert_unicode - = cBOOL(backslash_N) /* \N{} forces Unicode, hence - portable range */ - || ( ! non_portable_endpoint - && (( isLOWER_A(range_min) && isLOWER_A(range_max)) - || (isUPPER_A(range_min) && isUPPER_A(range_max)))) - )) { + convert_unicode = + cBOOL(backslash_N) /* \N{} forces Unicode, + hence portable range */ + || ( ! non_portable_endpoint + && (( isLOWER_A(range_min) && isLOWER_A(range_max)) + || (isUPPER_A(range_min) && isUPPER_A(range_max)))); + if (convert_unicode) { /* Special handling is needed for these portable ranges. - * They are defined to all be in Unicode terms, which - * include all Unicode code points between the end points. + * They are defined to be in Unicode terms, which includes + * all the Unicode code points between the end points. * Convert to Unicode to get the Unicode range. Later we * will convert each code point in the range back to * native. */ @@ -3021,7 +3066,6 @@ S_scan_const(pTHX_ char *start) range_max = UNI_TO_NATIVE(range_max); } #endif - /* Use the characters themselves for the error message if * ASCII printables; otherwise some visible representation * of them */ @@ -3032,32 +3076,41 @@ S_scan_const(pTHX_ char *start) } #ifdef EBCDIC else if (convert_unicode) { - /* diag_listed_as: Invalid range "%s" in transliteration operator */ + /* diag_listed_as: Invalid range "%s" in transliteration operator */ Perl_croak(aTHX_ - "Invalid range \"\\N{U+%04" UVXf "}-\\N{U+%04" UVXf "}\"" - " in transliteration operator", - range_min, range_max); + "Invalid range \"\\N{U+%04" UVXf "}-\\N{U+%04" + UVXf "}\" in transliteration operator", + range_min, range_max); } #endif else { - /* diag_listed_as: Invalid range "%s" in transliteration operator */ + /* diag_listed_as: Invalid range "%s" in transliteration operator */ Perl_croak(aTHX_ - "Invalid range \"\\x{%04" UVXf "}-\\x{%04" UVXf "}\"" - " in transliteration operator", - range_min, range_max); + "Invalid range \"\\x{%04" UVXf "}-\\x{%04" UVXf "}\"" + " in transliteration operator", + range_min, range_max); } } + /* If the range is exactly two code points long, they are + * already both in the output */ + if (UNLIKELY(range_min + 1 == range_max)) { + goto range_done; + } + + /* Here the range contains at least 3 code points */ + if (has_utf8) { - /* We try to avoid creating a swash. If the upper end of - * this range is below 256, this range won't force a swash; - * otherwise it does force a swash, and as long as we have - * to have one, we might as well not expand things out. - * But if it's EBCDIC, we may have to look at each - * character below 256 if we have to convert to/from - * Unicode values */ - if (range_max > 255 + /* If everything in the transliteration is below 256, we + * can avoid special handling later. A translation table + * for each of those bytes is created by op.c. So we + * expand out all ranges to their constituent code points. + * But if we've encountered something above 255, the + * expanding won't help, so skip doing that. But if it's + * EBCDIC, we may have to look at each character below 256 + * if we have to convert to/from Unicode values */ + if ( has_above_latin1 #ifdef EBCDIC && (range_min > 255 || ! convert_unicode) #endif @@ -3065,7 +3118,7 @@ S_scan_const(pTHX_ char *start) /* Move the high character one byte to the right; then * insert between it and the range begin, an illegal * byte which serves to indicate this is a range (using - * a '-' could be ambiguous). */ + * a '-' would be ambiguous). */ char *e = d++; while (e-- > max_ptr) { *(e + 1) = *e; @@ -3087,51 +3140,94 @@ S_scan_const(pTHX_ char *start) } /* Here we need to expand out the string to contain each - * character in the range. Grow the output to handle this */ + * character in the range. Grow the output to handle this. + * For non-UTF8, we need a byte for each code point in the + * range, minus the three that we've already allocated for: the + * hyphen, the min, and the max. For UTF-8, we need this + * plus an extra byte for each code point that occupies two + * bytes (is variant) when in UTF-8 (except we've already + * allocated for the end points, including if they are + * variants). For ASCII platforms and Unicode ranges on EBCDIC + * platforms, it's easy to calculate a precise number. To + * start, we count the variants in the range, which we need + * elsewhere in this function anyway. (For the case where it + * isn't easy to calculate, 'extras' has been initialized to 0, + * and the calculation is done in a loop further down.) */ +#ifdef EBCDIC + if (convert_unicode) +#endif + { + /* This is executed unconditionally on ASCII, and for + * Unicode ranges on EBCDIC. Under these conditions, all + * code points above a certain value are variant; and none + * under that value are. We just need to find out how much + * of the range is above that value. We don't count the + * end points here, as they will already have been counted + * as they were parsed. */ + if (range_min >= UTF_CONTINUATION_MARK) { + + /* The whole range is made up of variants */ + extras = (range_max - 1) - (range_min + 1) + 1; + } + else if (range_max >= UTF_CONTINUATION_MARK) { + + /* Only the higher portion of the range is variants */ + extras = (range_max - 1) - UTF_CONTINUATION_MARK + 1; + } - save_offset = min_ptr - SvPVX_const(sv); + utf8_variant_count += extras; + } - /* The base growth is the number of code points in the range */ - grow = range_max - range_min + 1; - if (has_utf8) { + /* The base growth is the number of code points in the range, + * not including the endpoints, which have already been sized + * for (and output). We don't subtract for the hyphen, as it + * has been parsed but not output, and the SvGROW below is + * based only on what's been output plus what's left to parse. + * */ + grow = (range_max - 1) - (range_min + 1) + 1; - /* But if the output is UTF-8, some of those characters may - * need two bytes (since the maximum range value here is - * 255, the max bytes per character is two). On ASCII - * platforms, it's not much trouble to get an accurate - * count of what's needed. But on EBCDIC, the ones that - * need 2 bytes are scattered around, so just use a worst - * case value instead of calculating for that platform. */ + if (has_utf8) { #ifdef EBCDIC - grow *= 2; -#else - /* Only those above 127 require 2 bytes. This may be - * everything in the range, or not */ - if (range_min > 127) { + /* In some cases in EBCDIC, we haven't yet calculated a + * precise amount needed for the UTF-8 variants. Just + * assume the worst case, that everything will expand by a + * byte */ + if (! convert_unicode) { grow *= 2; } - else if (range_max > 127) { - grow += range_max - 127; - } + else #endif + { + /* Otherwise we know exactly how many variants there + * are in the range. */ + grow += extras; + } } - /* Subtract 3 for the bytes that were already accounted for - * (min, max, and the hyphen) */ - d = save_offset + SvGROW(sv, SvLEN(sv) + grow - 3); + /* Grow, but position the output to overwrite the range min end + * point, because in some cases we overwrite that */ + SvCUR_set(sv, d - SvPVX_const(sv)); + offset_to_min = min_ptr - SvPVX_const(sv); + /* See Note on sizing above. */ + d = offset_to_min + SvGROW(sv, SvCUR(sv) + + (send - s) + + grow + + 1 /* Trailing NUL */ ); + + /* Now, we can expand out the range. */ #ifdef EBCDIC - /* Here, we expand out the range. */ if (convert_unicode) { - IV i; + SSize_t i; /* Recall that the min and max are now in Unicode terms, so * we have to convert each character to its native * equivalent */ if (has_utf8) { for (i = range_min; i <= range_max; i++) { - append_utf8_from_native_byte(LATIN1_TO_NATIVE((U8) i), - (U8 **) &d); + append_utf8_from_native_byte( + LATIN1_TO_NATIVE((U8) i), + (U8 **) &d); } } else { @@ -3144,7 +3240,7 @@ S_scan_const(pTHX_ char *start) #endif /* Always gets run for ASCII, and sometimes for EBCDIC. */ { - IV i; + SSize_t i; /* Here, no conversions are necessary, which means that the * first character in the range is already in 'd' and @@ -3157,21 +3253,38 @@ S_scan_const(pTHX_ char *start) } else { d++; - for (i = range_min + 1; i <= range_max; i++) { + assert(range_min + 1 <= range_max); + for (i = range_min + 1; i < range_max; i++) { +#ifdef EBCDIC + /* In this case on EBCDIC, we haven't calculated + * the variants. Do it here, as we go along */ + if (! UVCHR_IS_INVARIANT(i)) { + utf8_variant_count++; + } +#endif *d++ = (char)i; } + + /* The range_max is done outside the loop so as to + * avoid having to special case not incrementing + * 'utf8_variant_count' on EBCDIC (it's already been + * counted when originally parsed) */ + *d++ = (char) range_max; } } #ifdef EBCDIC - /* If the original range extended above 255, add in that portion. */ + /* If the original range extended above 255, add in that + * portion. */ if (real_range_max) { *d++ = (char) UTF8_TWO_BYTE_HI(0x100); *d++ = (char) UTF8_TWO_BYTE_LO(0x100); - if (real_range_max > 0x101) - *d++ = (char) ILLEGAL_UTF8_BYTE; - if (real_range_max > 0x100) + if (real_range_max > 0x100) { + if (real_range_max > 0x101) { + *d++ = (char) ILLEGAL_UTF8_BYTE; + } d = (char*)uvchr_to_utf8((U8*)d, real_range_max); + } } #endif @@ -3194,8 +3307,7 @@ S_scan_const(pTHX_ char *start) if (!esc) in_charclass = TRUE; } - - else if (*s == ']' && PL_lex_inpat && in_charclass) { + else if (*s == ']' && PL_lex_inpat && in_charclass) { char *s1 = s-1; int esc = 0; while (s1 >= start && *s1-- == '\\') @@ -3203,11 +3315,9 @@ S_scan_const(pTHX_ char *start) if (!esc) in_charclass = FALSE; } - - /* skip for regexp comments /(?#comment)/, except for the last - * char, which will be done separately. - * Stop on (?{..}) and friends */ - + /* skip for regexp comments /(?#comment)/, except for the last + * char, which will be done separately. Stop on (?{..}) and + * friends */ else if (*s == '(' && PL_lex_inpat && s[1] == '?' && !in_charclass) { if (s[2] == '#') { while (s+1 < send && *s != ')') @@ -3220,36 +3330,36 @@ S_scan_const(pTHX_ char *start) break; } } - - /* likewise skip #-initiated comments in //x patterns */ + /* likewise skip #-initiated comments in //x patterns */ else if (*s == '#' && PL_lex_inpat && !in_charclass && ((PMOP*)PL_lex_inpat)->op_pmflags & RXf_PMf_EXTENDED) { - while (s+1 < send && *s != '\n') + while (s < send && *s != '\n') *d++ = *s++; } - - /* no further processing of single-quoted regex */ + /* no further processing of single-quoted regex */ else if (PL_lex_inpat && SvIVX(PL_linestr) == '\'') goto default_action; - /* check for embedded arrays - (@foo, @::foo, @'foo, @{foo}, @$foo, @+, @-) - */ + /* check for embedded arrays + * (@foo, @::foo, @'foo, @{foo}, @$foo, @+, @-) + */ else if (*s == '@' && s[1]) { - if (UTF ? isIDFIRST_utf8((U8*)s+1) : isWORDCHAR_A(s[1])) + if (UTF + ? isIDFIRST_utf8_safe(s+1, send) + : isWORDCHAR_A(s[1])) + { break; + } if (strchr(":'{$", s[1])) break; if (!PL_lex_inpat && (s[1] == '+' || s[1] == '-')) break; /* in regexp, neither @+ nor @- are interpolated */ } - - /* check for embedded scalars. only stop if we're sure it's a - variable. - */ + /* check for embedded scalars. only stop if we're sure it's a + * variable. */ else if (*s == '$') { if (!PL_lex_inpat) /* not a regexp, so $ must be var */ break; @@ -3264,6 +3374,11 @@ S_scan_const(pTHX_ char *start) /* End of else if chain - OP_TRANS rejoin rest */ + if (UNLIKELY(s >= send)) { + assert(s == send); + break; + } + /* backslashes */ if (*s == '\\' && s+1 < send) { char* e; /* Can be used for ending '}', etc. */ @@ -3353,7 +3468,7 @@ S_scan_const(pTHX_ char *start) UTF); if (! valid) { yyerror(error); - continue; + uv = 0; /* drop through to ensure range ends are set */ } goto NUM_ESCAPE_INSERT; } @@ -3371,51 +3486,68 @@ S_scan_const(pTHX_ char *start) UTF); if (! valid) { yyerror(error); - continue; + uv = 0; /* drop through to ensure range ends are set */ } } NUM_ESCAPE_INSERT: /* Insert oct or hex escaped character. */ - + /* Here uv is the ordinal of the next character being added */ if (UVCHR_IS_INVARIANT(uv)) { *d++ = (char) uv; } else { if (!has_utf8 && uv > 255) { - /* Might need to recode whatever we have accumulated so - * far if it contains any chars variant in utf8 or - * utf-ebcdic. */ - - SvCUR_set(sv, d - SvPVX_const(sv)); - SvPOK_on(sv); - *d = '\0'; - /* See Note on sizing above. */ - sv_utf8_upgrade_flags_grow( - sv, - SV_GMAGIC|SV_FORCE_UTF8_UPGRADE - /* Above-latin1 in string - * implies no encoding */ - |SV_UTF8_NO_ENCODING, - UVCHR_SKIP(uv) + (STRLEN)(send - s) + 1); - d = SvPVX(sv) + SvCUR(sv); - has_utf8 = TRUE; + + /* Here, 'uv' won't fit unless we convert to UTF-8. + * If we've only seen invariants so far, all we have to + * do is turn on the flag */ + if (utf8_variant_count == 0) { + SvUTF8_on(sv); + } + else { + SvCUR_set(sv, d - SvPVX_const(sv)); + SvPOK_on(sv); + *d = '\0'; + + sv_utf8_upgrade_flags_grow( + sv, + SV_GMAGIC|SV_FORCE_UTF8_UPGRADE, + + /* Since we're having to grow here, + * make sure we have enough room for + * this escape and a NUL, so the + * code immediately below won't have + * to actually grow again */ + UVCHR_SKIP(uv) + + (STRLEN)(send - s) + 1); + d = SvPVX(sv) + SvCUR(sv); + } + + has_above_latin1 = TRUE; + has_utf8 = TRUE; } - if (has_utf8) { + if (! has_utf8) { + *d++ = (char)uv; + utf8_variant_count++; + } + else { /* Usually, there will already be enough room in 'sv' * since such escapes are likely longer than any UTF-8 * sequence they can end up as. This isn't the case on * EBCDIC where \x{40000000} contains 12 bytes, and the * UTF-8 for it contains 14. And, we have to allow for * a trailing NUL. It probably can't happen on ASCII - * platforms, but be safe */ - const STRLEN needed = d - SvPVX(sv) + UVCHR_SKIP(uv) + * platforms, but be safe. See Note on sizing above. */ + const STRLEN needed = d - SvPVX(sv) + + UVCHR_SKIP(uv) + + (send - s) + 1; if (UNLIKELY(needed > SvLEN(sv))) { SvCUR_set(sv, d - SvPVX_const(sv)); - d = sv_grow(sv, needed) + SvCUR(sv); + d = SvCUR(sv) + SvGROW(sv, needed); } d = (char*)uvchr_to_utf8((U8*)d, uv); @@ -3426,9 +3558,6 @@ S_scan_const(pTHX_ char *start) (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF); } - } - else { - *d++ = (char)uv; } } #ifdef EBCDIC @@ -3476,7 +3605,7 @@ S_scan_const(pTHX_ char *start) * braces */ s++; if (*s != '{') { - yyerror("Missing braces on \\N{}"); + yyerror("Missing braces on \\N{}"); continue; } s++; @@ -3542,16 +3671,27 @@ S_scan_const(pTHX_ char *start) if (! has_utf8 && ( uv > 0xFF || PL_lex_inwhat != OP_TRANS)) { + /* See Note on sizing above. */ + const STRLEN extra = OFFUNISKIP(uv) + (send - e) + 1; + SvCUR_set(sv, d - SvPVX_const(sv)); SvPOK_on(sv); *d = '\0'; - /* See Note on sizing above. */ - sv_utf8_upgrade_flags_grow( - sv, - SV_GMAGIC|SV_FORCE_UTF8_UPGRADE, - OFFUNISKIP(uv) + (STRLEN)(send - e) + 1); - d = SvPVX(sv) + SvCUR(sv); + + if (utf8_variant_count == 0) { + SvUTF8_on(sv); + d = SvCUR(sv) + SvGROW(sv, SvCUR(sv) + extra); + } + else { + sv_utf8_upgrade_flags_grow( + sv, + SV_GMAGIC|SV_FORCE_UTF8_UPGRADE, + extra); + d = SvPVX(sv) + SvCUR(sv); + } + has_utf8 = TRUE; + has_above_latin1 = TRUE; } /* Add the (Unicode) code point to the output. */ @@ -3696,34 +3836,49 @@ S_scan_const(pTHX_ char *start) (int) (e + 1 - start), start)); goto end_backslash_N; } + + if (SvUTF8(res) && UTF8_IS_ABOVE_LATIN1(*str)) { + has_above_latin1 = TRUE; + } + } 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/// */ - sv_utf8_upgrade_flags(res, SV_UTF8_NO_ENCODING); + sv_utf8_upgrade_flags(res, 0); str = SvPV_const(res, len); } /* Upgrade destination to be utf8 if this new * component is */ if (! has_utf8 && SvUTF8(res)) { + /* See Note on sizing above. */ + const STRLEN extra = len + (send - s) + 1; + SvCUR_set(sv, d - SvPVX_const(sv)); SvPOK_on(sv); *d = '\0'; - /* See Note on sizing above. */ - sv_utf8_upgrade_flags_grow(sv, + + if (utf8_variant_count == 0) { + SvUTF8_on(sv); + d = SvCUR(sv) + SvGROW(sv, SvCUR(sv) + extra); + } + else { + sv_utf8_upgrade_flags_grow(sv, SV_GMAGIC|SV_FORCE_UTF8_UPGRADE, - len + (STRLEN)(send - s) + 1); - d = SvPVX(sv) + SvCUR(sv); + extra); + d = SvPVX(sv) + SvCUR(sv); + } has_utf8 = TRUE; } else if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */ /* See Note on sizing above. (NOTE: SvCUR() is not * set correctly here). */ + const STRLEN extra = len + (send - e) + 1; const STRLEN off = d - SvPVX_const(sv); - d = off + SvGROW(sv, off + len + (STRLEN)(send - s) + 1); + d = off + SvGROW(sv, off + extra); } Copy(str, d, len, char); d += len; @@ -3787,42 +3942,61 @@ S_scan_const(pTHX_ char *start) * to/from UTF-8. * * If the input has the same representation in UTF-8 as not, it will be - * a single byte, and we don't care about UTF8ness; or if neither - * source nor output is UTF-8, just copy the byte */ - if (NATIVE_BYTE_IS_INVARIANT((U8)(*s)) || (! this_utf8 && ! has_utf8)) - { + * a single byte, and we don't care about UTF8ness; just copy the byte */ + if (NATIVE_BYTE_IS_INVARIANT((U8)(*s))) { *d++ = *s++; } - else { - STRLEN len = 1; + else if (! this_utf8 && ! has_utf8) { + /* If neither source nor output is UTF-8, is also a single byte, + * just copy it; but this byte counts should we later have to + * convert to UTF-8 */ + *d++ = *s++; + utf8_variant_count++; + } + else if (this_utf8 && has_utf8) { /* Both UTF-8, can just copy */ + const STRLEN len = UTF8SKIP(s); - /* One might think that it is wasted effort in the case of the - * source being utf8 (this_utf8 == TRUE) to take the next character - * in the source, convert it to an unsigned value, and then convert - * it back again. But the source has not been validated here. The - * routine that does the conversion checks for errors like - * malformed utf8 */ + /* We expect the source to have already been checked for + * malformedness */ + assert(isUTF8_CHAR((U8 *) s, (U8 *) send)); + Copy(s, d, len, U8); + d += len; + s += len; + } + else { /* UTF8ness matters and doesn't match, need to convert */ + STRLEN len = 1; const UV nextuv = (this_utf8) ? utf8n_to_uvchr((U8*)s, send - s, &len, 0) : (UV) ((U8) *s); - const STRLEN need = UVCHR_SKIP(nextuv); + STRLEN need = UVCHR_SKIP(nextuv); + if (!has_utf8) { SvCUR_set(sv, d - SvPVX_const(sv)); SvPOK_on(sv); *d = '\0'; - /* See Note on sizing above. */ - sv_utf8_upgrade_flags_grow(sv, - SV_GMAGIC|SV_FORCE_UTF8_UPGRADE, - need + (STRLEN)(send - s) + 1); - d = SvPVX(sv) + SvCUR(sv); + + /* See Note on sizing above. */ + need += (STRLEN)(send - s) + 1; + + if (utf8_variant_count == 0) { + SvUTF8_on(sv); + d = SvCUR(sv) + SvGROW(sv, SvCUR(sv) + need); + } + else { + sv_utf8_upgrade_flags_grow(sv, + SV_GMAGIC|SV_FORCE_UTF8_UPGRADE, + need); + d = SvPVX(sv) + SvCUR(sv); + } has_utf8 = TRUE; } else if (need > len) { /* encoded value larger than old, may need extra space (NOTE: * SvCUR() is not set correctly here). See Note on sizing * above. */ + const STRLEN extra = need + (send - s) + 1; const STRLEN off = d - SvPVX_const(sv); - d = SvGROW(sv, off + need + (STRLEN)(send - s) + 1) + off; + d = off + SvGROW(sv, off + extra); } s += len; @@ -3976,7 +4150,7 @@ S_intuit_more(pTHX_ char *s) case '&': case '$': weight -= seen[un_char] * 10; - if (isWORDCHAR_lazy_if(s+1,UTF)) { + if (isWORDCHAR_lazy_if_safe(s+1, PL_bufend, UTF)) { int len; char *tmp = PL_bufend; PL_bufend = (char*)send; @@ -4207,7 +4381,7 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) STRLEN const last_lop_pos = PL_parser->last_lop ? PL_parser->last_lop - buf : 0; av_push(PL_rsfp_filters, linestr); - PL_parser->linestr = + PL_parser->linestr = newSVpvn(SvPVX(linestr), ++s-SvPVX(linestr)); buf = SvPVX(PL_parser->linestr); PL_parser->bufend = buf + SvCUR(PL_parser->linestr); @@ -4451,12 +4625,18 @@ static void S_check_scalar_slice(pTHX_ char *s) { s++; - while (*s == ' ' || *s == '\t') s++; - if (*s == 'q' && s[1] == 'w' - && !isWORDCHAR_lazy_if(s+2,UTF)) + while (SPACE_OR_TAB(*s)) s++; + if (*s == 'q' && s[1] == 'w' && !isWORDCHAR_lazy_if_safe(s+2, + PL_bufend, + UTF)) + { return; - while (*s && (isWORDCHAR_lazy_if(s,UTF) || strchr(" \t$#+-'\"", *s))) - s += UTF ? UTF8SKIP(s) : 1; + } + while ( isWORDCHAR_lazy_if_safe(s, PL_bufend, UTF) + || (*s && strchr(" \t$#+-'\"", *s))) + { + s += UTF ? UTF8SKIP(s) : 1; + } if (*s == '}' || *s == ']') pl_yylval.ival = OPpSLICEWARNING; } @@ -4863,7 +5043,7 @@ Perl_yylex(pTHX) break; } s = skipspace(s); - if (isIDFIRST_lazy_if(s, UTF)) { + if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) { char *dest = PL_tokenbuf + 1; /* read var name, including sigil, into PL_tokenbuf */ PL_tokenbuf[0] = sigil; @@ -4902,13 +5082,12 @@ Perl_yylex(pTHX) default: if (UTF) { if (! isUTF8_CHAR((U8 *) s, (U8 *) PL_bufend)) { - ENTER; - SAVESPTR(PL_warnhook); - PL_warnhook = PERL_WARNHOOK_FATAL; - utf8n_to_uvchr((U8*)s, PL_bufend-s, NULL, 0); - LEAVE; + _force_out_malformed_utf8_message((U8 *) s, (U8 *) PL_bufend, + 0, + 1 /* 1 means die */ ); + NOT_REACHED; /* NOTREACHED */ } - if (isIDFIRST_utf8((U8*)s)) { + if (isIDFIRST_utf8_safe(s, PL_bufend)) { goto keylookup; } } @@ -5441,7 +5620,7 @@ Perl_yylex(pTHX) PL_expect = XPOSTDEREF; TOKEN(ARROW); } - if (isIDFIRST_lazy_if(s,UTF)) { + if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) { s = force_word(s,METHOD,FALSE,TRUE); TOKEN(ARROW); } @@ -5626,7 +5805,7 @@ Perl_yylex(pTHX) grabattrs: s = skipspace(s); attrs = NULL; - while (isIDFIRST_lazy_if(s,UTF)) { + while (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) { I32 tmp; SV *sv; d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); @@ -5668,7 +5847,8 @@ Perl_yylex(pTHX) if (len == 6 && strnEQ(SvPVX(sv), "unique", len)) { sv_free(sv); if (PL_in_my == KEY_our) { - deprecate(":unique"); + deprecate_disappears_in("5.28", + "Attribute \"unique\" is deprecated"); } else Perl_croak(aTHX_ "The 'unique' attribute may only be applied to 'our' variables"); @@ -5682,7 +5862,8 @@ Perl_yylex(pTHX) } else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "locked", len)) { sv_free(sv); - deprecate(":locked"); + deprecate_disappears_in("5.28", + "Attribute \"locked\" is deprecated"); } else if (!PL_in_my && len == 6 && strnEQ(SvPVX(sv), "method", len)) { sv_free(sv); @@ -5832,7 +6013,7 @@ Perl_yylex(pTHX) while (d < PL_bufend && SPACE_OR_TAB(*d)) d++; } - if (d < PL_bufend && isIDFIRST_lazy_if(d,UTF)) { + if (d < PL_bufend && isIDFIRST_lazy_if_safe(d, PL_bufend, UTF)) { d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE, &len); while (d < PL_bufend && SPACE_OR_TAB(*d)) @@ -5952,13 +6133,19 @@ Perl_yylex(pTHX) } else /* skip plain q word */ - while (t < PL_bufend && isWORDCHAR_lazy_if(t,UTF)) + while ( t < PL_bufend + && isWORDCHAR_lazy_if_safe(t, PL_bufend, UTF)) + { t += UTF ? UTF8SKIP(t) : 1; + } } - else if (isWORDCHAR_lazy_if(t,UTF)) { + else if (isWORDCHAR_lazy_if_safe(t, PL_bufend, UTF)) { t += UTF ? UTF8SKIP(t) : 1; - while (t < PL_bufend && isWORDCHAR_lazy_if(t,UTF)) + while ( t < PL_bufend + && isWORDCHAR_lazy_if_safe(t, PL_bufend, UTF)) + { t += UTF ? UTF8SKIP(t) : 1; + } } while (t < PL_bufend && isSPACE(*t)) t++; @@ -6053,8 +6240,9 @@ Perl_yylex(pTHX) } s--; if (PL_expect == XOPERATOR) { - if (PL_bufptr == PL_linestart && ckWARN(WARN_SEMICOLON) - && isIDFIRST_lazy_if(s,UTF)) + if ( PL_bufptr == PL_linestart + && ckWARN(WARN_SEMICOLON) + && isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) { CopLINE_dec(PL_curcop); Perl_warner(aTHX_ packWARN(WARN_SEMICOLON), "%s", PL_warn_nosemi); @@ -6336,7 +6524,10 @@ Perl_yylex(pTHX) POSTDEREF('$'); } - if (s[1] == '#' && (isIDFIRST_lazy_if(s+2,UTF) || strchr("{$:+-@", s[2]))) { + if ( s[1] == '#' + && ( isIDFIRST_lazy_if_safe(s+2, PL_bufend, UTF) + || strchr("{$:+-@", s[2]))) + { PL_tokenbuf[0] = '@'; s = scan_ident(s + 1, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE); @@ -6385,8 +6576,12 @@ Perl_yylex(pTHX) if (ckWARN(WARN_SYNTAX)) { char *t = s+1; - while (isSPACE(*t) || isWORDCHAR_lazy_if(t,UTF) || *t == '$') + while ( isSPACE(*t) + || isWORDCHAR_lazy_if_safe(t, PL_bufend, UTF) + || *t == '$') + { t += UTF ? UTF8SKIP(t) : 1; + } if (*t++ == ',') { PL_bufptr = skipspace(PL_bufptr); /* XXX can realloc */ while (t < PL_bufend && *t != ']') @@ -6407,17 +6602,21 @@ Perl_yylex(pTHX) do { t++; } while (isSPACE(*t)); - if (isIDFIRST_lazy_if(t,UTF)) { + if (isIDFIRST_lazy_if_safe(t, PL_bufend, UTF)) { STRLEN len; t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len); while (isSPACE(*t)) t++; - if (*t == ';' - && get_cvn_flags(tmpbuf, len, UTF ? SVf_UTF8 : 0)) + if ( *t == ';' + && get_cvn_flags(tmpbuf, len, UTF + ? SVf_UTF8 + : 0)) + { Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "You need to quote \"%" UTF8f "\"", UTF8fARG(UTF, len, tmpbuf)); + } } } } @@ -6430,9 +6629,12 @@ Perl_yylex(pTHX) PL_expect = XOPERATOR; else if (strchr("$@\"'`q", *s)) PL_expect = XTERM; /* e.g. print $fh "foo" */ - else if (strchr("&*<%", *s) && isIDFIRST_lazy_if(s+1,UTF)) + else if ( strchr("&*<%", *s) + && isIDFIRST_lazy_if_safe(s+1, PL_bufend, UTF)) + { PL_expect = XTERM; /* e.g. print $fh &sub */ - else if (isIDFIRST_lazy_if(s,UTF)) { + } + else if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) { char tmpbuf[sizeof PL_tokenbuf]; int t2; scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len); @@ -6531,10 +6733,10 @@ Perl_yylex(pTHX) } else { /* Disable warning on "study /blah/" */ - if (PL_oldoldbufptr == PL_last_uni - && (*PL_last_uni != 's' || s - PL_last_uni < 5 - || memNE(PL_last_uni, "study", 5) - || isWORDCHAR_lazy_if(PL_last_uni+5,UTF) + if ( PL_oldoldbufptr == PL_last_uni + && ( *PL_last_uni != 's' || s - PL_last_uni < 5 + || memNE(PL_last_uni, "study", 5) + || isWORDCHAR_lazy_if_safe(PL_last_uni+5, PL_bufend, UTF) )) check_uni(); s = scan_pat(s,OP_MATCH); @@ -6904,8 +7106,10 @@ Perl_yylex(pTHX) else { /* no override */ tmp = -tmp; if (tmp == KEY_dump) { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), - "dump() better written as CORE::dump()"); + Perl_ck_warner_d(aTHX_ packWARN2(WARN_MISC,WARN_DEPRECATED), + "dump() better written as CORE::dump(). " + "dump() will no longer be available " + "in Perl 5.30"); } gv = NULL; gvp = 0; @@ -7061,8 +7265,8 @@ Perl_yylex(pTHX) s = skipspace(s); /* Two barewords in a row may indicate method call. */ - - if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') + if ( ( isIDFIRST_lazy_if_safe(s, PL_bufend, UTF) + || *s == '$') && (tmp = intuit_method(s, lex ? NULL : sv, cv))) { goto method; @@ -7147,9 +7351,11 @@ Perl_yylex(pTHX) /* If followed by a bareword, see if it looks like indir obj. */ - if (tmp == 1 && !orig_keyword - && (isIDFIRST_lazy_if(s,UTF) || *s == '$') - && (tmp = intuit_method(s, lex ? NULL : sv, cv))) { + if ( tmp == 1 + && !orig_keyword + && (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF) || *s == '$') + && (tmp = intuit_method(s, lex ? NULL : sv, cv))) + { method: if (lex && !off) { assert(cSVOPx(pl_yylval.opval)->op_sv == sv); @@ -7588,7 +7794,7 @@ Perl_yylex(pTHX) case KEY_exists: UNI(OP_EXISTS); - + case KEY_exit: UNI(OP_EXIT); @@ -7643,7 +7849,9 @@ Perl_yylex(pTHX) return REPORT(0); pl_yylval.ival = CopLINE(PL_curcop); s = skipspace(s); - if (PL_expect == XSTATE && isIDFIRST_lazy_if(s,UTF)) { + if ( PL_expect == XSTATE + && isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) + { char *p = s; if ((PL_bufend - p) >= 3 @@ -7656,7 +7864,7 @@ Perl_yylex(pTHX) p += 3; p = skipspace(p); /* skip optional package name, as in "for my abc $x (..)" */ - if (isIDFIRST_lazy_if(p,UTF)) { + if (isIDFIRST_lazy_if_safe(p, PL_bufend, UTF)) { p = scan_word(p, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); p = skipspace(p); } @@ -7822,7 +8030,7 @@ Perl_yylex(pTHX) case KEY_last: LOOPX(OP_LAST); - + case KEY_lc: UNI(OP_LC); @@ -7899,7 +8107,7 @@ Perl_yylex(pTHX) } PL_in_my = (U16)tmp; s = skipspace(s); - if (isIDFIRST_lazy_if(s,UTF)) { + if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) { s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len); if (len == 3 && strEQs(PL_tokenbuf, "sub")) goto really_sub; @@ -7949,10 +8157,10 @@ Perl_yylex(pTHX) case KEY_open: s = skipspace(s); - if (isIDFIRST_lazy_if(s,UTF)) { - const char *t; - d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, - &len); + if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) { + const char *t; + d = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, + &len); for (t=d; isSPACE(*t);) t++; if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE) @@ -8002,7 +8210,7 @@ Perl_yylex(pTHX) case KEY_pos: UNIDOR(OP_POS); - + case KEY_pack: LOP(OP_PACK,XTERM); @@ -8109,9 +8317,13 @@ Perl_yylex(pTHX) { *PL_tokenbuf = '\0'; s = force_word(s,BAREWORD,TRUE,TRUE); - if (isIDFIRST_lazy_if(PL_tokenbuf,UTF)) + if (isIDFIRST_lazy_if_safe(PL_tokenbuf, + PL_tokenbuf + sizeof(PL_tokenbuf), + UTF)) + { gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), GV_ADD | (UTF ? SVf_UTF8 : 0)); + } else if (*s == '<') yyerror("<> at require-statement should be quotes"); } @@ -8119,7 +8331,7 @@ Perl_yylex(pTHX) orig_keyword = 0; pl_yylval.ival = 1; } - else + else pl_yylval.ival = 0; PL_expect = PL_nexttoke ? XOPERATOR : XTERM; PL_bufptr = s; @@ -8186,7 +8398,7 @@ Perl_yylex(pTHX) case KEY_chomp: UNI(OP_CHOMP); - + case KEY_scalar: UNI(OP_SCALAR); @@ -8313,7 +8525,7 @@ Perl_yylex(pTHX) s = skipspace(s); d = SvPVX(PL_linestr)+off; - if (isIDFIRST_lazy_if(s,UTF) + if ( isIDFIRST_lazy_if_safe(s, PL_bufend, UTF) || *s == '\'' || (*s == ':' && s[1] == ':')) { @@ -8759,10 +8971,10 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what) s++; while (s < PL_bufend && isSPACE(*s)) s++; - if (isIDFIRST_lazy_if(s,UTF)) { + if (isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) { const char * const w = s; s += UTF ? UTF8SKIP(s) : 1; - while (isWORDCHAR_lazy_if(s,UTF)) + while (isWORDCHAR_lazy_if_safe(s, PL_bufend, UTF)) s += UTF ? UTF8SKIP(s) : 1; while (s < PL_bufend && isSPACE(*s)) s++; @@ -8826,7 +9038,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen, || ! SvOK(*cvp)) { char *msg; - + /* Here haven't found what we're looking for. If it is charnames, * perhaps it needs to be loaded. Try doing that before giving up */ if (*key == 'c') { @@ -8935,21 +9147,23 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen, PERL_STATIC_INLINE void S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, - bool is_utf8, bool check_dollar) { + bool is_utf8, bool check_dollar) +{ PERL_ARGS_ASSERT_PARSE_IDENT; - for (;;) { + while (*s < PL_bufend) { if (*d >= e) Perl_croak(aTHX_ "%s", ident_too_long); - if (is_utf8 && isIDFIRST_utf8((U8*)*s)) { + if (is_utf8 && isIDFIRST_utf8_safe(*s, PL_bufend)) { /* The UTF-8 case must come first, otherwise things * like c\N{COMBINING TILDE} would start failing, as the * isWORDCHAR_A case below would gobble the 'c' up. */ char *t = *s + UTF8SKIP(*s); - while (isIDCONT_utf8((U8*)t)) + while (isIDCONT_utf8_safe((const U8*) t, (const U8*) PL_bufend)) { t += UTF8SKIP(t); + } if (*d + (t - *s) > e) Perl_croak(aTHX_ "%s", ident_too_long); Copy(*s, *d, t - *s, char); @@ -8961,7 +9175,10 @@ S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, *(*d)++ = *(*s)++; } while (isWORDCHAR_A(**s) && *d < e); } - else if (allow_package && **s == '\'' && isIDFIRST_lazy_if(*s+1,is_utf8)) { + else if ( allow_package + && **s == '\'' + && isIDFIRST_lazy_if_safe((*s)+1, PL_bufend, is_utf8)) + { *(*d)++ = ':'; *(*d)++ = ':'; (*s)++; @@ -9012,10 +9229,10 @@ S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN * Because all ASCII characters have the same representation whether * encoded in UTF-8 or not, we can use the foo_A macros below and '\0' and * '{' without knowing if is UTF-8 or not. */ -#define VALID_LEN_ONE_IDENT(s, is_utf8) \ - (isGRAPH_A(*(s)) || ((is_utf8) \ - ? isIDFIRST_utf8((U8*) (s)) \ - : (isGRAPH_L1(*s) \ +#define VALID_LEN_ONE_IDENT(s, e, is_utf8) \ + (isGRAPH_A(*(s)) || ((is_utf8) \ + ? isIDFIRST_utf8_safe(s, e) \ + : (isGRAPH_L1(*s) \ && LIKELY((U8) *(s) != LATIN1_TO_NATIVE(0xAD))))) STATIC char * @@ -9056,7 +9273,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) /* Here, it is not a run-of-the-mill identifier name */ if (*s == '$' && s[1] - && (isIDFIRST_lazy_if(s+1,is_utf8) + && ( isIDFIRST_lazy_if_safe(s+1, PL_bufend, is_utf8) || isDIGIT_A((U8)s[1]) || s[1] == '$' || s[1] == '{' @@ -9079,7 +9296,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) if ((s <= PL_bufend - (is_utf8) ? UTF8SKIP(s) : 1) - && VALID_LEN_ONE_IDENT(s, is_utf8)) + && VALID_LEN_ONE_IDENT(s, PL_bufend, is_utf8)) { if (is_utf8) { const STRLEN skip = UTF8SKIP(s); @@ -9107,7 +9324,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) bool skip; char *s2; /* If we were processing {...} notation then... */ - if (isIDFIRST_lazy_if(d,is_utf8)) { + if (isIDFIRST_lazy_if_safe(d, e, is_utf8)) { /* if it starts as a valid identifier, assume that it is one. (the later check for } being at the expected point will trap cases where this doesn't pan out.) */ @@ -9160,7 +9377,7 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) s2 = peekspace(s); else s2 = s; - + /* Expect to find a closing } after consuming any trailing whitespace. */ if (*s2 == '}') { @@ -9223,7 +9440,7 @@ S_pmflag(pTHX_ const char* const valid_flags, U32 * pmfl, char** s, char* charse STRLEN charlen = UTF ? UTF8SKIP(*s) : 1; if ( charlen != 1 || ! strchr(valid_flags, c) ) { - if (isWORDCHAR_lazy_if(*s, UTF)) { + if (isWORDCHAR_lazy_if_safe( *s, PL_bufend, UTF)) { yyerror_pv(Perl_form(aTHX_ "Unknown regexp modifier \"/%.*s\"", (int)charlen, *s), UTF ? SVf_UTF8 : 0); (*s) += charlen; @@ -9367,14 +9584,10 @@ S_scan_pat(pTHX_ char *start, I32 type) /* issue a warning if /c is specified,but /g is not */ if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)) { - Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), + Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless without /g" ); } - if (UNLIKELY((x_mod_count) > 1)) { - yyerror("Only one /x regex modifier is allowed"); - } - PL_lex_op = (OP*)pm; pl_yylval.ival = OP_MATCH; return s; @@ -9429,10 +9642,6 @@ S_scan_subst(pTHX_ char *start) } } - if (UNLIKELY((x_mod_count) > 1)) { - yyerror("Only one /x regex modifier is allowed"); - } - if ((pm->op_pmflags & PMf_CONTINUE)) { Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" ); } @@ -9467,7 +9676,8 @@ S_scan_subst(pTHX_ char *start) * spreads over */ sv_upgrade(PL_parser->lex_sub_repl, SVt_PVNV); ((XPVNV*)SvANY(PL_parser->lex_sub_repl))->xnv_u.xnv_lines = 0; - ((XPVIV*)SvANY(PL_parser->lex_sub_repl))->xiv_u.xivu_eval_seen = es; + ((XPVIV*)SvANY(PL_parser->lex_sub_repl))->xiv_u.xivu_eval_seen = + cBOOL(es); } PL_lex_op = (OP*)pm; @@ -9607,10 +9817,12 @@ S_scan_heredoc(pTHX_ char *s) s++, term = '\''; else term = '"'; - if (!isWORDCHAR_lazy_if(s,UTF)) - deprecate("bare << to mean <<\"\""); + if (! isWORDCHAR_lazy_if_safe(s, PL_bufend, UTF)) + deprecate_fatal_in("5.28", "Use of bare << to mean <<\"\" is deprecated"); peek = s; - while (isWORDCHAR_lazy_if(peek,UTF)) { + while ( + isWORDCHAR_lazy_if_safe(peek, PL_bufend, UTF)) + { peek += UTF ? UTF8SKIP(peek) : 1; } len = (peek - s >= e - d) ? (e - d) : (peek - s); @@ -9725,7 +9937,7 @@ S_scan_heredoc(pTHX_ char *s) /* Only valid if it's preceded by whitespace only */ while (backup != myolds && --backup >= myolds) { - if (*backup != ' ' && *backup != '\t') { + if (! SPACE_OR_TAB(*backup)) { break; } @@ -9861,14 +10073,14 @@ S_scan_heredoc(pTHX_ char *s) /* Only valid if it's preceded by whitespace only */ while (backup != s && --backup >= s) { - if (*backup != ' ' && *backup != '\t') { + if (! SPACE_OR_TAB(*backup)) { break; } indent_len++; } /* All whitespace or none! */ - if (backup == found || *backup == ' ' || *backup == '\t') { + if (backup == found || SPACE_OR_TAB(*backup)) { Newxz(indent, indent_len + 1, char); memcpy(indent, backup, indent_len); SvREFCNT_dec(PL_linestr); @@ -10027,8 +10239,9 @@ S_scan_inputsymbol(pTHX_ char *start) if (*d == '$' && d[1]) d++; /* allow or */ - while (*d && (isWORDCHAR_lazy_if(d,UTF) || *d == '\'' || *d == ':')) + while (isWORDCHAR_lazy_if_safe(d, e, UTF) || *d == '\'' || *d == ':') { d += UTF ? UTF8SKIP(d) : 1; + } /* If we've tried to read what we allow filehandles to look like, and there's still text left, then it must be a glob() and not a getline. @@ -10155,7 +10368,7 @@ S_scan_inputsymbol(pTHX_ char *start) ($*@) sub prototypes sub foo ($) (stuff) sub attr parameters sub foo : attr(stuff) <> readline or globs , <>, <$fh>, or <*.c> - + In most of these cases (all but <>, patterns and transliterate) yylex() calls scan_str(). m// makes yylex() call scan_pat() which calls scan_str(). s/// makes yylex() call scan_subst() which calls @@ -10192,6 +10405,18 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re STRLEN termlen; /* length of terminating string */ line_t herelines; + /* The delimiters that have a mirror-image closing one */ + const char * opening_delims = "([{<"; + const char * closing_delims = ")]}>"; + + const char * non_grapheme_msg = "Use of unassigned code point or" + " non-standalone grapheme for a delimiter" + " will be a fatal error starting in Perl" + " v5.30"; + /* The only non-UTF character that isn't a stand alone grapheme is + * white-space, hence can't be a delimiter. So can skip for non-UTF-8 */ + bool check_grapheme = UTF && ckWARN_d(WARN_DEPRECATED); + PERL_ARGS_ASSERT_SCAN_STR; /* skip space before the delimiter */ @@ -10204,15 +10429,35 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re /* after skipping whitespace, the next character is the terminator */ term = *s; - if (!UTF) { + if (!UTF || UTF8_IS_INVARIANT(term)) { termcode = termstr[0] = term; termlen = 1; } else { termcode = utf8_to_uvchr_buf((U8*)s, (U8*)PL_bufend, &termlen); + if (check_grapheme) { + if ( UNLIKELY(UNICODE_IS_SUPER(termcode)) + || UNLIKELY(UNICODE_IS_NONCHAR(termcode))) + { + /* These are considered graphemes, and since the ending + * delimiter will be the same, we don't have to check the other + * end */ + check_grapheme = FALSE; + } + else if (UNLIKELY(! _is_grapheme((U8 *) start, + (U8 *) s, + (U8 *) PL_bufend, + termcode))) + { + Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), "%s", non_grapheme_msg); + + /* Don't have to check the other end, as have already warned at + * this one */ + check_grapheme = FALSE; + } + } + Copy(s, termstr, termlen, U8); - if (!UTF8_IS_INVARIANT(term)) - has_utf8 = TRUE; } /* mark where we are */ @@ -10220,9 +10465,10 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re PL_multi_open = termcode; herelines = PL_parser->herelines; - /* find corresponding closing delimiter */ - if (term && (tmps = strchr("([{< )]}> )]}>",term))) - termcode = termstr[0] = term = tmps[5]; + /* If the delimiter has a mirror-image closing one, get it */ + if (term && (tmps = strchr(opening_delims, term))) { + termcode = termstr[0] = term = closing_delims[tmps - opening_delims]; + } PL_multi_close = termcode; @@ -10269,6 +10515,15 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re if (termlen == 1) break; if (s+termlen <= PL_bufend && memEQ(s, (char*)termstr, termlen)) + if ( check_grapheme + && UNLIKELY(! _is_grapheme((U8 *) start, + (U8 *) s, + (U8 *) PL_bufend, + termcode))) + { + Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), + "%s", non_grapheme_msg); + } break; } else if (!has_utf8 && !UTF8_IS_INVARIANT((U8)*s) && UTF) @@ -10276,7 +10531,7 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re *to = *s; } } - + /* if the terminator isn't the same as the start character (e.g., matched brackets), we have to allow more in the quoting, and be prepared for nested brackets. @@ -10334,7 +10589,7 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re else if (to - SvPVX_const(sv) == 1 && to[-1] == '\r') to[-1] = '\n'; #endif - + /* if we're out of file, or a read fails, bail and reset the current line marker so we can report where the unterminated string began */ @@ -10345,7 +10600,7 @@ S_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int re CopLINE_set(PL_curcop, (line_t)PL_multi_start); return NULL; } - s = PL_bufptr; + s = start = PL_bufptr; } /* at this point, we have successfully read the delimited string */ @@ -10413,6 +10668,15 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) bool floatit; /* boolean: int or float? */ const char *lastub = NULL; /* position of last underbar */ static const char* const number_too_long = "Number too long"; + bool warned_about_underscore = 0; +#define WARN_ABOUT_UNDERSCORE() \ + do { \ + if (!warned_about_underscore) { \ + warned_about_underscore = 1; \ + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), \ + "Misplaced _ in number"); \ + } \ + } while(0) /* Hexadecimal floating point. * * In many places (where we have quads and NV is IEEE 754 double) @@ -10497,8 +10761,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } if (*s == '_') { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s++; } @@ -10521,8 +10784,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* _ are ignored -- but warned about if consecutive */ case '_': if (lastub && s == lastub + 1) - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s++; break; @@ -10607,9 +10869,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) out: /* final misplaced underbar check */ - if (s[-1] == '_') { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); - } + if (s[-1] == '_') + WARN_ABOUT_UNDERSCORE(); if (UNLIKELY(HEXFP_PEEK(s))) { /* Do sloppy (on the underbars) but quick detection @@ -10818,8 +11079,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) */ if (*s == '_') { if (lastub && s == lastub + 1) - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s++; } else { @@ -10832,9 +11092,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } /* final misplaced underbar check */ - if (lastub && s == lastub + 1) { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Misplaced _ in number"); - } + if (lastub && s == lastub + 1) + WARN_ABOUT_UNDERSCORE(); /* read a decimal portion if there is one. avoid 3..5 being interpreted as the number 3. followed @@ -10845,8 +11104,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) *d++ = *s++; if (*s == '_') { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s; } @@ -10862,18 +11120,15 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) Perl_croak(aTHX_ "%s", number_too_long); if (*s == '_') { if (lastub && s == lastub + 1) - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s; } else *d++ = *s; } /* fractional part ending in underbar? */ - if (s[-1] == '_') { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); - } + if (s[-1] == '_') + WARN_ABOUT_UNDERSCORE(); if (*s == '.' && isDIGIT(s[1])) { /* oops, it's really a v-string, but without the "v" */ s = start; @@ -10903,8 +11158,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* stray preinitial _ */ if (*s == '_') { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s++; } @@ -10914,8 +11168,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) /* stray initial _ */ if (*s == '_') { - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s++; } @@ -10929,8 +11182,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) else { if (((lastub && s == lastub + 1) || (!isDIGIT(s[1]) && s[1] != '_'))) - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), - "Misplaced _ in number"); + WARN_ABOUT_UNDERSCORE(); lastub = s++; } } @@ -11085,8 +11337,7 @@ S_scan_formline(pTHX_ char *s) PL_expect = XSTATE; if (needargs) { const char *s2 = s; - while (*s2 == '\r' || *s2 == ' ' || *s2 == '\t' || *s2 == '\f' - || *s2 == '\v') + while (isSPACE(*s2) && *s2 != '\n') s2++; if (*s2 == '{') { PL_expect = XTERMBLOCK; @@ -11897,7 +12148,7 @@ Perl_parse_label(pTHX_ U32 flags) STRLEN wlen, bufptr_pos; lex_read_space(0); t = s = PL_bufptr; - if (!isIDFIRST_lazy_if(s, UTF)) + if (!isIDFIRST_lazy_if_safe(s, PL_bufend, UTF)) goto no_label; t = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &wlen); if (word_takes_any_delimiter(s, wlen)) diff --git a/universal.c b/universal.c index 95934ca..88835f9 100644 --- a/universal.c +++ b/universal.c @@ -184,8 +184,9 @@ The SV can be a Perl object or the name of a Perl class. #include "XSUB.h" -/* a special string address whose value is "isa", but whicb perl knows - * to treat as if it were really "DOES" */ +/* a special string address whose value is "isa", but which perl knows + * to treat as if it were really "DOES" when printing the method name in + * the "Can't call method '%s'" error message */ char PL_isa_DOES[] = "isa"; bool @@ -227,7 +228,7 @@ Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags) PUTBACK; /* create a PV with value "isa", but with a special address - * so that perl knows were' realling doing "DOES" instead */ + * so that perl knows we're really doing "DOES" instead */ methodname = newSV_type(SVt_PV); SvLEN(methodname) = 0; SvCUR(methodname) = strlen(PL_isa_DOES); diff --git a/unixish.h b/unixish.h index e05cb6a..4cd8e43 100644 --- a/unixish.h +++ b/unixish.h @@ -159,7 +159,7 @@ int afstat(int fd, struct stat *statb); #define BIT_BUCKET "/dev/null" -#define dXSUB_SYS +#define dXSUB_SYS dNOOP #ifndef NO_ENVIRON_ARRAY #define USE_ENVIRON_ARRAY diff --git a/utf8.c b/utf8.c index bc7cc06..77e16f3 100644 --- a/utf8.c +++ b/utf8.c @@ -37,7 +37,7 @@ static const char malformed_text[] = "Malformed UTF-8 character"; static const char unees[] = "Malformed UTF-8 character (unexpected end of string)"; static const char cp_above_legal_max[] = - "Use of code point 0x%" UVXf " is deprecated; the permissible max is 0x%" UVXf; + "Use of code point 0x%" UVXf " is deprecated; the permissible max is 0x%" UVXf ". This will be fatal in Perl 5.28"; #define MAX_NON_DEPRECATED_CP ((UV) (IV_MAX)) @@ -52,6 +52,54 @@ within non-zero characters. =cut */ +void +Perl__force_out_malformed_utf8_message(pTHX_ + const U8 *const p, /* First byte in UTF-8 sequence */ + const U8 * const e, /* Final byte in sequence (may include + multiple chars */ + const U32 flags, /* Flags to pass to utf8n_to_uvchr(), + usually 0, or some DISALLOW flags */ + const bool die_here) /* If TRUE, this function does not return */ +{ + /* This core-only function is to be called when a malformed UTF-8 character + * is found, in order to output the detailed information about the + * malformation before dieing. The reason it exists is for the occasions + * when such a malformation is fatal, but warnings might be turned off, so + * that normally they would not be actually output. This ensures that they + * do get output. Because a sequence may be malformed in more than one + * way, multiple messages may be generated, so we can't make them fatal, as + * that would cause the first one to die. + * + * Instead we pretend -W was passed to perl, then die afterwards. The + * flexibility is here to return to the caller so they can finish up and + * die themselves */ + U32 errors; + + PERL_ARGS_ASSERT__FORCE_OUT_MALFORMED_UTF8_MESSAGE; + + ENTER; + SAVEI8(PL_dowarn); + SAVESPTR(PL_curcop); + + PL_dowarn = G_WARN_ALL_ON|G_WARN_ON; + if (PL_curcop) { + PL_curcop->cop_warnings = pWARN_ALL; + } + + (void) utf8n_to_uvchr_error(p, e - p, NULL, flags & ~UTF8_CHECK_ONLY, &errors); + + LEAVE; + + if (! errors) { + Perl_croak(aTHX_ "panic: _force_out_malformed_utf8_message should" + " be called only when there are errors found"); + } + + if (die_here) { + Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)"); + } +} + /* =for apidoc uvoffuni_to_utf8_flags @@ -98,7 +146,7 @@ For details, see the description for L. #define MASK UTF_CONTINUATION_MASK U8 * -Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, UV flags) +Perl_uvoffuni_to_utf8_flags(pTHX_ U8 *d, UV uv, const UV flags) { PERL_ARGS_ASSERT_UVOFFUNI_TO_UTF8_FLAGS; @@ -650,7 +698,8 @@ Perl__is_utf8_char_helper(const U8 * const s, const U8 * e, const U32 flags) #endif if ( (flags & UTF8_DISALLOW_SUPER) - && UNLIKELY(s0 >= FIRST_START_BYTE_THAT_IS_DEFINITELY_SUPER)) { + && UNLIKELY(s0 >= FIRST_START_BYTE_THAT_IS_DEFINITELY_SUPER)) + { return 0; /* Above Unicode */ } @@ -768,7 +817,6 @@ S_unexpected_non_continuation_text(pTHX_ const U8 * const s, ? "immediately" : Perl_form(aTHX_ "%d bytes", (int) non_cont_byte_pos); - unsigned int i; PERL_ARGS_ASSERT_UNEXPECTED_NON_CONTINUATION_TEXT; @@ -776,18 +824,6 @@ S_unexpected_non_continuation_text(pTHX_ const U8 * const s, * calculated, it's likely faster to pass it; verify under DEBUGGING */ assert(expect_len == UTF8SKIP(s)); - /* It is possible that utf8n_to_uvchr() was called incorrectly, with a - * length that is larger than is actually available in the buffer. If we - * print all the bytes based on that length, we will read past the buffer - * end. Often, the strings are NUL terminated, so to lower the chances of - * this happening, print the malformed bytes only up through any NUL. */ - for (i = 1; i < print_len; i++) { - if (*(s + i) == '\0') { - print_len = i + 1; /* +1 gets the NUL printed */ - break; - } - } - return Perl_form(aTHX_ "%s: %s (unexpected non-continuation byte 0x%02x," " %s after start byte 0x%02x; need %d bytes, got %d)", malformed_text, @@ -827,10 +863,10 @@ is, when there is a shorter sequence that can express the same code point; overlong sequences are expressly forbidden in the UTF-8 standard due to potential security issues). Another malformation example is the first byte of a character not being a legal first byte. See F for the list of such -flags. For allowed 0 length strings, this function returns 0; for allowed -overlong sequences, the computed code point is returned; for all other allowed -malformations, the Unicode REPLACEMENT CHARACTER is returned, as these have no -determinable reasonable value. +flags. Even if allowed, this function generally returns the Unicode +REPLACEMENT CHARACTER when it encounters a malformation. There are flags in +F to override this behavior for the overlong malformations, but don't +do that except for very specialized purposes. The C flag overrides the behavior when a non-allowed (by other flags) malformation is found. If this flag is set, the routine assumes that @@ -1075,8 +1111,7 @@ Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s, if (UNLIKELY(curlen == 0)) { possible_problems |= UTF8_GOT_EMPTY; curlen = 0; - uv = 0; /* XXX It could be argued that this should be - UNICODE_REPLACEMENT? */ + uv = UNICODE_REPLACEMENT; goto ready_to_handle_errors; } @@ -1104,7 +1139,9 @@ Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s, } /* Here is not a continuation byte, nor an invariant. The only thing left - * is a start byte (possibly for an overlong) */ + * is a start byte (possibly for an overlong). (We can't use UTF8_IS_START + * because it excludes start bytes like \xC0 that always lead to + * overlongs.) */ /* 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 @@ -1212,6 +1249,12 @@ Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s, /* isn't problematic if < this */ if ( ( ( LIKELY(! possible_problems) && uv >= UNICODE_SURROGATE_FIRST) || ( UNLIKELY(possible_problems) + + /* if overflow, we know without looking further + * precisely which of the problematic types it is, + * and we deal with those in the overflow handling + * code */ + && LIKELY(! (possible_problems & UTF8_GOT_OVERFLOW)) && isUTF8_POSSIBLY_PROBLEMATIC(*adjusted_s0))) && ((flags & ( UTF8_DISALLOW_NONCHAR |UTF8_DISALLOW_SURROGATE @@ -1320,28 +1363,46 @@ Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s, if (flags & (UTF8_WARN_SUPER|UTF8_DISALLOW_SUPER)) { *errors |= UTF8_GOT_SUPER; } - if (flags & (UTF8_WARN_ABOVE_31_BIT|UTF8_DISALLOW_ABOVE_31_BIT)) { + if (flags + & (UTF8_WARN_ABOVE_31_BIT|UTF8_DISALLOW_ABOVE_31_BIT)) + { *errors |= UTF8_GOT_ABOVE_31_BIT; } - disallowed = TRUE; + /* Disallow if any of the three categories say to */ + if ( ! (flags & UTF8_ALLOW_OVERFLOW) + || (flags & ( UTF8_DISALLOW_SUPER + |UTF8_DISALLOW_ABOVE_31_BIT))) + { + disallowed = TRUE; + } + - /* The warnings code explicitly says it doesn't handle the case - * of packWARN2 and two categories which have parent-child - * relationship. Even if it works now to raise the warning if - * either is enabled, it wouldn't necessarily do so in the - * future. We output (only) the most dire warning*/ - if (! (flags & UTF8_CHECK_ONLY)) { - if (ckWARN_d(WARN_UTF8)) { - pack_warn = packWARN(WARN_UTF8); - } - else if (ckWARN_d(WARN_NON_UNICODE)) { - pack_warn = packWARN(WARN_NON_UNICODE); - } - if (pack_warn) { - message = Perl_form(aTHX_ "%s: %s (overflows)", - malformed_text, - _byte_dump_string(s0, send - s0)); + /* Likewise, warn if any say to, plus if deprecation warnings + * are on, because this code point is above IV_MAX */ + if ( ckWARN_d(WARN_DEPRECATED) + || ! (flags & UTF8_ALLOW_OVERFLOW) + || (flags & (UTF8_WARN_SUPER|UTF8_WARN_ABOVE_31_BIT))) + { + + /* The warnings code explicitly says it doesn't handle the + * case of packWARN2 and two categories which have + * parent-child relationship. Even if it works now to + * raise the warning if either is enabled, it wouldn't + * necessarily do so in the future. We output (only) the + * most dire warning*/ + if (! (flags & UTF8_CHECK_ONLY)) { + if (ckWARN_d(WARN_UTF8)) { + pack_warn = packWARN(WARN_UTF8); + } + else if (ckWARN_d(WARN_NON_UNICODE)) { + pack_warn = packWARN(WARN_NON_UNICODE); + } + if (pack_warn) { + message = Perl_form(aTHX_ "%s: %s (overflows)", + malformed_text, + _byte_dump_string(s0, send - s0)); + } } } } @@ -1350,6 +1411,12 @@ Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s, *errors |= UTF8_GOT_EMPTY; if (! (flags & UTF8_ALLOW_EMPTY)) { + + /* This so-called malformation is now treated as a bug in + * the caller. If you have nothing to decode, skip calling + * this function */ + assert(0); + disallowed = TRUE; if (ckWARN_d(WARN_UTF8) && ! (flags & UTF8_CHECK_ONLY)) { pack_warn = packWARN(WARN_UTF8); @@ -1400,10 +1467,17 @@ Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s, if (! (flags & UTF8_ALLOW_NON_CONTINUATION)) { disallowed = TRUE; if (ckWARN_d(WARN_UTF8) && ! (flags & UTF8_CHECK_ONLY)) { + + /* If we don't know for sure that the input length is + * valid, avoid as much as possible reading past the + * end of the buffer */ + int printlen = (flags & _UTF8_NO_CONFIDENCE_IN_CURLEN) + ? s - s0 + : send - s0; pack_warn = packWARN(WARN_UTF8); message = Perl_form(aTHX_ "%s", unexpected_non_continuation_text(s0, - send - s0, + printlen, s - s0, (int) expectlen)); } @@ -1413,7 +1487,17 @@ Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s, possible_problems &= ~UTF8_GOT_LONG; *errors |= UTF8_GOT_LONG; - if (! (flags & UTF8_ALLOW_LONG)) { + if (flags & UTF8_ALLOW_LONG) { + + /* We don't allow the actual overlong value, unless the + * special extra bit is also set */ + if (! (flags & ( UTF8_ALLOW_LONG_AND_ITS_VALUE + & ~UTF8_ALLOW_LONG))) + { + uv = UNICODE_REPLACEMENT; + } + } + else { disallowed = TRUE; if (ckWARN_d(WARN_UTF8) && ! (flags & UTF8_CHECK_ONLY)) { @@ -1548,7 +1632,9 @@ Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s, } } - if (flags & (UTF8_WARN_ABOVE_31_BIT|UTF8_DISALLOW_ABOVE_31_BIT)) { + if (flags & ( UTF8_WARN_ABOVE_31_BIT + |UTF8_DISALLOW_ABOVE_31_BIT)) + { *errors |= UTF8_GOT_ABOVE_31_BIT; if (flags & UTF8_DISALLOW_ABOVE_31_BIT) { @@ -1613,7 +1699,7 @@ Perl_utf8n_to_uvchr_error(pTHX_ const U8 *s, else Perl_warner(aTHX_ pack_warn, "%s", message); } - } /* End of 'while (possible_problems) {' */ + } /* End of 'while (possible_problems)' */ /* Since there was a possible problem, the returned length may need to * be changed from the one stored at the beginning of this function. @@ -1665,7 +1751,7 @@ Perl_utf8_to_uvchr_buf(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen) assert(s < send); return utf8n_to_uvchr(s, send - s, retlen, - ckWARN_d(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); + ckWARN_d(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); } /* This is marked as deprecated @@ -2068,7 +2154,7 @@ Perl__is_uni_FOO(pTHX_ const U8 classnum, const UV c) { U8 tmpbuf[UTF8_MAXBYTES+1]; uvchr_to_utf8(tmpbuf, c); - return _is_utf8_FOO(classnum, tmpbuf); + return _is_utf8_FOO_with_len(classnum, tmpbuf, tmpbuf + sizeof(tmpbuf)); } /* Internal function so we can deprecate the external one, and call @@ -2089,7 +2175,7 @@ Perl__is_uni_perl_idcont(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXBYTES+1]; uvchr_to_utf8(tmpbuf, c); - return _is_utf8_perl_idcont(tmpbuf); + return _is_utf8_perl_idcont_with_len(tmpbuf, tmpbuf + sizeof(tmpbuf)); } bool @@ -2097,7 +2183,7 @@ Perl__is_uni_perl_idstart(pTHX_ UV c) { U8 tmpbuf[UTF8_MAXBYTES+1]; uvchr_to_utf8(tmpbuf, c); - return _is_utf8_perl_idstart(tmpbuf); + return _is_utf8_perl_idstart_with_len(tmpbuf, tmpbuf + sizeof(tmpbuf)); } UV @@ -2207,7 +2293,7 @@ Perl_to_uni_title(pTHX_ UV c, U8* p, STRLEN *lenp) } STATIC U8 -S_to_lower_latin1(const U8 c, U8* p, STRLEN *lenp) +S_to_lower_latin1(const U8 c, U8* p, STRLEN *lenp, const char dummy) { /* We have the latin1-range values compiled into the core, so just use * those, converting the result to UTF-8. Since the result is always just @@ -2215,6 +2301,8 @@ S_to_lower_latin1(const U8 c, U8* p, STRLEN *lenp) U8 converted = toLOWER_LATIN1(c); + PERL_UNUSED_ARG(dummy); + if (p != NULL) { if (NATIVE_BYTE_IS_INVARIANT(converted)) { *p = converted; @@ -2237,7 +2325,7 @@ Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *lenp) PERL_ARGS_ASSERT_TO_UNI_LOWER; if (c < 256) { - return to_lower_latin1((U8) c, p, lenp); + return to_lower_latin1((U8) c, p, lenp, 0 /* 0 is a dummy arg */ ); } uvchr_to_utf8(p, c); @@ -2340,13 +2428,13 @@ Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, U8 flags) uvchr_to_utf8(p, c); return CALL_FOLD_CASE(c, p, p, lenp, flags & FOLD_FLAGS_FULL); } - else { /* Otherwise, _to_utf8_fold_flags has the intelligence to deal with + else { /* Otherwise, _toFOLD_utf8_flags has the intelligence to deal with the special flags. */ U8 utf8_c[UTF8_MAXBYTES + 1]; needs_full_generality: uvchr_to_utf8(utf8_c, c); - return _to_utf8_fold_flags(utf8_c, p, lenp, flags); + return _toFOLD_utf8_flags(utf8_c, utf8_c + sizeof(utf8_c), p, lenp, flags); } } @@ -2375,16 +2463,46 @@ S_is_utf8_common(pTHX_ const U8 *const p, SV **swash, * character without reading beyond the end, and pass that number on to the * validating routine */ if (! isUTF8_CHAR(p, p + UTF8SKIP(p))) { - if (ckWARN_d(WARN_UTF8)) { - Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED,WARN_UTF8), - "Passing malformed UTF-8 to \"%s\" is deprecated", swashname); - if (ckWARN(WARN_UTF8)) { /* This will output details as to the - what the malformation is */ - utf8_to_uvchr_buf(p, p + UTF8SKIP(p), NULL); - } - } - return FALSE; + _force_out_malformed_utf8_message(p, p + UTF8SKIP(p), + _UTF8_NO_CONFIDENCE_IN_CURLEN, + 1 /* Die */ ); + NOT_REACHED; /* NOTREACHED */ + } + + if (!*swash) { + U8 flags = _CORE_SWASH_INIT_ACCEPT_INVLIST; + *swash = _core_swash_init("utf8", + + /* Only use the name if there is no inversion + * list; otherwise will go out to disk */ + (invlist) ? "" : swashname, + + &PL_sv_undef, 1, 0, invlist, &flags); + } + + return swash_fetch(*swash, p, TRUE) != 0; +} + +PERL_STATIC_INLINE bool +S_is_utf8_common_with_len(pTHX_ const U8 *const p, const U8 * const e, SV **swash, + const char *const swashname, SV* const invlist) +{ + /* returns a boolean giving whether or not the UTF8-encoded character that + * starts at

, and extending no further than is in the swash + * indicated by . contains a pointer to where the swash + * indicated by is to be stored; which this routine will do, so + * that future calls will look at <*swash> and only generate a swash if it + * is not null. is NULL or an inversion list that defines the + * swash. If not null, it saves time during initialization of the swash. + */ + + PERL_ARGS_ASSERT_IS_UTF8_COMMON_WITH_LEN; + + if (! isUTF8_CHAR(p, e)) { + _force_out_malformed_utf8_message(p, e, 0, 1); + NOT_REACHED; /* NOTREACHED */ } + if (!*swash) { U8 flags = _CORE_SWASH_INIT_ACCEPT_INVLIST; *swash = _core_swash_init("utf8", @@ -2399,30 +2517,166 @@ S_is_utf8_common(pTHX_ const U8 *const p, SV **swash, return swash_fetch(*swash, p, TRUE) != 0; } +STATIC void +S_warn_on_first_deprecated_use(pTHX_ const char * const name, + const char * const alternative, + const bool use_locale, + const char * const file, + const unsigned line) +{ + const char * key; + + PERL_ARGS_ASSERT_WARN_ON_FIRST_DEPRECATED_USE; + + if (ckWARN_d(WARN_DEPRECATED)) { + + key = Perl_form(aTHX_ "%s;%d;%s;%d", name, use_locale, file, line); + if (! hv_fetch(PL_seen_deprecated_macro, key, strlen(key), 0)) { + if (! PL_seen_deprecated_macro) { + PL_seen_deprecated_macro = newHV(); + } + if (! hv_store(PL_seen_deprecated_macro, key, + strlen(key), &PL_sv_undef, 0)) + { + Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed"); + } + + if (instr(file, "mathoms.c")) { + Perl_warner(aTHX_ WARN_DEPRECATED, + "In %s, line %d, starting in Perl v5.30, %s()" + " will be removed. Avoid this message by" + " converting to use %s().\n", + file, line, name, alternative); + } + else { + Perl_warner(aTHX_ WARN_DEPRECATED, + "In %s, line %d, starting in Perl v5.30, %s() will" + " require an additional parameter. Avoid this" + " message by converting to use %s().\n", + file, line, name, alternative); + } + } + } +} + bool -Perl__is_utf8_FOO(pTHX_ const U8 classnum, const U8 *p) +Perl__is_utf8_FOO(pTHX_ U8 classnum, + const U8 *p, + const char * const name, + const char * const alternative, + const bool use_utf8, + const bool use_locale, + const char * const file, + const unsigned line) { PERL_ARGS_ASSERT__IS_UTF8_FOO; + warn_on_first_deprecated_use(name, alternative, use_locale, file, line); + + if (use_utf8 && UTF8_IS_ABOVE_LATIN1(*p)) { + + switch (classnum) { + case _CC_WORDCHAR: + case _CC_DIGIT: + case _CC_ALPHA: + case _CC_LOWER: + case _CC_UPPER: + case _CC_PUNCT: + case _CC_PRINT: + case _CC_ALPHANUMERIC: + case _CC_GRAPH: + case _CC_CASED: + + return is_utf8_common(p, + &PL_utf8_swash_ptrs[classnum], + swash_property_names[classnum], + PL_XPosix_ptrs[classnum]); + + case _CC_SPACE: + return is_XPERLSPACE_high(p); + case _CC_BLANK: + return is_HORIZWS_high(p); + case _CC_XDIGIT: + return is_XDIGIT_high(p); + case _CC_CNTRL: + return 0; + case _CC_ASCII: + return 0; + case _CC_VERTSPACE: + return is_VERTWS_high(p); + case _CC_IDFIRST: + if (! PL_utf8_perl_idstart) { + PL_utf8_perl_idstart + = _new_invlist_C_array(_Perl_IDStart_invlist); + } + return is_utf8_common(p, &PL_utf8_perl_idstart, + "_Perl_IDStart", NULL); + case _CC_IDCONT: + if (! PL_utf8_perl_idcont) { + PL_utf8_perl_idcont + = _new_invlist_C_array(_Perl_IDCont_invlist); + } + return is_utf8_common(p, &PL_utf8_perl_idcont, + "_Perl_IDCont", NULL); + } + } + + /* idcont is the same as wordchar below 256 */ + if (classnum == _CC_IDCONT) { + classnum = _CC_WORDCHAR; + } + else if (classnum == _CC_IDFIRST) { + if (*p == '_') { + return TRUE; + } + classnum = _CC_ALPHA; + } + + if (! use_locale) { + if (! use_utf8 || UTF8_IS_INVARIANT(*p)) { + return _generic_isCC(*p, classnum); + } + + return _generic_isCC(EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p + 1 )), classnum); + } + else { + if (! use_utf8 || UTF8_IS_INVARIANT(*p)) { + return isFOO_lc(classnum, *p); + } + + return isFOO_lc(classnum, EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p + 1 ))); + } + + NOT_REACHED; /* NOTREACHED */ +} + +bool +Perl__is_utf8_FOO_with_len(pTHX_ const U8 classnum, const U8 *p, + const U8 * const e) +{ + PERL_ARGS_ASSERT__IS_UTF8_FOO_WITH_LEN; + assert(classnum < _FIRST_NON_SWASH_CC); - return is_utf8_common(p, - &PL_utf8_swash_ptrs[classnum], - swash_property_names[classnum], - PL_XPosix_ptrs[classnum]); + return is_utf8_common_with_len(p, + e, + &PL_utf8_swash_ptrs[classnum], + swash_property_names[classnum], + PL_XPosix_ptrs[classnum]); } bool -Perl__is_utf8_perl_idstart(pTHX_ const U8 *p) +Perl__is_utf8_perl_idstart_with_len(pTHX_ const U8 *p, const U8 * const e) { SV* invlist = NULL; - PERL_ARGS_ASSERT__IS_UTF8_PERL_IDSTART; + PERL_ARGS_ASSERT__IS_UTF8_PERL_IDSTART_WITH_LEN; if (! PL_utf8_perl_idstart) { invlist = _new_invlist_C_array(_Perl_IDStart_invlist); } - return is_utf8_common(p, &PL_utf8_perl_idstart, "_Perl_IDStart", invlist); + return is_utf8_common_with_len(p, e, &PL_utf8_perl_idstart, + "_Perl_IDStart", invlist); } bool @@ -2436,16 +2690,17 @@ Perl__is_utf8_xidstart(pTHX_ const U8 *p) } bool -Perl__is_utf8_perl_idcont(pTHX_ const U8 *p) +Perl__is_utf8_perl_idcont_with_len(pTHX_ const U8 *p, const U8 * const e) { SV* invlist = NULL; - PERL_ARGS_ASSERT__IS_UTF8_PERL_IDCONT; + PERL_ARGS_ASSERT__IS_UTF8_PERL_IDCONT_WITH_LEN; if (! PL_utf8_perl_idcont) { invlist = _new_invlist_C_array(_Perl_IDCont_invlist); } - return is_utf8_common(p, &PL_utf8_perl_idcont, "_Perl_IDCont", invlist); + return is_utf8_common_with_len(p, e, &PL_utf8_perl_idcont, + "_Perl_IDCont", invlist); } bool @@ -2475,10 +2730,12 @@ Perl__is_utf8_mark(pTHX_ const U8 *p) /* =for apidoc to_utf8_case -Instead use the appropriate one of L, -L, -L, -or L. +Instead use the appropriate one of L, +L, +L, +or L. + +This function will be removed in Perl v5.28. C

contains the pointer to the UTF-8 string encoding the character that is being converted. This routine assumes that the character @@ -2511,9 +2768,19 @@ UV Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp, const char *normal, const char *special) { + STRLEN len_cp; + UV cp; + const U8 * e = p + UTF8SKIP(p); + PERL_ARGS_ASSERT_TO_UTF8_CASE; - return _to_utf8_case(valid_utf8_to_uvchr(p, NULL), p, ustrp, lenp, swashp, normal, special); + cp = utf8n_to_uvchr(p, e - p, &len_cp, UTF8_CHECK_ONLY); + if (len_cp == (STRLEN) -1) { + _force_out_malformed_utf8_message(p, e, + _UTF8_NO_CONFIDENCE_IN_CURLEN, 1 /* Die */ ); + } + + return _to_utf8_case(cp, p, ustrp, lenp, swashp, normal, special); } /* change namve uv1 to 'from' */ @@ -2746,10 +3013,177 @@ S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, U8* c return original; } +STATIC U32 +S_check_and_deprecate(pTHX_ const U8 *p, + const U8 **e, + const unsigned int type, /* See below */ + const bool use_locale, /* Is this a 'LC_' + macro call? */ + const char * const file, + const unsigned line) +{ + /* This is a temporary function to deprecate the unsafe calls to the case + * changing macros and functions. It keeps all the special stuff in just + * one place. + * + * It updates *e with the pointer to the end of the input string. If using + * the old-style macros, *e is NULL on input, and so this function assumes + * the input string is long enough to hold the entire UTF-8 sequence, and + * sets *e accordingly, but it then returns a flag to pass the + * utf8n_to_uvchr(), to tell it that this size is a guess, and to avoid + * using the full length if possible. + * + * It also does the assert that *e > p when *e is not NULL. This should be + * migrated to the callers when this function gets deleted. + * + * The 'type' parameter is used for the caller to specify which case + * changing function this is called from: */ + +# define DEPRECATE_TO_UPPER 0 +# define DEPRECATE_TO_TITLE 1 +# define DEPRECATE_TO_LOWER 2 +# define DEPRECATE_TO_FOLD 3 + + U32 utf8n_flags = 0; + const char * name; + const char * alternative; + + PERL_ARGS_ASSERT_CHECK_AND_DEPRECATE; + + if (*e == NULL) { + utf8n_flags = _UTF8_NO_CONFIDENCE_IN_CURLEN; + *e = p + UTF8SKIP(p); + + /* For mathoms.c calls, we use the function name we know is stored + * there. It could be part of a larger path */ + if (type == DEPRECATE_TO_UPPER) { + name = instr(file, "mathoms.c") + ? "to_utf8_upper" + : "toUPPER_utf8"; + alternative = "toUPPER_utf8_safe"; + } + else if (type == DEPRECATE_TO_TITLE) { + name = instr(file, "mathoms.c") + ? "to_utf8_title" + : "toTITLE_utf8"; + alternative = "toTITLE_utf8_safe"; + } + else if (type == DEPRECATE_TO_LOWER) { + name = instr(file, "mathoms.c") + ? "to_utf8_lower" + : "toLOWER_utf8"; + alternative = "toLOWER_utf8_safe"; + } + else if (type == DEPRECATE_TO_FOLD) { + name = instr(file, "mathoms.c") + ? "to_utf8_fold" + : "toFOLD_utf8"; + alternative = "toFOLD_utf8_safe"; + } + else Perl_croak(aTHX_ "panic: Unexpected case change type"); + + warn_on_first_deprecated_use(name, alternative, use_locale, file, line); + } + else { + assert (p < *e); + } + + return utf8n_flags; +} + +/* The process for changing the case is essentially the same for the four case + * change types, except there are complications for folding. Otherwise the + * difference is only which case to change to. To make sure that they all do + * the same thing, the bodies of the functions are extracted out into the + * following two macros. The functions are written with the same variable + * names, and these are known and used inside these macros. It would be + * better, of course, to have inline functions to do it, but since different + * macros are called, depending on which case is being changed to, this is not + * feasible in C (to khw's knowledge). Two macros are created so that the fold + * function can start with the common start macro, then finish with its special + * handling; while the other three cases can just use the common end macro. + * + * The algorithm is to use the proper (passed in) macro or function to change + * the case for code points that are below 256. The macro is used if using + * locale rules for the case change; the function if not. If the code point is + * above 255, it is computed from the input UTF-8, and another macro is called + * to do the conversion. If necessary, the output is converted to UTF-8. If + * using a locale, we have to check that the change did not cross the 255/256 + * boundary, see check_locale_boundary_crossing() for further details. + * + * The macros are split with the correct case change for the below-256 case + * stored into 'result', and in the middle of an else clause for the above-255 + * case. At that point in the 'else', 'result' is not the final result, but is + * the input code point calculated from the UTF-8. The fold code needs to + * realize all this and take it from there. + * + * If you read the two macros as sequential, it's easier to understand what's + * going on. */ +#define CASE_CHANGE_BODY_START(locale_flags, LC_L1_change_macro, L1_func, \ + L1_func_extra_param) \ + \ + if (flags & (locale_flags)) { \ + /* Treat a UTF-8 locale as not being in locale at all */ \ + if (IN_UTF8_CTYPE_LOCALE) { \ + flags &= ~(locale_flags); \ + } \ + else { \ + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; \ + } \ + } \ + \ + if (UTF8_IS_INVARIANT(*p)) { \ + if (flags & (locale_flags)) { \ + result = LC_L1_change_macro(*p); \ + } \ + else { \ + return L1_func(*p, ustrp, lenp, L1_func_extra_param); \ + } \ + } \ + else if UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(p, e) { \ + if (flags & (locale_flags)) { \ + result = LC_L1_change_macro(EIGHT_BIT_UTF8_TO_NATIVE(*p, \ + *(p+1))); \ + } \ + else { \ + return L1_func(EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)), \ + ustrp, lenp, L1_func_extra_param); \ + } \ + } \ + else { /* malformed UTF-8 or ord above 255 */ \ + STRLEN len_result; \ + result = utf8n_to_uvchr(p, e - p, &len_result, UTF8_CHECK_ONLY); \ + if (len_result == (STRLEN) -1) { \ + _force_out_malformed_utf8_message(p, e, utf8n_flags, \ + 1 /* Die */ ); \ + } + +#define CASE_CHANGE_BODY_END(locale_flags, change_macro) \ + result = change_macro(result, p, ustrp, lenp); \ + \ + if (flags & (locale_flags)) { \ + result = check_locale_boundary_crossing(p, result, ustrp, lenp); \ + } \ + return result; \ + } \ + \ + /* Here, used locale rules. Convert back to UTF-8 */ \ + if (UTF8_IS_INVARIANT(result)) { \ + *ustrp = (U8) result; \ + *lenp = 1; \ + } \ + else { \ + *ustrp = UTF8_EIGHT_BIT_HI((U8) result); \ + *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result); \ + *lenp = 2; \ + } \ + \ + return result; + /* =for apidoc to_utf8_upper -Instead use L. +Instead use L. =cut */ @@ -2758,67 +3192,30 @@ Instead use L. * be used. */ UV -Perl__to_utf8_upper_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags) +Perl__to_utf8_upper_flags(pTHX_ const U8 *p, + const U8 *e, + U8* ustrp, + STRLEN *lenp, + bool flags, + const char * const file, + const int line) { UV result; + const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_UPPER, + cBOOL(flags), file, line); PERL_ARGS_ASSERT__TO_UTF8_UPPER_FLAGS; - if (flags) { - /* Treat a UTF-8 locale as not being in locale at all */ - if (IN_UTF8_CTYPE_LOCALE) { - flags = FALSE; - } - else { - _CHECK_AND_WARN_PROBLEMATIC_LOCALE; - } - } - - if (UTF8_IS_INVARIANT(*p)) { - if (flags) { - result = toUPPER_LC(*p); - } - else { - return _to_upper_title_latin1(*p, ustrp, lenp, 'S'); - } - } - else if UTF8_IS_DOWNGRADEABLE_START(*p) { - if (flags) { - U8 c = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)); - result = toUPPER_LC(c); - } - else { - return _to_upper_title_latin1(EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)), - ustrp, lenp, 'S'); - } - } - else { /* UTF-8, ord above 255 */ - result = CALL_UPPER_CASE(valid_utf8_to_uvchr(p, NULL), p, ustrp, lenp); - - if (flags) { - result = check_locale_boundary_crossing(p, result, ustrp, lenp); - } - return result; - } - - /* Here, used locale rules. Convert back to UTF-8 */ - if (UTF8_IS_INVARIANT(result)) { - *ustrp = (U8) result; - *lenp = 1; - } - else { - *ustrp = UTF8_EIGHT_BIT_HI((U8) result); - *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result); - *lenp = 2; - } - - return result; + /* ~0 makes anything non-zero in 'flags' mean we are using locale rules */ + /* 2nd char of uc(U+DF) is 'S' */ + CASE_CHANGE_BODY_START(~0, toUPPER_LC, _to_upper_title_latin1, 'S'); + CASE_CHANGE_BODY_END (~0, CALL_UPPER_CASE); } /* =for apidoc to_utf8_title -Instead use L. +Instead use L. =cut */ @@ -2829,67 +3226,29 @@ Instead use L. */ UV -Perl__to_utf8_title_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags) +Perl__to_utf8_title_flags(pTHX_ const U8 *p, + const U8 *e, + U8* ustrp, + STRLEN *lenp, + bool flags, + const char * const file, + const int line) { UV result; + const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_TITLE, + cBOOL(flags), file, line); PERL_ARGS_ASSERT__TO_UTF8_TITLE_FLAGS; - if (flags) { - /* Treat a UTF-8 locale as not being in locale at all */ - if (IN_UTF8_CTYPE_LOCALE) { - flags = FALSE; - } - else { - _CHECK_AND_WARN_PROBLEMATIC_LOCALE; - } - } - - if (UTF8_IS_INVARIANT(*p)) { - if (flags) { - result = toUPPER_LC(*p); - } - else { - return _to_upper_title_latin1(*p, ustrp, lenp, 's'); - } - } - else if UTF8_IS_DOWNGRADEABLE_START(*p) { - if (flags) { - U8 c = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)); - result = toUPPER_LC(c); - } - else { - return _to_upper_title_latin1(EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)), - ustrp, lenp, 's'); - } - } - else { /* UTF-8, ord above 255 */ - result = CALL_TITLE_CASE(valid_utf8_to_uvchr(p, NULL), p, ustrp, lenp); - - if (flags) { - result = check_locale_boundary_crossing(p, result, ustrp, lenp); - } - return result; - } - - /* Here, used locale rules. Convert back to UTF-8 */ - if (UTF8_IS_INVARIANT(result)) { - *ustrp = (U8) result; - *lenp = 1; - } - else { - *ustrp = UTF8_EIGHT_BIT_HI((U8) result); - *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result); - *lenp = 2; - } - - return result; + /* 2nd char of ucfirst(U+DF) is 's' */ + CASE_CHANGE_BODY_START(~0, toUPPER_LC, _to_upper_title_latin1, 's'); + CASE_CHANGE_BODY_END (~0, CALL_TITLE_CASE); } /* =for apidoc to_utf8_lower -Instead use L. +Instead use L. =cut */ @@ -2899,68 +3258,28 @@ Instead use L. */ UV -Perl__to_utf8_lower_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, bool flags) +Perl__to_utf8_lower_flags(pTHX_ const U8 *p, + const U8 *e, + U8* ustrp, + STRLEN *lenp, + bool flags, + const char * const file, + const int line) { UV result; + const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_LOWER, + cBOOL(flags), file, line); PERL_ARGS_ASSERT__TO_UTF8_LOWER_FLAGS; - if (flags) { - /* Treat a UTF-8 locale as not being in locale at all */ - if (IN_UTF8_CTYPE_LOCALE) { - flags = FALSE; - } - else { - _CHECK_AND_WARN_PROBLEMATIC_LOCALE; - } - } - - if (UTF8_IS_INVARIANT(*p)) { - if (flags) { - result = toLOWER_LC(*p); - } - else { - return to_lower_latin1(*p, ustrp, lenp); - } - } - else if UTF8_IS_DOWNGRADEABLE_START(*p) { - if (flags) { - U8 c = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)); - result = toLOWER_LC(c); - } - else { - return to_lower_latin1(EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)), - ustrp, lenp); - } - } - else { /* UTF-8, ord above 255 */ - result = CALL_LOWER_CASE(valid_utf8_to_uvchr(p, NULL), p, ustrp, lenp); - - if (flags) { - result = check_locale_boundary_crossing(p, result, ustrp, lenp); - } - - return result; - } - - /* Here, used locale rules. Convert back to UTF-8 */ - if (UTF8_IS_INVARIANT(result)) { - *ustrp = (U8) result; - *lenp = 1; - } - else { - *ustrp = UTF8_EIGHT_BIT_HI((U8) result); - *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result); - *lenp = 2; - } - - return result; + CASE_CHANGE_BODY_START(~0, toLOWER_LC, to_lower_latin1, 0 /* 0 is dummy */) + CASE_CHANGE_BODY_END (~0, CALL_LOWER_CASE) } /* =for apidoc to_utf8_fold -Instead use L. +Instead use L. =cut */ @@ -2975,9 +3294,17 @@ Instead use L. */ UV -Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags) +Perl__to_utf8_fold_flags(pTHX_ const U8 *p, + const U8 *e, + U8* ustrp, + STRLEN *lenp, + U8 flags, + const char * const file, + const int line) { UV result; + const U32 utf8n_flags = check_and_deprecate(p, &e, DEPRECATE_TO_FOLD, + cBOOL(flags), file, line); PERL_ARGS_ASSERT__TO_UTF8_FOLD_FLAGS; @@ -2986,38 +3313,10 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, U8 flags) assert(p != ustrp); /* Otherwise overwrites */ - if (flags & FOLD_FLAGS_LOCALE) { - /* Treat a UTF-8 locale as not being in locale at all */ - if (IN_UTF8_CTYPE_LOCALE) { - flags &= ~FOLD_FLAGS_LOCALE; - } - else { - _CHECK_AND_WARN_PROBLEMATIC_LOCALE; - } - } + CASE_CHANGE_BODY_START(FOLD_FLAGS_LOCALE, toFOLD_LC, _to_fold_latin1, + ((flags) & (FOLD_FLAGS_FULL | FOLD_FLAGS_NOMIX_ASCII))); - if (UTF8_IS_INVARIANT(*p)) { - if (flags & FOLD_FLAGS_LOCALE) { - result = toFOLD_LC(*p); - } - else { - return _to_fold_latin1(*p, ustrp, lenp, - flags & (FOLD_FLAGS_FULL | FOLD_FLAGS_NOMIX_ASCII)); - } - } - else if UTF8_IS_DOWNGRADEABLE_START(*p) { - if (flags & FOLD_FLAGS_LOCALE) { - U8 c = EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)); - result = toFOLD_LC(c); - } - else { - return _to_fold_latin1(EIGHT_BIT_UTF8_TO_NATIVE(*p, *(p+1)), - ustrp, lenp, - flags & (FOLD_FLAGS_FULL | FOLD_FLAGS_NOMIX_ASCII)); - } - } - else { /* UTF-8, ord above 255 */ - result = CALL_FOLD_CASE(valid_utf8_to_uvchr(p, NULL), p, ustrp, lenp, flags & FOLD_FLAGS_FULL); + result = CALL_FOLD_CASE(result, p, ustrp, lenp, flags & FOLD_FLAGS_FULL); if (flags & FOLD_FLAGS_LOCALE) { @@ -4467,7 +4766,6 @@ Perl__swash_to_invlist(pTHX_ SV* const swash) invlist = _new_invlist(0); } else { - while (isSPACE(*l)) l++; l = (U8 *) after_atou; /* Get the 0th element, which is needed to setup the inversion list */ @@ -4992,7 +5290,7 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const c *foldbuf1 = toFOLD(*p1); } else if (u1) { - _to_utf8_fold_flags(p1, foldbuf1, &n1, flags_for_folder); + _toFOLD_utf8_flags(p1, e1, foldbuf1, &n1, flags_for_folder); } else { /* Not UTF-8, get UTF-8 fold */ _to_uni_fold_flags(*p1, foldbuf1, &n1, flags_for_folder); @@ -5016,7 +5314,7 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, const c *foldbuf2 = toFOLD(*p2); } else if (u2) { - _to_utf8_fold_flags(p2, foldbuf2, &n2, flags_for_folder); + _toFOLD_utf8_flags(p2, e2, foldbuf2, &n2, flags_for_folder); } else { _to_uni_fold_flags(*p2, foldbuf2, &n2, flags_for_folder); diff --git a/utf8.h b/utf8.h index f6d9d54..0fbe4b7 100644 --- a/utf8.h +++ b/utf8.h @@ -76,10 +76,15 @@ the string is invariant. utf8n_to_uvchr_error(s, len, lenp, flags, 0) #define to_uni_fold(c, p, lenp) _to_uni_fold_flags(c, p, lenp, FOLD_FLAGS_FULL) -#define to_utf8_fold(c, p, lenp) _to_utf8_fold_flags(c, p, lenp, FOLD_FLAGS_FULL) -#define to_utf8_lower(a,b,c) _to_utf8_lower_flags(a,b,c,0) -#define to_utf8_upper(a,b,c) _to_utf8_upper_flags(a,b,c,0) -#define to_utf8_title(a,b,c) _to_utf8_title_flags(a,b,c,0) + +#define to_utf8_fold(s, r, lenr) \ + _to_utf8_fold_flags (s, NULL, r, lenr, FOLD_FLAGS_FULL, __FILE__, __LINE__) +#define to_utf8_lower(s, r, lenr) \ + _to_utf8_lower_flags(s, NULL, r ,lenr, 0, __FILE__, __LINE__) +#define to_utf8_upper(s, r, lenr) \ + _to_utf8_upper_flags(s, NULL, r, lenr, 0, __FILE__, __LINE__) +#define to_utf8_title(s, r, lenr) \ + _to_utf8_title_flags(s, NULL, r, lenr ,0, __FILE__, __LINE__) #define foldEQ_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2) \ foldEQ_utf8_flags(s1, pe1, l1, u1, s2, pe2, l2, u2, 0) @@ -672,13 +677,30 @@ with a ptr argument. * beginning of a utf8 character. Now that foo_utf8() determines that itself, * no need to do it again here */ -#define isIDFIRST_lazy_if(p,UTF) ((IN_BYTES || !UTF) \ - ? isIDFIRST(*(p)) \ - : isIDFIRST_utf8((const U8*)p)) -#define isWORDCHAR_lazy_if(p,UTF) ((IN_BYTES || (!UTF)) \ - ? isWORDCHAR(*(p)) \ - : isWORDCHAR_utf8((const U8*)p)) -#define isALNUM_lazy_if(p,UTF) isWORDCHAR_lazy_if(p,UTF) +#define isIDFIRST_lazy_if(p,UTF) \ + _is_utf8_FOO(_CC_IDFIRST, (const U8 *) p, "isIDFIRST_lazy_if", \ + "isIDFIRST_lazy_if_safe", \ + cBOOL(UTF && ! IN_BYTES), 0, __FILE__,__LINE__) + +#define isIDFIRST_lazy_if_safe(p, e, UTF) \ + ((IN_BYTES || !UTF) \ + ? isIDFIRST(*(p)) \ + : isIDFIRST_utf8_safe(p, e)) + +#define isWORDCHAR_lazy_if(p,UTF) \ + _is_utf8_FOO(_CC_IDFIRST, (const U8 *) p, "isWORDCHAR_lazy_if", \ + "isWORDCHAR_lazy_if_safe", \ + cBOOL(UTF && ! IN_BYTES), 0, __FILE__,__LINE__) + +#define isWORDCHAR_lazy_if_safe(p, e, UTF) \ + ((IN_BYTES || !UTF) \ + ? isWORDCHAR(*(p)) \ + : isWORDCHAR_utf8_safe((U8 *) p, (U8 *) e)) + +#define isALNUM_lazy_if(p,UTF) \ + _is_utf8_FOO(_CC_IDFIRST, (const U8 *) p, "isALNUM_lazy_if", \ + "isWORDCHAR_lazy_if_safe", \ + cBOOL(UTF && ! IN_BYTES), 0, __FILE__,__LINE__) #define UTF8_MAXLEN UTF8_MAXBYTES @@ -727,38 +749,42 @@ case any call to string overloading updates the internal UTF-8 encoding flag. #define UTF8_ALLOW_SHORT 0x0008 #define UTF8_GOT_SHORT UTF8_ALLOW_SHORT -/* Overlong sequence; i.e., the code point can be specified in fewer bytes. */ +/* Overlong sequence; i.e., the code point can be specified in fewer bytes. + * First one will convert the overlong to the REPLACEMENT CHARACTER; second + * will return what the overlong evaluates to */ #define UTF8_ALLOW_LONG 0x0010 +#define UTF8_ALLOW_LONG_AND_ITS_VALUE (UTF8_ALLOW_LONG|0x0020) #define UTF8_GOT_LONG UTF8_ALLOW_LONG -/* Currently no way to allow overflow */ -#define UTF8_GOT_OVERFLOW 0x0020 +#define UTF8_ALLOW_OVERFLOW 0x0080 +#define UTF8_GOT_OVERFLOW UTF8_ALLOW_OVERFLOW -#define UTF8_DISALLOW_SURROGATE 0x0040 /* Unicode surrogates */ +#define UTF8_DISALLOW_SURROGATE 0x0100 /* Unicode surrogates */ #define UTF8_GOT_SURROGATE UTF8_DISALLOW_SURROGATE -#define UTF8_WARN_SURROGATE 0x0080 +#define UTF8_WARN_SURROGATE 0x0200 -#define UTF8_DISALLOW_NONCHAR 0x0100 /* Unicode non-character */ +#define UTF8_DISALLOW_NONCHAR 0x0400 /* Unicode non-character */ #define UTF8_GOT_NONCHAR UTF8_DISALLOW_NONCHAR -#define UTF8_WARN_NONCHAR 0x0200 /* code points */ +#define UTF8_WARN_NONCHAR 0x0800 /* code points */ -#define UTF8_DISALLOW_SUPER 0x0400 /* Super-set of Unicode: code */ +#define UTF8_DISALLOW_SUPER 0x1000 /* Super-set of Unicode: code */ #define UTF8_GOT_SUPER UTF8_DISALLOW_SUPER -#define UTF8_WARN_SUPER 0x0800 /* points above the legal max */ +#define UTF8_WARN_SUPER 0x2000 /* points above the legal max */ /* Code points which never were part of the original UTF-8 standard, which only * went up to 2 ** 31 - 1. Note that these all overflow a signed 32-bit word, * The first byte of these code points is FE or FF on ASCII platforms. If the * first byte is FF, it will overflow a 32-bit word. */ -#define UTF8_DISALLOW_ABOVE_31_BIT 0x1000 +#define UTF8_DISALLOW_ABOVE_31_BIT 0x4000 #define UTF8_GOT_ABOVE_31_BIT UTF8_DISALLOW_ABOVE_31_BIT -#define UTF8_WARN_ABOVE_31_BIT 0x2000 +#define UTF8_WARN_ABOVE_31_BIT 0x8000 /* For back compat, these old names are misleading for UTF_EBCDIC */ #define UTF8_DISALLOW_FE_FF UTF8_DISALLOW_ABOVE_31_BIT #define UTF8_WARN_FE_FF UTF8_WARN_ABOVE_31_BIT -#define UTF8_CHECK_ONLY 0x4000 +#define UTF8_CHECK_ONLY 0x10000 +#define _UTF8_NO_CONFIDENCE_IN_CURLEN 0x20000 /* Internal core use only */ /* For backwards source compatibility. They do nothing, as the default now * includes what they used to mean. The first one's meaning was to allow the @@ -776,12 +802,21 @@ case any call to string overloading updates the internal UTF-8 encoding flag. #define UTF8_WARN_ILLEGAL_INTERCHANGE \ (UTF8_WARN_ILLEGAL_C9_INTERCHANGE|UTF8_WARN_NONCHAR) -#define UTF8_ALLOW_ANY \ - (~( UTF8_DISALLOW_ILLEGAL_INTERCHANGE|UTF8_DISALLOW_ABOVE_31_BIT \ - |UTF8_WARN_ILLEGAL_INTERCHANGE|UTF8_WARN_ABOVE_31_BIT)) -#define UTF8_ALLOW_ANYUV UTF8_ALLOW_EMPTY -#define UTF8_ALLOW_DEFAULT (ckWARN(WARN_UTF8) ? 0 : \ - UTF8_ALLOW_ANYUV) +/* This is used typically for code that is willing to accept inputs of + * illformed UTF-8 sequences, for whatever reason. However, all such sequences + * evaluate to the REPLACEMENT CHARACTER unless other flags overriding this are + * also present. */ +#define UTF8_ALLOW_ANY ( UTF8_ALLOW_CONTINUATION \ + |UTF8_ALLOW_NON_CONTINUATION \ + |UTF8_ALLOW_SHORT \ + |UTF8_ALLOW_LONG \ + |UTF8_ALLOW_OVERFLOW) + +/* Accept any Perl-extended UTF-8 that evaluates to any UV on the platform, but + * not any malformed. This is the default. (Note that UVs above IV_MAX are + * deprecated. */ +#define UTF8_ALLOW_ANYUV 0 +#define UTF8_ALLOW_DEFAULT UTF8_ALLOW_ANYUV /* =for apidoc Am|bool|UTF8_IS_SURROGATE|const U8 *s|const U8 *e diff --git a/util.c b/util.c index 02c84c8..a542f5e 100644 --- a/util.c +++ b/util.c @@ -4712,20 +4712,23 @@ Perl_seed(pTHX) void Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer) { +#ifndef NO_PERL_HASH_ENV const char *env_pv; +#endif unsigned long i; PERL_ARGS_ASSERT_GET_HASH_SEED; +#ifndef NO_PERL_HASH_ENV env_pv= PerlEnv_getenv("PERL_HASH_SEED"); if ( env_pv ) -#ifndef USE_HASH_SEED_EXPLICIT +# ifndef USE_HASH_SEED_EXPLICIT { /* ignore leading spaces */ while (isSPACE(*env_pv)) env_pv++; -#ifdef USE_PERL_PERTURB_KEYS +# ifdef USE_PERL_PERTURB_KEYS /* if they set it to "0" we disable key traversal randomization completely */ if (strEQ(env_pv,"0")) { PL_hash_rand_bits_enabled= 0; @@ -4733,7 +4736,7 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer) /* otherwise switch to deterministic mode */ PL_hash_rand_bits_enabled= 2; } -#endif +# endif /* ignore a leading 0x... if it is there */ if (env_pv[0] == '0' && env_pv[1] == 'x') env_pv += 2; @@ -4755,6 +4758,7 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer) /* should we warn about insufficient hex? */ } else +# endif #endif { (void)seedDrand01((Rand_seed_t)seed()); @@ -4774,6 +4778,7 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer) PL_hash_rand_bits = ROTL_UV(PL_hash_rand_bits,8); } } +# ifndef NO_PERL_HASH_ENV env_pv= PerlEnv_getenv("PERL_PERTURB_KEYS"); if (env_pv) { if (strEQ(env_pv,"0") || strEQ(env_pv,"NO")) { @@ -4786,6 +4791,7 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer) Perl_warn(aTHX_ "perl: warning: strange setting in '$ENV{PERL_PERTURB_KEYS}': '%s'\n", env_pv); } } +# endif #endif } @@ -6618,7 +6624,7 @@ Perl_get_c_backtrace_dump(pTHX_ int depth, int skip) sv_catpvs(dsv, "\n"); } - Perl_free_c_backtrace(aTHX_ bt); + Perl_free_c_backtrace(bt); return dsv; } diff --git a/utils.lst b/utils.lst index 216a9d0..8d65a62 100644 --- a/utils.lst +++ b/utils.lst @@ -3,7 +3,6 @@ cpan/podlators/blib/script/pod2text cpan/Pod-Usage/blib/script/pod2usage cpan/Pod-Checker/blib/script/podchecker cpan/Pod-Parser/blib/script/podselect -utils/c2ph # link = utils/pstruct utils/cpan utils/corelist utils/enc2xs diff --git a/utils/Makefile.PL b/utils/Makefile.PL index 85b0833..f9f80ed 100644 --- a/utils/Makefile.PL +++ b/utils/Makefile.PL @@ -35,17 +35,15 @@ print $fh <<'EOT'; # Files to be built with variable substitution after miniperl is # available. Dependencies handled manually below (for now). -pl = c2ph.PL corelist.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL json_pp.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL ptar.PL ptardiff.PL ptargrep.PL shasum.PL splain.PL libnetcfg.PL piconv.PL enc2xs.PL encguess.PL xsubpp.PL pod2html.PL zipdetails.PL -plextract = c2ph corelist cpan h2ph h2xs instmodsh json_pp perlbug perldoc perlivp pl2pm prove ptar ptardiff ptargrep shasum splain libnetcfg piconv enc2xs encguess xsubpp pod2html zipdetails -plextractexe = ./c2ph ./corelist ./cpan ./h2ph ./h2xs ./json_pp ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./ptar ./ptardiff ./ptargrep ./shasum ./splain ./libnetcfg ./piconv ./enc2xs ./encguess ./xsubpp ./pod2html ./zipdetails +pl = corelist.PL cpan.PL h2ph.PL h2xs.PL instmodsh.PL json_pp.PL perlbug.PL perldoc.PL perlivp.PL pl2pm.PL prove.PL ptar.PL ptardiff.PL ptargrep.PL shasum.PL splain.PL libnetcfg.PL piconv.PL enc2xs.PL encguess.PL xsubpp.PL pod2html.PL zipdetails.PL +plextract = corelist cpan h2ph h2xs instmodsh json_pp perlbug perldoc perlivp pl2pm prove ptar ptardiff ptargrep shasum splain libnetcfg piconv enc2xs encguess xsubpp pod2html zipdetails +plextractexe = ./corelist ./cpan ./h2ph ./h2xs ./json_pp ./instmodsh ./perlbug ./perldoc ./perlivp ./pl2pm ./prove ./ptar ./ptardiff ./ptargrep ./shasum ./splain ./libnetcfg ./piconv ./enc2xs ./encguess ./xsubpp ./pod2html ./zipdetails all: $(plextract) $(plextract): $(RUN) $(PERL) -I../lib $@.PL -c2ph: c2ph.PL ../config.sh - cpan: cpan.PL ../config.sh corelist: corelist.PL ../config.sh @@ -95,7 +93,7 @@ pod2html: pod2html.PL ../config.sh ../ext/Pod-Html/bin/pod2html clean: realclean: - rm -rf $(plextract) pstruct $(plextractexe) + rm -rf $(plextract) $(plextractexe) rm -f ../t/_h2ph_pre.ph clobber: realclean diff --git a/utils/c2ph.PL b/utils/c2ph.PL deleted file mode 100644 index c5b5a3f..0000000 --- a/utils/c2ph.PL +++ /dev/null @@ -1,1448 +0,0 @@ -#!/usr/local/bin/perl - -use Config; -use File::Basename qw(&basename &dirname); -use Cwd; -use subs qw(link); - -sub link { # This is a cut-down version of installperl:link(). - my($from,$to) = @_; - my($success) = 0; - - eval { - CORE::link($from, $to) - ? $success++ - : ($from =~ m#^/afs/# || $to =~ m#^/afs/#) - ? die "AFS" # okay inside eval {} - : die "Couldn't link $from to $to: $!\n"; - }; - if ($@) { - warn $@; - require File::Copy; - File::Copy::copy($from, $to) - ? $success++ - : warn "Couldn't copy $from to $to: $!\n"; - } - $success; -} - -# List explicitly here the variables you want Configure to -# generate. Metaconfig only looks for shell variables, so you -# have to mention them as if they were shell variables, not -# %Config entries. Thus you write -# $startperl -# to ensure Configure will look for $Config{startperl}. - -# This forces PL files to create target in same directory as PL file. -# This is so that make depend always knows where to find PL derivatives. -$origdir = cwd; -chdir dirname($0); -$file = basename($0, '.PL'); -$file .= '.com' if $^O eq 'VMS'; - -open OUT,">$file" or die "Can't create $file: $!"; - -print "Extracting $file (with variable substitutions)\n"; - -# In this section, perl variables will be expanded during extraction. -# You can use $Config{...} to use Configure variables. - -print OUT <<"!GROK!THIS!"; -$Config{startperl} - eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' - if \$running_under_some_shell; -!GROK!THIS! - -# In the following, perl variables are not expanded during extraction. - -print OUT <<'!NO!SUBS!'; -# -# -# c2ph (aka pstruct) -# Tom Christiansen, -# -# As pstruct, dump C structures as generated from 'cc -g -S' stabs. -# As c2ph, do this PLUS generate perl code for getting at the structures. -# -# See the usage message for more. If this isn't enough, read the code. -# - -=head1 NAME - -c2ph, pstruct - Dump C structures as generated from C stabs - -=head1 SYNOPSIS - - c2ph [-dpnP] [var=val] [files ...] - -=head2 OPTIONS - - Options: - - -w wide; short for: type_width=45 member_width=35 offset_width=8 - -x hex; short for: offset_fmt=x offset_width=08 size_fmt=x \ - size_width=04 - - -n do not generate perl code (default when invoked as pstruct) - -p generate perl code (default when invoked as c2ph) - -v generate perl code, with C decls as comments - - -i do NOT recompute sizes for intrinsic datatypes - -a dump information on intrinsics also - - -t trace execution - -d spew reams of debugging output - - -slist give comma-separated list a structures to dump - -=head1 DESCRIPTION - -The following is the old c2ph.doc documentation by Tom Christiansen - -Date: 25 Jul 91 08:10:21 GMT - -Once upon a time, I wrote a program called pstruct. It was a perl -program that tried to parse out C structures and display their member -offsets for you. This was especially useful for people looking at -binary dumps or poking around the kernel. - -Pstruct was not a pretty program. Neither was it particularly robust. -The problem, you see, was that the C compiler was much better at parsing -C than I could ever hope to be. - -So I got smart: I decided to be lazy and let the C compiler parse the C, -which would spit out debugger stabs for me to read. These were much -easier to parse. It's still not a pretty program, but at least it's more -robust. - -Pstruct takes any .c or .h files, or preferably .s ones, since that's -the format it is going to massage them into anyway, and spits out -listings like this: - - struct tty { - int tty.t_locker 000 4 - int tty.t_mutex_index 004 4 - struct tty * tty.t_tp_virt 008 4 - struct clist tty.t_rawq 00c 20 - int tty.t_rawq.c_cc 00c 4 - int tty.t_rawq.c_cmax 010 4 - int tty.t_rawq.c_cfx 014 4 - int tty.t_rawq.c_clx 018 4 - struct tty * tty.t_rawq.c_tp_cpu 01c 4 - struct tty * tty.t_rawq.c_tp_iop 020 4 - unsigned char * tty.t_rawq.c_buf_cpu 024 4 - unsigned char * tty.t_rawq.c_buf_iop 028 4 - struct clist tty.t_canq 02c 20 - int tty.t_canq.c_cc 02c 4 - int tty.t_canq.c_cmax 030 4 - int tty.t_canq.c_cfx 034 4 - int tty.t_canq.c_clx 038 4 - struct tty * tty.t_canq.c_tp_cpu 03c 4 - struct tty * tty.t_canq.c_tp_iop 040 4 - unsigned char * tty.t_canq.c_buf_cpu 044 4 - unsigned char * tty.t_canq.c_buf_iop 048 4 - struct clist tty.t_outq 04c 20 - int tty.t_outq.c_cc 04c 4 - int tty.t_outq.c_cmax 050 4 - int tty.t_outq.c_cfx 054 4 - int tty.t_outq.c_clx 058 4 - struct tty * tty.t_outq.c_tp_cpu 05c 4 - struct tty * tty.t_outq.c_tp_iop 060 4 - unsigned char * tty.t_outq.c_buf_cpu 064 4 - unsigned char * tty.t_outq.c_buf_iop 068 4 - (*int)() tty.t_oproc_cpu 06c 4 - (*int)() tty.t_oproc_iop 070 4 - (*int)() tty.t_stopproc_cpu 074 4 - (*int)() tty.t_stopproc_iop 078 4 - struct thread * tty.t_rsel 07c 4 - -etc. - - -Actually, this was generated by a particular set of options. You can control -the formatting of each column, whether you prefer wide or fat, hex or decimal, -leading zeroes or whatever. - -All you need to be able to use this is a C compiler than generates -BSD/GCC-style stabs. The B<-g> option on native BSD compilers and GCC -should get this for you. - -To learn more, just type a bogus option, like B<-\?>, and a long usage message -will be provided. There are a fair number of possibilities. - -If you're only a C programmer, than this is the end of the message for you. -You can quit right now, and if you care to, save off the source and run it -when you feel like it. Or not. - - - -But if you're a perl programmer, then for you I have something much more -wondrous than just a structure offset printer. - -You see, if you call pstruct by its other incybernation, c2ph, you have a code -generator that translates C code into perl code! Well, structure and union -declarations at least, but that's quite a bit. - -Prior to this point, anyone programming in perl who wanted to interact -with C programs, like the kernel, was forced to guess the layouts of -the C structures, and then hardwire these into his program. Of course, -when you took your wonderfully crafted program to a system where the -sgtty structure was laid out differently, your program broke. Which is -a shame. - -We've had Larry's h2ph translator, which helped, but that only works on -cpp symbols, not real C, which was also very much needed. What I offer -you is a symbolic way of getting at all the C structures. I've couched -them in terms of packages and functions. Consider the following program: - - #!/usr/local/bin/perl - - require 'syscall.ph'; - require './sys/time.ph'; - require './sys/resource.ph'; - - $ru = "\0" x &rusage'sizeof(); - - syscall(&SYS_getrusage, &RUSAGE_SELF, $ru) && die "getrusage: $!"; - - @ru = unpack($t = &rusage'typedef(), $ru); - - $utime = $ru[ &rusage'ru_utime + &timeval'tv_sec ] - + ($ru[ &rusage'ru_utime + &timeval'tv_usec ]) / 1e6; - - $stime = $ru[ &rusage'ru_stime + &timeval'tv_sec ] - + ($ru[ &rusage'ru_stime + &timeval'tv_usec ]) / 1e6; - - printf "you have used %8.3fs+%8.3fu seconds.\n", $utime, $stime; - - -As you see, the name of the package is the name of the structure. Regular -fields are just their own names. Plus the following accessor functions are -provided for your convenience: - - struct This takes no arguments, and is merely the number of first- - level elements in the structure. You would use this for - indexing into arrays of structures, perhaps like this - - $usec = $u[ &user'u_utimer - + (&ITIMER_VIRTUAL * &itimerval'struct) - + &itimerval'it_value - + &timeval'tv_usec - ]; - - sizeof Returns the bytes in the structure, or the member if - you pass it an argument, such as - - &rusage'sizeof(&rusage'ru_utime) - - typedef This is the perl format definition for passing to pack and - unpack. If you ask for the typedef of a nothing, you get - the whole structure, otherwise you get that of the member - you ask for. Padding is taken care of, as is the magic to - guarantee that a union is unpacked into all its aliases. - Bitfields are not quite yet supported however. - - offsetof This function is the byte offset into the array of that - member. You may wish to use this for indexing directly - into the packed structure with vec() if you're too lazy - to unpack it. - - typeof Not to be confused with the typedef accessor function, this - one returns the C type of that field. This would allow - you to print out a nice structured pretty print of some - structure without knoning anything about it beforehand. - No args to this one is a noop. Someday I'll post such - a thing to dump out your u structure for you. - - -The way I see this being used is like basically this: - - % h2ph /usr/lib/perl/tmp.ph - % c2ph some_include_file.h >> /usr/lib/perl/tmp.ph - % install - -It's a little tricker with c2ph because you have to get the includes right. -I can't know this for your system, but it's not usually too terribly difficult. - -The code isn't pretty as I mentioned -- I never thought it would be a 1000- -line program when I started, or I might not have begun. :-) But I would have -been less cavalier in how the parts of the program communicated with each -other, etc. It might also have helped if I didn't have to divine the makeup -of the stabs on the fly, and then account for micro differences between my -compiler and gcc. - -Anyway, here it is. Should run on perl v4 or greater. Maybe less. - - - --tom - -=cut - -$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; - -###################################################################### - -# some handy data definitions. many of these can be reset later. - -$bitorder = 'b'; # ascending; set to B for descending bit fields - -%intrinsics = -%template = ( - 'char', 'c', - 'unsigned char', 'C', - 'short', 's', - 'short int', 's', - 'unsigned short', 'S', - 'unsigned short int', 'S', - 'short unsigned int', 'S', - 'int', 'i', - 'unsigned int', 'I', - 'long', 'l', - 'long int', 'l', - 'unsigned long', 'L', - 'unsigned long', 'L', - 'long unsigned int', 'L', - 'unsigned long int', 'L', - 'long long', 'q', - 'long long int', 'q', - 'unsigned long long', 'Q', - 'unsigned long long int', 'Q', - 'float', 'f', - 'double', 'd', - 'pointer', 'p', - 'null', 'x', - 'neganull', 'X', - 'bit', $bitorder, -); - -&buildscrunchlist; -delete $intrinsics{'neganull'}; -delete $intrinsics{'bit'}; -delete $intrinsics{'null'}; - -# use -s to recompute sizes -%sizeof = ( - 'char', '1', - 'unsigned char', '1', - 'short', '2', - 'short int', '2', - 'unsigned short', '2', - 'unsigned short int', '2', - 'short unsigned int', '2', - 'int', '4', - 'unsigned int', '4', - 'long', '4', - 'long int', '4', - 'unsigned long', '4', - 'unsigned long int', '4', - 'long unsigned int', '4', - 'long long', '8', - 'long long int', '8', - 'unsigned long long', '8', - 'unsigned long long int', '8', - 'float', '4', - 'double', '8', - 'pointer', '4', -); - -($type_width, $member_width, $offset_width, $size_width) = (20, 20, 6, 5); - -($offset_fmt, $size_fmt) = ('d', 'd'); - -$indent = 2; - -$CC = 'cc'; -!NO!SUBS! - -if (($Config{gccversion} || '') =~ /^(\d+)\.(\d+)/ - and ($1 > 3 or ($1 == 3 and $2 >= 2))) { - print OUT q/$CFLAGS = '-gstabs -S';/; -} else { - print OUT q/$CFLAGS = '-g -S';/; -} - -print OUT <<'!NO!SUBS!'; - -$DEFINES = ''; - -$perl++ if $0 =~ m#/?c2ph$#; - -use Getopt::Std qw(getopts); - -use File::Temp 'tempdir'; - -eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift; - -getopts('aixdpvtnws:') || &usage(0); - -$opt_d && $debug++; -$opt_t && $trace++; -$opt_p && $perl++; -$opt_v && $verbose++; -$opt_n && ($perl = 0); - -if ($opt_w) { - ($type_width, $member_width, $offset_width) = (45, 35, 8); -} -if ($opt_x) { - ($offset_fmt, $offset_width, $size_fmt, $size_width) = ( 'x', '08', 'x', 04 ); -} - -eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift; - -sub PLUMBER { - select(STDERR); - print "oops, apparent pager foulup\n"; - $isatty++; - &usage(1); -} - -sub usage { - local($oops) = @_; - unless (-t STDOUT) { - select(STDERR); - } elsif (!$oops) { - $isatty++; - $| = 1; - print "hit for further explanation: "; - ; - open (PIPE, "|". ($ENV{PAGER} || 'more')); - $SIG{PIPE} = PLUMBER; - select(PIPE); - } - - print "usage: $0 [-dpnP] [var=val] [files ...]\n"; - - exit unless $isatty; - - print < 1, CLEANUP => 1) - unless (defined($SAFEDIR)); -} - -undef $SAFEDIR; - -$recurse = 1; - -if (@ARGV) { - if (grep(!/\.[csh]$/,@ARGV)) { - warn "Only *.[csh] files expected!\n"; - &usage; - } - elsif (grep(/\.s$/,@ARGV)) { - if (@ARGV > 1) { - warn "Only one *.s file allowed!\n"; - &usage; - } - } - elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) { - local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#; - $chdir = "cd $dir && " if $dir; - &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1; - $ARGV[0] =~ s/\.c$/.s/; - } - else { - &safedir; - $TMP = "$SAFEDIR/c2ph.$$.c"; - &system("cat @ARGV > $TMP") && exit 1; - &system("cd $SAFEDIR && $CC $CFLAGS $DEFINES $TMP") && exit 1; - unlink $TMP; - $TMP =~ s/\.c$/.s/; - @ARGV = ($TMP); - } -} - -if ($opt_s) { - for (split(/[\s,]+/, $opt_s)) { - $interested{$_}++; - } -} - - -$| = 1 if $debug; - -main: { - - if ($trace) { - if (-t && !@ARGV) { - print STDERR "reading from your keyboard: "; - } else { - print STDERR "reading from " . (@ARGV ? "@ARGV" : "").": "; - } - } - -STAB: while (<>) { - if ($trace && !($. % 10)) { - $lineno = $..''; - print STDERR $lineno, "\b" x length($lineno); - } - next unless /^\s*\.stabs\s+/; - $line = $_; - s/^\s*\.stabs\s+//; - if (s/\\\\"[d,]+$//) { - $saveline .= $line; - $savebar = $_; - next STAB; - } - if ($saveline) { - s/^"//; - $_ = $savebar . $_; - $line = $saveline; - } - &stab; - $savebar = $saveline = undef; - } - print STDERR "$.\n" if $trace; - unlink $TMP if $TMP; - - &compute_intrinsics if $perl && !$opt_i; - - print STDERR "resolving types\n" if $trace; - - &resolve_types; - &adjust_start_addrs; - - $sum = 2 + $type_width + $member_width; - $pmask1 = "%-${type_width}s %-${member_width}s"; - $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s"; - - - - if ($perl) { - # resolve template -- should be in stab define order, but even this isn't enough. - print STDERR "\nbuilding type templates: " if $trace; - for $i (reverse 0..$#type) { - next unless defined($name = $type[$i]); - next unless defined $struct{$name}; - ($iname = $name) =~ s/\..*//; - $build_recursed = 0; - &build_template($name) unless defined $template{&psou($name)} || - $opt_s && !$interested{$iname}; - } - print STDERR "\n\n" if $trace; - } - - print STDERR "dumping structs: " if $trace; - - local($iam); - - - - foreach $name (sort keys %struct) { - ($iname = $name) =~ s/\..*//; - next if $opt_s && !$interested{$iname}; - print STDERR "$name " if $trace; - - undef @sizeof; - undef @typedef; - undef @offsetof; - undef @indices; - undef @typeof; - undef @fieldnames; - - $mname = &munge($name); - - $fname = &psou($name); - - print "# " if $perl && $verbose; - $pcode = ''; - print "$fname {\n" if !$perl || $verbose; - $template{$fname} = &scrunch($template{$fname}) if $perl; - &pstruct($name,$name,0); - print "# " if $perl && $verbose; - print "}\n" if !$perl || $verbose; - print "\n" if $perl && $verbose; - - if ($perl) { - print "$pcode"; - - printf("\nsub %-32s { %4d; }\n\n", "${mname}'struct", $countof{$name}); - - print < $sizeof{$b}; } - - - foreach $name (sort keys %intrinsics) { - print '$',&munge($name),"'typedef = '", $template{$name}, "';\n"; - } - - print "\n1;\n" if $perl; - - exit; -} - -######################################################################################## - - -sub stab { - next unless $continued || /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/; # (\d+,\d+) is for sun - s/"// || next; - s/",([x\d]+),([x\d]+),([x\d]+),.*// || next; - - next if /^\s*$/; - - $size = $3 if $3; - $_ = $continued . $_ if length($continued); - if (s/\\\\$//) { - # if last 2 chars of string are '\\' then stab is continued - # in next stab entry - chop; - $continued = $_; - next; - } - $continued = ''; - - - $line = $_; - - if (($name, $pdecl) = /^([\$ \w]+):[tT]((\d+)(=[rufs*](\d+))+)$/) { - print "$name is a typedef for some funky pointers: $pdecl\n" if $debug; - &pdecl($pdecl); - next; - } - - - - if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) { - local($ident) = $2; - push(@intrinsics, $ident); - $typeno = &typeno($3); - $type[$typeno] = $ident; - print STDERR "intrinsic $ident in new type $typeno\n" if $debug; - next; - } - - if (($name, $typeordef, $typeno, $extra, $struct, $_) - = /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/) - { - $typeno = &typeno($typeno); # sun foolery - } - elsif (/^[\$\w]+:/) { - next; # variable - } - else { - warn "can't grok stab: <$_> in: $line " if $_; - next; - } - - #warn "got size $size for $name\n"; - $sizeof{$name} = $size if $size; - - s/;[-\d]*;[-\d]*;$//; # we don't care about ranges - - $typenos{$name} = $typeno; - - unless (defined $type[$typeno]) { - &panic("type 0??") unless $typeno; - $type[$typeno] = $name unless defined $type[$typeno]; - printf "new type $typeno is $name" if $debug; - if ($extra =~ /\*/ && defined $type[$struct]) { - print ", a typedef for a pointer to " , $type[$struct] if $debug; - } - } else { - printf "%s is type %d", $name, $typeno if $debug; - print ", a typedef for " , $type[$typeno] if $debug; - } - print "\n" if $debug; - #next unless $extra =~ /[su*]/; - - #$type[$struct] = $name; - - if ($extra =~ /[us*]/) { - &sou($name, $extra); - $_ = &sdecl($name, $_, 0); - } - elsif (/^=ar/) { - print "it's a bare array typedef -- that's pretty sick\n" if $debug; - $_ = "$typeno$_"; - $scripts = ''; - $_ = &adecl($_,1); - - } - elsif (s/((\w+):t(\d+|\(\d+,\d+\)))?=r?(;\d+;\d+;)?//) { # the ?'s are for gcc - push(@intrinsics, $2); - $typeno = &typeno($3); - $type[$typeno] = $2; - print STDERR "intrinsic $2 in new type $typeno\n" if $debug; - } - elsif (s/^=e//) { # blessed be thy compiler; mine won't do this - &edecl; - } - else { - warn "Funny remainder for $name on line $_ left in $line " if $_; - } -} - -sub typeno { # sun thinks types are (0,27) instead of just 27 - local($_) = @_; - s/\(\d+,(\d+)\)/$1/; - $_; -} - -sub pstruct { - local($what,$prefix,$base) = @_; - local($field, $fieldname, $typeno, $count, $offset, $entry); - local($fieldtype); - local($type, $tname); - local($mytype, $mycount, $entry2); - local($struct_count) = 0; - local($pad, $revpad, $length, $prepad, $lastoffset, $lastlength, $fmt); - local($bits,$bytes); - local($template); - - - local($mname) = &munge($name); - - sub munge { - local($_) = @_; - s/[\s\$\.]/_/g; - $_; - } - - local($sname) = &psou($what); - - $nesting++; - - for $field (split(/;/, $struct{$what})) { - $pad = $prepad = 0; - $entry = ''; - ($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field); - - $type = $type[$typeno]; - - $type =~ /([^[]*)(\[.*\])?/; - $mytype = $1; - $count .= $2; - $fieldtype = &psou($mytype); - - local($fname) = &psou($name); - - if ($build_templates) { - - $pad = ($offset - ($lastoffset + $lastlength))/8 - if defined $lastoffset; - - if (! $finished_template{$sname}) { - if ($isaunion{$what}) { - $template{$sname} .= 'X' x $revpad . ' ' if $revpad; - } else { - $template{$sname} .= 'x' x $pad . ' ' if $pad; - } - } - - $template = &fetch_template($type); - &repeat_template($template,$count); - - if (! $finished_template{$sname}) { - $template{$sname} .= $template; - } - - $revpad = $length/8 if $isaunion{$what}; - - ($lastoffset, $lastlength) = ($offset, $length); - - } else { - print '# ' if $perl && $verbose; - $entry = sprintf($pmask1, - ' ' x ($nesting * $indent) . $fieldtype, - "$prefix.$fieldname" . $count); - - $entry =~ s/(\*+)( )/$2$1/; - - printf $pmask2, - $entry, - ($base+$offset)/8, - ($bits = ($base+$offset)%8) ? ".$bits" : " ", - $length/8, - ($bits = $length % 8) ? ".$bits": "" - if !$perl || $verbose; - - if ($perl) { - $template = &fetch_template($type); - &repeat_template($template,$count); - } - - if ($perl && $nesting == 1) { - - push(@sizeof, int($length/8) .",\t# $fieldname"); - push(@offsetof, int($offset/8) .",\t# $fieldname"); - local($little) = &scrunch($template); - push(@typedef, "'$little', \t# $fieldname"); - $type =~ s/(struct|union) //; - push(@typeof, "'$mytype" . ($count ? $count : '') . - "',\t# $fieldname"); - push(@fieldnames, "'$fieldname',"); - } - - print ' ', ' ' x $indent x $nesting, $template - if $perl && $verbose; - - print "\n" if !$perl || $verbose; - - } - if ($perl) { - local($mycount) = defined $struct{$mytype} ? $countof{$mytype} : 1; - $mycount *= &scripts2count($count) if $count; - if ($nesting==1 && !$build_templates) { - $pcode .= sprintf("sub %-32s { %4d; }\n", - "${mname}'${fieldname}", $struct_count); - push(@indices, $struct_count); - } - $struct_count += $mycount; - } - - - &pstruct($type, "$prefix.$fieldname", $base+$offset) - if $recurse && defined $struct{$type}; - } - - $countof{$what} = $struct_count unless defined $countof{$whati}; - - $template{$sname} .= '$' if $build_templates; - $finished_template{$sname}++; - - if ($build_templates && !defined $sizeof{$name}) { - local($fmt) = &scrunch($template{$sname}); - print STDERR "no size for $name, punting with $fmt..." if $debug; - eval '$sizeof{$name} = length(pack($fmt, ()))'; - if ($@) { - chop $@; - warn "couldn't get size for \$name: $@"; - } else { - print STDERR $sizeof{$name}, "\n" if $debUg; - } - } - - --$nesting; -} - - -sub psize { - local($me) = @_; - local($amstruct) = $struct{$me} ? 'struct ' : ''; - - print '$sizeof{\'', $amstruct, $me, '\'} = '; - printf "%d;\n", $sizeof{$me}; -} - -sub pdecl { - local($pdecl) = @_; - local(@pdecls); - local($tname); - - warn "pdecl: $pdecl\n" if $debug; - - $pdecl =~ s/\(\d+,(\d+)\)/$1/g; - $pdecl =~ s/\*//g; - @pdecls = split(/=/, $pdecl); - $typeno = $pdecls[0]; - $tname = pop @pdecls; - - if ($tname =~ s/^f//) { $tname = "$tname&"; } - #else { $tname = "$tname*"; } - - for (reverse @pdecls) { - $tname .= s/^f// ? "&" : "*"; - #$tname =~ s/^f(.*)/$1&/; - print "type[$_] is $tname\n" if $debug; - $type[$_] = $tname unless defined $type[$_]; - } -} - - - -sub adecl { - ($arraytype, $unknown, $lower, $upper) = (); - #local($typeno); - # global $typeno, @type - local($_, $typedef) = @_; - - while (s/^((\d+|\(\d+,\d+\))=)?ar(\d+|\(\d+,\d+\));//) { - ($arraytype, $unknown) = ($2, $3); - $arraytype = &typeno($arraytype); - $unknown = &typeno($unknown); - if (s/^(\d+);(\d+);//) { - ($lower, $upper) = ($1, $2); - $scripts .= '[' . ($upper+1) . ']'; - } else { - warn "can't find array bounds: $_"; - } - } - if (s/^([(,)\d*f=]*),(\d+),(\d+);//) { - ($start, $length) = ($2, $3); - $whatis = $1; - if ($whatis =~ /^(\d+|\(\d+,\d+\))=/) { - $typeno = &typeno($1); - &pdecl($whatis); - } else { - $typeno = &typeno($whatis); - } - } elsif (s/^(\d+)(=[*suf]\d*)//) { - local($whatis) = $2; - - if ($whatis =~ /[f*]/) { - &pdecl($whatis); - } elsif ($whatis =~ /[su]/) { # - print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n" - if $debug; - #$type[$typeno] = $name unless defined $type[$typeno]; - ##printf "new type $typeno is $name" if $debug; - $typeno = $1; - $type[$typeno] = "$prefix.$fieldname"; - local($name) = $type[$typeno]; - &sou($name, $whatis); - $_ = &sdecl($name, $_, $start+$offset); - 1; - $start = $start{$name}; - $offset = $sizeof{$name}; - $length = $offset; - } else { - warn "what's this? $whatis in $line "; - } - } elsif (/^\d+$/) { - $typeno = $_; - } else { - warn "bad array stab: $_ in $line "; - next STAB; - } - #local($wasdef) = defined($type[$typeno]) && $debug; - #if ($typedef) { - #print "redefining $type[$typeno] to " if $wasdef; - #$type[$typeno] = "$whatis$scripts"; # unless defined $type[$typeno]; - #print "$type[$typeno]\n" if $wasdef; - #} else { - #$type[$arraytype] = $type[$typeno] unless defined $type[$arraytype]; - #} - $type[$arraytype] = "$type[$typeno]$scripts" if defined $type[$typeno]; - print "type[$arraytype] is $type[$arraytype]\n" if $debug; - print "$prefix.$fieldname is an array of $type[$arraytype]\n" if $debug; - $_; -} - - - -sub sdecl { - local($prefix, $_, $offset) = @_; - - local($fieldname, $scripts, $type, $arraytype, $unknown, - $whatis, $pdecl, $upper,$lower, $start,$length) = (); - local($typeno,$sou); - - -SFIELD: - while (/^([^;]+);/) { - $scripts = ''; - warn "sdecl $_\n" if $debug; - if (s/^([\$\w]+)://) { - $fieldname = $1; - } elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # - $typeno = &typeno($1); - $type[$typeno] = "$prefix.$fieldname"; - local($name) = "$prefix.$fieldname"; - &sou($name,$2); - $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); - $start = $start{$name}; - $offset += $sizeof{$name}; - #print "done with anon, start is $start, offset is $offset\n"; - #next SFIELD; - } else { - warn "weird field $_ of $line" if $debug; - next STAB; - #$fieldname = &gensym; - #$_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); - } - - if (/^(\d+|\(\d+,\d+\))=ar/) { - $_ = &adecl($_); - } - elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) { - ($start, $length) = ($2, $3); - &panic("no length?") unless $length; - $typeno = &typeno($1) if $1; - } - elsif (s/^(\d+)=xs\w+:,(\d+),(\d+);//) { - ($start, $length) = ($2, $3); - &panic("no length?") unless $length; - $typeno = &typeno($1) if $1; - } - elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) { - ($pdecl, $start, $length) = ($1,$5,$6); - &pdecl($pdecl); - } - elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct - ($typeno, $sou) = ($1, $2); - $typeno = &typeno($typeno); - if (defined($type[$typeno])) { - warn "now how did we get type $1 in $fieldname of $line?"; - } else { - print "anon type $typeno is $prefix.$fieldname\n" if $debug; - $type[$typeno] = "$prefix.$fieldname" unless defined $type[$typeno]; - }; - local($name) = "$prefix.$fieldname"; - &sou($name,$sou); - print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug; - $type[$typeno] = "$prefix.$fieldname"; - $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); - $start = $start{$name}; - $length = $sizeof{$name}; - } - else { - warn "can't grok stab for $name ($_) in line $line "; - next STAB; - } - - &panic("no length for $prefix.$fieldname") unless $length; - $struct{$name} .= join(',', $fieldname, $typeno, $scripts, $start, $length) . ';'; - } - if (s/;\d*,(\d+),(\d+);//) { - local($start, $size) = ($1, $2); - $sizeof{$prefix} = $size; - print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug; - $start{$prefix} = $start; - } - $_; -} - -sub edecl { - s/;$//; - $enum{$name} = $_; - $_ = ''; -} - -sub resolve_types { - local($sou); - for $i (0 .. $#type) { - next unless defined $type[$i]; - $_ = $type[$i]; - unless (/\d/) { - print "type[$i] $type[$i]\n" if $debug; - next; - } - print "type[$i] $_ ==> " if $debug; - s/^(\d+)(\**)\&\*(\**)/"$2($3".&type($1) . ')()'/e; - s/^(\d+)\&/&type($1)/e; - s/^(\d+)/&type($1)/e; - s/(\*+)([^*]+)(\*+)/$1$3$2/; - s/\((\*+)(\w+)(\*+)\)/$3($1$2)/; - s/^(\d+)([\*\[].*)/&type($1).$2/e; - #s/(\d+)(\*|(\[[\[\]\d\*]+]\])+)/&type($1).$2/ge; - $type[$i] = $_; - print "$_\n" if $debug; - } -} -sub type { &psou($type[$_[0]] || ""); } - -sub adjust_start_addrs { - for (sort keys %start) { - ($basename = $_) =~ s/\.[^.]+$//; - $start{$_} += $start{$basename}; - print "start: $_ @ $start{$_}\n" if $debug; - } -} - -sub sou { - local($what, $_) = @_; - /u/ && $isaunion{$what}++; - /s/ && $isastruct{$what}++; -} - -sub psou { - local($what) = @_; - local($prefix) = ''; - if ($isaunion{$what}) { - $prefix = 'union '; - } elsif ($isastruct{$what}) { - $prefix = 'struct '; - } - $prefix . $what; -} - -sub scrunch { - local($_) = @_; - - return '' if $_ eq ''; - - study; - - s/\$//g; - s/ / /g; - 1 while s/(\w) \1/$1$1/g; - - # i wanna say this, but perl resists my efforts: - # s/(\w)(\1+)/$2 . length($1)/ge; - - &quick_scrunch; - - s/ $//; - - $_; -} - -sub buildscrunchlist { - $scrunch_code = "sub quick_scrunch {\n"; - for (values %intrinsics) { - $scrunch_code .= "\ts/(${_}{2,})/'$_' . length(\$1)/ge;\n"; - } - $scrunch_code .= "}\n"; - print "$scrunch_code" if $debug; - eval $scrunch_code; - &panic("can't eval scrunch_code $@ \nscrunch_code") if $@; -} - -sub fetch_template { - local($mytype) = @_; - local($fmt); - local($count) = 1; - - &panic("why do you care?") unless $perl; - - if ($mytype =~ s/(\[\d+\])+$//) { - $count .= $1; - } - - if ($mytype =~ /\*/) { - $fmt = $template{'pointer'}; - } - elsif (defined $template{$mytype}) { - $fmt = $template{$mytype}; - } - elsif (defined $struct{$mytype}) { - if (!defined $template{&psou($mytype)}) { - &build_template($mytype) unless $mytype eq $name; - } - elsif ($template{&psou($mytype)} !~ /\$$/) { - #warn "incomplete template for $mytype\n"; - } - $fmt = $template{&psou($mytype)} || '?'; - } - else { - warn "unknown fmt for $mytype\n"; - $fmt = '?'; - } - - $fmt x $count . ' '; -} - -sub compute_intrinsics { - &safedir; - local($TMP) = "$SAFEDIR/c2ph-i.$$.c"; - open (TMP, ">$TMP") || die "can't open $TMP: $!"; - select(TMP); - - print STDERR "computing intrinsic sizes: " if $trace; - - undef %intrinsics; - - print <<'EOF'; -main() { - char *mask = "%d %s\n"; -EOF - - for $type (@intrinsics) { - next if !$type || $type eq 'void' || $type =~ /complex/; # sun stuff - print <<"EOF"; - printf(mask,sizeof($type), "$type"); -EOF - } - - print <<'EOF'; - printf(mask,sizeof(char *), "pointer"); - exit(0); -} -EOF - close TMP; - - select(STDOUT); - open(PIPE, "cd $SAFEDIR && $CC $TMP && $SAFEDIR/a.out|"); - while () { - chop; - split(' ',$_,2);; - print "intrinsic $_[1] is size $_[0]\n" if $debug; - $sizeof{$_[1]} = $_[0]; - $intrinsics{$_[1]} = $template{$_[0]}; - } - close(PIPE) || die "couldn't read intrinsics!"; - unlink($TMP, "$SAFEDIR/a.out"); - print STDERR "done\n" if $trace; -} - -sub scripts2count { - local($_) = @_; - - s/^\[//; - s/\]$//; - s/\]\[/*/g; - $_ = eval; - &panic("$_: $@") if $@; - $_; -} - -sub system { - print STDERR "@_\n" if $trace; - system @_; -} - -sub build_template { - local($name) = @_; - - &panic("already got a template for $name") if defined $template{$name}; - - local($build_templates) = 1; - - local($lparen) = '(' x $build_recursed; - local($rparen) = ')' x $build_recursed; - - print STDERR "$lparen$name$rparen " if $trace; - $build_recursed++; - &pstruct($name,$name,0); - print STDERR "TEMPLATE for $name is ", $template{&psou($name)}, "\n" if $debug; - --$build_recursed; -} - - -sub panic { - - select(STDERR); - - print "\npanic: @_\n"; - - exit 1 if $] <= 4.003; # caller broken - - local($i,$_); - local($p,$f,$l,$s,$h,$a,@a,@sub); - for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) { - @a = @DB'args; - for (@a) { - if (/^StB\000/ && length($_) == length($_main{'_main'})) { - $_ = sprintf("%s",$_); - } - else { - s/'/\\'/g; - s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/; - s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; - s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; - } - } - $w = $w ? '@ = ' : '$ = '; - $a = $h ? '(' . join(', ', @a) . ')' : ''; - push(@sub, "$w&$s$a from file $f line $l\n"); - last if $signal; - } - for ($i=0; $i <= $#sub; $i++) { - last if $signal; - print $sub[$i]; - } - exit 1; -} - -sub squishseq { - local($num); - local($last) = -1e8; - local($string); - local($seq) = '..'; - - while (defined($num = shift)) { - if ($num == ($last + 1)) { - $string .= $seq unless $inseq++; - $last = $num; - next; - } elsif ($inseq) { - $string .= $last unless $last == -1e8; - } - - $string .= ',' if defined $string; - $string .= $num; - $last = $num; - $inseq = 0; - } - $string .= $last if $inseq && $last != -e18; - $string; -} - -sub repeat_template { - # local($template, $scripts) = @_; have to change caller's values - - if ( $_[1] ) { - local($ncount) = &scripts2count($_[1]); - if ($_[0] =~ /^\s*c\s*$/i) { - $_[0] = "A$ncount "; - $_[1] = ''; - } else { - $_[0] = $template x $ncount; - } - } -} -!NO!SUBS! - -close OUT or die "Can't close $file: $!"; -chmod 0755, $file or die "Can't reset permissions for $file: $!\n"; -unlink 'pstruct'; -print "Linking $file to pstruct.\n"; -if (defined $Config{d_link}) { - link $file, 'pstruct'; -} else { - unshift @INC, '../lib'; - require File::Copy; - File::Copy::syscopy('c2ph', 'pstruct'); -} -exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':'; -chdir $origdir; diff --git a/utils/corelist.PL b/utils/corelist.PL index 9bad775..d1376be 100644 --- a/utils/corelist.PL +++ b/utils/corelist.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, '>', $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -38,7 +38,7 @@ my $script = File::Spec->catfile( File::Spec->updir, qw[dist Module-CoreList] ), "corelist"); -if (open(IN, $script)) { +if (open(IN, '<', $script)) { print OUT ; close IN; } else { diff --git a/utils/cpan.PL b/utils/cpan.PL index c7c2668..f40c1c4 100644 --- a/utils/cpan.PL +++ b/utils/cpan.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, '>', $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -35,7 +35,7 @@ use File::Spec; my $cpan = File::Spec->catfile(File::Spec->catdir(File::Spec->updir, qw(cpan CPAN scripts)), "cpan"); -if (open(CPAN, $cpan)) { +if (open(CPAN, '<', $cpan)) { print OUT ; close CPAN; } else { diff --git a/utils/enc2xs.PL b/utils/enc2xs.PL index f50cdd7..863ff8e 100644 --- a/utils/enc2xs.PL +++ b/utils/enc2xs.PL @@ -21,7 +21,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, '>', $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -38,7 +38,7 @@ use File::Spec; my $enc2xs = File::Spec->catfile(File::Spec->catdir(File::Spec->updir, "cpan", "Encode", "bin"), "enc2xs"); -if (open(ENC2XS, $enc2xs)) { +if (open(ENC2XS, '<', $enc2xs)) { print OUT ; close ENC2XS; } else { diff --git a/utils/encguess.PL b/utils/encguess.PL index 81322f9..caa908f 100644 --- a/utils/encguess.PL +++ b/utils/encguess.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, '>', $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -35,7 +35,7 @@ use File::Spec; my $enc2xs = File::Spec->catfile(File::Spec->catdir(File::Spec->updir, "cpan", "Encode", "bin"), "encguess"); -if (open(ENC2XS, $enc2xs)) { +if (open(ENC2XS, '<', $enc2xs)) { print OUT ; close ENC2XS; } else { diff --git a/utils/h2ph.PL b/utils/h2ph.PL index 2523c0a..db78749 100644 --- a/utils/h2ph.PL +++ b/utils/h2ph.PL @@ -19,7 +19,7 @@ chdir dirname($0); $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, '>', $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -119,8 +119,8 @@ while (defined (my $file = next_file())) { } } - open(IN,"$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next); - open(OUT,">$Dest_dir/$outfile") || die "Can't create $outfile: $!\n"; + open(IN, "<", "$file") || (($Exit = 1),(warn "Can't open $file: $!\n"),next); + open(OUT, ">", "$Dest_dir/$outfile") || die "Can't create $outfile: $!\n"; } print OUT @@ -737,7 +737,7 @@ sub queue_includes_from return if ($file eq "-"); - open HEADER, $file or return; + open HEADER, "<", $file or return; while (defined($line =

)) { while (/\\$/) { # Handle continuation lines chop $line; @@ -777,7 +777,7 @@ sub build_preamble_if_necessary # Can we skip building the preamble file? if (-r $preamble) { # Extract version number from first line of preamble: - open PREAMBLE, $preamble or die "Cannot open $preamble: $!"; + open PREAMBLE, "<", $preamble or die "Cannot open $preamble: $!"; my $line = ; $line =~ /(\b\d+\b)/; close PREAMBLE or die "Cannot close $preamble: $!"; @@ -788,7 +788,7 @@ sub build_preamble_if_necessary my (%define) = _extract_cc_defines(); - open PREAMBLE, ">$preamble" or die "Cannot open $preamble: $!"; + open PREAMBLE, ">", $preamble or die "Cannot open $preamble: $!"; print PREAMBLE "# This file was created by h2ph version $VERSION\n"; # Prevent non-portable hex constants from warning. # diff --git a/utils/h2xs.PL b/utils/h2xs.PL index f9063cb..92dce0d 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -842,7 +842,7 @@ if( @path_h ){ # Scan the header file (we should deal with nested header files) # Record the names of simple #define constants into const_names # Function prototypes are processed below. - open(CH, "<$rel_path_h") || die "Can't open $rel_path_h: $!\n"; + open(CH, "<", "$rel_path_h") || die "Can't open $rel_path_h: $!\n"; defines: while () { if ($pre_sub_tri_graphs) { @@ -975,7 +975,7 @@ if( ! $opt_X ){ # use XS, unless it was disabled Devel::PPPort::WriteFile('ppport.h') || die "Can't create $ext$modpname/ppport.h: $!\n"; } - open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n"; + open(XS, ">", "$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n"; if ($opt_x) { warn "Scanning typemaps...\n"; get_typemap(); @@ -1093,7 +1093,7 @@ for (sort(keys(%const_names))) { } -d $modpmdir || mkpath([$modpmdir], 0, 0775); -open(PM, ">$modpmname") || die "Can't create $ext$modpname/$modpmname: $!\n"; +open(PM, ">", "$modpmname") || die "Can't create $ext$modpname/$modpmname: $!\n"; $" = "\n\t"; warn "Writing $ext$modpname/$modpmname\n"; @@ -1779,7 +1779,7 @@ sub get_typemap { warn " Scanning $typemap\n"; warn("Warning: ignoring non-text typemap file '$typemap'\n"), next unless -T $typemap ; - open(TYPEMAP, $typemap) + open(TYPEMAP, "<", $typemap) or warn ("Warning: could not open typemap file '$typemap': $!\n"), next; my $mode = 'Typemap'; while () { @@ -1872,7 +1872,7 @@ close XS; if (%types_seen) { my $type; warn "Writing $ext$modpname/typemap\n"; - open TM, ">typemap" or die "Cannot open typemap file for write: $!"; + open TM, ">", "typemap" or die "Cannot open typemap file for write: $!"; for $type (sort keys %types_seen) { my $entry = assign_typemap_entry $type; @@ -1906,7 +1906,7 @@ EOP } # if( ! $opt_X ) warn "Writing $ext$modpname/Makefile.PL\n"; -open(PL, ">Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n"; +open(PL, ">", "Makefile.PL") || die "Can't create $ext$modpname/Makefile.PL: $!\n"; my $prereq_pm = ''; @@ -2032,7 +2032,7 @@ close(PL) || die "Can't close $ext$modpname/Makefile.PL: $!\n"; # Create a simple README since this is a CPAN requirement # and it doesn't hurt to have one warn "Writing $ext$modpname/README\n"; -open(RM, ">README") || die "Can't create $ext$modpname/README:$!\n"; +open(RM, ">", "README") || die "Can't create $ext$modpname/README:$!\n"; my $thisyear = (gmtime)[5] + 1900; my $rmhead = "$modpname version $TEMPLATE_VERSION"; my $rmheadeq = "=" x length($rmhead); @@ -2099,7 +2099,7 @@ unless (-d "$testdir") { warn "Writing $ext$modpname/$testfile\n"; my $tests = @const_names ? 2 : 1; -open EX, ">$testfile" or die "Can't create $ext$modpname/$testfile: $!\n"; +open EX, ">", "$testfile" or die "Can't create $ext$modpname/$testfile: $!\n"; print EX <<_END_; # Before 'make install' is performed this script should be runnable with @@ -2205,7 +2205,7 @@ close(EX) || die "Can't close $ext$modpname/$testfile: $!\n"; unless ($opt_C) { warn "Writing $ext$modpname/Changes\n"; $" = ' '; - open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n"; + open(EX, ">", "Changes") || die "Can't create $ext$modpname/Changes: $!\n"; @ARGS = map {/[\s\"\'\`\$*?^|&<>\[\]\{\}\(\)]/ ? "'$_'" : $_} @ARGS; print EX <MANIFEST') or die "Can't create MANIFEST: $!"; +open(MANI, '>', 'MANIFEST') or die "Can't create MANIFEST: $!"; my @files = grep { -f } (<*>, , <$fallbackdirname/*>, <$modpmdir/*>); if (!@files) { eval {opendir(D,'.');}; diff --git a/utils/instmodsh.PL b/utils/instmodsh.PL index 08a47b7..a1e7b55 100644 --- a/utils/instmodsh.PL +++ b/utils/instmodsh.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, '>', $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -38,7 +38,7 @@ my $instmodsh qw(cpan ExtUtils-MakeMaker bin)), 'instmodsh'); -if (open(INSTMODSH, $instmodsh)) { +if (open(INSTMODSH, '<', $instmodsh)) { print OUT ; close INSTMODSH; } else { diff --git a/utils/json_pp.PL b/utils/json_pp.PL index 72c2e90..efd8e23 100644 --- a/utils/json_pp.PL +++ b/utils/json_pp.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, '>', $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -38,7 +38,7 @@ my $script = File::Spec->catfile( File::Spec->updir, qw[cpan JSON-PP bin] ), "json_pp"); -if (open(IN, $script)) { +if (open(IN, '<', $script)) { print OUT ; close IN; } else { diff --git a/utils/libnetcfg.PL b/utils/libnetcfg.PL index 26d2f99..f66e9b0 100644 --- a/utils/libnetcfg.PL +++ b/utils/libnetcfg.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; diff --git a/utils/perlbug.PL b/utils/perlbug.PL index b0b2c12..2a440cd 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -20,7 +20,7 @@ chdir dirname($0); $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT, ">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; # get patchlevel.h timestamp diff --git a/utils/perldoc.PL b/utils/perldoc.PL index cd60bd4..afaa5a9 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -29,7 +29,7 @@ warn "How odd, I'm going to generate $file_shortname?!" $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting \"$file\" (with variable substitutions)\n"; diff --git a/utils/perlivp.PL b/utils/perlivp.PL index 81f8ae4..50d187a 100644 --- a/utils/perlivp.PL +++ b/utils/perlivp.PL @@ -20,7 +20,7 @@ my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; # Create output file. -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; diff --git a/utils/piconv.PL b/utils/piconv.PL index ca8a8cf..4e012d3 100644 --- a/utils/piconv.PL +++ b/utils/piconv.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -35,7 +35,7 @@ use File::Spec; my $piconv = File::Spec->catfile(File::Spec->catdir(File::Spec->updir, "cpan", "Encode", "bin"), "piconv"); -if (open(PICONV, $piconv)) { +if (open(PICONV, '<', $piconv)) { print OUT ; close PICONV; } else { diff --git a/utils/pl2pm.PL b/utils/pl2pm.PL index b7e1cea..19aef58 100644 --- a/utils/pl2pm.PL +++ b/utils/pl2pm.PL @@ -18,7 +18,7 @@ chdir dirname($0); $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -126,7 +126,7 @@ while (<>) { $export_ok = "\@EXPORT_OK = qw(@export_ok);\n"; } - if ( open(PM, ">$newname") ) { + if ( open(PM, ">", $newname) ) { print PM <<"END"; package $newpack; use 5.006; diff --git a/utils/pod2html.PL b/utils/pod2html.PL index 696624f..eafd8f6 100644 --- a/utils/pod2html.PL +++ b/utils/pod2html.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; diff --git a/utils/prove.PL b/utils/prove.PL index 17c4a76..61b8efc 100644 --- a/utils/prove.PL +++ b/utils/prove.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -36,7 +36,7 @@ use File::Spec; my $prove = File::Spec->catfile(File::Spec->catdir(File::Spec->updir, "cpan", "Test-Harness", "bin"), "prove"); -if (open(PROVE, $prove)) { +if (open(PROVE, '<', $prove)) { print OUT ; close PROVE; } else { diff --git a/utils/ptar.PL b/utils/ptar.PL index 66242e3..5dbf61b 100644 --- a/utils/ptar.PL +++ b/utils/ptar.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -38,7 +38,7 @@ my $script = File::Spec->catfile( File::Spec->updir, qw[cpan Archive-Tar bin] ), "ptar"); -if (open(IN, $script)) { +if (open(IN, '<', $script)) { print OUT ; close IN; } else { diff --git a/utils/ptardiff.PL b/utils/ptardiff.PL index e68f11f..8daefe2 100644 --- a/utils/ptardiff.PL +++ b/utils/ptardiff.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -38,7 +38,7 @@ my $script = File::Spec->catfile( File::Spec->updir, qw[cpan Archive-Tar bin] ), "ptardiff"); -if (open(IN, $script)) { +if (open(IN, '<', $script)) { print OUT ; close IN; } else { diff --git a/utils/ptargrep.PL b/utils/ptargrep.PL index 99d66a6..b8b0830 100644 --- a/utils/ptargrep.PL +++ b/utils/ptargrep.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -38,7 +38,7 @@ my $script = File::Spec->catfile( File::Spec->updir, qw[cpan Archive-Tar bin] ), "ptargrep"); -if (open(IN, $script)) { +if (open(IN, '<', $script)) { print OUT ; close IN; } else { diff --git a/utils/shasum.PL b/utils/shasum.PL index 852e6d2..afdbb48 100644 --- a/utils/shasum.PL +++ b/utils/shasum.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -38,7 +38,7 @@ my $script = File::Spec->catfile( File::Spec->updir, qw[cpan Digest-SHA] ), "shasum"); -if (open(IN, $script)) { +if (open(IN, '<', $script)) { print OUT ; close IN; } else { diff --git a/utils/splain.PL b/utils/splain.PL index bbcdad6..ccf325d 100644 --- a/utils/splain.PL +++ b/utils/splain.PL @@ -21,11 +21,11 @@ $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; # Open input file before creating output file. -$IN = File::Spec->catfile(File::Spec->updir, 'lib', 'diagnostics.pm'); -open IN or die "Can't open $IN: $!\n"; +$in = File::Spec->catfile(File::Spec->updir, 'lib', 'diagnostics.pm'); +open IN, '<', $in or die "Can't open $in: $!\n"; # Create output file. -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, '>', $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; diff --git a/utils/xsubpp.PL b/utils/xsubpp.PL index 0331d4a..450275b 100644 --- a/utils/xsubpp.PL +++ b/utils/xsubpp.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -38,7 +38,7 @@ my $xsubpp = File::Spec->catfile(File::Spec->catdir(File::Spec->updir, lib ExtUtils)), 'xsubpp'); -if (open(XSUBPP, $xsubpp)) { +if (open(XSUBPP, '<', $xsubpp)) { print OUT ; close XSUBPP; } else { diff --git a/utils/zipdetails.PL b/utils/zipdetails.PL index a905c4b..0fbdf83 100644 --- a/utils/zipdetails.PL +++ b/utils/zipdetails.PL @@ -18,7 +18,7 @@ chdir dirname($0); my $file = basename($0, '.PL'); $file .= '.com' if $^O eq 'VMS'; -open OUT,">$file" or die "Can't create $file: $!"; +open OUT, ">", $file or die "Can't create $file: $!"; print "Extracting $file (with variable substitutions)\n"; @@ -38,7 +38,7 @@ my $script = File::Spec->catfile( File::Spec->updir, qw[ cpan IO-Compress bin ] ), "zipdetails"); -if (open(IN, $script)) { +if (open(IN, '<', $script)) { print OUT ; close IN; } else { diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index 5cd30dd..bc1ebec 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -281,7 +281,7 @@ unidatadirs = lib/unicore/To lib/unicore/lib # Modules which must be installed before we can build extensions LIBPREREQ = $(ARCHDIR)Config.pm $(ARCHDIR)Config_heavy.pl $(ARCHDIR)vmspipe.com -utils1 = [.utils]perldoc.com [.utils]c2ph.com [.utils]h2ph.com +utils1 = [.utils]perldoc.com [.utils]h2ph.com utils2 = [.utils]h2xs.com [.utils]libnetcfg.com [.lib]perlbug.com [.utils]json_pp.com utils3 = [.utils]perlivp.com [.lib]splain.com [.utils]pl2pm.com [.utils]xsubpp.com [.utils]pod2html.com [.utils]instmodsh.com utils4 = [.utils]enc2xs.com [.utils]piconv.com [.utils]cpan.com [.utils]prove.com [.utils]ptar.com [.utils]ptardiff.com [.utils]shasum.com @@ -307,7 +307,7 @@ utils : $(utils1) $(utils2) $(utils3) $(utils4) $(utils5) extra.pods : miniperl @ @extra_pods.com -PERLDELTA_CURRENT = [.pod]perl5258delta.pod +PERLDELTA_CURRENT = [.pod]perl5259delta.pod $(PERLDELTA_CURRENT) : [.pod]perldelta.pod Copy/NoConfirm/Log $(MMS$SOURCE) $(PERLDELTA_CURRENT) @@ -463,9 +463,6 @@ nonxsext : $(LIBPREREQ) preplibrary $(MINIPERL_EXE) [.pod]perlfunc.pod [.utils]corelist.com : [.utils]corelist.PL $(ARCHDIR)Config.pm $(MINIPERL) -"I[-.lib]" $(MMS$SOURCE) -[.utils]c2ph.com : [.utils]c2ph.PL $(ARCHDIR)Config.pm - $(MINIPERL) -"I[-.lib]" $(MMS$SOURCE) - [.utils]json_pp.com : [.utils]json_pp.PL $(ARCHDIR)Config.pm $(MINIPERL) -"I[-.lib]" $(MMS$SOURCE) diff --git a/vms/gen_shrfls.pl b/vms/gen_shrfls.pl index 570a946..6ed7eca 100644 --- a/vms/gen_shrfls.pl +++ b/vms/gen_shrfls.pl @@ -38,7 +38,7 @@ my $debug = $ENV{'GEN_SHRFLS_DEBUG'}; print "gen_shrfls.pl Rev. 8-Jul-2011\n" if $debug; if ($ARGV[0] eq '-f') { - open(INP,$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n"; + open(INP,'<',$ARGV[1]) or die "Can't read input file $ARGV[1]: $!\n"; print "Input taken from file $ARGV[1]\n" if $debug; @ARGV = (); while () { @@ -205,7 +205,7 @@ elsif (@symfiles) { $incstr .= ',' . join(',',@symfiles); } # Linker wants /Include and /Library on different lines print OPTBLD "$libperl/Include=($incstr)\n"; print OPTBLD "$libperl/Library\n"; -open(RTLOPT,$rtlopt) or die "$0: Can't read options file $rtlopt: $!\n"; +open(RTLOPT,'<',$rtlopt) or die "$0: Can't read options file $rtlopt: $!\n"; while () { print OPTBLD; } close RTLOPT; close OPTBLD; diff --git a/vms/mms2make.pl b/vms/mms2make.pl index 1706c51..7a83052 100644 --- a/vms/mms2make.pl +++ b/vms/mms2make.pl @@ -38,8 +38,8 @@ $macros{"DECC"} = 1 if $macros{"__AXP__"}; # [lazy - saves having to check for empty array - just test [0]==1] @conditions = (1); -open(INFIL,$infile) || die "Can't open $infile: $!\n"; -open(OUTFIL,">$outfile") || die "Can't open $outfile: $!\n"; +open(INFIL,'<',$infile) || die "Can't open $infile: $!\n"; +open(OUTFIL,'>',$outfile) || die "Can't open $outfile: $!\n"; print OUTFIL "#> This file produced from $infile by $0\n"; print OUTFIL "#> Lines beginning with \"#>\" were commented out during the\n"; diff --git a/vms/vms.c b/vms/vms.c index d1a89cd..71beaf7 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -483,7 +483,6 @@ copy_expand_unix_filename_escape(char *outspec, const char *inspec, int *output_ return 1; break; case '.': - case '~': case '!': case '#': case '&': @@ -505,7 +504,7 @@ copy_expand_unix_filename_escape(char *outspec, const char *inspec, int *output_ /* Don't escape again if following character is * already something we escape. */ - if (strchr(".~!#&\'`()+@{},;[]%^=_\\", *(inspec+1))) { + if (strchr(".!#&\'`()+@{},;[]%^=_\\", *(inspec+1))) { *outspec = *inspec; *output_cnt = 1; return 1; @@ -8335,7 +8334,6 @@ posix_to_vmsspec_hardway(char *vmspath, int vmspath_len, const char *unixpath, vmsptr += out_cnt; unixptr += in_cnt; break; - case '~': case ';': case '\\': case '?': @@ -8789,7 +8787,6 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) } break; case '\"': - case '~': case '`': case '!': case '#': @@ -8798,7 +8795,7 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) /* Don't escape again if following character is * already something we escape. */ - if (strchr("\"~`!#%^&()=+\'@[]{}:\\|<>_.", *(cp2+1))) { + if (strchr("\"`!#%^&()=+\'@[]{}:\\|<>_.", *(cp2+1))) { *(cp1++) = *(cp2++); break; } @@ -12034,7 +12031,7 @@ Perl_cando_by_name_int(pTHX_ I32 bit, bool effective, const char *fname, int opt } -/* Do the permissions allow some operation? Assumes PL_statcache already set. */ +/* Do the permissions in *statbufp allow some operation? */ /* Do this via $Check_Access on VMS, since the CRTL stat() returns only a * subset of the applicable information. */ diff --git a/vms/vmsish.h b/vms/vmsish.h index 1aea829..5011590 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -317,7 +317,7 @@ struct interp_intern { #define PERL_SYS_INIT_BODY(c,v) MALLOC_CHECK_TAINT2(*c,*v) vms_image_init((c),(v)); PERLIO_INIT; MALLOC_INIT #define PERL_SYS_TERM_BODY() HINTS_REFCNT_TERM; OP_REFCNT_TERM; \ PERLIO_TERM; MALLOC_TERM; LOCALE_TERM -#define dXSUB_SYS +#define dXSUB_SYS dNOOP #define HAS_KILL #define HAS_WAIT diff --git a/win32/GNUmakefile b/win32/GNUmakefile index a88a737..f188940 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -63,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.8 +#INST_VER := \5.25.9 # # Comment this out if you DON'T want your perl installation to have @@ -853,8 +853,6 @@ UTILS = \ ..\utils\splain \ ..\utils\perlbug \ ..\utils\pl2pm \ - ..\utils\c2ph \ - ..\utils\pstruct \ ..\utils\h2xs \ ..\utils\perldoc \ ..\utils\perlivp \ @@ -1573,7 +1571,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\perl5258delta.pod + copy ..\pod\perldelta.pod ..\pod\perl5259delta.pod $(MINIPERL) -I..\lib $(PL2BAT) $(UTILS) $(MINIPERL) -I..\lib ..\autodoc.pl .. $(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q .. @@ -1670,7 +1668,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 \ - perl5258delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ + perl5259delta.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 \ @@ -1680,7 +1678,7 @@ distclean: realclean perlsolaris.pod perlsymbian.pod perlsynology.pod perltoc.pod \ perltru64.pod perltw.pod perluniprops.pod perlvos.pod \ perlwin32.pod - -cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \ + -cd ..\utils && del /f h2ph splain perlbug pl2pm h2xs \ perldoc perlivp libnetcfg enc2xs encguess piconv cpan *.bat \ xsubpp pod2html instmodsh json_pp prove ptar ptardiff ptargrep shasum corelist zipdetails -del /f ..\config.sh perlmain.c dlutils.c config.h.new \ diff --git a/win32/Makefile b/win32/Makefile index cea93ce..1aa0e45 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -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.8 +#INST_VER = \5.25.9 # # Comment this out if you DON'T want your perl installation to have @@ -679,8 +679,6 @@ UTILS = \ ..\utils\splain \ ..\utils\perlbug \ ..\utils\pl2pm \ - ..\utils\c2ph \ - ..\utils\pstruct \ ..\utils\h2xs \ ..\utils\perldoc \ ..\utils\perlivp \ @@ -1215,7 +1213,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\perl5258delta.pod + copy ..\pod\perldelta.pod ..\pod\perl5259delta.pod cd ..\win32 $(PERLEXE) $(PL2BAT) $(UTILS) $(MINIPERL) -I..\lib ..\autodoc.pl .. @@ -1314,7 +1312,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 \ - perl5258delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ + perl5259delta.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 \ @@ -1324,7 +1322,7 @@ distclean: realclean perlsolaris.pod perlsymbian.pod perlsynology.pod perltoc.pod \ perltru64.pod perltw.pod perluniprops.pod perlvos.pod \ perlwin32.pod - -cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \ + -cd ..\utils && del /f h2ph splain perlbug pl2pm h2xs \ perldoc perlivp libnetcfg enc2xs encguess piconv cpan *.bat \ xsubpp pod2html instmodsh json_pp prove ptar ptardiff ptargrep shasum corelist zipdetails -del /f ..\config.sh perlmain.c dlutils.c config.h.new \ diff --git a/win32/bin/exetype.pl b/win32/bin/exetype.pl index 27e3b94..203f554 100644 --- a/win32/bin/exetype.pl +++ b/win32/bin/exetype.pl @@ -23,7 +23,7 @@ unless (@ARGV == 1 || defined $subsys{$ARGV[1]}) { } my ($record,$magic,$signature,$offset,$size); -open EXE, "+< $ARGV[0]" or die "Cannot open $ARGV[0]: $!\n"; +open EXE, '+<', $ARGV[0] or die "Cannot open $ARGV[0]: $!\n"; binmode EXE; # read IMAGE_DOS_HEADER structure diff --git a/win32/bin/pl2bat.pl b/win32/bin/pl2bat.pl index b30b16b..443f590 100644 --- a/win32/bin/pl2bat.pl +++ b/win32/bin/pl2bat.pl @@ -84,7 +84,7 @@ sub process { my $line; my $start= $Config{startperl}; $start= "#!perl" unless $start =~ /^#!.*perl/; - open( FILE, $file ) or die "$0: Can't open $file: $!"; + open( FILE, '<', $file ) or die "$0: Can't open $file: $!"; @file = ; foreach $line ( @file ) { $linenum++; @@ -111,7 +111,7 @@ sub process { close( FILE ); $file =~ s/$OPT{'s'}$//oi; $file .= '.bat' unless $file =~ /\.bat$/i or $file =~ /^-$/; - open( FILE, ">$file" ) or die "Can't open $file: $!"; + open( FILE, '>', $file ) or die "Can't open $file: $!"; print FILE $myhead; print FILE $start, ( $OPT{'w'} ? " -w" : "" ), "\n#line ", ($headlines+1), "\n" unless $linedone; diff --git a/win32/bin/search.pl b/win32/bin/search.pl index 8f4d739..cd6e6ad 100644 --- a/win32/bin/search.pl +++ b/win32/bin/search.pl @@ -626,7 +626,7 @@ sub read_rc { package magic; $^W= 0; } ## turn off warnings for when we run EXPR's - unless (open(RC, "$file")) { + unless (open(RC, '<', $file)) { $use_default=1; $file = ""; ## no RC file -- use this default. @@ -950,7 +950,7 @@ sub dodir } if ($DO_MAGIC_TESTS) { - if (!open(FILE_IN, $file)) { + if (!open(FILE_IN, '<', $file)) { &clear_message if $VERBOSE && $STDERR_SCREWS_STDOUT; warn qq/$0: can't open: $file\n/; next; @@ -990,7 +990,7 @@ sub dodir next; } else { ## if we weren't doing magic tests, file won't be open yet... - if (!$DO_MAGIC_TESTS && !open(FILE_IN, $file)) { + if (!$DO_MAGIC_TESTS && !open(FILE_IN, '<', $file)) { &clear_message if $VERBOSE && $STDERR_SCREWS_STDOUT; warn qq/$0: can't open: $file\n/; next; diff --git a/win32/ce-helpers/makedist.pl b/win32/ce-helpers/makedist.pl index 7cfdc36..2ad0f70 100644 --- a/win32/ce-helpers/makedist.pl +++ b/win32/ce-helpers/makedist.pl @@ -101,7 +101,7 @@ for (@efiles) { my ($dynaloader_pm); if ($opts{adaptation}) { # let's copy our Dynaloader.pm (make this optional?) - open my $fhdyna, ">$opts{distdir}/lib/Dynaloader.pm"; + open my $fhdyna, '>', "$opts{distdir}/lib/Dynaloader.pm"; print $fhdyna $dynaloader_pm; close $fhdyna; } @@ -138,7 +138,7 @@ for (@afiles) { sub copy($$) { my ($fnfrom, $fnto) = @_; - open my $fh, "<$fnfrom" or die "can not open $fnfrom: $!"; + open my $fh, '<', $fnfrom or die "can not open $fnfrom: $!"; binmode $fh; local $/; my $ffrom = <$fh>; @@ -153,7 +153,7 @@ sub copy($$) { } } mkpath $1 if $fnto=~/^(.*)\/([^\/]+)$/; - open my $fhout, ">$fnto"; + open my $fhout, '>', $fnto; binmode $fhout; print $fhout $ffrom; if ($opts{'verbose'} >=2) { diff --git a/win32/config_h.PL b/win32/config_h.PL index 89c7a20..e755007 100644 --- a/win32/config_h.PL +++ b/win32/config_h.PL @@ -26,7 +26,7 @@ $opt{CORE_DIR} ||= '../lib/CORE'; warn "Writing $opt{CONFIG_H}\n"; -open(SH,"<$name") || die "Cannot open $name:$!"; +open(SH, "<", $name) || die "Cannot open $name:$!"; while () { last if /^\s*sed/; @@ -50,7 +50,7 @@ eval $str; die "$str:$@" if $@; -open(H,">$file.new") || die "Cannot open $file.new:$!"; +open(H, ">", "$file.new") || die "Cannot open $file.new:$!"; binmode(H); while () { diff --git a/win32/config_sh.PL b/win32/config_sh.PL index 74e5f0d..c4a3112 100644 --- a/win32/config_sh.PL +++ b/win32/config_sh.PL @@ -22,7 +22,7 @@ sub loadopts { shift @ARGV; my $optfile = shift @ARGV; local (*OPTF); - open OPTF, $optfile or die "Can't open $optfile: $!\n"; + open OPTF, '<', $optfile or die "Can't open $optfile: $!\n"; my @opts; chomp(my $line = ); my @vars = split(/\t+~\t+/, $line); @@ -59,7 +59,7 @@ $opt{known_extensions} = join(' ',FindExt::known_extensions()) || ' '; my $pl_h = '../patchlevel.h'; if (-e $pl_h) { - open PL, "<$pl_h" or die "Can't open $pl_h: $!"; + open PL, "<", $pl_h or die "Can't open $pl_h: $!"; while () { if (/^#\s*define\s+(PERL_\w+)\s+([\d.]+)/) { $opt{$1} = $2; diff --git a/win32/makefile.mk b/win32/makefile.mk index 0e13a9f..931ee5e 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -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.8 +#INST_VER *= \5.25.9 # # Comment this out if you DON'T want your perl installation to have @@ -836,8 +836,6 @@ UTILS = \ ..\utils\splain \ ..\utils\perlbug \ ..\utils\pl2pm \ - ..\utils\c2ph \ - ..\utils\pstruct \ ..\utils\h2xs \ ..\utils\perldoc \ ..\utils\perlivp \ @@ -1532,7 +1530,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\perl5258delta.pod + copy ..\pod\perldelta.pod ..\pod\perl5259delta.pod $(MINIPERL) -I..\lib $(PL2BAT) $(UTILS) $(MINIPERL) -I..\lib ..\autodoc.pl .. $(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q .. @@ -1630,7 +1628,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 \ - perl5258delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ + perl5259delta.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 \ @@ -1640,7 +1638,7 @@ distclean: realclean perlsolaris.pod perlsymbian.pod perlsynology.pod perltoc.pod \ perltru64.pod perltw.pod perluniprops.pod perlvos.pod \ perlwin32.pod - -cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph pstruct h2xs \ + -cd ..\utils && del /f h2ph splain perlbug pl2pm h2xs \ perldoc perlivp libnetcfg enc2xs encguess piconv cpan *.bat \ xsubpp pod2html instmodsh json_pp prove ptar ptardiff ptargrep shasum corelist zipdetails -del /f ..\config.sh perlmain.c dlutils.c config.h.new \ diff --git a/win32/pod.mak b/win32/pod.mak index d56f7fa..e877895 100644 --- a/win32/pod.mak +++ b/win32/pod.mak @@ -43,7 +43,9 @@ POD = perl.pod \ perl5220delta.pod \ perl5221delta.pod \ perl5222delta.pod \ + perl5223delta.pod \ perl5240delta.pod \ + perl5241delta.pod \ perl5250delta.pod \ perl5251delta.pod \ perl5252delta.pod \ @@ -53,6 +55,7 @@ POD = perl.pod \ perl5256delta.pod \ perl5257delta.pod \ perl5258delta.pod \ + perl5259delta.pod \ perl561delta.pod \ perl56delta.pod \ perl581delta.pod \ @@ -81,6 +84,7 @@ POD = perl.pod \ perldebtut.pod \ perldebug.pod \ perldelta.pod \ + perldeprecation.pod \ perldiag.pod \ perldsc.pod \ perldtrace.pod \ @@ -190,7 +194,9 @@ MAN = perl.man \ perl5220delta.man \ perl5221delta.man \ perl5222delta.man \ + perl5223delta.man \ perl5240delta.man \ + perl5241delta.man \ perl5250delta.man \ perl5251delta.man \ perl5252delta.man \ @@ -200,6 +206,7 @@ MAN = perl.man \ perl5256delta.man \ perl5257delta.man \ perl5258delta.man \ + perl5259delta.man \ perl561delta.man \ perl56delta.man \ perl581delta.man \ @@ -228,6 +235,7 @@ MAN = perl.man \ perldebtut.man \ perldebug.man \ perldelta.man \ + perldeprecation.man \ perldiag.man \ perldsc.man \ perldtrace.man \ @@ -337,7 +345,9 @@ HTML = perl.html \ perl5220delta.html \ perl5221delta.html \ perl5222delta.html \ + perl5223delta.html \ perl5240delta.html \ + perl5241delta.html \ perl5250delta.html \ perl5251delta.html \ perl5252delta.html \ @@ -347,6 +357,7 @@ HTML = perl.html \ perl5256delta.html \ perl5257delta.html \ perl5258delta.html \ + perl5259delta.html \ perl561delta.html \ perl56delta.html \ perl581delta.html \ @@ -375,6 +386,7 @@ HTML = perl.html \ perldebtut.html \ perldebug.html \ perldelta.html \ + perldeprecation.html \ perldiag.html \ perldsc.html \ perldtrace.html \ @@ -484,7 +496,9 @@ TEX = perl.tex \ perl5220delta.tex \ perl5221delta.tex \ perl5222delta.tex \ + perl5223delta.tex \ perl5240delta.tex \ + perl5241delta.tex \ perl5250delta.tex \ perl5251delta.tex \ perl5252delta.tex \ @@ -494,6 +508,7 @@ TEX = perl.tex \ perl5256delta.tex \ perl5257delta.tex \ perl5258delta.tex \ + perl5259delta.tex \ perl561delta.tex \ perl56delta.tex \ perl581delta.tex \ @@ -522,6 +537,7 @@ TEX = perl.tex \ perldebtut.tex \ perldebug.tex \ perldelta.tex \ + perldeprecation.tex \ perldiag.tex \ perldsc.tex \ perldtrace.tex \ -- 2.7.4