In perl.git, the branch abigail/deprecation has been updated <http://perl5.git.perl.org/perl.git/commitdiff/a9cc9addf6d522d6d8435b2bf2ebe9b2d0e36cec?hp=3dc68c0bb8e5fbd81da6b416938c2d9297f4cb69>
- Log ----------------------------------------------------------------- commit a9cc9addf6d522d6d8435b2bf2ebe9b2d0e36cec Author: Matthew Horsfall <[email protected]> Date: Tue Nov 15 07:41:51 2016 -0500 Report indented here-doc line errors correctly M t/op/heredoc.t M toke.c commit c3656834eee6a619e93dcdde9f12264c822d0fcf Author: Nicolas R <[email protected]> Date: Sun Nov 13 02:16:23 2016 -0700 Cleanup PERL_VERSION checks in .c files This commit is removing code not exercised by blead or any later versions using PERL_VERSION. This is a noop, mainly cleaning code. M regexec.c M universal.c commit 98ed664135674637d081e73c193f2c8e5e289890 Author: Tony Cook <[email protected]> Date: Tue Nov 15 14:42:52 2016 +1100 Revert "Do not try to fchown() to uid -1 and gid -1." This reverts commit c4f643b9fca4c4487ef74e4e6cd5b61a26025698, which fixed a failure introduced by commit f95ba548a286b17c260cc168715a9d0d441b14a6 which was reverted in dd1dbff095629118e73a48a2a6008f03418a07f6. (uid_t)(-1) and (gid_t)(-1) are perfectly valid parameters to chown()/fchown() back to POSIX.1-2001 at least. M t/io/fs.t commit 518818ef951edb69f55bf0b099a3a6a137fff8e1 Author: Tony Cook <[email protected]> Date: Tue Nov 15 10:15:42 2016 +1100 avoid a declaration conflict on El Capitan with recent XCode OS X El Capitan doesn't implement the clock_gettime() or clock_getrez() APIs, but recent versions of XCode, which are released to El Capitan do include updated headers that declare those functions. This causes errors like: HiRes.xs:810:12: error: static declaration of 'clock_gettime' follows non-static declaration static int clock_gettime(clockid_t clock_id, struct timespec *ts) { ^ /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.12.sdk/usr/include/time.h:177:5: note: previous declaration is here int clock_gettime(clockid_t __clock_id, struct timespec *__tp); ^ HiRes.xs:844:12: error: static declaration of 'clock_getres' follows non-static declaration static int clock_getres(clockid_t clock_id, struct timespec *ts) { ^ /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.12.sdk/usr/include/time.h:174:5: note: previous declaration is here int clock_getres(clockid_t __clock_id, struct timespec *__res); ^ 2 errors generated. To avoid that, define the emulation functions with our own name and use a macro to map the standard names to our implemnentations. M dist/Time-HiRes/HiRes.xs commit 8f6424911d4735543fe22f6e1d384a1345c558aa Author: Karl Williamson <[email protected]> Date: Mon Nov 14 22:52:45 2016 +0100 Finish removing POSIX deprecated fcns Commit 47ed9d9e89922a8e165d6dfc5737772cc5ee7a45 removed various deprecated functions, as scheduled in this release, but failed to include everything that should have gotten removed. Spotted by Abigail. M ext/POSIX/lib/POSIX.pm M ext/POSIX/t/export.t M ext/POSIX/t/usage.t M ext/POSIX/t/wrappers.t commit 646d846cc7ecb7655c9b0caabc752e31f16aa415 Author: Dagfinn Ilmari MannsÃ¥ker <[email protected]> Date: Mon Nov 14 20:05:31 2016 +0100 Fix error message for unclosed \N{ in regcomp An unclosed \N{ that made it through to the regex engine rather than being handled by the lexer would erroneously trigger the error for "\N{NAME} must be resolved by the lexer". This separates the check for the missing trailing } and issues the correct error message for this. M regcomp.c M t/re/re_tests commit 92961fd9d2a8734f95412c203c8527f4f3494393 Author: Lukas Mai <[email protected]> Date: Mon Nov 14 15:23:17 2016 +0100 toke.c: remove obsolete comment M toke.c commit d1721ee5de2bde312f93a61a03f4ab807b170dbc Author: Lukas Mai <[email protected]> Date: Mon Nov 14 15:21:55 2016 +0100 op.h: add parens around macro expansion M op.h commit 73288ec07c1967d8a817c3f1749400b60d7d5c60 Author: Aaron Crane <[email protected]> Date: Mon Nov 14 15:24:30 2016 +0100 t/porting/regen.t: be even more helpful when tests fail My code here was wrong; it wasn't reporting anything useful when some dependencies of special regen scripts changed. M t/porting/regen.t commit 30df54161ba5b249dff36ac7a00fd16f94a61971 Author: Dagfinn Ilmari MannsÃ¥ker <[email protected]> Date: Mon Nov 14 15:13:58 2016 +0100 Document that symbols should be removed from metaconfig.h M metaconfig.h commit 4be484e44c755fecd122432856527c16dea4e607 Author: Dagfinn Ilmari MannsÃ¥ker <[email protected]> Date: Mon Nov 14 15:08:03 2016 +0100 Remove all symbols from metaconfig.h Except BOOTSTRAP_CHARSET, which was removed from Configure in commit 1d38f63fe5, they're all used in the code, so metaconfig pulls them in anyway. M metaconfig.h commit 712dbb30586fcc29b47289fc7ad932c80332798c Author: Matthew Horsfall <[email protected]> Date: Mon Nov 14 08:52:36 2016 -0500 Silence deprecation warnings in tests M t/io/utf8.t M t/op/readline.t M t/uni/readline.t commit fb35ab4954fed3d180d94c4a555640406e90f857 Author: Matthew Horsfall <[email protected]> Date: Mon Nov 14 08:41:24 2016 -0500 Fixup Unicode::UCD pod/version and regen dependent files M charclass_invlists.h M lib/Unicode/UCD.pm M regcharclass.h commit e095d3877fe8b131b6ad0e48ee2eacae66de27ab Author: Matthew Horsfall <[email protected]> Date: Mon Nov 14 08:03:33 2016 -0500 Add perldelta for Indented Here-docs M pod/perldelta.pod commit 27dc68f9d2bdc06b09a5b7b161f368a0eae7dc89 Author: Matthew Horsfall <[email protected]> Date: Fri Nov 11 06:35:32 2016 -0500 Document Indented Here-docs M pod/perlop.pod commit 633a0bc8355b4cbc4e408d2058194813b88330d7 Author: Matthew Horsfall <[email protected]> Date: Fri Nov 11 04:58:18 2016 -0500 Add indented here-docs. This adds a new modifier '~' to here-docs that tells the parser that it should look for /^\s*$DELIM\n/ as the closing delimiter. These syntaxes are all supported: <<~EOF; <<~\EOF; <<~'EOF'; <<~"EOF"; <<~`EOF`; <<~ 'EOF'; <<~ "EOF"; <<~ `EOF`; The '~' modifier will strip, from each line in the here-doc, the same whitespace that appears before the delimiter. Newlines will be copied as is, and lines that don't include the proper beginning whitespace will cause perl to croak. Some examples: if (1) { print <<~EOF; Hello there EOF } prints "Hello there\n"; The following: if (1) { print <<~EOF; Hello There EOF } croaks with: Indentation on line 1 of here-doc doesn't match delimiter at - line 2. M pod/perldiag.pod M t/lib/warnings/toke M t/op/exec.t M t/op/heredoc.t M toke.c commit 476ee9f50595cb1072de2c240c9e5cce485778ba Author: David Mitchell <[email protected]> Date: Mon Nov 14 12:44:12 2016 +0000 Remove "Warning: perl appears in your path" This install warning is more or less obsolete, since most platforms already *will* have a /usr/bin/perl or similar provided by the OS. We agreed to remove it in this thread: http://nntp.perl.org/group/perl.perl5.porters/240000 M installperl commit 53961df69d740a4b17661163353cd8ed01a42fd7 Author: David Mitchell <[email protected]> Date: Mon Nov 14 10:49:25 2016 +0000 /t/perf/benchmarks: move expr::index:: to func:: 'index' is a perl function, so it should really be in the 'func' top-level namespace of benchmarks M t/perf/benchmarks commit c678a5c2e5d4df527cd1b85faa0698a580e335e8 Author: H.Merijn Brand <[email protected]> Date: Mon Nov 14 13:15:25 2016 +0100 Additional warning of Name.pl going away M lib/Unicode/UCD.pm commit 932fab3d80bf39b4e6f1638c385e925ca05c4379 Author: H.Merijn Brand <[email protected]> Date: Mon Nov 14 12:37:18 2016 +0100 Unicode::UCD documentation for reading Name.pl as encouraged practice M lib/Unicode/UCD.pm commit a77ee6ad965a872824f6fb20c2cdb24847f75ac4 Author: David Mitchell <[email protected]> Date: Mon Nov 14 10:35:39 2016 +0000 eliminate OPpRUNTIME private PMOP flag This flag was added in 5.004 and even then it didn't seem to be used for anything. It gets set and unset in various places, but is never tested. I'm not even sure what it was intended for. M dump.c M ext/B/t/f_sort.t M ext/B/t/optree_misc.t M ext/B/t/optree_samples.t M lib/B/Op_private.pm M op.c M opcode.h M pp_ctl.c M regen/op_private commit 13f074b09c5267d0df69c951f504979e5573af1e Author: David Mitchell <[email protected]> Date: Mon Nov 14 09:22:09 2016 +0000 clarify what the SVf_AMAGIC means M sv.h commit c8db0cae4c27950a4bf37d2417f1c5fa4f5e35be Author: Dagfinn Ilmari MannsÃ¥ker <[email protected]> Date: Sun Nov 13 15:10:38 2016 +0100 Improve error for missing tie() pacakge/method This brings the error messages in line with the ones used for normal method calls, despite not using call_method(). M pp_sys.c M t/op/tie.t ----------------------------------------------------------------------- Summary of changes: charclass_invlists.h | 2 +- dist/Time-HiRes/HiRes.xs | 15 +- dump.c | 5 +- ext/B/t/f_sort.t | 4 +- ext/B/t/optree_misc.t | 4 +- ext/B/t/optree_samples.t | 4 +- ext/POSIX/lib/POSIX.pm | 7 +- ext/POSIX/t/export.t | 5 +- ext/POSIX/t/usage.t | 2 +- ext/POSIX/t/wrappers.t | 3 - installperl | 43 ------ lib/B/Op_private.pm | 4 - lib/Unicode/UCD.pm | 43 +++++- metaconfig.h | 37 +---- op.c | 5 +- op.h | 2 +- opcode.h | 382 +++++++++++++++++++++++------------------------ pod/perldelta.pod | 32 ++++ pod/perldiag.pod | 20 +++ pod/perlop.pod | 52 +++++++ pp_ctl.c | 1 - pp_sys.c | 21 ++- regcharclass.h | 2 +- regcomp.c | 8 +- regen/op_private | 6 - regexec.c | 7 - sv.h | 7 +- t/io/fs.t | 4 +- t/io/utf8.t | 1 + t/lib/warnings/toke | 9 ++ t/op/exec.t | 6 +- t/op/heredoc.t | 110 +++++++++++++- t/op/readline.t | 2 + t/op/tie.t | 12 +- t/perf/benchmarks | 191 ++++++++++++------------ t/porting/regen.t | 13 +- t/re/re_tests | 5 +- t/uni/readline.t | 11 +- toke.c | 159 +++++++++++++++++--- universal.c | 5 - 40 files changed, 786 insertions(+), 465 deletions(-) diff --git a/charclass_invlists.h b/charclass_invlists.h index 09949e3..3f14119 100644 --- a/charclass_invlists.h +++ b/charclass_invlists.h @@ -91515,7 +91515,7 @@ static const U8 WB_table[24][24] = { #endif /* defined(PERL_IN_REGEXEC_C) */ /* Generated from: - * d4d1ae3d05b9b07d066661a93af8896abe10fbf0f5cbe89575fbbc06a2928d60 lib/Unicode/UCD.pm + * f1951e655fd5fa35478f641663ef164146d743362998b01378327afac5f20270 lib/Unicode/UCD.pm * 47cb62a53beea6d0263e2147331c7e751853c9327225d95bbe2d9e1dc3e1aa44 lib/unicore/ArabicShaping.txt * 153f0a100c315f9f3945e78f57137611d36c44b3a975919c499fd403413fede8 lib/unicore/BidiBrackets.txt * fbe806975c1bf9fc9960bbaa39ff6290c42c7da8315f9cd459109b024cc1c485 lib/unicore/BidiMirroring.txt diff --git a/dist/Time-HiRes/HiRes.xs b/dist/Time-HiRes/HiRes.xs index d0cbff5..a8d26c7 100644 --- a/dist/Time-HiRes/HiRes.xs +++ b/dist/Time-HiRes/HiRes.xs @@ -807,7 +807,7 @@ static int darwin_time_init() { } #ifdef TIME_HIRES_CLOCK_GETTIME_EMULATION -static int clock_gettime(clockid_t clock_id, struct timespec *ts) { +static int th_clock_gettime(clockid_t clock_id, struct timespec *ts) { if (darwin_time_init() && timebase_info.denom) { switch (clock_id) { case CLOCK_REALTIME: @@ -838,10 +838,13 @@ static int clock_gettime(clockid_t clock_id, struct timespec *ts) { SETERRNO(EINVAL, LIB_INVARG); return -1; } + +#define clock_gettime(clock_id, ts) th_clock_gettime((clock_id), (ts)) + #endif /* TIME_HIRES_CLOCK_GETTIME_EMULATION */ #ifdef TIME_HIRES_CLOCK_GETRES_EMULATION -static int clock_getres(clockid_t clock_id, struct timespec *ts) { +static int th_clock_getres(clockid_t clock_id, struct timespec *ts) { if (darwin_time_init() && timebase_info.denom) { switch (clock_id) { case CLOCK_REALTIME: @@ -860,10 +863,12 @@ static int clock_getres(clockid_t clock_id, struct timespec *ts) { SETERRNO(EINVAL, LIB_INVARG); return -1; } + +#define clock_getres(clock_id, ts) th_clock_getres((clock_id), (ts)) #endif /* TIME_HIRES_CLOCK_GETRES_EMULATION */ #ifdef TIME_HIRES_CLOCK_NANOSLEEP_EMULATION -static int clock_nanosleep(clockid_t clock_id, int flags, +static int th_clock_nanosleep(clockid_t clock_id, int flags, const struct timespec *rqtp, struct timespec *rmtp) { if (darwin_time_init()) { @@ -900,6 +905,10 @@ static int clock_nanosleep(clockid_t clock_id, int flags, SETERRNO(EINVAL, LIB_INVARG); return -1; } + +#define clock_nanosleep(clock_id, flags, rqtp, rmtp) \ + th_clock_nanosleep((clock_id), (flags), (rqtp), (rmtp)) + #endif /* TIME_HIRES_CLOCK_NANOSLEEP_EMULATION */ #endif /* PERL_DARWIN */ diff --git a/dump.c b/dump.c index 1c64449..0d3dce5 100644 --- a/dump.c +++ b/dump.c @@ -664,9 +664,8 @@ Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, const PMOP *pm) else ch = '/'; if (PM_GETRE(pm)) - Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%.*s%c%s\n", - ch,(int)RX_PRELEN(PM_GETRE(pm)), RX_PRECOMP(PM_GETRE(pm)), ch, - (pm->op_private & OPpRUNTIME) ? " (RUNTIME)" : ""); + Perl_dump_indent(aTHX_ level, file, "PMf_PRE %c%.*s%c\n", + ch,(int)RX_PRELEN(PM_GETRE(pm)), RX_PRECOMP(PM_GETRE(pm)), ch); else Perl_dump_indent(aTHX_ level, file, "PMf_PRE (RUNTIME)\n"); diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t index eda5a21..fe09278 100644 --- a/ext/B/t/f_sort.t +++ b/ext/B/t/f_sort.t @@ -516,7 +516,7 @@ checkOptree(name => q{Compound sort/map Expression }, # b <;> nextstate(main 608 (eval 34):2) v:{ # c <0> pushmark s # d <#> gvsv[*_] s -# e </> match(/"=(\\d+)"/) l/RTIME +# e </> match(/"=(\\d+)"/) l # f <#> gvsv[*_] s # g <1> uc[t17] sK/1 # h <@> anonlist sK*/1 @@ -546,7 +546,7 @@ EOT_EOT # b <;> nextstate(main 608 (eval 34):2) v:{ # c <0> pushmark s # d <$> gvsv(*_) s -# e </> match(/"=(\\d+)"/) l/RTIME +# e </> match(/"=(\\d+)"/) l # f <$> gvsv(*_) s # g <1> uc[t9] sK/1 # h <@> anonlist sK*/1 diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t index 6505f65..22440ca 100644 --- a/ext/B/t/optree_misc.t +++ b/ext/B/t/optree_misc.t @@ -438,12 +438,12 @@ checkOptree ( name => 'm?x?', # 3 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->3 # 1 <;> nextstate(main 914 optree_misc.t:434) v:>,<,%,{ ->2 -# 2 </> match(/"x"/) /RTIME ->3 +# 2 </> match(/"x"/) ->3 EOT_EOT # 3 <1> leavesub[1 ref] K/REFC,1 ->(end) # - <@> lineseq KP ->3 # 1 <;> nextstate(main 914 optree_misc.t:434) v:>,<,%,{ ->2 -# 2 </> match(/"x"/) /RTIME ->3 +# 2 </> match(/"x"/) ->3 EONT_EONT diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t index 4a509a7..1330a47 100644 --- a/ext/B/t/optree_samples.t +++ b/ext/B/t/optree_samples.t @@ -431,7 +431,7 @@ checkOptree ( name => '@foo = grep(!/^\#/, @bar)', # 5 <1> rv2av[t4] lKM/1 # 6 <@> grepstart lK # 7 <|> grepwhile(other->8)[t5] lK -# 8 </> match(/"^#"/) s/RTIME +# 8 </> match(/"^#"/) s # 9 <1> not sK/1 # goto 7 # a <0> pushmark s @@ -447,7 +447,7 @@ EOT_EOT # 5 <1> rv2av[t2] lKM/1 # 6 <@> grepstart lK # 7 <|> grepwhile(other->8)[t3] lK -# 8 </> match(/"^\\#"/) s/RTIME +# 8 </> match(/"^\\#"/) s # 9 <1> not sK/1 # goto 7 # a <0> pushmark s diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm index dcf028f..76d58c9 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.74'; +our $VERSION = '1.75'; require XSLoader; @@ -164,8 +164,6 @@ my %reimpl = ( strstr => 'big, little => CORE::index($_[0], $_[1])', system => 'command => CORE::system($_[0])', time => 'CORE::time', - tolower => 'string => lc($_[0])', - toupper => 'string => uc($_[0])', umask => 'mask => CORE::umask($_[0])', unlink => 'filename => CORE::unlink($_[0])', utime => 'filename, atime, mtime => CORE::utime($_[1], $_[2], $_[0])', @@ -254,8 +252,7 @@ my %default_export_tags = ( # cf. exports policy below assert_h => [qw(assert NDEBUG)], - ctype_h => [qw(isalnum isalpha iscntrl isdigit isgraph islower - isprint ispunct isspace isupper isxdigit tolower toupper)], + ctype_h => [], dirent_h => [], diff --git a/ext/POSIX/t/export.t b/ext/POSIX/t/export.t index ff852ed..5e07a13 100644 --- a/ext/POSIX/t/export.t +++ b/ext/POSIX/t/export.t @@ -90,8 +90,7 @@ my %expect = ( fgets floor fmod fopen fpathconf fprintf fputc fputs fread free freopen frexp fscanf fseek fsetpos fstat fsync ftell fwrite getchar getcwd getegid getenv geteuid getgid getgroups - getpid gets getuid isalnum isalpha isatty iscntrl isdigit - isgraph islower isprint ispunct isspace isupper isxdigit labs + getpid gets getuid isatty labs ldexp ldiv localeconv log10 longjmp lseek malloc mblen mbstowcs mbtowc memchr memcmp memcpy memmove memset mkfifo mktime modf offsetof pathconf pause perror pow putc putchar @@ -103,7 +102,7 @@ my %expect = ( strncpy strpbrk strrchr strspn strstr strtod strtok strtol strtoul strxfrm sysconf tan tanh tcdrain tcflow tcflush tcgetattr tcgetpgrp tcsendbreak tcsetattr tcsetpgrp tmpfile - tmpnam tolower toupper ttyname tzname tzset uname ungetc + tmpnam ttyname tzname tzset uname ungetc vfprintf vprintf vsprintf wcstombs wctomb ), # this stuff was added in 5.21 diff --git a/ext/POSIX/t/usage.t b/ext/POSIX/t/usage.t index 24e6a7e..4d900e7 100644 --- a/ext/POSIX/t/usage.t +++ b/ext/POSIX/t/usage.t @@ -18,7 +18,7 @@ for my $list ([qw(errno fork getchar getegid geteuid getgid getgroups getlogin [qw(abs alarm assert chdir closedir cos exit exp fabs fstat getc getenv getgrgid getgrnam getpwnam getpwuid gmtime isatty localtime log opendir raise readdir remove rewind rewinddir - rmdir sin sleep sqrt stat strerror system tolower toupper + rmdir sin sleep sqrt stat strerror system umask unlink)], [qw(atan2 chmod creat kill link mkdir pow rename strstr waitpid)], [qw(chown fcntl utime)]) { diff --git a/ext/POSIX/t/wrappers.t b/ext/POSIX/t/wrappers.t index 2be9660..e41b319 100644 --- a/ext/POSIX/t/wrappers.t +++ b/ext/POSIX/t/wrappers.t @@ -162,9 +162,6 @@ SKIP: { cmp_ok($present, '<=', $future, 'time'); } -is(POSIX::tolower('Perl Rules'), 'perl rules', 'tolower'); -is(POSIX::toupper('oi!'), 'OI!', 'toupper'); - is(-e NOT_HERE, undef, NOT_HERE . ' does not exist'); foreach ([undef, 0, 'chdir', NOT_HERE], diff --git a/installperl b/installperl index f4d850b..af61203 100755 --- a/installperl +++ b/installperl @@ -541,49 +541,6 @@ if (!$opts{nopods} && (!$versiononly || ($installprivlib =~ m/\Q$vershort/))) { } -# Check to make sure there aren't other perls around in installer's -# path. This is probably UNIX-specific. Check all absolute directories -# in the path except for where public executables are supposed to live. -# Also skip $mainperl if the user opted to have it be a link to the -# installed perl. - -if (!$versiononly && !$opts{'skip-otherperls'}) { - my ($path, @path); - my $dirsep = ($Is_OS2 || $Is_W32 || $Is_NetWare) ? ';' : ':' ; - ($path = $ENV{"PATH"}) =~ s:\\:/:g ; - @path = split(/$dirsep/, $path); - if ($Is_VMS) { - my $i = 0; - while (exists $ENV{'DCL$PATH' . $i}) { - my $dir = unixpath($ENV{'DCL$PATH' . $i}); $dir =~ s-/$--; - push(@path,$dir); - } - } - my @otherperls; - my %otherperls; - for (@path) { - next unless m,^/,; - # Use &samepath here because some systems have other dirs linked - # to $mainperldir (like SunOS) - next unless -d; - next if samepath($_, $binexp); - next if samepath($_, cwd()); - next if ($mainperl_is_instperl && samepath($_, $mainperldir)); - my $otherperl = "$_/$perl$exe_ext"; - next if $otherperls{$otherperl}++; - push(@otherperls, $otherperl) - if (-x $otherperl && ! -d $otherperl); - } - if (@otherperls) { - warn "\nWarning: $perl appears in your path in the following " . - "locations beyond where\nwe just installed it:\n"; - for (@otherperls) { - warn " ", $_, "\n"; - } - warn "\n"; - } - -} $packlist->write() unless $opts{notify}; print " Installation complete\n" if $opts{verbose}; diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index d6e1435..98eeb68 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -147,7 +147,6 @@ $bits{$_}{6} = 'OPpOUR_INTRO' for qw(enteriter gvsv rv2av rv2hv rv2sv split); $bits{$_}{6} = 'OPpPAD_STATE' for qw(lvavref lvref padav padhv padsv pushmark refassign); $bits{$_}{7} = 'OPpPV_IS_UTF8' for qw(dump goto last next redo); $bits{$_}{6} = 'OPpREFCOUNTED' for qw(leave leaveeval leavesub leavesublv leavewrite); -$bits{$_}{5} = 'OPpRUNTIME' for qw(match qr split subst substcont); $bits{$_}{2} = 'OPpSLICEWARNING' for qw(aslice hslice padav padhv rv2av rv2hv); $bits{$_}{4} = 'OPpTARGET_MY' for qw(abs add atan2 chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtr ... [294 chars truncated] $bits{$_}{5} = 'OPpTRANS_COMPLEMENT' for qw(trans transr); @@ -661,7 +660,6 @@ our %defines = ( OPpREFCOUNTED => 64, OPpREPEAT_DOLIST => 64, OPpREVERSE_INPLACE => 8, - OPpRUNTIME => 32, OPpSLICE => 64, OPpSLICEWARNING => 4, OPpSORT_DESCEND => 16, @@ -756,7 +754,6 @@ our %labels = ( OPpREFCOUNTED => 'REFC', OPpREPEAT_DOLIST => 'DOLIST', OPpREVERSE_INPLACE => 'INPLACE', - OPpRUNTIME => 'RTIME', OPpSLICE => 'SLICE', OPpSLICEWARNING => 'SLICEWARN', OPpSORT_DESCEND => 'DESC', @@ -817,7 +814,6 @@ our %ops_using = ( OPpREFCOUNTED => [qw(leave leaveeval leavesub leavesublv leavewrite)], OPpREPEAT_DOLIST => [qw(repeat)], OPpREVERSE_INPLACE => [qw(reverse)], - OPpRUNTIME => [qw(match qr split subst substcont)], OPpSLICE => [qw(delete)], OPpSLICEWARNING => [qw(aslice hslice padav padhv rv2av rv2hv)], OPpSORT_DESCEND => [qw(sort)], diff --git a/lib/Unicode/UCD.pm b/lib/Unicode/UCD.pm index 990e86f..75b2b80 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.66'; +our $VERSION = '0.67'; require Exporter; @@ -1211,7 +1211,7 @@ sub bidi_types { =head2 B<compexcl()> WARNING: Unicode discourages the use of this function or any of the -alternative mechanisms listed in this section (the documention of +alternative mechanisms listed in this section (the documentation of C<compexcl()>), except internally in implementations of the Unicode Normalization Algorithm. You should be using L<Unicode::Normalize> directly instead of these. Using these will likely lead to half-baked results. @@ -3155,11 +3155,48 @@ return C<undef> if called with one of those. The returned values for the Perl extension properties, such as C<Any> and C<Greek> are somewhat misleading. The values are either C<"Y"> or C<"N>". All Unicode properties are bipartite, so you can actually use the C<"Y"> or -C<"N>" in a Perl regular rexpression for these, like C<qr/\p{ID_Start=Y/}> or +C<"N>" in a Perl regular expression for these, like C<qr/\p{ID_Start=Y/}> or C<qr/\p{Upper=N/}>. But the Perl extensions aren't specified this way, only like C</qr/\p{Any}>, I<etc>. You can't actually use the C<"Y"> and C<"N>" in them. +=head3 Getting every available name + +Instead of reading the Unicode Database directly from files, as you were able +to do for a long time, you are encouraged to use the supplied functions. So, +instead of reading C<Name.pl> - which may disappear without notice in the +future - directly, as with + + my (%name, %cp); + for (split m/\s*\n/ => do "unicore/Name.pl") { + my ($cp, $name) = split m/\t/ => $_; + $cp{$name} = $cp; + $name{$cp} = $name unless $cp =~ m/ /; + } + +You ought to use L</prop_invmap()> like this: + + my (%name, %cp, %cps, $n); + # All codepoints + foreach my $cat (qw( Name Name_Alias )) { + my ($codepoints, $names, $format, $default) = prop_invmap($cat); + # $format => "n", $default => "" + foreach my $i (0 .. @$codepoints - 2) { + my ($cp, $n) = ($codepoints->[$i], $names->[$i]); + # If $n is a ref, the same codepoint has multiple names + foreach my $name (ref $n ? @$n : $n) { + $name{$cp} //= $name; + $cp{$name} //= $cp; + } + } + } + # Named sequences + { my %ns = namedseq(); + foreach my $name (sort { $ns{$a} cmp $ns{$b} } keys %ns) { + $cp{$name} //= [ map { ord } split "" => $ns{$name} ]; + } + } + =cut # User-defined properties could be handled with some changes to utf8_heavy.pl; diff --git a/metaconfig.h b/metaconfig.h index 720c370..f19eee8 100644 --- a/metaconfig.h +++ b/metaconfig.h @@ -10,39 +10,6 @@ * they won't be available unless used. When new symbols are probed * in Configure, this is the way to force them into availability. * - * BOOTSTRAP_CHARSET - * DEFAULT_INC_EXCLUDES_DOT - * DOUBLEKIND - * HAS_ACOSH - * HAS_ASCTIME64 - * HAS_CTIME64 - * HAS_DIFFTIME64 - * HAS_DLADDR - * HAS_FEGETROUND - * HAS_FPCLASSIFY - * HAS_FREELOCALE - * HAS_GAI_STRERROR - * HAS_GMTIME64 - * HAS_ISFINITEL - * HAS_ISINFL - * HAS_ISLESS - * HAS_J0 - * HAS_LOCALTIME64 - * HAS_MEMMEM - * HAS_MKTIME64 - * HAS_NEWLOCALE - * HAS_PRCTL - * HAS_PSEUDOFORK - * HAS_QUERYLOCALE - * HAS_STRERROR_L - * HAS_TIMEGM - * HAS_USELOCALE - * I_XLOCALE - * I16SIZE - * I64SIZE - * I8SIZE - * LOCALTIME_R_NEEDS_TZSET - * LONG_DOUBLEKIND - * U8SIZE - * USE_CBACKTRACE + * Symbols should only be here temporarily. Once they are actually used, + * they should be removed from here. */ diff --git a/op.c b/op.c index 2c03d29..63a73ee 100644 --- a/op.c +++ b/op.c @@ -10556,8 +10556,6 @@ Perl_ck_match(pTHX_ OP *o) PERL_UNUSED_CONTEXT; PERL_ARGS_ASSERT_CK_MATCH; - if (o->op_type == OP_MATCH || o->op_type == OP_QR) - o->op_private |= OPpRUNTIME; return o; } @@ -11192,8 +11190,7 @@ Perl_ck_split(pTHX_ OP *o) op_sibling_splice(kid, cLISTOPx(kid)->op_last, 0, sibs); /* and reattach */ OpTYPE_set(kid, OP_SPLIT); kid->op_flags = (o->op_flags | (kid->op_flags & OPf_KIDS)); - assert(!(kid->op_private & ~OPpRUNTIME)); - kid->op_private = (o->op_private | (kid->op_private & OPpRUNTIME)); + kid->op_private = o->op_private; op_free(o); o = kid; kid = sibs; /* kid is now the string arg of the split */ diff --git a/op.h b/op.h index 47e6265..c0e6386 100644 --- a/op.h +++ b/op.h @@ -153,7 +153,7 @@ Deprecated. Use C<GIMME_V> instead. /* There is no room in op_flags for this one, so it has its own bit- field member (op_folded) instead. The flag is only used to tell op_convert_list to set op_folded. */ -#define OPf_FOLDED 1<<16 +#define OPf_FOLDED (1<<16) /* old names; don't use in new code, but don't break them, either */ #define OPf_LIST OPf_WANT_LIST diff --git a/opcode.h b/opcode.h index 525ddc1..5aec1a8 100644 --- a/opcode.h +++ b/opcode.h @@ -2260,7 +2260,6 @@ END_EXTERN_C #define OPpMAY_RETURN_CONSTANT 0x20 #define OPpMULTIDEREF_DELETE 0x20 #define OPpOPEN_IN_CRLF 0x20 -#define OPpRUNTIME 0x20 #define OPpSORT_QSORT 0x20 #define OPpTRANS_COMPLEMENT 0x20 #define OPpTRUEBOOL 0x20 @@ -2393,7 +2392,6 @@ EXTCONST char PL_op_private_labels[] = { 'R','E','P','L','1','S','T','\0', 'R','E','V','\0', 'R','E','V','E','R','S','E','D','\0', - 'R','T','I','M','E','\0', 'S','H','O','R','T','\0', 'S','L','I','C','E','\0', 'S','L','I','C','E','W','A','R','N','\0', @@ -2428,14 +2426,14 @@ EXTCONST char PL_op_private_labels[] = { EXTCONST I16 PL_op_private_bitfields[] = { 0, 8, -1, 0, 8, -1, - 0, 545, -1, + 0, 539, -1, 0, 8, -1, 0, 8, -1, - 0, 552, -1, - 0, 541, -1, - 1, -1, 0, 518, 1, 33, 2, 283, -1, + 0, 546, -1, + 0, 535, -1, + 1, -1, 0, 512, 1, 33, 2, 283, -1, 4, -1, 1, 164, 2, 171, 3, 178, -1, - 4, -1, 0, 518, 1, 33, 2, 283, 3, 110, -1, + 4, -1, 0, 512, 1, 33, 2, 283, 3, 110, -1, }; @@ -2474,18 +2472,18 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* regcmaybe */ 0, /* regcreset */ 0, /* regcomp */ - 53, /* match */ - 53, /* qr */ - 53, /* subst */ - 54, /* substcont */ - 56, /* trans */ - 56, /* transr */ - 63, /* sassign */ - 66, /* aassign */ + -1, /* match */ + -1, /* qr */ + -1, /* subst */ + 0, /* substcont */ + 53, /* trans */ + 53, /* transr */ + 60, /* sassign */ + 63, /* aassign */ 0, /* chop */ 0, /* schop */ - 71, /* chomp */ - 71, /* schomp */ + 68, /* chomp */ + 68, /* schomp */ 0, /* defined */ 0, /* undef */ 0, /* study */ @@ -2498,22 +2496,22 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* i_postinc */ 0, /* postdec */ 0, /* i_postdec */ - 73, /* pow */ - 73, /* multiply */ - 73, /* i_multiply */ - 73, /* divide */ - 73, /* i_divide */ - 73, /* modulo */ - 73, /* i_modulo */ - 75, /* repeat */ - 73, /* add */ - 73, /* i_add */ - 73, /* subtract */ - 73, /* i_subtract */ - 73, /* concat */ - 77, /* stringify */ - 73, /* left_shift */ - 73, /* right_shift */ + 70, /* pow */ + 70, /* multiply */ + 70, /* i_multiply */ + 70, /* divide */ + 70, /* i_divide */ + 70, /* modulo */ + 70, /* i_modulo */ + 72, /* repeat */ + 70, /* add */ + 70, /* i_add */ + 70, /* subtract */ + 70, /* i_subtract */ + 70, /* concat */ + 74, /* stringify */ + 70, /* left_shift */ + 70, /* right_shift */ 12, /* lt */ 12, /* i_lt */ 12, /* gt */ @@ -2538,9 +2536,9 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 12, /* bit_and */ 12, /* bit_xor */ 12, /* bit_or */ - 73, /* nbit_and */ - 73, /* nbit_xor */ - 73, /* nbit_or */ + 70, /* nbit_and */ + 70, /* nbit_xor */ + 70, /* nbit_or */ 12, /* sbit_and */ 12, /* sbit_xor */ 12, /* sbit_or */ @@ -2548,113 +2546,113 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* i_negate */ 0, /* not */ 0, /* complement */ - 71, /* ncomplement */ - 71, /* scomplement */ + 68, /* ncomplement */ + 68, /* scomplement */ 12, /* smartmatch */ - 77, /* atan2 */ - 71, /* sin */ - 71, /* cos */ - 77, /* rand */ - 77, /* srand */ - 71, /* exp */ - 71, /* log */ - 71, /* sqrt */ - 71, /* int */ - 71, /* hex */ - 71, /* oct */ - 71, /* abs */ - 71, /* length */ - 79, /* substr */ - 82, /* vec */ - 77, /* index */ - 77, /* rindex */ + 74, /* atan2 */ + 68, /* sin */ + 68, /* cos */ + 74, /* rand */ + 74, /* srand */ + 68, /* exp */ + 68, /* log */ + 68, /* sqrt */ + 68, /* int */ + 68, /* hex */ + 68, /* oct */ + 68, /* abs */ + 68, /* length */ + 76, /* substr */ + 79, /* vec */ + 74, /* index */ + 74, /* rindex */ 47, /* sprintf */ 47, /* formline */ - 71, /* ord */ - 71, /* chr */ - 77, /* crypt */ + 68, /* ord */ + 68, /* chr */ + 74, /* crypt */ 0, /* ucfirst */ 0, /* lcfirst */ 0, /* uc */ 0, /* lc */ 0, /* quotemeta */ - 84, /* rv2av */ - 90, /* aelemfast */ - 90, /* aelemfast_lex */ - 91, /* aelem */ - 96, /* aslice */ - 99, /* kvaslice */ + 81, /* rv2av */ + 87, /* aelemfast */ + 87, /* aelemfast_lex */ + 88, /* aelem */ + 93, /* aslice */ + 96, /* kvaslice */ 0, /* aeach */ 0, /* avalues */ 38, /* akeys */ 0, /* each */ 0, /* values */ 38, /* keys */ - 100, /* delete */ - 103, /* exists */ - 105, /* rv2hv */ - 91, /* helem */ - 96, /* hslice */ - 99, /* kvhslice */ - 113, /* multideref */ + 97, /* delete */ + 100, /* exists */ + 102, /* rv2hv */ + 88, /* helem */ + 93, /* hslice */ + 96, /* kvhslice */ + 110, /* multideref */ 47, /* unpack */ 47, /* pack */ - 120, /* split */ + 117, /* split */ 47, /* join */ - 126, /* list */ + 122, /* list */ 12, /* lslice */ 47, /* anonlist */ 47, /* anonhash */ 47, /* splice */ - 77, /* push */ + 74, /* push */ 0, /* pop */ 0, /* shift */ - 77, /* unshift */ - 128, /* sort */ - 135, /* reverse */ + 74, /* unshift */ + 124, /* sort */ + 131, /* reverse */ 0, /* grepstart */ 0, /* grepwhile */ 0, /* mapstart */ 0, /* mapwhile */ 0, /* range */ - 137, /* flip */ - 137, /* flop */ + 133, /* flip */ + 133, /* flop */ 0, /* and */ 0, /* or */ 12, /* xor */ 0, /* dor */ - 139, /* cond_expr */ + 135, /* cond_expr */ 0, /* andassign */ 0, /* orassign */ 0, /* dorassign */ 0, /* method */ - 141, /* entersub */ - 148, /* leavesub */ - 148, /* leavesublv */ + 137, /* entersub */ + 144, /* leavesub */ + 144, /* leavesublv */ 0, /* argcheck */ - 150, /* argelem */ + 146, /* argelem */ 0, /* argdefelem */ - 152, /* caller */ + 148, /* caller */ 47, /* warn */ 47, /* die */ 47, /* reset */ -1, /* lineseq */ - 154, /* nextstate */ - 154, /* dbstate */ + 150, /* nextstate */ + 150, /* dbstate */ -1, /* unstack */ -1, /* enter */ - 155, /* leave */ + 151, /* leave */ -1, /* scope */ - 157, /* enteriter */ - 161, /* iter */ + 153, /* enteriter */ + 157, /* iter */ -1, /* enterloop */ - 162, /* leaveloop */ + 158, /* leaveloop */ -1, /* return */ - 164, /* last */ - 164, /* next */ - 164, /* redo */ - 164, /* dump */ - 164, /* goto */ + 160, /* last */ + 160, /* next */ + 160, /* redo */ + 160, /* dump */ + 160, /* goto */ 47, /* exit */ 0, /* method_named */ 0, /* method_super */ @@ -2666,7 +2664,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* leavewhen */ -1, /* break */ -1, /* continue */ - 166, /* open */ + 162, /* open */ 47, /* close */ 47, /* pipe_op */ 47, /* fileno */ @@ -2682,7 +2680,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 47, /* getc */ 47, /* read */ 47, /* enterwrite */ - 148, /* leavewrite */ + 144, /* leavewrite */ -1, /* prtf */ -1, /* print */ -1, /* say */ @@ -2696,7 +2694,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 47, /* truncate */ 47, /* fcntl */ 47, /* ioctl */ - 77, /* flock */ + 74, /* flock */ 47, /* send */ 47, /* recv */ 47, /* socket */ @@ -2712,45 +2710,45 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* getpeername */ 0, /* lstat */ 0, /* stat */ - 171, /* ftrread */ - 171, /* ftrwrite */ - 171, /* ftrexec */ - 171, /* fteread */ - 171, /* ftewrite */ - 171, /* fteexec */ - 176, /* ftis */ - 176, /* ftsize */ - 176, /* ftmtime */ - 176, /* ftatime */ - 176, /* ftctime */ - 176, /* ftrowned */ - 176, /* fteowned */ - 176, /* ftzero */ - 176, /* ftsock */ - 176, /* ftchr */ - 176, /* ftblk */ - 176, /* ftfile */ - 176, /* ftdir */ - 176, /* ftpipe */ - 176, /* ftsuid */ - 176, /* ftsgid */ - 176, /* ftsvtx */ - 176, /* ftlink */ - 176, /* fttty */ - 176, /* fttext */ - 176, /* ftbinary */ - 77, /* chdir */ - 77, /* chown */ - 71, /* chroot */ - 77, /* unlink */ - 77, /* chmod */ - 77, /* utime */ - 77, /* rename */ - 77, /* link */ - 77, /* symlink */ + 167, /* ftrread */ + 167, /* ftrwrite */ + 167, /* ftrexec */ + 167, /* fteread */ + 167, /* ftewrite */ + 167, /* fteexec */ + 172, /* ftis */ + 172, /* ftsize */ + 172, /* ftmtime */ + 172, /* ftatime */ + 172, /* ftctime */ + 172, /* ftrowned */ + 172, /* fteowned */ + 172, /* ftzero */ + 172, /* ftsock */ + 172, /* ftchr */ + 172, /* ftblk */ + 172, /* ftfile */ + 172, /* ftdir */ + 172, /* ftpipe */ + 172, /* ftsuid */ + 172, /* ftsgid */ + 172, /* ftsvtx */ + 172, /* ftlink */ + 172, /* fttty */ + 172, /* fttext */ + 172, /* ftbinary */ + 74, /* chdir */ + 74, /* chown */ + 68, /* chroot */ + 74, /* unlink */ + 74, /* chmod */ + 74, /* utime */ + 74, /* rename */ + 74, /* link */ + 74, /* symlink */ 0, /* readlink */ - 77, /* mkdir */ - 71, /* rmdir */ + 74, /* mkdir */ + 68, /* rmdir */ 47, /* open_dir */ 0, /* readdir */ 0, /* telldir */ @@ -2758,22 +2756,22 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* rewinddir */ 0, /* closedir */ -1, /* fork */ - 180, /* wait */ - 77, /* waitpid */ - 77, /* system */ - 77, /* exec */ - 77, /* kill */ - 180, /* getppid */ - 77, /* getpgrp */ - 77, /* setpgrp */ - 77, /* getpriority */ - 77, /* setpriority */ - 180, /* time */ + 176, /* wait */ + 74, /* waitpid */ + 74, /* system */ + 74, /* exec */ + 74, /* kill */ + 176, /* getppid */ + 74, /* getpgrp */ + 74, /* setpgrp */ + 74, /* getpriority */ + 74, /* setpriority */ + 176, /* time */ -1, /* tms */ 0, /* localtime */ 47, /* gmtime */ 0, /* alarm */ - 77, /* sleep */ + 74, /* sleep */ 47, /* shmget */ 47, /* shmctl */ 47, /* shmread */ @@ -2788,8 +2786,8 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* require */ 0, /* dofile */ -1, /* hintseval */ - 181, /* entereval */ - 148, /* leaveeval */ + 177, /* entereval */ + 144, /* leaveeval */ 0, /* entertry */ -1, /* leavetry */ 0, /* ghbyname */ @@ -2827,18 +2825,18 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* lock */ 0, /* once */ -1, /* custom */ - 187, /* coreargs */ - 191, /* avhvswitch */ + 183, /* coreargs */ + 187, /* avhvswitch */ 3, /* runcv */ 0, /* fc */ -1, /* padcv */ -1, /* introcv */ -1, /* clonecv */ - 193, /* padrange */ - 195, /* refassign */ - 201, /* lvref */ - 207, /* lvrefslice */ - 208, /* lvavref */ + 189, /* padrange */ + 191, /* refassign */ + 197, /* lvref */ + 203, /* lvrefslice */ + 204, /* lvavref */ 0, /* anonconst */ }; @@ -2858,49 +2856,47 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { */ EXTCONST U16 PL_op_private_bitdefs[] = { - 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i ... [643 chars truncated] - 0x2cbc, 0x3eb9, /* pushmark */ + 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, substcont, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, ... [654 chars truncated] + 0x2cbc, 0x3df9, /* pushmark */ 0x00bd, /* wantarray, runcv */ - 0x0498, 0x18d0, 0x3f6c, 0x3a28, 0x3085, /* const */ + 0x0498, 0x18d0, 0x3eac, 0x3968, 0x3085, /* const */ 0x2cbc, 0x31d9, /* gvsv */ 0x1735, /* gv */ 0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, ... [14 chars truncated] - 0x2cbc, 0x3eb8, 0x03d7, /* padsv */ - 0x2cbc, 0x3eb8, 0x2dac, 0x3ba9, /* padav */ - 0x2cbc, 0x3eb8, 0x0614, 0x06b0, 0x2dac, 0x3ba9, /* padhv */ - 0x2cbc, 0x1ab8, 0x03d6, 0x2dac, 0x2fa8, 0x3f64, 0x0003, /* rv2gv */ - 0x2cbc, 0x31d8, 0x03d6, 0x3f64, 0x0003, /* rv2sv */ + 0x2cbc, 0x3df8, 0x03d7, /* padsv */ + 0x2cbc, 0x3df8, 0x2dac, 0x3ae9, /* padav */ + 0x2cbc, 0x3df8, 0x0614, 0x06b0, 0x2dac, 0x3ae9, /* padhv */ + 0x2cbc, 0x1ab8, 0x03d6, 0x2dac, 0x2fa8, 0x3ea4, 0x0003, /* rv2gv */ + 0x2cbc, 0x31d8, 0x03d6, 0x3ea4, 0x0003, /* rv2sv */ 0x2dac, 0x0003, /* av2arylen, pos, akeys, keys */ - 0x2f1c, 0x0ef8, 0x0c54, 0x028c, 0x4128, 0x3f64, 0x0003, /* rv2cv */ + 0x2f1c, 0x0ef8, 0x0c54, 0x028c, 0x4068, 0x3ea4, 0x0003, /* rv2cv */ 0x018f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, rea ... [363 chars truncated] 0x33bc, 0x32d8, 0x2714, 0x2650, 0x0003, /* backtick */ - 0x3975, /* match, qr, subst */ - 0x3974, 0x0003, /* substcont */ - 0x0ffc, 0x2038, 0x0834, 0x3cec, 0x23c8, 0x01e4, 0x0141, /* trans, transr */ + 0x0ffc, 0x2038, 0x0834, 0x3c2c, 0x23c8, 0x01e4, 0x0141, /* trans, transr */ 0x0e3c, 0x0538, 0x0067, /* sassign */ 0x0af8, 0x09f4, 0x08f0, 0x2dac, 0x0067, /* aassign */ - 0x41d0, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, length, ord, chr, chroot, rmdir */ - 0x41d0, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift, nbit_and, nbit_xor, nbit_or */ + 0x4110, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, length, ord, chr, chroot, rmdir */ + 0x4110, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift, nbit_and, nbit_xor, nbit_or */ 0x13b8, 0x0067, /* repeat */ - 0x41d0, 0x018f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgr ... [46 chars truncated] + 0x4110, 0x018f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgr ... [46 chars truncated] 0x36d0, 0x2dac, 0x012b, /* substr */ 0x2dac, 0x0067, /* vec */ - 0x2cbc, 0x31d8, 0x2dac, 0x3ba8, 0x3f64, 0x0003, /* rv2av */ + 0x2cbc, 0x31d8, 0x2dac, 0x3ae8, 0x3ea4, 0x0003, /* rv2av */ 0x025f, /* aelemfast, aelemfast_lex */ 0x2cbc, 0x2bb8, 0x03d6, 0x2dac, 0x0067, /* aelem, helem */ - 0x2cbc, 0x2dac, 0x3ba9, /* aslice, hslice */ + 0x2cbc, 0x2dac, 0x3ae9, /* aslice, hslice */ 0x2dad, /* kvaslice, kvhslice */ - 0x2cbc, 0x3af8, 0x0003, /* delete */ - 0x4058, 0x0003, /* exists */ - 0x2cbc, 0x31d8, 0x0614, 0x06b0, 0x2dac, 0x3ba8, 0x3f64, 0x0003, /* rv2hv */ - 0x2cbc, 0x2bb8, 0x1074, 0x19d0, 0x2dac, 0x3f64, 0x0003, /* multideref */ - 0x2cbc, 0x31d8, 0x3974, 0x0350, 0x29cc, 0x2489, /* split */ + 0x2cbc, 0x3a38, 0x0003, /* delete */ + 0x3f98, 0x0003, /* exists */ + 0x2cbc, 0x31d8, 0x0614, 0x06b0, 0x2dac, 0x3ae8, 0x3ea4, 0x0003, /* rv2hv */ + 0x2cbc, 0x2bb8, 0x1074, 0x19d0, 0x2dac, 0x3ea4, 0x0003, /* multideref */ + 0x2cbc, 0x31d8, 0x0350, 0x29cc, 0x2489, /* split */ 0x2cbc, 0x20f9, /* list */ - 0x3dd8, 0x3474, 0x1310, 0x27ac, 0x37c8, 0x28a4, 0x3141, /* sort */ + 0x3d18, 0x3474, 0x1310, 0x27ac, 0x37c8, 0x28a4, 0x3141, /* sort */ 0x27ac, 0x0003, /* reverse */ 0x2a58, 0x0003, /* flip, flop */ 0x2cbc, 0x0003, /* cond_expr */ - 0x2cbc, 0x0ef8, 0x03d6, 0x028c, 0x4128, 0x3f64, 0x2561, /* entersub */ + 0x2cbc, 0x0ef8, 0x03d6, 0x028c, 0x4068, 0x3ea4, 0x2561, /* entersub */ 0x3538, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */ 0x02aa, 0x0003, /* argelem */ 0x00bc, 0x018f, /* caller */ @@ -2909,19 +2905,19 @@ EXTCONST U16 PL_op_private_bitdefs[] = { 0x2cbc, 0x31d8, 0x0f6c, 0x3845, /* enteriter */ 0x3845, /* iter */ 0x2b5c, 0x0067, /* leaveloop */ - 0x433c, 0x0003, /* last, next, redo, dump, goto */ + 0x427c, 0x0003, /* last, next, redo, dump, goto */ 0x33bc, 0x32d8, 0x2714, 0x2650, 0x018f, /* open */ 0x1c70, 0x1ecc, 0x1d88, 0x1b44, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */ 0x1c70, 0x1ecc, 0x1d88, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ... [12 chars truncated] - 0x41d1, /* wait, getppid, time */ - 0x35d4, 0x0d10, 0x076c, 0x42a8, 0x21e4, 0x0003, /* entereval */ + 0x4111, /* wait, getppid, time */ + 0x35d4, 0x0d10, 0x076c, 0x41e8, 0x21e4, 0x0003, /* entereval */ 0x2e7c, 0x0018, 0x1224, 0x1141, /* coreargs */ 0x2dac, 0x00c7, /* avhvswitch */ 0x2cbc, 0x01fb, /* padrange */ - 0x2cbc, 0x3eb8, 0x04f6, 0x292c, 0x1828, 0x0067, /* refassign */ - 0x2cbc, 0x3eb8, 0x04f6, 0x292c, 0x1828, 0x0003, /* lvref */ + 0x2cbc, 0x3df8, 0x04f6, 0x292c, 0x1828, 0x0067, /* refassign */ + 0x2cbc, 0x3df8, 0x04f6, 0x292c, 0x1828, 0x0003, /* lvref */ 0x2cbd, /* lvrefslice */ - 0x2cbc, 0x3eb8, 0x0003, /* lvavref */ + 0x2cbc, 0x3df8, 0x0003, /* lvavref */ }; @@ -2960,10 +2956,10 @@ EXTCONST U8 PL_op_private_valid[] = { /* REGCMAYBE */ (OPpARG1_MASK), /* REGCRESET */ (OPpARG1_MASK), /* REGCOMP */ (OPpARG1_MASK), - /* MATCH */ (OPpRUNTIME), - /* QR */ (OPpRUNTIME), - /* SUBST */ (OPpRUNTIME), - /* SUBSTCONT */ (OPpARG1_MASK|OPpRUNTIME), + /* MATCH */ (0), + /* QR */ (0), + /* SUBST */ (0), + /* SUBSTCONT */ (OPpARG1_MASK), /* TRANS */ (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL|OPpTRANS_SQUASH|OPpTRANS_COMPLEMENT|OPpTRANS_GROWS|OPpTRANS_DELETE), /* TRANSR */ (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL|OPpTRANS_SQUASH|OPpTRANS_COMPLEMENT|OPpTRANS_GROWS|OPpTRANS_DELETE), /* SASSIGN */ (OPpARG2_MASK|OPpASSIGN_BACKWARDS|OPpASSIGN_CV_TO_GV), @@ -3085,7 +3081,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* MULTIDEREF */ (OPpARG1_MASK|OPpHINT_STRICT_REFS|OPpMAYBE_LVSUB|OPpMULTIDEREF_EXISTS|OPpMULTIDEREF_DELETE|OPpLVAL_DEFER|OPpLVAL_INTRO), /* UNPACK */ (OPpARG4_MASK), /* PACK */ (OPpARG4_MASK), - /* SPLIT */ (OPpSPLIT_IMPLIM|OPpSPLIT_LEX|OPpSPLIT_ASSIGN|OPpRUNTIME|OPpOUR_INTRO|OPpLVAL_INTRO), + /* SPLIT */ (OPpSPLIT_IMPLIM|OPpSPLIT_LEX|OPpSPLIT_ASSIGN|OPpOUR_INTRO|OPpLVAL_INTRO), /* JOIN */ (OPpARG4_MASK), /* LIST */ (OPpLIST_GUESSED|OPpLVAL_INTRO), /* LSLICE */ (OPpARG2_MASK), diff --git a/pod/perldelta.pod b/pod/perldelta.pod index d686561..4c15c0a 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -27,6 +27,38 @@ here, but most should go in the L</Performance Enhancements> section. [ List each enhancement as a =head2 entry ] +=head2 Indented Here-documents + +This adds a new modifier '~' to here-docs that tells the parser +that it should look for /^\s*$DELIM\n/ as the closing delimiter. + +These syntaxes are all supported: + + <<~EOF; + <<~\EOF; + <<~'EOF'; + <<~"EOF"; + <<~`EOF`; + <<~ 'EOF'; + <<~ "EOF"; + <<~ `EOF`; + +The '~' modifier will strip, from each line in the here-doc, the +same whitespace that appears before the delimiter. + +Newlines will be copied as is, and lines that don't include the +proper beginning whitespace will cause perl to croak. + +For example: + + if (1) { + print <<~EOF; + Hello there + EOF + } + +prints "Hello there\n" with no leading whitespace. + =head1 Security XXX Any security-related notices go here. In particular, any security diff --git a/pod/perldiag.pod b/pod/perldiag.pod index bbe9287..fb4d3dc 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2744,6 +2744,26 @@ parent '%s' C3-consistent, and you have enabled the C3 MRO for this class. See the C3 documentation in L<mro> for more information. +=item Indentation on line %d of here-doc doesn't match delimiter + +(F) You have an indented here-document where one or more of its lines +have whitespace at the beginning that does not match the closing +delimiter. + +For example, line 2 below is wrong because it does not have at least +2 spaces, but lines 1 and 3 are fine because they have at least 2: + + if ($something) { + print <<~EOF; + Line 1 + Line 2 not + Line 3 + EOF + } + +Note that tabs and spaces are compared strictly, meaning 1 tab will +not match 8 spaces. + =item Infinite recursion in regex (F) You used a pattern that references itself without consuming any input diff --git a/pod/perlop.pod b/pod/perlop.pod index 75f266c..8fefc4e 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -2511,6 +2511,9 @@ syntax. Following a C<< << >> you specify a string to terminate the quoted material, and all lines following the current line down to the terminating string are the value of the item. +Prefixing the terminating string with a C<~> specifies that you +want to use L</Indented Here-docs> (see below). + The terminating string may be either an identifier (a word), or some quoted text. An unquoted identifier works like double quotes. There may not be a space between the C<< << >> and the identifier, @@ -2574,6 +2577,55 @@ the results of the execution returned. =back +=over 4 + +=item Indented Here-docs + +The here-doc modifier C<~> allows you to indent your here-docs to make +the code more readable: + + if ($some_var) { + print <<~EOF; + This is a here-doc + EOF + } + +This will print... + + This is a here-doc + +...with no leading whitespace. + +The delimiter is used to determine the B<exact> whitespace to +remove from the beginning of each line. All lines B<must> have +at least the same starting whitespace (except lines only +containing a newline) or perl will croak. Tabs and spaces can +be mixed, but are matched exactly. One tab will not be equal to +8 spaces! + +Additional beginning whitespace (beyond what preceded the +delimiter) will be preserved: + + print <<~EOF; + This text is not indented + This text is indented with two spaces + This text is indented with two tabs + EOF + +Finally, the modifier may be used with all of the forms +mentioned above: + + <<~\EOF; + <<~'EOF' + <<~"EOF" + <<~`EOF` + +And whitespace may be used between the C<~> and quoted delimiters: + + <<~ 'EOF'; # ... "EOF", `EOF` + +=back + It is possible to stack multiple here-docs in a row: print <<"foo", <<"bar"; # you can stack them diff --git a/pp_ctl.c b/pp_ctl.c index f7dd946..847a100 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -178,7 +178,6 @@ PP(pp_regcomp) /* can't change the optree at runtime either */ /* PMf_KEEP is handled differently under threads to avoid these problems */ if (pm->op_pmflags & PMf_KEEP) { - pm->op_private &= ~OPpRUNTIME; /* no point compiling again */ cLOGOP->op_first->op_next = PL_op->op_next; } #endif diff --git a/pp_sys.c b/pp_sys.c index b7e5f61..1e1b459 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -952,10 +952,23 @@ PP(pp_tie) * (Sorry obfuscation writers. You're not going to be given this one.) */ stash = gv_stashsv(*MARK, 0); - if (!stash || !(gv = gv_fetchmethod(stash, methname))) { - DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"", - methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no)); - } + if (!stash) { + SV *stashname = SvOK(*MARK) ? *MARK : &PL_sv_no; + if (!SvCUR(*MARK)) { + stashname = sv_2mortal(newSVpvs("main")); + } + DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"" + " (perhaps you forgot to load \"%"SVf"\"?)", + methname, SVfARG(stashname), SVfARG(stashname)); + } + else if (!(gv = gv_fetchmethod(stash, methname))) { + /* The effective name can only be NULL for stashes that have + * been deleted from the symbol table, which this one can't + * be, since we just looked it up by name. + */ + DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"HEKf"\"", + methname, HvENAME_HEK_NN(stash)); + } ENTER_with_name("call_TIE"); PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); diff --git a/regcharclass.h b/regcharclass.h index 907fb4e..8f50913 100644 --- a/regcharclass.h +++ b/regcharclass.h @@ -1830,7 +1830,7 @@ #endif /* H_REGCHARCLASS */ /* Generated from: - * d4d1ae3d05b9b07d066661a93af8896abe10fbf0f5cbe89575fbbc06a2928d60 lib/Unicode/UCD.pm + * f1951e655fd5fa35478f641663ef164146d743362998b01378327afac5f20270 lib/Unicode/UCD.pm * 47cb62a53beea6d0263e2147331c7e751853c9327225d95bbe2d9e1dc3e1aa44 lib/unicore/ArabicShaping.txt * 153f0a100c315f9f3945e78f57137611d36c44b3a975919c499fd403413fede8 lib/unicore/BidiBrackets.txt * fbe806975c1bf9fc9960bbaa39ff6290c42c7da8315f9cd459109b024cc1c485 lib/unicore/BidiMirroring.txt diff --git a/regcomp.c b/regcomp.c index ac66432..332cf00 100644 --- a/regcomp.c +++ b/regcomp.c @@ -12005,13 +12005,15 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, RExC_parse++; /* Skip past the '{' */ - if (! (endbrace = strchr(RExC_parse, '}')) /* no trailing brace */ - || ! (endbrace == RExC_parse /* nothing between the {} */ + if (! (endbrace = strchr(RExC_parse, '}'))) { /* no trailing brace */ + vFAIL2("Missing right brace on \\%c{}", 'N'); + } + else if(!(endbrace == RExC_parse /* nothing between the {} */ || (endbrace - RExC_parse >= 2 /* U+ (bad hex is checked... */ && strnEQ(RExC_parse, "U+", 2)))) /* ... below for a better error msg) */ { - if (endbrace) RExC_parse = endbrace; /* position msg's '<--HERE' */ + RExC_parse = endbrace; /* position msg's '<--HERE' */ vFAIL("\\N{NAME} must be resolved by the lexer"); } diff --git a/regen/op_private b/regen/op_private index d459d47..5a8e714 100644 --- a/regen/op_private +++ b/regen/op_private @@ -396,12 +396,6 @@ addbits($_, 7 => qw(OPpLVALUE LV)) for qw(leave leaveloop); -# Pattern coming in on the stack -addbits($_, 5 => qw(OPpRUNTIME RTIME)) - for qw(match subst substcont qr split); - - - # autovivify: Want ref to something for (qw(rv2gv rv2sv padsv aelem helem entersub)) { addbits($_, '4..5' => { diff --git a/regexec.c b/regexec.c index 6c5ce9f..c54c159 100644 --- a/regexec.c +++ b/regexec.c @@ -3694,9 +3694,6 @@ Perl_re_exec_indentf(pTHX_ const char *fmt, U32 depth, ...) STATIC regmatch_state * S_push_slab(pTHX) { -#if PERL_VERSION < 9 && !defined(PERL_CORE) - dMY_CXT; -#endif regmatch_slab *s = PL_regmatch_slab->next; if (!s) { Newx(s, 1, regmatch_slab); @@ -5328,10 +5325,6 @@ S_backup_one_WB(pTHX_ WB_enum * previous, const U8 * const strbeg, U8 ** curpos, STATIC SSize_t S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) { - -#if PERL_VERSION < 9 && !defined(PERL_CORE) - dMY_CXT; -#endif dVAR; const bool utf8_target = reginfo->is_utf8_target; const U32 uniflags = UTF8_ALLOW_DEFAULT; diff --git a/sv.h b/sv.h index a9aca37..7808b89 100644 --- a/sv.h +++ b/sv.h @@ -413,7 +413,12 @@ perform the upgrade if necessary. See C<L</svtype>>. #define PRIVSHIFT 4 /* (SVp_?OK >> PRIVSHIFT) == SVf_?OK */ -/* Note that SVf_AMAGIC is now only set on stashes. */ +/* SVf_AMAGIC means that the stash *may* have have overload methods. It's + * set each time a function is compiled into a stash, and is reset by the + * overload code when called for the first time and finds that there are + * no overload methods. Note that this used to be set on the object; but + * is now only set on stashes. + */ #define SVf_AMAGIC 0x10000000 /* has magical overloaded methods */ #define SVf_IsCOW 0x10000000 /* copy on write (shared hash key if SvLEN == 0) */ diff --git a/t/io/fs.t b/t/io/fs.t index 5ed2053..b6754d6 100644 --- a/t/io/fs.t +++ b/t/io/fs.t @@ -211,14 +211,14 @@ SKIP: { SKIP: { skip "no fchown", 3 unless ($Config{d_fchown} || "") eq "define"; open(my $fh, "<", "a"); - is(chown($<, $(, $fh), 1, "fchown"); + is(chown(-1, -1, $fh), 1, "fchown"); # [perl #122703] # chown() behaved correctly, but there was no test for the chown() # on closed handle case close $fh; $! = 0; - ok(!chown($<, $(, $fh), "chown on closed handle fails"); + ok(!chown(-1, -1, $fh), "chown on closed handle fails"); isnt($!+0, 0, "and errno was set"); } diff --git a/t/io/utf8.t b/t/io/utf8.t index 3909dc8..2b70059 100644 --- a/t/io/utf8.t +++ b/t/io/utf8.t @@ -313,6 +313,7 @@ is($failed, undef); # [perl #23428] Somethings rotten in unicode semantics open F, ">$a_file"; binmode F, ":utf8"; + no warnings qw(deprecated); syswrite(F, $a = chr(0x100)); close F; is( ord($a), 0x100, '23428 syswrite should not downgrade scalar' ); diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index c182b80..279d33b 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -150,6 +150,15 @@ EXPECT Use of bare << to mean <<"" is deprecated at - line 2. ######## # toke.c +$a = <<~; + +$a = <<~ ; + +EXPECT +Use of bare << to mean <<"" is deprecated at - line 2. +Use of bare << to mean <<"" is deprecated at - line 4. +######## +# toke.c $a =~ m/$foo/eq; $a =~ s/$foo/fool/seq; diff --git a/t/op/exec.t b/t/op/exec.t index 886c323..1155439 100644 --- a/t/op/exec.t +++ b/t/op/exec.t @@ -36,7 +36,7 @@ $ENV{LANGUAGE} = 'C'; # Ditto in GNU. my $Is_VMS = $^O eq 'VMS'; my $Is_Win32 = $^O eq 'MSWin32'; -plan(tests => 24); +plan(tests => 25); my $Perl = which_perl(); @@ -123,6 +123,10 @@ is( <<`END`, "ok\n", '<<`HEREDOC`' ); $Perl -le "print 'ok'" END +is( <<~`END`, "ok\n", '<<~`HEREDOC`' ); + $Perl -le "print 'ok'" + END + { local $_ = qq($Perl -le "print 'ok'"); is( readpipe, "ok\n", 'readpipe default argument' ); diff --git a/t/op/heredoc.t b/t/op/heredoc.t index 13d1074..e4aa8a5 100644 --- a/t/op/heredoc.t +++ b/t/op/heredoc.t @@ -7,8 +7,7 @@ BEGIN { } use strict; -plan(tests => 43); - +plan(tests => 137); # heredoc without newline (#65838) { @@ -124,5 +123,112 @@ HEREDOC {}, "delimcpy(): handle last char being backslash properly" ); +} + + +# indented here-docs +{ + my $string = 'some data'; + + my %delimiters = ( + q{EOF} => "EOF", + q{'EOF'} => "EOF", + q{"EOF"} => "EOF", + q{\EOF} => "EOF", + q{' EOF'} => " EOF", + q{'EOF '} => "EOF ", + q{' EOF '} => " EOF ", + q{" EOF"} => " EOF", + q{"EOF "} => "EOF ", + q{" EOF "} => " EOF ", + q{''} => "", + q{""} => "", + ); + my @modifiers = ("~", "~ "); + + my @script_ends = ("", "\n"); + + my @tests; + + for my $start_delim (sort keys %delimiters) { + my $end_delim = $delimiters{$start_delim}; + + for my $modifier (@modifiers) { + # For now, "<<~ EOF" and "<<~ \EOF" aren't allowed + next if $modifier =~ /\s/ && $start_delim !~ /('|")/n; + + for my $script_end (@script_ends) { + # Normal heredoc + my $test = "print <<$modifier$start_delim\n $string\n" + . " $end_delim$script_end"; + unshift @tests, [ + $test, + $string, + "Indented here-doc: $test", + ]; + + # Eval'd heredoc + my $safe_start_delim = $start_delim =~ s/'/\\'/gr; + my $eval = " + \$_ = ''; + eval 's//<<$modifier$safe_start_delim.\"\"/e; print + $string + $end_delim$script_end' + or die \$\@ + "; + push @tests, [ + $eval, + $string, + "Eval'd Indented here-doc: $eval", + ]; + } + } + } + + push @tests, [ + "print <<~EOF;\n\t \t$string\n\t \tEOF\n", + $string, + "indented here-doc with tabs and spaces", + ]; + + push @tests, [ + "print <<~EOF;\n\t \tx EOF\n\t \t$string\n\t \tEOF\n", + "x EOF\n$string", + "Embedded delimiter ignored", + ]; + + push @tests, [ + "print <<~EOF;\n\t \t$string\n\t \tTEOF", + "Can't find string terminator \"EOF\" anywhere before EOF at - line 1.", + "indented here-doc missing terminator error is correct" + ]; + + push @tests, [ + "print <<~EOF;\n $string\n$string\n $string\n $string\n EOF", + "Indentation on line 1 of here-doc doesn't match delimiter at - line 1.\n", + "indented here-doc with bad indentation" + ]; + + push @tests, [ + "print <<~EOF;\n $string\n $string\n$string\n $string\n EOF", + "Indentation on line 3 of here-doc doesn't match delimiter at - line 1.\n", + "indented here-doc with bad indentation" + ]; + + # If our delim is " EOF ", make sure other spaced version don't match + push @tests, [ + "print <<~' EOF ';\n $string\n EOF\nEOF \n EOF \n EOF \n", + " $string\n EOF\nEOF \n EOF \n", + "intented here-doc matches final delimiter correctly" + ]; + + for my $test (@tests) { + fresh_perl_is( + $test->[0], + $test->[1], + { switches => ['-w'], stderr => 1 }, + $test->[2], + ); + } } diff --git a/t/op/readline.t b/t/op/readline.t index bfe90d5..2ee1534 100644 --- a/t/op/readline.t +++ b/t/op/readline.t @@ -214,6 +214,7 @@ SKIP: { pipe $in, $out; binmode $out, ':utf8'; binmode $in, ':utf8'; + no warnings qw(deprecated); syswrite $out, "...\n"; $line .= readline $in; @@ -226,6 +227,7 @@ SKIP: { pipe $in, $out; binmode $out, ':utf8'; binmode $in, ':utf8'; + no warnings qw(deprecated); syswrite $out, "\x{2080}...\n"; $line .= readline $in; diff --git a/t/op/tie.t b/t/op/tie.t index cbae110..e5e7d30 100644 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -930,7 +930,17 @@ sub IO::File::TIEARRAY { } fileno FOO; tie @a, "FOO" EXPECT -Can't locate object method "TIEARRAY" via package "FOO" at - line 5. +Can't locate object method "TIEARRAY" via package "FOO" (perhaps you forgot to load "FOO"?) at - line 5. +######## +# tie into empty package name +tie $foo, ""; +EXPECT +Can't locate object method "TIESCALAR" via package "main" at - line 2. +######## +# tie into undef package name +tie $foo, undef; +EXPECT +Can't locate object method "TIESCALAR" via package "main" at - line 2. ######## # # STORE freeing tie'd AV diff --git a/t/perf/benchmarks b/t/perf/benchmarks index a06921a..5726c98 100644 --- a/t/perf/benchmarks +++ b/t/perf/benchmarks @@ -303,101 +303,6 @@ }, - # using a const string as second arg to index triggers using FBM. - # the FBM matcher special-cases 1,2-byte strings. - # - 'expr::index::short_const1' => { - desc => 'index of a short string against a 1 char const substr', - setup => 'my $x = "aaaab"', - code => 'index $x, "b"', - }, - 'expr::index::long_const1' => { - desc => 'index of a long string against a 1 char const substr', - setup => 'my $x = "a" x 1000 . "b"', - code => 'index $x, "b"', - }, - 'expr::index::short_const2aabc_bc' => { - desc => 'index of a short string against a 2 char const substr', - setup => 'my $x = "aaaabc"', - code => 'index $x, "bc"', - }, - 'expr::index::long_const2aabc_bc' => { - desc => 'index of a long string against a 2 char const substr', - setup => 'my $x = "a" x 1000 . "bc"', - code => 'index $x, "bc"', - }, - 'expr::index::long_const2aa_ab' => { - desc => 'index of a long string aaa.. against const substr "ab"', - setup => 'my $x = "a" x 1000', - code => 'index $x, "ab"', - }, - 'expr::index::long_const2bb_ab' => { - desc => 'index of a long string bbb.. against const substr "ab"', - setup => 'my $x = "b" x 1000', - code => 'index $x, "ab"', - }, - 'expr::index::long_const2aa_bb' => { - desc => 'index of a long string aaa.. against const substr "bb"', - setup => 'my $x = "a" x 1000', - code => 'index $x, "bb"', - }, - # this one is designed to be pathological - 'expr::index::long_const2ab_aa' => { - desc => 'index of a long string abab.. against const substr "aa"', - setup => 'my $x = "ab" x 500', - code => 'index $x, "aa"', - }, - # near misses with gaps, 1st letter - 'expr::index::long_const2aaxx_xy' => { - desc => 'index of a long string with "xx"s against const substr "xy"', - setup => 'my $x = "aaaaaaaaxx" x 100', - code => 'index $x, "xy"', - }, - # near misses with gaps, 2nd letter - 'expr::index::long_const2aayy_xy' => { - desc => 'index of a long string with "yy"s against const substr "xy"', - setup => 'my $x = "aaaaaaaayy" x 100', - code => 'index $x, "xy"', - }, - # near misses with gaps, duplicate letter - 'expr::index::long_const2aaxy_xx' => { - desc => 'index of a long string with "xy"s against const substr "xx"', - setup => 'my $x = "aaaaaaaaxy" x 100', - code => 'index $x, "xx"', - }, - # alternating near misses with gaps - 'expr::index::long_const2aaxxaayy_xy' => { - desc => 'index of a long string with "xx/yy"s against const substr "xy"', - setup => 'my $x = "aaaaaaaaxxbbbbbbbbyy" x 50', - code => 'index $x, "xy"', - }, - 'expr::index::short_const3aabcd_bcd' => { - desc => 'index of a short string against a 3 char const substr', - setup => 'my $x = "aaaabcd"', - code => 'index $x, "bcd"', - }, - 'expr::index::long_const3aabcd_bcd' => { - desc => 'index of a long string against a 3 char const substr', - setup => 'my $x = "a" x 1000 . "bcd"', - code => 'index $x, "bcd"', - }, - 'expr::index::long_const3ab_abc' => { - desc => 'index of a long string of "ab"s against a 3 char const substr "abc"', - setup => 'my $x = "ab" x 500', - code => 'index $x, "abc"', - }, - 'expr::index::long_const3bc_abc' => { - desc => 'index of a long string of "bc"s against a 3 char const substr "abc"', - setup => 'my $x = "bc" x 500', - code => 'index $x, "abc"', - }, - 'expr::index::utf8_position_1' => { - desc => 'index of a utf8 string, matching at position 1', - setup => 'my $x = "abc". chr(0x100); chop $x', - code => 'index $x, "b"', - }, - - # list assign, OP_AASSIGN @@ -985,6 +890,102 @@ + # using a const string as second arg to index triggers using FBM. + # the FBM matcher special-cases 1,2-byte strings. + # + 'func::index::short_const1' => { + desc => 'index of a short string against a 1 char const substr', + setup => 'my $x = "aaaab"', + code => 'index $x, "b"', + }, + 'func::index::long_const1' => { + desc => 'index of a long string against a 1 char const substr', + setup => 'my $x = "a" x 1000 . "b"', + code => 'index $x, "b"', + }, + 'func::index::short_const2aabc_bc' => { + desc => 'index of a short string against a 2 char const substr', + setup => 'my $x = "aaaabc"', + code => 'index $x, "bc"', + }, + 'func::index::long_const2aabc_bc' => { + desc => 'index of a long string against a 2 char const substr', + setup => 'my $x = "a" x 1000 . "bc"', + code => 'index $x, "bc"', + }, + 'func::index::long_const2aa_ab' => { + desc => 'index of a long string aaa.. against const substr "ab"', + setup => 'my $x = "a" x 1000', + code => 'index $x, "ab"', + }, + 'func::index::long_const2bb_ab' => { + desc => 'index of a long string bbb.. against const substr "ab"', + setup => 'my $x = "b" x 1000', + code => 'index $x, "ab"', + }, + 'func::index::long_const2aa_bb' => { + desc => 'index of a long string aaa.. against const substr "bb"', + setup => 'my $x = "a" x 1000', + code => 'index $x, "bb"', + }, + # this one is designed to be pathological + 'func::index::long_const2ab_aa' => { + desc => 'index of a long string abab.. against const substr "aa"', + setup => 'my $x = "ab" x 500', + code => 'index $x, "aa"', + }, + # near misses with gaps, 1st letter + 'func::index::long_const2aaxx_xy' => { + desc => 'index of a long string with "xx"s against const substr "xy"', + setup => 'my $x = "aaaaaaaaxx" x 100', + code => 'index $x, "xy"', + }, + # near misses with gaps, 2nd letter + 'func::index::long_const2aayy_xy' => { + desc => 'index of a long string with "yy"s against const substr "xy"', + setup => 'my $x = "aaaaaaaayy" x 100', + code => 'index $x, "xy"', + }, + # near misses with gaps, duplicate letter + 'func::index::long_const2aaxy_xx' => { + desc => 'index of a long string with "xy"s against const substr "xx"', + setup => 'my $x = "aaaaaaaaxy" x 100', + code => 'index $x, "xx"', + }, + # alternating near misses with gaps + 'func::index::long_const2aaxxaayy_xy' => { + desc => 'index of a long string with "xx/yy"s against const substr "xy"', + setup => 'my $x = "aaaaaaaaxxbbbbbbbbyy" x 50', + code => 'index $x, "xy"', + }, + 'func::index::short_const3aabcd_bcd' => { + desc => 'index of a short string against a 3 char const substr', + setup => 'my $x = "aaaabcd"', + code => 'index $x, "bcd"', + }, + 'func::index::long_const3aabcd_bcd' => { + desc => 'index of a long string against a 3 char const substr', + setup => 'my $x = "a" x 1000 . "bcd"', + code => 'index $x, "bcd"', + }, + 'func::index::long_const3ab_abc' => { + desc => 'index of a long string of "ab"s against a 3 char const substr "abc"', + setup => 'my $x = "ab" x 500', + code => 'index $x, "abc"', + }, + 'func::index::long_const3bc_abc' => { + desc => 'index of a long string of "bc"s against a 3 char const substr "abc"', + setup => 'my $x = "bc" x 500', + code => 'index $x, "abc"', + }, + 'func::index::utf8_position_1' => { + desc => 'index of a utf8 string, matching at position 1', + setup => 'my $x = "abc". chr(0x100); chop $x', + code => 'index $x, "b"', + }, + + + 'func::sort::num' => { desc => 'plain numeric sort', setup => 'my (@a, @b); @a = reverse 1..10;', diff --git a/t/porting/regen.t b/t/porting/regen.t index a3944ca..f296626 100644 --- a/t/porting/regen.t +++ b/t/porting/regen.t @@ -42,6 +42,12 @@ my %other_requirement = ( "regen/regcharclass.pl" => "needs the Perl you've just built", ); +my %skippable_script_for_target; +for my $script (keys %other_requirement) { + $skippable_script_for_target{$_} = $script + for @{ $skip{$script} }; +} + my @files = map {@$_} sort values %skip; open my $fh, '<', 'regen.pl' @@ -90,9 +96,10 @@ OUTER: foreach my $file (@files) { push @bad, $2 unless $digest eq $1; } is("@bad", '', "generated $file is up to date"); - for (@bad) { - my $reason = delete $other_requirement{$_} || next; - diag("Note: $_ must be run manually, because it $reason"); + if (@bad && (my $skippable_script = $skippable_script_for_target{$file})) { + my $reason = delete $other_requirement{$skippable_script}; + diag("Note: $skippable_script must be run manually, because it $reason") + if $reason; } } diff --git a/t/re/re_tests b/t/re/re_tests index 046beaa..1797ddc 100644 --- a/t/re/re_tests +++ b/t/re/re_tests @@ -1478,7 +1478,10 @@ abc\N abc\n n [\N{U+}] - c - Invalid hexadecimal number \N{U+4AG3} - c - Invalid hexadecimal number [\N{U+4AG3}] - c - Invalid hexadecimal number -abc\N{def - c - \\N{NAME} must be resolved by the lexer +abc\N{def} - c - \\N{NAME} must be resolved by the lexer +abc\N{U+4AG3 - c - Missing right brace on \\N{} +abc\N{def - c - Missing right brace on \\N{} +abc\N{ - c - Missing right brace on \\N{} # Verify that under /x that still cant have space before left brace /abc\N {U+41}/x - c - Missing braces diff --git a/t/uni/readline.t b/t/uni/readline.t index c733f69..893a290 100644 --- a/t/uni/readline.t +++ b/t/uni/readline.t @@ -27,10 +27,13 @@ like($@, qr/Modification of a read-only value attempted/, '[perl #19566]'); } use strict; - -open á, '.' and sysread á, $_, 1; -my $err = $! + 0; -close á; +my $err; +{ + no warnings qw(deprecated); + open á, '.' and sysread á, $_, 1; + $err = $! + 0; + close á; +} SKIP: { skip "you can read directories as plain files", 2 unless( $err ); diff --git a/toke.c b/toke.c index a105010..9160407 100644 --- a/toke.c +++ b/toke.c @@ -2290,12 +2290,12 @@ S_tokeq(pTHX_ SV *sv) * Pattern matching will set PL_lex_op to the pattern-matching op to * make (we return THING if pl_yylval.ival is OP_NULL, PMFUNC otherwise). * - * OP_CONST and OP_READLINE are easy--just make the new op and return. + * OP_CONST is easy--just make the new op and return. * * Everything else becomes a FUNC. * - * Sets PL_lex_state to LEX_INTERPPUSH unless (ival was OP_NULL or we - * had an OP_CONST or OP_READLINE). This just sets us up for a + * Sets PL_lex_state to LEX_INTERPPUSH unless ival was OP_NULL or we + * had an OP_CONST. This just sets us up for a * call to S_sublex_push(). */ @@ -9562,6 +9562,9 @@ S_scan_heredoc(pTHX_ char *s) char *d; char *e; char *peek; + char *indent = 0; + I32 indent_len = 0; + bool indented = FALSE; const bool infile = PL_rsfp || PL_parser->filtered; const line_t origline = CopLINE(PL_curcop); LEXSHARED *shared = PL_parser->lex_shared; @@ -9573,6 +9576,10 @@ S_scan_heredoc(pTHX_ char *s) e = PL_tokenbuf + sizeof PL_tokenbuf - 1; *PL_tokenbuf = '\n'; peek = s; + if (*peek == '~') { + indented = TRUE; + peek++; s++; + } while (SPACE_OR_TAB(*peek)) peek++; if (*peek == '`' || *peek == '\'' || *peek =='"') { @@ -9695,12 +9702,45 @@ S_scan_heredoc(pTHX_ char *s) linestr = shared->ls_linestr; bufend = SvEND(linestr); d = s; - while (s < bufend - len + 1 - && memNE(s,PL_tokenbuf,len) ) - { - if (*s++ == '\n') - ++PL_parser->herelines; + if (indented) { + char *myolds = s; + + while (s < bufend - len + 1) { + if (*s++ == '\n') + ++PL_parser->herelines; + + if (memEQ(s, PL_tokenbuf + 1, len - 1)) { + char *backup = s; + indent_len = 0; + + /* Only valid if it's preceded by whitespace only */ + while (backup != myolds && --backup >= myolds) { + if (*backup != ' ' && *backup != '\t') { + break; + } + + indent_len++; + } + + /* No whitespace or all! */ + if (backup == s || *backup == '\n') { + Newxz(indent, indent_len + 1, char); + memcpy(indent, backup + 1, indent_len); + s--; /* before our delimiter */ + PL_parser->herelines--; /* this line doesn't count */ + break; + } + } + } + } else { + while (s < bufend - len + 1 + && memNE(s,PL_tokenbuf,len) ) + { + if (*s++ == '\n') + ++PL_parser->herelines; + } } + if (s >= bufend - len + 1) { goto interminable; } @@ -9802,23 +9842,102 @@ S_scan_heredoc(pTHX_ char *s) else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r') PL_bufend[-1] = '\n'; #endif - if (*s == term && PL_bufend-s >= len - && memEQ(s,PL_tokenbuf + 1,len)) { - SvREFCNT_dec(PL_linestr); - PL_linestr = linestr_save; - PL_linestart = SvPVX(linestr_save); - PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); - PL_oldbufptr = oldbufptr_save; - PL_oldoldbufptr = oldoldbufptr_save; - s = d; - break; - } - else { + if (indented && (PL_bufend-s) >= len) { + char * found = ninstr(s, PL_bufend, (PL_tokenbuf + 1), (PL_tokenbuf +1 + len)); + + if (found) { + char *backup = found; + indent_len = 0; + + /* Only valid if it's preceded by whitespace only */ + while (backup != s && --backup >= s) { + if (*backup != ' ' && *backup != '\t') { + break; + } **** PATCH TRUNCATED AT 2000 LINES -- 104 NOT SHOWN **** -- Perl5 Master Repository
