From: DongHun Kwak Date: Wed, 28 Jun 2017 01:42:48 +0000 (+0900) Subject: Imported Upstream version 5.23.2 X-Git-Tag: upstream/5.23.3~1 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=refs%2Fchanges%2F31%2F136031%2F1;p=platform%2Fupstream%2Fperl.git Imported Upstream version 5.23.2 Change-Id: I6aaf597b5cbd6c307c4b2541d97c36cc8df87f21 Signed-off-by: DongHun Kwak --- diff --git a/.gitignore b/.gitignore index 96cd2fa..6b57f5e 100644 --- a/.gitignore +++ b/.gitignore @@ -182,6 +182,9 @@ MANIFEST.srt # generated by the top level install.html target. XXX Why does it need this? /vms/README_vms.pod +# generated be ext/re/Makefile +ext/re/invlist_inline.h + # ctags tags TAGS diff --git a/AUTHORS b/AUTHORS index 2a28775..c844e9e 100644 --- a/AUTHORS +++ b/AUTHORS @@ -21,6 +21,7 @@ A. Sinan Unur Aaron Crane Aaron B. Dossett Aaron J. Mackey +Aaron Priven Aaron Trevena Augustina Blair Abe Timmerman @@ -513,6 +514,7 @@ Ingy döt Net insecure Irving Reid Ivan Kurmanov +Ivan Pozdeev Ivan Tubert-Brohman J. David Blackstone J. van Krieken @@ -733,6 +735,7 @@ Louis Strous Luc St-Louis Luca Fini Lucas Holt +Ludovic E. R. Tolhurst-Cleaver Lukas Mai Luke Closs Luke Ross diff --git a/Configure b/Configure index f16a4bf..464737d 100755 --- a/Configure +++ b/Configure @@ -8040,7 +8040,7 @@ cat </dev/null 2>&1 && $run ./a.out; then + if $cc $ccflags $ldflags -o a.out try.c >/dev/null 2>&1 && $run ./a.out; then bin_ELF="$define" fi $rm_try @@ -23459,13 +23459,13 @@ find_extensions=' case "$xxx" in DynaLoader|dynaload) ;; *) - this_ext=`echo $xxx | $sed -e s/-/\\\//g`; + this_ext=`echo "$xxx" | $sed -e s/-/\\\//g`; case "$this_ext" in Scalar/List/Utils) this_ext="List/Util" ;; PathTools) this_ext="Cwd" ;; esac; - echo " $xs_extensions $nonxs_extensions" > $tdir/$$.tmp; - if $contains " $this_ext " $tdir/$$.tmp; then + echo " $xs_extensions $nonxs_extensions" > "$tdir/$$.tmp"; + if $contains " $this_ext " "$tdir/$$.tmp"; then echo >&4; echo "Duplicate directories detected for extension $xxx" >&4; echo "Configure cannot correctly recover from this - shall I abort?" >&4; @@ -23483,15 +23483,15 @@ find_extensions=' esac; echo "Ok. You will need to correct config.sh before running make." >&4; fi; - $ls -1 $xxx > $tdir/$$.tmp; - if $contains "\.xs$" $tdir/$$.tmp > /dev/null 2>&1; then + $ls -1 "$xxx" > "$tdir/$$.tmp"; + if $contains "\.xs$" "$tdir/$$.tmp" > /dev/null 2>&1; then xs_extensions="$xs_extensions $this_ext"; - elif $contains "\.c$" $tdir/$$.tmp > /dev/null 2>&1; then + elif $contains "\.c$" "$tdir/$$.tmp" > /dev/null 2>&1; then xs_extensions="$xs_extensions $this_ext"; - elif $test -d $xxx; then + elif $test -d "$xxx"; then nonxs_extensions="$nonxs_extensions $this_ext"; fi; - $rm -f $tdir/$$.tmp; + $rm -f "$tdir/$$.tmp"; ;; esac; done' diff --git a/Cross/Makefile-cross-SH b/Cross/Makefile-cross-SH index 01cde92..4b6bf12 100644 --- a/Cross/Makefile-cross-SH +++ b/Cross/Makefile-cross-SH @@ -345,17 +345,17 @@ h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h h5 = utf8.h warnings.h h = $(h1) $(h2) $(h3) $(h4) $(h5) -c1 = av.c scope.c op.c doop.c doio.c dump.c gv.c hv.c mg.c reentr.c mro_core.c perl.c +c1 = av.c scope.c op.c doop.c doio.c dquote.c dump.c gv.c hv.c mg.c reentr.c mro_core.c perl.c c2 = perly.c pp.c pp_hot.c pp_ctl.c pp_sys.c regcomp.c regexec.c utf8.c sv.c -c3 = taint.c toke.c util.c deb.c run.c universal.c pad.c globals.c keywords.c +c3 = taint.c time64.c toke.c util.c deb.c run.c universal.c pad.c globals.c keywords.c c4 = perlio.c perlapi.c numeric.c mathoms.c locale.c pp_pack.c pp_sort.c c5 = $(mallocsrc) c = $(c1) $(c2) $(c3) $(c4) $(c5) miniperlmain.c perlmain.c opmini.c -obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) pad$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT) reentr$(OBJ_EXT) mro_core$(OBJ_EXT) +obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) pad$(OBJ_EXT) regcomp$(OBJ_EXT) dquote$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT) reentr$(OBJ_EXT) mro_core$(OBJ_EXT) obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) perl$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT) -obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT) perlapi$(OBJ_EXT) numeric$(OBJ_EXT) mathoms$(OBJ_EXT) locale$(OBJ_EXT) pp_pack$(OBJ_EXT) pp_sort$(OBJ_EXT) +obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT) perlapi$(OBJ_EXT) numeric$(OBJ_EXT) mathoms$(OBJ_EXT) locale$(OBJ_EXT) pp_pack$(OBJ_EXT) pp_sort$(OBJ_EXT) time64$(OBJ_EXT) obj = $(obj1) $(obj2) $(obj3) $(ARCHOBJS) diff --git a/Cross/cflags-cross-arm b/Cross/cflags-cross-arm index 8ee55a5..3006394 100644 --- a/Cross/cflags-cross-arm +++ b/Cross/cflags-cross-arm @@ -73,6 +73,7 @@ for file do dl) ;; doio) ;; doop) ;; + dquote) ;; dump) ;; globals) ;; gv) ;; @@ -102,6 +103,7 @@ for file do scope) ;; sv) ;; taint) ;; + time64) ;; toke) ;; universal) ;; usersub) ;; diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux index 996d28b..c470fbf 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='1' +api_subversion='2' api_version='23' -api_versionstring='5.23.1' +api_versionstring='5.23.2' ar='ar' -archlib='/usr/lib/perl5/5.23.1/armv4l-linux' -archlibexp='/usr/lib/perl5/5.23.1/armv4l-linux' +archlib='/usr/lib/perl5/5.23.2/armv4l-linux' +archlibexp='/usr/lib/perl5/5.23.2/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.23.1/armv4l-linux/CORE' +ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.23.2/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' @@ -796,7 +796,7 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='./install_me_here/usr/lib/perl5/5.23.1/armv4l-linux' +installarchlib='./install_me_here/usr/lib/perl5/5.23.2/armv4l-linux' installbin='./install_me_here/usr/bin' installhtml1dir='' installhtml3dir='' @@ -804,13 +804,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.23.1' +installprivlib='./install_me_here/usr/lib/perl5/5.23.2' installscript='./install_me_here/usr/bin' -installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.23.1/armv4l-linux' +installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.23.2/armv4l-linux' installsitebin='./install_me_here/usr/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.23.1' +installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.23.2' installsiteman1dir='./install_me_here/usr/share/man/man1' installsiteman3dir='./install_me_here/usr/share/man/man3' installsitescript='./install_me_here/usr/bin' @@ -944,8 +944,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/usr/lib/perl5/5.23.1' -privlibexp='/usr/lib/perl5/5.23.1' +privlib='/usr/lib/perl5/5.23.2' +privlibexp='/usr/lib/perl5/5.23.2' procselfexe='"/proc/self/exe"' prototype='define' ptrsize='4' @@ -1010,17 +1010,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.23.1/armv4l-linux' -sitearchexp='/usr/lib/perl5/site_perl/5.23.1/armv4l-linux' +sitearch='/usr/lib/perl5/site_perl/5.23.2/armv4l-linux' +sitearchexp='/usr/lib/perl5/site_perl/5.23.2/armv4l-linux' sitebin='/usr/bin' sitebinexp='/usr/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/usr/lib/perl5/site_perl/5.23.1' +sitelib='/usr/lib/perl5/site_perl/5.23.2' sitelib_stem='/usr/lib/perl5/site_perl' -sitelibexp='/usr/lib/perl5/site_perl/5.23.1' +sitelibexp='/usr/lib/perl5/site_perl/5.23.2' siteman1dir='/usr/share/man/man1' siteman1direxp='/usr/share/man/man1' siteman3dir='/usr/share/man/man3' @@ -1059,7 +1059,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='1' +subversion='2' sysman='/usr/share/man/man1' tail='' tar='' @@ -1151,8 +1151,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.23.1' -version_patchlevel_string='version 23 subversion 1' +version='5.23.2' +version_patchlevel_string='version 23 subversion 2' versiononly='undef' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1166,9 +1166,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=23 -PERL_SUBVERSION=1 +PERL_SUBVERSION=2 PERL_API_REVISION=5 PERL_API_VERSION=23 -PERL_API_SUBVERSION=1 +PERL_API_SUBVERSION=2 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770 index fc734b7..c16c4eb 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='1' +api_subversion='2' api_version='23' -api_versionstring='5.23.1' +api_versionstring='5.23.2' ar='ar' -archlib='/usr/lib/perl5/5.23.1/armv4l-linux' -archlibexp='/usr/lib/perl5/5.23.1/armv4l-linux' +archlib='/usr/lib/perl5/5.23.2/armv4l-linux' +archlibexp='/usr/lib/perl5/5.23.2/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.23.1/armv4l-linux/CORE' +ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.23.2/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.23.1/armv4l-linux' +installarchlib='./install_me_here/usr/lib/perl5/5.23.2/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.23.1' +installprivlib='./install_me_here/usr/lib/perl5/5.23.2' installscript='./install_me_here/usr/bin' -installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.23.1/armv4l-linux' +installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.23.2/armv4l-linux' installsitebin='./install_me_here/usr/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.23.1' +installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.23.2' 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.23.1' -privlibexp='/usr/lib/perl5/5.23.1' +privlib='/usr/lib/perl5/5.23.2' +privlibexp='/usr/lib/perl5/5.23.2' 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.23.1/armv4l-linux' -sitearchexp='/usr/lib/perl5/site_perl/5.23.1/armv4l-linux' +sitearch='/usr/lib/perl5/site_perl/5.23.2/armv4l-linux' +sitearchexp='/usr/lib/perl5/site_perl/5.23.2/armv4l-linux' sitebin='/usr/bin' sitebinexp='/usr/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/usr/lib/perl5/site_perl/5.23.1' +sitelib='/usr/lib/perl5/site_perl/5.23.2' sitelib_stem='/usr/lib/perl5/site_perl' -sitelibexp='/usr/lib/perl5/site_perl/5.23.1' +sitelibexp='/usr/lib/perl5/site_perl/5.23.2' 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='1' +subversion='2' sysman='/usr/share/man/man1' tail='' tar='' @@ -1035,8 +1035,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.23.1' -version_patchlevel_string='version 23 subversion 1' +version='5.23.2' +version_patchlevel_string='version 23 subversion 2' versiononly='undef' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1050,9 +1050,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=23 -PERL_SUBVERSION=1 +PERL_SUBVERSION=2 PERL_API_REVISION=5 PERL_API_VERSION=23 -PERL_API_SUBVERSION=1 +PERL_API_SUBVERSION=2 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/INSTALL b/INSTALL index 23ca435..7b129bd 100644 --- a/INSTALL +++ b/INSTALL @@ -332,9 +332,6 @@ this support (if it is available). Note that the exact format and range of long doubles varies: the most common is the x86 80-bit (64 bits of mantissa) format, but there are others, with different mantissa and exponent ranges. -In fact, the type may not be called "long double" at C level, and -therefore the C means "using floating point larger -than double". =head3 "more bits" @@ -584,7 +581,7 @@ The directories set up by Configure fall into three broad categories. =item Directories for the perl distribution -By default, Configure will use the following directories for 5.23.1. +By default, Configure will use the following directories for 5.23.2. $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 @@ -2443,7 +2440,7 @@ http://www.chiark.greenend.org.uk/~sgtatham/bugs.html =head1 Coexistence with earlier versions of perl 5 -Perl 5.23.1 is not binary compatible with earlier versions of Perl. +Perl 5.23.2 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 @@ -2518,9 +2515,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.23.1 + sh Configure -Dprefix=/opt/perl5.23.2 -and adding /opt/perl5.23.1/bin to the shell PATH variable. Such users +and adding /opt/perl5.23.2/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. @@ -2533,13 +2530,13 @@ seriously consider using a separate directory, since development subversions may not have all the compatibility wrinkles ironed out yet. -=head2 Upgrading from 5.23.0 or earlier +=head2 Upgrading from 5.23.1 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.23.1. If you find you do need to rebuild an extension with -5.23.1, you may safely do so without disturbing the older +used with 5.23.2. If you find you do need to rebuild an extension with +5.23.2, you may safely do so without disturbing the older installations. (See L<"Coexistence with earlier versions of perl 5"> above.) @@ -2572,15 +2569,15 @@ Firstly, the bare minimum to run this script print("$f\n"); } -in Linux with perl-5.23.1 is as follows (under $Config{prefix}): +in Linux with perl-5.23.2 is as follows (under $Config{prefix}): ./bin/perl - ./lib/perl5/5.23.1/strict.pm - ./lib/perl5/5.23.1/warnings.pm - ./lib/perl5/5.23.1/i686-linux/File/Glob.pm - ./lib/perl5/5.23.1/feature.pm - ./lib/perl5/5.23.1/XSLoader.pm - ./lib/perl5/5.23.1/i686-linux/auto/File/Glob/Glob.so + ./lib/perl5/5.23.2/strict.pm + ./lib/perl5/5.23.2/warnings.pm + ./lib/perl5/5.23.2/i686-linux/File/Glob.pm + ./lib/perl5/5.23.2/feature.pm + ./lib/perl5/5.23.2/XSLoader.pm + ./lib/perl5/5.23.2/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 61437ba..097427f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -327,7 +327,6 @@ cpan/CPAN-Meta/t/repository.t cpan/CPAN-Meta/t/save-load.t cpan/CPAN-Meta/t/validator.t cpan/CPAN-Meta-YAML/lib/CPAN/Meta/YAML.pm CPAN-Meta-YAML files -cpan/CPAN-Meta-YAML/t/00-report-prereqs.dd cpan/CPAN-Meta-YAML/t/01_api.t cpan/CPAN-Meta-YAML/t/01_compile.t CPAN-Meta-YAML files cpan/CPAN-Meta-YAML/t/10_read.t @@ -345,6 +344,7 @@ cpan/CPAN-Meta-YAML/t/data/latin1.yml cpan/CPAN-Meta-YAML/t/data/multibyte.yml CPAN-Meta-YAML files cpan/CPAN-Meta-YAML/t/data/utf_16_le_bom.yml CPAN-Meta-YAML files cpan/CPAN-Meta-YAML/t/data/utf_8_bom.yml +cpan/CPAN-Meta-YAML/t/lib/SubtestCompat.pm cpan/CPAN-Meta-YAML/t/lib/TestBridge.pm cpan/CPAN-Meta-YAML/t/lib/TestML/Tiny.pm cpan/CPAN-Meta-YAML/t/lib/TestUtils.pm @@ -1160,6 +1160,8 @@ cpan/Filter-Util-Call/Call.pm Filter::Util::Call extension module cpan/Filter-Util-Call/Call.xs Filter::Util::Call extension external subroutines cpan/Filter-Util-Call/filter-util.pl See if Filter::Util::Call works cpan/Filter-Util-Call/t/call.t See if Filter::Util::Call works +cpan/Filter-Util-Call/t/rt_101033.pm +cpan/Filter-Util-Call/t/rt_101033.t cpan/Filter-Util-Call/t/rt_54452-rebless.t cpan/Getopt-Long/lib/Getopt/Long.pm Fetch command options (GetOptions) cpan/Getopt-Long/t/gol-basic.t See if Getopt::Long works @@ -3527,7 +3529,8 @@ djgpp/fixpmain DOS/DJGPP port doio.c I/O operations doop.c Support code for various operations dosish.h Some defines for MS/DOSish machines -dquote_static.c Static functions for double quotish contexts +dquote.c Functions for double quotish contexts +dquote_inline.h Inline functions for double quotish contexts dump.c Debugging output ebcdic_tables.h Generated tables included in utfebcdic.h embed.fnc Database used by embed.pl @@ -4107,7 +4110,6 @@ hv.c Hash value code hv_func.h Hash value static inline function header hv.h Hash value header inline.h Static inline functions -inline_invlist.c Inline functions for handling inversion lists INSTALL Detailed installation instructions installhtml Perl script to install html files for pods install_lib.pl functions shared between install* scripts @@ -4115,6 +4117,7 @@ installman Perl script to install man pages for pods installperl Perl script to do "make install" dirty work INTERN.h Included before domestic .h files intrpvar.h Variables held in each interpreter instance +invlist_inline.h Inline functions for handling inversion lists iperlsys.h Perl's interface to the system keywords.c Perl_keyword(), generated by regen/keywords.pl keywords.h The keyword numbers @@ -4385,7 +4388,7 @@ META.json Distribution meta-data in JSON META.yml Distribution meta-data in YAML mg.c Magic code mg.h Magic header -mg_names.c Generated magic names used by dump.c +mg_names.inc Generated magic names used by dump.c mg_raw.h Generated magic data used by generate_uudmap.c mg_vtable.h Generated magic vtable data miniperlmain.c Basic perl w/o dynamic loading or extensions @@ -4515,9 +4518,9 @@ os2/OS2/typemap Common typemap for OS/2 types os2/perl2cmd.pl Corrects installed binaries under OS/2 os2/perlrexx.c Support perl interpreter embedded in REXX os2/perlrexx.cmd Test perl interpreter embedded in REXX -overload.c generated overload enum (public) -overload.h generated overload name table (implementation) -packsizetables.c The generated packprops array used in pp_pack.c +overload.h generated overload enum (public) +overload.inc generated overload name table (implementation) +packsizetables.inc The generated packprops array used in pp_pack.c pad.c Scratchpad functions pad.h Scratchpad headers parser.h parser object header @@ -4583,6 +4586,7 @@ pod/perl5201delta.pod Perl changes in version 5.20.1 pod/perl5202delta.pod Perl changes in version 5.20.2 pod/perl5220delta.pod Perl changes in version 5.22.0 pod/perl5230delta.pod Perl changes in version 5.23.0 +pod/perl5231delta.pod Perl changes in version 5.23.1 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 @@ -5146,6 +5150,7 @@ t/mro/vulcan_dfs.t mro tests t/mro/vulcan_dfs_utf8.t utf8 mro tests toke.c The tokener t/op/64bitint.t See if 64 bit integers work +t/op/aassign.t test list assign t/op/alarm.t See if alarm works t/op/anonconst.t See if :const works t/op/anonsub.t See if anonymous subroutines work diff --git a/META.json b/META.json index 04750e4..7f54836 100644 --- a/META.json +++ b/META.json @@ -125,6 +125,6 @@ "url" : "http://perl5.git.perl.org/" } }, - "version" : "5.023001", + "version" : "5.023002", "x_serialization_backend" : "JSON::PP version 2.27300" } diff --git a/META.yml b/META.yml index 11ffebb..739d308 100644 --- a/META.yml +++ b/META.yml @@ -112,5 +112,5 @@ resources: homepage: http://www.perl.org/ license: http://dev.perl.org/licenses/ repository: http://perl5.git.perl.org/ -version: '5.023001' -x_serialization_backend: 'CPAN::Meta::YAML version 0.016' +version: '5.023002' +x_serialization_backend: 'CPAN::Meta::YAML version 0.017' diff --git a/Makefile.SH b/Makefile.SH index 2b0f95c..bc5837e 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -476,7 +476,7 @@ h = $(h1) $(h2) $(h3) $(h4) $(h5) $(h6) c1 = av.c scope.c op.c doop.c doio.c dump.c gv.c hv.c mg.c reentr.c mro_core.c perl.c c2 = perly.c pp.c pp_hot.c pp_ctl.c pp_sys.c regcomp.c regexec.c utf8.c sv.c c3 = taint.c toke.c util.c deb.c run.c universal.c pad.c globals.c keywords.c -c4 = perlio.c perlapi.c numeric.c mathoms.c locale.c pp_pack.c pp_sort.c caretx.c +c4 = perlio.c perlapi.c numeric.c mathoms.c locale.c pp_pack.c pp_sort.c caretx.c dquote.c time64.c c5 = $(mallocsrc) c = $(c1) $(c2) $(c3) $(c4) $(c5) miniperlmain.c opmini.c perlmini.c @@ -485,14 +485,14 @@ obj0 = op$(OBJ_EXT) perl$(OBJ_EXT) obj0mini = perlmini$(OBJ_EXT) opmini$(OBJ_EXT) miniperlmain$(OBJ_EXT) obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) pad$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT) reentr$(OBJ_EXT) mro_core$(OBJ_EXT) keywords$(OBJ_EXT) obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT) -obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT) perlapi$(OBJ_EXT) numeric$(OBJ_EXT) mathoms$(OBJ_EXT) locale$(OBJ_EXT) pp_pack$(OBJ_EXT) pp_sort$(OBJ_EXT) caretx$(OBJ_EXT) +obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT) perlapi$(OBJ_EXT) numeric$(OBJ_EXT) mathoms$(OBJ_EXT) locale$(OBJ_EXT) pp_pack$(OBJ_EXT) pp_sort$(OBJ_EXT) caretx$(OBJ_EXT) dquote$(OBJ_EXT) time64$(OBJ_EXT) minindt_obj = $(obj0mini) $(obj1) $(obj2) $(obj3) $(ARCHOBJS) mini_obj = $(minindt_obj) $(MINIDTRACE_O) ndt_obj = $(obj0) $(obj1) $(obj2) $(obj3) $(ARCHOBJS) obj = $(ndt_obj) $(DTRACE_O) -perltoc_pod_prereqs = extra.pods pod/perl5231delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod +perltoc_pod_prereqs = extra.pods pod/perl5232delta.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 @@ -1020,9 +1020,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/perl5231delta.pod: pod/perldelta.pod - $(RMS) pod/perl5231delta.pod - $(LNS) perldelta.pod pod/perl5231delta.pod +pod/perl5232delta.pod: pod/perldelta.pod + $(RMS) pod/perl5232delta.pod + $(LNS) perldelta.pod pod/perl5232delta.pod extra.pods: $(MINIPERL_EXE) -@test ! -f extra.pods || rm -f `cat extra.pods` diff --git a/Makefile.micro b/Makefile.micro index dedf183..a697e16 100644 --- a/Makefile.micro +++ b/Makefile.micro @@ -14,13 +14,13 @@ RUN = all: microperl -O = uav$(_O) udeb$(_O) udoio$(_O) udoop$(_O) udump$(_O) \ +O = uav$(_O) udeb$(_O) udoio$(_O) udoop$(_O) udquote$(_O) udump$(_O) \ uglobals$(_O) ugv$(_O) uhv$(_O) umro$(_O)\ umg$(_O) uperlmain$(_O) uop$(_O) ureentr$(_O) \ upad$(_O) uperl$(_O) uperlio$(_O) uperly$(_O) upp$(_O) \ upp_ctl$(_O) upp_hot$(_O) upp_sys$(_O) upp_pack$(_O) upp_sort$(_O) \ uregcomp$(_O) uregexec$(_O) urun$(_O) \ - uscope$(_O) usv$(_O) utaint$(_O) utoke$(_O) \ + uscope$(_O) usv$(_O) utaint$(_O) utime64$(_O) utoke$(_O) \ unumeric$(_O) ulocale$(_O) umathoms$(_O) \ uuniversal$(_O) uutf8$(_O) uutil$(_O) uperlapi$(_O) ukeywords$(_O) @@ -76,6 +76,9 @@ udoio$(_O): $(HE) doio.c udoop$(_O): $(HE) doop.c $(CC) $(CCFLAGS) -o $@ $(CFLAGS) doop.c +udquote$(_O): $(HE) dquote.c regcomp.h regnodes.h + $(CC) $(CCFLAGS) -o $@ $(CFLAGS) dquote.c + udump$(_O): $(HE) dump.c regcomp.h regnodes.h $(CC) $(CCFLAGS) -o $@ $(CFLAGS) dump.c @@ -154,6 +157,9 @@ usv$(_O): $(HE) sv.c utaint$(_O): $(HE) taint.c $(CC) $(CCFLAGS) -o $@ $(CFLAGS) taint.c +utime64$(_O): $(HE) time64.c time64.h time64_config.h + $(CC) $(CCFLAGS) -o $@ $(CFLAGS) time64.c + utoke$(_O): $(HE) toke.c keywords.h $(CC) $(CCFLAGS) -o $@ $(CFLAGS) toke.c diff --git a/NetWare/Makefile b/NetWare/Makefile index 422c5cb..dd4df14 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.23.1 for NetWare" +MODULE_DESC = "Perl 5.23.2 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.23.1 +INST_VER = \5.23.2 # # Comment this out if you DON'T want your perl installation to have @@ -689,6 +689,7 @@ MICROCORE_SRC = \ ..\deb.c \ ..\doio.c \ ..\doop.c \ + ..\dquote.c \ ..\dump.c \ ..\globals.c \ ..\gv.c \ @@ -716,6 +717,7 @@ MICROCORE_SRC = \ ..\scope.c \ ..\sv.c \ ..\taint.c \ + ..\time64.c \ ..\toke.c \ ..\universal.c \ ..\utf8.c \ diff --git a/NetWare/config_H.wc b/NetWare/config_H.wc index 3f915fa..88fddc7 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.23.1\\lib\\NetWare-x86-multi-thread" /**/ +#define ARCHLIB "c:\\perl\\5.23.2\\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.23.1\\bin\\NetWare-x86-multi-thread" /**/ -#define BIN_EXP "c:\\perl\\5.23.1\\bin\\NetWare-x86-multi-thread" /**/ +#define BIN "c:\\perl\\5.23.2\\bin\\NetWare-x86-multi-thread" /**/ +#define BIN_EXP "c:\\perl\\5.23.2\\bin\\NetWare-x86-multi-thread" /**/ /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, @@ -3091,7 +3091,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.23.1\\lib\\NetWare-x86-multi-thread" /**/ +#define SITEARCH "c:\\perl\\site\\5.23.2\\lib\\NetWare-x86-multi-thread" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -3114,7 +3114,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.23.1\\lib" /**/ +#define SITELIB "c:\\perl\\site\\5.23.2\\lib" /**/ /*#define SITELIB_EXP "" /**/ #define SITELIB_STEM "" /**/ diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index cc5e564..7ea239e 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -18,11 +18,12 @@ use File::Glob qw(:case); @IGNORABLE = qw( .cvsignore .dualLivedDiffConfig .gitignore .perlcriticrc .perltidyrc .travis.yml ANNOUNCE Announce Artistic AUTHORS BENCHMARK BUGS Build.PL - CHANGELOG ChangeLog Changelog CHANGES Changes CONTRIBUTING CONTRIBUTING.mkdn - COPYING Copying cpanfile CREDITS dist.ini GOALS HISTORY INSTALL INSTALL.SKIP - LICENCE LICENSE Makefile.PL MANIFEST MANIFEST.SKIP META.json META.yml - MYMETA.json MYMETA.yml NEW NEWS NOTES perlcritic.rc ppport.h README - README.md README.PATCHING SIGNATURE THANKS TODO Todo VERSION WHATSNEW + CHANGELOG ChangeLog Changelog CHANGES Changes CONTRIBUTING CONTRIBUTING.md + CONTRIBUTING.mkdn COPYING Copying cpanfile CREDITS dist.ini GOALS HISTORY + INSTALL INSTALL.SKIP LICENCE LICENSE Makefile.PL MANIFEST MANIFEST.SKIP + META.json META.yml MYMETA.json MYMETA.yml NEW NEWS NOTES perlcritic.rc + ppport.h README README.md README.pod README.PATCHING SIGNATURE THANKS TODO + Todo VERSION WHATSNEW ); # Each entry in the %Modules hash roughly represents a distribution, @@ -128,7 +129,7 @@ use File::Glob qw(:case); }, 'Attribute::Handlers' => { - 'DISTRIBUTION' => 'SMUELLER/Attribute-Handlers-0.96.tar.gz', + 'DISTRIBUTION' => 'RJBS/Attribute-Handlers-0.99.tar.gz', 'FILES' => q[dist/Attribute-Handlers], }, @@ -309,7 +310,7 @@ use File::Glob qw(:case); }, 'CPAN::Meta::YAML' => { - 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-YAML-0.016.tar.gz', + 'DISTRIBUTION' => 'DAGOLDEN/CPAN-Meta-YAML-0.017-TRIAL.tar.gz', 'FILES' => q[cpan/CPAN-Meta-YAML], 'EXCLUDED' => [ 't/00-report-prereqs.t', @@ -381,7 +382,7 @@ use File::Glob qw(:case); }, 'Encode' => { - 'DISTRIBUTION' => 'DANKOGAI/Encode-2.75.tar.gz', + 'DISTRIBUTION' => 'DANKOGAI/Encode-2.76.tar.gz', 'FILES' => q[cpan/Encode], }, @@ -562,7 +563,7 @@ use File::Glob qw(:case); }, 'Filter::Util::Call' => { - 'DISTRIBUTION' => 'RURBAN/Filter-1.54.tar.gz', + 'DISTRIBUTION' => 'RURBAN/Filter-1.55.tar.gz', 'FILES' => q[cpan/Filter-Util-Call pod/perlfilter.pod ], @@ -747,7 +748,7 @@ use File::Glob qw(:case); }, 'Math::BigInt' => { - 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.9993.tar.gz', + 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.9997.tar.gz', 'FILES' => q[dist/Math-BigInt], 'EXCLUDED' => [ qr{^inc/}, @@ -819,7 +820,7 @@ use File::Glob qw(:case); }, 'Module::CoreList' => { - 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20150620.tar.gz', + 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20150720.tar.gz', 'FILES' => q[dist/Module-CoreList], }, @@ -892,7 +893,7 @@ use File::Glob qw(:case); }, 'perlfaq' => { - 'DISTRIBUTION' => 'ETHER/perlfaq-5.021009.tar.gz', + 'DISTRIBUTION' => 'LLAP/perlfaq-5.021010.tar.gz', 'FILES' => q[cpan/perlfaq], 'EXCLUDED' => [ qw( inc/CreateQuestionList.pm @@ -1054,7 +1055,7 @@ use File::Glob qw(:case); }, 'Term::Cap' => { - 'DISTRIBUTION' => 'JSTOWE/Term-Cap-1.15.tar.gz', + 'DISTRIBUTION' => 'JSTOWE/Term-Cap-1.17.tar.gz', 'FILES' => q[cpan/Term-Cap], }, diff --git a/Porting/bisect-runner.pl b/Porting/bisect-runner.pl index 417ac2b..5c228b8 100755 --- a/Porting/bisect-runner.pl +++ b/Porting/bisect-runner.pl @@ -1249,7 +1249,7 @@ sub match_and_exit { while (<$fh>) { if ($_ =~ $re) { ++$matches; - if (tr/\t\r\n -~\200-\377//c) { + if (/[^[:^cntrl:]\h\v]/a) { # Matches non-spacing non-C1 controls print "Binary file $file matches\n"; } else { $_ .= "\n" unless /\n\z/; diff --git a/Porting/config.sh b/Porting/config.sh index b8e5cce..fda6c0b 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -39,12 +39,12 @@ alignbytes='4' ansi2knr='' aphostname='/bin/hostname' api_revision='5' -api_subversion='1' +api_subversion='2' api_version='23' -api_versionstring='5.23.1' +api_versionstring='5.23.2' ar='ar' -archlib='/pro/lib/perl5/5.23.1/i686-linux-64int' -archlibexp='/pro/lib/perl5/5.23.1/i686-linux-64int' +archlib='/pro/lib/perl5/5.23.2/i686-linux-64int' +archlibexp='/pro/lib/perl5/5.23.2/i686-linux-64int' archname64='64int' archname='i686-linux-64int' archobjs='' @@ -813,7 +813,7 @@ incpath='' incpth='/usr/lib/gcc/i586-suse-linux/4.8/include /usr/local/include /usr/lib/gcc/i586-suse-linux/4.8/include-fixed /usr/lib/gcc/i586-suse-linux/4.8/../../../../i586-suse-linux/include /usr/include' inews='' initialinstalllocation='/pro/bin' -installarchlib='/pro/lib/perl5/5.23.1/i686-linux-64int' +installarchlib='/pro/lib/perl5/5.23.2/i686-linux-64int' installbin='/pro/bin' installhtml1dir='' installhtml3dir='' @@ -821,13 +821,13 @@ installman1dir='/pro/local/man/man1' installman3dir='/pro/local/man/man3' installprefix='/pro' installprefixexp='/pro' -installprivlib='/pro/lib/perl5/5.23.1' +installprivlib='/pro/lib/perl5/5.23.2' installscript='/pro/bin' -installsitearch='/pro/lib/perl5/site_perl/5.23.1/i686-linux-64int' +installsitearch='/pro/lib/perl5/site_perl/5.23.2/i686-linux-64int' installsitebin='/pro/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='/pro/lib/perl5/site_perl/5.23.1' +installsitelib='/pro/lib/perl5/site_perl/5.23.2' installsiteman1dir='/pro/local/man/man1' installsiteman3dir='/pro/local/man/man3' installsitescript='/pro/bin' @@ -953,7 +953,7 @@ perl_patchlevel='' perl_static_inline='static __inline__' perladmin='hmbrand@cpan.org' perllibs='-lnsl -ldl -lm -lcrypt -lutil -lc' -perlpath='/pro/bin/perl5.23.1' +perlpath='/pro/bin/perl5.23.2' pg='pg' phostname='hostname' pidtype='pid_t' @@ -962,8 +962,8 @@ pmake='' pr='' prefix='/pro' prefixexp='/pro' -privlib='/pro/lib/perl5/5.23.1' -privlibexp='/pro/lib/perl5/5.23.1' +privlib='/pro/lib/perl5/5.23.2' +privlibexp='/pro/lib/perl5/5.23.2' procselfexe='"/proc/self/exe"' prototype='define' ptrsize='4' @@ -1029,17 +1029,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, 64, 6, 17, 29, 31, 0' sig_size='69' signal_t='void' -sitearch='/pro/lib/perl5/site_perl/5.23.1/i686-linux-64int' -sitearchexp='/pro/lib/perl5/site_perl/5.23.1/i686-linux-64int' +sitearch='/pro/lib/perl5/site_perl/5.23.2/i686-linux-64int' +sitearchexp='/pro/lib/perl5/site_perl/5.23.2/i686-linux-64int' sitebin='/pro/bin' sitebinexp='/pro/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/pro/lib/perl5/site_perl/5.23.1' +sitelib='/pro/lib/perl5/site_perl/5.23.2' sitelib_stem='/pro/lib/perl5/site_perl' -sitelibexp='/pro/lib/perl5/site_perl/5.23.1' +sitelibexp='/pro/lib/perl5/site_perl/5.23.2' siteman1dir='/pro/local/man/man1' siteman1direxp='/pro/local/man/man1' siteman3dir='/pro/local/man/man3' @@ -1065,7 +1065,7 @@ src='.' ssizetype='ssize_t' st_ino_sign='1' st_ino_size='8' -startperl='#!/pro/bin/perl5.23.1' +startperl='#!/pro/bin/perl5.23.2' startsh='#!/bin/sh' static_ext=' ' stdchar='char' @@ -1078,7 +1078,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='1' +subversion='2' sysman='/usr/share/man/man1' sysroot='' tail='' @@ -1177,8 +1177,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.23.1' -version_patchlevel_string='version 23 subversion 1' +version='5.23.2' +version_patchlevel_string='version 23 subversion 2' versiononly='define' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1188,10 +1188,10 @@ zcat='' zip='zip' PERL_REVISION=5 PERL_VERSION=23 -PERL_SUBVERSION=1 +PERL_SUBVERSION=2 PERL_API_REVISION=5 PERL_API_VERSION=23 -PERL_API_SUBVERSION=1 +PERL_API_SUBVERSION=2 PERL_PATCHLEVEL='' PERL_CONFIG_SH=true : Variables propagated from previous config.sh file. diff --git a/Porting/config_H b/Porting/config_H index 7b6de26..b880c6c 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.23.1/i686-linux-64int-ld" /**/ -#define ARCHLIB_EXP "/pro/lib/perl5/5.23.1/i686-linux-64int-ld" /**/ +#define ARCHLIB "/pro/lib/perl5/5.23.2/i686-linux-64int-ld" /**/ +#define ARCHLIB_EXP "/pro/lib/perl5/5.23.2/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.23.1" /**/ -#define PRIVLIB_EXP "/pro/lib/perl5/5.23.1" /**/ +#define PRIVLIB "/pro/lib/perl5/5.23.2" /**/ +#define PRIVLIB_EXP "/pro/lib/perl5/5.23.2" /**/ /* 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.23.1/i686-linux-64int-ld" /**/ -#define SITEARCH_EXP "/pro/lib/perl5/site_perl/5.23.1/i686-linux-64int-ld" /**/ +#define SITEARCH "/pro/lib/perl5/site_perl/5.23.2/i686-linux-64int-ld" /**/ +#define SITEARCH_EXP "/pro/lib/perl5/site_perl/5.23.2/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.23.1" /**/ -#define SITELIB_EXP "/pro/lib/perl5/site_perl/5.23.1" /**/ +#define SITELIB "/pro/lib/perl5/site_perl/5.23.2" /**/ +#define SITELIB_EXP "/pro/lib/perl5/site_perl/5.23.2" /**/ #define SITELIB_STEM "/pro/lib/perl5/site_perl" /**/ /* SSize_t: @@ -4326,7 +4326,7 @@ * script to make sure (one hopes) that it runs with perl and not * some shell. */ -#define STARTPERL "#!/pro/bin/perl5.23.1" /**/ +#define STARTPERL "#!/pro/bin/perl5.23.2" /**/ /* HAS_STDIO_STREAM_ARRAY: * This symbol, if defined, tells that there is an array diff --git a/Porting/epigraphs.pod b/Porting/epigraphs.pod index a71ac18..fffd1b6 100644 --- a/Porting/epigraphs.pod +++ b/Porting/epigraphs.pod @@ -17,6 +17,63 @@ Consult your favorite dictionary for details. =head1 EPIGRAPHS +=head2 v5.23.1 - Elizabeth Haydon, "The Assassin King" + +L + + I was born beneath this willow, + Where my sire the earth did farm + Had the green grass as my pillow + The east wind as a blanket warm. + + But away! away! called the wind from the west + And in answer I did run + Seeking glory and adventure + Promised by the rising sun. + + I found love beneath this willow, + As true a love as life could hold, + Pledged my heart and swore my fealty + Sealed with a kiss and a band of gold. + + But to arms! to arms! called the wind from the west + In faithful answer I did run + Marching forth for king and country + In battles 'neath the midday sun. + + Oft I dreamt of that fair willow + As the seven seas I plied + And the girl who I left waiting + Longing to be at her side. + + But about! about! called the wind from the west + As once again my ship did run + Down the coast, about the wide world + Flying sails in the setting sun. + + Now I lie beneath the willow + Now at last no more to roam, + My bride and earth so tightly hold me + In their arms I'm finally home. + + While away! away! calls the wind from the west + Beyond the grave my spirit, free + Will chase the sun into the morning + Beyond the sky, beyond the sea. + +=head2 v5.23.0 - Bob Dylan, Maggie's Farm + +L + + I ain't gonna work on Maggie's farm no more + I ain't gonna work on Maggie's farm no more + Well, I try my best + To be just like I am + But everybody wants you + To be just like them + They sing while you slave and I just get bored + I ain't gonna work on Maggie's farm no more + =head2 v5.22.0 - Gene Wolfe, The Citadel of the Autarch L diff --git a/Porting/makerel b/Porting/makerel index 11e22fd..a2160fb 100755 --- a/Porting/makerel +++ b/Porting/makerel @@ -141,7 +141,7 @@ my @writables = qw( proto.h embed.h embedvar.h - overload.c + overload.inc overload.h mg_vtable.h perlapi.h diff --git a/Porting/perldelta_template.pod b/Porting/perldelta_template.pod index b052ec1..8ac9e75 100644 --- a/Porting/perldelta_template.pod +++ b/Porting/perldelta_template.pod @@ -378,7 +378,7 @@ here. XXX Generate this with: - perl Porting/acknowledgements.pl v5.23.1..HEAD + perl Porting/acknowledgements.pl v5.23.2..HEAD =head1 Reporting Bugs diff --git a/Porting/release_announcement_template.txt b/Porting/release_announcement_template.txt index a83e113..c1fb1e7 100644 --- a/Porting/release_announcement_template.txt +++ b/Porting/release_announcement_template.txt @@ -24,7 +24,7 @@ https://metacpan.org/pod/release/[AUTHOR]/perl-5.[VERSION.SUBVERSION]/pod/perlde [ACKNOWLEDGEMENTS SECTION FROM PERLDELTA] We expect to release version [NEXT BLEAD VERSION.SUBVERSION] on [FUTURE -DATE]. The next major stable release of Perl 5, version 22.0, should -appear in May 2015. +DATE]. The next major stable release of Perl 5, version 24.0, should +appear in May 2016. [YOUR SALUTATION HERE] diff --git a/Porting/release_managers_guide.pod b/Porting/release_managers_guide.pod index d80dafb..55b50bb 100644 --- a/Porting/release_managers_guide.pod +++ b/Porting/release_managers_guide.pod @@ -637,7 +637,10 @@ Also edit Module::CoreList's new version number in its F file. =head4 Add Module::CoreList version bump to perldelta -Add a perldelta entry for the new Module::CoreList version. +Add a perldelta entry for the new Module::CoreList version. You only +need to do this if you want to add notes about the changes included +with this version of Module::CoreList. Otherwise, its version bump +will be automatically filled in below in L. =for checklist skip RC diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod index 31b4ee1..dfe2d18 100644 --- a/Porting/release_schedule.pod +++ b/Porting/release_schedule.pod @@ -51,8 +51,8 @@ you should reset the version numbers to the next blead series. =head2 Perl 5.23 - 2015-06-20 5.23.0 Ricardo Signes - 2015-07-20 5.23.1 Matthew Horsfall + 2015-06-20 5.23.0 ✓ Ricardo Signes + 2015-07-20 5.23.1 ✓ Matthew Horsfall 2015-08-20 5.23.2 ? 2015-09-20 5.23.3 ? 2015-10-20 5.23.4 Steve Hay diff --git a/Porting/todo.pod b/Porting/todo.pod index 89ad5a4..1ed467f 100644 --- a/Porting/todo.pod +++ b/Porting/todo.pod @@ -71,8 +71,8 @@ instead there is an intentionally simpler library, F. However, quite a few tests in F have not been refactored to use it. Refactoring any of these tests, one at a time, is a useful thing TODO. -The subdirectories F, F and F, that contain the most -basic tests, should be excluded from this task. +The subdirectories F, F, F and F, that contain the +most basic tests, should be excluded from this task. =head2 Automate perldelta generation @@ -467,7 +467,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.23.1. +options would be nice for perl 5.23.2. =head2 Profile Perl - am I hot or not? @@ -1169,7 +1169,7 @@ L =head1 Big projects Tasks that will get your name mentioned in the description of the "Highlights -of 5.23.1" +of 5.23.2" =head2 make ithreads more robust diff --git a/README.haiku b/README.haiku index b893beb..59b0eb1 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.23.1/BePC-haiku/CORE/libperl.so . + cd /boot/common/lib; ln -s perl5/5.23.2/BePC-haiku/CORE/libperl.so . -Replace C<5.23.1> with your respective version of Perl. +Replace C<5.23.2> with your respective version of Perl. =head1 KNOWN PROBLEMS diff --git a/README.macosx b/README.macosx index 975638a..13fff32 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.23.1.tar.gz - tar -xzf perl-5.23.1.tar.gz - cd perl-5.23.1 + curl -O http://www.cpan.org/src/perl-5.23.2.tar.gz + tar -xzf perl-5.23.2.tar.gz + cd perl-5.23.2 ./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.23.1 as of this writing) builds without changes +The latest Perl release (5.23.2 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 84894a3..b0b2993 100644 --- a/README.os2 +++ b/README.os2 @@ -619,7 +619,7 @@ C in F, see L<"PERLLIB_PREFIX">. =item Additional Perl modules - unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.23.1/ + unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.23.2/ 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 5dd9afb..4cbf269 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^.23^.1.tar + vmstar -xvf perl-5^.23^.2.tar Then set default to the top-level source directory like so: - set default [.perl-5^.23^.1] + set default [.perl-5^.23^.2] and proceed with configuration as described in the next section. diff --git a/README.win32 b/README.win32 index ec29cfa..b4a07a6 100644 --- a/README.win32 +++ b/README.win32 @@ -42,7 +42,7 @@ following compilers on the Intel x86 architecture: Microsoft Visual C++ version 6.0 or later Intel C++ Compiler (experimental) Gcc by mingw.org gcc version 3.4.5 or later - Gcc by mingw-w64.sf.net gcc version 4.4.3 or later + Gcc by mingw-w64.org gcc version 4.4.3 or later Note that the last two of these are actually competing projects both delivering complete gcc toolchain for MS Windows: @@ -53,7 +53,7 @@ delivering complete gcc toolchain for MS Windows: Delivers gcc toolchain targeting 32-bit Windows platform. -=item L +=item L Delivers gcc toolchain targeting both 64-bit Windows and 32-bit Windows platforms (despite the project name "mingw-w64" they are not only 64-bit @@ -74,7 +74,7 @@ This port can also be built on IA64/AMD64 using: MinGW64 compiler (gcc version 4.4.3 or later) The Windows SDK can be downloaded from L. -The MinGW64 compiler is available at L. +The MinGW64 compiler is available at L. The latter is actually a cross-compiler targeting Win64. There's also a trimmed down compiler (no java, or gfortran) suitable for building perl available at: L @@ -369,7 +369,7 @@ You will have to make sure that CCTYPE is set correctly and that CCHOME points to wherever you installed your compiler. If building with the cross-compiler provided by -mingw-w64.sourceforge.net you'll need to uncomment the line that sets +mingw-w64.org you'll need to uncomment the line that sets GCCCROSS in the makefile.mk. Do this only if it's the cross-compiler - ie only if the bin folder doesn't contain a gcc.exe. (The cross-compiler does not provide a gcc.exe, g++.exe, ar.exe, etc. Instead, all of these diff --git a/charclass_invlists.h b/charclass_invlists.h index 076d223..8f14d31 100644 --- a/charclass_invlists.h +++ b/charclass_invlists.h @@ -312,7 +312,387 @@ static const UV Cased_invlist[] = { /* for ASCII/Latin1 */ 0x1F18A }; -static const UV Grapheme_Cluster_Break_invlist[] = { /* for ASCII/Latin1 */ +#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 */ + 247, /* 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, + 0x26A, + 0x26B, + 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, + 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, + 0xA7AE, + 0xA7B0, + 0xA7B8, + 0xAB53, + 0xAB54, + 0xAB70, + 0xABC0, + 0xFB00, + 0xFB07, + 0xFB13, + 0xFB18, + 0xFF21, + 0xFF3B, + 0xFF41, + 0xFF5B, + 0x10400, + 0x10450, + 0x10C80, + 0x10CB3, + 0x10CC0, + 0x10CF3, + 0x118A0, + 0x118E0 +}; + +static const UV _Perl_Folds_To_Multi_Char_invlist[] = { /* for ASCII/Latin1 */ + 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, + 0xDF, + 0xE0, + 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 ASCII/Latin1 */ 1502, /* Number of elements */ 148565664, /* Version and data structure type */ 0, /* 0 if the list starts at 0; @@ -1844,7 +2224,7 @@ typedef enum { GCB_V = 13 } GCB_enum; -static const GCB_enum Grapheme_Cluster_Break_invmap[] = { /* for ASCII/Latin1 */ +static const GCB_enum _Perl_GCB_invmap[] = { /* for ASCII/Latin1 */ GCB_Control, GCB_LF, GCB_Control, @@ -3351,382 +3731,6 @@ static const GCB_enum Grapheme_Cluster_Break_invmap[] = { /* for ASCII/Latin1 */ #endif /* defined(PERL_IN_REGEXEC_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 */ - 247, /* 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, - 0x26A, - 0x26B, - 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, - 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, - 0xA7AE, - 0xA7B0, - 0xA7B8, - 0xAB53, - 0xAB54, - 0xAB70, - 0xABC0, - 0xFB00, - 0xFB07, - 0xFB13, - 0xFB18, - 0xFF21, - 0xFF3B, - 0xFF41, - 0xFF5B, - 0x10400, - 0x10450, - 0x10C80, - 0x10CB3, - 0x10CC0, - 0x10CF3, - 0x118A0, - 0x118E0 -}; - -static const UV _Perl_Folds_To_Multi_Char_invlist[] = { /* for ASCII/Latin1 */ - 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, - 0xDF, - 0xE0, - 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_UTF8_C) static const UV _Perl_IDCont_invlist[] = { /* for ASCII/Latin1 */ @@ -6193,7 +6197,7 @@ static const UV _Perl_IDStart_invlist[] = { /* for ASCII/Latin1 */ #if defined(PERL_IN_PERL_C) -static const UV Sentence_Break_invlist[] = { /* for ASCII/Latin1 */ +static const UV _Perl_SB_invlist[] = { /* for ASCII/Latin1 */ 2896, /* Number of elements */ 148565664, /* Version and data structure type */ 0, /* 0 if the list starts at 0; @@ -9121,7 +9125,7 @@ typedef enum { SB_Upper = 15 } SB_enum; -static const SB_enum Sentence_Break_invmap[] = { /* for ASCII/Latin1 */ +static const SB_enum _Perl_SB_invmap[] = { /* for ASCII/Latin1 */ SB_Other, SB_Sp, SB_LF, @@ -12022,37 +12026,9 @@ static const SB_enum Sentence_Break_invmap[] = { /* for ASCII/Latin1 */ #endif /* defined(PERL_IN_REGEXEC_C) */ -#if defined(PERL_IN_REGCOMP_C) - -static const UV UpperLatin1_invlist[] = { /* for ASCII/Latin1 */ - 3, /* 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, - 0x80, - 0x100 -}; - -#endif /* defined(PERL_IN_REGCOMP_C) */ - #if defined(PERL_IN_PERL_C) -static const UV VertSpace_invlist[] = { /* for ASCII/Latin1 */ - 7, /* 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, - 0xA, - 0xE, - 0x85, - 0x86, - 0x2028, - 0x202A -}; - -static const UV Word_Break_invlist[] = { /* for ASCII/Latin1 */ +static const UV _Perl_WB_invlist[] = { /* for ASCII/Latin1 */ 1524, /* Number of elements */ 148565664, /* Version and data structure type */ 0, /* 0 if the list starts at 0; @@ -13611,7 +13587,7 @@ typedef enum { WB_UNKNOWN = 18 } WB_enum; -static const WB_enum Word_Break_invmap[] = { /* for ASCII/Latin1 */ +static const WB_enum _Perl_WB_invmap[] = { /* for ASCII/Latin1 */ WB_Other, WB_LF, WB_Newline, @@ -15140,8 +15116,36 @@ static const WB_enum Word_Break_invmap[] = { /* for ASCII/Latin1 */ #endif /* defined(PERL_IN_REGEXEC_C) */ +#if defined(PERL_IN_REGCOMP_C) + +static const UV UpperLatin1_invlist[] = { /* for ASCII/Latin1 */ + 3, /* 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, + 0x80, + 0x100 +}; + +#endif /* defined(PERL_IN_REGCOMP_C) */ + #if defined(PERL_IN_PERL_C) +static const UV VertSpace_invlist[] = { /* for ASCII/Latin1 */ + 7, /* 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, + 0xA, + 0xE, + 0x85, + 0x86, + 0x2028, + 0x202A +}; + static const UV XPerlSpace_invlist[] = { /* for ASCII/Latin1 */ 21, /* Number of elements */ 148565664, /* Version and data structure type */ @@ -24947,7 +24951,419 @@ static const UV Cased_invlist[] = { /* for EBCDIC 1047 */ 0x1F18A }; -static const UV Grapheme_Cluster_Break_invlist[] = { /* for EBCDIC 1047 */ +#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 */ + 279, /* 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, + 0x26A, + 0x26B, + 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, + 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, + 0xA7AE, + 0xA7B0, + 0xA7B8, + 0xAB53, + 0xAB54, + 0xAB70, + 0xABC0, + 0xFB00, + 0xFB07, + 0xFB13, + 0xFB18, + 0xFF21, + 0xFF3B, + 0xFF41, + 0xFF5B, + 0x10400, + 0x10450, + 0x10C80, + 0x10CB3, + 0x10CC0, + 0x10CF3, + 0x118A0, + 0x118E0 +}; + +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 */ 1502, /* Number of elements */ 148565664, /* Version and data structure type */ 0, /* 0 if the list starts at 0; @@ -26479,7 +26895,7 @@ typedef enum { GCB_V = 13 } GCB_enum; -static const GCB_enum Grapheme_Cluster_Break_invmap[] = { /* for EBCDIC 1047 */ +static const GCB_enum _Perl_GCB_invmap[] = { /* for EBCDIC 1047 */ GCB_Control, GCB_CR, GCB_Control, @@ -27986,414 +28402,6 @@ static const GCB_enum Grapheme_Cluster_Break_invmap[] = { /* for EBCDIC 1047 */ #endif /* defined(PERL_IN_REGEXEC_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 */ - 279, /* 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, - 0x26A, - 0x26B, - 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, - 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, - 0xA7AE, - 0xA7B0, - 0xA7B8, - 0xAB53, - 0xAB54, - 0xAB70, - 0xABC0, - 0xFB00, - 0xFB07, - 0xFB13, - 0xFB18, - 0xFF21, - 0xFF3B, - 0xFF41, - 0xFF5B, - 0x10400, - 0x10450, - 0x10C80, - 0x10CB3, - 0x10CC0, - 0x10CF3, - 0x118A0, - 0x118E0 -}; - -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_UTF8_C) static const UV _Perl_IDCont_invlist[] = { /* for EBCDIC 1047 */ @@ -30910,7 +30918,7 @@ static const UV _Perl_IDStart_invlist[] = { /* for EBCDIC 1047 */ #if defined(PERL_IN_PERL_C) -static const UV Sentence_Break_invlist[] = { /* for EBCDIC 1047 */ +static const UV _Perl_SB_invlist[] = { /* for EBCDIC 1047 */ 2920, /* Number of elements */ 148565664, /* Version and data structure type */ 0, /* 0 if the list starts at 0; @@ -33862,7 +33870,7 @@ typedef enum { SB_Upper = 15 } SB_enum; -static const SB_enum Sentence_Break_invmap[] = { /* for EBCDIC 1047 */ +static const SB_enum _Perl_SB_invmap[] = { /* for EBCDIC 1047 */ SB_Other, SB_Sp, SB_Other, @@ -36787,91 +36795,9 @@ static const SB_enum Sentence_Break_invmap[] = { /* for EBCDIC 1047 */ #endif /* defined(PERL_IN_REGEXEC_C) */ -#if defined(PERL_IN_REGCOMP_C) - -static const UV UpperLatin1_invlist[] = { /* for EBCDIC 1047 */ - 55, /* 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, - 0x4, - 0x5, - 0x6, - 0x7, - 0x8, - 0xB, - 0x14, - 0x15, - 0x17, - 0x18, - 0x1A, - 0x1C, - 0x20, - 0x26, - 0x28, - 0x2D, - 0x30, - 0x32, - 0x33, - 0x37, - 0x38, - 0x3C, - 0x3E, - 0x3F, - 0x41, - 0x4B, - 0x51, - 0x5A, - 0x62, - 0x6B, - 0x70, - 0x79, - 0x80, - 0x81, - 0x8A, - 0x91, - 0x9A, - 0xA1, - 0xAA, - 0xAD, - 0xAE, - 0xBD, - 0xBE, - 0xC0, - 0xCA, - 0xD0, - 0xDA, - 0xE0, - 0xE1, - 0xE2, - 0xEA, - 0xF0, - 0xFA, - 0x100 -}; - -#endif /* defined(PERL_IN_REGCOMP_C) */ - #if defined(PERL_IN_PERL_C) -static const UV VertSpace_invlist[] = { /* for EBCDIC 1047 */ - 9, /* 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, - 0xB, - 0xE, - 0x15, - 0x16, - 0x25, - 0x26, - 0x2028, - 0x202A -}; - -static const UV Word_Break_invlist[] = { /* for EBCDIC 1047 */ +static const UV _Perl_WB_invlist[] = { /* for EBCDIC 1047 */ 1549, /* Number of elements */ 148565664, /* Version and data structure type */ 0, /* 0 if the list starts at 0; @@ -38455,7 +38381,7 @@ typedef enum { WB_UNKNOWN = 18 } WB_enum; -static const WB_enum Word_Break_invmap[] = { /* for EBCDIC 1047 */ +static const WB_enum _Perl_WB_invmap[] = { /* for EBCDIC 1047 */ WB_Other, WB_Newline, WB_CR, @@ -40009,8 +39935,90 @@ static const WB_enum Word_Break_invmap[] = { /* for EBCDIC 1047 */ #endif /* defined(PERL_IN_REGEXEC_C) */ +#if defined(PERL_IN_REGCOMP_C) + +static const UV UpperLatin1_invlist[] = { /* for EBCDIC 1047 */ + 55, /* 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, + 0x4, + 0x5, + 0x6, + 0x7, + 0x8, + 0xB, + 0x14, + 0x15, + 0x17, + 0x18, + 0x1A, + 0x1C, + 0x20, + 0x26, + 0x28, + 0x2D, + 0x30, + 0x32, + 0x33, + 0x37, + 0x38, + 0x3C, + 0x3E, + 0x3F, + 0x41, + 0x4B, + 0x51, + 0x5A, + 0x62, + 0x6B, + 0x70, + 0x79, + 0x80, + 0x81, + 0x8A, + 0x91, + 0x9A, + 0xA1, + 0xAA, + 0xAD, + 0xAE, + 0xBD, + 0xBE, + 0xC0, + 0xCA, + 0xD0, + 0xDA, + 0xE0, + 0xE1, + 0xE2, + 0xEA, + 0xF0, + 0xFA, + 0x100 +}; + +#endif /* defined(PERL_IN_REGCOMP_C) */ + #if defined(PERL_IN_PERL_C) +static const UV VertSpace_invlist[] = { /* for EBCDIC 1047 */ + 9, /* 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, + 0xB, + 0xE, + 0x15, + 0x16, + 0x25, + 0x26, + 0x2028, + 0x202A +}; + static const UV XPerlSpace_invlist[] = { /* for EBCDIC 1047 */ 23, /* Number of elements */ 148565664, /* Version and data structure type */ @@ -49924,174 +49932,582 @@ static const UV Cased_invlist[] = { /* for EBCDIC 037 */ 0x1F18A }; -static const UV Grapheme_Cluster_Break_invlist[] = { /* for EBCDIC 037 */ - 1502, /* Number of elements */ +#endif /* defined(PERL_IN_PERL_C) */ + +#if defined(PERL_IN_REGCOMP_C) + +static const UV NonL1_Perl_Non_Final_Folds_invlist[] = { /* for EBCDIC 037 */ + 45, /* Number of elements */ 148565664, /* Version and data structure type */ - 0, /* 0 if the list starts at 0; + 1, /* 0 if the list starts at 0; 1 if it starts at the element beyond 0 */ 0x0, - 0xD, - 0xE, - 0x25, - 0x26, - 0x40, + 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 037 */ + 275, /* 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, + 0xAF, + 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, + 0x26A, + 0x26B, + 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, - 0x483, + 0x374, + 0x376, + 0x378, + 0x37B, + 0x37E, + 0x37F, + 0x380, + 0x386, + 0x387, + 0x388, + 0x38B, + 0x38C, + 0x38D, + 0x38E, + 0x3A2, + 0x3A3, + 0x3D2, + 0x3D5, + 0x3F6, + 0x3F7, + 0x3FC, + 0x3FD, + 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, - 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, + 0x530, + 0x531, + 0x557, + 0x561, + 0x588, + 0x10A0, + 0x10C6, + 0x10C7, + 0x10C8, + 0x10CD, + 0x10CE, + 0x13A0, + 0x13F6, + 0x13F8, + 0x13FE, + 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, + 0xA7AE, + 0xA7B0, + 0xA7B8, + 0xAB53, + 0xAB54, + 0xAB70, + 0xABC0, + 0xFB00, + 0xFB07, + 0xFB13, + 0xFB18, + 0xFF21, + 0xFF3B, + 0xFF41, + 0xFF5B, + 0x10400, + 0x10450, + 0x10C80, + 0x10CB3, + 0x10CC0, + 0x10CF3, + 0x118A0, + 0x118E0 +}; + +static const UV _Perl_Folds_To_Multi_Char_invlist[] = { /* for EBCDIC 037 */ + 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 037 */ + 1502, /* 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, + 0x25, + 0x26, + 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, + 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, @@ -51456,7 +51872,7 @@ typedef enum { GCB_V = 13 } GCB_enum; -static const GCB_enum Grapheme_Cluster_Break_invmap[] = { /* for EBCDIC 037 */ +static const GCB_enum _Perl_GCB_invmap[] = { /* for EBCDIC 037 */ GCB_Control, GCB_CR, GCB_Control, @@ -52963,410 +53379,6 @@ static const GCB_enum Grapheme_Cluster_Break_invmap[] = { /* for EBCDIC 037 */ #endif /* defined(PERL_IN_REGEXEC_C) */ -#if defined(PERL_IN_REGCOMP_C) - -static const UV NonL1_Perl_Non_Final_Folds_invlist[] = { /* for EBCDIC 037 */ - 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 037 */ - 275, /* 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, - 0xAF, - 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, - 0x26A, - 0x26B, - 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, - 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, - 0xA7AE, - 0xA7B0, - 0xA7B8, - 0xAB53, - 0xAB54, - 0xAB70, - 0xABC0, - 0xFB00, - 0xFB07, - 0xFB13, - 0xFB18, - 0xFF21, - 0xFF3B, - 0xFF41, - 0xFF5B, - 0x10400, - 0x10450, - 0x10C80, - 0x10CB3, - 0x10CC0, - 0x10CF3, - 0x118A0, - 0x118E0 -}; - -static const UV _Perl_Folds_To_Multi_Char_invlist[] = { /* for EBCDIC 037 */ - 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_UTF8_C) static const UV _Perl_IDCont_invlist[] = { /* for EBCDIC 037 */ @@ -55875,7 +55887,7 @@ static const UV _Perl_IDStart_invlist[] = { /* for EBCDIC 037 */ #if defined(PERL_IN_PERL_C) -static const UV Sentence_Break_invlist[] = { /* for EBCDIC 037 */ +static const UV _Perl_SB_invlist[] = { /* for EBCDIC 037 */ 2916, /* Number of elements */ 148565664, /* Version and data structure type */ 0, /* 0 if the list starts at 0; @@ -58823,7 +58835,7 @@ typedef enum { SB_Upper = 15 } SB_enum; -static const SB_enum Sentence_Break_invmap[] = { /* for EBCDIC 037 */ +static const SB_enum _Perl_SB_invmap[] = { /* for EBCDIC 037 */ SB_Other, SB_Sp, SB_Other, @@ -61744,93 +61756,9 @@ static const SB_enum Sentence_Break_invmap[] = { /* for EBCDIC 037 */ #endif /* defined(PERL_IN_REGEXEC_C) */ -#if defined(PERL_IN_REGCOMP_C) - -static const UV UpperLatin1_invlist[] = { /* for EBCDIC 037 */ - 57, /* 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, - 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, - 0x100 -}; - -#endif /* defined(PERL_IN_REGCOMP_C) */ - #if defined(PERL_IN_PERL_C) -static const UV VertSpace_invlist[] = { /* for EBCDIC 037 */ - 9, /* 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, - 0xB, - 0xE, - 0x15, - 0x16, - 0x25, - 0x26, - 0x2028, - 0x202A -}; - -static const UV Word_Break_invlist[] = { /* for EBCDIC 037 */ +static const UV _Perl_WB_invlist[] = { /* for EBCDIC 037 */ 1545, /* Number of elements */ 148565664, /* Version and data structure type */ 0, /* 0 if the list starts at 0; @@ -63410,7 +63338,7 @@ typedef enum { WB_UNKNOWN = 18 } WB_enum; -static const WB_enum Word_Break_invmap[] = { /* for EBCDIC 037 */ +static const WB_enum _Perl_WB_invmap[] = { /* for EBCDIC 037 */ WB_Other, WB_Newline, WB_CR, @@ -64960,8 +64888,92 @@ static const WB_enum Word_Break_invmap[] = { /* for EBCDIC 037 */ #endif /* defined(PERL_IN_REGEXEC_C) */ +#if defined(PERL_IN_REGCOMP_C) + +static const UV UpperLatin1_invlist[] = { /* for EBCDIC 037 */ + 57, /* 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, + 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, + 0x100 +}; + +#endif /* defined(PERL_IN_REGCOMP_C) */ + #if defined(PERL_IN_PERL_C) +static const UV VertSpace_invlist[] = { /* for EBCDIC 037 */ + 9, /* 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, + 0xB, + 0xE, + 0x15, + 0x16, + 0x25, + 0x26, + 0x2028, + 0x202A +}; + static const UV XPerlSpace_invlist[] = { /* for EBCDIC 037 */ 23, /* Number of elements */ 148565664, /* Version and data structure type */ @@ -74865,164 +74877,574 @@ static const UV Cased_invlist[] = { /* for EBCDIC POSIX-BC */ 0x1F18A }; -static const UV Grapheme_Cluster_Break_invlist[] = { /* for EBCDIC POSIX-BC */ - 1502, /* Number of elements */ +#endif /* defined(PERL_IN_PERL_C) */ + +#if defined(PERL_IN_REGCOMP_C) + +static const UV NonL1_Perl_Non_Final_Folds_invlist[] = { /* for EBCDIC POSIX-BC */ + 45, /* Number of elements */ 148565664, /* Version and data structure type */ - 0, /* 0 if the list starts at 0; + 1, /* 0 if the list starts at 0; 1 if it starts at the element beyond 0 */ 0x0, - 0xD, - 0xE, - 0x15, - 0x16, - 0x40, - 0x5F, - 0x60, + 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 POSIX-BC */ + 277, /* 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, + 0xAF, + 0xC0, 0xCA, 0xCB, + 0xD0, + 0xD1, + 0xDA, + 0xDB, + 0xE1, + 0xE2, + 0xEA, + 0xEB, + 0xF0, + 0xFC, + 0xFD, + 0xFE, + 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, + 0x26A, + 0x26B, + 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, - 0x483, + 0x374, + 0x376, + 0x378, + 0x37B, + 0x37E, + 0x37F, + 0x380, + 0x386, + 0x387, + 0x388, + 0x38B, + 0x38C, + 0x38D, + 0x38E, + 0x3A2, + 0x3A3, + 0x3D2, + 0x3D5, + 0x3F6, + 0x3F7, + 0x3FC, + 0x3FD, + 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, - 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, + 0x530, + 0x531, + 0x557, + 0x561, + 0x588, + 0x10A0, + 0x10C6, + 0x10C7, + 0x10C8, + 0x10CD, + 0x10CE, + 0x13A0, + 0x13F6, + 0x13F8, + 0x13FE, + 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, + 0xA7AE, + 0xA7B0, + 0xA7B8, + 0xAB53, + 0xAB54, + 0xAB70, + 0xABC0, + 0xFB00, + 0xFB07, + 0xFB13, + 0xFB18, + 0xFF21, + 0xFF3B, + 0xFF41, + 0xFF5B, + 0x10400, + 0x10450, + 0x10C80, + 0x10CB3, + 0x10CC0, + 0x10CF3, + 0x118A0, + 0x118E0 +}; + +static const UV _Perl_Folds_To_Multi_Char_invlist[] = { /* for EBCDIC POSIX-BC */ + 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 POSIX-BC */ + 1502, /* 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, + 0x5F, + 0x60, + 0xCA, + 0xCB, + 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, + 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, @@ -76397,7 +76819,7 @@ typedef enum { GCB_V = 13 } GCB_enum; -static const GCB_enum Grapheme_Cluster_Break_invmap[] = { /* for EBCDIC POSIX-BC */ +static const GCB_enum _Perl_GCB_invmap[] = { /* for EBCDIC POSIX-BC */ GCB_Control, GCB_CR, GCB_Control, @@ -77904,412 +78326,6 @@ static const GCB_enum Grapheme_Cluster_Break_invmap[] = { /* for EBCDIC POSIX-BC #endif /* defined(PERL_IN_REGEXEC_C) */ -#if defined(PERL_IN_REGCOMP_C) - -static const UV NonL1_Perl_Non_Final_Folds_invlist[] = { /* for EBCDIC POSIX-BC */ - 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 POSIX-BC */ - 277, /* 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, - 0xAF, - 0xC0, - 0xCA, - 0xCB, - 0xD0, - 0xD1, - 0xDA, - 0xDB, - 0xE1, - 0xE2, - 0xEA, - 0xEB, - 0xF0, - 0xFC, - 0xFD, - 0xFE, - 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, - 0x26A, - 0x26B, - 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, - 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, - 0xA7AE, - 0xA7B0, - 0xA7B8, - 0xAB53, - 0xAB54, - 0xAB70, - 0xABC0, - 0xFB00, - 0xFB07, - 0xFB13, - 0xFB18, - 0xFF21, - 0xFF3B, - 0xFF41, - 0xFF5B, - 0x10400, - 0x10450, - 0x10C80, - 0x10CB3, - 0x10CC0, - 0x10CF3, - 0x118A0, - 0x118E0 -}; - -static const UV _Perl_Folds_To_Multi_Char_invlist[] = { /* for EBCDIC POSIX-BC */ - 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_UTF8_C) static const UV _Perl_IDCont_invlist[] = { /* for EBCDIC POSIX-BC */ @@ -80822,7 +80838,7 @@ static const UV _Perl_IDStart_invlist[] = { /* for EBCDIC POSIX-BC */ #if defined(PERL_IN_PERL_C) -static const UV Sentence_Break_invlist[] = { /* for EBCDIC POSIX-BC */ +static const UV _Perl_SB_invlist[] = { /* for EBCDIC POSIX-BC */ 2924, /* Number of elements */ 148565664, /* Version and data structure type */ 0, /* 0 if the list starts at 0; @@ -83778,7 +83794,7 @@ typedef enum { SB_Upper = 15 } SB_enum; -static const SB_enum Sentence_Break_invmap[] = { /* for EBCDIC POSIX-BC */ +static const SB_enum _Perl_SB_invmap[] = { /* for EBCDIC POSIX-BC */ SB_Other, SB_Sp, SB_Other, @@ -86707,93 +86723,9 @@ static const SB_enum Sentence_Break_invmap[] = { /* for EBCDIC POSIX-BC */ #endif /* defined(PERL_IN_REGEXEC_C) */ -#if defined(PERL_IN_REGCOMP_C) - -static const UV UpperLatin1_invlist[] = { /* for EBCDIC POSIX-BC */ - 57, /* 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, - 0x4, - 0x5, - 0x6, - 0x7, - 0x8, - 0xB, - 0x14, - 0x15, - 0x17, - 0x18, - 0x1A, - 0x1C, - 0x20, - 0x26, - 0x28, - 0x2D, - 0x30, - 0x32, - 0x33, - 0x37, - 0x38, - 0x3C, - 0x3E, - 0x3F, - 0x41, - 0x4A, - 0x51, - 0x5A, - 0x5F, - 0x60, - 0x62, - 0x6A, - 0x70, - 0x7A, - 0x80, - 0x81, - 0x8A, - 0x91, - 0x9A, - 0xA2, - 0xAA, - 0xBB, - 0xBE, - 0xC1, - 0xCA, - 0xD1, - 0xDA, - 0xE2, - 0xEA, - 0xF0, - 0xFA, - 0xFB, - 0xFC, - 0xFD, - 0xFE, - 0xFF -}; - -#endif /* defined(PERL_IN_REGCOMP_C) */ - #if defined(PERL_IN_PERL_C) -static const UV VertSpace_invlist[] = { /* for EBCDIC POSIX-BC */ - 9, /* 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, - 0xB, - 0xE, - 0x15, - 0x16, - 0x25, - 0x26, - 0x2028, - 0x202A -}; - -static const UV Word_Break_invlist[] = { /* for EBCDIC POSIX-BC */ +static const UV _Perl_WB_invlist[] = { /* for EBCDIC POSIX-BC */ 1547, /* Number of elements */ 148565664, /* Version and data structure type */ 0, /* 0 if the list starts at 0; @@ -88375,7 +88307,7 @@ typedef enum { WB_UNKNOWN = 18 } WB_enum; -static const WB_enum Word_Break_invmap[] = { /* for EBCDIC POSIX-BC */ +static const WB_enum _Perl_WB_invmap[] = { /* for EBCDIC POSIX-BC */ WB_Other, WB_Newline, WB_CR, @@ -89927,8 +89859,92 @@ static const WB_enum Word_Break_invmap[] = { /* for EBCDIC POSIX-BC */ #endif /* defined(PERL_IN_REGEXEC_C) */ +#if defined(PERL_IN_REGCOMP_C) + +static const UV UpperLatin1_invlist[] = { /* for EBCDIC POSIX-BC */ + 57, /* 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, + 0x4, + 0x5, + 0x6, + 0x7, + 0x8, + 0xB, + 0x14, + 0x15, + 0x17, + 0x18, + 0x1A, + 0x1C, + 0x20, + 0x26, + 0x28, + 0x2D, + 0x30, + 0x32, + 0x33, + 0x37, + 0x38, + 0x3C, + 0x3E, + 0x3F, + 0x41, + 0x4A, + 0x51, + 0x5A, + 0x5F, + 0x60, + 0x62, + 0x6A, + 0x70, + 0x7A, + 0x80, + 0x81, + 0x8A, + 0x91, + 0x9A, + 0xA2, + 0xAA, + 0xBB, + 0xBE, + 0xC1, + 0xCA, + 0xD1, + 0xDA, + 0xE2, + 0xEA, + 0xF0, + 0xFA, + 0xFB, + 0xFC, + 0xFD, + 0xFE, + 0xFF +}; + +#endif /* defined(PERL_IN_REGCOMP_C) */ + #if defined(PERL_IN_PERL_C) +static const UV VertSpace_invlist[] = { /* for EBCDIC POSIX-BC */ + 9, /* 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, + 0xB, + 0xE, + 0x15, + 0x16, + 0x25, + 0x26, + 0x2028, + 0x202A +}; + static const UV XPerlSpace_invlist[] = { /* for EBCDIC POSIX-BC */ 23, /* Number of elements */ 148565664, /* Version and data structure type */ @@ -99479,7 +99495,7 @@ static const UV XPosixXDigit_invlist[] = { /* for EBCDIC POSIX-BC */ #endif /* EBCDIC POSIX-BC */ /* Generated from: - * 083180df694deb1fc173361406c1a75619fb8376403db3a76dc585c1e3951eca lib/Unicode/UCD.pm + * 0bca60a25eb4ccf2e04f50446db5f882322f50a9c61dc57bb806ccfc9b2e26a4 lib/Unicode/UCD.pm * ae98bec7e4f0564758eed81eca5015481ba32581f8a735a825b71b3bba714450 lib/unicore/ArabicShaping.txt * 1687fe5994eb7e5c0dab8503fc2a1b3b479d91af9d3b8055941c9bd791f7d0b5 lib/unicore/BidiBrackets.txt * 350d1302116194b0b21def287434b55c5088098fbc726e879f7420a391965643 lib/unicore/BidiMirroring.txt @@ -99521,8 +99537,8 @@ static const UV XPosixXDigit_invlist[] = { /* for EBCDIC POSIX-BC */ * 1a0687fb9c6c4567e853913549df0944fe40821279a3e9cdaa6ab8679bc286fd lib/unicore/extracted/DLineBreak.txt * 40bcfed3ca727c19e1331f6c33806231d5f7eeeabd2e6a9e06a3740c85d0c250 lib/unicore/extracted/DNumType.txt * a18d502bad39d527ac5586d7bc93e29f565859e3bcc24ada627eff606d6f5fed lib/unicore/extracted/DNumValues.txt - * c9326eab8d7861c3543963e555d5b927348f4467c93071db23154dece7619654 lib/unicore/mktables + * ad739a46951b5f46396074b0682a2cfeed24b633a742a8e1aa0e337f69ef8b1c lib/unicore/mktables * 462c9aaa608fb2014cd9649af1c5c009485c60b9c8b15b89401fdc10cf6161c6 lib/unicore/version * c6884f4d629f04d1316f3476cb1050b6a1b98ca30c903262955d4eae337c6b1e regen/charset_translations.pl - * f199f92c0b5f87882b0198936ea8ef3dc43627b57a77ac3eb9250bd2664bbd88 regen/mk_invlists.pl + * 8a097f8f726bb1619af2f27f149ab87e60a1602f790147e3a561358be16abd27 regen/mk_invlists.pl * ex: set ro: */ diff --git a/cop.h b/cop.h index bf287a1..70e7817 100644 --- a/cop.h +++ b/cop.h @@ -154,10 +154,10 @@ typedef struct refcounted_he COPHH; /* =for apidoc Amx|SV *|cophh_fetch_pvn|const COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|U32 flags -Look up the entry in the cop hints hash I with the key specified by -I and I. If I has the C bit set, +Look up the entry in the cop hints hash C with the key specified by +C and C. If C has the C bit set, the key octets are interpreted as UTF-8, otherwise they are interpreted -as Latin-1. I is a precomputed hash of the key string, or zero if +as Latin-1. C is a precomputed hash of the key string, or zero if it has not been precomputed. Returns a mortal scalar copy of the value associated with the key, or C<&PL_sv_placeholder> if there is no value associated with the key. @@ -208,7 +208,7 @@ string/length pair. =for apidoc Amx|HV *|cophh_2hv|const COPHH *cophh|U32 flags Generates and returns a standard Perl hash representing the full set of -key/value pairs in the cop hints hash I. I is currently +key/value pairs in the cop hints hash C. C is currently unused and must be zero. =cut @@ -220,7 +220,7 @@ unused and must be zero. /* =for apidoc Amx|COPHH *|cophh_copy|COPHH *cophh -Make and return a complete copy of the cop hints hash I. +Make and return a complete copy of the cop hints hash C. =cut */ @@ -230,7 +230,7 @@ Make and return a complete copy of the cop hints hash I. /* =for apidoc Amx|void|cophh_free|COPHH *cophh -Discard the cop hints hash I, freeing all resources associated +Discard the cop hints hash C, freeing all resources associated with it. =cut @@ -251,18 +251,18 @@ Generate and return a fresh cop hints hash containing no entries. /* =for apidoc Amx|COPHH *|cophh_store_pvn|COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|SV *value|U32 flags -Stores a value, associated with a key, in the cop hints hash I, +Stores a value, associated with a key, in the cop hints hash C, and returns the modified hash. The returned hash pointer is in general not the same as the hash pointer that was passed in. The input hash is consumed by the function, and the pointer to it must not be subsequently used. Use L if you need both hashes. -The key is specified by I and I. If I has the +The key is specified by C and C. If C has the C bit set, the key octets are interpreted as UTF-8, -otherwise they are interpreted as Latin-1. I is a precomputed +otherwise they are interpreted as Latin-1. C is a precomputed hash of the key string, or zero if it has not been precomputed. -I is the scalar value to store for this key. I is copied +C is the scalar value to store for this key. C is copied by this function, which thus does not take ownership of any reference to it, and later changes to the scalar will not be reflected in the value visible in the cop hints hash. Complex types of scalar will not @@ -313,15 +313,15 @@ string/length pair. /* =for apidoc Amx|COPHH *|cophh_delete_pvn|COPHH *cophh|const char *keypv|STRLEN keylen|U32 hash|U32 flags -Delete a key and its associated value from the cop hints hash I, +Delete a key and its associated value from the cop hints hash C, and returns the modified hash. The returned hash pointer is in general not the same as the hash pointer that was passed in. The input hash is consumed by the function, and the pointer to it must not be subsequently used. Use L if you need both hashes. -The key is specified by I and I. If I has the +The key is specified by C and C. If C has the C bit set, the key octets are interpreted as UTF-8, -otherwise they are interpreted as Latin-1. I is a precomputed +otherwise they are interpreted as Latin-1. C is a precomputed hash of the key string, or zero if it has not been precomputed. =cut @@ -457,10 +457,10 @@ struct cop { /* =for apidoc Am|SV *|cop_hints_fetch_pvn|const COP *cop|const char *keypv|STRLEN keylen|U32 hash|U32 flags -Look up the hint entry in the cop I with the key specified by -I and I. If I has the C bit set, +Look up the hint entry in the cop C with the key specified by +C and C. If C has the C bit set, the key octets are interpreted as UTF-8, otherwise they are interpreted -as Latin-1. I is a precomputed hash of the key string, or zero if +as Latin-1. C is a precomputed hash of the key string, or zero if it has not been precomputed. Returns a mortal scalar copy of the value associated with the key, or C<&PL_sv_placeholder> if there is no value associated with the key. @@ -511,7 +511,7 @@ string/length pair. =for apidoc Am|HV *|cop_hints_2hv|const COP *cop|U32 flags Generates and returns a standard Perl hash representing the full set of -hint entries in the cop I. I is currently unused and must +hint entries in the cop C. C is currently unused and must be zero. =cut diff --git a/cpan/CPAN-Meta-YAML/lib/CPAN/Meta/YAML.pm b/cpan/CPAN-Meta-YAML/lib/CPAN/Meta/YAML.pm index 96ed0ca..f0c1900 100644 --- a/cpan/CPAN-Meta-YAML/lib/CPAN/Meta/YAML.pm +++ b/cpan/CPAN-Meta-YAML/lib/CPAN/Meta/YAML.pm @@ -1,11 +1,11 @@ use 5.008001; # sane UTF-8 support use strict; use warnings; -package CPAN::Meta::YAML; # git description: v1.66-5-ge09e1ae +package CPAN::Meta::YAML; # git description: v1.68-2-gcc5324e # XXX-INGY is 5.8.1 too old/broken for utf8? # XXX-XDG Lancaster consensus was that it was sufficient until # proven otherwise -$CPAN::Meta::YAML::VERSION = '0.016'; +$CPAN::Meta::YAML::VERSION = '0.017'; # TRIAL ; # original $VERSION removed by Doppelgaenger ##################################################################### @@ -878,7 +878,7 @@ CPAN::Meta::YAML - Read and write a subset of YAML for CPAN Meta files =head1 VERSION -version 0.016 +version 0.017 =head1 SYNOPSIS diff --git a/cpan/CPAN-Meta-YAML/t/00-report-prereqs.dd b/cpan/CPAN-Meta-YAML/t/00-report-prereqs.dd deleted file mode 100644 index 98d00aa..0000000 --- a/cpan/CPAN-Meta-YAML/t/00-report-prereqs.dd +++ /dev/null @@ -1,66 +0,0 @@ -do { my $x = { - 'configure' => { - 'requires' => { - 'ExtUtils::MakeMaker' => '6.17', - 'perl' => '5.008001' - } - }, - 'develop' => { - 'requires' => { - 'Dist::Zilla' => '5', - 'Dist::Zilla::Plugin::AppendExternalData' => '0', - 'Dist::Zilla::Plugin::Doppelgaenger' => '0.007', - 'Dist::Zilla::Plugin::Encoding' => '0', - 'Dist::Zilla::Plugin::Git::NextVersion' => '0', - 'Dist::Zilla::Plugin::MakeMaker::Highlander' => '0.003', - 'Dist::Zilla::Plugin::MetaResources' => '0', - 'Dist::Zilla::Plugin::PkgVersion' => '0', - 'Dist::Zilla::Plugin::PodWeaver' => '0', - 'Dist::Zilla::Plugin::PruneFiles' => '0', - 'Dist::Zilla::Plugin::RemovePrereqs' => '0', - 'Dist::Zilla::PluginBundle::DAGOLDEN' => '0.072', - 'File::Spec' => '0', - 'File::Temp' => '0', - 'IO::Handle' => '0', - 'IPC::Open3' => '0', - 'Test::CPAN::Meta' => '0', - 'Test::More' => '0', - 'Test::Pod' => '1.41', - 'Test::Version' => '1' - } - }, - 'runtime' => { - 'requires' => { - 'B' => '0', - 'Carp' => '0', - 'Exporter' => '0', - 'Fcntl' => '0', - 'Scalar::Util' => '0', - 'perl' => '5.008001', - 'strict' => '0', - 'warnings' => '0' - } - }, - 'test' => { - 'recommends' => { - 'CPAN::Meta' => '2.120900' - }, - 'requires' => { - 'ExtUtils::MakeMaker' => '0', - 'File::Basename' => '0', - 'File::Find' => '0', - 'File::Spec' => '0', - 'File::Spec::Functions' => '0', - 'File::Temp' => '0.19', - 'IO::Dir' => '0', - 'JSON::PP' => '0', - 'Test::More' => '0.99', - 'lib' => '0', - 'perl' => '5.008001', - 'utf8' => '0', - 'vars' => '0' - } - } - }; - $x; - } \ No newline at end of file diff --git a/cpan/CPAN-Meta-YAML/t/01_api.t b/cpan/CPAN-Meta-YAML/t/01_api.t index 3d57c85..643660f 100644 --- a/cpan/CPAN-Meta-YAML/t/01_api.t +++ b/cpan/CPAN-Meta-YAML/t/01_api.t @@ -4,7 +4,8 @@ use strict; use warnings; use lib 't/lib/'; -use Test::More 0.99; +use Test::More 0.88; +use SubtestCompat; use TestBridge; use CPAN::Meta::YAML; diff --git a/cpan/CPAN-Meta-YAML/t/01_compile.t b/cpan/CPAN-Meta-YAML/t/01_compile.t index e7b3870..916c6ce 100644 --- a/cpan/CPAN-Meta-YAML/t/01_compile.t +++ b/cpan/CPAN-Meta-YAML/t/01_compile.t @@ -8,7 +8,7 @@ BEGIN { $| = 1; } -use Test::More 0.99; +use Test::More 0.88; # Check their perl version ok( $] ge '5.008001', "Your perl is new enough" ); diff --git a/cpan/CPAN-Meta-YAML/t/10_read.t b/cpan/CPAN-Meta-YAML/t/10_read.t index af02e79..f70f217 100644 --- a/cpan/CPAN-Meta-YAML/t/10_read.t +++ b/cpan/CPAN-Meta-YAML/t/10_read.t @@ -2,7 +2,8 @@ use strict; use warnings; use utf8; use lib 't/lib/'; -use Test::More 0.99; +use Test::More 0.88; +use SubtestCompat; use TestUtils; use TestBridge; diff --git a/cpan/CPAN-Meta-YAML/t/11_read_string.t b/cpan/CPAN-Meta-YAML/t/11_read_string.t index 9b00291..491fd8e 100644 --- a/cpan/CPAN-Meta-YAML/t/11_read_string.t +++ b/cpan/CPAN-Meta-YAML/t/11_read_string.t @@ -1,7 +1,8 @@ use strict; use warnings; use lib 't/lib/'; -use Test::More 0.99; +use Test::More 0.88; +use SubtestCompat; use TestUtils; use TestBridge; diff --git a/cpan/CPAN-Meta-YAML/t/12_write.t b/cpan/CPAN-Meta-YAML/t/12_write.t index b4be78a..23d9ccf 100644 --- a/cpan/CPAN-Meta-YAML/t/12_write.t +++ b/cpan/CPAN-Meta-YAML/t/12_write.t @@ -2,7 +2,8 @@ use utf8; use strict; use warnings; use lib 't/lib/'; -use Test::More 0.99; +use Test::More 0.88; +use SubtestCompat; use TestBridge; use TestUtils; diff --git a/cpan/CPAN-Meta-YAML/t/13_write_string.t b/cpan/CPAN-Meta-YAML/t/13_write_string.t index 48113d0..14dd85c 100644 --- a/cpan/CPAN-Meta-YAML/t/13_write_string.t +++ b/cpan/CPAN-Meta-YAML/t/13_write_string.t @@ -1,7 +1,8 @@ use strict; use warnings; use lib 't/lib/'; -use Test::More 0.99; +use Test::More 0.88; +use SubtestCompat; use TestUtils; use TestBridge; diff --git a/cpan/CPAN-Meta-YAML/t/20_subclass.t b/cpan/CPAN-Meta-YAML/t/20_subclass.t index 9935ca9..e1d260c 100644 --- a/cpan/CPAN-Meta-YAML/t/20_subclass.t +++ b/cpan/CPAN-Meta-YAML/t/20_subclass.t @@ -2,7 +2,7 @@ use strict; use warnings; use lib 't/lib/'; -use Test::More 0.99; +use Test::More 0.88; use TestUtils; use File::Spec::Functions ':ALL'; diff --git a/cpan/CPAN-Meta-YAML/t/21_yamlpm_compat.t b/cpan/CPAN-Meta-YAML/t/21_yamlpm_compat.t index 944ceff..b7b0c0c 100644 --- a/cpan/CPAN-Meta-YAML/t/21_yamlpm_compat.t +++ b/cpan/CPAN-Meta-YAML/t/21_yamlpm_compat.t @@ -1,7 +1,7 @@ use strict; use warnings; use lib 't/lib/'; -use Test::More 0.99; +use Test::More 0.88; use TestBridge; use File::Spec::Functions 'catfile'; use File::Temp 0.19; # newdir diff --git a/cpan/CPAN-Meta-YAML/t/30_yaml_spec_tml.t b/cpan/CPAN-Meta-YAML/t/30_yaml_spec_tml.t index 1209a96..9d9f773 100644 --- a/cpan/CPAN-Meta-YAML/t/30_yaml_spec_tml.t +++ b/cpan/CPAN-Meta-YAML/t/30_yaml_spec_tml.t @@ -2,14 +2,16 @@ use strict; use warnings; use lib 't/lib'; -use Test::More 0.99; +use Test::More 0.88; +use SubtestCompat; use TestBridge; use TestUtils; my $JSON = json_class() or Test::More::plan skip_all => 'no JSON backends available!?'; -diag 'using JSON backend: ' . $JSON; +diag 'using JSON backend: ' . $JSON . ' ' . $JSON->VERSION + if not $ENV{PERL_CORE}; # Each spec test will need a different bridge and arguments: my @spec_tests = ( @@ -24,7 +26,6 @@ for my $test (@spec_tests) { my $code = sub { my ($file, $blocks) = @_; subtest "YAML Spec Test; file: $file" => sub { - plan tests => scalar @$blocks; my $func = \&{$bridge}; $func->($_) for @$blocks; }; diff --git a/cpan/CPAN-Meta-YAML/t/31_local_tml.t b/cpan/CPAN-Meta-YAML/t/31_local_tml.t index 2339773..23e0e31 100644 --- a/cpan/CPAN-Meta-YAML/t/31_local_tml.t +++ b/cpan/CPAN-Meta-YAML/t/31_local_tml.t @@ -1,7 +1,7 @@ use strict; use warnings; use lib 't/lib/'; -use Test::More 0.99; +use Test::More 0.88; use TestBridge; use IO::Dir; use File::Spec::Functions qw/catdir/; diff --git a/cpan/CPAN-Meta-YAML/t/32_world_tml.t b/cpan/CPAN-Meta-YAML/t/32_world_tml.t index 5dcca9a..11b785a 100644 --- a/cpan/CPAN-Meta-YAML/t/32_world_tml.t +++ b/cpan/CPAN-Meta-YAML/t/32_world_tml.t @@ -1,7 +1,7 @@ use strict; use warnings; use lib 't/lib/'; -use Test::More 0.99; +use Test::More 0.88; use TestBridge; run_all_testml_files( diff --git a/cpan/CPAN-Meta-YAML/t/README.md b/cpan/CPAN-Meta-YAML/t/README.md index e95ebfe..56450af 100644 --- a/cpan/CPAN-Meta-YAML/t/README.md +++ b/cpan/CPAN-Meta-YAML/t/README.md @@ -19,10 +19,8 @@ of those modules as necessary to avoid known bugs. Some .t files have complete inputs/outputs for their tests. Others iterate over .tml files in the t/tml-* directories. -A .t file should load Test::More and either use `done_testing` or provide a -test plan. If tests iterate over external data, the use of `done_testing` is -preferred so that external data can be updated with new tests without needing -to also update a test plan. +A .t file should load Test::More and use `done_testing` at the end +to so that new tests may be added without needing to also update a test plan. Currently, the convention is to name .t files matching the pattern qr/^\d\d_\w+\.t$/ @@ -35,10 +33,16 @@ libraries can assume that if they were loaded, that 't/lib' is already in @INC. The test libraries are: +* SubtestCompat * TestML::Tiny * TestBridge * TestUtils +The "SubtestCompat" library provides a limited emulation of +Test::More::subtest that is reasonably compatible back to 0.88. If using +subtests, you must not set a plan in the subtest and you must use +done_testing in the *.t file. + The TestML::Tiny library contains functions for parsing and executing TestML tests with callbacks. TestML is a data-driven testing language; TestML::Tiny implements a small subset of its features. See the section on TestML, below, diff --git a/cpan/CPAN-Meta-YAML/t/lib/SubtestCompat.pm b/cpan/CPAN-Meta-YAML/t/lib/SubtestCompat.pm new file mode 100644 index 0000000..17b3953 --- /dev/null +++ b/cpan/CPAN-Meta-YAML/t/lib/SubtestCompat.pm @@ -0,0 +1,66 @@ +use 5.008001; +use strict; +use warnings; + +package SubtestCompat; + +# XXX must be used with no_plan or done_testing +use Test::More 0.88; + +use base 'Exporter'; +our @EXPORT; + +our $INDENT = -2; + +# intercept 'skip_all' in subtest and turn into a regular skip +sub _fake_plan { + my ( $self, $cmd, $arg ) = @_; + + return unless $cmd; + + if ( $cmd eq 'skip_all' ) { + die bless { reason => $arg }, "Subtest::SKIP"; + } + else { + goto &Test::Builder::plan; + } +} + +unless ( Test::More->can("subtest") ) { + *subtest = sub { + my ( $label, $code ) = @_; + local $Test::Builder::Level = $Test::Builder::Level + 1; + + local $INDENT = $INDENT + 2; + + $label = "TEST: $label"; + my $sep_len = 60 - length($label); + + note( " " x $INDENT . "$label { " . ( " " x ($sep_len-$INDENT-2) ) ); + eval { + no warnings 'redefine'; + local *Test::Builder::plan = \&_fake_plan; + # only want subtest error reporting to look up to the code ref + # for where test was called, not further up to *our* callers, + # so we *reset* the Level, rather than increment it + local $Test::Builder::Level = 1; + $code->(); + }; + if ( my $err = $@ ) { + if ( ref($err) eq 'Subtest::SKIP' ) { + SKIP: { + skip $err->{reason}, 1; + } + } + else { + fail("SUBTEST: $label"); + diag("Caught exception: $err"); + die "$err\n"; + } + } + note( " " x $INDENT . "}" ); + }; + push @EXPORT, 'subtest'; +} + +1; diff --git a/cpan/CPAN-Meta-YAML/t/lib/TestBridge.pm b/cpan/CPAN-Meta-YAML/t/lib/TestBridge.pm index eb2ebe7..70f7d40 100644 --- a/cpan/CPAN-Meta-YAML/t/lib/TestBridge.pm +++ b/cpan/CPAN-Meta-YAML/t/lib/TestBridge.pm @@ -2,8 +2,9 @@ package TestBridge; use strict; use warnings; - -use Test::More 0.99; +use lib 't/lib'; +use Test::More 0.88; +use SubtestCompat; use TestUtils; use TestML::Tiny; @@ -51,8 +52,7 @@ my %WARN = ( # run_all_testml_files # # Iterate over all .tml files in a directory using a particular test bridge -# code # reference. Each file is wrapped in a subtest with a test plan -# equal to the number of blocks. +# code # reference. Each file is wrapped in a subtest. #--------------------------------------------------------------------------# sub run_all_testml_files { @@ -61,7 +61,6 @@ sub run_all_testml_files { my $code = sub { my ($file, $blocks) = @_; subtest "$label: $file" => sub { - plan tests => scalar @$blocks; $bridge->($_, @args) for @$blocks; }; }; diff --git a/cpan/CPAN-Meta-YAML/t/lib/TestML/Tiny.pm b/cpan/CPAN-Meta-YAML/t/lib/TestML/Tiny.pm index 5a3df6f..1056e07 100644 --- a/cpan/CPAN-Meta-YAML/t/lib/TestML/Tiny.pm +++ b/cpan/CPAN-Meta-YAML/t/lib/TestML/Tiny.pm @@ -4,7 +4,7 @@ package TestML::Tiny; ; # original $VERSION removed by Doppelgaenger use Carp(); -use Test::More 0.99 (); +use Test::More 0.88 (); # use XXX; diff --git a/cpan/CPAN-Meta-YAML/t/tml b/cpan/CPAN-Meta-YAML/t/tml index d4e3fe7..cdcb9ca 100755 --- a/cpan/CPAN-Meta-YAML/t/tml +++ b/cpan/CPAN-Meta-YAML/t/tml @@ -2,7 +2,8 @@ use strict; use warnings; use lib 'lib', 't/lib/'; -use Test::More 0.99; +use Test::More 0.88; +use SubtestCompat; use Getopt::Long qw/:config passthrough/; use List::Util qw/first/; use TestBridge; @@ -42,7 +43,6 @@ sub main { sub { my ($file, $blocks) = @_; subtest "TestML dev runner: $file" => sub { - plan tests => scalar @$blocks; $BRIDGE_MAP{$bridge}->($_) for @$blocks; }; done_testing; diff --git a/cpan/Encode/Encode.pm b/cpan/Encode/Encode.pm index e94b3e9..1fea02b 100644 --- a/cpan/Encode/Encode.pm +++ b/cpan/Encode/Encode.pm @@ -1,10 +1,10 @@ # -# $Id: Encode.pm,v 2.75 2015/06/30 09:57:15 dankogai Exp $ +# $Id: Encode.pm,v 2.76 2015/07/31 02:17:53 dankogai Exp $ # package Encode; use strict; use warnings; -our $VERSION = sprintf "%d.%02d", q$Revision: 2.75 $ =~ /(\d+)/g; +our $VERSION = sprintf "%d.%02d", q$Revision: 2.76 $ =~ /(\d+)/g; use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG}; use XSLoader (); XSLoader::load( __PACKAGE__, $VERSION ); diff --git a/cpan/Encode/ucm/koi8-u.ucm b/cpan/Encode/ucm/koi8-u.ucm index d92df5a..c955083 100644 --- a/cpan/Encode/ucm/koi8-u.ucm +++ b/cpan/Encode/ucm/koi8-u.ucm @@ -1,11 +1,11 @@ # -# $Id: koi8-u.ucm,v 2.1 2013/08/14 02:29:54 dankogai Exp $ +# $Id: koi8-u.ucm,v 2.2 2015/07/31 02:18:28 dankogai Exp dankogai $ # -# Written $Id: koi8-u.ucm,v 2.1 2013/08/14 02:29:54 dankogai Exp $ +# Written $Id: koi8-u.ucm,v 2.2 2015/07/31 02:18:28 dankogai Exp dankogai $ # ./compile -n koi8-u -o Encode/koi8-u.ucm Encode/koi8-u.enc # # Original table can be obtained at -# http://www.unicode.org/Public/MAPPINGS/VENDORS/MISC/KOI8-R.TXT +# http://www.unicode.org/Public/MAPPINGS/VENDORS/MISC/KOI8-U.TXT # # Copyright (c) 1991-2008 Unicode, Inc. All Rights reserved. # @@ -178,7 +178,7 @@ CHARMAP \x92 |0 # DARK SHADE \x93 |0 # TOP HALF INTEGRAL \x94 |0 # BLACK SQUARE - \x95 |0 # BULLET + \x95 |0 # BULLET OPERATOR \x96 |0 # SQUARE ROOT \x97 |0 # ALMOST EQUAL TO \x98 |0 # LESS-THAN OR EQUAL TO diff --git a/cpan/Filter-Util-Call/Call.pm b/cpan/Filter-Util-Call/Call.pm index f282a15..8b4d41a 100644 --- a/cpan/Filter-Util-Call/Call.pm +++ b/cpan/Filter-Util-Call/Call.pm @@ -1,7 +1,7 @@ - # Call.pm # # Copyright (c) 1995-2011 Paul Marquess. All rights reserved. +# Copyright (c) 2011-2014 Reini Urban. All rights reserved. # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. @@ -18,7 +18,7 @@ use vars qw($VERSION @ISA @EXPORT) ; @ISA = qw(Exporter DynaLoader); @EXPORT = qw( filter_add filter_del filter_read filter_read_exact) ; -$VERSION = "1.54" ; +$VERSION = "1.55" ; sub filter_read_exact($) { @@ -292,6 +292,29 @@ See L for details. Internal function which adds the filter, based on the L argument type. +=item I + +May be used to disable a filter, but is rarely needed. See L. + +=back + +=head1 LIMITATIONS + +See L for an overview of the general problems +filtering code in a textual line-level only. + +=over + +=item __DATA__ is ignored + +The content from the __DATA__ block is not filtered. +This is a serious limitation, e.g. for the L module. +See L for more. + +=item Max. codesize limited to 32-bit + +Currently internal buffer lengths are limited to 32-bit only. + =back =head1 EXAMPLES diff --git a/cpan/Filter-Util-Call/Call.xs b/cpan/Filter-Util-Call/Call.xs index fd79c57..97280d7 100644 --- a/cpan/Filter-Util-Call/Call.xs +++ b/cpan/Filter-Util-Call/Call.xs @@ -3,7 +3,7 @@ * * Author : Paul Marquess * Date : 2014-12-09 02:48:44 rurban - * Version : 1.54 + * Version : 1.55 * * Copyright (c) 1995-2011 Paul Marquess. All rights reserved. * Copyright (c) 2011-2014 Reini Urban. All rights reserved. @@ -131,19 +131,15 @@ filter_call(pTHX_ int idx, SV *buf_sv, int maxlen) DEFSV_set(newSVpv("", 0)) ; PUSHMARK(sp) ; - if (CODE_REF(my_sv)) { /* if (SvROK(PERL_OBJECT(my_sv)) && SvTYPE(SvRV(PERL_OBJECT(my_sv))) == SVt_PVCV) { */ count = perl_call_sv((SV*)PERL_OBJECT(my_sv), G_SCALAR); } else { XPUSHs((SV*)PERL_OBJECT(my_sv)) ; - PUTBACK ; - count = perl_call_method("filter", G_SCALAR); } - SPAGAIN ; if (count != 1) diff --git a/cpan/Filter-Util-Call/filter-util.pl b/cpan/Filter-Util-Call/filter-util.pl index 1bc3bfb..44e8b1e 100644 --- a/cpan/Filter-Util-Call/filter-util.pl +++ b/cpan/Filter-Util-Call/filter-util.pl @@ -9,8 +9,8 @@ sub readFile my ($filename) = @_ ; my ($string) = '' ; - open (F, "<$filename") - or die "Cannot open $filename: $!\n" ; + open (F, "<", $filename) + or die "Cannot read $filename: $!\n" ; while () { $string .= $_ } close F ; @@ -20,8 +20,8 @@ sub readFile sub writeFile { my($filename, @strings) = @_ ; - open (F, ">$filename") - or die "Cannot open $filename: $!\n" ; + open (F, ">", $filename) + or die "Cannot write $filename: $!\n" ; binmode(F) if $filename =~ /bin$/i; foreach (@strings) { print F } diff --git a/cpan/Filter-Util-Call/t/rt_101033.pm b/cpan/Filter-Util-Call/t/rt_101033.pm new file mode 100644 index 0000000..526a97c --- /dev/null +++ b/cpan/Filter-Util-Call/t/rt_101033.pm @@ -0,0 +1,27 @@ +package rt_101033; + +use strict; +use Filter::Util::Call; + +sub import +{ + filter_add({}); + 1; +} + +sub unimport +{ + filter_del() +} + +sub filter +{ + my($self) = @_ ; + my $status = 1; + $status = filter_read(1_000_000); + #print "code: !$_!\n\n"; + return $status; +} + +1; + diff --git a/cpan/Filter-Util-Call/t/rt_101033.t b/cpan/Filter-Util-Call/t/rt_101033.t new file mode 100644 index 0000000..4df3614 --- /dev/null +++ b/cpan/Filter-Util-Call/t/rt_101033.t @@ -0,0 +1,11 @@ +#! perl +use lib 't'; +use rt_101033; + +print "1..1\n"; +my $s = ; +print "not " if $s !~ /^test/; +print "ok 1 # TODO RT #101033 + Switch #97440 ignores __DATA__\n"; + +__DATA__ +test diff --git a/cpan/Term-Cap/Cap.pm b/cpan/Term-Cap/Cap.pm index 9a70251..12d8299 100644 --- a/cpan/Term-Cap/Cap.pm +++ b/cpan/Term-Cap/Cap.pm @@ -19,51 +19,8 @@ use strict; use vars qw($VERSION $VMS_TERMCAP); use vars qw($termpat $state $first $entry); -$VERSION = '1.15'; - -# Version undef: Thu Dec 14 20:02:42 CST 1995 by sanders@bsdi.com -# Version 1.00: Thu Nov 30 23:34:29 EST 2000 by schwern@pobox.com -# [PATCH] $VERSION crusade, strict, tests, etc... all over lib/ -# Version 1.01: Wed May 23 00:00:00 CST 2001 by d-lewart@uiuc.edu -# Avoid warnings in Tgetent and Tputs -# Version 1.02: Sat Nov 17 13:50:39 GMT 2001 by jns@gellyfish.com -# Altered layout of the POD -# Added Test::More to PREREQ_PM in Makefile.PL -# Fixed no argument Tgetent() -# Version 1.03: Wed Nov 28 10:09:38 GMT 2001 -# VMS Support from Charles Lane -# Version 1.04: Thu Nov 29 16:22:03 GMT 2001 -# Fixed warnings in test -# Version 1.05: Mon Dec 3 15:33:49 GMT 2001 -# Don't try to fall back on infocmp if it's not there. From chromatic. -# Version 1.06: Thu Dec 6 18:43:22 GMT 2001 -# Preload the default VMS termcap from Charles Lane -# Don't carp at setting OSPEED unless warnings are on. -# Version 1.07: Wed Jan 2 21:35:09 GMT 2002 -# Sanity check on infocmp output from Norton Allen -# Repaired INSTALLDIRS thanks to Michael Schwern -# Version 1.08: Sat Sep 28 11:33:15 BST 2002 -# Late loading of 'Carp' as per Michael Schwern -# Version 1.09: Tue Apr 20 12:06:51 BST 2004 -# Merged in changes from and to Core -# Core (Fri Aug 30 14:15:55 CEST 2002): -# Cope with comments lines from 'infocmp' from Brendan O'Dea -# Allow for EBCDIC in Tgoto magic test. -# Version 1.10: Thu Oct 18 16:52:20 BST 2007 -# Don't use try to use $ENV{HOME} if it doesn't exist -# Give Win32 'dumb' if TERM isn't set -# Provide fallback 'dumb' termcap entry as last resort -# Version 1.11: Thu Oct 25 09:33:07 BST 2007 -# EBDIC fixes from Chun Bing Ge -# Version 1.12: Sat Dec 8 00:10:21 GMT 2007 -# QNX test fix from Matt Kraai -# Version 1.13: Thu Dec 22 22:21:09 GMT 2011 -# POD error fix from Domin Hargreaves -# Version 1.14 Sat Oct 26 19:16:38 BST 2013 -# Applied all patches from RT and updated contact details -# Version 1.15 Sat Oct 26 21:32:24 BST 2013 -# Metadata change from David Steinbrunner -# Forgot to update the email somewhere +$VERSION = '1.17'; + # TODO: # support Berkeley DB termcaps # force $FH into callers package? @@ -279,7 +236,7 @@ sub Tgetent my @termcap_path = termcap_path(); - unless ( @termcap_path || $entry ) + if ( !@termcap_path && !$entry ) { # last resort--fake up a termcap from terminfo @@ -405,25 +362,25 @@ sub Tgetent $entry =~ s/^[^:]*://; foreach $field ( split( /:[\s:\\]*/, $entry ) ) { - if ( defined $field && $field =~ /^(\w\w)$/ ) + if ( defined $field && $field =~ /^(\w{2,})$/ ) { $self->{ '_' . $field } = 1 unless defined $self->{ '_' . $1 }; # print STDERR "DEBUG: flag $1\n"; } - elsif ( defined $field && $field =~ /^(\w\w)\@/ ) + elsif ( defined $field && $field =~ /^(\w{2,})\@/ ) { $self->{ '_' . $1 } = ""; # print STDERR "DEBUG: unset $1\n"; } - elsif ( defined $field && $field =~ /^(\w\w)#(.*)/ ) + elsif ( defined $field && $field =~ /^(\w{2,})#(.*)/ ) { $self->{ '_' . $1 } = $2 unless defined $self->{ '_' . $1 }; # print STDERR "DEBUG: numeric $1 = $2\n"; } - elsif ( defined $field && $field =~ /^(\w\w)=(.*)/ ) + elsif ( defined $field && $field =~ /^(\w{2,})=(.*)/ ) { # print STDERR "DEBUG: string $1 = $2\n"; @@ -770,7 +727,13 @@ sub Trequire =head1 COPYRIGHT AND LICENSE -Please see the README file in distribution. +Copyright 1995-2015 (c) perl5 porters. + +This software is free software and can be modified and distributed under +the same terms as Perl itself. + +Please see the file README in the Perl source distribution for details of +the Perl license. =head1 AUTHOR diff --git a/cpan/perlfaq/lib/perlfaq.pm b/cpan/perlfaq/lib/perlfaq.pm index 8fc808a..0be9c18 100644 --- a/cpan/perlfaq/lib/perlfaq.pm +++ b/cpan/perlfaq/lib/perlfaq.pm @@ -1,5 +1,5 @@ use strict; use warnings; package perlfaq; -$perlfaq::VERSION = '5.021009'; +$perlfaq::VERSION = '5.021010'; 1; diff --git a/cpan/perlfaq/lib/perlfaq.pod b/cpan/perlfaq/lib/perlfaq.pod index 9ffec6f..5be2f6d 100644 --- a/cpan/perlfaq/lib/perlfaq.pod +++ b/cpan/perlfaq/lib/perlfaq.pod @@ -4,7 +4,7 @@ perlfaq - frequently asked questions about Perl =head1 VERSION -version 5.021009 +version 5.021010 =head1 DESCRIPTION diff --git a/cpan/perlfaq/lib/perlfaq1.pod b/cpan/perlfaq/lib/perlfaq1.pod index fb52cd3..c2c793e 100644 --- a/cpan/perlfaq/lib/perlfaq1.pod +++ b/cpan/perlfaq/lib/perlfaq1.pod @@ -4,7 +4,7 @@ perlfaq1 - General Questions About Perl =head1 VERSION -version 5.021009 +version 5.021010 =head1 DESCRIPTION diff --git a/cpan/perlfaq/lib/perlfaq2.pod b/cpan/perlfaq/lib/perlfaq2.pod index d4f81b0..4c652db 100644 --- a/cpan/perlfaq/lib/perlfaq2.pod +++ b/cpan/perlfaq/lib/perlfaq2.pod @@ -4,7 +4,7 @@ perlfaq2 - Obtaining and Learning about Perl =head1 VERSION -version 5.021009 +version 5.021010 =head1 DESCRIPTION diff --git a/cpan/perlfaq/lib/perlfaq3.pod b/cpan/perlfaq/lib/perlfaq3.pod index 9411862..78a2bab 100644 --- a/cpan/perlfaq/lib/perlfaq3.pod +++ b/cpan/perlfaq/lib/perlfaq3.pod @@ -4,7 +4,7 @@ perlfaq3 - Programming Tools =head1 VERSION -version 5.021009 +version 5.021010 =head1 DESCRIPTION diff --git a/cpan/perlfaq/lib/perlfaq4.pod b/cpan/perlfaq/lib/perlfaq4.pod index 6645aac..f6bf2ca 100644 --- a/cpan/perlfaq/lib/perlfaq4.pod +++ b/cpan/perlfaq/lib/perlfaq4.pod @@ -4,7 +4,7 @@ perlfaq4 - Data Manipulation =head1 VERSION -version 5.021009 +version 5.021010 =head1 DESCRIPTION @@ -490,7 +490,7 @@ operators so you can compare them directly: You can also get differences with a subtraction, which returns a L object: - my $diff = $date1 - $date2; + my $date_diff = $date1 - $date2; print "The difference is ", $date_diff->days, " days\n"; If you want to work with formatted dates, the L, diff --git a/cpan/perlfaq/lib/perlfaq5.pod b/cpan/perlfaq/lib/perlfaq5.pod index 9550e58..cbb73c7 100644 --- a/cpan/perlfaq/lib/perlfaq5.pod +++ b/cpan/perlfaq/lib/perlfaq5.pod @@ -4,7 +4,7 @@ perlfaq5 - Files and Formats =head1 VERSION -version 5.021009 +version 5.021010 =head1 DESCRIPTION diff --git a/cpan/perlfaq/lib/perlfaq6.pod b/cpan/perlfaq/lib/perlfaq6.pod index 2cc1af5..c889ca4 100644 --- a/cpan/perlfaq/lib/perlfaq6.pod +++ b/cpan/perlfaq/lib/perlfaq6.pod @@ -4,7 +4,7 @@ perlfaq6 - Regular Expressions =head1 VERSION -version 5.021009 +version 5.021010 =head1 DESCRIPTION diff --git a/cpan/perlfaq/lib/perlfaq7.pod b/cpan/perlfaq/lib/perlfaq7.pod index 3a1238c..fb67736 100644 --- a/cpan/perlfaq/lib/perlfaq7.pod +++ b/cpan/perlfaq/lib/perlfaq7.pod @@ -4,7 +4,7 @@ perlfaq7 - General Perl Language Issues =head1 VERSION -version 5.021009 +version 5.021010 =head1 DESCRIPTION diff --git a/cpan/perlfaq/lib/perlfaq8.pod b/cpan/perlfaq/lib/perlfaq8.pod index c5a1604..3bbd459 100644 --- a/cpan/perlfaq/lib/perlfaq8.pod +++ b/cpan/perlfaq/lib/perlfaq8.pod @@ -4,7 +4,7 @@ perlfaq8 - System Interaction =head1 VERSION -version 5.021009 +version 5.021010 =head1 DESCRIPTION @@ -204,7 +204,7 @@ method returns the string for the given capability: use Term::Cap; my $terminal = Term::Cap->Tgetent( { OSPEED => 9600 } ); - my $clear_string = $terminal->Tputs('cl'); + my $clear_screen = $terminal->Tputs('cl'); print $clear_screen; diff --git a/cpan/perlfaq/lib/perlfaq9.pod b/cpan/perlfaq/lib/perlfaq9.pod index ea9a55e..bc68746 100644 --- a/cpan/perlfaq/lib/perlfaq9.pod +++ b/cpan/perlfaq/lib/perlfaq9.pod @@ -4,7 +4,7 @@ perlfaq9 - Web, Email and Networking =head1 VERSION -version 5.021009 +version 5.021010 =head1 DESCRIPTION diff --git a/cpan/perlfaq/lib/perlglossary.pod b/cpan/perlfaq/lib/perlglossary.pod index 7db2bb3..76a54f0 100644 --- a/cpan/perlfaq/lib/perlglossary.pod +++ b/cpan/perlfaq/lib/perlglossary.pod @@ -7,7 +7,7 @@ perlglossary - Perl Glossary =head1 VERSION -version 5.021009 +version 5.021010 =head1 DESCRIPTION diff --git a/dist/Attribute-Handlers/Changes b/dist/Attribute-Handlers/Changes index f81a472..6278c9a 100644 --- a/dist/Attribute-Handlers/Changes +++ b/dist/Attribute-Handlers/Changes @@ -172,3 +172,6 @@ t Revision history for Perl extension Attribute-Handlers 0.97 Sun Jun 1 12:00:00 GMT 2015 - fixes to deal with CVs without GVs + +0.99 Fri Jul 24 18:44:48 EDT 2015 + - CPAN release of v0.97 code diff --git a/dist/Attribute-Handlers/lib/Attribute/Handlers.pm b/dist/Attribute-Handlers/lib/Attribute/Handlers.pm index 17c4bb7..7c049d4 100644 --- a/dist/Attribute-Handlers/lib/Attribute/Handlers.pm +++ b/dist/Attribute-Handlers/lib/Attribute/Handlers.pm @@ -4,7 +4,7 @@ use Carp; use warnings; use strict; use vars qw($VERSION $AUTOLOAD); -$VERSION = '0.97'; # remember to update version in POD! +$VERSION = '0.99'; # remember to update version in POD! # $DB::single=1; my %symcache; @@ -270,7 +270,7 @@ Attribute::Handlers - Simpler definition of attribute handlers =head1 VERSION -This document describes version 0.97 of Attribute::Handlers. +This document describes version 0.99 of Attribute::Handlers. =head1 SYNOPSIS diff --git a/dist/Carp/Makefile.PL b/dist/Carp/Makefile.PL index 05aabd3..7aa6132 100644 --- a/dist/Carp/Makefile.PL +++ b/dist/Carp/Makefile.PL @@ -14,7 +14,7 @@ WriteMakefile( "IPC::Open3" => "1.0103", "Test::More" => 0, "overload" => 0, - "parent" => 0, + "parent" => 0.217, "strict" => 0, "warnings" => 0, }, diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index 0987500..8b4d7cf 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -11,7 +11,7 @@ use Symbol; our $VERSION; BEGIN { - $VERSION = '3.28'; + $VERSION = '3.29'; } use ExtUtils::ParseXS::Constants $VERSION; use ExtUtils::ParseXS::CountLines $VERSION; @@ -1577,6 +1577,25 @@ sub QuoteArgs { return join (' ', ($cmd, @args)); } +# code copied from CPAN::HandleConfig::safe_quote +# - that has doc saying leave if start/finish with same quote, but no code +# given text, will conditionally quote it to protect from shell +{ + my ($quote, $use_quote) = $^O eq 'MSWin32' + ? (q{"}, q{"}) + : (q{"'}, q{'}); + sub _safe_quote { + my ($self, $command) = @_; + # Set up quote/default quote + if (defined($command) + and $command =~ /\s/ + and $command !~ /[$quote]/) { + return qq{$use_quote$command$use_quote} + } + return $command; + } +} + sub INCLUDE_COMMAND_handler { my $self = shift; $_ = shift; @@ -1598,7 +1617,8 @@ sub INCLUDE_COMMAND_handler { # If $^X is used in INCLUDE_COMMAND, we know it's supposed to be # the same perl interpreter as we're currently running - s/^\s*\$\^X/$^X/; + my $X = $self->_safe_quote($^X); # quotes if has spaces + s/^\s*\$\^X/$X/; # open the new file open ($self->{FH}, "-|", $_) diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm index 5603613..7ea1a82 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm @@ -3,7 +3,7 @@ use strict; use warnings; use Symbol; -our $VERSION = '3.28'; +our $VERSION = '3.29'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm index b30812c..6724522 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm @@ -1,7 +1,7 @@ package ExtUtils::ParseXS::CountLines; use strict; -our $VERSION = '3.28'; +our $VERSION = '3.29'; our $SECTION_END_MARKER; diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm index b4f41cb..f85740d 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm @@ -2,7 +2,7 @@ package ExtUtils::ParseXS::Eval; use strict; use warnings; -our $VERSION = '3.28'; +our $VERSION = '3.29'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm index 37094cb..a5920fd 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm @@ -5,7 +5,7 @@ use Exporter; use File::Spec; use ExtUtils::ParseXS::Constants (); -our $VERSION = '3.28'; +our $VERSION = '3.29'; our (@ISA, @EXPORT_OK); @ISA = qw(Exporter); diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm index f9b568d..98cb34a 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/Typemaps.pm @@ -2,7 +2,7 @@ package ExtUtils::Typemaps; use 5.006001; use strict; use warnings; -our $VERSION = '3.28'; +our $VERSION = '3.29'; require ExtUtils::ParseXS; require ExtUtils::ParseXS::Constants; diff --git a/dist/Module-CoreList/Changes b/dist/Module-CoreList/Changes index d5cb688..deb3ddb 100644 --- a/dist/Module-CoreList/Changes +++ b/dist/Module-CoreList/Changes @@ -1,3 +1,6 @@ +5.20150820 + - Updated for v5.23.2 + 5.20150720 - Updated for v5.23.1 diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index 2cea131..266dbba 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -4,7 +4,7 @@ use vars qw/$VERSION %released %version %families %upstream %bug_tracker %deprecated %delta/; use Module::CoreList::TieHashDelta; use version; -$VERSION = '5.20150720'; +$VERSION = '5.20150820'; sub _released_order { # Sort helper, to make '?' sort after everything else (substr($released{$a}, 0, 1) eq "?") @@ -281,6 +281,7 @@ sub changes_between { 5.022000 => '2015-06-01', 5.023000 => '2015-06-20', 5.023001 => '2015-07-20', + 5.023002 => '2015-08-20', ); for my $version ( sort { $a <=> $b } keys %released ) { @@ -11651,6 +11652,44 @@ for my $version ( sort { $a <=> $b } keys %released ) { 'autodie::ScopeUtil' => 1, } }, + 5.023002 => { + delta_from => 5.023001, + changed => { + 'Attribute::Handlers' => '0.99', + 'B::Op_private' => '5.023002', + 'CPAN::Meta::YAML' => '0.017', + 'Config' => '5.023002', + 'Cwd' => '3.57', + 'Encode' => '2.76', + 'ExtUtils::ParseXS' => '3.29', + 'ExtUtils::ParseXS::Constants'=> '3.29', + 'ExtUtils::ParseXS::CountLines'=> '3.29', + 'ExtUtils::ParseXS::Eval'=> '3.29', + 'ExtUtils::ParseXS::Utilities'=> '3.29', + 'ExtUtils::Typemaps' => '3.29', + 'File::Find' => '1.30', + 'File::Spec' => '3.57', + 'File::Spec::Cygwin' => '3.57', + 'File::Spec::Epoc' => '3.57', + 'File::Spec::Functions' => '3.57', + 'File::Spec::Mac' => '3.57', + 'File::Spec::OS2' => '3.57', + 'File::Spec::Unix' => '3.57', + 'File::Spec::VMS' => '3.57', + 'File::Spec::Win32' => '3.57', + 'Filter::Util::Call' => '1.55', + 'Hash::Util' => '0.19', + 'Module::CoreList' => '5.20150820', + 'Module::CoreList::TieHashDelta'=> '5.20150820', + 'Module::CoreList::Utils'=> '5.20150820', + 'POSIX' => '1.56', + 'Term::Cap' => '1.17', + 'Unicode::UCD' => '0.62', + 'perlfaq' => '5.021010', + }, + removed => { + } + }, ); sub is_core @@ -12221,6 +12260,13 @@ for my $version (sort { $a <=> $b } keys %delta) { removed => { } }, + 5.023002 => { + delta_from => 5.023001, + changed => { + }, + removed => { + } + }, ); for my $version (sort { $a <=> $b } keys %deprecated) { diff --git a/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm b/dist/Module-CoreList/lib/Module/CoreList/TieHashDelta.pm index f60f5cd..1f2c8ab 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.20150720'; +$VERSION = '5.20150820'; 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 3141a87..bfc1800 100644 --- a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm +++ b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm @@ -6,7 +6,7 @@ use vars qw[$VERSION %utilities]; use Module::CoreList; use Module::CoreList::TieHashDelta; -$VERSION = '5.20150720'; +$VERSION = '5.20150820'; sub utilities { my $perl = shift; @@ -1066,6 +1066,13 @@ my %delta = ( removed => { } }, + 5.023002 => { + delta_from => 5.023001, + changed => { + }, + removed => { + } + }, ); for my $version (sort { $a <=> $b } keys %delta) { diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm index 49cc4c1..0765de4 100644 --- a/dist/PathTools/Cwd.pm +++ b/dist/PathTools/Cwd.pm @@ -3,7 +3,7 @@ use strict; use Exporter; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); -$VERSION = '3.56'; +$VERSION = '3.57'; my $xs_version = $VERSION; $VERSION =~ tr/_//; @@ -600,20 +600,23 @@ sub _vms_abs_path { } sub _os2_cwd { - $ENV{'PWD'} = `cmd /c cd`; - chomp $ENV{'PWD'}; - $ENV{'PWD'} =~ s:\\:/:g ; - return $ENV{'PWD'}; + my $pwd = `cmd /c cd`; + chomp $pwd; + $pwd =~ s:\\:/:g ; + $ENV{'PWD'} = $pwd; + return $pwd; } sub _win32_cwd_simple { - $ENV{'PWD'} = `cd`; - chomp $ENV{'PWD'}; - $ENV{'PWD'} =~ s:\\:/:g ; - return $ENV{'PWD'}; + my $pwd = `cd`; + chomp $pwd; + $pwd =~ s:\\:/:g ; + $ENV{'PWD'} = $pwd; + return $pwd; } sub _win32_cwd { + my $pwd; # Need to avoid taking any sort of reference to the typeglob or the code in # the optree, so that this tests the runtime state of things, as the # ExtUtils::MakeMaker tests for "miniperl" need to be able to fake things at @@ -622,35 +625,38 @@ sub _win32_cwd { # problems (for reasons that we haven't been able to get to the bottom of - # rt.cpan.org #56225) if (*{$DynaLoader::{boot_DynaLoader}}{CODE}) { - $ENV{'PWD'} = Win32::GetCwd(); + $pwd = Win32::GetCwd(); } else { # miniperl - chomp($ENV{'PWD'} = `cd`); + chomp($pwd = `cd`); } - $ENV{'PWD'} =~ s:\\:/:g ; - return $ENV{'PWD'}; + $pwd =~ s:\\:/:g ; + $ENV{'PWD'} = $pwd; + return $pwd; } *_NT_cwd = defined &Win32::GetCwd ? \&_win32_cwd : \&_win32_cwd_simple; sub _dos_cwd { + my $pwd; if (!defined &Dos::GetCwd) { - $ENV{'PWD'} = `command /c cd`; - chomp $ENV{'PWD'}; - $ENV{'PWD'} =~ s:\\:/:g ; + chomp($pwd = `command /c cd`); + $pwd =~ s:\\:/:g ; } else { - $ENV{'PWD'} = Dos::GetCwd(); + $pwd = Dos::GetCwd(); } - return $ENV{'PWD'}; + $ENV{'PWD'} = $pwd; + return $pwd; } sub _qnx_cwd { local $ENV{PATH} = ''; local $ENV{CDPATH} = ''; local $ENV{ENV} = ''; - $ENV{'PWD'} = `/usr/bin/fullpath -t`; - chomp $ENV{'PWD'}; - return $ENV{'PWD'}; + my $pwd = `/usr/bin/fullpath -t`; + chomp $pwd; + $ENV{'PWD'} = $pwd; + return $pwd; } sub _qnx_abs_path { @@ -669,8 +675,7 @@ sub _qnx_abs_path { } sub _epoc_cwd { - $ENV{'PWD'} = EPOC::getcwd(); - return $ENV{'PWD'}; + return $ENV{'PWD'} = EPOC::getcwd(); } diff --git a/dist/PathTools/lib/File/Spec.pm b/dist/PathTools/lib/File/Spec.pm index 8c77c98..2f35526 100644 --- a/dist/PathTools/lib/File/Spec.pm +++ b/dist/PathTools/lib/File/Spec.pm @@ -3,7 +3,7 @@ package File::Spec; use strict; use vars qw(@ISA $VERSION); -$VERSION = '3.56'; +$VERSION = '3.57'; $VERSION =~ tr/_//; my %module = (MacOS => 'Mac', diff --git a/dist/PathTools/lib/File/Spec/Cygwin.pm b/dist/PathTools/lib/File/Spec/Cygwin.pm index 1b77e6a..e5839e9 100644 --- a/dist/PathTools/lib/File/Spec/Cygwin.pm +++ b/dist/PathTools/lib/File/Spec/Cygwin.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.56'; +$VERSION = '3.57'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Epoc.pm b/dist/PathTools/lib/File/Spec/Epoc.pm index 7bc3867..390a641 100644 --- a/dist/PathTools/lib/File/Spec/Epoc.pm +++ b/dist/PathTools/lib/File/Spec/Epoc.pm @@ -3,7 +3,7 @@ package File::Spec::Epoc; use strict; use vars qw($VERSION @ISA); -$VERSION = '3.56'; +$VERSION = '3.57'; $VERSION =~ tr/_//; require File::Spec::Unix; diff --git a/dist/PathTools/lib/File/Spec/Functions.pm b/dist/PathTools/lib/File/Spec/Functions.pm index 8eafe24..5c2cec0 100644 --- a/dist/PathTools/lib/File/Spec/Functions.pm +++ b/dist/PathTools/lib/File/Spec/Functions.pm @@ -5,7 +5,7 @@ use strict; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); -$VERSION = '3.56'; +$VERSION = '3.57'; $VERSION =~ tr/_//; require Exporter; diff --git a/dist/PathTools/lib/File/Spec/Mac.pm b/dist/PathTools/lib/File/Spec/Mac.pm index 02cae14..7cc816f 100644 --- a/dist/PathTools/lib/File/Spec/Mac.pm +++ b/dist/PathTools/lib/File/Spec/Mac.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.56'; +$VERSION = '3.57'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/OS2.pm b/dist/PathTools/lib/File/Spec/OS2.pm index fb8f101..8d3951f 100644 --- a/dist/PathTools/lib/File/Spec/OS2.pm +++ b/dist/PathTools/lib/File/Spec/OS2.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.56'; +$VERSION = '3.57'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Unix.pm b/dist/PathTools/lib/File/Spec/Unix.pm index f76b29e..48e2b60 100644 --- a/dist/PathTools/lib/File/Spec/Unix.pm +++ b/dist/PathTools/lib/File/Spec/Unix.pm @@ -3,7 +3,7 @@ package File::Spec::Unix; use strict; use vars qw($VERSION); -$VERSION = '3.56'; +$VERSION = '3.57'; my $xs_version = $VERSION; $VERSION =~ tr/_//; diff --git a/dist/PathTools/lib/File/Spec/VMS.pm b/dist/PathTools/lib/File/Spec/VMS.pm index 254f524..5e4a3b3 100644 --- a/dist/PathTools/lib/File/Spec/VMS.pm +++ b/dist/PathTools/lib/File/Spec/VMS.pm @@ -4,7 +4,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.56'; +$VERSION = '3.57'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Win32.pm b/dist/PathTools/lib/File/Spec/Win32.pm index 53f3854..77e0fed 100644 --- a/dist/PathTools/lib/File/Spec/Win32.pm +++ b/dist/PathTools/lib/File/Spec/Win32.pm @@ -5,7 +5,7 @@ use strict; use vars qw(@ISA $VERSION); require File::Spec::Unix; -$VERSION = '3.56'; +$VERSION = '3.57'; $VERSION =~ tr/_//; @ISA = qw(File::Spec::Unix); diff --git a/dist/XSLoader/Makefile.PL b/dist/XSLoader/Makefile.PL index 008f602..899cc89 100644 --- a/dist/XSLoader/Makefile.PL +++ b/dist/XSLoader/Makefile.PL @@ -48,7 +48,7 @@ WriteMakefile( resources => { repository => 'git://perl5.git.perl.org/perl.git', license => 'http://dev.perl.org/licenses/', - homepage => 'https://metacpan.org/module/Math::BigInt', + homepage => 'https://metacpan.org/module/XSLoader', irc => 'irc://irc.perl.org/#p5p', mailinglist => 'http://lists.perl.org/list/perl5-porters.html', bugtracker => "https://rt.perl.org/rt3/Search/Results.html?Query=Queue='perl5' AND Content LIKE 'module=XSLoader' AND (Status='open' OR Status='new' OR Status='stalled')", diff --git a/doio.c b/doio.c index ecfe3db..39e5ce7 100644 --- a/doio.c +++ b/doio.c @@ -2522,7 +2522,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) Function called by C to spawn a glob (or do the glob inside perl on VMS). This code used to be inline, but now perl uses C this glob starter is only used by miniperl during the build process. -Moving it away shrinks pp_hot.c; shrinking pp_hot.c helps speed perl up. +Moving it away shrinks F; shrinking F helps speed perl up. =cut */ diff --git a/doop.c b/doop.c index 22e614a..19fe310 100644 --- a/doop.c +++ b/doop.c @@ -1263,8 +1263,7 @@ Perl_do_kv(pTHX) XPUSHs(sv); } if (dovalues) { - SV *tmpstr; - tmpstr = hv_iterval(keys,entry); + SV *tmpstr = hv_iterval(keys,entry); DEBUG_H(Perl_sv_setpvf(aTHX_ tmpstr, "%lu%%%d=%lu", (unsigned long)HeHASH(entry), (int)HvMAX(keys)+1, diff --git a/dquote_static.c b/dquote.c similarity index 53% rename from dquote_static.c rename to dquote.c index 885ba06..9d35f20 100644 --- a/dquote_static.c +++ b/dquote.c @@ -1,46 +1,21 @@ -/* dquote_static.c +/* dquote.c * - * This file contains static functions that are related to - * parsing double-quotish expressions, but are used in more than - * one file. + * This file contains functions that are related to + * parsing double-quotish expressions. * - * It is currently #included by regcomp.c and toke.c. */ -#define PERL_IN_DQUOTE_STATIC_C -#include "embed.h" - -/* - - regcurly - a little FSA that accepts {\d+,?\d*} - Pulled from regcomp.c. - */ -PERL_STATIC_INLINE I32 -S_regcurly(const char *s) -{ - PERL_ARGS_ASSERT_REGCURLY; - - if (*s++ != '{') - return FALSE; - if (!isDIGIT(*s)) - return FALSE; - while (isDIGIT(*s)) - s++; - if (*s == ',') { - s++; - while (isDIGIT(*s)) - s++; - } - - return *s == '}'; -} +#include "EXTERN.h" +#define PERL_IN_DQUOTE_C +#include "perl.h" /* XXX Add documentation after final interface and behavior is decided */ -/* May want to show context for error, so would pass Perl_bslash_c(pTHX_ const char* current, const char* start, const bool output_warning) +/* May want to show context for error, so would pass S_grok_bslash_c(pTHX_ const char* current, const char* start, const bool output_warning) U8 source = *current; */ -STATIC char -S_grok_bslash_c(pTHX_ const char source, const bool output_warning) +char +Perl_grok_bslash_c(pTHX_ const char source, const bool output_warning) { U8 result; @@ -79,8 +54,8 @@ S_grok_bslash_c(pTHX_ const char source, const bool output_warning) return result; } -STATIC bool -S_grok_bslash_o(pTHX_ char **s, UV *uv, const char** error_msg, +bool +Perl_grok_bslash_o(pTHX_ char **s, UV *uv, const char** error_msg, const bool output_warning, const bool strict, const bool silence_non_portable, const bool UTF) @@ -190,132 +165,8 @@ S_grok_bslash_o(pTHX_ char **s, UV *uv, const char** error_msg, return TRUE; } -PERL_STATIC_INLINE bool -S_grok_bslash_x(pTHX_ char **s, UV *uv, const char** error_msg, - const bool output_warning, const bool strict, - const bool silence_non_portable, - const bool UTF) -{ - -/* Documentation to be supplied when interface nailed down finally - * This returns FALSE if there is an error which the caller need not recover - * from; otherwise TRUE. - * It guarantees that the returned codepoint, *uv, when expressed as - * utf8 bytes, would fit within the skipped "\x{...}" bytes. - * - * On input: - * s is the address of a pointer to a NULL terminated string that begins - * with 'x', and the previous character was a backslash. At exit, *s - * will be advanced to the byte just after those absorbed by this - * function. Hence the caller can continue parsing from there. In - * the case of an error, this routine has generally positioned *s to - * point just to the right of the first bad spot, so that a message - * that has a "<--" to mark the spot will be correctly positioned. - * uv points to a UV that will hold the output value, valid only if the - * return from the function is TRUE - * error_msg is a pointer that will be set to an internal buffer giving an - * error message upon failure (the return is FALSE). Untouched if - * function succeeds - * output_warning says whether to output any warning messages, or suppress - * them - * strict is true if anything out of the ordinary should cause this to - * fail instead of warn or be silent. For example, it requires - * exactly 2 digits following the \x (when there are no braces). - * 3 digits could be a mistake, so is forbidden in this mode. - * silence_non_portable is true if to suppress warnings about the code - * point returned being too large to fit on all platforms. - * UTF is true iff the string *s is encoded in UTF-8. - */ - char* e; - STRLEN numbers_len; - I32 flags = PERL_SCAN_DISALLOW_PREFIX; -#ifdef DEBUGGING - char *start = *s - 1; - assert(*start == '\\'); -#endif - - PERL_ARGS_ASSERT_GROK_BSLASH_X; - - assert(**s == 'x'); - (*s)++; - - if (strict || ! output_warning) { - flags |= PERL_SCAN_SILENT_ILLDIGIT; - } - - if (**s != '{') { - STRLEN len = (strict) ? 3 : 2; - - *uv = grok_hex(*s, &len, &flags, NULL); - *s += len; - if (strict && len != 2) { - if (len < 2) { - *s += (UTF) ? UTF8SKIP(*s) : 1; - *error_msg = "Non-hex character"; - } - else { - *error_msg = "Use \\x{...} for more than two hex characters"; - } - return FALSE; - } - goto ok; - } - - e = strchr(*s, '}'); - if (!e) { - (*s)++; /* Move past the '{' */ - while (isXDIGIT(**s)) { /* Position beyond the legal digits */ - (*s)++; - } - /* XXX The corresponding message above for \o is just '\\o{'; other - * messages for other constructs include the '}', so are inconsistent. - */ - *error_msg = "Missing right brace on \\x{}"; - return FALSE; - } - - (*s)++; /* Point to expected first digit (could be first byte of utf8 - sequence if not a digit) */ - numbers_len = e - *s; - if (numbers_len == 0) { - if (strict) { - (*s)++; /* Move past the } */ - *error_msg = "Number with no digits"; - return FALSE; - } - *s = e + 1; - *uv = 0; - goto ok; - } - - flags |= PERL_SCAN_ALLOW_UNDERSCORES; - if (silence_non_portable) { - flags |= PERL_SCAN_SILENT_NON_PORTABLE; - } - - *uv = grok_hex(*s, &numbers_len, &flags, NULL); - /* Note that if has non-hex, will ignore everything starting with that up - * to the '}' */ - - if (strict && numbers_len != (STRLEN) (e - *s)) { - *s += numbers_len; - *s += (UTF) ? UTF8SKIP(*s) : 1; - *error_msg = "Non-hex character"; - return FALSE; - } - - /* Return past the '}' */ - *s = e + 1; - - ok: - /* guarantee replacing "\x{...}" with utf8 bytes fits within - * existing space */ - assert(OFFUNISKIP(*uv) < *s - start); - return TRUE; -} - -STATIC char* -S_form_short_octal_warning(pTHX_ +char* +Perl_form_short_octal_warning(pTHX_ const char * const s, /* Points to first non-octal */ const STRLEN len /* Length of octals string, so (s-len) points to first diff --git a/dquote_inline.h b/dquote_inline.h new file mode 100644 index 0000000..d8548bf --- /dev/null +++ b/dquote_inline.h @@ -0,0 +1,160 @@ +/* dquote_inline.h + * + * Copyright (C) 2015 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. + */ + +#ifndef DQUOTE_INLINE_H /* Guard against nested #inclusion */ +#define DQUOTE_INLINE_H + +/* + - regcurly - a little FSA that accepts {\d+,?\d*} + Pulled from reg.c. + */ +PERL_STATIC_INLINE I32 +S_regcurly(const char *s) +{ + PERL_ARGS_ASSERT_REGCURLY; + + if (*s++ != '{') + return FALSE; + if (!isDIGIT(*s)) + return FALSE; + while (isDIGIT(*s)) + s++; + if (*s == ',') { + s++; + while (isDIGIT(*s)) + s++; + } + + return *s == '}'; +} + +PERL_STATIC_INLINE bool +S_grok_bslash_x(pTHX_ char **s, UV *uv, const char** error_msg, + const bool output_warning, const bool strict, + const bool silence_non_portable, + const bool UTF) +{ + +/* Documentation to be supplied when interface nailed down finally + * This returns FALSE if there is an error which the caller need not recover + * from; otherwise TRUE. + * It guarantees that the returned codepoint, *uv, when expressed as + * utf8 bytes, would fit within the skipped "\x{...}" bytes. + * + * On input: + * s is the address of a pointer to a NULL terminated string that begins + * with 'x', and the previous character was a backslash. At exit, *s + * will be advanced to the byte just after those absorbed by this + * function. Hence the caller can continue parsing from there. In + * the case of an error, this routine has generally positioned *s to + * point just to the right of the first bad spot, so that a message + * that has a "<--" to mark the spot will be correctly positioned. + * uv points to a UV that will hold the output value, valid only if the + * return from the function is TRUE + * error_msg is a pointer that will be set to an internal buffer giving an + * error message upon failure (the return is FALSE). Untouched if + * function succeeds + * output_warning says whether to output any warning messages, or suppress + * them + * strict is true if anything out of the ordinary should cause this to + * fail instead of warn or be silent. For example, it requires + * exactly 2 digits following the \x (when there are no braces). + * 3 digits could be a mistake, so is forbidden in this mode. + * silence_non_portable is true if to suppress warnings about the code + * point returned being too large to fit on all platforms. + * UTF is true iff the string *s is encoded in UTF-8. + */ + char* e; + STRLEN numbers_len; + I32 flags = PERL_SCAN_DISALLOW_PREFIX; +#ifdef DEBUGGING + char *start = *s - 1; + assert(*start == '\\'); +#endif + + PERL_ARGS_ASSERT_GROK_BSLASH_X; + + assert(**s == 'x'); + (*s)++; + + if (strict || ! output_warning) { + flags |= PERL_SCAN_SILENT_ILLDIGIT; + } + + if (**s != '{') { + STRLEN len = (strict) ? 3 : 2; + + *uv = grok_hex(*s, &len, &flags, NULL); + *s += len; + if (strict && len != 2) { + if (len < 2) { + *s += (UTF) ? UTF8SKIP(*s) : 1; + *error_msg = "Non-hex character"; + } + else { + *error_msg = "Use \\x{...} for more than two hex characters"; + } + return FALSE; + } + goto ok; + } + + e = strchr(*s, '}'); + if (!e) { + (*s)++; /* Move past the '{' */ + while (isXDIGIT(**s)) { /* Position beyond the legal digits */ + (*s)++; + } + /* XXX The corresponding message above for \o is just '\\o{'; other + * messages for other constructs include the '}', so are inconsistent. + */ + *error_msg = "Missing right brace on \\x{}"; + return FALSE; + } + + (*s)++; /* Point to expected first digit (could be first byte of utf8 + sequence if not a digit) */ + numbers_len = e - *s; + if (numbers_len == 0) { + if (strict) { + (*s)++; /* Move past the } */ + *error_msg = "Number with no digits"; + return FALSE; + } + *s = e + 1; + *uv = 0; + goto ok; + } + + flags |= PERL_SCAN_ALLOW_UNDERSCORES; + if (silence_non_portable) { + flags |= PERL_SCAN_SILENT_NON_PORTABLE; + } + + *uv = grok_hex(*s, &numbers_len, &flags, NULL); + /* Note that if has non-hex, will ignore everything starting with that up + * to the '}' */ + + if (strict && numbers_len != (STRLEN) (e - *s)) { + *s += numbers_len; + *s += (UTF) ? UTF8SKIP(*s) : 1; + *error_msg = "Non-hex character"; + return FALSE; + } + + /* Return past the '}' */ + *s = e + 1; + + ok: + /* guarantee replacing "\x{...}" with utf8 bytes fits within + * existing space */ + assert(OFFUNISKIP(*uv) < *s - start); + return TRUE; +} + +#endif /* DQUOTE_INLINE_H */ diff --git a/dump.c b/dump.c index c4d4018..778e345 100644 --- a/dump.c +++ b/dump.c @@ -1116,7 +1116,7 @@ Perl_gv_dump(pTHX_ GV *gv) */ static const struct { const char type; const char *name; } magic_names[] = { -#include "mg_names.c" +#include "mg_names.inc" /* this null string terminates the list */ { 0, NULL }, }; @@ -2032,7 +2032,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%"UVxf " (%s)\n", (UV)GvGPFLAGS(sv), - GvALIASED_SV(sv) ? "ALIASED_SV" : ""); + ""); Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv)); Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv)); do_gv_dump (level, file, " EGV", GvEGV(sv)); diff --git a/embed.fnc b/embed.fnc index af63435..12c0551 100644 --- a/embed.fnc +++ b/embed.fnc @@ -798,22 +798,22 @@ p |OP* |localize |NN OP *o|I32 lex ApdR |I32 |looks_like_number|NN SV *const sv Apd |UV |grok_bin |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) -EMsR |char |grok_bslash_c |const char source|const bool output_warning -EMsR |bool |grok_bslash_o |NN char** s|NN UV* uv \ +EMiR |bool |grok_bslash_x |NN char** s|NN UV* uv \ |NN const char** error_msg \ |const bool output_warning \ |const bool strict \ |const bool silence_non_portable \ |const bool utf8 -EMiR |bool |grok_bslash_x |NN char** s|NN UV* uv \ +#endif +EMpRX |char |grok_bslash_c |const char source|const bool output_warning +EMpRX |bool |grok_bslash_o |NN char** s|NN UV* uv \ |NN const char** error_msg \ |const bool output_warning \ |const bool strict \ |const bool silence_non_portable \ |const bool utf8 -EMsPR |char*|form_short_octal_warning|NN const char * const s \ +EMpPRX |char*|form_short_octal_warning|NN const char * const s \ |const STRLEN len -#endif Apd |UV |grok_hex |NN const char* start|NN STRLEN* len_p|NN I32* flags|NULLOK NV *result Apd |int |grok_infnan |NN const char** sp|NN const char *send Apd |int |grok_number |NN const char *pv|STRLEN len|NULLOK UV *valuep @@ -962,9 +962,6 @@ ADMnoPR |UV |ASCII_TO_NEED |const UV enc|const UV ch Apa |OP* |newANONLIST |NULLOK OP* o Apa |OP* |newANONHASH |NULLOK OP* o Ap |OP* |newANONSUB |I32 floor|NULLOK OP* proto|NULLOK OP* block -#if defined(PERL_IN_OP_C) -i |bool |aassign_common_vars |NULLOK OP* o -#endif Apda |OP* |newASSIGNOP |I32 flags|NULLOK OP* left|I32 optype|NULLOK OP* right Apda |OP* |newCONDOP |I32 flags|NN OP* first|NULLOK OP* trueop|NULLOK OP* falseop Apd |CV* |newCONSTSUB |NULLOK HV* stash|NULLOK const char* name|NULLOK SV* sv @@ -1260,7 +1257,6 @@ Ap |void |savestack_grow_cnt |I32 need Amp |void |save_aelem |NN AV* av|SSize_t idx|NN SV **sptr Ap |void |save_aelem_flags|NN AV* av|SSize_t idx|NN SV **sptr \ |const U32 flags -p |void |save_aliased_sv|NN GV* gv Ap |I32 |save_alloc |I32 size|I32 pad Ap |void |save_aptr |NN AV** aptr Ap |AV* |save_ary |NN GV* gv @@ -2745,7 +2741,7 @@ so |void |xs_version_bootcheck|U32 items|U32 ax|NN const char *xs_p \ #endif Xpon |I32 |xs_handshake |const U32 key|NN void * v_my_perl\ |NN const char * file| ... -Xp |void |xs_boot_epilog |const U32 ax +Xp |void |xs_boot_epilog |const I32 ax #ifndef HAS_STRLCAT Apnod |Size_t |my_strlcat |NULLOK char *dst|NULLOK const char *src|Size_t size #endif diff --git a/embed.h b/embed.h index 5963253..0611ea9 100644 --- a/embed.h +++ b/embed.h @@ -902,7 +902,10 @@ #define av_reify(a) Perl_av_reify(aTHX_ a) #define current_re_engine() Perl_current_re_engine(aTHX) #define cv_ckproto_len_flags(a,b,c,d,e) Perl_cv_ckproto_len_flags(aTHX_ a,b,c,d,e) +#define form_short_octal_warning(a,b) Perl_form_short_octal_warning(aTHX_ a,b) #define grok_atoUV Perl_grok_atoUV +#define grok_bslash_c(a,b) Perl_grok_bslash_c(aTHX_ a,b) +#define grok_bslash_o(a,b,c,d,e,f,g) Perl_grok_bslash_o(aTHX_ a,b,c,d,e,f,g) #define mg_find_mglob(a) Perl_mg_find_mglob(aTHX_ a) #define multideref_stringify(a,b) Perl_multideref_stringify(aTHX_ a,b) #define op_clear(a) Perl_op_clear(aTHX_ a) @@ -1038,9 +1041,6 @@ #define _core_swash_init(a,b,c,d,e,f,g) Perl__core_swash_init(aTHX_ a,b,c,d,e,f,g) # endif # if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) -#define form_short_octal_warning(a,b) S_form_short_octal_warning(aTHX_ a,b) -#define grok_bslash_c(a,b) S_grok_bslash_c(aTHX_ a,b) -#define grok_bslash_o(a,b,c,d,e,f,g) S_grok_bslash_o(aTHX_ a,b,c,d,e,f,g) #define grok_bslash_x(a,b,c,d,e,f,g) S_grok_bslash_x(aTHX_ a,b,c,d,e,f,g) #define regcurly S_regcurly # endif @@ -1304,7 +1304,6 @@ #define rsignal_restore(a,b) Perl_rsignal_restore(aTHX_ a,b) #define rsignal_save(a,b,c) Perl_rsignal_save(aTHX_ a,b,c) #define rxres_save(a,b) Perl_rxres_save(aTHX_ a,b) -#define save_aliased_sv(a) Perl_save_aliased_sv(aTHX_ a) #define save_strlen(a) Perl_save_strlen(aTHX_ a) #define sawparens(a) Perl_sawparens(aTHX_ a) #define scalar(a) Perl_scalar(aTHX_ a) @@ -1526,7 +1525,6 @@ #define mro_get_linear_isa_dfs(a,b) S_mro_get_linear_isa_dfs(aTHX_ a,b) # endif # if defined(PERL_IN_OP_C) -#define aassign_common_vars(a) S_aassign_common_vars(aTHX_ a) #define apply_attrs(a,b,c) S_apply_attrs(aTHX_ a,b,c) #define apply_attrs_my(a,b,c,d) S_apply_attrs_my(aTHX_ a,b,c,d) #define assignment_type(a) S_assignment_type(aTHX_ a) diff --git a/embedvar.h b/embedvar.h index 9ed30e0..c6213c0 100644 --- a/embedvar.h +++ b/embedvar.h @@ -270,7 +270,6 @@ #define PL_savestack (vTHX->Isavestack) #define PL_savestack_ix (vTHX->Isavestack_ix) #define PL_savestack_max (vTHX->Isavestack_max) -#define PL_sawalias (vTHX->Isawalias) #ifndef PL_sawampersand #define PL_sawampersand (vTHX->Isawampersand) #endif diff --git a/ext/B/t/b.t b/ext/B/t/b.t index 1420f91..4638c3e 100644 --- a/ext/B/t/b.t +++ b/ext/B/t/b.t @@ -209,12 +209,6 @@ is($gv_ref->SAFENAME(), "gv", "Test SAFENAME()"); like($gv_ref->FILE(), qr/b\.t$/, "Testing FILE()"); is($gv_ref->SvTYPE(), B::SVt_PVGV, "Test SvTYPE()"); is($gv_ref->FLAGS() & B::SVTYPEMASK, B::SVt_PVGV, "Test SVTYPEMASK"); -is($gv_ref->GPFLAGS & B::GPf_ALIASED_SV, 0, 'GPFLAGS are unset'); -{ - local *gv = \my $x; - is($gv_ref->GPFLAGS & B::GPf_ALIASED_SV, B::GPf_ALIASED_SV, - 'GPFLAGS gets GPf_ALIASED_SV set'); -} # The following return B::SPECIALs. is(ref B::sv_yes(), "B::SPECIAL", "B::sv_yes()"); diff --git a/ext/B/t/f_map.t b/ext/B/t/f_map.t index 4f19427..a1cbc38 100644 --- a/ext/B/t/f_map.t +++ b/ext/B/t/f_map.t @@ -59,7 +59,7 @@ checkOptree(note => q{}, # a <0> pushmark s # b <#> gv[*chars] s # c <1> rv2av[t2] lKRM*/1 -# d <2> aassign[t9] KS/COMMON +# d <2> aassign[t9] KS/COM_AGG # e <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 559 (eval 15):1) v @@ -75,7 +75,7 @@ EOT_EOT # a <0> pushmark s # b <$> gv(*chars) s # c <1> rv2av[t1] lKRM*/1 -# d <2> aassign[t6] KS/COMMON +# d <2> aassign[t6] KS/COM_AGG # e <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -109,7 +109,7 @@ checkOptree(note => q{}, # g <0> pushmark s # h <#> gv[*hash] s # i <1> rv2hv lKRM*/1 -# j <2> aassign[t10] KS/COMMON +# j <2> aassign[t10] KS/COM_AGG # k <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 560 (eval 15):1) v:{ @@ -131,7 +131,7 @@ EOT_EOT # g <0> pushmark s # h <$> gv(*hash) s # i <1> rv2hv lKRM*/1 -# j <2> aassign[t5] KS/COMMON +# j <2> aassign[t5] KS/COM_AGG # k <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -244,7 +244,7 @@ checkOptree(note => q{}, # b <0> pushmark s # c <#> gv[*hash] s # d <1> rv2hv lKRM*/1 -# e <2> aassign[t10] KS/COMMON +# e <2> aassign[t10] KS/COM_AGG # f <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 560 (eval 15):1) v @@ -261,7 +261,7 @@ EOT_EOT # b <0> pushmark s # c <$> gv(*hash) s # d <1> rv2hv lKRM*/1 -# e <2> aassign[t6] KS/COMMON +# e <2> aassign[t6] KS/COM_AGG # f <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -290,7 +290,7 @@ checkOptree(note => q{}, # b <0> pushmark s # c <#> gv[*hash] s # d <1> rv2hv lKRM*/1 -# e <2> aassign[t10] KS/COMMON +# e <2> aassign[t10] KS/COM_AGG # f <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 560 (eval 15):1) v @@ -307,7 +307,7 @@ EOT_EOT # b <0> pushmark s # c <$> gv(*hash) s # d <1> rv2hv lKRM*/1 -# e <2> aassign[t6] KS/COMMON +# e <2> aassign[t6] KS/COM_AGG # f <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -336,7 +336,7 @@ checkOptree(note => q{}, # b <0> pushmark s # c <#> gv[*hash] s # d <1> rv2hv lKRM*/1 -# e <2> aassign[t9] KS/COMMON +# e <2> aassign[t9] KS/COM_AGG # f <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 589 (eval 26):1) v @@ -353,7 +353,7 @@ EOT_EOT # b <0> pushmark s # c <$> gv(*hash) s # d <1> rv2hv lKRM*/1 -# e <2> aassign[t5] KS/COMMON +# e <2> aassign[t5] KS/COM_AGG # f <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -382,7 +382,7 @@ checkOptree(note => q{}, # b <0> pushmark s # c <#> gv[*hash] s # d <1> rv2hv lKRM*/1 -# e <2> aassign[t8] KS/COMMON +# e <2> aassign[t8] KS/COM_AGG # f <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 593 (eval 28):1) v @@ -399,7 +399,7 @@ EOT_EOT # b <0> pushmark s # c <$> gv(*hash) s # d <1> rv2hv lKRM*/1 -# e <2> aassign[t5] KS/COMMON +# e <2> aassign[t5] KS/COM_AGG # f <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -427,7 +427,7 @@ checkOptree(note => q{}, # a <0> pushmark s # b <#> gv[*hash] s # c <1> rv2hv lKRM*/1 -# d <2> aassign[t6] KS/COMMON +# d <2> aassign[t6] KS/COM_AGG # e <#> gv[*array] s # f <1> rv2av[t8] K/1 # g <@> list K @@ -446,7 +446,7 @@ EOT_EOT # a <0> pushmark s # b <$> gv(*hash) s # c <1> rv2hv lKRM*/1 -# d <2> aassign[t4] KS/COMMON +# d <2> aassign[t4] KS/COM_AGG # e <$> gv(*array) s # f <1> rv2av[t5] K/1 # g <@> list K @@ -480,7 +480,7 @@ checkOptree(note => q{}, # d <0> pushmark s # e <#> gv[*hashes] s # f <1> rv2av[t2] lKRM*/1 -# g <2> aassign[t8] KS/COMMON +# g <2> aassign[t8] KS/COM_AGG # h <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 601 (eval 32):1) v @@ -499,6 +499,6 @@ EOT_EOT # d <0> pushmark s # e <$> gv(*hashes) s # f <1> rv2av[t1] lKRM*/1 -# g <2> aassign[t5] KS/COMMON +# g <2> aassign[t5] KS/COM_AGG # h <1> leavesub[1 ref] K/REFC,1 EONT_EONT diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t index 55811ed..eda5a21 100644 --- a/ext/B/t/f_sort.t +++ b/ext/B/t/f_sort.t @@ -60,7 +60,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t5] KS +# a <2> aassign[t5] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 545 (eval 15):1) v @@ -72,7 +72,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t3] KS +# a <2> aassign[t3] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -97,7 +97,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t3] KS +# a <2> aassign[t3] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -109,7 +109,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS +# a <2> aassign[t2] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -135,7 +135,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t10] KS +# a <2> aassign[t10] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -148,7 +148,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t6] KS +# a <2> aassign[t6] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -173,7 +173,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t3] KS +# a <2> aassign[t3] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -185,7 +185,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS +# a <2> aassign[t2] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -210,7 +210,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t3] KS +# a <2> aassign[t3] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -222,7 +222,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS +# a <2> aassign[t2] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -247,7 +247,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t3] KS +# a <2> aassign[t3] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -259,7 +259,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t2] KS +# a <2> aassign[t2] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -288,7 +288,7 @@ checkOptree(note => q{}, # 8 <0> pushmark s # 9 <#> gv[*eldest] s # a <1> rv2av[t2] lKRM*/1 -# b <2> aassign[t11] KS/COMMON +# b <2> aassign[t11] KS/COM_AGG # c <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -303,7 +303,7 @@ EOT_EOT # 8 <0> pushmark s # 9 <$> gv(*eldest) s # a <1> rv2av[t1] lKRM*/1 -# b <2> aassign[t5] KS/COMMON +# b <2> aassign[t5] KS/COM_AGG # c <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -333,7 +333,7 @@ checkOptree(note => q{}, # 8 <0> pushmark s # 9 <#> gv[*sortedclass] s # a <1> rv2av[t2] lKRM*/1 -# b <2> aassign[t5] KS +# b <2> aassign[t5] KS/COM_AGG # c <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -347,7 +347,7 @@ EOT_EOT # 8 <0> pushmark s # 9 <$> gv(*sortedclass) s # a <1> rv2av[t1] lKRM*/1 -# b <2> aassign[t3] KS +# b <2> aassign[t3] KS/COM_AGG # c <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -530,7 +530,7 @@ checkOptree(name => q{Compound sort/map Expression }, # n <0> pushmark s # o <#> gv[*new] s # p <1> rv2av[t2] lKRM*/1 -# q <2> aassign[t22] KS/COMMON +# q <2> aassign[t22] KS/COM_AGG # r <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 609 (eval 34):3) v:{ @@ -560,7 +560,7 @@ EOT_EOT # n <0> pushmark s # o <$> gv(*new) s # p <1> rv2av[t1] lKRM*/1 -# q <2> aassign[t13] KS/COMMON +# q <2> aassign[t13] KS/COM_AGG # r <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -592,7 +592,7 @@ checkOptree(name => q{sort other::sub LIST }, # 8 <0> pushmark s # 9 <#> gv[*new] s # a <1> rv2av[t2] lKRM*/1 -# b <2> aassign[t5] KS +# b <2> aassign[t5] KS/COM_AGG # c <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 614 (eval 36):2) v:{ @@ -606,7 +606,7 @@ EOT_EOT # 8 <0> pushmark s # 9 <$> gv(*new) s # a <1> rv2av[t1] lKRM*/1 -# b <2> aassign[t3] KS +# b <2> aassign[t3] KS/COM_AGG # c <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -634,7 +634,7 @@ checkOptree(note => q{}, # 8 <0> pushmark s # 9 <#> gv[*new] s # a <1> rv2av[t2] lKRM*/1 -# b <2> aassign[t5] KS +# b <2> aassign[t5] KS/COM_AGG # c <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -648,7 +648,7 @@ EOT_EOT # 8 <0> pushmark s # 9 <$> gv(*new) s # a <1> rv2av[t1] lKRM*/1 -# b <2> aassign[t3] KS +# b <2> aassign[t3] KS/COM_AGG # c <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -672,7 +672,7 @@ my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT'); # 7 <0> pushmark s # 8 <#> gv[*new] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t14] KS +# a <2> aassign[t14] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 578 (eval 15):1) v:%,{ @@ -685,7 +685,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*new) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t6] KS +# a <2> aassign[t6] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -717,7 +717,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*new] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t14] KS +# a <2> aassign[t14] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 578 (eval 15):1) v:%,{ @@ -730,7 +730,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*new) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t6] KS +# a <2> aassign[t6] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -756,7 +756,7 @@ checkOptree(note => q{}, # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t8] KS +# a <2> aassign[t8] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -769,7 +769,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t4] KS +# a <2> aassign[t4] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -803,7 +803,7 @@ checkOptree(note => q{}, # d <0> pushmark s # e <#> gv[*result] s # f <1> rv2av[t2] lKRM*/1 -# g <2> aassign[t3] KS/COMMON +# g <2> aassign[t3] KS/COM_AGG # h <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 547 (eval 15):1) v @@ -824,7 +824,7 @@ EOT_EOT # d <0> pushmark s # e <$> gv(*result) s # f <1> rv2av[t1] lKRM*/1 -# g <2> aassign[t2] KS/COMMON +# g <2> aassign[t2] KS/COM_AGG # h <1> leavesub[1 ref] K/REFC,1 EONT_EONT diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t index 9bfcc49..2d6b80f 100644 --- a/ext/B/t/optree_misc.t +++ b/ext/B/t/optree_misc.t @@ -205,7 +205,7 @@ checkOptree ( name => 'padrange', # - <0> padsv[$x:1,2] vM/LVINTRO ->- # - <0> padsv[$y:1,2] vM/LVINTRO ->- # 3 <;> nextstate(main 2 -e:1) v:>,<,% ->4 -# 8 <2> aassign[t4] vKS ->9 +# 8 <2> aassign[t4] vKS/COM_AGG ->9 # - <1> ex-list lKP ->5 # 4 <0> padrange[$x:1,2; $y:1,2] /2 ->5 # - <0> padsv[$x:1,2] s ->- @@ -215,7 +215,7 @@ checkOptree ( name => 'padrange', # 7 <1> rv2av[t3] lKRM*/1 ->8 # 6 <#> gv[*a] s ->7 # 9 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->a -# e <2> aassign[t6] KS ->f +# e <2> aassign[t6] KS/COM_RC1 ->f # - <1> ex-list lK ->d # a <0> pushmark s ->b # c <1> rv2av[t5] lK/1 ->d @@ -233,7 +233,7 @@ EOT_EOT # - <0> padsv[$x:1,2] vM/LVINTRO ->- # - <0> padsv[$y:1,2] vM/LVINTRO ->- # 3 <;> nextstate(main 2 -e:1) v:>,<,% ->4 -# 8 <2> aassign[t4] vKS ->9 +# 8 <2> aassign[t4] vKS/COM_AGG ->9 # - <1> ex-list lKP ->5 # 4 <0> padrange[$x:1,2; $y:1,2] /2 ->5 # - <0> padsv[$x:1,2] s ->- @@ -243,7 +243,7 @@ EOT_EOT # 7 <1> rv2av[t3] lKRM*/1 ->8 # 6 <$> gv(*a) s ->7 # 9 <;> nextstate(main 2 -e:1) v:>,<,%,{ ->a -# e <2> aassign[t6] KS ->f +# e <2> aassign[t6] KS/COM_RC1 ->f # - <1> ex-list lK ->d # a <0> pushmark s ->b # c <1> rv2av[t5] lK/1 ->d @@ -276,7 +276,7 @@ checkOptree ( name => 'padrange and @_', # - <0> padsv[$a:1,4] sRM*/LVINTRO ->- # - <0> padsv[$b:1,4] sRM*/LVINTRO ->- # 4 <;> nextstate(main 2 p3:2) v:>,<,% ->5 -# 9 <2> aassign[t10] vKS ->a +# 9 <2> aassign[t10] vKS/COM_RC1 ->a # - <1> ex-list lK ->8 # 5 <0> pushmark s ->6 # 7 <1> rv2av[t9] lK/1 ->8 @@ -309,7 +309,7 @@ EOT_EOT # - <0> padsv[$a:1,4] sRM*/LVINTRO ->- # - <0> padsv[$b:1,4] sRM*/LVINTRO ->- # 4 <;> nextstate(main 2 p3:2) v:>,<,% ->5 -# 9 <2> aassign[t10] vKS ->a +# 9 <2> aassign[t10] vKS/COM_RC1 ->a # - <1> ex-list lK ->8 # 5 <0> pushmark s ->6 # 7 <1> rv2av[t9] lK/1 ->8 diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t index d259bf9..c6288d9 100644 --- a/ext/B/t/optree_samples.t +++ b/ext/B/t/optree_samples.t @@ -437,7 +437,7 @@ checkOptree ( name => '@foo = grep(!/^\#/, @bar)', # a <0> pushmark s # b <#> gv[*foo] s # c <1> rv2av[t2] lKRM*/1 -# d <2> aassign[t6] KS +# d <2> aassign[t6] KS/COM_AGG # e <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 496 (eval 20):1) v:{ @@ -453,7 +453,7 @@ EOT_EOT # a <0> pushmark s # b <$> gv(*foo) s # c <1> rv2av[t1] lKRM*/1 -# d <2> aassign[t4] KS +# d <2> aassign[t4] KS/COM_AGG # e <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -485,7 +485,7 @@ checkOptree ( name => '%h = map { getkey($_) => $_ } @a', # h <#> gv[*h] s # i <1> rv2hv[t2] lKRM*/1 < 5.019006 # i <1> rv2hv lKRM*/1 >=5.019006 -# j <2> aassign[t10] KS/COMMON +# j <2> aassign[t10] KS/COM_AGG # k <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 501 (eval 22):1) v:{ @@ -509,7 +509,7 @@ EOT_EOT # h <$> gv(*h) s # i <1> rv2hv[t1] lKRM*/1 < 5.019006 # i <1> rv2hv lKRM*/1 >=5.019006 -# j <2> aassign[t5] KS/COMMON +# j <2> aassign[t5] KS/COM_AGG # k <1> leavesub[1 ref] K/REFC,1 EONT_EONT diff --git a/ext/B/t/optree_sort.t b/ext/B/t/optree_sort.t index 660d9b2..0b5897d 100644 --- a/ext/B/t/optree_sort.t +++ b/ext/B/t/optree_sort.t @@ -77,7 +77,7 @@ checkOptree ( name => 'sub {@a = sort @a}', 7 <0> pushmark s 8 <#> gv[*a] s 9 <1> rv2av[t2] lKRM*/1 -a <2> aassign[t5] KS/COMMON +a <2> aassign[t5] KS/COM_AGG b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 65 optree.t:311) v:>,<,% @@ -89,7 +89,7 @@ EOT_EOT # 7 <0> pushmark s # 8 <$> gv(*a) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t3] KS/COMMON +# a <2> aassign[t3] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -198,7 +198,7 @@ checkOptree ( name => 'sub {my @a; @a = sort @a}', 7 <@> sort lK 8 <0> pushmark s 9 <0> padav[@a:-437,-436] lRM* -a <2> aassign[t2] KS/COMMON +a <2> aassign[t2] KS/COM_AGG b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 427 optree_sort.t:172) v:>,<,% @@ -210,7 +210,7 @@ EOT_EOT # 7 <@> sort lK # 8 <0> pushmark s # 9 <0> padav[@a:-437,-436] lRM* -# a <2> aassign[t2] KS/COMMON +# a <2> aassign[t2] KS/COM_AGG # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT diff --git a/ext/File-Find/lib/File/Find.pm b/ext/File-Find/lib/File/Find.pm index af2a2e7..a888925 100644 --- a/ext/File-Find/lib/File/Find.pm +++ b/ext/File-Find/lib/File/Find.pm @@ -3,7 +3,7 @@ use 5.006; use strict; use warnings; use warnings::register; -our $VERSION = '1.29'; +our $VERSION = '1.30'; require Exporter; require Cwd; @@ -1051,7 +1051,8 @@ following globals available: C<$File::Find::topdir>, C<$File::Find::topdev>, C<$File::Find::topino>, C<$File::Find::topmode> and C<$File::Find::topnlink>. -This library is useful for the C tool, which when fed, +This library is useful for the C tool (distribued as part of the +App-find2perl CPAN distribution), which when fed, find2perl / -name .nfs\* -mtime +7 \ -exec rm -f {} \; -o -fstype nfs -prune diff --git a/ext/Hash-Util/lib/Hash/Util.pm b/ext/Hash-Util/lib/Hash/Util.pm index da02510..a947b9a 100644 --- a/ext/Hash-Util/lib/Hash/Util.pm +++ b/ext/Hash-Util/lib/Hash/Util.pm @@ -31,10 +31,11 @@ our @EXPORT_OK = qw( hash_seed hash_value hv_store bucket_stats bucket_stats_formatted bucket_info bucket_array lock_hash_recurse unlock_hash_recurse + lock_hashref_recurse unlock_hashref_recurse hash_traversal_mask ); -our $VERSION = '0.18'; +our $VERSION = '0.19'; require XSLoader; XSLoader::load(); @@ -78,6 +79,7 @@ Hash::Util - A selection of general-utility hash subroutines hash_seed hash_value hv_store bucket_stats bucket_info bucket_array lock_hash_recurse unlock_hash_recurse + lock_hashref_recurse unlock_hashref_recurse hash_traversal_mask ); @@ -364,7 +366,7 @@ sub unlock_hashref_recurse { if (defined($type) and $type eq 'HASH') { unlock_hashref_recurse($value); } - Internals::SvREADONLY($value,1); + Internals::SvREADONLY($value,0); } unlock_ref_keys($hash); return $hash; diff --git a/ext/Hash-Util/t/Util.t b/ext/Hash-Util/t/Util.t index 031d074..4a12fd1 100644 --- a/ext/Hash-Util/t/Util.t +++ b/ext/Hash-Util/t/Util.t @@ -44,8 +44,9 @@ BEGIN { hash_seed hash_value bucket_stats bucket_info bucket_array hv_store lock_hash_recurse unlock_hash_recurse + lock_hashref_recurse unlock_hashref_recurse ); - plan tests => 236 + @Exported_Funcs; + plan tests => 244 + @Exported_Funcs; use_ok 'Hash::Util', @Exported_Funcs; } foreach my $func (@Exported_Funcs) { @@ -530,6 +531,7 @@ ok(defined($hash_seed) && $hash_seed ne '', "hash_seed $hash_seed"); } { + # lock_hash_recurse / unlock_hash_recurse my %hash = ( a => 'alpha', b => [ qw( beta gamma delta ) ], @@ -549,6 +551,43 @@ ok(defined($hash_seed) && $hash_seed ne '', "hash_seed $hash_seed"); "unlock_hash_recurse(): top-level hash unlocked" ); ok( hash_unlocked(%{$hash{d}}), "unlock_hash_recurse(): element which is hashref unlocked" ); + { + local $@; + eval { $hash{d} = { theta => 'kappa' }; }; + ok(! $@, "No error; can assign to unlocked hash") + or diag($@); + } + ok( hash_unlocked(%{$hash{c}[1]}), + "unlock_hash_recurse(): element which is hashref in array ref not locked" ); +} + +{ + # lock_hashref_recurse / unlock_hashref_recurse + my %hash = ( + a => 'alpha', + b => [ qw( beta gamma delta ) ], + c => [ 'epsilon', { zeta => 'eta' }, ], + d => { theta => 'iota' }, + ); + Hash::Util::lock_hashref_recurse(\%hash); + ok( hash_locked(%hash), + "lock_hash_recurse(): top-level hash locked" ); + ok( hash_locked(%{$hash{d}}), + "lock_hash_recurse(): element which is hashref locked" ); + ok( ! hash_locked(%{$hash{c}[1]}), + "lock_hash_recurse(): element which is hashref in array ref not locked" ); + + Hash::Util::unlock_hashref_recurse(\%hash); + ok( hash_unlocked(%hash), + "unlock_hash_recurse(): top-level hash unlocked" ); + ok( hash_unlocked(%{$hash{d}}), + "unlock_hash_recurse(): element which is hashref unlocked" ); + { + local $@; + eval { $hash{d} = { theta => 'kappa' }; }; + ok(! $@, "No error; can assign to unlocked hash") + or diag($@); + } ok( hash_unlocked(%{$hash{c}[1]}), "unlock_hash_recurse(): element which is hashref in array ref not locked" ); } diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 96892d9..801bf4b 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -1229,7 +1229,9 @@ static void S_setpayload(NV* nvp, NV_PAYLOAD_TYPE payload, bool signaling) } #ifdef USE_LONG_DOUBLE # if LONG_DOUBLEKIND == 3 || LONG_DOUBLEKIND == 4 +# if LONG_DOUBLESIZE > 10 memset((char *)nvp + 10, '\0', LONG_DOUBLESIZE - 10); /* x86 long double */ +# endif # endif #endif for (i = 0; i < (int)C_ARRAY_LENGTH(a); i++) { diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm index 7717fce..ff01b21 100644 --- a/ext/POSIX/lib/POSIX.pm +++ b/ext/POSIX/lib/POSIX.pm @@ -4,7 +4,7 @@ use warnings; our ($AUTOLOAD, %SIGRT); -our $VERSION = '1.55'; +our $VERSION = '1.56'; require XSLoader; diff --git a/ext/POSIX/lib/POSIX.pod b/ext/POSIX/lib/POSIX.pod index 3e6f78d..a021d13 100644 --- a/ext/POSIX/lib/POSIX.pod +++ b/ext/POSIX/lib/POSIX.pod @@ -1244,7 +1244,9 @@ should not rely on more than 32 bits of payload. Whether a "signaling" NaN is in any way different from a "quiet" NaN, depends on the platform. Also note that the payload of the default NaN (no argument to nan()) is not necessarily zero, use C -to explicitly set the payload. +to explicitly set the payload. On some platforms like the 32-bit x86, +(unless using the 80-bit long doubles) the signaling bit is not supported +at all. See also L, L and L. diff --git a/ext/POSIX/t/math.t b/ext/POSIX/t/math.t index 2618865..5a9759a 100644 --- a/ext/POSIX/t/math.t +++ b/ext/POSIX/t/math.t @@ -172,8 +172,26 @@ SKIP: { # (3) and is signaling setpayloadsig($x, 0x12345); ok(isnan($x), "setpayloadsig + isnan"); - is(getpayload($x), 0x12345, "setpayload + getpayload"); - ok(issignaling($x), "setpayloadsig + issignaling"); + is(getpayload($x), 0x12345, "setpayloadsig + getpayload"); + SKIP: { + # https://rt.perl.org/Ticket/Display.html?id=125710 + # In the 32-bit x86 ABI cannot preserve the signaling bit + # (the x87 simply does not preserve that). But using the + # 80-bit extended format aka long double, the bit is preserved. + # https://gcc.gnu.org/bugzilla/show_bug.cgi?id=57484 + my $could_be_x86_32 = + # This is a really weak test: there are other 32-bit + # little-endian platforms than just Intel (some embedded + # processors, for example), but we use this just for not + # bothering with the test if things look iffy. + # We could, say, $Config{ccsymbols} =~ /\b__[xi][3-7]86=1\b/, + # but that feels quite shaky. + $Config{byteorder} eq '1234' && + $Config{ivsize} == 4 && # Really redundant with the 'byteorder'. + $Config{ptrsize} == 4; + skip($^O, 1) if $could_be_x86_32 && !$Config{uselongdouble}; + ok(issignaling($x), "setpayloadsig + issignaling"); + } # Try a payload more than one byte. is(getpayload(nan(0x12345)), 0x12345, "nan + getpayload"); diff --git a/ext/XS-APItest/t/handy.t b/ext/XS-APItest/t/handy.t index 9ebe0d3..eea81e8 100644 --- a/ext/XS-APItest/t/handy.t +++ b/ext/XS-APItest/t/handy.t @@ -42,7 +42,7 @@ my %properties = ( alnum => 'Word', wordchar => 'Word', alphanumeric => 'Alnum', - alpha => 'Alpha', + alpha => 'XPosixAlpha', ascii => 'ASCII', blank => 'Blank', cntrl => 'Control', @@ -50,14 +50,14 @@ my %properties = ( graph => 'Graph', idfirst => '_Perl_IDStart', idcont => '_Perl_IDCont', - lower => 'Lower', + lower => 'XPosixLower', print => 'Print', psxspc => 'XPosixSpace', punct => 'XPosixPunct', quotemeta => '_Perl_Quotemeta', space => 'XPerlSpace', vertws => 'VertSpace', - upper => 'Upper', + upper => 'XPosixUpper', xdigit => 'XDigit', ); @@ -69,8 +69,13 @@ foreach my $name (sort keys %properties) { my $property = $properties{$name}; my @invlist = prop_invlist($property, '_perl_core_internal_ok'); if (! @invlist) { - fail("No inversion list found for $property"); - next; + + # 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; + } } # Include all the Latin1 code points, plus 0x100. @@ -270,7 +275,7 @@ foreach my $name (sort keys %to_properties) { fail("No inversion map found for $property"); next; } - if ($format ne "al") { + if ($format !~ / ^ a l? $ /x) { fail("Unexpected inversion map format ('$format') found for $property"); next; } diff --git a/ext/re/Makefile.PL b/ext/re/Makefile.PL index c6338c7..4a21934 100644 --- a/ext/re/Makefile.PL +++ b/ext/re/Makefile.PL @@ -12,7 +12,7 @@ WriteMakefile( XSPROTOARG => '-noprototypes', OBJECT => $object, DEFINE => $defines, - clean => { FILES => '*$(OBJ_EXT) *.c ../../lib/re.pm' }, + clean => { FILES => '*$(OBJ_EXT) invlist_inline.h *.c ../../lib/re.pm' }, ); package MY; @@ -24,29 +24,29 @@ sub upupfile { sub postamble { my $regcomp_c = upupfile('regcomp.c'); my $regexec_c = upupfile('regexec.c'); - my $dquote_static_c = upupfile('dquote_static.c'); - my $inline_invlist_c = upupfile('inline_invlist.c'); + my $dquote_c = upupfile('dquote.c'); + my $invlist_inline_h = upupfile('invlist_inline.h'); <xpv_len) -#define GvASSIGN_GENERATION_set(gv,val) \ - STMT_START { assert(SvTYPE(gv) == SVt_PVGV); \ - (((XPV*) SvANY(gv))->xpv_len = (val)); } STMT_END - /* =head1 GV Functions @@ -198,12 +193,6 @@ Return the CV from the GV. #define GvIMPORTED_CV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_CV) #define GvIMPORTED_CV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_CV) -#define GPf_ALIASED_SV 1 - -#define GvALIASED_SV(gv) (GvGPFLAGS(gv) & GPf_ALIASED_SV) -#define GvALIASED_SV_on(gv) (GvGPFLAGS(gv) |= GPf_ALIASED_SV) -#define GvALIASED_SV_off(gv) (GvGPFLAGS(gv) &= ~GPf_ALIASED_SV) - #ifndef PERL_CORE # define GvIN_PAD(gv) 0 # define GvIN_PAD_on(gv) NOOP diff --git a/handy.h b/handy.h index 2f0c50c..248b685 100644 --- a/handy.h +++ b/handy.h @@ -173,12 +173,11 @@ typedef I16TYPE I16; typedef U16TYPE U16; typedef I32TYPE I32; typedef U32TYPE U32; -#ifdef PERL_CORE -# ifdef HAS_QUAD + +#ifdef HAS_QUAD typedef I64TYPE I64; typedef U64TYPE U64; -# endif -#endif /* PERL_CORE */ +#endif /* INT64_C/UINT64_C are C99 from (so they will not be * available in strict C89 mode), but they are nice, so let's define @@ -205,8 +204,8 @@ typedef U64TYPE U64; # define PeRl_UINT64_C(c) CAT2(c,UI64) # endif # ifndef PeRl_INT64_C -# define PeRl_INT64_C(c) ((I64TYPE)(c)) /* last resort */ -# define PeRl_UINT64_C(c) ((U64TYPE)(c)) +# define PeRl_INT64_C(c) ((I64)(c)) /* last resort */ +# define PeRl_UINT64_C(c) ((U64)(c)) # endif /* In OS X the INT64_C/UINT64_C are defined with LL/ULL, which will * not fly with C89-pedantic gcc, so let's undefine them first so that @@ -554,8 +553,8 @@ 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 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). The +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). The classification of just the first (possibly multi-byte) character in the string is tested. @@ -682,9 +681,8 @@ 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 @@ -812,8 +810,8 @@ ASCII uppercase character, that input character itself is returned. Variant C is equivalent. =for apidoc Am|U8|toLOWER_L1|U8 ch -Converts the specified Latin1 character to lowercase. The results are undefined if -the input doesn't fit in a byte. +Converts the specified Latin1 character to lowercase. The results are +undefined if the input doesn't fit in a byte. =for apidoc Am|U8|toLOWER_LC|U8 ch Converts the specified character to lowercase using the current locale's rules, @@ -842,9 +840,9 @@ The input character at C

is assumed to be well-formed. =for apidoc Am|U8|toTITLE|U8 ch Converts the specified character to titlecase. If the input is anything but an ASCII lowercase character, that input character itself is returned. Variant -C is equivalent. (There is no C for the full Latin1 range, -as the full generality of L is needed there. Titlecase is not a -concept used in locale handling, so there is no functionality for that.) +C is equivalent. (There is no C for the full Latin1 +range, as the full generality of L is needed there. Titlecase is +not a concept used in locale handling, so there is no functionality for that.) =for apidoc Am|UV|toTITLE_uni|UV cp|U8* s|STRLEN* lenp Converts the Unicode code point C to its titlecase version, and @@ -999,7 +997,9 @@ typedef enum { #define POSIX_SWASH_COUNT _FIRST_NON_SWASH_CC #define POSIX_CC_COUNT (_HIGHEST_REGCOMP_DOT_H_SYNC + 1) -#if defined(PERL_IN_UTF8_C) || defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) +#if defined(PERL_IN_UTF8_C) \ + || defined(PERL_IN_REGCOMP_C) \ + || defined(PERL_IN_REGEXEC_C) # if _CC_WORDCHAR != 0 || _CC_DIGIT != 1 || _CC_ALPHA != 2 || _CC_LOWER != 3 \ || _CC_UPPER != 4 || _CC_PUNCT != 5 || _CC_PRINT != 6 \ || _CC_ALPHANUMERIC != 7 || _CC_GRAPH != 8 || _CC_CASED != 9 @@ -1050,9 +1050,9 @@ END_EXTERN_C /* For internal core Perl use only: the base macro for defining macros like * isALPHA_A. The foo_A version makes sure that both the desired bit and * the ASCII bit are present */ -# define _generic_isCC_A(c, classnum) (FITS_IN_8_BITS(c) \ - && ((PL_charclass[(U8) (c)] & _CC_mask_A(classnum)) \ - == _CC_mask_A(classnum))) +# define _generic_isCC_A(c, classnum) (FITS_IN_8_BITS(c) \ + && ((PL_charclass[(U8) (c)] & _CC_mask_A(classnum)) \ + == _CC_mask_A(classnum))) # define isALPHA_A(c) _generic_isCC_A(c, _CC_ALPHA) # define isALPHANUMERIC_A(c) _generic_isCC_A(c, _CC_ALPHANUMERIC) @@ -1066,7 +1066,8 @@ END_EXTERN_C # define isSPACE_A(c) _generic_isCC_A(c, _CC_SPACE) # define isUPPER_A(c) _generic_isCC_A(c, _CC_UPPER) # define isWORDCHAR_A(c) _generic_isCC_A(c, _CC_WORDCHAR) -# define isXDIGIT_A(c) _generic_isCC(c, _CC_XDIGIT) /* No non-ASCII xdigits */ +# define isXDIGIT_A(c) _generic_isCC(c, _CC_XDIGIT) /* No non-ASCII xdigits + */ # define isIDFIRST_A(c) _generic_isCC_A(c, _CC_IDFIRST) # define isALPHA_L1(c) _generic_isCC(c, _CC_ALPHA) # define isALPHANUMERIC_L1(c) _generic_isCC(c, _CC_ALPHANUMERIC) @@ -1079,7 +1080,7 @@ END_EXTERN_C # define isGRAPH_L1(c) _generic_isCC(c, _CC_GRAPH) # define isLOWER_L1(c) _generic_isCC(c, _CC_LOWER) # define isPRINT_L1(c) _generic_isCC(c, _CC_PRINT) -# define isPSXSPC_L1(c) isSPACE_L1(c) +# define isPSXSPC_L1(c) isSPACE_L1(c) # define isPUNCT_L1(c) _generic_isCC(c, _CC_PUNCT) # define isSPACE_L1(c) _generic_isCC(c, _CC_SPACE) # define isUPPER_L1(c) _generic_isCC(c, _CC_UPPER) @@ -1098,9 +1099,9 @@ END_EXTERN_C # define _isQUOTEMETA(c) _generic_isCC(c, _CC_QUOTEMETA) # define _IS_NON_FINAL_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c) \ - _generic_isCC(c, _CC_NON_FINAL_FOLD) + _generic_isCC(c, _CC_NON_FINAL_FOLD) # define _IS_IN_SOME_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c) \ - _generic_isCC(c, _CC_IS_IN_SOME_FOLD) + _generic_isCC(c, _CC_IS_IN_SOME_FOLD) # define _IS_MNEMONIC_CNTRL_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c) \ _generic_isCC(c, _CC_MNEMONIC_CNTRL) #else /* else we don't have perl.h H_PERL */ @@ -1363,7 +1364,7 @@ END_EXTERN_C (! FITS_IN_8_BITS(c) \ ? (c) \ : ((! IN_UTF8_CTYPE_LOCALE) \ - ? (cast)function((cast)(c)) \ + ? (cast)function((cast)(c)) \ : ((((U8)(c)) == MICRO_SIGN) \ ? GREEK_CAPITAL_LETTER_MU \ : ((((U8)(c)) == LATIN_SMALL_LETTER_Y_WITH_DIAERESIS) \ @@ -1410,20 +1411,25 @@ END_EXTERN_C * Not all possible weirdnesses are checked for, just the ones that were * detected on actual Microsoft code pages */ -# define isCNTRL_LC(c) _generic_LC(c, _CC_CNTRL, iscntrl) -# define isSPACE_LC(c) _generic_LC(c, _CC_SPACE, isspace) - -# define isALPHA_LC(c) (_generic_LC(c, _CC_ALPHA, isalpha) && isALPHANUMERIC_LC(c)) -# define isALPHANUMERIC_LC(c) (_generic_LC(c, _CC_ALPHANUMERIC, isalnum) && ! isPUNCT_LC(c)) -# define isDIGIT_LC(c) (_generic_LC(c, _CC_DIGIT, isdigit) && isALPHANUMERIC_LC(c)) -# define isGRAPH_LC(c) (_generic_LC(c, _CC_GRAPH, isgraph) && isPRINT_LC(c)) -# define isIDFIRST_LC(c) (((c) == '_') || (_generic_LC(c, _CC_IDFIRST, isalpha) && ! isPUNCT_LC(c))) -# define isLOWER_LC(c) (_generic_LC(c, _CC_LOWER, islower) && isALPHA_LC(c)) -# define isPRINT_LC(c) (_generic_LC(c, _CC_PRINT, isprint) && ! isCNTRL_LC(c)) -# define isPUNCT_LC(c) (_generic_LC(c, _CC_PUNCT, ispunct) && ! isCNTRL_LC(c)) -# define isUPPER_LC(c) (_generic_LC(c, _CC_UPPER, isupper) && isALPHA_LC(c)) +# define isCNTRL_LC(c) _generic_LC(c, _CC_CNTRL, iscntrl) +# define isSPACE_LC(c) _generic_LC(c, _CC_SPACE, isspace) + +# define isALPHA_LC(c) (_generic_LC(c, _CC_ALPHA, isalpha) \ + && isALPHANUMERIC_LC(c)) +# define isALPHANUMERIC_LC(c) (_generic_LC(c, _CC_ALPHANUMERIC, isalnum) && \ + ! isPUNCT_LC(c)) +# define isDIGIT_LC(c) (_generic_LC(c, _CC_DIGIT, isdigit) && \ + isALPHANUMERIC_LC(c)) +# define isGRAPH_LC(c) (_generic_LC(c, _CC_GRAPH, isgraph) && isPRINT_LC(c)) +# define isIDFIRST_LC(c) (((c) == '_') \ + || (_generic_LC(c, _CC_IDFIRST, isalpha) && ! isPUNCT_LC(c))) +# define isLOWER_LC(c) (_generic_LC(c, _CC_LOWER, islower) && isALPHA_LC(c)) +# define isPRINT_LC(c) (_generic_LC(c, _CC_PRINT, isprint) && ! isCNTRL_LC(c)) +# define isPUNCT_LC(c) (_generic_LC(c, _CC_PUNCT, ispunct) && ! isCNTRL_LC(c)) +# define isUPPER_LC(c) (_generic_LC(c, _CC_UPPER, isupper) && isALPHA_LC(c)) # define isWORDCHAR_LC(c) (((c) == '_') || isALPHANUMERIC_LC(c)) -# define isXDIGIT_LC(c) (_generic_LC(c, _CC_XDIGIT, isxdigit) && isALPHANUMERIC_LC(c)) +# define isXDIGIT_LC(c) (_generic_LC(c, _CC_XDIGIT, isxdigit) \ + && isALPHANUMERIC_LC(c)) # define toLOWER_LC(c) _generic_toLOWER_LC((c), tolower, U8) # define toUPPER_LC(c) _generic_toUPPER_LC((c), toupper, U8) @@ -1453,19 +1459,19 @@ END_EXTERN_C #else /* The final fallback position */ -# define isALPHA_LC(c) (isascii(c) && isalpha(c)) -# define isALPHANUMERIC_LC(c) (isascii(c) && isalnum(c)) -# define isCNTRL_LC(c) (isascii(c) && iscntrl(c)) -# define isDIGIT_LC(c) (isascii(c) && isdigit(c)) -# define isGRAPH_LC(c) (isascii(c) && isgraph(c)) +# define isALPHA_LC(c) (isascii(c) && isalpha(c)) +# define isALPHANUMERIC_LC(c) (isascii(c) && isalnum(c)) +# define isCNTRL_LC(c) (isascii(c) && iscntrl(c)) +# define isDIGIT_LC(c) (isascii(c) && isdigit(c)) +# define isGRAPH_LC(c) (isascii(c) && isgraph(c)) # define isIDFIRST_LC(c) (isascii(c) && (isalpha(c) || (c) == '_')) -# define isLOWER_LC(c) (isascii(c) && islower(c)) -# define isPRINT_LC(c) (isascii(c) && isprint(c)) -# define isPUNCT_LC(c) (isascii(c) && ispunct(c)) -# define isSPACE_LC(c) (isascii(c) && isspace(c)) -# define isUPPER_LC(c) (isascii(c) && isupper(c)) +# define isLOWER_LC(c) (isascii(c) && islower(c)) +# define isPRINT_LC(c) (isascii(c) && isprint(c)) +# define isPUNCT_LC(c) (isascii(c) && ispunct(c)) +# define isSPACE_LC(c) (isascii(c) && isspace(c)) +# define isUPPER_LC(c) (isascii(c) && isupper(c)) # define isWORDCHAR_LC(c) (isascii(c) && (isalnum(c) || (c) == '_')) -# define isXDIGIT_LC(c) (isascii(c) && isxdigit(c)) +# define isXDIGIT_LC(c) (isascii(c) && isxdigit(c)) # define toLOWER_LC(c) (isascii(c) ? tolower(c) : (c)) # define toUPPER_LC(c) (isascii(c) ? toupper(c) : (c)) @@ -1538,27 +1544,29 @@ END_EXTERN_C #define isALPHA_LC_uvchr(c) _generic_LC_swash_uvchr(isALPHA_LC, _CC_ALPHA, c) #define isALPHANUMERIC_LC_uvchr(c) _generic_LC_swash_uvchr(isALPHANUMERIC_LC, \ _CC_ALPHANUMERIC, c) -#define isASCII_LC_uvchr(c) isASCII_LC(c) -#define isBLANK_LC_uvchr(c) _generic_LC_uvchr(isBLANK_LC, is_HORIZWS_cp_high, c) +#define isASCII_LC_uvchr(c) isASCII_LC(c) +#define isBLANK_LC_uvchr(c) _generic_LC_uvchr(isBLANK_LC, \ + is_HORIZWS_cp_high, c) #define isCNTRL_LC_uvchr(c) (c < 256 ? isCNTRL_LC(c) : 0) #define isDIGIT_LC_uvchr(c) _generic_LC_swash_uvchr(isDIGIT_LC, _CC_DIGIT, c) #define isGRAPH_LC_uvchr(c) _generic_LC_swash_uvchr(isGRAPH_LC, _CC_GRAPH, c) -#define isIDCONT_LC_uvchr(c) _generic_LC_uvchr(isIDCONT_LC, \ +#define isIDCONT_LC_uvchr(c) _generic_LC_uvchr(isIDCONT_LC, \ _is_uni_perl_idcont, c) -#define isIDFIRST_LC_uvchr(c) _generic_LC_uvchr(isIDFIRST_LC, \ +#define isIDFIRST_LC_uvchr(c) _generic_LC_uvchr(isIDFIRST_LC, \ _is_uni_perl_idstart, c) #define isLOWER_LC_uvchr(c) _generic_LC_swash_uvchr(isLOWER_LC, _CC_LOWER, c) #define isPRINT_LC_uvchr(c) _generic_LC_swash_uvchr(isPRINT_LC, _CC_PRINT, c) -#define isPSXSPC_LC_uvchr(c) isSPACE_LC_uvchr(c) +#define isPSXSPC_LC_uvchr(c) isSPACE_LC_uvchr(c) #define isPUNCT_LC_uvchr(c) _generic_LC_swash_uvchr(isPUNCT_LC, _CC_PUNCT, c) -#define isSPACE_LC_uvchr(c) _generic_LC_uvchr(isSPACE_LC, \ +#define isSPACE_LC_uvchr(c) _generic_LC_uvchr(isSPACE_LC, \ is_XPERLSPACE_cp_high, c) #define isUPPER_LC_uvchr(c) _generic_LC_swash_uvchr(isUPPER_LC, _CC_UPPER, c) -#define isWORDCHAR_LC_uvchr(c) _generic_LC_swash_uvchr(isWORDCHAR_LC, \ +#define isWORDCHAR_LC_uvchr(c) _generic_LC_swash_uvchr(isWORDCHAR_LC, \ _CC_WORDCHAR, c) -#define isXDIGIT_LC_uvchr(c) _generic_LC_uvchr(isXDIGIT_LC, is_XDIGIT_cp_high, c) +#define isXDIGIT_LC_uvchr(c) _generic_LC_uvchr(isXDIGIT_LC, \ + is_XDIGIT_cp_high, c) -#define isBLANK_LC_uni(c) isBLANK_LC_uvchr(UNI_TO_NATIVE(c)) +#define isBLANK_LC_uni(c) isBLANK_LC_uvchr(UNI_TO_NATIVE(c)) /* For internal core Perl use only: the base macros for defining macros like * isALPHA_utf8. These are like the earlier defined macros, but take an input @@ -1575,8 +1583,8 @@ END_EXTERN_C *((p)+1 )), \ classnum) \ : utf8) -/* Like the above, but calls 'above_latin1(p)' to get the utf8 value. 'above_latin1' - * can be a macro */ +/* 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)) /* Like the above, but passes classnum to _isFOO_utf8(), instead of having an @@ -1603,12 +1611,12 @@ 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 +#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 isBLANK_utf8(p) _generic_func_utf8(_CC_BLANK, is_HORIZWS_high, p) #ifdef EBCDIC /* Because all controls are UTF-8 invariants in EBCDIC, we can use this @@ -1630,18 +1638,18 @@ 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, \ +#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, \ +#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 toFOLD_utf8(p,s,l) to_utf8_fold(p,s,l) @@ -1665,47 +1673,52 @@ END_EXTERN_C #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, \ +#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 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 isXDIGIT_LC_utf8(p) _generic_LC_func_utf8(isXDIGIT_LC, \ + is_XDIGIT_high, p) /* Macros for backwards compatibility and for completeness when the ASCII and * Latin1 values are identical */ -#define isALPHAU(c) isALPHA_L1(c) -#define isDIGIT_L1(c) isDIGIT_A(c) -#define isOCTAL(c) isOCTAL_A(c) -#define isOCTAL_L1(c) isOCTAL_A(c) -#define isXDIGIT_L1(c) isXDIGIT_A(c) -#define isALNUM(c) isWORDCHAR(c) -#define isALNUMU(c) isWORDCHAR_L1(c) -#define isALNUM_LC(c) isWORDCHAR_LC(c) -#define isALNUM_uni(c) isWORDCHAR_uni(c) +#define isALPHAU(c) isALPHA_L1(c) +#define isDIGIT_L1(c) isDIGIT_A(c) +#define isOCTAL(c) isOCTAL_A(c) +#define isOCTAL_L1(c) isOCTAL_A(c) +#define isXDIGIT_L1(c) isXDIGIT_A(c) +#define isALNUM(c) isWORDCHAR(c) +#define isALNUMU(c) isWORDCHAR_L1(c) +#define isALNUM_LC(c) isWORDCHAR_LC(c) +#define isALNUM_uni(c) isWORDCHAR_uni(c) #define isALNUM_LC_uvchr(c) isWORDCHAR_LC_uvchr(c) -#define isALNUM_utf8(p) isWORDCHAR_utf8(p) -#define isALNUM_LC_utf8(p) isWORDCHAR_LC_utf8(p) -#define isALNUMC_A(c) isALPHANUMERIC_A(c) /* Mnemonic: "C's alnum" */ -#define isALNUMC_L1(c) isALPHANUMERIC_L1(c) -#define isALNUMC(c) isALPHANUMERIC(c) -#define isALNUMC_LC(c) isALPHANUMERIC_LC(c) -#define isALNUMC_uni(c) isALPHANUMERIC_uni(c) +#define isALNUM_utf8(p) isWORDCHAR_utf8(p) +#define isALNUM_LC_utf8(p) isWORDCHAR_LC_utf8(p) +#define isALNUMC_A(c) isALPHANUMERIC_A(c) /* Mnemonic: "C's alnum" */ +#define isALNUMC_L1(c) isALPHANUMERIC_L1(c) +#define isALNUMC(c) isALPHANUMERIC(c) +#define isALNUMC_LC(c) isALPHANUMERIC_LC(c) +#define isALNUMC_uni(c) isALPHANUMERIC_uni(c) #define isALNUMC_LC_uvchr(c) isALPHANUMERIC_LC_uvchr(c) -#define isALNUMC_utf8(p) isALPHANUMERIC_utf8(p) +#define isALNUMC_utf8(p) isALPHANUMERIC_utf8(p) #define isALNUMC_LC_utf8(p) isALPHANUMERIC_LC_utf8(p) /* On EBCDIC platforms, CTRL-@ is 0, CTRL-A is 1, etc, just like on ASCII, @@ -2110,7 +2123,8 @@ void Perl_mem_log_del_sv(const SV *sv, const char *filename, const int linenumbe shortcut macro defined without -DPERL_CORE. Neither codesearch.google.com nor CPAN::Unpack show any users outside the core. */ #ifdef PERL_CORE -# define deprecate(s) Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), "Use of " s " is deprecated") +# define deprecate(s) Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \ + "Use of " s " is deprecated") #endif /* Internal macros to deal with gids and uids */ diff --git a/hints/catamount.sh b/hints/catamount.sh index 950476b..9bedff9 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.23.1 +# mkdir -p /opt/perl-catamount/lib/perl5/5.23.2 # 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.23.1 +# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.23.2 # 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/darwin.sh b/hints/darwin.sh index fec05fd..81cdcff 100644 --- a/hints/darwin.sh +++ b/hints/darwin.sh @@ -301,6 +301,11 @@ case "$usemymalloc" in esac # However sbrk() returns -1 (failure) somewhere in lib/unicore/mktables at # around 14M, so we need to use system malloc() as our sbrk() +# +# sbrk() in Darwin deprecated since Mavericks (10.9), it still exists +# in Yosemite (10.10) but that is just an emulation, and fails for +# allocations beyond 4MB. One should use e.g. mmap instead (or system +# malloc, as suggested above, that but is kind of backward). malloc_cflags='ccflags="-DUSE_PERL_SBRK -DPERL_SBRK_VIA_MALLOC $ccflags"' # Locales aren't feeling well. diff --git a/hv.c b/hv.c index 2fd36ee..469221f 100644 --- a/hv.c +++ b/hv.c @@ -1490,10 +1490,10 @@ Perl_newHVhv(pTHX_ HV *ohv) /* =for apidoc Am|HV *|hv_copy_hints_hv|HV *ohv -A specialised version of L for copying C<%^H>. I must be +A specialised version of L for copying C<%^H>. C must be a pointer to a hash (which may have C<%^H> magic, but should be generally non-magical), or C (interpreted as an empty hash). The content -of I is copied to a new hash, which has the C<%^H>-specific magic +of C is copied to a new hash, which has the C<%^H>-specific magic added to it. A pointer to the new hash is returned. =cut @@ -3064,7 +3064,7 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he) Generates and returns a C representing the content of a C chain. -I is currently unused and must be zero. +C is currently unused and must be zero. =cut */ @@ -3171,9 +3171,9 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags) =for apidoc m|SV *|refcounted_he_fetch_pvn|const struct refcounted_he *chain|const char *keypv|STRLEN keylen|U32 hash|U32 flags Search along a C chain for an entry with the key specified -by I and I. If I has the C +by C and C. If C has the C bit set, the key octets are interpreted as UTF-8, otherwise they -are interpreted as Latin-1. I is a precomputed hash of the key +are interpreted as Latin-1. C is a precomputed hash of the key string, or zero if it has not been precomputed. Returns a mortal scalar representing the value associated with the key, or C<&PL_sv_placeholder> if there is no value associated with the key. @@ -3310,25 +3310,25 @@ be empty), and thus forms a longer chain. When using the longer chain, the new key/value pair takes precedence over any entry for the same key further along the chain. -The new key is specified by I and I. If I has +The new key is specified by C and C. If C has the C bit set, the key octets are interpreted -as UTF-8, otherwise they are interpreted as Latin-1. I is +as UTF-8, otherwise they are interpreted as Latin-1. C is a precomputed hash of the key string, or zero if it has not been precomputed. -I is the scalar value to store for this key. I is copied +C is the scalar value to store for this key. C is copied by this function, which thus does not take ownership of any reference to it, and later changes to the scalar will not be reflected in the value visible in the C. Complex types of scalar will not be stored with referential integrity, but will be coerced to strings. -I may be either null or C<&PL_sv_placeholder> to indicate that no +C may be either null or C<&PL_sv_placeholder> to indicate that no value is to be associated with the key; this, as with any non-null value, takes precedence over the existence of a value for the key further along the chain. -I points to the rest of the C chain to be +C points to the rest of the C chain to be attached to the new C. This function takes ownership -of one reference to I, and returns one reference to the new +of one reference to C, and returns one reference to the new C. =cut diff --git a/hv_func.h b/hv_func.h index 708c6c7..b0e50e3 100644 --- a/hv_func.h +++ b/hv_func.h @@ -100,7 +100,7 @@ * are only needed to help derive these 3. * * U8TO32_LE(x) Read a little endian unsigned 32-bit int - * UNALIGNED_SAFE Defined if READ_UINT32 works on non-word boundaries + * UNALIGNED_SAFE Defined if unaligned access is safe * ROTL32(x,r) Rotate x left by r bits */ @@ -114,8 +114,6 @@ +((const U8 *)(d))[0]) #endif - -/* Now find best way we can to READ_UINT32 */ #if (BYTEORDER == 0x1234 || BYTEORDER == 0x12345678) && U32SIZE == 4 /* CPU endian matches murmurhash algorithm, so read 32-bit word directly */ #define U8TO32_LE(ptr) (*((U32*)(ptr))) @@ -139,7 +137,7 @@ #ifndef U64TYPE /* This probably isn't going to work, but failing with a compiler error due to lack of uint64_t is no worse than failing right now with an #error. */ -#define U64TYPE uint64_t +#define U64 uint64_t #endif #endif @@ -154,7 +152,7 @@ /* gcc recognises this code and generates a rotate instruction for CPUs with one */ #define ROTL32(x,r) (((U32)x << r) | ((U32)x >> (32 - r))) #ifdef HAS_QUAD - #define ROTL64(x,r) (((U64TYPE)x << r) | ((U64TYPE)x >> (64 - r))) + #define ROTL64(x,r) (((U64)x << r) | ((U64)x >> (64 - r))) #endif #endif @@ -182,14 +180,14 @@ #ifdef HAS_QUAD #define U8TO64_LE(p) \ - (((U64TYPE)((p)[0]) ) | \ - ((U64TYPE)((p)[1]) << 8) | \ - ((U64TYPE)((p)[2]) << 16) | \ - ((U64TYPE)((p)[3]) << 24) | \ - ((U64TYPE)((p)[4]) << 32) | \ - ((U64TYPE)((p)[5]) << 40) | \ - ((U64TYPE)((p)[6]) << 48) | \ - ((U64TYPE)((p)[7]) << 56)) + (((U64)((p)[0]) ) | \ + ((U64)((p)[1]) << 8) | \ + ((U64)((p)[2]) << 16) | \ + ((U64)((p)[3]) << 24) | \ + ((U64)((p)[4]) << 32) | \ + ((U64)((p)[5]) << 40) | \ + ((U64)((p)[6]) << 48) | \ + ((U64)((p)[7]) << 56)) #define SIPROUND \ do { \ @@ -204,19 +202,19 @@ PERL_STATIC_INLINE U32 S_perl_hash_siphash_2_4(const unsigned char * const seed, const unsigned char *in, const STRLEN inlen) { /* "somepseudorandomlygeneratedbytes" */ - U64TYPE v0 = UINT64_C(0x736f6d6570736575); - U64TYPE v1 = UINT64_C(0x646f72616e646f6d); - U64TYPE v2 = UINT64_C(0x6c7967656e657261); - U64TYPE v3 = UINT64_C(0x7465646279746573); - - U64TYPE b; - U64TYPE k0 = ((U64TYPE*)seed)[0]; - U64TYPE k1 = ((U64TYPE*)seed)[1]; - U64TYPE m; + U64 v0 = UINT64_C(0x736f6d6570736575); + U64 v1 = UINT64_C(0x646f72616e646f6d); + U64 v2 = UINT64_C(0x6c7967656e657261); + U64 v3 = UINT64_C(0x7465646279746573); + + U64 b; + U64 k0 = ((U64*)seed)[0]; + U64 k1 = ((U64*)seed)[1]; + U64 m; const int left = inlen & 7; const U8 *end = in + inlen - left; - b = ( ( U64TYPE )(inlen) ) << 56; + b = ( ( U64 )(inlen) ) << 56; v3 ^= k1; v2 ^= k0; v1 ^= k1; @@ -233,13 +231,13 @@ S_perl_hash_siphash_2_4(const unsigned char * const seed, const unsigned char *i switch( left ) { - case 7: b |= ( ( U64TYPE )in[ 6] ) << 48; - case 6: b |= ( ( U64TYPE )in[ 5] ) << 40; - case 5: b |= ( ( U64TYPE )in[ 4] ) << 32; - case 4: b |= ( ( U64TYPE )in[ 3] ) << 24; - case 3: b |= ( ( U64TYPE )in[ 2] ) << 16; - case 2: b |= ( ( U64TYPE )in[ 1] ) << 8; - case 1: b |= ( ( U64TYPE )in[ 0] ); break; + case 7: b |= ( ( U64 )in[ 6] ) << 48; + case 6: b |= ( ( U64 )in[ 5] ) << 40; + case 5: b |= ( ( U64 )in[ 4] ) << 32; + case 4: b |= ( ( U64 )in[ 3] ) << 24; + case 3: b |= ( ( U64 )in[ 2] ) << 16; + case 2: b |= ( ( U64 )in[ 1] ) << 8; + case 1: b |= ( ( U64 )in[ 0] ); break; case 0: break; } @@ -570,7 +568,7 @@ S_perl_hash_old_one_at_a_time(const unsigned char * const seed, const unsigned c return a 32 bit hash. Note uses unaligned 64 bit loads - will NOT work on machines with - strict alginment requirements. + strict alignment requirements. Also this code may not be suitable for big-endian machines. */ @@ -579,16 +577,16 @@ S_perl_hash_old_one_at_a_time(const unsigned char * const seed, const unsigned c PERL_STATIC_INLINE U32 S_perl_hash_murmur_hash_64a (const unsigned char * const seed, const unsigned char *str, const STRLEN len) { - const U64TYPE m = 0xc6a4a7935bd1e995; + const U64 m = UINT64_C(0xc6a4a7935bd1e995); const int r = 47; - U64TYPE h = *((U64TYPE*)seed) ^ len; - const U64TYPE * data = (const U64TYPE *)str; - const U64TYPE * end = data + (len/8); + U64 h = *((U64*)seed) ^ len; + const U64 * data = (const U64 *)str; + const U64 * end = data + (len/8); const unsigned char * data2; while(data != end) { - U64TYPE k = *data++; + U64 k = *data++; k *= m; k ^= k >> r; @@ -602,13 +600,13 @@ S_perl_hash_murmur_hash_64a (const unsigned char * const seed, const unsigned ch switch(len & 7) { - case 7: h ^= (U64TYPE)(data2[6]) << 48; /* fallthrough */ - case 6: h ^= (U64TYPE)(data2[5]) << 40; /* fallthrough */ - case 5: h ^= (U64TYPE)(data2[4]) << 32; /* fallthrough */ - case 4: h ^= (U64TYPE)(data2[3]) << 24; /* fallthrough */ - case 3: h ^= (U64TYPE)(data2[2]) << 16; /* fallthrough */ - case 2: h ^= (U64TYPE)(data2[1]) << 8; /* fallthrough */ - case 1: h ^= (U64TYPE)(data2[0]); /* fallthrough */ + case 7: h ^= (U64)(data2[6]) << 48; /* fallthrough */ + case 6: h ^= (U64)(data2[5]) << 40; /* fallthrough */ + case 5: h ^= (U64)(data2[4]) << 32; /* fallthrough */ + case 4: h ^= (U64)(data2[3]) << 24; /* fallthrough */ + case 3: h ^= (U64)(data2[2]) << 16; /* fallthrough */ + case 2: h ^= (U64)(data2[1]) << 8; /* fallthrough */ + case 1: h ^= (U64)(data2[0]); /* fallthrough */ h *= m; }; @@ -628,7 +626,7 @@ S_perl_hash_murmur_hash_64a (const unsigned char * const seed, const unsigned ch a 32 bit value Note uses unaligned 32 bit loads - will NOT work on machines with - strict alginment requirements. + strict alignment requirements. Also this code may not be suitable for big-endian machines. */ @@ -683,7 +681,7 @@ S_perl_hash_murmur_hash_64b (const unsigned char * const seed, const unsigned ch h1 ^= h2 >> 17; h1 *= m; - U64TYPE h = h1; + U64 h = h1; h = (h << 32) | h2; */ diff --git a/intrpvar.h b/intrpvar.h index fad08ba..20fd4df 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -60,9 +60,6 @@ PERLVAR(I, markstack, I32 *) /* stack_sp locations we're PERLVAR(I, markstack_ptr, I32 *) PERLVAR(I, markstack_max, I32 *) -PERLVARI(I, sawalias, bool, FALSE) /* must enable common-vars - pessimisation */ - #ifdef PERL_HASH_RANDOMIZE_KEYS #ifdef USE_PERL_PERTURB_KEYS PERLVARI(I, hash_rand_bits_enabled, U8, 1) /* used to randomize hash stuff 0 == no-random, 1 == random, 2 == determinsitic */ @@ -179,7 +176,7 @@ PERLVAR(I, statgv, GV *) PERLVARI(I, statname, SV *, NULL) #ifdef HAS_TIMES -/* Will be removed soon after v5.23.1. See RT #121351 */ +/* Will be removed soon after v5.23.2. See RT #121351 */ PERLVAR(I, timesbuf, struct tms) #endif @@ -492,7 +489,8 @@ PERLVAR(I, sys_intern, struct interp_intern) /* more statics moved here */ PERLVAR(I, DBcv, CV *) /* from perl.c */ -PERLVARI(I, generation, int, 100) /* from op.c */ +PERLVARI(I, generation, int, 100) /* scan sequence# for OP_AASSIGN + compile-time common elem detection */ PERLVAR(I, unicode, U32) /* Unicode features: $ENV{PERL_UNICODE} or -C */ @@ -753,7 +751,7 @@ PERLVARI(I, globhook, globhook_t, NULL) PERLVARI(I, padlist_generation, U32, 1) /* id to identify padlist clones */ -/* The last unconditional member of the interpreter structure when 5.23.1 was +/* The last unconditional member of the interpreter structure when 5.23.2 was released. The offset of the end of this is baked into a global variable in any shared perl library which will allow a sanity test in future perl releases. */ diff --git a/inline_invlist.c b/invlist_inline.h similarity index 99% rename from inline_invlist.c rename to invlist_inline.h index 1589f95..4ce04f9 100644 --- a/inline_invlist.c +++ b/invlist_inline.h @@ -1,4 +1,4 @@ -/* inline_invlist.c +/* invlist_inline.h * * Copyright (C) 2012 by Larry Wall and others * diff --git a/l1_char_class_tab.h b/l1_char_class_tab.h index bdab989..434190f 100644 --- a/l1_char_class_tab.h +++ b/l1_char_class_tab.h @@ -263,7 +263,7 @@ /* U+FC u with diaeresis */ (1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_LOWER)|(1U<<_CC_PRINT)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD), /* U+FD y with acute */ (1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_LOWER)|(1U<<_CC_PRINT)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD), /* U+FE thorn */ (1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_LOWER)|(1U<<_CC_PRINT)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD), -/* U+FF y with diaeresis */ (1U<<_CC_NONLATIN1_SIMPLE_FOLD)|(1U<<_CC_NONLATIN1_FOLD)|(1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_LOWER)|(1U<<_CC_PRINT)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD), +/* U+FF y with diaeresis */ (1U<<_CC_NONLATIN1_SIMPLE_FOLD)|(1U<<_CC_NONLATIN1_FOLD)|(1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_LOWER)|(1U<<_CC_PRINT)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD) #endif /* ASCII/Latin1 */ @@ -526,7 +526,7 @@ /* 0xFC U+DC U with DIAERESIS */ (1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_PRINT)|(1U<<_CC_UPPER)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD), /* 0xFD U+D9 U with GRAVE */ (1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_PRINT)|(1U<<_CC_UPPER)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD), /* 0xFE U+DA U with ACUTE */ (1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_PRINT)|(1U<<_CC_UPPER)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD), -/* 0xFF U+9F APC */ (1U<<_CC_CNTRL)|(1U<<_CC_QUOTEMETA), +/* 0xFF U+9F APC */ (1U<<_CC_CNTRL)|(1U<<_CC_QUOTEMETA) #endif /* EBCDIC 1047 */ @@ -789,7 +789,7 @@ /* 0xFC U+DC U with DIAERESIS */ (1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_PRINT)|(1U<<_CC_UPPER)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD), /* 0xFD U+D9 U with GRAVE */ (1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_PRINT)|(1U<<_CC_UPPER)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD), /* 0xFE U+DA U with ACUTE */ (1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_PRINT)|(1U<<_CC_UPPER)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD), -/* 0xFF U+9F APC */ (1U<<_CC_CNTRL)|(1U<<_CC_QUOTEMETA), +/* 0xFF U+9F APC */ (1U<<_CC_CNTRL)|(1U<<_CC_QUOTEMETA) #endif /* EBCDIC 037 */ @@ -1052,7 +1052,7 @@ /* 0xFC U+DC U with DIAERESIS */ (1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_PRINT)|(1U<<_CC_UPPER)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD), /* 0xFD U+7D '}' */ (1U<<_CC_ASCII)|(1U<<_CC_GRAPH)|(1U<<_CC_PRINT)|(1U<<_CC_PUNCT)|(1U<<_CC_QUOTEMETA), /* 0xFE U+DA U with ACUTE */ (1U<<_CC_ALPHANUMERIC)|(1U<<_CC_ALPHA)|(1U<<_CC_CASED)|(1U<<_CC_CHARNAME_CONT)|(1U<<_CC_GRAPH)|(1U<<_CC_IDFIRST)|(1U<<_CC_PRINT)|(1U<<_CC_UPPER)|(1U<<_CC_WORDCHAR)|(1U<<_CC_IS_IN_SOME_FOLD), -/* 0xFF U+7E '~' */ (1U<<_CC_ASCII)|(1U<<_CC_GRAPH)|(1U<<_CC_PRINT)|(1U<<_CC_PUNCT)|(1U<<_CC_QUOTEMETA), +/* 0xFF U+7E '~' */ (1U<<_CC_ASCII)|(1U<<_CC_GRAPH)|(1U<<_CC_PRINT)|(1U<<_CC_PUNCT)|(1U<<_CC_QUOTEMETA) #endif /* EBCDIC POSIX-BC */ diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index c9db867..f889efc 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.023001"; +our $VERSION = "5.023002"; $bits{$_}{3} = 'OPpENTERSUB_AMPER' for qw(entersub rv2cv); $bits{$_}{6} = 'OPpENTERSUB_DB' for qw(entersub rv2cv); @@ -228,7 +228,7 @@ my @bf = ( }, ); -@{$bits{aassign}}{6,1,0} = ('OPpASSIGN_COMMON', $bf[1], $bf[1]); +@{$bits{aassign}}{6,5,4,1,0} = ('OPpASSIGN_COMMON_SCALAR', 'OPpASSIGN_COMMON_RC1', 'OPpASSIGN_COMMON_AGG', $bf[1], $bf[1]); $bits{abs}{0} = $bf[0]; @{$bits{accept}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); @{$bits{add}}{1,0} = ($bf[1], $bf[1]); @@ -567,7 +567,9 @@ our %defines = ( OPpARG3_MASK => 7, OPpARG4_MASK => 15, OPpASSIGN_BACKWARDS => 64, - OPpASSIGN_COMMON => 64, + OPpASSIGN_COMMON_AGG => 16, + OPpASSIGN_COMMON_RC1 => 32, + OPpASSIGN_COMMON_SCALAR => 64, OPpASSIGN_CV_TO_GV => 128, OPpCONST_BARE => 64, OPpCONST_ENTERED => 16, @@ -660,7 +662,9 @@ our %defines = ( our %labels = ( OPpALLOW_FAKE => 'FAKE', OPpASSIGN_BACKWARDS => 'BKWARD', - OPpASSIGN_COMMON => 'COMMON', + OPpASSIGN_COMMON_AGG => 'COM_AGG', + OPpASSIGN_COMMON_RC1 => 'COM_RC1', + OPpASSIGN_COMMON_SCALAR => 'COM_SCALAR', OPpASSIGN_CV_TO_GV => 'CV2GV', OPpCONST_BARE => 'BARE', OPpCONST_ENTERED => 'ENTERED', @@ -750,7 +754,7 @@ our %labels = ( our %ops_using = ( OPpALLOW_FAKE => [qw(rv2gv)], OPpASSIGN_BACKWARDS => [qw(sassign)], - OPpASSIGN_COMMON => [qw(aassign)], + OPpASSIGN_COMMON_AGG => [qw(aassign)], OPpCONST_BARE => [qw(const)], OPpCOREARGS_DEREF1 => [qw(coreargs)], OPpEARLY_CV => [qw(gv)], @@ -793,6 +797,8 @@ our %ops_using = ( OPpTRANS_COMPLEMENT => [qw(trans transr)], ); +$ops_using{OPpASSIGN_COMMON_RC1} = $ops_using{OPpASSIGN_COMMON_AGG}; +$ops_using{OPpASSIGN_COMMON_SCALAR} = $ops_using{OPpASSIGN_COMMON_AGG}; $ops_using{OPpASSIGN_CV_TO_GV} = $ops_using{OPpASSIGN_BACKWARDS}; $ops_using{OPpCONST_ENTERED} = $ops_using{OPpCONST_BARE}; $ops_using{OPpCONST_NOVER} = $ops_using{OPpCONST_BARE}; diff --git a/lib/Unicode/UCD.pm b/lib/Unicode/UCD.pm index 06fbfd1..1854982 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.61'; +our $VERSION = '0.62'; require Exporter; @@ -775,7 +775,6 @@ sub charprop ($$) { } else { croak __PACKAGE__, "::charprop: Internal error: unknown format '$format'. Please perlbug this"; - return undef; } } @@ -877,6 +876,10 @@ sub _charblocks { local $_; local $/ = "\n"; while (<$BLOCKSFH>) { + + # Old versions used a different syntax to mark the range. + $_ =~ s/;\s+/../ if $v_unicode_version lt v3.1.0; + if (/^([0-9A-F]+)\.\.([0-9A-F]+);\s+(.+)/) { my ($lo, $hi) = (hex($1), hex($2)); my $subrange = [ $lo, $hi, $3 ]; @@ -2652,9 +2655,11 @@ or even better, C<"Gc=LC">). Many Unicode properties have more than one name (or alias). C understands all of these, including Perl extensions to them. Ambiguities are -resolved as described above for L. The Perl internal -property "Perl_Decimal_Digit, described below, is also accepted. An empty -list is returned if the property name is unknown. +resolved as described above for L (except if a property has +both a complete mapping, and a binary C/C mapping, then specifying the +property name prefixed by C<"is"> causes the binary one to be returned). The +Perl internal property "Perl_Decimal_Digit, described below, is also accepted. +An empty list is returned if the property name is unknown. See L for the properties acceptable as inputs to this function. @@ -3253,8 +3258,8 @@ RETRY: # we need to also read in that table. Create a hash with the keys # being the code points, and the values being a list of the # aliases for the code point key. - my ($aliases_code_points, $aliases_maps, undef, undef) = - &prop_invmap('Name_Alias'); + my ($aliases_code_points, $aliases_maps, undef, undef) + = &prop_invmap("_Perl_Name_Alias", '_perl_core_internal_ok'); my %aliases; for (my $i = 0; $i < @$aliases_code_points; $i++) { my $code_point = $aliases_code_points->[$i]; @@ -3545,7 +3550,19 @@ RETRY: if ($swash->{'LIST'} =~ /^V/) { @invlist = split "\n", $swash->{'LIST'} =~ s/ \s* (?: \# .* )? $ //xmgr; - shift @invlist; + + shift @invlist; # Get rid of 'V'; + + # Could need to be inverted: add or subtract a 0 at the beginning of + # the list. + if ($swash->{'INVERT_IT'}) { + if (@invlist && $invlist[0] == 0) { + shift @invlist; + } + else { + unshift @invlist, 0; + } + } foreach my $i (0 .. @invlist - 1) { $invmap[$i] = ($i % 2 == 0) ? 'Y' : 'N' } @@ -3558,6 +3575,10 @@ RETRY: } } else { + if ($swash->{'INVERT_IT'}) { + croak __PACKAGE__, ":prop_invmap: Don't know how to deal with inverted"; + } + # The LIST input lines look like: # ... # 0374\t\tCommon @@ -3873,7 +3894,7 @@ RETRY: map { $_ = [ split " ", $_ ] if $_ =~ / / } @invmap; $format = 'sl'; } - elsif ($returned_prop eq 'ToNameAlias') { + elsif ($returned_prop =~ / To ( _Perl )? NameAlias/x) { # This property currently doesn't have any lists, but theoretically # could @@ -3888,7 +3909,14 @@ RETRY: # to indicate that need to add code point to it. $format = 'ar'; } - elsif ($format ne 'n' && $format ne 'a') { + elsif ($format eq 'ax') { + + # Normally 'ax' properties have overrides, and will have been handled + # above, but if not, they still need adjustment, and the hex values + # have already been converted to decimal + $format = 'a'; + } + elsif ($format ne 'n' && $format !~ / ^ a /x) { # All others are simple scalars $format = 's'; @@ -4079,6 +4107,15 @@ for its block using C). Note that starting in Unicode 6.1, many of the block names have shorter synonyms. These are always given in the new style. +=head2 Use with older Unicode versions + +The functions in this module work as well as can be expected when +used on earlier Unicode versions. But, obviously, they use the available data +from that Unicode version. For example, if the Unicode version predates the +definition of the script property (Unicode 3.1), then any function that deals +with scripts is going to return C for the script portion of the return +value. + =head1 AUTHOR Jarkko Hietaniemi. Now maintained by perl5 porters. diff --git a/lib/Unicode/UCD.t b/lib/Unicode/UCD.t index a799dd0..22b2edb 100644 --- a/lib/Unicode/UCD.t +++ b/lib/Unicode/UCD.t @@ -19,14 +19,22 @@ use Test::More; use Unicode::UCD qw(charinfo charprop charprops_all); +my $expected_version = '8.0.0'; +my $current_version = Unicode::UCD::UnicodeVersion; +my $v_unicode_version = pack "C*", split /\./, $current_version; +my $unknown_script = ($v_unicode_version lt v5.0.0) + ? 'Common' + : 'Unknown'; my $input_record_separator = 7; # Make sure Unicode::UCD isn't affected by $/ = $input_record_separator; # setting this. my $charinfo; is(charinfo(0x110000), undef, "Verify charinfo() of non-unicode is undef"); -is(charprop(0x110000, 'age'), "Unassigned", "Verify charprop(age) of non-unicode is Unassigned"); -is(charprop(0x110000, 'in'), "Unassigned", "Verify charprop(in), a bipartite Perl extension, works"); +if ($v_unicode_version ge v3.2.0) { + is(lc charprop(0x110000, 'age'), lc "Unassigned", "Verify charprop(age) of non-unicode is Unassigned"); + is(charprop(0x110000, 'in'), "Unassigned", "Verify charprop(in), a bipartite Perl extension, works"); +} is(charprop(0x110000, 'Any'), undef, "Verify charprop of non-bipartite Perl extension returns undef"); my $cp = 0; @@ -37,9 +45,10 @@ is($charinfo->{code}, "0000", is($charinfo->{name}, ""); is(charprop($cp, "name"), ""); -# This gets a sl-type property returning a flattened list -is(charprop($cp, "name_alias"), "NULL: control,NUL: abbreviation"); - +if ($v_unicode_version ge v6.1.0) { + # This gets a sl-type property returning a flattened list + is(charprop($cp, "name_alias"), "NULL: control,NUL: abbreviation"); +} is($charinfo->{category}, "Cc"); is(charprop($cp, "category"), "Control"); is($charinfo->{combining}, "0"); @@ -66,8 +75,8 @@ is($charinfo->{title}, ""); is(charprop($cp, "tc"), "\0"); is($charinfo->{block}, "Basic Latin"); is(charprop($cp, "block"), "Basic_Latin"); -is($charinfo->{script}, "Common"); -is(charprop($cp, "script"), "Common"); +is($charinfo->{script}, "Common") if $v_unicode_version gt v3.0.1; +is(charprop($cp, "script"), "Common") if $v_unicode_version gt v3.0.1; $cp = utf8::unicode_to_native(0x41); my $A_code = sprintf("%04X", ord("A")); @@ -103,8 +112,8 @@ is($charinfo->{title}, ""); is(charprop($cp, 'tc'), "A"); is($charinfo->{block}, "Basic Latin"); is(charprop($cp, 'block'), "Basic_Latin"); -is($charinfo->{script}, "Latin"); -is(charprop($cp, 'script'), "Latin"); +is($charinfo->{script}, "Latin") if $v_unicode_version gt v3.0.1; +is(charprop($cp, 'script'), "Latin") if $v_unicode_version gt v3.0.1; $cp = 0x100; $charinfo = charinfo($cp); @@ -138,8 +147,8 @@ is($charinfo->{title}, ""); is(charprop($cp, 'tc'), "\x{100}"); is($charinfo->{block}, "Latin Extended-A"); is(charprop($cp, 'block'), "Latin_Extended_A"); -is($charinfo->{script}, "Latin"); -is(charprop($cp, 'script'), "Latin"); +is($charinfo->{script}, "Latin") if $v_unicode_version gt v3.0.1; +is(charprop($cp, 'script'), "Latin") if $v_unicode_version gt v3.0.1; $cp = 0x590; # 0x0590 is in the Hebrew block but unused. $charinfo = charinfo($cp); @@ -152,7 +161,9 @@ is(charprop($cp, 'gc'), "Unassigned"); is($charinfo->{combining}, undef); is(charprop($cp, 'ccc'), "Not_Reordered"); is($charinfo->{bidi}, undef); -is(charprop($cp, 'bc'), "Right_To_Left"); +if ($v_unicode_version gt v3.2.0) { + is(charprop($cp, 'bc'), "Right_To_Left"); +} is($charinfo->{decomposition}, undef); is(charprop($cp, 'dm'), "\x{590}"); is($charinfo->{decimal}, undef); @@ -174,7 +185,8 @@ is(charprop($cp, 'tc'), "\x{590}"); is($charinfo->{block}, undef); is(charprop($cp, 'block'), "Hebrew"); is($charinfo->{script}, undef); -is(charprop($cp, 'script'), "Unknown"); +is(charprop($cp, 'script'), $unknown_script) if $v_unicode_version gt +v3.0.1; # 0x05d0 is in the Hebrew block and used. @@ -210,8 +222,8 @@ is($charinfo->{title}, ""); is(charprop($cp, 'tc'), "\x{5d0}"); is($charinfo->{block}, "Hebrew"); is(charprop($cp, 'block'), "Hebrew"); -is($charinfo->{script}, "Hebrew"); -is(charprop($cp, 'script'), "Hebrew"); +is($charinfo->{script}, "Hebrew") if $v_unicode_version gt v3.0.1; +is(charprop($cp, 'script'), "Hebrew") if $v_unicode_version gt v3.0.1; # An open syllable in Hangul. @@ -247,8 +259,8 @@ is($charinfo->{title}, ""); is(charprop($cp, 'tc'), "\x{AC00}"); is($charinfo->{block}, "Hangul Syllables"); is(charprop($cp, 'block'), "Hangul_Syllables"); -is($charinfo->{script}, "Hangul"); -is(charprop($cp, 'script'), "Hangul"); +is($charinfo->{script}, "Hangul") if $v_unicode_version gt v3.0.1; +is(charprop($cp, 'script'), "Hangul") if $v_unicode_version gt v3.0.1; # A closed syllable in Hangul. @@ -284,85 +296,89 @@ is($charinfo->{title}, ""); is(charprop($cp, 'tc'), "\x{AE00}"); is($charinfo->{block}, "Hangul Syllables"); is(charprop($cp, 'block'), "Hangul_Syllables"); -is($charinfo->{script}, "Hangul"); -is(charprop($cp, 'script'), "Hangul"); - -$cp = 0x1D400; -$charinfo = charinfo($cp); +is($charinfo->{script}, "Hangul") if $v_unicode_version gt v3.0.1; +is(charprop($cp, 'script'), "Hangul") if $v_unicode_version gt v3.0.1; + +if ($v_unicode_version gt v3.0.1) { + $cp = 0x1D400; + $charinfo = charinfo($cp); + + is($charinfo->{code}, "1D400", "MATHEMATICAL BOLD CAPITAL A"); + is($charinfo->{name}, "MATHEMATICAL BOLD CAPITAL A"); + is(charprop($cp, 'name'), "MATHEMATICAL BOLD CAPITAL A"); + is($charinfo->{category}, "Lu"); + is(charprop($cp, 'gc'), "Uppercase_Letter"); + is($charinfo->{combining}, "0"); + is(charprop($cp, 'ccc'), "Not_Reordered"); + is($charinfo->{bidi}, "L"); + is(charprop($cp, 'bc'), "Left_To_Right"); + is($charinfo->{decomposition}, " $A_code"); + is(charprop($cp, 'dm'), "A"); + is($charinfo->{decimal}, ""); + is($charinfo->{digit}, ""); + is($charinfo->{numeric}, ""); + is(charprop($cp, 'nv'), "NaN"); + is($charinfo->{mirrored}, "N"); + is(charprop($cp, 'bidim'), "No"); + is($charinfo->{unicode10}, ""); + is(charprop($cp, 'na1'), ""); + is($charinfo->{comment}, ""); + is(charprop($cp, 'isc'), ""); + is($charinfo->{upper}, ""); + is(charprop($cp, 'uc'), "\x{1D400}"); + is($charinfo->{lower}, ""); + is(charprop($cp, 'lc'), "\x{1D400}"); + is($charinfo->{title}, ""); + is(charprop($cp, 'tc'), "\x{1D400}"); + is($charinfo->{block}, "Mathematical Alphanumeric Symbols"); + is(charprop($cp, 'block'), "Mathematical_Alphanumeric_Symbols"); + is($charinfo->{script}, "Common"); + is(charprop($cp, 'script'), "Common"); +} -is($charinfo->{code}, "1D400", "MATHEMATICAL BOLD CAPITAL A"); -is($charinfo->{name}, "MATHEMATICAL BOLD CAPITAL A"); -is(charprop($cp, 'name'), "MATHEMATICAL BOLD CAPITAL A"); -is($charinfo->{category}, "Lu"); -is(charprop($cp, 'gc'), "Uppercase_Letter"); -is($charinfo->{combining}, "0"); -is(charprop($cp, 'ccc'), "Not_Reordered"); -is($charinfo->{bidi}, "L"); -is(charprop($cp, 'bc'), "Left_To_Right"); -is($charinfo->{decomposition}, " $A_code"); -is(charprop($cp, 'dm'), "A"); -is($charinfo->{decimal}, ""); -is($charinfo->{digit}, ""); -is($charinfo->{numeric}, ""); -is(charprop($cp, 'nv'), "NaN"); -is($charinfo->{mirrored}, "N"); -is(charprop($cp, 'bidim'), "No"); -is($charinfo->{unicode10}, ""); -is(charprop($cp, 'na1'), ""); -is($charinfo->{comment}, ""); -is(charprop($cp, 'isc'), ""); -is($charinfo->{upper}, ""); -is(charprop($cp, 'uc'), "\x{1D400}"); -is($charinfo->{lower}, ""); -is(charprop($cp, 'lc'), "\x{1D400}"); -is($charinfo->{title}, ""); -is(charprop($cp, 'tc'), "\x{1D400}"); -is($charinfo->{block}, "Mathematical Alphanumeric Symbols"); -is(charprop($cp, 'block'), "Mathematical_Alphanumeric_Symbols"); -is($charinfo->{script}, "Common"); -is(charprop($cp, 'script'), "Common"); - -$cp = 0x9FBA; #Bug 58428 -$charinfo = charinfo(0x9FBA); - -is($charinfo->{code}, "9FBA", "U+9FBA"); -is($charinfo->{name}, "CJK UNIFIED IDEOGRAPH-9FBA"); -is(charprop($cp, 'name'), "CJK UNIFIED IDEOGRAPH-9FBA"); -is($charinfo->{category}, "Lo"); -is(charprop($cp, 'gc'), "Other_Letter"); -is($charinfo->{combining}, "0"); -is(charprop($cp, 'ccc'), "Not_Reordered"); -is($charinfo->{bidi}, "L"); -is(charprop($cp, 'bc'), "Left_To_Right"); -is($charinfo->{decomposition}, ""); -is(charprop($cp, 'dm'), "\x{9FBA}"); -is($charinfo->{decimal}, ""); -is($charinfo->{digit}, ""); -is($charinfo->{numeric}, ""); -is(charprop($cp, 'nv'), "NaN"); -is($charinfo->{mirrored}, "N"); -is(charprop($cp, 'bidim'), "No"); -is($charinfo->{unicode10}, ""); -is(charprop($cp, 'na1'), ""); -is($charinfo->{comment}, ""); -is(charprop($cp, 'isc'), ""); -is($charinfo->{upper}, ""); -is(charprop($cp, 'uc'), "\x{9FBA}"); -is($charinfo->{lower}, ""); -is(charprop($cp, 'lc'), "\x{9FBA}"); -is($charinfo->{title}, ""); -is(charprop($cp, 'tc'), "\x{9FBA}"); -is($charinfo->{block}, "CJK Unified Ideographs"); -is(charprop($cp, 'block'), "CJK_Unified_Ideographs"); -is($charinfo->{script}, "Han"); -is(charprop($cp, 'script'), "Han"); +if ($v_unicode_version ge v4.1.0) { + $cp = 0x9FBA; #Bug 58428 + $charinfo = charinfo(0x9FBA); + + is($charinfo->{code}, "9FBA", "U+9FBA"); + is($charinfo->{name}, "CJK UNIFIED IDEOGRAPH-9FBA"); + is(charprop($cp, 'name'), "CJK UNIFIED IDEOGRAPH-9FBA"); + is($charinfo->{category}, "Lo"); + is(charprop($cp, 'gc'), "Other_Letter"); + is($charinfo->{combining}, "0"); + is(charprop($cp, 'ccc'), "Not_Reordered"); + is($charinfo->{bidi}, "L"); + is(charprop($cp, 'bc'), "Left_To_Right"); + is($charinfo->{decomposition}, ""); + is(charprop($cp, 'dm'), "\x{9FBA}"); + is($charinfo->{decimal}, ""); + is($charinfo->{digit}, ""); + is($charinfo->{numeric}, ""); + is(charprop($cp, 'nv'), "NaN"); + is($charinfo->{mirrored}, "N"); + is(charprop($cp, 'bidim'), "No"); + is($charinfo->{unicode10}, ""); + is(charprop($cp, 'na1'), ""); + is($charinfo->{comment}, ""); + is(charprop($cp, 'isc'), ""); + is($charinfo->{upper}, ""); + is(charprop($cp, 'uc'), "\x{9FBA}"); + is($charinfo->{lower}, ""); + is(charprop($cp, 'lc'), "\x{9FBA}"); + is($charinfo->{title}, ""); + is(charprop($cp, 'tc'), "\x{9FBA}"); + is($charinfo->{block}, "CJK Unified Ideographs"); + is(charprop($cp, 'block'), "CJK_Unified_Ideographs"); + is($charinfo->{script}, "Han"); + is(charprop($cp, 'script'), "Han"); +} use Unicode::UCD qw(charblock charscript); # 0x0590 is in the Hebrew block but unused. is(charblock(0x590), "Hebrew", "0x0590 - Hebrew unused charblock"); -is(charscript(0x590), "Unknown", "0x0590 - Hebrew unused charscript"); +is(charscript(0x590), $unknown_script, "0x0590 - Hebrew unused charscript") if $v_unicode_version gt v3.0.1; is(charblock(0x1FFFF), "No_Block", "0x1FFFF - unused charblock"); my $fraction_3_4_code = sprintf("%04X", utf8::unicode_to_native(0xbe)); @@ -401,8 +417,8 @@ is($charinfo->{title}, ""); is(charprop($cp, 'tc'), chr hex $cp); is($charinfo->{block}, "Latin-1 Supplement"); is(charprop($cp, 'block'), "Latin_1_Supplement"); -is($charinfo->{script}, "Common"); -is(charprop($cp, 'script'), "Common"); +is($charinfo->{script}, "Common") if $v_unicode_version gt v3.0.1; +is(charprop($cp, 'script'), "Common") if $v_unicode_version gt v3.0.1; # This is to test a case where both simple and full lowercases exist and # differ @@ -435,13 +451,13 @@ is(charprop($cp, 'isc'), ""); is($charinfo->{upper}, ""); is(charprop($cp, 'uc'), "\x{130}"); is($charinfo->{lower}, $i_code); -is(charprop($cp, 'lc'), "i\x{307}"); +is(charprop($cp, 'lc'), "i\x{307}") if $v_unicode_version ge v3.2.0; is($charinfo->{title}, ""); is(charprop($cp, 'tc'), "\x{130}"); is($charinfo->{block}, "Latin Extended-A"); is(charprop($cp, 'block'), "Latin_Extended_A"); -is($charinfo->{script}, "Latin"); -is(charprop($cp, 'script'), "Latin"); +is($charinfo->{script}, "Latin") if $v_unicode_version gt v3.0.1; +is(charprop($cp, 'script'), "Latin") if $v_unicode_version gt v3.0.1; # This is to test a case where both simple and full uppercases exist and # differ @@ -478,19 +494,23 @@ is($charinfo->{title}, "1F88"); is(charprop($cp, "tc"), "\x{1F88}"); is($charinfo->{block}, "Greek Extended"); is(charprop($cp, "block"), "Greek_Extended"); -is($charinfo->{script}, "Greek"); -is(charprop($cp, "script"), "Greek"); +is($charinfo->{script}, "Greek") if $v_unicode_version gt v3.0.1; +is(charprop($cp, "script"), "Greek") if $v_unicode_version gt v3.0.1; is(charprop(ord("A"), "foo"), undef, "Verify charprop of unknown property returns "); # These were created from inspection of the code to exercise the branches -is(charprop(ord("("), "bpb"), ")", +if ($v_unicode_version ge v6.3.0) { + is(charprop(ord("("), "bpb"), ")", "Verify charprop figures out that s-type properties can be char"); +} is(charprop(ord("9"), "nv"), 9, "Verify charprop can adjust an ar-type property"); -is(charprop(utf8::unicode_to_native(0xAD), "NFKC_Casefold"), "", +if ($v_unicode_version ge v5.2.0) { + is(charprop(utf8::unicode_to_native(0xAD), "NFKC_Casefold"), "", "Verify charprop can handle an \"\" in ae-type property"); +} my $mark_props_ref = charprops_all(0x300); is($mark_props_ref->{'Bidi_Class'}, "Nonspacing_Mark", @@ -499,9 +519,13 @@ is($mark_props_ref->{'Bidi_Mirrored'}, "No"); is($mark_props_ref->{'Canonical_Combining_Class'}, "Above"); is($mark_props_ref->{'Case_Folding'}, "\x{300}"); is($mark_props_ref->{'Decomposition_Mapping'}, "\x{300}"); -is($mark_props_ref->{'Decomposition_Type'}, "None"); +is($mark_props_ref->{'Decomposition_Type'}, ($v_unicode_version le v4.0.0) + ? "none" + : "None"); is($mark_props_ref->{'General_Category'}, "Nonspacing_Mark"); -is($mark_props_ref->{'ISO_Comment'}, ""); +if ($v_unicode_version gt v5.1.0) { + is($mark_props_ref->{'ISO_Comment'}, ""); +} is($mark_props_ref->{'Lowercase_Mapping'}, "\x{300}"); is($mark_props_ref->{'Name'}, "COMBINING GRAVE ACCENT"); is($mark_props_ref->{'Numeric_Type'}, "None"); @@ -522,36 +546,40 @@ ok(exists $charblocks->{Thai}, 'Thai charblock exists'); is($charblocks->{Thai}->[0]->[0], hex('0e00')); ok(!exists $charblocks->{PigLatin}, 'PigLatin charblock does not exist'); -my $charscripts = charscripts(); +if ($v_unicode_version gt v3.0.1) { + my $charscripts = charscripts(); -ok(exists $charscripts->{Armenian}, 'Armenian charscript exists'); -is($charscripts->{Armenian}->[0]->[0], hex('0531')); -ok(!exists $charscripts->{PigLatin}, 'PigLatin charscript does not exist'); + ok(exists $charscripts->{Armenian}, 'Armenian charscript exists'); + is($charscripts->{Armenian}->[0]->[0], hex('0531')); + ok(!exists $charscripts->{PigLatin}, 'PigLatin charscript does not exist'); -my $charscript; + my $charscript; -$charscript = charscript("12ab"); -is($charscript, 'Ethiopic', 'Ethiopic charscript'); + $charscript = charscript("12ab"); + is($charscript, 'Ethiopic', 'Ethiopic charscript'); -$charscript = charscript("0x12ab"); -is($charscript, 'Ethiopic'); + $charscript = charscript("0x12ab"); + is($charscript, 'Ethiopic'); -$charscript = charscript("U+12ab"); -is($charscript, 'Ethiopic'); + $charscript = charscript("U+12ab"); + is($charscript, 'Ethiopic'); -my $ranges; + my $ranges; -$ranges = charscript('Ogham'); -is($ranges->[0]->[0], hex('1680'), 'Ogham charscript'); -is($ranges->[0]->[1], hex('169C')); + if ($v_unicode_version gt v4.0.0) { + $ranges = charscript('Ogham'); + is($ranges->[0]->[0], hex('1680'), 'Ogham charscript'); + is($ranges->[0]->[1], hex('169C')); + } -use Unicode::UCD qw(charinrange); + use Unicode::UCD qw(charinrange); -$ranges = charscript('Cherokee'); -ok(!charinrange($ranges, "139f"), 'Cherokee charscript'); -ok( charinrange($ranges, "13a0")); -ok( charinrange($ranges, "13f4")); -ok(!charinrange($ranges, "13ff")); + $ranges = charscript('Cherokee'); + ok(!charinrange($ranges, "139f"), 'Cherokee charscript'); + ok( charinrange($ranges, "13a0")); + ok( charinrange($ranges, "13f4")); + ok(!charinrange($ranges, "13ff")); +} use Unicode::UCD qw(general_categories); @@ -571,7 +599,8 @@ is($bt->{AL}, 'Right-to-Left Arabic', 'AL is Right-to-Left Arabic'); # If this fails, then maybe one should look at the Unicode changes to see # what else might need to be updated. -is(Unicode::UCD::UnicodeVersion, '8.0.0', 'UnicodeVersion'); +ok($current_version le $expected_version, + "Verify there isn't a new Unicode version to upgrade to"); use Unicode::UCD qw(compexcl); @@ -593,66 +622,93 @@ is($casefold->{full}, $a_code, 'casefold native(0x41) full'); is($casefold->{simple}, $a_code, 'casefold native(0x41) simple'); is($casefold->{turkic}, "", 'casefold native(0x41) turkic'); -$casefold = casefold(utf8::unicode_to_native(0xdf)); my $sharp_s_code = sprintf("%04X", utf8::unicode_to_native(0xdf)); my $S_code = sprintf("%04X", ord "S"); my $s_code = sprintf("%04X", ord "s"); -is($casefold->{code}, $sharp_s_code, 'casefold native(0xDF) code'); -is($casefold->{status}, 'F', 'casefold native(0xDF) status'); -is($casefold->{mapping}, "$s_code $s_code", 'casefold native(0xDF) mapping'); -is($casefold->{full}, "$s_code $s_code", 'casefold native(0xDF) full'); -is($casefold->{simple}, "", 'casefold native(0xDF) simple'); -is($casefold->{turkic}, "", 'casefold native(0xDF) turkic'); - -# Do different tests depending on if version < 3.2, or not. -my $v_unicode_version = pack "C*", split /\./, Unicode::UCD::UnicodeVersion(); -if ($v_unicode_version lt v3.2.0) { - $casefold = casefold(0x130); - - is($casefold->{code}, '0130', 'casefold 0x130 code'); - is($casefold->{status}, 'I' , 'casefold 0x130 status'); - is($casefold->{mapping}, $i_code, 'casefold 0x130 mapping'); - is($casefold->{full}, $i_code, 'casefold 0x130 full'); - is($casefold->{simple}, $i_code, 'casefold 0x130 simple'); - is($casefold->{turkic}, $i_code, 'casefold 0x130 turkic'); - - $casefold = casefold(0x131); - - is($casefold->{code}, '0131', 'casefold 0x131 code'); - is($casefold->{status}, 'I' , 'casefold 0x131 status'); - is($casefold->{mapping}, $i_code, 'casefold 0x131 mapping'); - is($casefold->{full}, $i_code, 'casefold 0x131 full'); - is($casefold->{simple}, $i_code, 'casefold 0x131 simple'); - is($casefold->{turkic}, $i_code, 'casefold 0x131 turkic'); -} else { - $casefold = casefold(utf8::unicode_to_native(0x49)); - - is($casefold->{code}, $I_code, 'casefold native(0x49) code'); - is($casefold->{status}, 'C' , 'casefold native(0x49) status'); - is($casefold->{mapping}, $i_code, 'casefold native(0x49) mapping'); - is($casefold->{full}, $i_code, 'casefold native(0x49) full'); - is($casefold->{simple}, $i_code, 'casefold native(0x49) simple'); - is($casefold->{turkic}, "0131", 'casefold native(0x49) turkic'); - - $casefold = casefold(0x130); - - is($casefold->{code}, '0130', 'casefold 0x130 code'); - is($casefold->{status}, 'F' , 'casefold 0x130 status'); - is($casefold->{mapping}, "$i_code 0307", 'casefold 0x130 mapping'); - is($casefold->{full}, "$i_code 0307", 'casefold 0x130 full'); - is($casefold->{simple}, "", 'casefold 0x130 simple'); - is($casefold->{turkic}, $i_code, 'casefold 0x130 turkic'); -} +if ($v_unicode_version gt v3.0.0) { # These special ones don't work on early + # perls + $casefold = casefold(utf8::unicode_to_native(0xdf)); + + is($casefold->{code}, $sharp_s_code, 'casefold native(0xDF) code'); + is($casefold->{status}, 'F', 'casefold native(0xDF) status'); + is($casefold->{mapping}, "$s_code $s_code", 'casefold native(0xDF) mapping'); + is($casefold->{full}, "$s_code $s_code", 'casefold native(0xDF) full'); + is($casefold->{simple}, "", 'casefold native(0xDF) simple'); + is($casefold->{turkic}, "", 'casefold native(0xDF) turkic'); + + # Do different tests depending on if version < 3.2, or not. + if ($v_unicode_version eq v3.0.1) { + # In this release, there was no special Turkic values. + # Both 0x130 and 0x131 folded to 'i'. + + $casefold = casefold(0x130); + + is($casefold->{code}, '0130', 'casefold 0x130 code'); + is($casefold->{status}, 'C' , 'casefold 0x130 status'); + is($casefold->{mapping}, $i_code, 'casefold 0x130 mapping'); + is($casefold->{full}, $i_code, 'casefold 0x130 full'); + is($casefold->{simple}, $i_code, 'casefold 0x130 simple'); + is($casefold->{turkic}, "", 'casefold 0x130 turkic'); + + $casefold = casefold(0x131); + + is($casefold->{code}, '0131', 'casefold 0x131 code'); + is($casefold->{status}, 'C' , 'casefold 0x131 status'); + is($casefold->{mapping}, $i_code, 'casefold 0x131 mapping'); + is($casefold->{full}, $i_code, 'casefold 0x131 full'); + is($casefold->{simple}, $i_code, 'casefold 0x131 simple'); + is($casefold->{turkic}, "", 'casefold 0x131 turkic'); + } + elsif ($v_unicode_version lt v3.2.0) { + $casefold = casefold(0x130); + + is($casefold->{code}, '0130', 'casefold 0x130 code'); + is($casefold->{status}, 'I' , 'casefold 0x130 status'); + is($casefold->{mapping}, $i_code, 'casefold 0x130 mapping'); + is($casefold->{full}, $i_code, 'casefold 0x130 full'); + is($casefold->{simple}, $i_code, 'casefold 0x130 simple'); + is($casefold->{turkic}, $i_code, 'casefold 0x130 turkic'); + + $casefold = casefold(0x131); + + is($casefold->{code}, '0131', 'casefold 0x131 code'); + is($casefold->{status}, 'I' , 'casefold 0x131 status'); + is($casefold->{mapping}, $i_code, 'casefold 0x131 mapping'); + is($casefold->{full}, $i_code, 'casefold 0x131 full'); + is($casefold->{simple}, $i_code, 'casefold 0x131 simple'); + is($casefold->{turkic}, $i_code, 'casefold 0x131 turkic'); + } else { + $casefold = casefold(utf8::unicode_to_native(0x49)); + + is($casefold->{code}, $I_code, 'casefold native(0x49) code'); + is($casefold->{status}, 'C' , 'casefold native(0x49) status'); + is($casefold->{mapping}, $i_code, 'casefold native(0x49) mapping'); + is($casefold->{full}, $i_code, 'casefold native(0x49) full'); + is($casefold->{simple}, $i_code, 'casefold native(0x49) simple'); + is($casefold->{turkic}, "0131", 'casefold native(0x49) turkic'); + + $casefold = casefold(0x130); + + is($casefold->{code}, '0130', 'casefold 0x130 code'); + is($casefold->{status}, 'F' , 'casefold 0x130 status'); + is($casefold->{mapping}, "$i_code 0307", 'casefold 0x130 mapping'); + is($casefold->{full}, "$i_code 0307", 'casefold 0x130 full'); + is($casefold->{simple}, "", 'casefold 0x130 simple'); + is($casefold->{turkic}, $i_code, 'casefold 0x130 turkic'); + } -$casefold = casefold(0x1F88); + if ($v_unicode_version gt v3.0.1) { + $casefold = casefold(0x1F88); -is($casefold->{code}, '1F88', 'casefold 0x1F88 code'); -is($casefold->{status}, 'S' , 'casefold 0x1F88 status'); -is($casefold->{mapping}, '1F80', 'casefold 0x1F88 mapping'); -is($casefold->{full}, '1F00 03B9', 'casefold 0x1F88 full'); -is($casefold->{simple}, '1F80', 'casefold 0x1F88 simple'); -is($casefold->{turkic}, "", 'casefold 0x1F88 turkic'); + is($casefold->{code}, '1F88', 'casefold 0x1F88 code'); + is($casefold->{status}, 'S' , 'casefold 0x1F88 status'); + is($casefold->{mapping}, '1F80', 'casefold 0x1F88 mapping'); + is($casefold->{full}, '1F00 03B9', 'casefold 0x1F88 full'); + is($casefold->{simple}, '1F80', 'casefold 0x1F88 simple'); + is($casefold->{turkic}, "", 'casefold 0x1F88 turkic'); + } +} ok(!casefold(utf8::unicode_to_native(0x20))); @@ -672,12 +728,16 @@ ok($casespec->{code} eq $sharp_s_code && $casespec = casespec(0x307); -ok($casespec->{az}->{code} eq '0307' && - !defined $casespec->{az}->{lower} && - $casespec->{az}->{title} eq '0307' && - $casespec->{az}->{upper} eq '0307' && - $casespec->{az}->{condition} eq 'az After_I', - 'casespec 0x307'); +if ($v_unicode_version gt v3.1.0) { + ok($casespec->{az}->{code} eq '0307' + && !defined $casespec->{az}->{lower} + && $casespec->{az}->{title} eq '0307' + && $casespec->{az}->{upper} eq '0307' + && $casespec->{az}->{condition} eq ($v_unicode_version le v3.2) + ? 'az After_Soft_Dotted' + : 'az After_I', + 'casespec 0x307'); +} # perl #7305 UnicodeCD::compexcl is weird @@ -699,11 +759,15 @@ is(Unicode::UCD::_getcode('x123'), undef, "_getcode(x123)"); is(Unicode::UCD::_getcode('0x123x'), undef, "_getcode(x123)"); is(Unicode::UCD::_getcode('U+123x'), undef, "_getcode(x123)"); +SKIP: { + skip("Script property not in this release", 3) if $v_unicode_version lt v3.1.0; my $r1 = charscript('Latin'); if (ok(defined $r1, "Found Latin script")) { + skip("Latin range count will be wrong when using older Unicode release", + 2) if $v_unicode_version lt $expected_version; my $n1 = @$r1; - is($n1, 31, "number of ranges in Latin script (Unicode 7.0.0)") if $::IS_ASCII; + is($n1, 31, "number of ranges in Latin script (Unicode $expected_version)") if $::IS_ASCII; shift @$r1 while @$r1; my $r2 = charscript('Latin'); is(@$r2, $n1, "modifying results should not mess up internal caches"); @@ -714,38 +778,72 @@ is(Unicode::UCD::_getcode('U+123x'), undef, "_getcode(x123)"); is(charinfo(0xdeadbeef), undef, "[perl #23273] warnings in Unicode::UCD"); } -use Unicode::UCD qw(namedseq); - -is(namedseq("KATAKANA LETTER AINU P"), "\x{31F7}\x{309A}", "namedseq"); -is(namedseq("KATAKANA LETTER AINU Q"), undef); -is(namedseq(), undef); -is(namedseq(qw(foo bar)), undef); -my @ns = namedseq("KATAKANA LETTER AINU P"); -is(scalar @ns, 2); -is($ns[0], 0x31F7); -is($ns[1], 0x309A); -my %ns = namedseq(); -is($ns{"KATAKANA LETTER AINU P"}, "\x{31F7}\x{309A}"); -@ns = namedseq(42); -is(@ns, 0); +if ($v_unicode_version ge v4.1.0) { + use Unicode::UCD qw(namedseq); + + is(namedseq("KATAKANA LETTER AINU P"), "\x{31F7}\x{309A}", "namedseq"); + is(namedseq("KATAKANA LETTER AINU Q"), undef); + is(namedseq(), undef); + is(namedseq(qw(foo bar)), undef); + my @ns = namedseq("KATAKANA LETTER AINU P"); + is(scalar @ns, 2); + is($ns[0], 0x31F7); + is($ns[1], 0x309A); + my %ns = namedseq(); + is($ns{"KATAKANA LETTER AINU P"}, "\x{31F7}\x{309A}"); + @ns = namedseq(42); + is(@ns, 0); +} use Unicode::UCD qw(num); -use charnames ":full"; +use charnames (); # Don't use \N{} on things not in original Unicode + # version; else will get a compilation error when this .t + # is run on an older version. is(num("0"), 0, 'Verify num("0") == 0'); is(num("98765"), 98765, 'Verify num("98765") == 98765'); -ok(! defined num("98765\N{FULLWIDTH DIGIT FOUR}"), 'Verify num("98765\N{FULLWIDTH DIGIT FOUR}") isnt defined'); -is(num("\N{NEW TAI LUE DIGIT TWO}"), 2, 'Verify num("\N{NEW TAI LUE DIGIT TWO}") == 2'); -is(num("\N{NEW TAI LUE DIGIT ONE}"), 1, 'Verify num("\N{NEW TAI LUE DIGIT ONE}") == 1'); -is(num("\N{NEW TAI LUE DIGIT TWO}\N{NEW TAI LUE DIGIT ONE}"), 21, 'Verify num("\N{NEW TAI LUE DIGIT TWO}\N{NEW TAI LUE DIGIT ONE}") == 21'); -ok(! defined num("\N{NEW TAI LUE DIGIT TWO}\N{NEW TAI LUE THAM DIGIT ONE}"), 'Verify num("\N{NEW TAI LUE DIGIT TWO}\N{NEW TAI LUE THAM DIGIT ONE}") isnt defined'); -is(num("\N{CHAM DIGIT ZERO}\N{CHAM DIGIT THREE}"), 3, 'Verify num("\N{CHAM DIGIT ZERO}\N{CHAM DIGIT THREE}") == 3'); -ok(! defined num("\N{CHAM DIGIT ZERO}\N{JAVANESE DIGIT NINE}"), 'Verify num("\N{CHAM DIGIT ZERO}\N{JAVANESE DIGIT NINE}") isnt defined'); +ok(! defined num("98765\N{FULLWIDTH DIGIT FOUR}"), + 'Verify num("98765\N{FULLWIDTH DIGIT FOUR}") isnt defined'); +my $tai_lue_2; +if ($v_unicode_version ge v4.1.0) { + my $tai_lue_1 = charnames::string_vianame("NEW TAI LUE DIGIT ONE"); + $tai_lue_2 = charnames::string_vianame("NEW TAI LUE DIGIT TWO"); + is(num($tai_lue_2), 2, 'Verify num("\N{NEW TAI LUE DIGIT TWO}") == 2'); + is(num($tai_lue_1), 1, 'Verify num("\N{NEW TAI LUE DIGIT ONE}") == 1'); + is(num($tai_lue_2 . $tai_lue_1), 21, + 'Verify num("\N{NEW TAI LUE DIGIT TWO}\N{NEW TAI LUE DIGIT ONE}") == 21'); +} +if ($v_unicode_version ge v5.2.0) { + ok(! defined num($tai_lue_2 + . charnames::string_vianame("NEW TAI LUE THAM DIGIT ONE")), + 'Verify num("\N{NEW TAI LUE DIGIT TWO}\N{NEW TAI LUE THAM DIGIT ONE}") isnt defined'); +} +if ($v_unicode_version ge v5.1.0) { + my $cham_0 = charnames::string_vianame("CHAM DIGIT ZERO"); + is(num($cham_0 . charnames::string_vianame("CHAM DIGIT THREE")), 3, + 'Verify num("\N{CHAM DIGIT ZERO}\N{CHAM DIGIT THREE}") == 3'); + if ($v_unicode_version ge v5.2.0) { + ok(! defined num( $cham_0 + . charnames::string_vianame("JAVANESE DIGIT NINE")), + 'Verify num("\N{CHAM DIGIT ZERO}\N{JAVANESE DIGIT NINE}") isnt defined'); + } +} is(num("\N{SUPERSCRIPT TWO}"), 2, 'Verify num("\N{SUPERSCRIPT TWO} == 2'); -is(num("\N{ETHIOPIC NUMBER TEN THOUSAND}"), 10000, 'Verify num("\N{ETHIOPIC NUMBER TEN THOUSAND}") == 10000'); -is(num("\N{NORTH INDIC FRACTION ONE HALF}"), .5, 'Verify num("\N{NORTH INDIC FRACTION ONE HALF}") == .5'); -is(num("\N{U+12448}"), 9, 'Verify num("\N{U+12448}") == 9'); -is(num("\N{U+5146}"), 1000000000000, 'Verify num("\N{U+5146}") == 1000000000000'); +if ($v_unicode_version ge v3.0.0) { + is(num(charnames::string_vianame("ETHIOPIC NUMBER TEN THOUSAND")), 10000, + 'Verify num("\N{ETHIOPIC NUMBER TEN THOUSAND}") == 10000'); +} +if ($v_unicode_version ge v5.2.0) { + is(num(charnames::string_vianame("NORTH INDIC FRACTION ONE HALF")), + .5, + 'Verify num("\N{NORTH INDIC FRACTION ONE HALF}") == .5'); + is(num("\N{U+12448}"), 9, 'Verify num("\N{U+12448}") == 9'); +} +if ($v_unicode_version gt v3.2.0) { # Is missing from non-Unihan files before + # this + is(num("\N{U+5146}"), 1000000000000, + 'Verify num("\N{U+5146}") == 1000000000000'); +} # Create a user-defined property sub InKana {<<'END'} @@ -979,6 +1077,12 @@ while (<$propvalues>) { my @fields = split /\s*;\s*/; # Fields are separated by semi-colons my $prop = shift @fields; # 0th field is the property, + # 'qc' is short in early versions of the file for any of the quick check + # properties. Choose one of them. + if ($prop eq 'qc' && $v_unicode_version le v4.0.0) { + $prop = "NFKC_QC"; + } + # When changing properties, we examine the accumulated values for the old # one to see if our function that returns them matches. if ($prev_prop ne $prop) { @@ -986,6 +1090,11 @@ while (<$propvalues>) { my @ucd_function_values = prop_values($prev_prop); @ucd_function_values = () unless @ucd_function_values; + # The file didn't include strictly numeric values until after this + if ($prev_prop eq 'ccc' && $v_unicode_version le v6.0.0) { + @ucd_function_values = grep { /\D/ } @ucd_function_values; + } + # This perl extension doesn't appear in the official file push @this_prop_values, "Non_Canon" if $prev_prop eq 'dt'; @@ -1008,6 +1117,12 @@ while (<$propvalues>) { # characters that are ignored under loose matching to test that my $mod_prop = "$extra_chars$prop"; + if ($prop eq 'blk' && $v_unicode_version le v5.0.0) { + foreach my $element (@fields) { + $element =~ s/-/_/g; + } + } + if ($fields[0] eq 'n/a') { # See comments in input file, essentially # means full name and short name are identical $fields[0] = $fields[1]; @@ -1190,36 +1305,39 @@ if ($::IS_ASCII) { # On EBCDIC, other things will come first, and can vary $prop = "lc"; ($invlist_ref, $invmap_ref, $format, $missing) = prop_invmap($prop); - is($format, 'al', "prop_invmap() format of '$prop' is 'al'"); + my $lc_format = ($v_unicode_version ge v3.2.0) ? 'al' : 'a'; + is($format, $lc_format, "prop_invmap() format of '$prop' is '$lc_format"); is($missing, '0', "prop_invmap() missing of '$prop' is '0'"); is($invlist_ref->[1], 0x41, "prop_invmap('$prop') list[1] is 0x41"); is($invmap_ref->[1], 0x61, "prop_invmap('$prop') map[1] is 0x61"); } # This property is stable and small, so can test all of it -$prop = "ASCII_Hex_Digit"; -($invlist_ref, $invmap_ref, $format, $missing) = prop_invmap($prop); -is($format, 's', "prop_invmap() format of '$prop' is 's'"); -is($missing, 'N', "prop_invmap() missing of '$prop' is 'N'"); -if ($::IS_ASCII) { - is_deeply($invlist_ref, [ 0x0000, 0x0030, 0x003A, - 0x0041, 0x0047, - 0x0061, 0x0067, 0x110000 - ], - "prop_invmap('$prop') code point list is correct"); -} -elsif ($::IS_EBCDIC) { - is_deeply($invlist_ref, [ - utf8::unicode_to_native(0x0000), - utf8::unicode_to_native(0x0061), utf8::unicode_to_native(0x0066) + 1, - utf8::unicode_to_native(0x0041), utf8::unicode_to_native(0x0046) + 1, - utf8::unicode_to_native(0x0030), utf8::unicode_to_native(0x0039) + 1, - utf8::unicode_to_native(0x110000) - ], - "prop_invmap('$prop') code point list is correct"); +if ($v_unicode_version gt v3.1.0) { + $prop = "ASCII_Hex_Digit"; + ($invlist_ref, $invmap_ref, $format, $missing) = prop_invmap($prop); + is($format, 's', "prop_invmap() format of '$prop' is 's'"); + is($missing, 'N', "prop_invmap() missing of '$prop' is 'N'"); + if ($::IS_ASCII) { + is_deeply($invlist_ref, [ 0x0000, 0x0030, 0x003A, + 0x0041, 0x0047, + 0x0061, 0x0067, 0x110000 + ], + "prop_invmap('$prop') code point list is correct"); + } + elsif ($::IS_EBCDIC) { + is_deeply($invlist_ref, [ + utf8::unicode_to_native(0x0000), + utf8::unicode_to_native(0x0061), utf8::unicode_to_native(0x0066) + 1, + utf8::unicode_to_native(0x0041), utf8::unicode_to_native(0x0046) + 1, + utf8::unicode_to_native(0x0030), utf8::unicode_to_native(0x0039) + 1, + utf8::unicode_to_native(0x110000) + ], + "prop_invmap('$prop') code point list is correct"); + } + is_deeply($invmap_ref, [ 'N', 'Y', 'N', 'Y', 'N', 'Y', 'N', 'N' ] , + "prop_invmap('$prop') map list is correct"); } -is_deeply($invmap_ref, [ 'N', 'Y', 'N', 'Y', 'N', 'Y', 'N', 'N' ] , - "prop_invmap('$prop') map list is correct"); is(prop_invlist("Unknown property"), undef, "prop_invlist() returns undef"); is(prop_invlist(undef), undef, "prop_invlist(undef) returns undef"); @@ -1240,36 +1358,38 @@ is(prop_invlist("InKana"), undef, "prop_invlist([$i]; @@ -2534,11 +2662,13 @@ foreach my $prop (sort(keys %props), sort keys %legacy_props) { # A few tests of search_invlist use Unicode::UCD qw(search_invlist); -my ($scripts_ranges_ref, $scripts_map_ref) = prop_invmap("Script"); -my $index = search_invlist($scripts_ranges_ref, 0x390); -is($scripts_map_ref->[$index], "Greek", "U+0390 is Greek"); -my @alpha_invlist = prop_invlist("Alpha"); -is(search_invlist(\@alpha_invlist, ord("\t")), undef, "search_invlist returns undef for code points before first one on the list"); +if ($v_unicode_version ge v3.1.0) { # No Script property before this + my ($scripts_ranges_ref, $scripts_map_ref) = prop_invmap("Script"); + my $index = search_invlist($scripts_ranges_ref, 0x390); + is($scripts_map_ref->[$index], "Greek", "U+0390 is Greek"); + my @alpha_invlist = prop_invlist("Alpha"); + is(search_invlist(\@alpha_invlist, ord("\t")), undef, "search_invlist returns undef for code points before first one on the list"); +} ok($/ eq $input_record_separator, "The record separator didn't get overridden"); diff --git a/lib/h2xs.t b/lib/h2xs.t index d10ce75..25502da 100644 --- a/lib/h2xs.t +++ b/lib/h2xs.t @@ -72,7 +72,7 @@ my $thisversion = sprintf "%vd", $^V; $thisversion =~ s/^v//; # If this test has failed previously a copy may be left. -rmtree($name); +rmtree($name) if -e $name; my @tests = ( "-f -n $name", $], <<"EOXSFILES", diff --git a/lib/locale.t b/lib/locale.t index 1ebd0ce..1b510d2 100644 --- a/lib/locale.t +++ b/lib/locale.t @@ -848,7 +848,8 @@ sub disp_str ($) { } else { $result .= " " unless $prev_was_punct; - $result .= charnames::viacode(ord $char); + my $name = charnames::viacode(ord $char); + $result .= (defined $name) ? $name : ':unknown:'; $prev_was_punct = 0; } } diff --git a/lib/unicore/README.perl b/lib/unicore/README.perl index ef5fec6..f892334 100644 --- a/lib/unicore/README.perl +++ b/lib/unicore/README.perl @@ -1,15 +1,12 @@ # The goal is for perl to compile and reasonably run any version of Unicode. -# But in v5.22, the earliest version that this works for is Unicode 5.1. # Working reasonably well doesn't mean that the test suite will run without -# showing errors. You may be able to compile an earlier version, and get -# things to sort-of work. A few of the very-Unicode specific test files have been +# showing errors. A few of the very-Unicode specific test files have been # modified to account for different versions, but most have not. For example, # some tests use characters that aren't encoded in all Unicode versions; others # have hard-coded the General Categories for a code point that were correct at # the time the test was written. Perl itself will not compile under Unicode # releases prior to 3.0 without a simple change to Unicode::Normalize. -# mktables contains instructions for this, as well as other hints for using -# older Unicode versions. +# mktables contains instructions for this. # The *.txt files were copied from @@ -17,14 +14,20 @@ # (which always points to the latest version) with subdirectories 'extracted' and # 'auxiliary'. Older versions are located under Public with an appropriate name. +# They are also available via http at www.unicode.org/versions/ +# # The Unihan files were not included due to space considerations. Also NOT -# included were any *.html files. It is possible to add the Unihan files, and -# edit mktables (see instructions near its beginning) to look at them. +# included were any *.html files. It is possible to add the Unihan files and +# have some properties from them automatically compiled. By editing mktables +# (see instructions near its beginning) you can add other Unihan properties. # The file named 'version' should exist and be a single line with the Unicode # version, like: +# # 5.2.0 +# +# (without the initial '# ') # To be 8.3 filesystem friendly, the names of some of the input files have been # changed from the values that are in the Unicode DB. Not all of the Test @@ -58,6 +61,8 @@ mv extracted/DerivedJoiningType.txt extracted/DJoinType.txt mv extracted/DerivedLineBreak.txt extracted/DLineBreak.txt mv extracted/DerivedNumericType.txt extracted/DNumType.txt mv extracted/DerivedNumericValues.txt extracted/DNumValues.txt +rmdir extracted 2>/dev/null # Will fail if non-empty, but if it is empty + # was an early release that didn't have it. mv auxiliary/GraphemeBreakTest.txt auxiliary/GCBTest.txt mv auxiliary/LineBreakTest.txt auxiliary/LBTest.txt @@ -81,14 +86,31 @@ mv Unihan_Variants.txt UnihanVariants.txt # filesystems. # mktables is used to generate the tables used by the rest of Perl. It will -# warn you about any *.txt files in the directory substructure that it doesn't -# know about. You should remove any so-identified, or edit mktables to add -# them to its lists to process. You can run +# warn you about any *.txt and *.html files in the directory substructure that +# it doesn't know about. You should remove any so-identified, or edit mktables +# to add them to its lists to process. You can run # # mktables -globlist # -#to have it try to process these tables generically. -# +# to have it try to process these tables generically. + +# COMPILING ON OLDER UNICODE VERSIONS +# +# To compile perl for use with an older Unicode release, delete everything in +# the lib/unicore directory except mktables and Makefile. Then download the +# Unicode-supplied files for the desired version to that directory (A url for +# these is given earlier in this file). Then create the 'version' file with a +# single line, like '6.1.0'. Do a 'make test' from the project level. You +# will get some porting errors for needing to regen. Regenerate what it tells +# you are needed, and make test again. If you compile an old enough version, +# you will also have to download a few files from later Unicode versions, +# following the instructions that will be given if warranted. It should +# compile in any release without warnings, except for some casing conflicts +# in Unicode 2.1.8, and some extraneous files will show up in very early +# releases of the form qr/diff.*\.txt/. If you add Unihan.txt, one line is in error in +# +# Other glitches are noted in mktables under 'UNICODE VERSIONS NOTES' + # FOR PUMPKINS # # The files are inter-related. If you take the latest UnicodeData.txt, for diff --git a/lib/unicore/mktables b/lib/unicore/mktables index 572c299..8153936 100644 --- a/lib/unicore/mktables +++ b/lib/unicore/mktables @@ -4,17 +4,9 @@ # Any files created or read by this program should be listed in 'mktables.lst' # Use -makelist to regenerate it. -# Needs 'no overloading' to run faster on miniperl. Code commented out at the -# subroutine objaddr can be used instead to work as far back (untested) as -# 5.8: needs pack "U". But almost all occurrences of objaddr have been -# removed in favor of using 'no overloading'. You also would have to go -# through and replace occurrences like: -# my $addr = do { no overloading; pack 'J', $self; } -# with -# my $addr = main::objaddr $self; -# (or reverse commit 9b01bafde4b022706c3d6f947a0963f821b2e50b -# that instituted the change to main::objaddr, and subsequent commits that -# changed 0+$self to pack 'J', $self.) +# There was an attempt when this was first rewritten to make it 5.8 +# compatible, but that has now been abandoned, and newer constructs are used +# as convenient. my $start_time; BEGIN { # Get the time the script started running; do it at compilation to @@ -32,6 +24,7 @@ use File::Path; use File::Spec; use Text::Tabs; use re "/aa"; +use feature 'state'; sub DEBUG () { 0 } # Set to 0 for production; 1 for development my $debugging_build = $Config{"ccflags"} =~ /-DDEBUGGING/; @@ -292,8 +285,8 @@ my $unicode_reference_url = 'http://www.unicode.org/reports/tr44/'; # As mentioned earlier, some properties are given in more than one file. In # particular, the files in the extracted directory are supposedly just # reformattings of the others. But they contain information not easily -# derivable from the other files, including results for Unihan, which this -# program doesn't ordinarily look at, and for unassigned code points. They +# derivable from the other files, including results for Unihan (which isn't +# usually available to this program) and for unassigned code points. They # also have historically had errors or been incomplete. In an attempt to # create the best possible data, this program thus processes them first to # glean information missing from the other files; then processes those other @@ -411,24 +404,19 @@ my $unicode_reference_url = 'http://www.unicode.org/reports/tr44/'; # # A NOTE ON UNIHAN # -# This program can generate tables from the Unihan database. But it doesn't -# by default, letting the CPAN module Unicode::Unihan handle them. Prior to -# version 5.2, this database was in a single file, Unihan.txt. In 5.2 the -# database was split into 8 different files, all beginning with the letters -# 'Unihan'. This program will read those file(s) if present, but it needs to -# know which of the many properties in the file(s) should have tables created -# for them. It will create tables for any properties listed in -# PropertyAliases.txt and PropValueAliases.txt, plus any listed in the -# @cjk_properties array and the @cjk_property_values array. Thus, if a -# property you want is not in those files of the release you are building -# against, you must add it to those two arrays. Starting in 4.0, the -# Unicode_Radical_Stroke was listed in those files, so if the Unihan database -# is present in the directory, a table will be generated for that property. -# In 5.2, several more properties were added. For your convenience, the two -# arrays are initialized with all the 6.0 listed properties that are also in -# earlier releases. But these are commented out. You can just uncomment the -# ones you want, or use them as a template for adding entries for other -# properties. +# This program can generate tables from the Unihan database. But that db +# isn't normally available, so it is marked as optional. Prior to version +# 5.2, this database was in a single file, Unihan.txt. In 5.2 the database +# was split into 8 different files, all beginning with the letters 'Unihan'. +# If you plunk those files down into the directory mktables ($0) is in, this +# program will read them and automatically create tables for the properties +# from it that are listed in PropertyAliases.txt and PropValueAliases.txt, +# plus any you add to the @cjk_properties array and the @cjk_property_values +# array, being sure to add necessary '# @missings' lines to the latter. For +# Unicode versions earlier than 5.2, most of the Unihan properties are not +# listed at all in PropertyAliases nor PropValueAliases. This program assumes +# for these early releases that you want the properties that are specified in +# the 5.2 release. # # You may need to adjust the entries to suit your purposes. setup_unihan(), # and filter_unihan_line() are the functions where this is done. This program @@ -437,8 +425,8 @@ my $unicode_reference_url = 'http://www.unicode.org/reports/tr44/'; # # There is a bug in the 3.2 data file in which some values for the # kPrimaryNumeric property have commas and an unexpected comment. A filter -# could be added for these; or for a particular installation, the Unihan.txt -# file could be edited to fix them. +# could be added to correct these; or for a particular installation, the +# Unihan.txt file could be edited to fix them. # # HOW TO ADD A FILE TO BE PROCESSED # @@ -484,13 +472,13 @@ my $unicode_reference_url = 'http://www.unicode.org/reports/tr44/'; # handled by Unicode::Normalize, nor will it compile when presented a version # that has them. However, you can trivially get it to compile by simply # ignoring those decompositions, by changing the croak to a carp. At the time -# of this writing, the line (in cpan/Unicode-Normalize/mkheader) reads +# of this writing, the line (in cpan/Unicode-Normalize/Normalize.pm or +# cpan/Unicode-Normalize/mkheader) reads # # croak("Weird Canonical Decomposition of U+$h"); # # Simply comment it out. It will compile, but will not know about any three -# character decompositions. If using the .pm version, there is a similar -# line. +# character decompositions. # The number of code points in \p{alpha=True} halved in 2.1.9. It turns out # that the reason is that the CJK block starting at 4E00 was removed from @@ -513,10 +501,13 @@ my $unicode_reference_url = 'http://www.unicode.org/reports/tr44/'; # name for the class, it would not have been affected, but if it used the # mnemonic, it would have been. # -# \p{Script=Hrkt} (Katakana_Or_Hiragana) came in 4.0.1. Before that code +# \p{Script=Hrkt} (Katakana_Or_Hiragana) came in 4.0.1. Before that, code # points which eventually came to have this script property value, instead # mapped to "Unknown". But in the next release all these code points were # moved to \p{sc=common} instead. + +# The tests furnished by Unicode for testing WordBreak and SentenceBreak +# generate errors in 5.0 and earlier. # # The default for missing code points for BidiClass is complicated. Starting # in 3.1.1, the derived file DBidiClass.txt handles this, but this program @@ -596,8 +587,8 @@ our $to_trace = 0; || $caller_name eq 'trace'); my $output = ""; + #print STDERR __LINE__, ": ", join ", ", @input, "\n"; foreach my $string (@input) { - #print STDERR __LINE__, ": ", join ", ", @input, "\n"; if (ref $string eq 'ARRAY' || ref $string eq 'HASH') { $output .= simple_dumper($string); } @@ -623,10 +614,11 @@ our $to_trace = 0; # This is for a rarely used development feature that allows you to compare two # versions of the Unicode standard without having to deal with changes caused -# by the code points introduced in the later version. Change the 0 to a -# string containing a SINGLE dotted Unicode release number (e.g. "2.1"). Only -# code points introduced in that release and earlier will be used; later ones -# are thrown away. You use the version number of the earliest one you want to +# by the code points introduced in the later version. You probably also want +# to use the -annotate option when using this. Change the 0 to a string +# containing a SINGLE dotted Unicode release number (e.g. "2.1"). Only code +# points introduced in that release and earlier will be used; later ones are +# thrown away. You use the version number of the earliest one you want to # compare; then run this program on directory structures containing each # release, and compare the outputs. These outputs will therefore include only # the code points common to both releases, and you can see the changes caused @@ -861,33 +853,8 @@ if ($v_version gt v3.2.0) { 'Canonical_Combining_Class=Attached_Below_Left' } -# These are listed in the Property aliases file in 6.0, but Unihan is ignored -# unless explicitly added. -if ($v_version ge v5.2.0) { - my $unihan = 'Unihan; remove from list if using Unihan'; - foreach my $table (qw ( - kAccountingNumeric - kOtherNumeric - kPrimaryNumeric - kCompatibilityVariant - kIICore - kIRG_GSource - kIRG_HSource - kIRG_JSource - kIRG_KPSource - kIRG_MSource - kIRG_KSource - kIRG_TSource - kIRG_USource - kIRG_VSource - kRSUnicode - )) - { - $why_suppress_if_empty_warn_if_not{$table} = $unihan; - } -} - -# Enum values for to_output_map() method in the Map_Table package. +# Enum values for to_output_map() method in the Map_Table package. (0 is don't +# output) my $EXTERNAL_MAP = 1; my $INTERNAL_MAP = 2; my $OUTPUT_ADJUSTED = 3; @@ -913,13 +880,6 @@ my %global_to_output_map = ( Decomposition_Type => 0, ); -# Properties that this program ignores. -my @unimplemented_properties; - -# With this release, it is automatically handled if the Unihan db is -# downloaded -push @unimplemented_properties, 'Unicode_Radical_Stroke' if $v_version le v5.2.0; - # There are several types of obsolete properties defined by Unicode. These # must be hand-edited for every new Unicode release. my %why_deprecated; # Generates a deprecated warning message if used. @@ -959,8 +919,6 @@ my %why_obsolete; # Documentation only # existence is not noted in the comment. 'Decomposition_Mapping' => 'Accessible via Unicode::Normalize or prop_invmap() or charprop() in Unicode::UCD::', - 'Indic_Matra_Category' => "Withdrawn by Unicode while still provisional", - # Don't suppress ISO_Comment, as otherwise special handling is needed # to differentiate between it and gc=c, which can be written as 'isc', # which is the same characters as ISO_Comment's short name. @@ -1046,45 +1004,13 @@ if ($v_version ge v6.0.0) { my @output_mapped_properties = split "\n", < -## @missing: 0000..10FFFF; cjkIICore; -## @missing: 0000..10FFFF; cjkIRG_GSource; -## @missing: 0000..10FFFF; cjkIRG_HSource; -## @missing: 0000..10FFFF; cjkIRG_JSource; -## @missing: 0000..10FFFF; cjkIRG_KPSource; -## @missing: 0000..10FFFF; cjkIRG_KSource; -## @missing: 0000..10FFFF; cjkIRG_TSource; -## @missing: 0000..10FFFF; cjkIRG_USource; -## @missing: 0000..10FFFF; cjkIRG_VSource; -## @missing: 0000..10FFFF; cjkOtherNumeric; NaN -## @missing: 0000..10FFFF; cjkPrimaryNumeric; NaN -## @missing: 0000..10FFFF; cjkRSUnicode; END # The input files don't list every code point. Those not listed are to be @@ -1109,7 +1035,7 @@ my %default_mapping = ( Decomposition_Type => 'None', East_Asian_Width => "Neutral", FC_NFKC_Closure => $CODE_POINT, - General_Category => 'Cn', + General_Category => ($v_version le 6.3.0) ? 'Cn' : 'Unassigned', Grapheme_Cluster_Break => 'Other', Hangul_Syllable_Type => 'NA', ISO_Comment => "", @@ -1140,39 +1066,6 @@ my %default_mapping = ( Word_Break => 'Other', ); -# Below are files that Unicode furnishes, but this program ignores, and why. -# NormalizationCorrections.txt requires some more explanation. It documents -# the cumulative fixes to erroneous normalizations in earlier Unicode -# versions. Its main purpose is so that someone running on an earlier version -# can use this file to override what got published in that earlier release. -# It would be easy for mktables to read and handle this file. But all the -# corrections in it should already be in the other files for the release it -# is. To get it to actually mean something useful, someone would have to be -# using an earlier Unicode release, and copy it to the files for that release -# and recomplile. So far there has been no demand to do that, so this hasn't -# been implemented. -my %ignored_files = ( - 'CJKRadicals.txt' => 'Maps the kRSUnicode property values to corresponding code points', - 'Index.txt' => 'Alphabetical index of Unicode characters', - 'NamedSqProv.txt' => 'Named sequences proposed for inclusion in a later version of the Unicode Standard; if you need them now, you can append this file to F and recompile perl', - 'NamesList.txt' => 'Annotated list of characters', - 'NamesList.html' => 'Describes the format and contents of F', - 'NormalizationCorrections.txt' => 'Documentation of corrections already incorporated into the Unicode data base', - 'Props.txt' => 'Only in very early releases; is a subset of F (which is used instead)', - 'ReadMe.txt' => 'Documentation', - 'StandardizedVariants.txt' => 'Certain glyph variations for character display are standardized. This lists the non-Unihan ones; the Unihan ones are also not used by Perl, and are in a separate Unicode data base L', - 'StandardizedVariants.html' => 'Provides a visual display of the standard variant sequences derived from F.', - 'EmojiSources.txt' => 'Maps certain Unicode code points to their legacy Japanese cell-phone values', - 'USourceData.txt' => 'Documentation of status and cross reference of proposals for encoding by Unicode of Unihan characters', - 'USourceGlyphs.pdf' => 'Pictures of the characters in F', - 'auxiliary/WordBreakTest.html' => 'Documentation of validation tests', - 'auxiliary/SentenceBreakTest.html' => 'Documentation of validation tests', - 'auxiliary/GraphemeBreakTest.html' => 'Documentation of validation tests', - 'auxiliary/LineBreakTest.html' => 'Documentation of validation tests', -); - -my %skipped_files; # List of files that we skip - ### End of externally interesting definitions, except for @input_file_objects my $HEADER=<<"EOF"; @@ -1199,7 +1092,9 @@ my $DEVELOPMENT_ONLY=<<"EOF"; EOF -my $MAX_UNICODE_CODEPOINT_STRING = "10FFFF"; +my $MAX_UNICODE_CODEPOINT_STRING = ($v_version ge v2.0.0) + ? "10FFFF" + : "FFFF"; my $MAX_UNICODE_CODEPOINT = hex $MAX_UNICODE_CODEPOINT_STRING; my $MAX_UNICODE_CODEPOINTS = $MAX_UNICODE_CODEPOINT + 1; @@ -1229,8 +1124,7 @@ my $code_point_re = qr/\b$run_on_code_point_re/; # defaults for code points not listed (i.e., missing) in the file. The code # depends on this ending with a semi-colon, so it can assume it is a valid # field when the line is split() by semi-colons -my $missing_defaults_prefix = - qr/^#\s+\@missing:\s+0000\.\.$MAX_UNICODE_CODEPOINT_STRING\s*;/; +my $missing_defaults_prefix = qr/^#\s+\@missing:\s+0000\.\.10FFFF\s*;/; # Property types. Unicode has more types, but these are sufficient for our # purposes. @@ -1307,11 +1201,15 @@ my $OBSOLETE = 'O'; my $a_bold_obsolete = "an 'B<$OBSOLETE>'"; my $A_bold_obsolete = "An 'B<$OBSOLETE>'"; +# Aliases can also have an extra status: +my $INTERNAL_ALIAS = 'P'; + my %status_past_participles = ( $DISCOURAGED => 'discouraged', $STABILIZED => 'stabilized', $OBSOLETE => 'obsolete', $DEPRECATED => 'deprecated', + $INTERNAL_ALIAS => 'reserved for Perl core internal use only', ); # Table fates. These are somewhat ordered, so that fates < $MAP_PROXIED should be @@ -1374,18 +1272,21 @@ my %loose_to_file_of; # loosely maps table names to their respective # files my %stricter_to_file_of; # same; but for stricter mapping. my %loose_property_to_file_of; # Maps a loose property name to its map file +my %strict_property_to_file_of; # Same, but strict my @inline_definitions = "V0"; # Each element gives a definition of a unique # inversion list. When a definition is inlined, # its value in the hash it's in (one of the two # defined just above) will include an index into # this array. The 0th element is initialized to - # the definition for a zero length invwersion list + # the definition for a zero length inversion list my %file_to_swash_name; # Maps the file name to its corresponding key name # in the hash %utf8::SwashInfo my %nv_floating_to_rational; # maps numeric values floating point numbers to # their rational equivalent my %loose_property_name_of; # Loosely maps (non_string) property names to # standard form +my %strict_property_name_of; # Strictly maps (non_string) property names to + # standard form my %string_property_loose_to_name; # Same, for string properties. my %loose_defaults; # keys are of form "prop=value", where 'prop' is # the property name in standard loose form, and @@ -1395,12 +1296,16 @@ my %loose_to_standard_value; # loosely maps table names to the canonical # alias for them my %ambiguous_names; # keys are alias names (in standard form) that # have more than one possible meaning. +my %combination_property; # keys are alias names (in standard form) that + # have both a map table, and a binary one that + # yields true for all non-null maps. my %prop_aliases; # Keys are standard property name; values are each # one's aliases my %prop_value_aliases; # Keys of top level are standard property name; # values are keys to another hash, Each one is # one of the property's values, in standard form. # The values are that prop-val's aliases. +my %skipped_files; # List of files that we skip my %ucd_pod; # Holds entries that will go into the UCD section of the pod # Most properties are immune to caseless matching, otherwise you would get @@ -1477,6 +1382,8 @@ my @named_sequences; # NamedSequences.txt contents. my %potential_files; # Generated list of all .txt files in the directory # structure so we can warn if something is being # ignored. +my @missing_early_files; # Generated list of absent files that we need to + # proceed in compiling this early Unicode version my @files_actually_output; # List of files we generated. my @more_Names; # Some code point names are compound; this is used # to store the extra components of them. @@ -1493,6 +1400,7 @@ my $block; my $perl_charname; my $print; my $All; +my $Assigned; # All assigned characters in this Unicode release my $script; # Are there conflicting names because of beginning with 'In_', or 'Is_' @@ -1533,6 +1441,7 @@ sub objaddr($) { # after all the input has been processed. But most can be skipped, as they # have the same descriptive phrases, such as being unassigned my @viacode; # Contains the 1 million character names +my @age; # And their ages ("" if none) my @printable; # boolean: And are those characters printable? my @annotate_char_type; # Contains a type of those characters, specifically # for the purposes of annotation. @@ -1591,12 +1500,14 @@ sub populate_char_info ($) { $annotate_char_type[$i] = $ABOVE_UNICODE_TYPE; $printable[$i] = 0; $end = $MAX_WORKING_CODEPOINT; + $age[$i] = ""; } elsif ($gc-> table('Private_use')->contains($i)) { $viacode[$i] = 'Private Use'; $annotate_char_type[$i] = $PRIVATE_USE_TYPE; $printable[$i] = 0; $end = $gc->table('Private_Use')->containing_range($i)->end; + $age[$i] = property_ref("Age")->value_of($i); } elsif ((defined ($nonchar = Property::property_ref('Noncharacter_Code_Point')) @@ -1607,16 +1518,18 @@ sub populate_char_info ($) { $printable[$i] = 0; $end = property_ref('Noncharacter_Code_Point')->table('Y')-> containing_range($i)->end; + $age[$i] = property_ref("Age")->value_of($i); } elsif ($gc-> table('Control')->contains($i)) { $viacode[$i] = property_ref('Name_Alias')->value_of($i) || 'Control'; $annotate_char_type[$i] = $CONTROL_TYPE; $printable[$i] = 0; + $age[$i] = property_ref("Age")->value_of($i); } elsif ($gc-> table('Unassigned')->contains($i)) { $annotate_char_type[$i] = $UNASSIGNED_TYPE; $printable[$i] = 0; - if ($v_version lt v2.0.0) { # No blocks in earliest releases + if (defined $block) { # No blocks in earliest releases $viacode[$i] = 'Unassigned'; $end = $gc-> table('Unassigned')->containing_range($i)->end; } @@ -1632,17 +1545,14 @@ sub populate_char_info ($) { $unassigned_sans_noncharacters-> containing_range($i)->end); } + $age[$i] = property_ref("Age")->value_of($i); } - elsif ($v_version lt v2.0.0) { # No surrogates in earliest releases - $viacode[$i] = $gc->value_of($i); - $annotate_char_type[$i] = $UNKNOWN_TYPE; - $printable[$i] = 0; - } - elsif ($gc-> table('Surrogate')->contains($i)) { + elsif ($perl->table('_Perl_Surrogate')->contains($i)) { $viacode[$i] = 'Surrogate'; $annotate_char_type[$i] = $SURROGATE_TYPE; $printable[$i] = 0; $end = $gc->table('Surrogate')->containing_range($i)->end; + $age[$i] = property_ref("Age")->value_of($i); } else { Carp::my_carp_bug("Can't figure out how to annotate " @@ -1658,7 +1568,18 @@ sub populate_char_info ($) { # appended to the name, do that. elsif ($annotate_char_type[$i] == $CP_IN_NAME) { $viacode[$i] .= sprintf("-%04X", $i); - $end = $perl_charname->containing_range($i)->end; + + # Do all these as groups of the same age, instead of individually, + # because their names are so meaningless, and there are typically + # large quantities of them. + my $Age = property_ref("Age"); + $age[$i] = $Age->value_of($i); + my $limit = $perl_charname->containing_range($i)->end; + $end = $i + 1; + while ($end <= $limit && $Age->value_of($end) == $age[$i]) { + $end++; + } + $end--; } # And here, has a name, but if it's a hangul syllable one, replace it with @@ -1671,8 +1592,12 @@ sub populate_char_info ($) { my $T = $TBase + $SIndex % $TCount; $viacode[$i] = "HANGUL SYLLABLE $Jamo{$L}$Jamo{$V}"; $viacode[$i] .= $Jamo{$T} if $T != $TBase; + $age[$i] = property_ref("Age")->value_of($i); $end = $perl_charname->containing_range($i)->end; } + else { + $age[$i] = property_ref("Age")->value_of($i); + } return if ! defined wantarray; return $i if ! defined $end; # If not a range, return the input @@ -2110,6 +2035,7 @@ package Input_file; # while(next_line()) {...} loop. # # You can also set up handlers to +# 0) call during object construction time, after everything else is done # 1) call before the first line is read, for pre processing # 2) call to adjust each line of the input before the main handler gets # them. This can be automatically generated, if appropriately simple @@ -2121,19 +2047,29 @@ package Input_file; # each_line_handler()s. So, if the format of the line is not in the desired # format for the main handler, these are used to do that adjusting. They can # be stacked (by enclosing them in an [ anonymous array ] in the constructor, -# so the $_ output of one is used as the input to the next. None of the other -# handlers are stackable, but could easily be changed to be so. +# so the $_ output of one is used as the input to the next. The eof handler +# is also stackable, but none of the others are, but could easily be changed +# to be so. +# +# Some properties are used by the Perl core but aren't defined until later +# Unicode releases. The perl interpreter would have problems working when +# compiled with an earlier Unicode version that doesn't have them, so we need +# to define them somehow for those releases. The 'Early' constructor +# parameter can be used to automatically handle this. It is essentially +# ignored if the Unicode version being compiled has a data file for this +# property. Either code to execute or a file to read can be specified. +# Details are at the %early definition. # # Most of the handlers can call insert_lines() or insert_adjusted_lines() # which insert the parameters as lines to be processed before the next input -# file line is read. This allows the EOF handler to flush buffers, for +# file line is read. This allows the EOF handler(s) to flush buffers, for # example. The difference between the two routines is that the lines inserted # by insert_lines() are subjected to the each_line_handler()s. (So if you -# called it from such a handler, you would get infinite recursion.) Lines -# inserted by insert_adjusted_lines() go directly to the main handler without -# any adjustments. If the post-processing handler calls any of these, there -# will be no effect. Some error checking for these conditions could be added, -# but it hasn't been done. +# called it from such a handler, you would get infinite recursion without some +# mechanism to prevent that.) Lines inserted by insert_adjusted_lines() go +# directly to the main handler without any adjustments. If the +# post-processing handler calls any of these, there will be no effect. Some +# error checking for these conditions could be added, but it hasn't been done. # # carp_bad_line() should be called to warn of bad input lines, which clears $_ # to prevent further processing of the line. This routine will output the @@ -2169,10 +2105,16 @@ sub trace { return main::trace(@_); } main::set_access('property', \%property, qw{ c r }); my %optional; - # If this is true, the file is optional. If not present, no warning is - # output. If it is present, the string given by this parameter is - # evaluated, and if false the file is not processed. - main::set_access('optional', \%optional, 'c', 'r'); + # This is either an unsigned number, or a list of property names. In the + # former case, if it is non-zero, it means the file is optional, so if the + # file is absent, no warning about that is output. In the latter case, it + # is a list of properties that the file (exclusively) defines. If the + # file is present, tables for those properties will be produced; if + # absent, none will, even if they are listed elsewhere (namely + # PropertyAliases.txt and PropValueAliases.txt) as being in this release, + # and no warnings will be raised about them not being available. (And no + # warning about the file itself will be raised.) + main::set_access('optional', \%optional, qw{ c readable_array } ); my %non_skip; # This is used for debugging, to skip processing of all but a few input @@ -2181,16 +2123,19 @@ sub trace { return main::trace(@_); } main::set_access('non_skip', \%non_skip, 'c'); my %skip; - # This is used to skip processing of this input file semi-permanently, - # when it evaluates to true. The value should be the reason the file is - # being skipped. It is used for files that we aren't planning to process - # anytime soon, but want to allow to be in the directory and not raise a - # message that we are not handling. Mostly for test files. This is in - # contrast to the non_skip element, which is supposed to be used very - # temporarily for debugging. Sets 'optional' to 1. Also, files that we - # pretty much will never look at can be placed in the global - # %ignored_files instead. Ones used here will be added to %skipped files - main::set_access('skip', \%skip, 'c'); + # This is used to skip processing of this input file (semi-) permanently. + # The value should be the reason the file is being skipped. It is used + # for files that we aren't planning to process anytime soon, but want to + # allow to be in the directory and be checked for their names not + # conflicting with any other files on a DOS 8.3 name filesystem, but to + # not otherwise be processed, and to not raise a warning about not being + # handled. In the constructor call, any value that evaluates to a numeric + # 0 or undef means don't skip. Any other value is a string giving the + # reason it is being skippped, and this will appear in generated pod. + # However, an empty string reason will suppress the pod entry. + # Internally, calls that evaluate to numeric 0 are changed into undef to + # distinguish them from an empty string call. + main::set_access('skip', \%skip, 'c', 'r'); my %each_line_handler; # list of subroutines to look at and filter each non-comment line in the @@ -2221,21 +2166,28 @@ sub trace { return main::trace(@_); } main::set_access('has_missings_defaults', \%has_missings_defaults, qw{ c r }); + my %construction_time_handler; + # Subroutine to call at the end of the new method. If undef, no such + # handler is called. + main::set_access('construction_time_handler', + \%construction_time_handler, qw{ c }); + my %pre_handler; # Subroutine to call before doing anything else in the file. If undef, no # such handler is called. main::set_access('pre_handler', \%pre_handler, qw{ c }); my %eof_handler; - # Subroutine to call upon getting an EOF on the input file, but before + # Subroutines to call upon getting an EOF on the input file, but before # that is returned to the main handler. This is to allow buffers to be # flushed. The handler is expected to call insert_lines() or # insert_adjusted() with the buffered material - main::set_access('eof_handler', \%eof_handler, qw{ c r }); + main::set_access('eof_handler', \%eof_handler, qw{ c }); my %post_handler; # Subroutine to call after all the lines of the file are read in and - # processed. If undef, no such handler is called. + # processed. If undef, no such handler is called. Note that this cannot + # add lines to be processed; instead use eof_handler main::set_access('post_handler', \%post_handler, qw{ c }); my %progress_message; @@ -2263,6 +2215,69 @@ sub trace { return main::trace(@_); } # storage of '@missing' defaults lines main::set_access('missings', \%missings); + my %early; + # Used for properties that must be defined (for Perl's purposes) on + # versions of Unicode earlier than Unicode itself defines them. The + # parameter is an array (it would be better to be a hash, but not worth + # bothering about due to its rare use). + # + # The first element is either a code reference to call when in a release + # earlier than the Unicode file is available in, or it is an alternate + # file to use instead of the non-existent one. This file must have been + # plunked down in the same directory as mktables. Should you be compiling + # on a release that needs such a file, mktables will abort the + # compilation, and tell you where to get the necessary file(s), and what + # name(s) to use to store them as. + # In the case of specifying an alternate file, the array must contain two + # further elements: + # + # [1] is the name of the property that will be generated by this file. + # The class automatically takes the input file and excludes any code + # points in it that were not assigned in the Unicode version being + # compiled. It then uses this result to define the property in the given + # version. Since the property doesn't actually exist in the Unicode + # version being compiled, this should be a name accessible only by core + # perl. If it is the same name as the regular property, the constructor + # will mark the output table as a $PLACEHOLDER so that it doesn't actually + # get output, and so will be unusable by non-core code. Otherwise it gets + # marked as $INTERNAL_ONLY. + # + # [2] is a property value to assign (only when compiling Unicode 1.1.5) to + # the Hangul syllables in that release (which were ripped out in version + # 2) for the given property . (Hence it is ignored except when compiling + # version 1. You only get one value that applies to all of them, which + # may not be the actual reality, but probably nobody cares anyway for + # these obsolete characters.) + # + # Not all files can be handled in the above way, and so the code ref + # alternative is available. It can do whatever it needs to. The other + # array elements are optional in this case, and the code is free to use or + # ignore them if they are present. + # + # Internally, the constructor unshifts a 0 or 1 onto this array to + # indicate if an early alternative is actually being used or not. This + # makes for easier testing later on. + main::set_access('early', \%early, 'c'); + + my %required_even_in_debug_skip; + # debug_skip is used to speed up compilation during debugging by skipping + # processing files that are not needed for the task at hand. However, + # some files pretty much can never be skipped, and this is used to specify + # that this is one of them. In order to skip this file, the call to the + # constructor must be edited to comment out this parameter. + main::set_access('required_even_in_debug_skip', + \%required_even_in_debug_skip, 'c'); + + my %withdrawn; + # Some files get removed from the Unicode DB. This is a version object + # giving the first release without this file. + main::set_access('withdrawn', \%withdrawn, 'c'); + + my %in_this_release; + # Calculated value from %first_released and %withdrawn. Are we compiling + # a Unicode release which includes this file? + main::set_access('in_this_release', \%in_this_release); + sub _next_line; sub _next_line_with_remapped_range; @@ -2275,22 +2290,23 @@ sub trace { return main::trace(@_); } # Set defaults $handler{$addr} = \&main::process_generic_property_file; $non_skip{$addr} = 0; - $skip{$addr} = 0; + $skip{$addr} = undef; $has_missings_defaults{$addr} = $NO_DEFAULTS; $handle{$addr} = undef; $added_lines{$addr} = [ ]; $remapped_lines{$addr} = [ ]; $each_line_handler{$addr} = [ ]; + $eof_handler{$addr} = [ ]; $errors{$addr} = { }; $missings{$addr} = [ ]; + $early{$addr} = [ ]; + $optional{$addr} = [ ]; # Two positional parameters. return Carp::carp_too_few_args(\@_, 2) if main::DEBUG && @_ < 2; $file{$addr} = main::internal_file_to_platform(shift); $first_released{$addr} = shift; - undef $file{$addr} if $first_released{$addr} gt $v_version; - # The rest of the arguments are key => value pairs # %constructor_fields has been set up earlier to list all possible # ones. Either set or push, depending on how the default has been set @@ -2322,30 +2338,206 @@ sub trace { return main::trace(@_); } delete $args{$key}; }; - # If the file has a property for it, it means that the property is not - # listed in the file's entries. So add a handler to the list of line - # handlers to insert the property name into the lines, to provide a - # uniform interface to the final processing subroutine. - # the final code doesn't have to worry about that. - if ($property{$addr}) { - push @{$each_line_handler{$addr}}, \&_insert_property_into_line; + $non_skip{$addr} = 1 if $required_even_in_debug_skip{$addr}; + + # Convert 0 (meaning don't skip) to undef + undef $skip{$addr} unless $skip{$addr}; + + # Handle the case where this file is optional + my $pod_message_for_non_existent_optional = ""; + if ($optional{$addr}->@*) { + + # First element is the pod message + $pod_message_for_non_existent_optional + = shift $optional{$addr}->@*; + # Convert a 0 'Optional' argument to an empty list to make later + # code more concise. + if ( $optional{$addr}->@* + && $optional{$addr}->@* == 1 + && $optional{$addr}[0] ne "" + && $optional{$addr}[0] !~ /\D/ + && $optional{$addr}[0] == 0) + { + $optional{$addr} = [ ]; + } + else { # But if the only element doesn't evaluate to 0, make sure + # that this file is indeed considered optional below. + unshift $optional{$addr}->@*, 1; + } + } + + my $progress; + my $function_instead_of_file = 0; + + # If we are compiling a Unicode release earlier than the file became + # available, the constructor may have supplied a substitute + if ($first_released{$addr} gt $v_version && $early{$addr}->@*) { + + # Yes, we have a substitute, that we will use; mark it so + unshift $early{$addr}->@*, 1; + + # See the definition of %early for what the array elements mean. + # If we have a property this defines, create a table and default + # map for it now (at essentially compile time), so that it will be + # available for the whole of run time. (We will want to add this + # name as an alias when we are using the official property name; + # but this must be deferred until run(), because at construction + # time the official names have yet to be defined.) + if ($early{$addr}[2]) { + my $fate = ($property{$addr} + && $property{$addr} eq $early{$addr}[2]) + ? $PLACEHOLDER + : $INTERNAL_ONLY; + my $prop_object = Property->new($early{$addr}[2], + Fate => $fate, + Perl_Extension => 1, + ); + + # Use the default mapping for the regular property for this + # substitute one. + if ( defined $property{$addr} + && defined $default_mapping{$property{$addr}}) + { + $prop_object + ->set_default_map($default_mapping{$property{$addr}}); + } + } + + if (ref $early{$addr}[1] eq 'CODE') { + $function_instead_of_file = 1; + + # If the first element of the array is a code ref, the others + # are optional. + $handler{$addr} = $early{$addr}[1]; + $property{$addr} = $early{$addr}[2] + if defined $early{$addr}[2]; + $progress = "substitute $file{$addr}"; + + undef $file{$addr}; + } + else { # Specifying a substitute file + + if (! main::file_exists($early{$addr}[1])) { + + # If we don't see the substitute file, generate an error + # message giving the needed things, and add it to the list + # of such to output before actual processing happens + # (hence the user finds out all of them in one run). + # Instead of creating a general method for NameAliases, + # hard-code it here, as there is unlikely to ever be a + # second one which needs special handling. + my $string_version = ($file{$addr} eq "NameAliases.txt") + ? 'at least 6.1 (the later, the better)' + : sprintf "%vd", $first_released{$addr}; + push @missing_early_files, <@*, \&_exclude_unassigned; + + if ( $v_version lt v2.0 # Hanguls in this release ... + && defined $early{$addr}[3]) # ... need special treatment + { + push $eof_handler{$addr}->@*, \&_fixup_obsolete_hanguls; + } + } + + # And this substitute is valid for all releases. + $first_released{$addr} = v0; + } + else { # Normal behavior + $progress = $file{$addr}; + unshift $early{$addr}->@*, 0; # No substitute } - if ($non_skip{$addr} && ! $debug_skip && $verbosity) { - print "Warning: " . __PACKAGE__ . " constructor for $file{$addr} has useless 'non_skip' in it\n"; + my $file = $file{$addr}; + $progress_message{$addr} = "Processing $progress" + unless $progress_message{$addr}; + + # A file should be there if it is within the window of versions for + # which Unicode supplies it + if ($withdrawn{$addr} && $withdrawn{$addr} le $v_version) { + $in_this_release{$addr} = 0; + $skip{$addr} = ""; + } + else { + $in_this_release{$addr} = $first_released{$addr} le $v_version; + + # Check that the file for this object (possibly using a substitute + # for early releases) exists or we have a function alternative + if ( ! $function_instead_of_file + && ! main::file_exists($file)) + { + # Here there is nothing available for this release. This is + # fine if we aren't expecting anything in this release. + if (! $in_this_release{$addr}) { + $skip{$addr} = ""; # Don't remark since we expected + # nothing and got nothing + } + elsif ($optional{$addr}->@*) { + + # Here the file is optional in this release; Use the + # passed in text to document this case in the pod. + $skip{$addr} = $pod_message_for_non_existent_optional; + } + elsif ( $in_this_release{$addr} + && ! defined $skip{$addr} + && defined $file) + { # Doesn't exist but should. + $skip{$addr} = "'$file' not found. Possibly Big problems"; + Carp::my_carp($skip{$addr}); + } + } + elsif ($debug_skip && ! defined $skip{$addr} && ! $non_skip{$addr}) + { + + # The file exists; if not skipped for another reason, and we are + # skipping most everything during debugging builds, use that as + # the skip reason. + $skip{$addr} = '$debug_skip is on' + } + } + + if ( ! $debug_skip + && $non_skip{$addr} + && ! $required_even_in_debug_skip{$addr} + && $verbosity) + { + print "Warning: " . __PACKAGE__ . " constructor for $file has useless 'non_skip' in it\n"; } - # If skipping, set to optional, and add to list of ignored files, - # including its reason - if ($skip{$addr}) { - $optional{$addr} = 1; - $skipped_files{$file{$addr}} = $skip{$addr} if $file{$addr}; + # Here, we have figured out if we will be skipping this file or not. + # If so, we add any single property it defines to any passed in + # optional property list. These will be dealt with at run time. + if (defined $skip{$addr}) { + if ($property{$addr}) { + push $optional{$addr}->@*, $property{$addr}; + } + } # Otherwise, are going to process the file. + elsif ($property{$addr}) { + + # If the file has a property defined in the constructor for it, it + # means that the property is not listed in the file's entries. So + # add a handler (to the list of line handlers) to insert the + # property name into the lines, to provide a uniform interface to + # the final processing subroutine. + push @{$each_line_handler{$addr}}, \&_insert_property_into_line; } elsif ($properties{$addr}) { - # Add a handler for each line in the input so that it creates a - # separate input line for each property in those input lines, thus - # making them suitable for process_generic_property_file(). + # Similarly, there may be more than one property represented on + # each line, with no clue but the constructor input what those + # might be. Add a handler for each line in the input so that it + # creates a separate input line for each property in those input + # lines, thus making them suitable to handle generically. push @{$each_line_handler{$addr}}, sub { @@ -2376,7 +2568,7 @@ sub trace { return main::trace(@_); } }; } - { # On non-ascii platforms, we use a special handler + { # On non-ascii platforms, we use a special pre-handler no strict; no warnings 'once'; *next_line = (main::NON_ASCII_PLATFORM) @@ -2384,6 +2576,9 @@ sub trace { return main::trace(@_); } : *_next_line; } + &{$construction_time_handler{$addr}}($self) + if $construction_time_handler{$addr}; + return $self; } @@ -2401,13 +2596,13 @@ sub trace { return main::trace(@_); } return __PACKAGE__ . " object for " . $self->file; } - # flag to make sure extracted files are processed early - my $seen_non_extracted_non_age = 0; - sub run { # Process the input object $self. This opens and closes the file and # calls all the handlers for it. Currently, this can only be called - # once per file, as it destroy's the EOF handler + # once per file, as it destroy's the EOF handlers + + # flag to make sure extracted files are processed early + state $seen_non_extracted_non_age = 0; my $self = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; @@ -2416,61 +2611,14 @@ sub trace { return main::trace(@_); } my $file = $file{$addr}; - # Don't process if not expecting this file (because released later - # than this Unicode version), and isn't there. This means if someone - # copies it into an earlier version's directory, we will go ahead and - # process it. - return if $first_released{$addr} gt $v_version - && (! defined $file || ! -e $file); - - # If in debugging mode and this file doesn't have the non-skip - # flag set, and isn't one of the critical files, skip it. - if ($debug_skip - && $first_released{$addr} ne v0 - && ! $non_skip{$addr}) - { - print "Skipping $file in debugging\n" if $verbosity; - return; - } - - # File could be optional - if ($optional{$addr}) { - return unless -e $file; - my $result = eval $optional{$addr}; - if (! defined $result) { - Carp::my_carp_bug("Got '$@' when tried to eval $optional{$addr}. $file Skipped."); - return; - } - if (! $result) { - if ($verbosity) { - print STDERR "Skipping processing input file '$file' because '$optional{$addr}' is not true\n"; - } - return; - } - } - - if (! defined $file || ! -e $file) { - - # If the file doesn't exist, see if have internal data for it - # (based on first_released being 0). - if ($first_released{$addr} eq v0) { - $handle{$addr} = 'pretend_is_open'; - } - else { - if (! $optional{$addr} # File could be optional - && $v_version ge $first_released{$addr}) - { - print STDERR "Skipping processing input file '$file' because not found\n" if $v_version ge $first_released{$addr}; - } - return; - } + if (! $file) { + $handle{$addr} = 'pretend_is_open'; } else { - - # Here, the file exists. Some platforms may change the case of - # its name if ($seen_non_extracted_non_age) { - if ($file =~ /$EXTRACTED/i) { + if ($file =~ /$EXTRACTED/i) # Some platforms may change the + # case of the file's name + { Carp::my_carp_bug(main::join_lines(<rel2abs($file); - my $expecting = delete $potential_files{lc($fkey)}; + my $exists = delete $potential_files{lc($fkey)}; + + Carp::my_carp("Was not expecting '$file'.") + if $exists && ! $in_this_release{$addr}; + + # If there is special handling for compiling Unicode releases + # earlier than the first one in which Unicode defines this + # property ... + if ($early{$addr}->@* > 1) { + + # Mark as processed any substitute file that would be used in + # such a release + $fkey = File::Spec->rel2abs($early{$addr}[1]); + delete $potential_files{lc($fkey)}; + + # As commented in the constructor code, when using the + # official property, we still have to allow the publicly + # inaccessible early name so that the core code which uses it + # will work regardless. + if (! $early{$addr}[0] && $early{$addr}->@* > 2) { + my $early_property_name = $early{$addr}[2]; + if ($property{$addr} ne $early_property_name) { + main::property_ref($property{$addr}) + ->add_alias($early_property_name); + } + } + } + + # We may be skipping this file ... + if (defined $skip{$addr}) { - Carp::my_carp("Was not expecting '$file'.") if - ! $expecting - && ! defined $handle{$addr}; + # If the file isn't supposed to be in this release, there is + # nothing to do + if ($in_this_release{$addr}) { + + # But otherwise, we may print a message + if ($debug_skip) { + print STDERR "Skipping input file '$file'", + " because '$skip{$addr}'\n"; + } + + # And add it to the list of skipped files, which is later + # used to make the pod + $skipped_files{$file} = $skip{$addr}; + + # The 'optional' list contains properties that are also to + # be skipped along with the file. (There may also be + # digits which are just placeholders to make sure it isn't + # an empty list + foreach my $property ($optional{$addr}->@*) { + next unless $property =~ /\D/; + my $prop_object = main::property_ref($property); + next unless defined $prop_object; + $prop_object->set_fate($SUPPRESSED, $skip{$addr}); + } + } - # Having deleted from expected files, we can quit if not to do - # anything. Don't print progress unless really want verbosity - if ($skip{$addr}) { - print "Skipping $file.\n" if $verbosity >= $VERBOSE; return; } - # Open the file, converting the slashes used in this program - # into the proper form for the OS + # Here, we are going to process the file. Open it, converting the + # slashes used in this program into the proper form for the OS my $file_handle; if (not open $file_handle, "<", $file) { Carp::my_carp("Can't open $file. Skipping: $!"); - return 0; + return; } $handle{$addr} = $file_handle; # Cache the open file handle - if ($v_version ge v3.2.0 && lc($file) ne 'unicodedata.txt') { + # If possible, make sure that the file is the correct version. + # (This data isn't available on early Unicode releases or in + # UnicodeData.txt.) We don't do this check if we are using a + # substitute file instead of the official one (though the code + # could be extended to do so). + if ($in_this_release{$addr} + && ! $early{$addr}[0] + && lc($file) ne 'unicodedata.txt') + { if ($file !~ /^Unihan/i) { - $_ = <$file_handle>; - if ($_ !~ / - $string_version \. /x) { - chomp; - $_ =~ s/^#\s*//; - die Carp::my_carp("File '$file' is version '$_'. It should be version $string_version"); + + # The non-Unihan files started getting version numbers in + # 3.2, but some files in 4.0 are unchanged from 3.2, and + # marked as 3.2. 4.0.1 is the first version where there + # are no files marked as being from less than 4.0, though + # some are marked as 4.0. In versions after that, the + # numbers are correct. + if ($v_version ge v4.0.1) { + $_ = <$file_handle>; # The version number is in the + # very first line + if ($_ !~ / - $string_version \. /x) { + chomp; + $_ =~ s/^#\s*//; + + # 4.0.1 had some valid files that weren't updated. + if (! ($v_version eq v4.0.1 && $_ =~ /4\.0\.0/)) { + die Carp::my_carp("File '$file' is version " + . "'$_'. It should be " + . "version $string_version"); + } + } } } - else { + elsif ($v_version ge v6.0.0) { # Unihan + + # Unihan files didn't get accurate version numbers until + # 6.0. The version is somewhere in the first comment + # block while (<$file_handle>) { if ($_ !~ /^#/) { - Carp::my_carp_bug("Could not find the expected version info in file '$file'"); + Carp::my_carp_bug("Could not find the expected " + . "version info in file '$file'"); last; } chomp; $_ =~ s/^#\s*//; next if $_ !~ / version: /x; last if $_ =~ /$string_version/; - die Carp::my_carp("File '$file' is '$_'. It should be version $string_version"); + die Carp::my_carp("File '$file' is version " + . "'$_'. It should be " + . "version $string_version"); } } } } - if ($verbosity >= $PROGRESS) { - if ($progress_message{$addr}) { - print "$progress_message{$addr}\n"; - } - else { - # If using a virtual file, say so. - print "Processing ", (-e $file) - ? $file - : "substitute $file", - "\n"; - } - } - + print "$progress_message{$addr}\n" if $verbosity >= $PROGRESS; # Call any special handler for before the file. &{$pre_handler{$addr}}($self) if $pre_handler{$addr}; @@ -2742,11 +2959,11 @@ END return 1; } # End of looping through lines. - # If there is an EOF handler, call it (only once) and if it generates + # If there are EOF handlers, call each (only once) and if it generates # more lines to process go back in the loop to handle them. - if ($eof_handler{$addr}) { - &{$eof_handler{$addr}}($self); - $eof_handler{$addr} = ""; # Currently only get one shot at it. + while ($eof_handler{$addr}->@*) { + &{$eof_handler{$addr}[0]}($self); + shift $eof_handler{$addr}->@*; # Currently only get one shot at it. goto LINE if $added_lines{$addr}; } @@ -2943,6 +3160,82 @@ END return @return; } + sub _exclude_unassigned { + + # Takes the range in $_ and excludes code points that aren't assigned + # in this release + + state $skip_inserted_count = 0; + + # Ignore recursive calls. + if ($skip_inserted_count) { + $skip_inserted_count--; + return; + } + + # Find what code points are assigned in this release + main::calculate_Assigned() if ! defined $Assigned; + + my $self = shift; + my $addr = do { no overloading; pack 'J', $self; }; + Carp::carp_extra_args(\@_) if main::DEBUG && @_; + + my ($range, @remainder) + = split /\s*;\s*/, $_, -1; # -1 => retain trailing null fields + + # Examine the range. + if ($range =~ /^ ($code_point_re) (?:\.\. ($code_point_re) )? $/x) + { + my $low = hex $1; + my $high = (defined $2) ? hex $2 : $low; + + # Split the range into subranges of just those code points in it + # that are assigned. + my @ranges = (Range_List->new(Initialize + => Range->new($low, $high)) & $Assigned)->ranges; + + # Do nothing if nothing in the original range is assigned in this + # release; handle normally if everything is in this release. + if (! @ranges) { + $_ = ""; + } + elsif (@ranges != 1) { + + # Here, some code points in the original range aren't in this + # release; @ranges gives the ones that are. Create fake input + # lines for each of the ranges, and set things up so that when + # this routine is called on that fake input, it will do + # nothing. + $skip_inserted_count = @ranges; + my $remainder = join ";", @remainder; + for my $range (@ranges) { + $self->insert_lines(sprintf("%04X..%04X;%s", + $range->start, $range->end, $remainder)); + } + $_ = ""; # The original range is now defunct. + } + } + + return; + } + + sub _fixup_obsolete_hanguls { + + # This is called only when compiling Unicode version 1. All Unicode + # data for subsequent releases assumes that the code points that were + # Hangul syllables in this release only are something else, so if + # using such data, we have to override it + + my $self = shift; + my $addr = do { no overloading; pack 'J', $self; }; + Carp::carp_extra_args(\@_) if main::DEBUG && @_; + + my $object = main::property_ref($property{$addr}); + $object->add_map(0x3400, 0x4DFF, + $early{$addr}[3], # Passed-in value for these + Replace => $UNCONDITIONALLY); + } + sub _insert_property_into_line { # Add a property field to $_, if this file requires it. @@ -3027,6 +3320,8 @@ package Multi_Default; # . # . # 'U')); + # It is best to leave the final value be the one that matches the + # above-Unicode code points. my $class = shift; @@ -3732,7 +4027,7 @@ sub trace { return main::trace(@_); } # => $MULTIPLE_BEFORE means that if this range duplicates an # existing one, but has a different value, # don't replace the existing one, but insert - # this, one so that the same range can occur + # this one so that the same range can occur # multiple times. They are stored LIFO, so # that the final one inserted is the first one # returned in an ordered search of the table. @@ -3747,6 +4042,7 @@ sub trace { return main::trace(@_); } # existing range, this one is discarded # (leaving the existing one in its original, # higher priority position + # => $CROAK Die with an error if is already there # => anything else is the same as => $IF_NOT_EQUIVALENT # # "same value" means identical for non-type-0 ranges, and it means @@ -3835,7 +4131,7 @@ sub trace { return main::trace(@_); } # Here, the new range starts just after the current highest in # the range list, and they have the same type and value. - # Extend the current range to incorporate the new one. + # Extend the existing range to incorporate the new one. @{$r}[-1]->set_end($end); } @@ -4228,7 +4524,7 @@ sub trace { return main::trace(@_); } # In other words, # r[$i-1]->end < $start <= r[$i]->end # And: - # r[$i-1]->end < $start <= $end <= r[$j+1]->start + # r[$i-1]->end < $start <= $end < r[$j+1]->start # # Also: # $clean_insert is a boolean which is set true if and only if @@ -5093,6 +5389,7 @@ sub trace { return main::trace(@_); } my $note = delete $args{'Note'}; my $make_re_pod_entry = delete $args{'Re_Pod_Entry'}; my $perl_extension = delete $args{'Perl_Extension'}; + my $suppression_reason = delete $args{'Suppression_Reason'}; # Shouldn't have any left over Carp::carp_extra_args(\%args) if main::DEBUG && %args; @@ -5134,11 +5431,12 @@ END { $fate{$addr} = $SUPPRESSED; } - elsif ($fate{$addr} == $SUPPRESSED - && ! exists $why_suppressed{$property{$addr}->complete_name}) - { - Carp::my_carp_bug("There is no current capability to set the reason for suppressing."); - # perhaps Fate => [ $SUPPRESSED, "reason" ] + elsif ($fate{$addr} == $SUPPRESSED) { + Carp::my_carp_bug("Need reason for suppressing") unless $suppression_reason; + # Though currently unused + } + elsif ($suppression_reason) { + Carp::my_carp_bug("A reason was given for suppressing, but not suppressed"); } # If hasn't set its status already, see if it is on one of the @@ -5266,17 +5564,18 @@ END my %args = @_; my $loose_match = delete $args{'Fuzzy'}; - my $make_re_pod_entry = delete $args{'Re_Pod_Entry'}; - $make_re_pod_entry = $YES unless defined $make_re_pod_entry; - my $ok_as_filename = delete $args{'OK_as_Filename'}; $ok_as_filename = 1 unless defined $ok_as_filename; - my $status = delete $args{'Status'}; - $status = $NORMAL unless defined $status; - # An internal name does not get documented, unless overridden by the - # input. + # input; same for making tests for it. + my $status = delete $args{'Status'} || (($name =~ /^_/) + ? $INTERNAL_ALIAS + : $NORMAL); + my $make_re_pod_entry = delete $args{'Re_Pod_Entry'} + // (($status ne $INTERNAL_ALIAS) + ? (($name =~ /^_/) ? $NO : $YES) + : $NO); my $ucd = delete $args{'UCD'} // (($name =~ /^_/) ? 0 : 1); Carp::carp_extra_args(\%args) if main::DEBUG && %args; @@ -5346,7 +5645,7 @@ END $insert_position, 0, Alias->new($name, $loose_match, $make_re_pod_entry, - $ok_as_filename, $status, $ucd); + $ok_as_filename, $status, $ucd); # This name may be shorter than any existing ones, so clear the cache # of the shortest, so will have to be recalculated. @@ -6064,7 +6363,10 @@ END else { # Indent if not displaying code points $annotation = " " x 4; } - $annotation .= " $range_name" if $range_name; + if ($range_name) { + $annotation .= " $age[$i]" if $age[$i]; + $annotation .= " $range_name"; + } # Include the number of code points in the # range @@ -6141,7 +6443,7 @@ END } if ($include_cp) { - $annotation = sprintf "%04X", $i; + $annotation = sprintf "%04X %s", $i, $age[$i]; if ($use_adjustments) { $annotation .= " => $output_value"; } @@ -6267,7 +6569,8 @@ END } # Save the reason for suppression for output - if ($fate == $SUPPRESSED && defined $reason) { + if ($fate >= $SUPPRESSED) { + $reason = "" unless defined $reason; $why_suppressed{$complete_name{$addr}} = $reason; } @@ -6763,7 +7066,7 @@ END # The ranges that map to the default aren't output, so subtract that # to get those actually output. A property with matching tables # already has the information calculated. - if ($property->type != $STRING) { + if ($property->type != $STRING && $property->type != $FORCED_BINARY) { $count -= $property->table($default_map)->count; } elsif (defined $default_map) { @@ -6839,9 +7142,11 @@ END $comment .= "This file returns the $mapping:\n"; my $ucd_accessible_name = ""; + my $has_underscore_name = 0; my $full_name = $self->property->full_name; for my $i (0 .. @property_aliases - 1) { my $name = $property_aliases[$i]->name; + $has_underscore_name = 1 if $name =~ /^_/; $comment .= sprintf("%-8s%s\n", " ", $name . '(cp)'); if ($property_aliases[$i]->ucd) { if ($name eq $full_name) { @@ -6854,7 +7159,12 @@ END } $comment .= "\nwhere 'cp' is $cp."; if ($ucd_accessible_name) { - $comment .= " Note that $these_mappings $are accessible via the functions prop_invmap('$full_name') or charprop() in Unicode::UCD"; + $comment .= " Note that $these_mappings"; + if ($has_underscore_name) { + $comment .= " (except for the one(s) that begin with an underscore)"; + } + $comment .= " $are accessible via the functions prop_invmap('$full_name') or charprop() in Unicode::UCD"; + } # And append any commentary already set from the actual property. @@ -6888,7 +7198,7 @@ END # There are tables which end up only having one element per # range, but it is not worth keeping track of for making just # this comment a little better. - $comment.= <= 2); # boolean, ? are there unrelated # tables - for my $parent (@parents) { my $property = $parent->property; @@ -7906,7 +8215,7 @@ END # commentary that the other combinations are possible. # Because regular expressions don't recognize things like # \p{jsn=}, only look at non-null right-hand-sides - my @property_aliases = $table_property->aliases; + my @property_aliases = grep { $_->status ne $INTERNAL_ALIAS } $table_property->aliases; my @table_aliases = grep { $_->name ne "" } $table->aliases; # The alias lists above are already ordered in the order we @@ -7918,8 +8227,7 @@ END ? main::max(scalar @table_aliases, scalar @property_aliases) : 0; - trace "$listed_combos, tables=", scalar @table_aliases, "; names=", scalar @property_aliases if main::DEBUG; - + trace "$listed_combos, tables=", scalar @table_aliases, "; property names=", scalar @property_aliases if main::DEBUG; my $property_had_compound_name = 0; @@ -8070,8 +8378,14 @@ END foreach my $flag (sort keys %flags) { $comment .= <perl_extension if ! defined $perl_extension; + my $fate; + my $suppression_reason = ""; + if ($self->name =~ /^_/) { + $fate = $SUPPRESSED; + $suppression_reason = "Parent property is internal only"; + } + elsif ($self->fate >= $SUPPRESSED) { + $fate = $self->fate; + $suppression_reason = $why_suppressed{$self->complete_name}; + + } + elsif ($name =~ /^_/) { + $fate = $INTERNAL_ONLY; + } $table = Match_Table->new( Name => $name, Perl_Extension => $perl_extension, _Alias_Hash => $table_ref{$addr}, _Property => $self, - - # gets property's fate and status by default, - # except if the name begind with an - # underscore, default it to internal - Fate => ($name =~ /^_/) - ? $INTERNAL_ONLY - : $self->fate, + Fate => $fate, + Suppression_Reason => $suppression_reason, Status => $self->status, _Status_Info => $self->status_info, %args); @@ -8562,10 +8885,13 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } # Swash names are used only on either # 1) legacy-only properties, because the formats for these are # unchangeable, and they have had these lines in them; or - # 2) regular map tables; otherwise there should be no access to the + # 2) regular or internal-only map tables + # 3) otherwise there should be no access to the # property map table from other parts of Perl. return if $map{$addr}->fate != $ORDINARY - && $map{$addr}->fate != $LEGACY_ONLY; + && $map{$addr}->fate != $LEGACY_ONLY + && ! ($map{$addr}->name =~ /^_/ + && $map{$addr}->fate == $INTERNAL_ONLY); return $file{$addr} if defined $file{$addr}; return $map{$addr}->external_name; @@ -8589,9 +8915,6 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } # to it. return 0 if $type{$addr} == $STRING; - # Don't generate anything for unimplemented properties. - return 0 if grep { $self->complete_name eq $_ } - @unimplemented_properties; # Otherwise, do. return 1; } @@ -8808,7 +9131,7 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } Carp::carp_extra_args(\@_) if main::DEBUG && @_; my $addr = do { no overloading; pack 'J', $self; }; - if ($fate == $SUPPRESSED) { + if ($fate >= $SUPPRESSED) { $why_suppressed{$self->complete_name} = $reason; } @@ -8894,15 +9217,15 @@ sub trace { return main::trace(@_) if main::DEBUG && $to_trace } package main; - sub display_chr { - # Converts an ordinal printable character value to a displayable - # string, using a dotted circle to hold combining characters. +sub display_chr { + # Converts an ordinal printable character value to a displayable string, + # using a dotted circle to hold combining characters. - my $ord = shift; - my $chr = chr $ord; - return $chr if $ccc->table(0)->contains($ord); - return "\x{25CC}$chr"; - } + my $ord = shift; + my $chr = chr $ord; + return $chr if $ccc->table(0)->contains($ord); + return "\x{25CC}$chr"; +} sub join_lines($) { # Returns lines of the input joined together, so that they can be folded @@ -9443,7 +9766,6 @@ sub dump_inside_out { my $object = shift; my $fields_ref = shift; - Carp::carp_extra_args(\@_) if main::DEBUG && @_; my $addr = do { no overloading; pack 'J', $object; }; @@ -9520,6 +9842,17 @@ sub _operator_not_equal { return ! _operator_equal($self, $other); } +sub substitute_PropertyAliases($) { + # Deal with early releases that don't have the crucial PropertyAliases.txt + # file. + + my $file_object = shift; + $file_object->insert_lines(get_old_property_aliases()); + + process_PropertyAliases($file_object); +} + + sub process_PropertyAliases($) { # This reads in the PropertyAliases.txt file, which contains almost all # the character properties in Unicode and their equivalent aliases: @@ -9532,11 +9865,6 @@ sub process_PropertyAliases($) { my $file= shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - # This whole file was non-existent in early releases, so use our own - # internal one. - $file->insert_lines(get_old_property_aliases()) - if ! -e 'PropertyAliases.txt'; - # Add any cjk properties that may have been defined. $file->insert_lines(@cjk_properties); @@ -9546,8 +9874,17 @@ sub process_PropertyAliases($) { my $full = $data[1]; + # This line is defective in early Perls. The property in Unihan.txt + # is kRSUnicode. + if ($full eq 'Unicode_Radical_Stroke' && @data < 3) { + push @data, qw(cjkRSUnicode kRSUnicode); + } + my $this = Property->new($data[0], Full_Name => $full); + $this->set_fate($SUPPRESSED, $why_suppressed{$full}) + if $why_suppressed{$full}; + # Start looking for more aliases after these two. for my $i (2 .. @data - 1) { $this->add_alias($data[$i]); @@ -9573,18 +9910,6 @@ sub finish_property_setup { Property->new('JSN', Full_Name => 'Jamo_Short_Name'); } - # These two properties must be defined in all releases so we can generate - # the tables from them to make regex \X work, but suppress their output so - # aren't application visible prior to releases where they should be - if (! defined property_ref('GCB')) { - Property->new('GCB', Full_Name => 'Grapheme_Cluster_Break', - Fate => $PLACEHOLDER); - } - if (! defined property_ref('hst')) { - Property->new('hst', Full_Name => 'Hangul_Syllable_Type', - Fate => $PLACEHOLDER); - } - # These are used so much, that we set globals for them. $gc = property_ref('General_Category'); $block = property_ref('Block'); @@ -9701,22 +10026,15 @@ sub finish_property_setup { # for non-assigned code points; 'AL' for assigned. if (file_exists("${EXTRACTED}DLineBreak.txt") || -e 'LineBreak.txt') { my $lb = property_ref('Line_Break'); - if ($v_version gt 3.2.0) { + if (file_exists("${EXTRACTED}DLineBreak.txt")) { $lb->set_default_map('Unknown'); } else { - my $default = Multi_Default->new( 'Unknown' => '$gc->table("Cn")', - 'AL'); + my $default = Multi_Default->new('AL' => '~ $gc->table("Cn")', + 'Unknown', + ); $lb->set_default_map($default); } - - # If has the URS property, make sure that the standard aliases are in - # it, since not in the input tables in some versions. - my $urs = property_ref('Unicode_Radical_Stroke'); - if (defined $urs) { - $urs->add_alias('cjkRSUnicode'); - $urs->add_alias('kRSUnicode'); - } } # For backwards compatibility with applications that may read the mapping @@ -9874,6 +10192,16 @@ END return @return; } +sub substitute_PropValueAliases($) { + # Deal with early releases that don't have the crucial + # PropValueAliases.txt file. + + my $file_object = shift; + $file_object->insert_lines(get_old_property_value_aliases()); + + process_PropValueAliases($file_object); +} + sub process_PropValueAliases { # This file contains values that properties look like: # bc ; AL ; Arabic_Letter @@ -9899,35 +10227,29 @@ sub process_PropValueAliases { my $file= shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - # This whole file was non-existent in early releases, so use our own - # internal one if necessary. - if (! -e 'PropValueAliases.txt') { - $file->insert_lines(get_old_property_value_aliases()); - } - if ($v_version lt 4.0.0) { $file->insert_lines(split /\n/, <<'END' -hst; L ; Leading_Jamo -hst; LV ; LV_Syllable -hst; LVT ; LVT_Syllable -hst; NA ; Not_Applicable -hst; T ; Trailing_Jamo -hst; V ; Vowel_Jamo +Hangul_Syllable_Type; L ; Leading_Jamo +Hangul_Syllable_Type; LV ; LV_Syllable +Hangul_Syllable_Type; LVT ; LVT_Syllable +Hangul_Syllable_Type; NA ; Not_Applicable +Hangul_Syllable_Type; T ; Trailing_Jamo +Hangul_Syllable_Type; V ; Vowel_Jamo END ); } if ($v_version lt 4.1.0) { $file->insert_lines(split /\n/, <<'END' -GCB; CN ; Control -GCB; CR ; CR -GCB; EX ; Extend -GCB; L ; L -GCB; LF ; LF -GCB; LV ; LV -GCB; LVT ; LVT -GCB; T ; T -GCB; V ; V -GCB; XX ; Other +_Perl_GCB; CN ; Control +_Perl_GCB; CR ; CR +_Perl_GCB; EX ; Extend +_Perl_GCB; L ; L +_Perl_GCB; LF ; LF +_Perl_GCB; LV ; LV +_Perl_GCB; LVT ; LVT +_Perl_GCB; T ; T +_Perl_GCB; V ; V +_Perl_GCB; XX ; Other END ); } @@ -9942,7 +10264,6 @@ END # program generates for this block property value #$file->insert_lines('blk; n/a; Herited'); - # Process each line of the file ... while ($file->next_line) { @@ -9959,6 +10280,11 @@ END # thus shifting the former field 0 to after them.) splice (@data, 0, 0, splice(@data, 1, 2)) if $property eq 'ccc'; + if ($v_version le v5.0.0 && $property eq 'blk' && $data[1] =~ /-/) { + my $new_style = $data[1] =~ s/-/_/gr; + splice @data, 1, 0, $new_style; + } + # Field 0 is a short name unless "n/a"; field 1 is the full name. If # there is no short name, use the full one in element 1 if ($data[0] eq "n/a") { @@ -10552,7 +10878,8 @@ sub output_perl_charnames_line ($$) { $line)); } - # And process the first range, like any other. + # And set things up so that the below will process this first + # range, like any other. $low = $this_range->start; $high = $this_range->end; } @@ -10963,11 +11290,12 @@ END my $file = shift; Carp::carp_extra_args(\@_) if main::DEBUG && @_; - # Create a new property specially located that is a combination of the + # Create a new property specially located that is a combination of # various Name properties: Name, Unicode_1_Name, Named Sequences, and - # Name_Alias properties. (The final duplicates elements of the - # first.) A comment for it will later be constructed based on the - # actual properties present and used + # _Perl_Name_Alias properties. (The final one duplicates elements of the + # first, and starting in v6.1, is the same as the 'Name_Alias + # property.) A comment for the new property will later be constructed + # based on the actual properties present and used $perl_charname = Property->new('Perl_Charnames', Default_Map => "", Directory => File::Spec->curdir(), @@ -12028,10 +12356,8 @@ sub filter_old_style_case_folding { Carp::carp_extra_args(\@_) if main::DEBUG && @_; my @fields = split /\s*;\s*/; - if ($fields[0] =~ /^ 013 [01] $/x) { # The two turkish fields - $fields[1] = 'I'; - } - elsif ($fields[1] eq 'L') { + + if ($fields[1] eq 'L') { $fields[1] = 'C'; # L => C always } elsif ($fields[1] eq 'E') { @@ -12339,6 +12665,68 @@ sub filter_numeric_value_line { { # Closure my %unihan_properties; + sub construct_unihan { + + my $file_object = shift; + + return unless file_exists($file_object->file); + + if ($v_version lt v4.0.0) { + push @cjk_properties, 'URS ; Unicode_Radical_Stroke'; + push @cjk_property_values, split "\n", <<'END'; +# @missing: 0000..10FFFF; Unicode_Radical_Stroke; +END + } + + if ($v_version ge v3.0.0) { + push @cjk_properties, split "\n", <<'END'; +cjkIRG_GSource; kIRG_GSource +cjkIRG_JSource; kIRG_JSource +cjkIRG_KSource; kIRG_KSource +cjkIRG_TSource; kIRG_TSource +cjkIRG_VSource; kIRG_VSource +END + push @cjk_property_values, split "\n", <<'END'; +# @missing: 0000..10FFFF; cjkIRG_GSource; +# @missing: 0000..10FFFF; cjkIRG_JSource; +# @missing: 0000..10FFFF; cjkIRG_KSource; +# @missing: 0000..10FFFF; cjkIRG_TSource; +# @missing: 0000..10FFFF; cjkIRG_VSource; +END + } + if ($v_version ge v3.1.0) { + push @cjk_properties, 'cjkIRG_HSource; kIRG_HSource'; + push @cjk_property_values, '# @missing: 0000..10FFFF; cjkIRG_HSource; '; + } + if ($v_version ge v3.1.1) { + push @cjk_properties, 'cjkIRG_KPSource; kIRG_KPSource'; + push @cjk_property_values, '# @missing: 0000..10FFFF; cjkIRG_KPSource; '; + } + if ($v_version ge v3.2.0) { + push @cjk_properties, split "\n", <<'END'; +cjkAccountingNumeric; kAccountingNumeric +cjkCompatibilityVariant; kCompatibilityVariant +cjkOtherNumeric; kOtherNumeric +cjkPrimaryNumeric; kPrimaryNumeric +END + push @cjk_property_values, split "\n", <<'END'; +# @missing: 0000..10FFFF; cjkAccountingNumeric; NaN +# @missing: 0000..10FFFF; cjkCompatibilityVariant; +# @missing: 0000..10FFFF; cjkOtherNumeric; NaN +# @missing: 0000..10FFFF; cjkPrimaryNumeric; NaN +END + } + if ($v_version gt v4.0.0) { + push @cjk_properties, 'cjkIRG_USource; kIRG_USource'; + push @cjk_property_values, '# @missing: 0000..10FFFF; cjkIRG_USource; '; + } + + if ($v_version ge v4.1.0) { + push @cjk_properties, 'cjkIICore ; kIICore'; + push @cjk_property_values, '# @missing: 0000..10FFFF; cjkIICore; '; + } + } + sub setup_unihan { # Do any special setup for Unihan properties. @@ -12351,16 +12739,16 @@ sub filter_numeric_value_line { my $iicore = property_ref('kIICore'); if (defined $iicore) { $iicore->set_type($FORCED_BINARY); - $iicore->table("Y")->add_note("Forced to a binary property as per unicode.org UAX #38."); + $iicore->table("Y")->add_note("Matches any code point which has a non-null value for this property; see unicode.org UAX #38."); # Unicode doesn't include the maps for this property, so don't # warn that they are missing. $iicore->set_pre_declared_maps(0); $iicore->add_comment(join_lines( <), the + # initial set is a subset of the later version, with different English + # transliterations. I did not see an easy mapping between them. The + # later set includes essentially all possibilities, even ones that aren't + # in modern use (if they ever were), and over 96% of the new ones are type + # LVT. Mathematically, the early set must also contain a preponderance of + # LVT values. In lieu of doing nothing, we just set them all to LVT, and + # expect that this will be right most of the time, which is better than + # not being right at all. if ($v_version lt v2.0.0) { my $property = property_ref($file->property); + $file->insert_lines("3400..4DFF; LVT\n"); push @tables_that_may_be_empty, $property->table('LV')->complete_name; - push @tables_that_may_be_empty, $property->table('LVT')->complete_name; return; } @@ -12712,7 +13110,6 @@ sub generate_GCB { # Also from http://www.unicode.org/reports/tr29/tr29-3.html. foreach my $code_point ( qw{ - 40000 09BE 09D7 0B3E 0B57 0BBE 0BD7 0CC2 0CD5 0CD6 0D3E 0D57 0DCF 0DDF FF9E FF9F 1D165 1D16E 1D16F } @@ -12735,275 +13132,50 @@ sub generate_GCB { generate_hst($file); } - return; + main::process_generic_property_file($file); } -sub setup_early_name_alias { - my $file= shift; - Carp::carp_extra_args(\@_) if main::DEBUG && @_; - # This has the effect of pretending that the Name_Alias property was - # available in all Unicode releases. Strictly speaking, this property - # should not be availabe in early releases, but doing this allows - # charnames.pm to work on older releases without change. Prior to v5.16 - # it had these names hard-coded inside it. Unicode 6.1 came along and - # created these names, and so they were removed from charnames. +sub fixup_early_perl_name_alias { - my $aliases = property_ref('Name_Alias'); - if (! defined $aliases) { - $aliases = Property->new('Name_Alias', Default_Map => ""); - } + # Different versions of Unicode have varying support for the name synonyms + # below. Just include everything. As of 6.1, all these are correct in + # the Unicode-supplied file. + + my $file= shift; + Carp::carp_extra_args(\@_) if main::DEBUG && @_; - $file->insert_lines(get_old_name_aliases()); - return; -} + # ALERT did not come along until 6.0, at which point it became preferred + # over BELL. By inserting it last in early releases, BELL is preferred + # over it; and vice-vers in 6.0 + my $type_for_bell = ($v_version lt v6.0.0) + ? 'correction' + : 'alternate'; + $file->insert_lines(split /\n/, < retain trailing null fields + my @words = split "_", $script; + for my $word (@words) { + $word = + ucfirst(lc($word)) if $word ne 'CJK'; + } + $script = join "_", @words; + $_ = join ";", $range, $script, @remainder; +} + sub finish_Unicode() { # This routine should be called after all the Unicode files have been read # in. It: @@ -13188,72 +13375,81 @@ END # Add any remaining code points to the mapping, using the default for # missing code points. my $default_table; - if (defined (my $default_map = $property->default_map)) { + my $default_map = $property->default_map; + if ($property_type == $FORCED_BINARY) { - # Make sure there is a match table for the default - if (! defined ($default_table = $property->table($default_map))) { - $default_table = $property->add_match_table($default_map); + # A forced binary property creates a 'Y' table that matches all + # non-default values. The actual string values are also written out + # as a map table. (The default value will almost certainly be the + # empty string, so the pod glosses over the distinction, and just + # talks about empty vs non-empty.) + my $yes = $property->table("Y"); + foreach my $range ($property->ranges) { + next if $range->value eq $default_map; + $yes->add_range($range->start, $range->end); } + $property->table("N")->set_complement($yes); + } + else { + if (defined $default_map) { - # And, if the property is binary, the default table will just - # be the complement of the other table. - if ($property_type == $BINARY) { - my $non_default_table; - - # Find the non-default table. - for my $table ($property->tables) { - next if $table == $default_table; - $non_default_table = $table; + # Make sure there is a match table for the default + if (! defined ($default_table = $property->table($default_map))) + { + $default_table = $property->add_match_table($default_map); } - $default_table->set_complement($non_default_table); - } - else { - # This fills in any missing values with the default. It's not - # necessary to do this with binary properties, as the default - # is defined completely in terms of the Y table. - $property->add_map(0, $MAX_WORKING_CODEPOINT, - $default_map, Replace => $NO); - } - } + # And, if the property is binary, the default table will just + # be the complement of the other table. + if ($property_type == $BINARY) { + my $non_default_table; - # Have all we need to populate the match tables. - my $maps_should_be_defined = $property->pre_declared_maps; - foreach my $range ($property->ranges) { - my $map = $range->value; - my $table = $property->table($map); - if (! defined $table) { + # Find the non-default table. + for my $table ($property->tables) { + if ($table == $default_table) { + if ($v_version le v5.0.0) { + $table->add_alias($_) for qw(N No F False); + } + next; + } elsif ($v_version le v5.0.0) { + $table->add_alias($_) for qw(Y Yes T True); + } + $non_default_table = $table; + } + $default_table->set_complement($non_default_table); + } + else { - # Integral and rational property values are not necessarily - # defined in PropValueAliases, but whether all the other ones - # should be depends on the property. - if ($maps_should_be_defined - && $map !~ /^ -? \d+ ( \/ \d+ )? $/x) - { - Carp::my_carp("Table '$property_name=$map' should have been defined. Defining it now.") + # This fills in any missing values with the default. It's + # not necessary to do this with binary properties, as the + # default is defined completely in terms of the Y table. + $property->add_map(0, $MAX_WORKING_CODEPOINT, + $default_map, Replace => $NO); } - $table = $property->add_match_table($map); } - next if $table->complement != 0; # Don't need to populate these - $table->add_range($range->start, $range->end); - } + # Have all we need to populate the match tables. + my $maps_should_be_defined = $property->pre_declared_maps; + foreach my $range ($property->ranges) { + my $map = $range->value; + my $table = $property->table($map); + if (! defined $table) { - # A forced binary property has additional true/false tables which - # should have been set up when it was forced into binary. The false - # table matches exactly the same set as the property's default table. - # The true table matches the complement of that. The false table is - # not the same as an additional set of aliases on top of the default - # table, so use 'set_equivalent_to'. If it were implemented as - # additional aliases, various things would have to be adjusted, but - # especially, if the user wants to get a list of names for the table - # using Unicode::UCD::prop_value_aliases(), s/he should get a - # different set depending on whether they want the default table or - # the false table. - if ($property_type == $FORCED_BINARY) { - $property->table('N')->set_equivalent_to($default_table, - Related => 1); - $property->table('Y')->set_complement($default_table); + # Integral and rational property values are not + # necessarily defined in PropValueAliases, but whether all + # the other ones should be depends on the property. + if ($maps_should_be_defined + && $map !~ /^ -? \d+ ( \/ \d+ )? $/x) + { + Carp::my_carp("Table '$property_name=$map' should " + . "have been defined. Defining it now.") + } + $table = $property->add_match_table($map); + } + + next if $table->complement != 0; # Don't need to populate these + $table->add_range($range->start, $range->end); + } } # For Perl 5.6 compatibility, all properties matchable in regexes can @@ -13321,8 +13517,6 @@ END $gc->table('Ll')->set_caseless_equivalent($LC); $gc->table('Lu')->set_caseless_equivalent($LC); - my $Cs = $gc->table('Cs'); - # Create digit and case fold tables with the original file names for # backwards compatibility with applications that read them directly. my $Digit = Property->new("Legacy_Perl_Decimal_Digit", @@ -13408,6 +13602,26 @@ sub pre_3_dot_1_Nl () { return $Nl; } +sub calculate_Assigned() { # Calculate the gc != Cn code points; may be + # called before the Cn's are completely filled. + # Works on Unicodes earlier than ones that + # explicitly specify Cn. + return if defined $Assigned; + + if (! defined $gc || $gc->is_empty()) { + Carp::my_carp_bug("calculate_Assigned() called before $gc is populated"); + } + + $Assigned = $perl->add_match_table('Assigned', + Description => "All assigned code points", + ); + while (defined (my $range = $gc->each_range())) { + my $standard_value = standardize($range->value); + next if $standard_value eq 'cn' || $standard_value eq 'unassigned'; + $Assigned->add_range($range->start, $range->end); + } +} + sub compile_perl() { # Create perl-defined tables. Almost all are part of the pseudo-property # named 'perl' internally to this program. Many of these are recommended @@ -13446,16 +13660,12 @@ sub compile_perl() { } my $Any = $perl->add_match_table('Any', - Description => "All Unicode code points: [\\x{0000}-\\x{10FFFF}]", + Description => "All Unicode code points: [\\x{0000}-\\x{$MAX_UNICODE_CODEPOINT_STRING}]", ); - $Any->add_range(0, 0x10FFFF); + $Any->add_range(0, $MAX_UNICODE_CODEPOINT); $Any->add_alias('Unicode'); - # Assigned is the opposite of gc=unassigned - my $Assigned = $perl->add_match_table('Assigned', - Description => "All assigned code points", - Initialize => ~ $gc->table('Unassigned'), - ); + calculate_Assigned(); # Our internal-only property should be treated as more than just a # synonym; grandfather it in to the pod. @@ -13501,32 +13711,27 @@ sub compile_perl() { # There are quite a few code points in Lower, that aren't in gc=lc, # and not all are in all releases. - foreach my $code_point ( utf8::unicode_to_native(0xAA), - utf8::unicode_to_native(0xBA), - 0x02B0 .. 0x02B8, - 0x02C0 .. 0x02C1, - 0x02E0 .. 0x02E4, - 0x0345, - 0x037A, - 0x1D2C .. 0x1D6A, - 0x1D78, - 0x1D9B .. 0x1DBF, - 0x2071, - 0x207F, - 0x2090 .. 0x209C, - 0x2170 .. 0x217F, - 0x24D0 .. 0x24E9, - 0x2C7C .. 0x2C7D, - 0xA770, - 0xA7F8 .. 0xA7F9, - ) { - # Don't include the code point unless it is assigned in this - # release - my $category = $gc->value_of(hex $code_point); - next if ! defined $category || $category eq 'Cn'; - - $Lower += $code_point; - } + my $temp = Range_List->new(Initialize => [ + utf8::unicode_to_native(0xAA), + utf8::unicode_to_native(0xBA), + 0x02B0 .. 0x02B8, + 0x02C0 .. 0x02C1, + 0x02E0 .. 0x02E4, + 0x0345, + 0x037A, + 0x1D2C .. 0x1D6A, + 0x1D78, + 0x1D9B .. 0x1DBF, + 0x2071, + 0x207F, + 0x2090 .. 0x209C, + 0x2170 .. 0x217F, + 0x24D0 .. 0x24E9, + 0x2C7C .. 0x2C7D, + 0xA770, + 0xA7F8 .. 0xA7F9, + ]); + $Lower += $temp & $Assigned; } my $Posix_Lower = $perl->add_match_table("PosixLower", Description => "[a-z]", @@ -13832,6 +14037,7 @@ sub compile_perl() { ); $Space->add_alias('XPerlSpace'); # Pre-existing synonyms $Space->add_alias('SpacePerl'); + $Space->add_alias('Space') if $v_version lt v4.1.0; my $Posix_space = $perl->add_match_table("PosixSpace", Description => "\\t, \\n, \\cK, \\f, \\r, and ' '. (\\cK is vertical tab)", @@ -13847,11 +14053,18 @@ sub compile_perl() { Initialize => $Cntrl & $ASCII, ); + my $perl_surrogate = $perl->add_match_table('_Perl_Surrogate'); + if (defined (my $Cs = $gc->table('Cs'))) { + $perl_surrogate += $Cs; + } + else { + push @tables_that_may_be_empty, '_Perl_Surrogate'; + } + # $controls is a temporary used to construct Graph. my $controls = Range_List->new(Initialize => $gc->table('Unassigned') - + $gc->table('Control')); - # Cs not in release 1 - $controls += $gc->table('Surrogate') if defined $gc->table('Surrogate'); + + $gc->table('Control') + + $perl_surrogate); # Graph is ~space & ~(Cc|Cs|Cn) = ~(space + $controls) my $Graph = $perl->add_match_table('Graph', Full_Name => 'XPosixGraph', @@ -13957,14 +14170,21 @@ sub compile_perl() { # 31f05a37c4e9c37a7263491f2fc0237d836e1a80 for a more complete description # of the MU issue. foreach my $range ($loc_problem_folds->ranges) { - foreach my $code_point($range->start .. $range->end) { + foreach my $code_point ($range->start .. $range->end) { my $fold_range = $cf->containing_range($code_point); next unless defined $fold_range; + # Skip if folds to itself + next if $fold_range->value eq $CODE_POINT; + my @hex_folds = split " ", $fold_range->value; - my $start_cp = hex $hex_folds[0]; + my $start_cp = $hex_folds[0]; + next if $start_cp eq $CODE_POINT; + $start_cp = hex $start_cp; foreach my $i (0 .. @hex_folds - 1) { - my $cp = hex $hex_folds[$i]; + my $cp = $hex_folds[$i]; + next if $cp eq $CODE_POINT; + $cp = hex $cp; next unless $cp > 255; # Already have the < 256 ones $loc_problem_folds->add_range($cp, $cp); @@ -13978,9 +14198,13 @@ sub compile_perl() { Description => "Code points whose fold is a string of more than one character", ); + if ($v_version lt v3.0.1) { + push @tables_that_may_be_empty, '_Perl_Folds_To_Multi_Char'; + } # Look through all the known folds to populate these tables. foreach my $range ($cf->ranges) { + next if $range->value eq $CODE_POINT; my $start = $range->start; my $end = $range->end; $any_folds->add_range($start, $end); @@ -14190,7 +14414,7 @@ sub compile_perl() { + utf8::unicode_to_native(0xA0) # NBSP ); - my @composition = ('Name', 'Unicode_1_Name', 'Name_Alias'); + my @composition = ('Name', 'Unicode_1_Name', '_Perl_Name_Alias'); if (@named_sequences) { push @composition, 'Named_Sequence'; @@ -14201,15 +14425,15 @@ sub compile_perl() { my $alias_sentence = ""; my %abbreviations; - my $alias = property_ref('Name_Alias'); - $perl_charname->set_proxy_for('Name_Alias'); - - # Add each entry in Name_Alias to Perl_Charnames. Where these go with - # respect to any existing entry depends on the entry type. Corrections go - # before said entry, as they should be returned in preference over the - # existing entry. (A correction to a correction should be later in the - # Name_Alias table, so it will correctly precede the erroneous correction - # in Perl_Charnames.) + my $alias = property_ref('_Perl_Name_Alias'); + $perl_charname->set_proxy_for('_Perl_Name_Alias'); + + # Add each entry in _Perl_Name_Alias to Perl_Charnames. Where these go + # with respect to any existing entry depends on the entry type. + # Corrections go before said entry, as they should be returned in + # preference over the existing entry. (A correction to a correction + # should be later in the _Perl_Name_Alias table, so it will correctly + # precede the erroneous correction in Perl_Charnames.) # # Abbreviations go after everything else, so they are saved temporarily in # a hash for later. @@ -14244,7 +14468,7 @@ sub compile_perl() { $perl_charname->add_duplicate($code_point, $value, Replace => $replace_type); } $alias_sentence = < $before_or_after); } - # But in this version only, the ALERT has precedence over BELL, the - # Unicode_1_Name that would otherwise have precedence. - if ($v_version eq v6.0.0) { - $perl_charname->add_duplicate(7, 'ALERT', Replace => $MULTIPLE_BEFORE); - } - # Now that have everything added, add in abbreviations after # everything else. Sort so results don't change between runs of this # program @@ -14398,6 +14617,25 @@ END $unassigned->set_equivalent_to($age_default, Related => 1); } + my $patws = $perl->add_match_table('_Perl_PatWS', + Perl_Extension => 1, + Fate => $INTERNAL_ONLY); + if (defined (my $off_patws = property_ref('Pattern_White_Space'))) { + $patws->initialize($off_patws->table('Y')); + } + else { + $patws->initialize([ ord("\t"), + ord("\n"), + utf8::unicode_to_native(0x0B), # VT + ord("\f"), + ord("\r"), + ord(" "), + utf8::unicode_to_native(0x85), # NEL + 0x200E..0x200F, # Left, Right marks + 0x2028..0x2029 # Line, Paragraph seps + ] ); + } + # See L my $quotemeta = $perl->add_match_table('_Perl_Quotemeta', Perl_Extension => 1, @@ -14406,22 +14644,78 @@ END # Initialize to what's common in # all Unicode releases. Initialize => - $Space - + $gc->table('Control') + $gc->table('Control') + + $Space + + $patws + + ((~ $Word) & $ASCII) ); - # In early releases without the proper Unicode properties, just set to \W. - if (! defined (my $patsyn = property_ref('Pattern_Syntax')) - || ! defined (my $patws = property_ref('Pattern_White_Space')) - || ! defined (my $di = property_ref('Default_Ignorable_Code_Point'))) - { - $quotemeta += ~ $Word; + if (defined (my $patsyn = property_ref('Pattern_Syntax'))) { + $quotemeta += $patsyn->table('Y'); } else { - $quotemeta += $patsyn->table('Y') - + $patws->table('Y') - + $di->table('Y') - + ((~ $Word) & $ASCII); + $quotemeta += ((~ $Word) & Range->new(0, 255)) + - utf8::unicode_to_native(0xA8) + - utf8::unicode_to_native(0xAF) + - utf8::unicode_to_native(0xB2) + - utf8::unicode_to_native(0xB3) + - utf8::unicode_to_native(0xB4) + - utf8::unicode_to_native(0xB7) + - utf8::unicode_to_native(0xB8) + - utf8::unicode_to_native(0xB9) + - utf8::unicode_to_native(0xBC) + - utf8::unicode_to_native(0xBD) + - utf8::unicode_to_native(0xBE); + $quotemeta += [ # These are above-Latin1 patsyn; hence should be the + # same in all releases + 0x2010 .. 0x2027, + 0x2030 .. 0x203E, + 0x2041 .. 0x2053, + 0x2055 .. 0x205E, + 0x2190 .. 0x245F, + 0x2500 .. 0x2775, + 0x2794 .. 0x2BFF, + 0x2E00 .. 0x2E7F, + 0x3001 .. 0x3003, + 0x3008 .. 0x3020, + 0x3030 .. 0x3030, + 0xFD3E .. 0xFD3F, + 0xFE45 .. 0xFE46 + ]; + } + + if (defined (my $di = property_ref('Default_Ignorable_Code_Point'))) { + $quotemeta += $di->table('Y') + } + else { + if ($v_version ge v2.0) { + $quotemeta += $gc->table('Cf') + + $gc->table('Cs'); + } + $quotemeta += $gc->table('Cc') + - $Space; + my $temp = Range_List->new(Initialize => [ 0x180B .. 0x180D, + 0x2060 .. 0x206F, + 0xFE00 .. 0xFE0F, + 0xFFF0 .. 0xFFFB, + 0xE0000 .. 0xE0FFF, + ]); + $quotemeta += $temp & $Assigned; + } + + my $nchar = $perl->add_match_table('_Perl_Nchar', + Perl_Extension => 1, + Fate => $INTERNAL_ONLY); + if (defined (my $off_nchar = property_ref('Nchar'))) { + $nchar->initialize($off_nchar->table('Y')); + } + else { + $nchar->initialize([ 0xFFFE .. 0xFFFF ]); + if ($v_version ge v2.0) { # First release with these nchars + for (my $i = 0x1FFFE; $i <= 0x10FFFE; $i += 0x10000) { + $nchar += [ $i .. $i+1 ]; + } + } } # Finished creating all the perl properties. All non-internal non-string @@ -14743,14 +15037,15 @@ sub register_file_for_name($$$) { my $file = shift; # The file name in the final directory. Carp::carp_extra_args(\@_) if main::DEBUG && @_; - trace "table=$table, file=$file, directory=@$directory_ref" if main::DEBUG && $to_trace; + trace "table=$table, file=$file, directory=@$directory_ref, fate=", $table->fate if main::DEBUG && $to_trace; if ($table->isa('Property')) { $table->set_file_path(@$directory_ref, $file); push @map_properties, $table; # No swash means don't do the rest of this. - return if $table->fate != $ORDINARY; + return if $table->fate != $ORDINARY + && ! ($table->name =~ /^_/ && $table->fate == $INTERNAL_ONLY); # Get the path to the file my @path = $table->file_path; @@ -14764,7 +15059,12 @@ sub register_file_for_name($$$) { # property's map table foreach my $alias ($table->aliases) { my $name = $alias->name; - $loose_property_to_file_of{standardize($name)} = $file; + if ($name =~ /^_/) { + $strict_property_to_file_of{lc $name} = $file; + } + else { + $loose_property_to_file_of{standardize($name)} = $file; + } } # And a way for utf8_heavy to find the proper key in the SwashInfo @@ -14972,7 +15272,22 @@ sub register_file_for_name($$$) { # Remove interior underscores. (my $filename = $name) =~ s/ (?<=.) _ (?=.) //xg; - # Change any non-word character into an underscore, and truncate to 8. + # Convert the dot in floating point numbers to an underscore + $filename =~ s/\./_/ if $filename =~ / ^ \d+ \. \d+ $ /x; + + my $suffix = ""; + + # Extract any suffix, delete any non-word character, and truncate to 3 + # after the dot + if ($filename =~ m/ ( .*? ) ( \. .* ) /x) { + $filename = $1; + $suffix = $2; + $suffix =~ s/\W+//g; + substr($suffix, 4) = "" if length($suffix) > 4; + } + + # Change any non-word character outside the suffix into an underscore, + # and truncate to 8. $filename =~ s/\W+/_/g; # eg., "L&" -> "L_" substr($filename, 8) = "" if length($filename) > 8; @@ -14984,7 +15299,7 @@ sub register_file_for_name($$$) { # InGreekE # InGreek2 my $warned = 0; - while (my $num = $base_names{$path}{lc $filename}++) { + while (my $num = $base_names{$path}{lc "$filename$suffix"}++) { $num++; # so basenames with numbers start with '2', which # just looks more natural. @@ -15491,9 +15806,9 @@ sub make_ucd_table_pod_entries { $$info_ref .= $full_name; } - # And the full-name entry includes the short name, if different + # And the full-name entry includes the short name, if shorter if ($info_ref == \$full_info - && $standard_short_name ne $standard_full_name) + && length $standard_short_name < length $standard_full_name) { $full_info =~ s/\.\Z//; $full_info .= " " if $full_info; @@ -15517,6 +15832,17 @@ sub make_ucd_table_pod_entries { $full_info .= ". " if $full_info; $full_info .= $more_info; } + if ($table->property->type == $FORCED_BINARY) { + if ($full_info) { + $full_info =~ s/\.\Z//; + $full_info .= ". "; + } + $full_info .= "This is a combination property which has both:" + . " 1) a map to various string values; and" + . " 2) a map to boolean Y/N, where 'Y' means the" + . " string value is non-empty. Add the prefix 'is'" + . " to the prop_invmap() call to get the latter"; + } # These keep track if have created full and short name pod entries for the # property @@ -15548,6 +15874,9 @@ sub make_ucd_table_pod_entries { $info = $other_info; } + $combination_property{$standard} = 1 + if $table->property->type == $FORCED_BINARY; + # Here, we have set up the two columns for this entry. But if an # entry already exists for this name, we have to decide which one # we're going to later output. @@ -15614,9 +15943,9 @@ sub pod_alphanumeric_sort { # The first few character columns are filler, plus the '\p{'; and get rid # of all the trailing stuff, starting with the trailing '}', so as to sort # on just 'Name=Value' - (my $a = lc $a) =~ s/^ .*? { //x; + (my $a = lc $a) =~ s/^ .*? \{ //x; $a =~ s/}.*//; - (my $b = lc $b) =~ s/^ .*? { //x; + (my $b = lc $b) =~ s/^ .*? \{ //x; $b =~ s/}.*//; # Determine if the two operands are both internal only or both not. @@ -15761,6 +16090,7 @@ END # The sort will cause the alphabetically first properties to be added to # each list first, so each list will be sorted. foreach my $property (sort keys %why_suppressed) { + next unless $why_suppressed{$property}; push @{$why_list{$why_suppressed{$property}}}, $property; } @@ -15823,13 +16153,12 @@ END } # Similiarly, generate a list of files that we don't use, grouped by the - # reasons why. First, create a hash whose keys are the reasons, and whose - # values are anonymous arrays of all the files that share that reason. + # reasons why (Don't output if the reason is empty). First, create a hash + # whose keys are the reasons, and whose values are anonymous arrays of all + # the files that share that reason. my %grouped_by_reason; - foreach my $file (keys %ignored_files) { - push @{$grouped_by_reason{$ignored_files{$file}}}, $file; - } foreach my $file (keys %skipped_files) { + next unless $skipped_files{$file}; push @{$grouped_by_reason{$skipped_files{$file}}}, $file; } @@ -16284,6 +16613,10 @@ sub make_Heavy () { = simple_dumper(\%loose_property_name_of, ' ' x 4); chomp $loose_property_name_of; + my $strict_property_name_of + = simple_dumper(\%strict_property_name_of, ' ' x 4); + chomp $strict_property_name_of; + my $stricter_to_file_of = simple_dumper(\%stricter_to_file_of, ' ' x 4); chomp $stricter_to_file_of; @@ -16322,6 +16655,10 @@ sub make_Heavy () { = simple_dumper(\%loose_property_to_file_of, ' ' x 4); chomp $loose_property_to_file_of; + my $strict_property_to_file_of + = simple_dumper(\%strict_property_to_file_of, ' ' x 4); + chomp $strict_property_to_file_of; + my $file_to_swash_name = simple_dumper(\%file_to_swash_name, ' ' x 4); chomp $file_to_swash_name; @@ -16337,6 +16674,11 @@ $INTERNAL_ONLY_HEADER $loose_property_name_of ); +# Same, but strict names +\%utf8::strict_property_name_of = ( +$strict_property_name_of +); + # Gives the definitions (in the form of inversion lists) for those properties # whose definitions aren't kept in files \@utf8::inline_definitions = ( @@ -16385,6 +16727,11 @@ $caseless_equivalent_to $loose_property_to_file_of ); +# Property names to mapping files +\%utf8::strict_property_to_file_of = ( +$strict_property_to_file_of +); + # Files to the swash names within them. \%utf8::file_to_swash_name = ( $file_to_swash_name @@ -16756,8 +17103,8 @@ sub make_UCD () { # an element for the Hangul syllables in the appropriate place, and # otherwise changes the name to include the "-" suffix. my @algorithm_names; - my $done_hangul = 0; - + my $done_hangul = $v_version lt v2.0.0; # Hanguls as we know them came + # along in this version # Copy it linearly. for my $i (0 .. @code_points_ending_in_code_point - 1) { @@ -16808,6 +17155,9 @@ sub make_UCD () { my $ambiguous_names = simple_dumper(\%ambiguous_names, ' ' x 4); chomp $ambiguous_names; + my $combination_property = simple_dumper(\%combination_property, ' ' x 4); + chomp $combination_property; + my $loose_defaults = simple_dumper(\%loose_defaults, ' ' x 4); chomp $loose_defaults; @@ -16872,6 +17222,13 @@ $ambiguous_names $loose_defaults ); +# The properties that are combinations, in that they have both a map table and +# a match table. This is actually for UCD.t, so it knows how to test for +# these. +\%Unicode::UCD::combination_property = ( +$combination_property +); + # All combinations of names that are suppressed. # This is actually for UCD.t, so it knows which properties shouldn't have # entries. If it got any bigger, would probably want to put it in its own @@ -16972,14 +17329,8 @@ sub write_all_tables() { # with it or not. my $expected_empty = - # $perl should be empty, as well as properties that we just - # don't do anything with - ($is_property - && ($table == $perl - || grep { $complete_name eq $_ } - @unimplemented_properties - ) - ) + # $perl should be empty + ($is_property && ($table == $perl)) # Match tables in properties we skipped populating should be # empty @@ -17045,7 +17396,7 @@ sub write_all_tables() { : ($is_property) ? # All these types of map tables will be full because # they will have been populated with defaults - ($type == $ENUM || $type == $FORCED_BINARY) + ($type == $ENUM) : # A match table should match everything if its method # shows it should @@ -17206,12 +17557,14 @@ sub write_all_tables() { } } else { - if (exists ($loose_property_name_of{$alias_standard})) - { - Carp::my_carp("There already is a property with the same standard name as $alias_name: $loose_property_name_of{$alias_standard}. Old name is retained"); + my $hash_ref = ($alias_standard =~ /^_/) + ? \%strict_property_name_of + : \%loose_property_name_of; + if (exists $hash_ref->{$alias_standard}) { + Carp::my_carp("There already is a property with the same standard name as $alias_name: $hash_ref->{$alias_standard}. Old name is retained"); } else { - $loose_property_name_of{$alias_standard} + $hash_ref->{$alias_standard} = $standard_property_name; } @@ -17462,7 +17815,7 @@ sub generate_tests($$$$$) { my @output; # Create a complete set of tests, with complements. if (defined $valid_code) { - push @output, <<"EOC" + push @output, <<"EOC" Expect(1, $valid_code, '\\p{$name}', $warning); Expect(0, $valid_code, '\\p{^$name}', $warning); Expect(0, $valid_code, '\\P{$name}', $warning); @@ -17470,7 +17823,7 @@ Expect(1, $valid_code, '\\P{^$name}', $warning); EOC } if (defined $invalid_code) { - push @output, <<"EOC" + push @output, <<"EOC" Expect(0, $invalid_code, '\\p{$name}', $warning); Expect(1, $invalid_code, '\\p{^$name}', $warning); Expect(1, $invalid_code, '\\P{$name}', $warning); @@ -17708,8 +18061,10 @@ sub make_property_test_script() { # Test each possible combination of the property's aliases with # the table's. If this gets to be too many, could do what is done # in the set_final_comment() for Tables - my @table_aliases = $table->aliases; - my @property_aliases = $table->property->aliases; + my @table_aliases = grep { $_->status ne $INTERNAL_ALIAS } $table->aliases; + next unless @table_aliases; + my @property_aliases = grep { $_->status ne $INTERNAL_ALIAS } $table->property->aliases; + next unless @property_aliases; # Every property can be optionally be prefixed by 'Is_', so test # that those work, by creating such a new alias for each @@ -17941,84 +18296,97 @@ END return; } +# Skip reasons, so will be exact same text and hence the files with each +# reason will get grouped together in perluniprops. +my $Documentation = "Documentation"; +my $Indic_Skip + = "Provisional; for the analysis and processing of Indic scripts"; +my $Validation = "Validation Tests"; +my $Validation_Documentation = "Documentation of validation Tests"; + # This is a list of the input files and how to handle them. The files are # processed in their order in this list. Some reordering is possible if -# desired, but the v0 files should be first, and the extracted before the -# others except DAge.txt (as data in an extracted file can be over-ridden by -# the non-extracted. Some other files depend on data derived from an earlier -# file, like UnicodeData requires data from Jamo, and the case changing and -# folding requires data from Unicode. Mostly, it is safest to order by first -# version releases in (except the Jamo). DAge.txt is read before the -# extracted ones because of the rarely used feature $compare_versions. In the -# unlikely event that there were ever an extracted file that contained the Age -# property information, it would have to go in front of DAge. +# desired, but the PropertyAliases and PropValueAliases files should be first, +# and the extracted before the others except DAge.txt (as data in an extracted +# file can be over-ridden by the non-extracted. Some other files depend on +# data derived from an earlier file, like UnicodeData requires data from Jamo, +# and the case changing and folding requires data from Unicode. Mostly, it is +# safest to order by first version releases in (except the Jamo). DAge.txt is +# read before the extracted ones because of the rarely used feature +# $compare_versions. In the unlikely event that there were ever an extracted +# file that contained the Age property information, it would have to go in +# front of DAge. # # The version strings allow the program to know whether to expect a file or # not, but if a file exists in the directory, it will be processed, even if it # is in a version earlier than expected, so you can copy files from a later # release into an earlier release's directory. my @input_file_objects = ( - Input_file->new('PropertyAliases.txt', v0, + Input_file->new('PropertyAliases.txt', v3.2, Handler => \&process_PropertyAliases, - ), + Early => [ \&substitute_PropertyAliases ], + Required_Even_in_Debug_Skip => 1, + ), Input_file->new(undef, v0, # No file associated with this Progress_Message => 'Finishing property setup', Handler => \&finish_property_setup, - ), - Input_file->new('PropValueAliases.txt', v0, + ), + Input_file->new('PropValueAliases.txt', v3.2, Handler => \&process_PropValueAliases, + Early => [ \&substitute_PropValueAliases ], Has_Missings_Defaults => $NOT_IGNORED, - ), + Required_Even_in_Debug_Skip => 1, + ), Input_file->new('DAge.txt', v3.2.0, Has_Missings_Defaults => $NOT_IGNORED, Property => 'Age' - ), + ), Input_file->new("${EXTRACTED}DGeneralCategory.txt", v3.1.0, Property => 'General_Category', - ), + ), Input_file->new("${EXTRACTED}DCombiningClass.txt", v3.1.0, Property => 'Canonical_Combining_Class', Has_Missings_Defaults => $NOT_IGNORED, - ), + ), Input_file->new("${EXTRACTED}DNumType.txt", v3.1.0, Property => 'Numeric_Type', Has_Missings_Defaults => $NOT_IGNORED, - ), + ), Input_file->new("${EXTRACTED}DEastAsianWidth.txt", v3.1.0, Property => 'East_Asian_Width', Has_Missings_Defaults => $NOT_IGNORED, - ), + ), Input_file->new("${EXTRACTED}DLineBreak.txt", v3.1.0, Property => 'Line_Break', Has_Missings_Defaults => $NOT_IGNORED, - ), + ), Input_file->new("${EXTRACTED}DBidiClass.txt", v3.1.1, Property => 'Bidi_Class', Has_Missings_Defaults => $NOT_IGNORED, - ), + ), Input_file->new("${EXTRACTED}DDecompositionType.txt", v3.1.0, Property => 'Decomposition_Type', Has_Missings_Defaults => $NOT_IGNORED, - ), + ), Input_file->new("${EXTRACTED}DBinaryProperties.txt", v3.1.0), Input_file->new("${EXTRACTED}DNumValues.txt", v3.1.0, Property => 'Numeric_Value', Each_Line_Handler => \&filter_numeric_value_line, Has_Missings_Defaults => $NOT_IGNORED, - ), + ), Input_file->new("${EXTRACTED}DJoinGroup.txt", v3.1.0, Property => 'Joining_Group', Has_Missings_Defaults => $NOT_IGNORED, - ), + ), Input_file->new("${EXTRACTED}DJoinType.txt", v3.1.0, Property => 'Joining_Type', Has_Missings_Defaults => $NOT_IGNORED, - ), + ), Input_file->new('Jamo.txt', v2.0.0, Property => 'Jamo_Short_Name', Each_Line_Handler => \&filter_jamo_line, - ), + ), Input_file->new('UnicodeData.txt', v1.1.5, Pre_Handler => \&setup_UnicodeData, @@ -18053,7 +18421,12 @@ my @input_file_objects = ( \&filter_UnicodeData_line, ], EOF_Handler => \&EOF_UnicodeData, - ), + ), + Input_file->new('CJKXREF.TXT', v1.1.5, + Withdrawn => v2.0.0, + Skip => 'Gives the mapping of CJK code points ' + . 'between Unicode and various other standards', + ), Input_file->new('ArabicShaping.txt', v2.0.0, Each_Line_Handler => ($v_version lt 4.1.0) @@ -18063,29 +18436,46 @@ my @input_file_objects = ( # not used by Perl Properties => [ '', 'Joining_Type', 'Joining_Group' ], Has_Missings_Defaults => $NOT_IGNORED, - ), + ), Input_file->new('Blocks.txt', v2.0.0, Property => 'Block', Has_Missings_Defaults => $NOT_IGNORED, Each_Line_Handler => \&filter_blocks_lines - ), + ), + Input_file->new('Index.txt', v2.0.0, + Skip => 'Alphabetical index of Unicode characters', + ), + Input_file->new('NamesList.txt', v2.0.0, + Skip => 'Annotated list of characters', + ), Input_file->new('PropList.txt', v2.0.0, Each_Line_Handler => (($v_version lt v3.1.0) ? \&filter_old_style_proplist : undef), - ), + ), + Input_file->new('Props.txt', v2.0.0, + Withdrawn => v3.0.0, + Skip => 'A subset of F (which is used instead)', + ), + Input_file->new('ReadMe.txt', v2.0.0, + Skip => $Documentation, + ), Input_file->new('Unihan.txt', v2.0.0, + Withdrawn => v5.2.0, + Construction_Time_Handler => \&construct_unihan, Pre_Handler => \&setup_unihan, - Optional => 1, + Optional => [ "", + 'Unicode_Radical_Stroke' + ], Each_Line_Handler => \&filter_unihan_line, - ), + ), Input_file->new('SpecialCasing.txt', v2.1.8, Each_Line_Handler => ($v_version eq 2.1.8) ? \&filter_2_1_8_special_casing_line : \&filter_special_casing_line, Pre_Handler => \&setup_special_casing, Has_Missings_Defaults => $IGNORED, - ), + ), Input_file->new( 'LineBreak.txt', v3.0.0, Has_Missings_Defaults => $NOT_IGNORED, @@ -18094,7 +18484,7 @@ my @input_file_objects = ( Each_Line_Handler => (($v_version lt v3.1.0) ? \&filter_early_ea_lb : undef), - ), + ), Input_file->new('EastAsianWidth.txt', v3.0.0, Property => 'East_Asian_Width', Has_Missings_Defaults => $NOT_IGNORED, @@ -18102,10 +18492,14 @@ my @input_file_objects = ( Each_Line_Handler => (($v_version lt v3.1.0) ? \&filter_early_ea_lb : undef), - ), + ), Input_file->new('CompositionExclusions.txt', v3.0.0, Property => 'Composition_Exclusion', - ), + ), + Input_file->new('UnicodeData.html', v3.0.0, + Withdrawn => v4.0.1, + Skip => $Documentation, + ), Input_file->new('BidiMirroring.txt', v3.0.1, Property => 'Bidi_Mirroring_Glyph', Has_Missings_Defaults => ($v_version lt v6.2.0) @@ -18114,12 +18508,15 @@ my @input_file_objects = ( # anything to us, we will use the # null string : $IGNORED, - - ), - Input_file->new("NormTest.txt", v3.0.0, - Handler => \&process_NormalizationsTest, - Skip => ($make_norm_test_script) ? 0 : 'Validation Tests', - ), + ), + Input_file->new('NamesList.html', v3.0.0, + Skip => 'Describes the format and contents of ' + . 'F', + ), + Input_file->new('UnicodeCharacterDatabase.html', v3.0.0, + Withdrawn => v5.1, + Skip => $Documentation, + ), Input_file->new('CaseFolding.txt', v3.0.1, Pre_Handler => \&setup_case_folding, Each_Line_Handler => @@ -18129,105 +18526,222 @@ my @input_file_objects = ( \&filter_case_folding_line ], Has_Missings_Defaults => $IGNORED, - ), + ), + Input_file->new("NormTest.txt", v3.0.1, + Handler => \&process_NormalizationsTest, + Skip => ($make_norm_test_script) ? 0 : $Validation, + ), Input_file->new('DCoreProperties.txt', v3.1.0, # 5.2 changed this file Has_Missings_Defaults => (($v_version ge v5.2.0) ? $NOT_IGNORED : $NO_DEFAULTS), - ), + ), + Input_file->new('DProperties.html', v3.1.0, + Withdrawn => v3.2.0, + Skip => $Documentation, + ), + Input_file->new('PropList.html', v3.1.0, + Withdrawn => v5.1, + Skip => $Documentation, + ), Input_file->new('Scripts.txt', v3.1.0, Property => 'Script', + Each_Line_Handler => (($v_version le v4.0.0) + ? \&filter_all_caps_script_names + : undef), Has_Missings_Defaults => $NOT_IGNORED, - ), + ), Input_file->new('DNormalizationProps.txt', v3.1.0, Has_Missings_Defaults => $NOT_IGNORED, Each_Line_Handler => (($v_version lt v4.0.1) ? \&filter_old_style_normalization_lines : undef), - ), - Input_file->new('HangulSyllableType.txt', v0, + ), + Input_file->new('DerivedProperties.html', v3.1.1, + Withdrawn => v5.1, + Skip => $Documentation, + ), + Input_file->new('HangulSyllableType.txt', v4.0, Has_Missings_Defaults => $NOT_IGNORED, - Property => 'Hangul_Syllable_Type', - Pre_Handler => ($v_version lt v4.0.0) - ? \&generate_hst - : undef, - ), + Early => [ \&generate_hst, 'Hangul_Syllable_Type' ], + Property => 'Hangul_Syllable_Type' + ), + Input_file->new('NormalizationCorrections.txt', v3.2.0, + # This documents the cumulative fixes to erroneous + # normalizations in earlier Unicode versions. Its main + # purpose is so that someone running on an earlier + # version can use this file to override what got + # published in that earlier release. It would be easy + # for mktables to handle this file. But all the + # corrections in it should already be in the other files + # for the release it is. To get it to actually mean + # something useful, someone would have to be using an + # earlier Unicode release, and copy it into the directory + # for that release and recomplile. So far there has been + # no demand to do that, so this hasn't been implemented. + Skip => 'Documentation of corrections already ' + . 'incorporated into the Unicode data base', + ), + Input_file->new('StandardizedVariants.html', v3.2.0, + Skip => 'Provides a visual display of the standard ' + . 'variant sequences derived from ' + . 'F.', + # I don't know why the html came earlier than the + # .txt, but both are skipped anyway, so it doesn't + # matter. + ), + Input_file->new('StandardizedVariants.txt', v4.0.0, + Skip => 'Certain glyph variations for character display ' + . 'are standardized. This lists the non-Unihan ' + . 'ones; the Unihan ones are also not used by ' + . 'Perl, and are in a separate Unicode data base ' + . 'L', + ), + Input_file->new('UCD.html', v4.0.0, + Withdrawn => v5.2, + Skip => $Documentation, + ), Input_file->new("$AUXILIARY/WordBreakProperty.txt", v4.1.0, + Early => [ "WBsubst.txt", '_Perl_WB', 'ALetter' ], Property => 'Word_Break', Has_Missings_Defaults => $NOT_IGNORED, - ), - Input_file->new("$AUXILIARY/GraphemeBreakProperty.txt", v0, + ), + Input_file->new("$AUXILIARY/GraphemeBreakProperty.txt", v4.1, + Early => [ \&generate_GCB, '_Perl_GCB' ], Property => 'Grapheme_Cluster_Break', Has_Missings_Defaults => $NOT_IGNORED, - Pre_Handler => ($v_version lt v4.1.0) - ? \&generate_GCB - : undef, - ), + ), Input_file->new("$AUXILIARY/GCBTest.txt", v4.1.0, Handler => \&process_GCB_test, - ), - Input_file->new("$AUXILIARY/LBTest.txt", v4.1.0, - Skip => 'Validation Tests', - ), + ), + Input_file->new("$AUXILIARY/GraphemeBreakTest.html", v4.1.0, + Skip => $Validation_Documentation, + ), Input_file->new("$AUXILIARY/SBTest.txt", v4.1.0, Handler => \&process_SB_test, - ), + ), + Input_file->new("$AUXILIARY/SentenceBreakTest.html", v4.1.0, + Skip => $Validation_Documentation, + ), Input_file->new("$AUXILIARY/WBTest.txt", v4.1.0, Handler => \&process_WB_test, - ), + ), + Input_file->new("$AUXILIARY/WordBreakTest.html", v4.1.0, + Skip => $Validation_Documentation, + ), Input_file->new("$AUXILIARY/SentenceBreakProperty.txt", v4.1.0, Property => 'Sentence_Break', + Early => [ "SBsubst.txt", '_Perl_SB', 'OLetter' ], Has_Missings_Defaults => $NOT_IGNORED, - ), + ), Input_file->new('NamedSequences.txt', v4.1.0, Handler => \&process_NamedSequences - ), - Input_file->new('NameAliases.txt', v0, + ), + Input_file->new('Unihan.html', v4.1.0, + Withdrawn => v5.2, + Skip => $Documentation, + ), + Input_file->new('NameAliases.txt', v5.0, Property => 'Name_Alias', - Pre_Handler => ($v_version le v6.0.0) - ? \&setup_early_name_alias - : undef, Each_Line_Handler => ($v_version le v6.0.0) ? \&filter_early_version_name_alias_line : \&filter_later_version_name_alias_line, - ), + ), + # NameAliases.txt came along in v5.0. The above constructor handles + # this. But until 6.1, it was lacking some information needed by core + # perl. The constructor below handles that. It is either a kludge or + # clever, depending on your point of view. The 'Withdrawn' parameter + # indicates not to use it at all starting in 6.1 (so the above + # constructor applies), and the 'v6.1' parameter indicates to use the + # Early parameter before 6.1. Therefore 'Early" is always used, + # yielding the internal-only property '_Perl_Name_Alias', which it + # gets from a NameAliases.txt from 6.1 or later stored in + # N_Asubst.txt. In combination with the above constructor, + # 'Name_Alias' is publicly accessible starting with v5.0, and the + # better 6.1 version is accessible to perl core in all releases. + Input_file->new("NameAliases.txt", v6.1, + Withdrawn => v6.1, + Early => [ "N_Asubst.txt", '_Perl_Name_Alias', "" ], + Property => 'Name_Alias', + EOF_Handler => \&fixup_early_perl_name_alias, + Each_Line_Handler => + \&filter_later_version_name_alias_line, + ), + Input_file->new('NamedSqProv.txt', v5.0.0, + Skip => 'Named sequences proposed for inclusion in a ' + . 'later version of the Unicode Standard; if you ' + . 'need them now, you can append this file to ' + . 'F and recompile perl', + ), + Input_file->new("$AUXILIARY/LBTest.txt", v5.1.0, + Skip => $Validation, + ), + Input_file->new("$AUXILIARY/LineBreakTest.html", v5.1.0, + Skip => $Validation_Documentation, + ), Input_file->new("BidiTest.txt", v5.2.0, - Skip => 'Validation Tests', - ), + Skip => $Validation, + ), Input_file->new('UnihanIndicesDictionary.txt', v5.2.0, - Optional => 1, + Optional => "", Each_Line_Handler => \&filter_unihan_line, - ), + ), Input_file->new('UnihanDataDictionaryLike.txt', v5.2.0, - Optional => 1, + Optional => "", Each_Line_Handler => \&filter_unihan_line, - ), + ), Input_file->new('UnihanIRGSources.txt', v5.2.0, - Optional => 1, + Optional => [ "", + 'kCompatibilityVariant', + 'kIICore', + 'kIRG_GSource', + 'kIRG_HSource', + 'kIRG_JSource', + 'kIRG_KPSource', + 'kIRG_MSource', + 'kIRG_KSource', + 'kIRG_TSource', + 'kIRG_USource', + 'kIRG_VSource', + ], Pre_Handler => \&setup_unihan, Each_Line_Handler => \&filter_unihan_line, - ), + ), Input_file->new('UnihanNumericValues.txt', v5.2.0, - Optional => 1, + Optional => [ "", + 'kAccountingNumeric', + 'kOtherNumeric', + 'kPrimaryNumeric', + ], Each_Line_Handler => \&filter_unihan_line, - ), + ), Input_file->new('UnihanOtherMappings.txt', v5.2.0, - Optional => 1, + Optional => "", Each_Line_Handler => \&filter_unihan_line, - ), + ), Input_file->new('UnihanRadicalStrokeCounts.txt', v5.2.0, - Optional => 1, + Optional => [ "", + 'Unicode_Radical_Stroke' + ], Each_Line_Handler => \&filter_unihan_line, - ), + ), Input_file->new('UnihanReadings.txt', v5.2.0, - Optional => 1, + Optional => "", Each_Line_Handler => \&filter_unihan_line, - ), + ), Input_file->new('UnihanVariants.txt', v5.2.0, - Optional => 1, + Optional => "", Each_Line_Handler => \&filter_unihan_line, - ), + ), + Input_file->new('CJKRadicals.txt', v5.2.0, + Skip => 'Maps the kRSUnicode property values to ' + . 'corresponding code points', + ), + Input_file->new('EmojiSources.txt', v6.0.0, + Skip => 'Maps certain Unicode code points to their ' + . 'legacy Japanese cell-phone values', + ), Input_file->new('ScriptExtensions.txt', v6.0.0, Property => 'Script_Extensions', Pre_Handler => \&setup_script_extensions, @@ -18235,39 +18749,74 @@ my @input_file_objects = ( Has_Missings_Defaults => (($v_version le v6.0.0) ? $NO_DEFAULTS : $IGNORED), - ), - # The two Indic files are actually available starting in v6.0.0, but their - # property values are missing from PropValueAliases.txt in that release, - # so that further work would have to be done to get them to work properly - # for that release. - Input_file->new('IndicMatraCategory.txt', v6.1.0, + ), + # These two Indic files are actually not usable as-is until 6.1.0, + # because their property values are missing from PropValueAliases.txt + # until that release, so that further work would have to be done to get + # them to work properly, which isn't worth it because of them being + # provisional. + Input_file->new('IndicMatraCategory.txt', v6.0.0, + Withdrawn => v8.0.0, Property => 'Indic_Matra_Category', Has_Missings_Defaults => $NOT_IGNORED, - Skip => "Withdrawn by Unicode while still provisional", - ), - Input_file->new('IndicSyllabicCategory.txt', v6.1.0, + Skip => $Indic_Skip, + ), + Input_file->new('IndicSyllabicCategory.txt', v6.0.0, Property => 'Indic_Syllabic_Category', Has_Missings_Defaults => $NOT_IGNORED, Skip => (($v_version lt v8.0.0) - ? "Provisional; for the analysis and processing of Indic scripts" + ? $Indic_Skip : 0), - ), + ), + Input_file->new('USourceData.txt', v6.2.0, + Skip => 'Documentation of status and cross reference of ' + . 'proposals for encoding by Unicode of Unihan ' + . 'characters', + ), + Input_file->new('USourceGlyphs.pdf', v6.2.0, + Skip => 'Pictures of the characters in F', + ), Input_file->new('BidiBrackets.txt', v6.3.0, - Properties => [ 'Bidi_Paired_Bracket', 'Bidi_Paired_Bracket_Type' ], + Properties => [ 'Bidi_Paired_Bracket', + 'Bidi_Paired_Bracket_Type' + ], Has_Missings_Defaults => $NO_DEFAULTS, - ), + ), Input_file->new("BidiCharacterTest.txt", v6.3.0, - Skip => 'Validation Tests', - ), + Skip => $Validation, + ), Input_file->new('IndicPositionalCategory.txt', v8.0.0, Property => 'Indic_Positional_Category', Has_Missings_Defaults => $NOT_IGNORED, - ), + ), ); # End of all the preliminaries. # Do it... +if (@missing_early_files) { + print simple_fold(join_lines(<rel2abs( - internal_file_to_platform($_)) - } keys %ignored_files; +# that could be inputs to this program File::Find::find({ wanted=>sub { - return unless /\.txt$/i; # Some platforms change the name's case + return unless / \. ( txt | htm l? ) $ /xi; # Some platforms change the + # name's case my $full = lc(File::Spec->rel2abs($_)); - $potential_files{$full} = 1 - if ! grep { $full eq lc($_) } @ignored_files_full_names; + $potential_files{$full} = 1; return; } }, File::Spec->curdir()); @@ -18344,8 +18889,7 @@ else { # The paths are stored with relative names, and with '/' as the # delimiter; convert to absolute on this machine my $full = lc(File::Spec->rel2abs(internal_file_to_platform($input))); - $potential_files{lc $full} = 1 - if ! grep { lc($full) eq lc($_) } @ignored_files_full_names; + $potential_files{lc $full} = 1; } } @@ -18422,7 +18966,7 @@ my @input_files = qw(version Makefile); foreach my $object (@input_file_objects) { my $file = $object->file; next if ! defined $file; # Not all objects have files - next if $object->optional && ! -e $file; + next if defined $object->skip;; push @input_files, $file; } @@ -18444,7 +18988,6 @@ foreach my $in (@input_files) { my ($volume, $directories, $file ) = File::Spec->splitpath($in); $directories =~ s;/$;;; # Can have extraneous trailing '/' my @directories = File::Spec->splitdir($directories); - my $base = $file =~ s/\.txt$//; construct_filename($file, 'mutable', \@directories); } } @@ -18593,6 +19136,16 @@ use warnings; my $Tests = 0; my $Fails = 0; +# loc_tools.pl requires this function to be defined +sub ok($@) { + my ($pass, @msg) = @_; + print "not " unless $pass; + print "ok "; + print ++$Tests; + print " - ", join "", @msg if @msg; + print "\n"; +} + sub Expect($$$$) { my $expected = shift; my $ord = shift; diff --git a/lib/utf8_heavy.pl b/lib/utf8_heavy.pl index 1ba73b2..51137b5 100644 --- a/lib/utf8_heavy.pl +++ b/lib/utf8_heavy.pl @@ -404,7 +404,11 @@ sub _loose_name ($) { # If didn't find it, try again with looser matching by editing # out the applicable characters on the rhs and looking up # again. + my $strict_property_and_table; if (! defined $file) { + + # This isn't used unless the name begins with 'to' + $strict_property_and_table = $property_and_table =~ s/^to//r; $table = _loose_name($table); $property_and_table = "$prefix$table"; print STDERR __LINE__, ": $property_and_table\n" if DEBUG; @@ -443,61 +447,51 @@ sub _loose_name ($) { ## is to use Unicode::UCD. ## # Only check if caller wants non-binary - my $retried = 0; - if ($minbits != 1 && $property_and_table =~ s/^to//) {{ + if ($minbits != 1) { + if ($property_and_table =~ s/^to//) { # Look input up in list of properties for which we have - # mapping files. - if (defined ($file = + # mapping files. First do it with the strict approach + if (defined ($file = $utf8::strict_property_to_file_of{ + $strict_property_and_table})) + { + $type = $utf8::file_to_swash_name{$file}; + print STDERR __LINE__, ": type set to $type\n" + if DEBUG; + $file = "$unicore_dir/$file.pl"; + last GETFILE; + } + elsif (defined ($file = $utf8::loose_property_to_file_of{$property_and_table})) - { - $type = $utf8::file_to_swash_name{$file}; - print STDERR __LINE__, ": type set to $type\n" if DEBUG; - $file = "$unicore_dir/$file.pl"; - last GETFILE; - } # If that fails see if there is a corresponding binary - # property file - elsif (defined ($file = - $utf8::loose_to_file_of{$property_and_table})) - { + { + $type = $utf8::file_to_swash_name{$file}; + print STDERR __LINE__, ": type set to $type\n" + if DEBUG; + $file = "$unicore_dir/$file.pl"; + last GETFILE; + } # If that fails see if there is a corresponding binary + # property file + elsif (defined ($file = + $utf8::loose_to_file_of{$property_and_table})) + { - # Here, there is no map file for the property we are - # trying to get the map of, but this is a binary - # property, and there is a file for it that can easily - # be translated to a mapping. - - # In the case of properties that are forced to binary, - # they are a combination. We return the actual - # mapping instead of the binary. If the input is - # something like 'Tocjkkiicore', it will be found in - # %loose_property_to_file_of above as => 'To/kIICore'. - # But the form like ToIskiicore won't be. To fix - # this, it was easiest to do it here. These - # properties are the complements of the default - # property, so there is an entry in %loose_to_file_of - # that is 'iskiicore' => '!kIICore/N', If we find such - # an entry, strip off things and try again, which - # should find the entry in %loose_property_to_file_of. - # Actual binary properties that are of this form, such - # as this entry: 'ishrkt' => '!Perl/Any' will also be - # retried, but won't be in %loose_property_to_file_of, - # and instead the next time through, it will find - # 'hrkt' => '!Perl/Any' and proceed. - redo if ! $retried - && $file =~ /^!/ - && $property_and_table =~ s/^is//; - - # This is a binary property. Setting this here causes - # it to be stored as such in the cache, so if someone - # comes along later looking for just a binary, they - # get it. - $minbits = 1; - - # The 0+ makes sure is numeric - $invert_it = 0 + $file =~ s/!//; - $file = "$unicore_dir/lib/$file.pl" unless $file =~ m!^#/!; - last GETFILE; + # Here, there is no map file for the property we + # are trying to get the map of, but this is a + # binary property, and there is a file for it that + # can easily be translated to a mapping, so use + # that, treating this as a binary property. + # Setting 'minbits' here causes it to be stored as + # such in the cache, so if someone comes along + # later looking for just a binary, they get it. + $minbits = 1; + + # The 0+ makes sure is numeric + $invert_it = 0 + $file =~ s/!//; + $file = "$unicore_dir/lib/$file.pl" + unless $file =~ m!^#/!; + last GETFILE; + } } - } } + } ## ## If we reach this line, it's because we couldn't figure diff --git a/locale.c b/locale.c index a36e8dc..9b0979d 100644 --- a/locale.c +++ b/locale.c @@ -707,7 +707,6 @@ Perl_init_i18nl10n(pTHX_ int printwarn) } if (!setlocale_failure) { # ifdef USE_LOCALE_CTYPE - Safefree(curctype); if (! (curctype = my_setlocale(LC_CTYPE, (!done && (lang || PerlEnv_getenv("LC_CTYPE"))) @@ -717,7 +716,6 @@ Perl_init_i18nl10n(pTHX_ int printwarn) curctype = savepv(curctype); # endif /* USE_LOCALE_CTYPE */ # ifdef USE_LOCALE_COLLATE - Safefree(curcoll); if (! (curcoll = my_setlocale(LC_COLLATE, (!done && (lang || PerlEnv_getenv("LC_COLLATE"))) @@ -727,7 +725,6 @@ Perl_init_i18nl10n(pTHX_ int printwarn) curcoll = savepv(curcoll); # endif /* USE_LOCALE_COLLATE */ # ifdef USE_LOCALE_NUMERIC - Safefree(curnum); if (! (curnum = my_setlocale(LC_NUMERIC, (!done && (lang || PerlEnv_getenv("LC_NUMERIC"))) diff --git a/makedef.pl b/makedef.pl index 999655c..1fee334 100644 --- a/makedef.pl +++ b/makedef.pl @@ -657,33 +657,13 @@ if ($ARGS{PLATFORM} eq 'netware') { push(@layer_syms,'PL_def_layerlist','PL_known_layers','PL_perlio'); } -if ($define{'USE_PERLIO'}) { - # Export the symbols that make up the PerlIO abstraction, regardless - # of its implementation - read from a file - push @syms, 'perlio.sym'; +# Export the symbols that make up the PerlIO abstraction, regardless +# of its implementation - read from a file +push @syms, 'perlio.sym'; - # PerlIO with layers - export implementation - try_symbols(@layer_syms, 'perlsio_binmode'); -} else { - # -Uuseperlio - # Skip the PerlIO layer symbols - although - # nothing should have exported them anyway. - ++$skip{$_} foreach @layer_syms; - ++$skip{$_} foreach qw( - perlsio_binmode - PL_def_layerlist - PL_known_layers - PL_perlio - PL_perlio_debug_fd - PL_perlio_fd_refcnt - PL_perlio_fd_refcnt_size - PL_perlio_mutex - ); +# PerlIO with layers - export implementation +try_symbols(@layer_syms, 'perlsio_binmode'); - # Also do NOT add abstraction symbols from $perlio_sym - # abstraction is done as #define to stdio - # Remaining remnants that _may_ be functions are handled below. -} unless ($define{'USE_QUADMATH'}) { ++$skip{Perl_quadmath_format_needed}; diff --git a/malloc.c b/malloc.c index 05810b5..69b6b95 100644 --- a/malloc.c +++ b/malloc.c @@ -253,6 +253,10 @@ # define PERL_MAYBE_ALIVE 1 #endif +#ifndef MYMALLOC +# error "MYMALLOC is not defined" +#endif + #ifndef MUTEX_LOCK # define MUTEX_LOCK(l) #endif diff --git a/mathoms.c b/mathoms.c index d659883..7da0068 100644 --- a/mathoms.c +++ b/mathoms.c @@ -1795,7 +1795,7 @@ Perl_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen) /* =for apidoc Am|HV *|pad_compname_type|PADOFFSET po -Looks up the type of the lexical variable at position I in the +Looks up the type of the lexical variable at position C in the currently-compiling pad. If the variable is typed, the stash of the class to which it is typed is returned. If not, C is returned. diff --git a/mg.c b/mg.c index b4a368d..6ec7628 100644 --- a/mg.c +++ b/mg.c @@ -579,7 +579,7 @@ Perl_mg_free(pTHX_ SV *sv) /* =for apidoc Am|void|mg_free_type|SV *sv|int how -Remove any magic of type I from the SV I. See L. +Remove any magic of type C from the SV C. See L. =cut */ diff --git a/mg_names.c b/mg_names.inc similarity index 99% rename from mg_names.c rename to mg_names.inc index 57d52db..fde6872 100644 --- a/mg_names.c +++ b/mg_names.inc @@ -1,6 +1,6 @@ /* -*- buffer-read-only: t -*- * - * mg_names.c + * mg_names.inc * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! * This file is built by regen/mg_vtable.pl. * Any changes made here will be lost! diff --git a/mro_core.c b/mro_core.c index 25d30d9..d134b8a 100644 --- a/mro_core.c +++ b/mro_core.c @@ -1295,7 +1295,7 @@ XS code. 2) Assigning a reference to a readonly scalar constant into a stash entry in order to create -a constant subroutine (like constant.pm +a constant subroutine (like F does). This same method is available from pure perl diff --git a/numeric.c b/numeric.c index be85adb..6aeaf9f 100644 --- a/numeric.c +++ b/numeric.c @@ -107,23 +107,23 @@ Perl_cast_uv(NV f) converts a string representing a binary number to numeric form. -On entry I and I<*len> give the string to scan, I<*flags> gives -conversion flags, and I should be NULL or a pointer to an NV. +On entry C and C<*len> give the string to scan, C<*flags> gives +conversion flags, and C should be NULL or a pointer to an NV. The scan stops at the end of the string, or the first invalid character. -Unless C is set in I<*flags>, encountering an +Unless C is set in C<*flags>, encountering an invalid character will also trigger a warning. -On return I<*len> is set to the length of the scanned string, -and I<*flags> gives output flags. +On return C<*len> is set to the length of the scanned string, +and C<*flags> gives output flags. If the value is <= C it is returned as a UV, the output flags are clear, -and nothing is written to I<*result>. If the value is > UV_MAX C +and nothing is written to C<*result>. If the value is > UV_MAX C returns UV_MAX, sets C in the output flags, -and writes the value to I<*result> (or the value is discarded if I +and writes the value to C<*result> (or the value is discarded if C is NULL). The binary number may optionally be prefixed with "0b" or "b" unless -C is set in I<*flags> on entry. If -C is set in I<*flags> then the binary +C is set in C<*flags> on entry. If +C is set in C<*flags> then the binary number may use '_' characters to separate digits. =cut @@ -230,23 +230,23 @@ Perl_grok_bin(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) converts a string representing a hex number to numeric form. -On entry I and I<*len_p> give the string to scan, I<*flags> gives -conversion flags, and I should be NULL or a pointer to an NV. +On entry C and C<*len_p> give the string to scan, C<*flags> gives +conversion flags, and C should be NULL or a pointer to an NV. The scan stops at the end of the string, or the first invalid character. -Unless C is set in I<*flags>, encountering an +Unless C is set in C<*flags>, encountering an invalid character will also trigger a warning. -On return I<*len> is set to the length of the scanned string, -and I<*flags> gives output flags. +On return C<*len> is set to the length of the scanned string, +and C<*flags> gives output flags. If the value is <= UV_MAX it is returned as a UV, the output flags are clear, -and nothing is written to I<*result>. If the value is > UV_MAX C +and nothing is written to C<*result>. If the value is > UV_MAX C returns UV_MAX, sets C in the output flags, -and writes the value to I<*result> (or the value is discarded if I +and writes the value to C<*result> (or the value is discarded if C is NULL). The hex number may optionally be prefixed with "0x" or "x" unless -C is set in I<*flags> on entry. If -C is set in I<*flags> then the hex +C is set in C<*flags> on entry. If +C is set in C<*flags> then the hex number may use '_' characters to separate digits. =cut @@ -351,21 +351,21 @@ Perl_grok_hex(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result) converts a string representing an octal number to numeric form. -On entry I and I<*len> give the string to scan, I<*flags> gives -conversion flags, and I should be NULL or a pointer to an NV. +On entry C and C<*len> give the string to scan, C<*flags> gives +conversion flags, and C should be NULL or a pointer to an NV. The scan stops at the end of the string, or the first invalid character. -Unless C is set in I<*flags>, encountering an +Unless C is set in C<*flags>, encountering an 8 or 9 will also trigger a warning. -On return I<*len> is set to the length of the scanned string, -and I<*flags> gives output flags. +On return C<*len> is set to the length of the scanned string, +and C<*flags> gives output flags. If the value is <= UV_MAX it is returned as a UV, the output flags are clear, -and nothing is written to I<*result>. If the value is > UV_MAX C +and nothing is written to C<*result>. If the value is > UV_MAX C returns UV_MAX, sets C in the output flags, -and writes the value to I<*result> (or the value is discarded if I +and writes the value to C<*result> (or the value is discarded if C is NULL). -If C is set in I<*flags> then the octal +If C is set in C<*flags> then the octal number may use '_' characters to separate digits. =cut @@ -808,7 +808,7 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send) Recognise (or not) a number. The type of the number is returned (0 if unrecognised), otherwise it is a bit-ORed combination of IS_NUMBER_IN_UV, IS_NUMBER_GREATER_THAN_UV_MAX, IS_NUMBER_NOT_INT, -IS_NUMBER_NEG, IS_NUMBER_INFINITY, IS_NUMBER_NAN (defined in perl.h). +IS_NUMBER_NEG, IS_NUMBER_INFINITY, IS_NUMBER_NAN (defined in F). If the value of the number can fit in a UV, it is returned in the *valuep IS_NUMBER_IN_UV will be set to indicate that *valuep is valid, IS_NUMBER_IN_UV @@ -1610,7 +1610,7 @@ Perl_my_frexpl(long double x, int *e) { Return a non-zero integer if the sign bit on an NV is set, and 0 if it is not. -If Configure detects this system has a signbit() that will work with +If F detects this system has a signbit() that will work with our NVs, then we just use it via the #define in perl.h. Otherwise, fall back on this implementation. The main use of this function is catching -0.0. @@ -1621,7 +1621,7 @@ function or macro that doesn't happen to work with our particular choice of NVs. We shouldn't just re-#define signbit as Perl_signbit and expect the standard system headers to be happy. Also, this is a no-context function (no pTHX_) because Perl_signbit() is usually re-#defined in -perl.h as a simple macro call to the system's signbit(). +F as a simple macro call to the system's signbit(). Users should just always call Perl_signbit(). =cut diff --git a/op.c b/op.c index 9d3d0fa..ff2848a 100644 --- a/op.c +++ b/op.c @@ -1442,7 +1442,7 @@ S_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other) =for apidoc Am|OP *|op_contextualize|OP *o|I32 context Applies a syntactic context to an op tree representing an expression. -I is the op tree, and I must be C, C, +C is the op tree, and C must be C, C, or C to specify the context to apply. The modified op tree is returned. @@ -2584,7 +2584,7 @@ S_finalize_op(pTHX_ OP* o) =for apidoc Amx|OP *|op_lvalue|OP *o|I32 type Propagate lvalue ("modifiable") context to an op and its children. -I represents the context type, roughly based on the type of op that +C represents the context type, roughly based on the type of op that would do the modifying, although C is represented by OP_NULL, because it has no op type of its own (it is signalled by a flag on the lvalue op). @@ -3905,9 +3905,9 @@ Perl_block_start(pTHX_ int full) /* =for apidoc Am|OP *|block_end|I32 floor|OP *seq -Handles compile-time scope exit. I +Handles compile-time scope exit. C is the savestack index returned by -C, and I is the body of the block. Returns the block, +C, and C is the body of the block. Returns the block, possibly modified. =cut @@ -4455,10 +4455,10 @@ S_gen_constant_list(pTHX_ OP *o) =for apidoc Am|OP *|op_append_elem|I32 optype|OP *first|OP *last Append an item to the list of ops contained directly within a list-type -op, returning the lengthened list. I is the list-type op, -and I is the op to append to the list. I specifies the -intended opcode for the list. If I is not already a list of the -right type, it will be upgraded into one. If either I or I +op, returning the lengthened list. C is the list-type op, +and C is the op to append to the list. C specifies the +intended opcode for the list. If C is not already a list of the +right type, it will be upgraded into one. If either C or C is null, the other is returned unchanged. =cut @@ -4488,10 +4488,10 @@ Perl_op_append_elem(pTHX_ I32 type, OP *first, OP *last) =for apidoc Am|OP *|op_append_list|I32 optype|OP *first|OP *last Concatenate the lists of ops contained directly within two list-type ops, -returning the combined list. I and I are the list-type ops -to concatenate. I specifies the intended opcode for the list. -If either I or I is not already a list of the right type, -it will be upgraded into one. If either I or I is null, +returning the combined list. C and C are the list-type ops +to concatenate. C specifies the intended opcode for the list. +If either C or C is not already a list of the right type, +it will be upgraded into one. If either C or C is null, the other is returned unchanged. =cut @@ -4526,10 +4526,10 @@ Perl_op_append_list(pTHX_ I32 type, OP *first, OP *last) =for apidoc Am|OP *|op_prepend_elem|I32 optype|OP *first|OP *last Prepend an item to the list of ops contained directly within a list-type -op, returning the lengthened list. I is the op to prepend to the -list, and I is the list-type op. I specifies the intended -opcode for the list. If I is not already a list of the right type, -it will be upgraded into one. If either I or I is null, +op, returning the lengthened list. C is the op to prepend to the +list, and C is the list-type op. C specifies the intended +opcode for the list. If C is not already a list of the right type, +it will be upgraded into one. If either C or C is null, the other is returned unchanged. =cut @@ -4563,8 +4563,8 @@ Perl_op_prepend_elem(pTHX_ I32 type, OP *first, OP *last) /* =for apidoc Am|OP *|op_convert_list|I32 type|I32 flags|OP *o -Converts I into a list op if it is not one already, and then converts it -into the specified I, calling its check function, allocating a target if +Converts C into a list op if it is not one already, and then converts it +into the specified C, calling its check function, allocating a target if it needs one, and folding constants. A list-type op is usually constructed one kid at a time via C, @@ -4664,9 +4664,9 @@ S_force_list(pTHX_ OP *o, bool nullit) /* =for apidoc Am|OP *|newLISTOP|I32 type|I32 flags|OP *first|OP *last -Constructs, checks, and returns an op of any list type. I is -the opcode. I gives the eight bits of C, except that -C will be set automatically if required. I and I +Constructs, checks, and returns an op of any list type. C is +the opcode. C gives the eight bits of C, except that +C will be set automatically if required. C and C supply up to two ops to be direct children of the list op; they are consumed by this function and become part of the constructed op tree. @@ -4722,7 +4722,7 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) =for apidoc Am|OP *|newOP|I32 type|I32 flags Constructs, checks, and returns an op of any base type (any type that -has no extra fields). I is the opcode. I gives the +has no extra fields). C is the opcode. C gives the eight bits of C, and, shifted up eight bits, the eight bits of C. @@ -4761,11 +4761,11 @@ Perl_newOP(pTHX_ I32 type, I32 flags) /* =for apidoc Am|OP *|newUNOP|I32 type|I32 flags|OP *first -Constructs, checks, and returns an op of any unary type. I is -the opcode. I gives the eight bits of C, except that +Constructs, checks, and returns an op of any unary type. C is +the opcode. C gives the eight bits of C, except that C will be set automatically if required, and, shifted up eight bits, the eight bits of C, except that the bit with value 1 -is automatically set. I supplies an optional op to be the direct +is automatically set. C supplies an optional op to be the direct child of the unary op; it is consumed by this function and become part of the constructed op tree. @@ -4851,10 +4851,10 @@ Perl_newUNOP_AUX(pTHX_ I32 type, I32 flags, OP *first, UNOP_AUX_item *aux) =for apidoc Am|OP *|newMETHOP|I32 type|I32 flags|OP *first Constructs, checks, and returns an op of method type with a method name -evaluated at runtime. I is the opcode. I gives the eight +evaluated at runtime. C is the opcode. C gives the eight bits of C, except that C will be set automatically, and, shifted up eight bits, the eight bits of C, except that -the bit with value 1 is automatically set. I supplies an +the bit with value 1 is automatically set. C supplies an op which evaluates method name; it is consumed by this function and become part of the constructed op tree. Supported optypes: OP_METHOD. @@ -4908,9 +4908,9 @@ Perl_newMETHOP (pTHX_ I32 type, I32 flags, OP* dynamic_meth) { =for apidoc Am|OP *|newMETHOP_named|I32 type|I32 flags|SV *const_meth Constructs, checks, and returns an op of method type with a constant -method name. I is the opcode. I gives the eight bits of +method name. C is the opcode. C gives the eight bits of C, and, shifted up eight bits, the eight bits of -C. I supplies a constant method name; +C. C supplies a constant method name; it must be a shared COW string. Supported optypes: OP_METHOD_NAMED. @@ -4926,11 +4926,11 @@ Perl_newMETHOP_named (pTHX_ I32 type, I32 flags, SV* const_meth) { /* =for apidoc Am|OP *|newBINOP|I32 type|I32 flags|OP *first|OP *last -Constructs, checks, and returns an op of any binary type. I -is the opcode. I gives the eight bits of C, except +Constructs, checks, and returns an op of any binary type. C +is the opcode. C gives the eight bits of C, except that C will be set automatically, and, shifted up eight bits, the eight bits of C, except that the bit with value 1 or -2 is automatically set as required. I and I supply up to +2 is automatically set as required. C and C supply up to two ops to be the direct children of the binary op; they are consumed by this function and become part of the constructed op tree. @@ -5161,7 +5161,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) } } - /* now see which range will peter our first, if either. */ + /* now see which range will peter out first, if either. */ tdiff = tlast - tfirst; rdiff = rlast - rfirst; tcount += tdiff + 1; @@ -5332,7 +5332,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) =for apidoc Am|OP *|newPMOP|I32 type|I32 flags Constructs, checks, and returns an op of any pattern matching type. -I is the opcode. I gives the eight bits of C +C is the opcode. C gives the eight bits of C and, shifted up eight bits, the eight bits of C. =cut @@ -5773,8 +5773,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor) =for apidoc Am|OP *|newSVOP|I32 type|I32 flags|SV *sv Constructs, checks, and returns an op of any type that involves an -embedded SV. I is the opcode. I gives the eight bits -of C. I gives the SV to embed in the op; this function +embedded SV. C is the opcode. C gives the eight bits +of C. C gives the SV to embed in the op; this function takes ownership of one reference to it. =cut @@ -5836,9 +5836,9 @@ Perl_newDEFSVOP(pTHX) =for apidoc Am|OP *|newPADOP|I32 type|I32 flags|SV *sv Constructs, checks, and returns an op of any type that involves a -reference to a pad element. I is the opcode. I gives the +reference to a pad element. C is the opcode. C gives the eight bits of C. A pad slot is automatically allocated, and -is populated with I; this function takes ownership of one reference +is populated with C; this function takes ownership of one reference to it. This function only exists if Perl has been compiled to use ithreads. @@ -5881,8 +5881,8 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv) =for apidoc Am|OP *|newGVOP|I32 type|I32 flags|GV *gv Constructs, checks, and returns an op of any type that involves an -embedded reference to a GV. I is the opcode. I gives the -eight bits of C. I identifies the GV that the op should +embedded reference to a GV. C is the opcode. C gives the +eight bits of C. C identifies the GV that the op should reference; calling this function does not transfer ownership of any reference to it. @@ -5905,8 +5905,8 @@ Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv) =for apidoc Am|OP *|newPVOP|I32 type|I32 flags|char *pv Constructs, checks, and returns an op of any type that involves an -embedded C-level pointer (PV). I is the opcode. I gives -the eight bits of C. I supplies the C-level pointer, which +embedded C-level pointer (PV). C is the opcode. C gives +the eight bits of C. C supplies the C-level pointer, which must have been allocated using C; the memory will be freed when the op is destroyed. @@ -6221,11 +6221,11 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin) =for apidoc Am|OP *|newSLICEOP|I32 flags|OP *subscript|OP *listval -Constructs, checks, and returns an C (list slice) op. I +Constructs, checks, and returns an C (list slice) op. C gives the eight bits of C, except that C will be set automatically, and, shifted up eight bits, the eight bits of C, except that the bit with value 1 or 2 is automatically -set as required. I and I supply the parameters of +set as required. C and C supply the parameters of the slice; they are consumed by this function and become part of the constructed op tree. @@ -6303,149 +6303,23 @@ S_assignment_type(pTHX_ const OP *o) return ret; } -/* - Helper function for newASSIGNOP to detect commonality between the - lhs and the rhs. (It is actually called very indirectly. newASSIGNOP - flags the op and the peephole optimizer calls this helper function - if the flag is set.) Marks all variables with PL_generation. If it - returns TRUE the assignment must be able to handle common variables. - - PL_generation sorcery: - An assignment like ($a,$b) = ($c,$d) is easier than - ($a,$b) = ($c,$a), since there is no need for temporary vars. - To detect whether there are common vars, the global var - PL_generation is incremented for each assign op we compile. - Then, while compiling the assign op, we run through all the - variables on both sides of the assignment, setting a spare slot - in each of them to PL_generation. If any of them already have - that value, we know we've got commonality. Also, if the - generation number is already set to PERL_INT_MAX, then - the variable is involved in aliasing, so we also have - potential commonality in that case. We could use a - single bit marker, but then we'd have to make 2 passes, first - to clear the flag, then to test and set it. And that - wouldn't help with aliasing, either. To find somewhere - to store these values, evil chicanery is done with SvUVX(). -*/ -PERL_STATIC_INLINE bool -S_aassign_common_vars(pTHX_ OP* o) -{ - OP *curop; - for (curop = cUNOPo->op_first; curop; curop = OpSIBLING(curop)) { - if (PL_opargs[curop->op_type] & OA_DANGEROUS) { - if (curop->op_type == OP_GV || curop->op_type == OP_GVSV - || curop->op_type == OP_AELEMFAST) { - GV *gv = cGVOPx_gv(curop); - if (gv == PL_defgv - || (int)GvASSIGN_GENERATION(gv) == PL_generation) - return TRUE; - GvASSIGN_GENERATION_set(gv, PL_generation); - } - else if (curop->op_type == OP_PADSV || - curop->op_type == OP_PADAV || - curop->op_type == OP_PADHV || - curop->op_type == OP_AELEMFAST_LEX || - curop->op_type == OP_PADANY) - { - padcheck: - if (PAD_COMPNAME_GEN(curop->op_targ) - == (STRLEN)PL_generation - || PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX) - return TRUE; - PAD_COMPNAME_GEN_set(curop->op_targ, PL_generation); - - } - else if (curop->op_type == OP_RV2CV) - return TRUE; - else if (curop->op_type == OP_RV2SV || - curop->op_type == OP_RV2AV || - curop->op_type == OP_RV2HV || - curop->op_type == OP_RV2GV) { - if (cUNOPx(curop)->op_first->op_type != OP_GV) /* funny deref? */ - return TRUE; - } - else if (curop->op_type == OP_PUSHRE) { - GV *const gv = -#ifdef USE_ITHREADS - ((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff - ? MUTABLE_GV(PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff)) - : NULL; -#else - ((PMOP*)curop)->op_pmreplrootu.op_pmtargetgv; -#endif - if (gv) { - if (gv == PL_defgv - || (int)GvASSIGN_GENERATION(gv) == PL_generation) - return TRUE; - GvASSIGN_GENERATION_set(gv, PL_generation); - } - else if (curop->op_targ) - goto padcheck; - } - else if (curop->op_type == OP_PADRANGE) - /* Ignore padrange; checking its siblings is sufficient. */ - continue; - else - return TRUE; - } - else if (PL_opargs[curop->op_type] & OA_TARGLEX - && curop->op_private & OPpTARGET_MY) - goto padcheck; - - if (curop->op_flags & OPf_KIDS) { - if (aassign_common_vars(curop)) - return TRUE; - } - } - return FALSE; -} - -/* This variant only handles lexical aliases. It is called when - newASSIGNOP decides that we don’t have any common vars, as lexical ali- - ases trump that decision. */ -PERL_STATIC_INLINE bool -S_aassign_common_vars_aliases_only(pTHX_ OP *o) -{ - OP *curop; - for (curop = cUNOPo->op_first; curop; curop = OpSIBLING(curop)) { - if ((curop->op_type == OP_PADSV || - curop->op_type == OP_PADAV || - curop->op_type == OP_PADHV || - curop->op_type == OP_AELEMFAST_LEX || - curop->op_type == OP_PADANY || - ( PL_opargs[curop->op_type] & OA_TARGLEX - && curop->op_private & OPpTARGET_MY )) - && PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX) - return TRUE; - - if (curop->op_type == OP_PUSHRE && curop->op_targ - && PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX) - return TRUE; - - if (curop->op_flags & OPf_KIDS) { - if (S_aassign_common_vars_aliases_only(aTHX_ curop)) - return TRUE; - } - } - return FALSE; -} /* =for apidoc Am|OP *|newASSIGNOP|I32 flags|OP *left|I32 optype|OP *right -Constructs, checks, and returns an assignment op. I and I +Constructs, checks, and returns an assignment op. C and C supply the parameters of the assignment; they are consumed by this function and become part of the constructed op tree. -If I is C, C, or C, then -a suitable conditional optree is constructed. If I is the opcode +If C is C, C, or C, then +a suitable conditional optree is constructed. If C is the opcode of a binary operator, such as C, then an op is constructed that performs the binary operation and assigns the result to the left argument. -Either way, if I is non-zero then I has no effect. +Either way, if C is non-zero then C has no effect. -If I is zero, then a plain scalar or list assignment is +If C is zero, then a plain scalar or list assignment is constructed. Which type of assignment it is is automatically determined. -I gives the eight bits of C, except that C +C gives the eight bits of C, except that C will be set automatically, and, shifted up eight bits, the eight bits of C, except that the bit with value 1 or 2 is automatically set as required. @@ -6475,7 +6349,6 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) static const char no_list_state[] = "Initialization of state variables" " in list context currently forbidden"; OP *curop; - bool maybe_common_vars = TRUE; if (left->op_type == OP_ASLICE || left->op_type == OP_HSLICE) left->op_private &= ~ OPpSLICEWARNING; @@ -6489,47 +6362,24 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) if (OP_TYPE_IS_OR_WAS(left, OP_LIST)) { OP* lop = ((LISTOP*)left)->op_first; - maybe_common_vars = FALSE; while (lop) { - if (lop->op_type == OP_PADSV || - lop->op_type == OP_PADAV || - lop->op_type == OP_PADHV || - lop->op_type == OP_PADANY) { - if (!(lop->op_private & OPpLVAL_INTRO)) - maybe_common_vars = TRUE; - - if (lop->op_private & OPpPAD_STATE) { - if (left->op_private & OPpLVAL_INTRO) { - /* Each variable in state($a, $b, $c) = ... */ - } - else { - /* Each state variable in - (state $a, my $b, our $c, $d, undef) = ... */ - } - yyerror(no_list_state); - } else { - /* Each my variable in - (state $a, my $b, our $c, $d, undef) = ... */ - } - } else if (lop->op_type == OP_UNDEF || - OP_TYPE_IS_OR_WAS(lop, OP_PUSHMARK)) { - /* undef may be interesting in - (state $a, undef, state $c) */ - } else { - /* Other ops in the list. */ - maybe_common_vars = TRUE; - } + if ((lop->op_type == OP_PADSV || + lop->op_type == OP_PADAV || + lop->op_type == OP_PADHV || + lop->op_type == OP_PADANY) + && (lop->op_private & OPpPAD_STATE) + ) + yyerror(no_list_state); lop = OpSIBLING(lop); } } - else if ((left->op_private & OPpLVAL_INTRO) + else if ( (left->op_private & OPpLVAL_INTRO) + && (left->op_private & OPpPAD_STATE) && ( left->op_type == OP_PADSV || left->op_type == OP_PADAV || left->op_type == OP_PADHV - || left->op_type == OP_PADANY)) - { - if (left->op_type == OP_PADSV) maybe_common_vars = FALSE; - if (left->op_private & OPpPAD_STATE) { + || left->op_type == OP_PADANY) + ) { /* All single variable list context state assignments, hence state ($a) = ... (state $a) = ... @@ -6541,13 +6391,6 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) (state %a) = ... */ yyerror(no_list_state); - } - } - - if (maybe_common_vars) { - /* The peephole optimizer will do the full check and pos- - sibly turn this off. */ - o->op_private |= OPpASSIGN_COMMON; } if (right && right->op_type == OP_SPLIT @@ -6660,13 +6503,13 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) Constructs a state op (COP). The state op is normally a C op, but will be a C op if debugging is enabled for currently-compiled code. The state op is populated from C (or C). -If I