In perl.git, the branch smoke-me/ilmari/sort-weak has been updated <http://perl5.git.perl.org/perl.git/commitdiff/21d4c236cca491fbf12f039c1f4576ca9eb10f0b?hp=743bd4deba657e2f90334d3c92857b099f216e39>
discards 743bd4deba657e2f90334d3c92857b099f216e39 (commit) discards 4fbe0529a38141c78622081f4f1b5dd39dfc51fe (commit) discards 7c401a6450e517ab3e678e90538fc3e001366aa0 (commit) - Log ----------------------------------------------------------------- commit 21d4c236cca491fbf12f039c1f4576ca9eb10f0b Author: Dagfinn Ilmari Mannsåker <[email protected]> Date: Wed Aug 30 22:34:54 2017 +0100 Use sv_rvunweaken() in Scalar::Util::unweaken() M cpan/Scalar-List-Utils/ListUtil.xs M cpan/Scalar-List-Utils/lib/List/Util.pm M cpan/Scalar-List-Utils/lib/List/Util/XS.pm M cpan/Scalar-List-Utils/lib/Scalar/Util.pm M cpan/Scalar-List-Utils/lib/Sub/Util.pm commit d5fbc37e847e622c95e0f66f9ff856af4c88c7ef Author: Dagfinn Ilmari Mannsåker <[email protected]> Date: Wed Aug 30 22:35:17 2017 +0100 Strengthen weak refs when sorting in-place It's conceptually an assignment, which should strengthen any weak refs. Reported-by: Tom Molesworth <[email protected]> M pp_sort.c M t/op/sort.t commit dc7aebc17cbe776a79b41111d97834a5fae92ad9 Author: Dagfinn Ilmari Mannsåker <[email protected]> Date: Wed Aug 30 22:33:45 2017 +0100 Add new API function sv_rvunweaken Needed to fix in-place sort of weak references in a future commit. Stolen from Scalar::Util::unweaken, which will be made to use this when available in a future commit. M embed.fnc M embed.h M pod/perldiag.pod M proto.h M sv.c ----------------------------------------------------------------------- Summary of changes: ext/VMS-Stdio/Stdio.pm | 38 ++++++-------------------------------- mg.c | 2 +- pod/perldelta.pod | 17 +++++++++++++++++ pp_hot.c | 20 ++++++++++++++++---- t/comp/parser_run.t | 12 +++++++++++- t/op/magic.t | 10 +++++++++- toke.c | 5 ++++- 7 files changed, 64 insertions(+), 40 deletions(-) diff --git a/ext/VMS-Stdio/Stdio.pm b/ext/VMS-Stdio/Stdio.pm index 4d05994279..f9ed211d3b 100644 --- a/ext/VMS-Stdio/Stdio.pm +++ b/ext/VMS-Stdio/Stdio.pm @@ -13,7 +13,7 @@ use Carp '&croak'; use DynaLoader (); use Exporter (); -$VERSION = '2.41'; +$VERSION = '2.42'; @ISA = qw( Exporter DynaLoader IO::File ); @EXPORT = qw( &O_APPEND &O_CREAT &O_EXCL &O_NDELAY &O_NOWAIT &O_RDONLY &O_RDWR &O_TRUNC &O_WRONLY ); @@ -48,30 +48,6 @@ sub AUTOLOAD { sub DESTROY { close($_[0]); } -################################################################################ -# Intercept calls to old VMS::stdio package, complain, and hand off -# This will be removed in a future version of VMS::Stdio - -package VMS::stdio; - -sub AUTOLOAD { - my($func) = $AUTOLOAD; - $func =~ s/.*:://; - # Cheap trick: we know DynaLoader has required Carp.pm - Carp::carp("Old package VMS::stdio is now VMS::Stdio; please update your code"); - if ($func eq 'vmsfopen') { - Carp::carp("Old function &vmsfopen is now &vmsopen"); - goto &VMS::Stdio::vmsopen; - } - elsif ($func eq 'fgetname') { - Carp::carp("Old function &fgetname is now &getname"); - goto &VMS::Stdio::getname; - } - else { goto &{"VMS::Stdio::$func"}; } -} - -package VMS::Stdio; # in case we ever use AutoLoader - 1; __END__ @@ -138,13 +114,11 @@ is done to save startup time for users who don't wish to use the IO::File methods. B<Note:> In order to conform to naming conventions for Perl -extensions and functions, the name of this package has been -changed to VMS::Stdio as of Perl 5.002, and the names of some -routines have been changed. Calls to the old VMS::stdio routines -will generate a warning, and will be routed to the equivalent -VMS::Stdio function. This compatibility interface will be -removed in a future release of this extension, so please -update your code to use the new routines. +extensions and functions, the name of this package was +changed to from VMS::stdio to VMS::Stdio as of Perl 5.002, and the names of some +routines were changed. For many releases, calls to the old VMS::stdio routines +would generate a warning, and then route to the equivalent +VMS::Stdio function. This compatibility interface has now been removed. =over 4 diff --git a/mg.c b/mg.c index e0d1215281..971fceed2b 100644 --- a/mg.c +++ b/mg.c @@ -1007,7 +1007,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) break; case '\014': /* ^LAST_FH */ if (strEQ(remaining, "AST_FH")) { - if (PL_last_in_gv) { + if (PL_last_in_gv && (SV*)PL_last_in_gv != &PL_sv_undef) { assert(isGV_with_GP(PL_last_in_gv)); SV_CHECK_THINKFIRST_COW_DROP(sv); prepare_SV_for_RV(sv); diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 274c464b59..3f1d22eea7 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -361,10 +361,27 @@ files in F<ext/> and F<lib/> are best summarized in L</Modules and Pragmata>. =item * +The internal stack usage checks introduced in 5.27.2 is now also done +by the C<entersub> operator when calling XSUBs. This means we can +report which XSUB failed to allocate enough stack space. [perl +#131975] + +=item * + Parsing a C<sub> definition could cause a use after free if the C<sub> keyword was followed by whitespace including newlines (and comments.) [perl #131836] +=item * + +The tokenizer now correctly adjusts a parse pointer when skipping +whitespace in a C< ${identifier} > construct. [perl #131949] + +=item * + +Accesses to C<${^LAST_FH}> no longer assert after using any of a +variety of I/O operations on a non-glob. [perl #128263] + =back =head1 Known Problems diff --git a/pp_hot.c b/pp_hot.c index 528817fed9..b891d79519 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -446,10 +446,7 @@ PP(pp_readline) PUTBACK; Perl_pp_rv2gv(aTHX); PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--); - if (PL_last_in_gv == (GV *)&PL_sv_undef) - PL_last_in_gv = NULL; - else - assert(isGV_with_GP(PL_last_in_gv)); + assert((SV*)PL_last_in_gv == &PL_sv_undef || isGV_with_GP(PL_last_in_gv)); } } return do_readline(); @@ -4423,6 +4420,21 @@ PP(pp_entersub) assert(CvXSUB(cv)); CvXSUB(cv)(aTHX_ cv); +#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY + /* This duplicates the check done in runops_debug(), but provides more + * information in the common case of the fault being with an XSUB. + * + * It should also catch an XSUB pushing more than it extends + * in scalar context. + */ + if (PL_curstackinfo->si_stack_hwm < PL_stack_sp - PL_stack_base) + Perl_croak_nocontext( + "panic: XSUB %s::%s (%s) failed to extend arg stack: " + "base=%p, sp=%p, hwm=%p\n", + HvNAME(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)), CvFILE(cv), + PL_stack_base, PL_stack_sp, + PL_stack_base + PL_curstackinfo->si_stack_hwm); +#endif /* Enforce some sanity in scalar context. */ if (is_scalar) { SV **svp = PL_stack_base + markix + 1; diff --git a/t/comp/parser_run.t b/t/comp/parser_run.t index a2cc27d3fb..af35758bee 100644 --- a/t/comp/parser_run.t +++ b/t/comp/parser_run.t @@ -10,7 +10,7 @@ BEGIN { } require './test.pl'; -plan(3); +plan(4); # [perl #130814] can reallocate lineptr while looking ahead for # "Missing $ on loop variable" diagnostic. @@ -39,5 +39,15 @@ syntax error at - line 1, at EOF Execution of - aborted due to compilation errors. EXPECTED +SKIP: +{ + # [perl #131949] use after free + # detected by ASAN + # Win32 cmd.exe can't handle newlines well + skip("Need POSIXish", 1) if $^O eq "MSWin32"; + my $out = runperl(prog => "\@{ 0\n\n}", stderr => 1, non_portable => 1); + is($out, "", "check for ASAN use after free"); +} + __END__ # ex: set ts=8 sts=4 sw=4 et: diff --git a/t/op/magic.t b/t/op/magic.t index 3f71f8ec64..02ced156d5 100644 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -5,7 +5,7 @@ BEGIN { chdir 't' if -d 't'; require './test.pl'; set_up_inc( '../lib' ); - plan (tests => 192); # some tests are run in BEGIN block + plan (tests => 196); # some tests are run in BEGIN block } # Test that defined() returns true for magic variables created on the fly, @@ -643,6 +643,14 @@ is ${^LAST_FH}, \*STDIN, '${^LAST_FH} after another tell'; # This also tests that ${^LAST_FH} is a weak reference: is ${^LAST_FH}, undef, '${^LAST_FH} is undef when PL_last_in_gv is NULL'; +# all of these would set PL_last_in_gv to a non-GV which would +# assert when referenced by the magic for ${^LAST_FH}. +# The approach to fixing this has changed (#128263), but it's still useful +# to check each op. +for my $code ('tell $0', 'sysseek $0, 0, 0', 'seek $0, 0, 0', 'eof $0') { + fresh_perl_is("$code; print defined \${^LAST_FH} ? qq(not ok\n) : qq(ok\n)", "ok\n", + undef, "check $code doesn't define \${^LAST_FH}"); +} # $| fresh_perl_is 'print $| = ~$|', "1\n", {switches => ['-l']}, diff --git a/toke.c b/toke.c index 35940be787..4f370895c0 100644 --- a/toke.c +++ b/toke.c @@ -9438,10 +9438,13 @@ S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) if ( !tmp_copline ) tmp_copline = CopLINE(PL_curcop); - if ((skip = s < PL_bufend && isSPACE(*s))) + if ((skip = s < PL_bufend && isSPACE(*s))) { /* Avoid incrementing line numbers or resetting PL_linestart, in case we have to back up. */ + STRLEN s_off = s - SvPVX(PL_linestr); s2 = peekspace(s); + s = SvPVX(PL_linestr) + s_off; + } else s2 = s; -- Perl5 Master Repository
