In perl.git, the branch abigail/deprecation has been updated <http://perl5.git.perl.org/perl.git/commitdiff/102f1566ae3179210c18c496975364effd65758b?hp=2820dd91910f553dd43a73e9804d9f5213cad9cb>
- Log ----------------------------------------------------------------- commit 102f1566ae3179210c18c496975364effd65758b Author: James E Keenan <[email protected]> Date: Thu Nov 17 18:01:13 2016 -0500 Remove code commented out since July 1996. M dist/Safe/t/safe2.t commit 2476334afc51c4a3f4e80ec6bee812e73cedfc78 Author: Karl Williamson <[email protected]> Date: Wed Nov 16 20:18:59 2016 -0700 APItest/t/utf8.t: Fix failing EBCDIC tests I keep not getting this completely correct, hence 1069c57cb1f4e6b94f8695843243749e9511303e 162256f303e3b2f3936976e692650c18c9cad0a6 But I'm hopeful this is the final answer. We should be operating on I8 strings in this function, translating into I8 at the beginning and translating back to UTF-EBCDIC at the end (except UTF8SKIP has purposely been built for speed to not use the transform, so it operates on UTF-EBCDIC. M ext/XS-APItest/t/utf8.t commit 949b9d0ed63f71dc78f29409c3fe8a4c7f569e3f Author: Karl Williamson <[email protected]> Date: Wed Nov 16 20:17:48 2016 -0700 APItest/t/utf8.t: Fill in missing die() reason I forgot to complete this before the initial commit, so that the reason for dieing was empty. M ext/XS-APItest/t/utf8.t commit 326f017ee5e3bc76d19d8edbe62ccef1f8a7c884 Author: Karl Williamson <[email protected]> Date: Wed Nov 16 20:15:54 2016 -0700 op/bop.t: Fix test failing on EBCDIC This recently added test did not take into account character set differences. M t/op/bop.t commit b18037451ab5d9c28846c9b9e20cdfe18577619c Author: Dagfinn Ilmari Mannsåker <[email protected]> Date: Thu Nov 17 09:21:07 2016 +0000 Remove spurious executable bit from Porting/pod_lib.pl M Porting/pod_lib.pl commit 7419ef42afb53fc5db745a116010d7d1325f64fa Author: James E Keenan <[email protected]> Date: Mon Nov 14 17:22:22 2016 -0500 Account for possibility of DOS file endings. Although our source code (including this file) is supposed to have only Unix line endings, cloning, etc., can result in particular users having DOS line endings. Let's allow '\r\n' to avoid spurious testing or installation problems. For: RT #130088, as recommended by Mark E Renzulli (UTRC). M Porting/pod_lib.pl commit b439273356daf6f4d1324e3d570fe4f803284efa Author: Matthew Horsfall <[email protected]> Date: Wed Nov 16 08:31:00 2016 -0500 Test descriptions should be one line or ./TEST chokes on them M t/op/heredoc.t commit ad520e20c958b047a0b9358db949ea654a5c597a Author: David Mitchell <[email protected]> Date: Tue Nov 15 08:27:48 2016 +0000 optimise $ref1 = $ref2 better When assigning to a ref, the old referent is mortalised if its refcount is 1, to avoid a premature free on things like $r = $$r or $r = $r->[0]. For the shortcut case where $ref1 and $ref2 are simple refs (no magic etc) it's possible to do the assign then SvREFCNT_dec() the old value without having to mortalise it. Which is faster. Even when it doesn't have to be mortalised (RC > 1) this commit makes it slightly faster as it no longer calls sv_unref_flags(). Conversely, this commit also makes the short-cut integer assign code path infinitesimally slower. M sv.c M t/perf/benchmarks commit 1290db03c0d1eaf58919a620b00531e502262a43 Author: David Mitchell <[email protected]> Date: Tue Nov 15 08:22:48 2016 +0000 perf/benchmarks: tidy scalar assign benchmarks rename them from expr::assign::* to expr::sassign::* so as to more easily distinguish them from expr::aassign::, and move them to the correct place in the file M t/perf/benchmarks ----------------------------------------------------------------------- Summary of changes: Porting/pod_lib.pl | 2 +- dist/Safe/t/safe2.t | 12 --------- ext/XS-APItest/t/utf8.t | 6 ++--- sv.c | 10 +++++-- t/op/bop.t | 3 ++- t/op/heredoc.t | 5 ++-- t/perf/benchmarks | 70 +++++++++++++++++++++++++++++-------------------- 7 files changed, 59 insertions(+), 49 deletions(-) diff --git a/Porting/pod_lib.pl b/Porting/pod_lib.pl index 6eaacde..25cf691 100644 --- a/Porting/pod_lib.pl +++ b/Porting/pod_lib.pl @@ -403,7 +403,7 @@ sub __prime_state { my $filename = "pod/$source"; my $contents = slurp_or_die($filename); my @want = - $contents =~ /perldelta - what is new for perl v(5)\.(\d+)\.(\d+)\n/; + $contents =~ /perldelta - what is new for perl v(5)\.(\d+)\.(\d+)\r?\n/; die "Can't extract version from $filename" unless @want; my $delta_leaf = join '', 'perl', @want, 'delta'; $state{delta_target} = "$delta_leaf.pod"; diff --git a/dist/Safe/t/safe2.t b/dist/Safe/t/safe2.t index b55b4a9..fc519ff 100644 --- a/dist/Safe/t/safe2.t +++ b/dist/Safe/t/safe2.t @@ -143,16 +143,4 @@ if ($@) { } close(NOSUCH); -#my $rdo_file = "tmp_rdo.tpl"; -#if (open X,">$rdo_file") { -# print X "999\n"; -# close X; -# $cpt->permit_only('const', 'leaveeval'); -# $cpt->rdo($rdo_file) == 999 ? "ok $t\n" : "not ok $t\n"; $t++; -# unlink $rdo_file; -#} -#else { -# print "# test $t skipped, can't open file: $!\nok $t\n"; $t++; -#} - done_testing(); diff --git a/ext/XS-APItest/t/utf8.t b/ext/XS-APItest/t/utf8.t index e366254..49a6fba 100644 --- a/ext/XS-APItest/t/utf8.t +++ b/ext/XS-APItest/t/utf8.t @@ -72,7 +72,7 @@ sub start_byte_to_cont($) { my $byte = shift; my $len = test_UTF8_SKIP($byte); if ($len < 2) { - die ""; + die "start_byte_to_cont() is expecting a UTF-8 variant"; } $byte = ord native_to_I8($byte); @@ -80,8 +80,8 @@ sub start_byte_to_cont($) { # Copied from utf8.h. This gets rid of the leading 1 bits. $byte &= ((($len) >= 7) ? 0x00 : (0x1F >> (($len)-2))); - $byte |= (isASCII) ? 0x80 : ord I8_to_native("\xA0"); - return chr $byte; + $byte |= (isASCII) ? 0x80 : 0xA0; + return I8_to_native(chr $byte); } my $is64bit = length sprintf("%x", ~0) > 8; diff --git a/sv.c b/sv.c index 7bc97f3..25776f2 100644 --- a/sv.c +++ b/sv.c @@ -4280,12 +4280,17 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) * special-casing */ U32 sflags; U32 new_dflags; + SV *old_rv = NULL; /* minimal subset of SV_CHECK_THINKFIRST_COW_DROP(dstr) */ if (SvREADONLY(dstr)) Perl_croak_no_modify(); - if (SvROK(dstr)) - sv_unref_flags(dstr, 0); + if (SvROK(dstr)) { + if (SvWEAKREF(dstr)) + sv_unref_flags(dstr, 0); + else + old_rv = SvRV(dstr); + } assert(!SvGMAGICAL(sstr)); assert(!SvGMAGICAL(dstr)); @@ -4315,6 +4320,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, SV* sstr, const I32 flags) new_dflags = dtype; /* turn off everything except the type */ } SvFLAGS(dstr) = new_dflags; + SvREFCNT_dec(old_rv); return; } diff --git a/t/op/bop.t b/t/op/bop.t index dd5b5ef..594dd09 100644 --- a/t/op/bop.t +++ b/t/op/bop.t @@ -681,4 +681,5 @@ is $byte, "\0", "utf8 &. appends null byte"; # only visible under sanitize fresh_perl_is('$x = "UUUUUUUV"; $y = "xxxxxxx"; $x |= $y; print $x', - '}}}}}}}V', {}, "[perl #129995] access to freed memory"); + ( $::IS_EBCDIC) ? 'XXXXXXXV' : '}}}}}}}V', + {}, "[perl #129995] access to freed memory"); diff --git a/t/op/heredoc.t b/t/op/heredoc.t index e4aa8a5..15b12d9 100644 --- a/t/op/heredoc.t +++ b/t/op/heredoc.t @@ -165,7 +165,7 @@ HEREDOC unshift @tests, [ $test, $string, - "Indented here-doc: $test", + "Indented here-doc: <<$modifier$start_delim with end delim '$end_delim'" . ($script_end ? "\\n" : ""), ]; # Eval'd heredoc @@ -180,7 +180,8 @@ HEREDOC push @tests, [ $eval, $string, - "Eval'd Indented here-doc: $eval", + "Eval'd Indented here-doc: <<$modifier$start_delim with end delim '$end_delim'" . ($script_end ? "\\n" : ""), + ]; } } diff --git a/t/perf/benchmarks b/t/perf/benchmarks index 5726c98..8306b1f 100644 --- a/t/perf/benchmarks +++ b/t/perf/benchmarks @@ -199,34 +199,6 @@ code => '$h{$k1}[$i]{$k2}', }, - - 'expr::assign::scalar_lex_int' => { - desc => 'lexical $x = 1', - setup => 'my $x', - code => '$x = 1', - }, - 'expr::assign::scalar_lex_str' => { - desc => 'lexical $x = "abc"', - setup => 'my $x', - code => '$x = "abc"', - }, - 'expr::assign::scalar_lex_strint' => { - desc => 'lexical $x = 1 where $x was previously a string', - setup => 'my $x = "abc"', - code => '$x = 1', - }, - 'expr::assign::scalar_lex_intstr' => { - desc => 'lexical $x = "abc" where $x was previously an int', - setup => 'my $x = 1;', - code => '$x = "abc"', - }, - 'expr::assign::2list_lex' => { - desc => 'lexical ($x, $y) = (1, 2)', - setup => 'my ($x, $y)', - code => '($x, $y) = (1, 2)', - }, - - 'expr::hash::lex_1const' => { desc => 'lexical $hash{const}', setup => 'my %h = ("foo" => 1)', @@ -716,6 +688,12 @@ code => '($x,$x) = (undef, $x)', }, + 'expr::aassign::2list_lex' => { + desc => 'lexical ($x, $y) = (1, 2)', + setup => 'my ($x, $y)', + code => '($x, $y) = (1, 2)', + }, + # array assign of strings 'expr::aassign::la_3s' => { @@ -890,6 +868,42 @@ + # scalar assign, OP_SASSIGN + + + 'expr::sassign::scalar_lex_int' => { + desc => 'lexical $x = 1', + setup => 'my $x', + code => '$x = 1', + }, + 'expr::sassign::scalar_lex_str' => { + desc => 'lexical $x = "abc"', + setup => 'my $x', + code => '$x = "abc"', + }, + 'expr::sassign::scalar_lex_strint' => { + desc => 'lexical $x = 1 where $x was previously a string', + setup => 'my $x = "abc"', + code => '$x = 1', + }, + 'expr::sassign::scalar_lex_intstr' => { + desc => 'lexical $x = "abc" where $x was previously an int', + setup => 'my $x = 1;', + code => '$x = "abc"', + }, + 'expr::sassign::lex_rv' => { + desc => 'lexical $ref1 = $ref2;', + setup => 'my $r1 = []; my $r = $r1;', + code => '$r = $r1;', + }, + 'expr::sassign::lex_rv1' => { + desc => 'lexical $ref1 = $ref2; where $$ref1 gets freed', + setup => 'my $r1 = []; my $r', + code => '$r = []; $r = $r1;', + }, + + + # using a const string as second arg to index triggers using FBM. # the FBM matcher special-cases 1,2-byte strings. # -- Perl5 Master Repository
