Package: release.debian.org
Severity: normal
User: release.debian....@packages.debian.org
Usertags: pu
Attached are two patches against perl 5.14.2-21 for consideration for
the next wheezy point release.
The first patch contains mainly functional changes with associated
Debian bugs. The second set are correctness/believed-to-be-non-exploitable
security issues taken from 5.14.4.
Please note that a separate bug report will follow for
libdigest-sha-perl, which will need to be released at the same time.
Please would you let me know whether I may upload packages including
either or both sets of changes?
Thanks,
Dominic.
diff --git a/cpan/Digest-SHA/SHA.xs b/cpan/Digest-SHA/SHA.xs
index 7088a33..893bed2 100644
--- a/cpan/Digest-SHA/SHA.xs
+++ b/cpan/Digest-SHA/SHA.xs
@@ -23,6 +23,9 @@ PROTOTYPES: ENABLE
int
shaclose(s)
SHA * s
+CODE:
+ RETVAL = shaclose(s);
+ sv_setiv(SvRV(ST(0)), 0);
int
shadump(file, s)
diff --git a/cpan/Digest-SHA/lib/Digest/SHA.pm b/cpan/Digest-SHA/lib/Digest/SHA.pm
index 8cea302..2e70f60 100644
--- a/cpan/Digest-SHA/lib/Digest/SHA.pm
+++ b/cpan/Digest-SHA/lib/Digest/SHA.pm
@@ -65,7 +65,7 @@ sub new {
sub DESTROY {
my $self = shift;
- shaclose($$self) if $$self;
+ if ($$self) { shaclose($$self); $$self = undef }
}
sub clone {
diff --git a/debian/.git-dpm b/debian/.git-dpm
index c8c980a..36f1942 100644
--- a/debian/.git-dpm
+++ b/debian/.git-dpm
@@ -1,6 +1,6 @@
# see git-dpm(1) from git-dpm package
-93f6c83c7454de33df00a0e3fde3a890d6c87e91
-93f6c83c7454de33df00a0e3fde3a890d6c87e91
+504aefc29e21b6cc8e7d81ca83548ccda7ca606d
+504aefc29e21b6cc8e7d81ca83548ccda7ca606d
5f99bf7a09dd2ae3c22081331f4973210a543731
5f99bf7a09dd2ae3c22081331f4973210a543731
perl_5.14.2.orig.tar.bz2
diff --git a/debian/changelog b/debian/changelog
index 14df505..fa9a5b9 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,13 @@
+perl (5.14.2-21+deb7u1) UNRELEASED; urgency=low
+
+ * Fix issue with shared references disappearing on sub return
+ (Closes: #718438)
+ * Make perlbug.PL look up local patches at runtime (Closes: #710842)
+ * Apply patch from upstream fixing Digest::SHA double-free
+ crash (Closes: #711206)
+
+ -- Dominic Hargreaves <d...@earth.li> Mon, 23 Sep 2013 20:40:20 +0100
+
perl (5.14.2-21) unstable; urgency=low
[ Dominic Hargreaves ]
diff --git a/debian/control b/debian/control
index a0310a1..0840ed0 100644
--- a/debian/control
+++ b/debian/control
@@ -282,7 +282,7 @@ Breaks: perl-doc (<< ${Upstream-Version}-1),
libmime-base64-perl (<< 3.13),
libtime-hires-perl (<< 1.9721.01),
libstorable-perl (<< 2.27),
- libdigest-sha-perl (<< 5.71-2),
+ libdigest-sha-perl (<< 5.71-2+deb7u1),
libsys-syslog-perl (<< 0.27),
libcompress-zlib-perl (<< 2.033),
libcompress-raw-zlib-perl (<< 2.033),
diff --git a/debian/patches/fixes/digest_sha_double_free.diff b/debian/patches/fixes/digest_sha_double_free.diff
new file mode 100644
index 0000000..340a699
--- /dev/null
+++ b/debian/patches/fixes/digest_sha_double_free.diff
@@ -0,0 +1,43 @@
+From 504aefc29e21b6cc8e7d81ca83548ccda7ca606d Mon Sep 17 00:00:00 2001
+From: Chris 'BinGOs' Williams <ch...@bingosnet.co.uk>
+Date: Fri, 28 Jun 2013 13:07:34 +0100
+Subject: maint-5.18: Digest-SHA crash fix in 5.85
+
+Backported minimal changes from blead
+
+Bug-Debian: http://bugs.debian.org/711206
+Bug: https://rt.cpan.org/Public/Bug/Display.html?id=86295
+Origin: http://perl5.git.perl.org/perl.git/commit/ee8c6f40e6bd7b4e08eac8386f9a092fdd609ffa
+Patch-Name: fixes/digest_sha_double_free.diff
+---
+ cpan/Digest-SHA/SHA.xs | 3 +++
+ cpan/Digest-SHA/lib/Digest/SHA.pm | 2 +-
+ 2 files changed, 4 insertions(+), 1 deletion(-)
+
+diff --git a/cpan/Digest-SHA/SHA.xs b/cpan/Digest-SHA/SHA.xs
+index 7088a33..893bed2 100644
+--- a/cpan/Digest-SHA/SHA.xs
++++ b/cpan/Digest-SHA/SHA.xs
+@@ -23,6 +23,9 @@ PROTOTYPES: ENABLE
+ int
+ shaclose(s)
+ SHA * s
++CODE:
++ RETVAL = shaclose(s);
++ sv_setiv(SvRV(ST(0)), 0);
+
+ int
+ shadump(file, s)
+diff --git a/cpan/Digest-SHA/lib/Digest/SHA.pm b/cpan/Digest-SHA/lib/Digest/SHA.pm
+index 8cea302..2e70f60 100644
+--- a/cpan/Digest-SHA/lib/Digest/SHA.pm
++++ b/cpan/Digest-SHA/lib/Digest/SHA.pm
+@@ -65,7 +65,7 @@ sub new {
+
+ sub DESTROY {
+ my $self = shift;
+- shaclose($$self) if $$self;
++ if ($$self) { shaclose($$self); $$self = undef }
+ }
+
+ sub clone {
diff --git a/debian/patches/fixes/perlbug-patchlist.diff b/debian/patches/fixes/perlbug-patchlist.diff
new file mode 100644
index 0000000..d123722
--- /dev/null
+++ b/debian/patches/fixes/perlbug-patchlist.diff
@@ -0,0 +1,83 @@
+From dc41c3a1d8f2f3f3f507971fe86eb45079e5ec21 Mon Sep 17 00:00:00 2001
+From: Niko Tyni <nt...@debian.org>
+Date: Thu, 27 Jun 2013 14:37:01 +0300
+Subject: Make perlbug look up the list of local patches at run time
+
+Re-parsing patchlevel.h in Perl by perlbug.PL is error prone
+and apparently unnecessary. The same information is available
+to perlbug via Config::local_patches().
+
+This fixes [perl #118433].
+
+Bug: https://rt.perl.org/rt3/Public/Bug/Display.html?id=118433
+Bug-Debian: http://bugs.debian.org/710842
+Origin: http://perl5.git.perl.org/perl.git/commit/3541c11ab9be01478a51881e3972abb78481726e
+Patch-Name: fixes/perlbug-patchlist.diff
+---
+ utils/perlbug.PL | 39 ++++++---------------------------------
+ 1 file changed, 6 insertions(+), 33 deletions(-)
+
+diff --git a/utils/perlbug.PL b/utils/perlbug.PL
+index 368ce91..8318531 100644
+--- a/utils/perlbug.PL
++++ b/utils/perlbug.PL
+@@ -22,37 +22,12 @@ $file .= '.com' if $^O eq 'VMS';
+
+ open OUT, ">$file" or die "Can't create $file: $!";
+
+-# extract patchlevel.h information
++# get patchlevel.h timestamp
+
+-open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
+- or die "Can't open patchlevel.h: $!";
++-e catfile(updir, "patchlevel.h")
++ or die "Can't find patchlevel.h: $!";
+
+-my $patchlevel_date = (stat PATCH_LEVEL)[9];
+-
+-while (<PATCH_LEVEL>) {
+- last if $_ =~ /^\s*static\s+(?:const\s+)?char.*?local_patches\[\]\s*=\s*{\s*$/;
+-}
+-
+-if (! defined($_)) {
+- warn "Warning: local_patches section not found in patchlevel.h\n";
+-}
+-
+-my @patches;
+-while (<PATCH_LEVEL>) {
+- last if /^\s*}/;
+- next if /^\s*#/; # preprocessor stuff
+- next if /PERL_GIT_UNPUSHED_COMMITS/; # XXX expand instead
+- next if /"uncommitted-changes"/; # XXX determine if active instead
+- chomp;
+- s/^\s+,?\s*"?//;
+- s/"?\s*,?$//;
+- s/(['\\])/\\$1/g;
+- push @patches, $_ unless $_ eq 'NULL';
+-}
+-my $patch_desc = "'" . join("',\n '", @patches) . "'";
+-my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
+-
+-close(PATCH_LEVEL) or die "Error closing patchlevel.h: $!";
++my $patchlevel_date = (stat _)[9];
+
+ # TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
+ # used, compare $Config::config_sh with the stored version. If they differ then
+@@ -74,15 +49,13 @@ $Config{startperl}
+ my \$config_tag1 = '$extract_version - $Config{cf_time}';
+
+ my \$patchlevel_date = $patchlevel_date;
+-my \$patch_tags = '$patch_tags';
+-my \@patches = (
+- $patch_desc
+-);
+ !GROK!THIS!
+
+ # In the following, perl variables are not expanded during extraction.
+
+ print OUT <<'!NO!SUBS!';
++my @patches = Config::local_patches();
++my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
+
+ use warnings;
+ no warnings 'once'; # Eventually, the $::opt_ stuff should get cleaned up
diff --git a/debian/patches/fixes/threads_shared_elements_crash.diff b/debian/patches/fixes/threads_shared_elements_crash.diff
new file mode 100644
index 0000000..20f9eac
--- /dev/null
+++ b/debian/patches/fixes/threads_shared_elements_crash.diff
@@ -0,0 +1,178 @@
+From 4e07a8e0c8772662e962688a7f7eef04c1540a0c Mon Sep 17 00:00:00 2001
+From: Nicholas Clark <n...@ccl4.org>
+Date: Fri, 2 Aug 2013 12:08:33 +0200
+Subject: threads::shared should not crash if shared elements outlive their
+ aggregate.
+
+If an element of a shared aggregate is returned from a function, it is
+possible for it to outlive the aggregate itself. As the element has a pointer
+to the underlying shared aggregate and might use it, it is necessary for that
+pointer to remain valid. Hence threads::shared needs to ensure that cleanup
+of the shared aggregate is performed by the last proxy pointing to it, which
+is not necessarily the proxy for the aggregate itself. This can happen with
+lvalue subroutines.
+
+See the discussion in perl #119089 for more details.
+
+Backport to 5.14 via discussion in the upstream RT ticket.
+
+Bug-Debian: http://bugs.debian.org/718438
+Bug: https://rt.perl.org/rt3/Ticket/Display.html?id=119089
+Patch-Name: fixes/threads_shared_elements_crash.diff
+---
+ dist/threads-shared/shared.xs | 39 +++++++++++++++++++++++++++++++++++++--
+ dist/threads-shared/t/av_refs.t | 27 ++++++++++++++++++++++++++-
+ dist/threads-shared/t/hv_refs.t | 24 +++++++++++++++++++++++-
+ 3 files changed, 86 insertions(+), 4 deletions(-)
+
+diff --git a/dist/threads-shared/shared.xs b/dist/threads-shared/shared.xs
+index 7f1cd06..a21606c 100644
+--- a/dist/threads-shared/shared.xs
++++ b/dist/threads-shared/shared.xs
+@@ -998,6 +998,27 @@ sharedsv_elem_mg_DELETE(pTHX_ SV *sv, MAGIC *mg)
+ return (0);
+ }
+
++int
++sharedsv_elem_mg_free(pTHX_ SV *sv, MAGIC *mg)
++{
++ dTHXc;
++ PERL_UNUSED_ARG(sv);
++ ENTER_LOCK;
++ if (mg->mg_obj) {
++ if (!PL_dirty) {
++ assert(SvROK(mg->mg_obj));
++ }
++ if (SvREFCNT(mg->mg_obj) == 1) {
++ /* If the element has the last pointer to the shared aggregate, then
++ it has to free the shared aggregate. mg->mg_obj itself is freed
++ by Perl_mg_free() */
++ S_sharedsv_dec(aTHX_ S_sharedsv_from_obj(aTHX_ mg->mg_obj));
++ }
++ }
++ LEAVE_LOCK;
++ return (0);
++}
++
+ /* Called during cloning of PERL_MAGIC_tiedelem(p) magic in new
+ * thread */
+
+@@ -1015,7 +1036,7 @@ MGVTBL sharedsv_elem_vtbl = {
+ sharedsv_elem_mg_STORE, /* set */
+ 0, /* len */
+ sharedsv_elem_mg_DELETE, /* clear */
+- 0, /* free */
++ sharedsv_elem_mg_free, /* free */
+ 0, /* copy */
+ sharedsv_elem_mg_dup, /* dup */
+ #ifdef MGf_LOCAL
+@@ -1069,7 +1090,21 @@ int
+ sharedsv_array_mg_free(pTHX_ SV *sv, MAGIC *mg)
+ {
+ PERL_UNUSED_ARG(sv);
+- S_sharedsv_dec(aTHX_ (SV*)mg->mg_ptr);
++ if (!PL_dirty) {
++ assert(mg->mg_obj);
++ assert(SvROK(mg->mg_obj));
++ assert(SvUV(SvRV(mg->mg_obj)) == PTR2UV(mg->mg_ptr));
++ }
++ if (mg->mg_obj) {
++ if (SvREFCNT(mg->mg_obj) == 1) {
++ S_sharedsv_dec(aTHX_ (SV*)mg->mg_ptr);
++ } else {
++ /* An element of this aggregate still has PERL_MAGIC_tied(p)
++ pointing to this shared aggregate. It will take responsibility
++ for freeing the shared aggregate. Perl_mg_free() drops the
++ reference count on mg->mg_obj. */
++ }
++ }
+ return (0);
+ }
+
+diff --git a/dist/threads-shared/t/av_refs.t b/dist/threads-shared/t/av_refs.t
+index 8106e32..5243c54 100644
+--- a/dist/threads-shared/t/av_refs.t
++++ b/dist/threads-shared/t/av_refs.t
+@@ -27,7 +27,7 @@ sub ok {
+
+ BEGIN {
+ $| = 1;
+- print("1..14\n"); ### Number of tests that will be run ###
++ print("1..16\n"); ### Number of tests that will be run ###
+ };
+
+ use threads;
+@@ -90,6 +90,31 @@ ok(13, is_shared(@av), "Check for sharing");
+ my $x :shared;
+ ok(14, is_shared($x), "Check for sharing");
+
++# This is a reduction of the test case from perl #119089. Whilst the bug that
++# this exposes was fixed by a core change in 5.15.7, the variant with lvalues
++# below would still crash, and the fix for it also a fix for this bug on earlier
++# perl versions:
++
++sub elem_on_stack {
++ my @a :shared;
++ $a[0] = 6;
++ $a[0];
++}
++
++ok(15, defined elem_on_stack(), "element on stack should be defined");
++
++sub lvalue_elem_on_stack :lvalue {
++ my @a :shared;
++ $a[0];
++}
++
++if ($] >= 5.008008) {
++ lvalue_elem_on_stack() = 9;
++ ok(16, 1, "assigning to lvalue element on stack does not crash");
++} else {
++ print "ok 16 # skip $] can't return temporaries from lvalue subs\n";
++}
++
+ exit(0);
+
+ # EOF
+diff --git a/dist/threads-shared/t/hv_refs.t b/dist/threads-shared/t/hv_refs.t
+index ecefdc6..3b9b36b 100644
+--- a/dist/threads-shared/t/hv_refs.t
++++ b/dist/threads-shared/t/hv_refs.t
+@@ -27,7 +27,7 @@ sub ok {
+
+ BEGIN {
+ $| = 1;
+- print("1..20\n"); ### Number of tests that will be run ###
++ print("1..22\n"); ### Number of tests that will be run ###
+ };
+
+ use threads;
+@@ -106,6 +106,28 @@ ok(10, keys %foo == 0, "And make sure we realy have deleted the values");
+ ok(19, is_shared($foo), "Check for sharing");
+ ok(20, is_shared(%foo), "Check for sharing");
+
++# See av_refs.t for a description.
++
++sub elem_on_stack {
++ my %h :shared;
++ $h{''} = 6;
++ $h{''};
++}
++
++ok(21, defined elem_on_stack(), "element on stack should be defined");
++
++sub lvalue_elem_on_stack :lvalue {
++ my %h :shared;
++ $h{''};
++}
++
++if ($] >= 5.008008) {
++ lvalue_elem_on_stack() = 9;
++ ok(22, 1, "assigning to lvalue element on stack does not crash");
++} else {
++ print "ok 22 # skip $] can't return temporaries from lvalue subs\n";
++}
++
+ exit(0);
+
+ # EOF
diff --git a/debian/patches/series b/debian/patches/series
index 2d0696c..bdf49b8 100644
--- a/debian/patches/series
+++ b/debian/patches/series
@@ -78,3 +78,6 @@ fixes/64bitint-signedness-wraparound.diff
fixes/stdin-sigchld.diff
fixes/hsplit-rehash.diff
fixes/encode-memleak.diff
+fixes/threads_shared_elements_crash.diff
+fixes/perlbug-patchlist.diff
+fixes/digest_sha_double_free.diff
diff --git a/dist/threads-shared/shared.xs b/dist/threads-shared/shared.xs
index 7f1cd06..a21606c 100644
--- a/dist/threads-shared/shared.xs
+++ b/dist/threads-shared/shared.xs
@@ -998,6 +998,27 @@ sharedsv_elem_mg_DELETE(pTHX_ SV *sv, MAGIC *mg)
return (0);
}
+int
+sharedsv_elem_mg_free(pTHX_ SV *sv, MAGIC *mg)
+{
+ dTHXc;
+ PERL_UNUSED_ARG(sv);
+ ENTER_LOCK;
+ if (mg->mg_obj) {
+ if (!PL_dirty) {
+ assert(SvROK(mg->mg_obj));
+ }
+ if (SvREFCNT(mg->mg_obj) == 1) {
+ /* If the element has the last pointer to the shared aggregate, then
+ it has to free the shared aggregate. mg->mg_obj itself is freed
+ by Perl_mg_free() */
+ S_sharedsv_dec(aTHX_ S_sharedsv_from_obj(aTHX_ mg->mg_obj));
+ }
+ }
+ LEAVE_LOCK;
+ return (0);
+}
+
/* Called during cloning of PERL_MAGIC_tiedelem(p) magic in new
* thread */
@@ -1015,7 +1036,7 @@ MGVTBL sharedsv_elem_vtbl = {
sharedsv_elem_mg_STORE, /* set */
0, /* len */
sharedsv_elem_mg_DELETE, /* clear */
- 0, /* free */
+ sharedsv_elem_mg_free, /* free */
0, /* copy */
sharedsv_elem_mg_dup, /* dup */
#ifdef MGf_LOCAL
@@ -1069,7 +1090,21 @@ int
sharedsv_array_mg_free(pTHX_ SV *sv, MAGIC *mg)
{
PERL_UNUSED_ARG(sv);
- S_sharedsv_dec(aTHX_ (SV*)mg->mg_ptr);
+ if (!PL_dirty) {
+ assert(mg->mg_obj);
+ assert(SvROK(mg->mg_obj));
+ assert(SvUV(SvRV(mg->mg_obj)) == PTR2UV(mg->mg_ptr));
+ }
+ if (mg->mg_obj) {
+ if (SvREFCNT(mg->mg_obj) == 1) {
+ S_sharedsv_dec(aTHX_ (SV*)mg->mg_ptr);
+ } else {
+ /* An element of this aggregate still has PERL_MAGIC_tied(p)
+ pointing to this shared aggregate. It will take responsibility
+ for freeing the shared aggregate. Perl_mg_free() drops the
+ reference count on mg->mg_obj. */
+ }
+ }
return (0);
}
diff --git a/dist/threads-shared/t/av_refs.t b/dist/threads-shared/t/av_refs.t
index 8106e32..5243c54 100644
--- a/dist/threads-shared/t/av_refs.t
+++ b/dist/threads-shared/t/av_refs.t
@@ -27,7 +27,7 @@ sub ok {
BEGIN {
$| = 1;
- print("1..14\n"); ### Number of tests that will be run ###
+ print("1..16\n"); ### Number of tests that will be run ###
};
use threads;
@@ -90,6 +90,31 @@ ok(13, is_shared(@av), "Check for sharing");
my $x :shared;
ok(14, is_shared($x), "Check for sharing");
+# This is a reduction of the test case from perl #119089. Whilst the bug that
+# this exposes was fixed by a core change in 5.15.7, the variant with lvalues
+# below would still crash, and the fix for it also a fix for this bug on earlier
+# perl versions:
+
+sub elem_on_stack {
+ my @a :shared;
+ $a[0] = 6;
+ $a[0];
+}
+
+ok(15, defined elem_on_stack(), "element on stack should be defined");
+
+sub lvalue_elem_on_stack :lvalue {
+ my @a :shared;
+ $a[0];
+}
+
+if ($] >= 5.008008) {
+ lvalue_elem_on_stack() = 9;
+ ok(16, 1, "assigning to lvalue element on stack does not crash");
+} else {
+ print "ok 16 # skip $] can't return temporaries from lvalue subs\n";
+}
+
exit(0);
# EOF
diff --git a/dist/threads-shared/t/hv_refs.t b/dist/threads-shared/t/hv_refs.t
index ecefdc6..3b9b36b 100644
--- a/dist/threads-shared/t/hv_refs.t
+++ b/dist/threads-shared/t/hv_refs.t
@@ -27,7 +27,7 @@ sub ok {
BEGIN {
$| = 1;
- print("1..20\n"); ### Number of tests that will be run ###
+ print("1..22\n"); ### Number of tests that will be run ###
};
use threads;
@@ -106,6 +106,28 @@ ok(10, keys %foo == 0, "And make sure we realy have deleted the values");
ok(19, is_shared($foo), "Check for sharing");
ok(20, is_shared(%foo), "Check for sharing");
+# See av_refs.t for a description.
+
+sub elem_on_stack {
+ my %h :shared;
+ $h{''} = 6;
+ $h{''};
+}
+
+ok(21, defined elem_on_stack(), "element on stack should be defined");
+
+sub lvalue_elem_on_stack :lvalue {
+ my %h :shared;
+ $h{''};
+}
+
+if ($] >= 5.008008) {
+ lvalue_elem_on_stack() = 9;
+ ok(22, 1, "assigning to lvalue element on stack does not crash");
+} else {
+ print "ok 22 # skip $] can't return temporaries from lvalue subs\n";
+}
+
exit(0);
# EOF
diff --git a/utils/perlbug.PL b/utils/perlbug.PL
index 368ce91..8318531 100644
--- a/utils/perlbug.PL
+++ b/utils/perlbug.PL
@@ -22,37 +22,12 @@ $file .= '.com' if $^O eq 'VMS';
open OUT, ">$file" or die "Can't create $file: $!";
-# extract patchlevel.h information
+# get patchlevel.h timestamp
-open PATCH_LEVEL, "<" . catfile(updir, "patchlevel.h")
- or die "Can't open patchlevel.h: $!";
+-e catfile(updir, "patchlevel.h")
+ or die "Can't find patchlevel.h: $!";
-my $patchlevel_date = (stat PATCH_LEVEL)[9];
-
-while (<PATCH_LEVEL>) {
- last if $_ =~ /^\s*static\s+(?:const\s+)?char.*?local_patches\[\]\s*=\s*{\s*$/;
-}
-
-if (! defined($_)) {
- warn "Warning: local_patches section not found in patchlevel.h\n";
-}
-
-my @patches;
-while (<PATCH_LEVEL>) {
- last if /^\s*}/;
- next if /^\s*#/; # preprocessor stuff
- next if /PERL_GIT_UNPUSHED_COMMITS/; # XXX expand instead
- next if /"uncommitted-changes"/; # XXX determine if active instead
- chomp;
- s/^\s+,?\s*"?//;
- s/"?\s*,?$//;
- s/(['\\])/\\$1/g;
- push @patches, $_ unless $_ eq 'NULL';
-}
-my $patch_desc = "'" . join("',\n '", @patches) . "'";
-my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
-
-close(PATCH_LEVEL) or die "Error closing patchlevel.h: $!";
+my $patchlevel_date = (stat _)[9];
# TO DO (prehaps): store/embed $Config::config_sh into perlbug. When perlbug is
# used, compare $Config::config_sh with the stored version. If they differ then
@@ -74,15 +49,13 @@ $Config{startperl}
my \$config_tag1 = '$extract_version - $Config{cf_time}';
my \$patchlevel_date = $patchlevel_date;
-my \$patch_tags = '$patch_tags';
-my \@patches = (
- $patch_desc
-);
!GROK!THIS!
# In the following, perl variables are not expanded during extraction.
print OUT <<'!NO!SUBS!';
+my @patches = Config::local_patches();
+my $patch_tags = join "", map /(\S+)/ ? "+$1 " : (), @patches;
use warnings;
no warnings 'once'; # Eventually, the $::opt_ stuff should get cleaned up
diff --git a/cpan/List-Util/ListUtil.xs b/cpan/List-Util/ListUtil.xs
index 7da9b95..eacdde4 100644
--- a/cpan/List-Util/ListUtil.xs
+++ b/cpan/List-Util/ListUtil.xs
@@ -595,7 +595,7 @@ BOOT:
varav = GvAVn(vargv);
#endif
if (SvTYPE(rmcgv) != SVt_PVGV)
- gv_init(rmcgv, lu_stash, "List::Util", 12, TRUE);
+ gv_init(rmcgv, lu_stash, "List::Util", 10, TRUE);
rmcsv = GvSVn(rmcgv);
#ifndef SvWEAKREF
av_push(varav, newSVpv("weaken",6));
diff --git a/debian/.git-dpm b/debian/.git-dpm
index 36f1942..514a406 100644
--- a/debian/.git-dpm
+++ b/debian/.git-dpm
@@ -1,6 +1,6 @@
# see git-dpm(1) from git-dpm package
-504aefc29e21b6cc8e7d81ca83548ccda7ca606d
-504aefc29e21b6cc8e7d81ca83548ccda7ca606d
+30c39051fabf7d1111a2c55f5665c8bea679d19f
+30c39051fabf7d1111a2c55f5665c8bea679d19f
5f99bf7a09dd2ae3c22081331f4973210a543731
5f99bf7a09dd2ae3c22081331f4973210a543731
perl_5.14.2.orig.tar.bz2
diff --git a/debian/changelog b/debian/changelog
index fa9a5b9..604524f 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -5,6 +5,12 @@ perl (5.14.2-21+deb7u1) UNRELEASED; urgency=low
* Make perlbug.PL look up local patches at runtime (Closes: #710842)
* Apply patch from upstream fixing Digest::SHA double-free
crash (Closes: #711206)
+ * Apply correctness patches from 5.14.4:
+ - fixes/pl_eval_start_use_after_free.diff
+ - fixes/regcomp_fix_segv.diff
+ - list_util_off_by_two.diff
+ - sdbm_off_by_one.diff
+ - socket_unpack_sockaddr_un_heap_buffer_overflow.diff
-- Dominic Hargreaves <d...@earth.li> Mon, 23 Sep 2013 20:40:20 +0100
diff --git a/debian/patches/fixes/list_util_off_by_two.diff b/debian/patches/fixes/list_util_off_by_two.diff
new file mode 100644
index 0000000..c853a63
--- /dev/null
+++ b/debian/patches/fixes/list_util_off_by_two.diff
@@ -0,0 +1,27 @@
+From e84d279b900223724e7b81c97ec6b0bab30381a9 Mon Sep 17 00:00:00 2001
+From: David Mitchell <da...@iabyn.com>
+Date: Sun, 24 Feb 2013 15:45:48 +0000
+Subject: fix off-by-two error in List::Util
+
+A string literal is being used that includes two bytes beyond the
+end of the string.
+
+Origin: http://perl5.git.perl.org/perl.git/commit/623a911da450f8f4f1f400cb2c291c7898aecbd1
+Patch-Name: fixes/list_util_off_by_two.diff
+---
+ cpan/List-Util/ListUtil.xs | 2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/cpan/List-Util/ListUtil.xs b/cpan/List-Util/ListUtil.xs
+index 7da9b95..eacdde4 100644
+--- a/cpan/List-Util/ListUtil.xs
++++ b/cpan/List-Util/ListUtil.xs
+@@ -595,7 +595,7 @@ BOOT:
+ varav = GvAVn(vargv);
+ #endif
+ if (SvTYPE(rmcgv) != SVt_PVGV)
+- gv_init(rmcgv, lu_stash, "List::Util", 12, TRUE);
++ gv_init(rmcgv, lu_stash, "List::Util", 10, TRUE);
+ rmcsv = GvSVn(rmcgv);
+ #ifndef SvWEAKREF
+ av_push(varav, newSVpv("weaken",6));
diff --git a/debian/patches/fixes/pl_eval_start_use_after_free.diff b/debian/patches/fixes/pl_eval_start_use_after_free.diff
new file mode 100644
index 0000000..6328c09
--- /dev/null
+++ b/debian/patches/fixes/pl_eval_start_use_after_free.diff
@@ -0,0 +1,89 @@
+From c3492954a5e9c5a358dea824be027746f0c817c5 Mon Sep 17 00:00:00 2001
+From: David Mitchell <da...@iabyn.com>
+Date: Fri, 7 Dec 2012 11:07:30 +0000
+Subject: PL_eval_start use-after-free
+
+PL_eval_start is used for two purposes.
+
+First, it indicates the start op of a freshly-compiled eval. It is set in
+newPROG(), and used by entereval etc to know where to begin executing.
+After execution has begun, its value is meaningless (and may well point
+to a freed op).
+
+Second, it's used as a temporary pointer to indicate, within an assignment
+to $] (which has been optimised into a const), that it's not to croak in
+op_lvalue() with "Can't modify constant item", but instead to set
+CopARYBASE.
+
+This second use temporarily sets it in Perl_newASSIGNOP(), which calls
+op_lvalue(), which uses and then clears it. The issue is that it can also
+be left set by a previous eval, so something like 'local $[' will see it
+set and try to use its value.
+
+The quickest fix is to just set it NULL directly after each eval where its
+used.
+
+This change has been applied directly to maint-5.14 rather than going via
+bleed, since the old $[ mechanism was ripped out for 5.15.3.
+
+Bug: https://rt.perl.org/rt3//Ticket/Display.html?id=115992
+Origin: http://perl5.git.perl.org/perl.git/commit/eae139f3f1da0f91ca0fb543c5f5bc3b2b94cbc9
+Patch-Name: fixes/pl_eval_start_use_after_free.diff
+---
+ pp_ctl.c | 14 +++++++++++---
+ 1 file changed, 11 insertions(+), 3 deletions(-)
+
+diff --git a/pp_ctl.c b/pp_ctl.c
+index cbeeeee..615b82e 100644
+--- a/pp_ctl.c
++++ b/pp_ctl.c
+@@ -3088,6 +3088,7 @@ Perl_sv_compile_2op_is_broken(pTHX_ SV *sv, OP **startop, const char *code,
+ CV* runcv = NULL; /* initialise to avoid compiler warnings */
+ STRLEN len;
+ bool need_catch;
++ OP* ret;
+
+ PERL_ARGS_ASSERT_SV_COMPILE_2OP_IS_BROKEN;
+
+@@ -3182,7 +3183,9 @@ Perl_sv_compile_2op_is_broken(pTHX_ SV *sv, OP **startop, const char *code,
+ PERL_UNUSED_VAR(newsp);
+ PERL_UNUSED_VAR(optype);
+
+- return PL_eval_start;
++ ret = PL_eval_start;
++ PL_eval_start = NULL;
++ return ret;
+ }
+
+
+@@ -3903,8 +3906,10 @@ PP(pp_require)
+ encoding = PL_encoding;
+ PL_encoding = NULL;
+
+- if (doeval(gimme, NULL, NULL, PL_curcop->cop_seq))
++ if (doeval(gimme, NULL, NULL, PL_curcop->cop_seq)) {
+ op = DOCATCH(PL_eval_start);
++ PL_eval_start = NULL;
++ }
+ else
+ op = PL_op->op_next;
+
+@@ -4029,6 +4034,7 @@ PP(pp_entereval)
+ PUTBACK;
+
+ if (doeval(gimme, NULL, runcv, seq)) {
++ OP *ret;
+ if (was != PL_breakable_sub_gen /* Some subs defined here. */
+ ? (PERLDB_LINE || PERLDB_SAVESRC)
+ : PERLDB_SAVESRC_NOSUBS) {
+@@ -4037,7 +4043,9 @@ PP(pp_entereval)
+ char *const safestr = savepvn(tmpbuf, len);
+ SAVEDELETE(PL_defstash, safestr, len);
+ }
+- return DOCATCH(PL_eval_start);
++ ret = DOCATCH(PL_eval_start);
++ PL_eval_start = NULL;
++ return ret;
+ } else {
+ /* We have already left the scope set up earlier thanks to the LEAVE
+ in doeval(). */
diff --git a/debian/patches/fixes/regcomp_fix_segv.diff b/debian/patches/fixes/regcomp_fix_segv.diff
new file mode 100644
index 0000000..b941932
--- /dev/null
+++ b/debian/patches/fixes/regcomp_fix_segv.diff
@@ -0,0 +1,47 @@
+From 356ca08fba8dbd2ef6fbf5e09ac7d438887fbc61 Mon Sep 17 00:00:00 2001
+From: David Mitchell <da...@iabyn.com>
+Date: Tue, 5 Jul 2011 11:35:08 +0100
+Subject: fix segv in regcomp.c:S_join_exact()
+
+[ cherry-picked from bb789b09de07edfb74477eb1603949c96d60927d
+to stop clang's address-sanitizer from complaining. See [perl #115994] ]
+
+This function joins multiple EXACT* nodes into a single node.
+At the end, under DEBUGGING, it marks the optimised-out nodes as being
+type OPTIMIZED. However, some of the 'nodes' aren't actually nodes;
+they're random bits of string at the tail of those nodes. So you
+can't peek that the 'node's OP field to decide what type it was.
+
+Instead, just unconditionally overwrite all the slots with fake
+OPTIMIZED nodes.
+
+Bug: https://rt.perl.org/rt3//Ticket/Display.html?id=115994
+Origin: http://perl5.git.perl.org/perl.git/commit/ebb390a3767eb21f1f35d77eb92061bd48850a9e
+Patch-Name: fixes/regcomp_fix_segv.diff
+---
+ regcomp.c | 10 +++++-----
+ 1 file changed, 5 insertions(+), 5 deletions(-)
+
+diff --git a/regcomp.c b/regcomp.c
+index b186c8d..b30e3bc 100644
+--- a/regcomp.c
++++ b/regcomp.c
+@@ -2647,13 +2647,13 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags
+ }
+
+ #ifdef DEBUGGING
+- /* Allow dumping */
++ /* Allow dumping but overwriting the collection of skipped
++ * ops and/or strings with fake optimized ops */
+ n = scan + NODE_SZ_STR(scan);
+ while (n <= stop) {
+- if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
+- OP(n) = OPTIMIZED;
+- NEXT_OFF(n) = 0;
+- }
++ OP(n) = OPTIMIZED;
++ FLAGS(n) = 0;
++ NEXT_OFF(n) = 0;
+ n++;
+ }
+ #endif
diff --git a/debian/patches/fixes/sdbm_off_by_one.diff b/debian/patches/fixes/sdbm_off_by_one.diff
new file mode 100644
index 0000000..7a7ce34
--- /dev/null
+++ b/debian/patches/fixes/sdbm_off_by_one.diff
@@ -0,0 +1,61 @@
+From 2a6361c589c39bc3124e49360b54224d89f41fff Mon Sep 17 00:00:00 2001
+From: Reini Urban <rur...@x-ray.at>
+Date: Fri, 9 Mar 2012 09:11:50 -0600
+Subject: sdbm.c: fix off-by-one access to global ".dir"
+
+Detected by clang -faddress-sanitizer.
+
+The bug came in 081f72ad6fa2b76e0b3cd9046371b2dbd9130114, where
+we started calculating lengths with sizeof on string constants
+instead of using strlen. Since string constants include the null
+byte, sizeof(".dir"), for example, is 5, but we've been copying 6
+bytes.
+
+This patch resolves [perl #111586] and includes revisions by the
+committer.
+
+Bug: https://rt.perl.org/rt3//Ticket/Display.html?id=111586
+Origin: http://perl5.git.perl.org/perl.git/commit/7f5f08b152bb9d0c88efd1dd0f70d45e427efe1c
+Patch-Name: fixes/sdbm_off_by_one.diff
+---
+ ext/SDBM_File/sdbm/sdbm.c | 14 +++++++-------
+ 1 file changed, 7 insertions(+), 7 deletions(-)
+
+diff --git a/ext/SDBM_File/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c
+index c554e52..46be83e 100644
+--- a/ext/SDBM_File/sdbm/sdbm.c
++++ b/ext/SDBM_File/sdbm/sdbm.c
+@@ -78,8 +78,8 @@ sdbm_open(register char *file, register int flags, register int mode)
+ register char *dirname;
+ register char *pagname;
+ size_t filelen;
+- const size_t dirfext_len = sizeof(DIRFEXT "");
+- const size_t pagfext_len = sizeof(PAGFEXT "");
++ const size_t dirfext_size = sizeof(DIRFEXT "");
++ const size_t pagfext_size = sizeof(PAGFEXT "");
+
+ if (file == NULL || !*file)
+ return errno = EINVAL, (DBM *) NULL;
+@@ -88,17 +88,17 @@ sdbm_open(register char *file, register int flags, register int mode)
+ */
+ filelen = strlen(file);
+
+- if ((dirname = (char *) malloc(filelen + dirfext_len + 1
+- + filelen + pagfext_len + 1)) == NULL)
++ if ((dirname = (char *) malloc(filelen + dirfext_size
++ + filelen + pagfext_size)) == NULL)
+ return errno = ENOMEM, (DBM *) NULL;
+ /*
+ * build the file names
+ */
+ memcpy(dirname, file, filelen);
+- memcpy(dirname + filelen, DIRFEXT, dirfext_len + 1);
+- pagname = dirname + filelen + dirfext_len + 1;
++ memcpy(dirname + filelen, DIRFEXT, dirfext_size);
++ pagname = dirname + filelen + dirfext_size;
+ memcpy(pagname, file, filelen);
+- memcpy(pagname + filelen, PAGFEXT, pagfext_len + 1);
++ memcpy(pagname + filelen, PAGFEXT, pagfext_size);
+
+ db = sdbm_prep(dirname, pagname, flags, mode);
+ free((char *) dirname);
diff --git a/debian/patches/fixes/socket_unpack_sockaddr_un_heap_buffer_overflow.diff b/debian/patches/fixes/socket_unpack_sockaddr_un_heap_buffer_overflow.diff
new file mode 100644
index 0000000..ddd0259
--- /dev/null
+++ b/debian/patches/fixes/socket_unpack_sockaddr_un_heap_buffer_overflow.diff
@@ -0,0 +1,51 @@
+From 30c39051fabf7d1111a2c55f5665c8bea679d19f Mon Sep 17 00:00:00 2001
+From: David Mitchell <da...@iabyn.com>
+Date: Sun, 24 Feb 2013 16:46:19 +0000
+Subject: Socket::unpack_sockaddr_un heap-buffer-overflow
+
+[perl #111594]
+
+A (fairly harmless) read buffer overflow can occur when copying sockaddr
+buffers. Cherry-pick the fix from Socket 2.009 to keep ASAN happy.
+
+Bug: https://rt.perl.org/rt3//Ticket/Display.html?id=111594
+Origin: http://perl5.git.perl.org/perl.git/commit/e5086424505dcbfc5e26aeb984b769ecf5ffed01
+Patch-Name: fixes/socket_unpack_sockaddr_un_heap_buffer_overflow.diff
+---
+ ext/Socket/Socket.xs | 18 +++++++++++-------
+ 1 file changed, 11 insertions(+), 7 deletions(-)
+
+diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs
+index 9214fc1..e5abb71 100644
+--- a/ext/Socket/Socket.xs
++++ b/ext/Socket/Socket.xs
+@@ -557,18 +557,22 @@ unpack_sockaddr_un(sun_sv)
+ STRLEN sockaddrlen;
+ char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
+ int addr_len;
+-# ifndef __linux__
++# ifdef __linux__
+ /* On Linux sockaddrlen on sockets returned by accept, recvfrom,
+ getpeername and getsockname is not equal to sizeof(addr). */
+- if (sockaddrlen != sizeof(addr)) {
+- croak("Bad arg length for %s, length is %d, should be %d",
+- "Socket::unpack_sockaddr_un",
+- sockaddrlen, sizeof(addr));
++ if (sockaddrlen < sizeof(addr)) {
++ Copy(sun_ad, &addr, sockaddrlen, char);
++ Zero(((char*)&addr) + sockaddrlen, sizeof(addr) - sockaddrlen, char);
++ } else {
++ Copy(sun_ad, &addr, sizeof(addr), char);
+ }
++# else
++ if (sockaddrlen != sizeof(addr))
++ croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
++ "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)sizeof(addr));
++ Copy(sun_ad, &addr, sizeof(addr), char);
+ # endif
+
+- Copy( sun_ad, &addr, sizeof addr, char );
+-
+ if ( addr.sun_family != AF_UNIX ) {
+ croak("Bad address family for %s, got %d, should be %d",
+ "Socket::unpack_sockaddr_un",
diff --git a/debian/patches/series b/debian/patches/series
index bdf49b8..2c15b2e 100644
--- a/debian/patches/series
+++ b/debian/patches/series
@@ -81,3 +81,8 @@ fixes/encode-memleak.diff
fixes/threads_shared_elements_crash.diff
fixes/perlbug-patchlist.diff
fixes/digest_sha_double_free.diff
+fixes/pl_eval_start_use_after_free.diff
+fixes/regcomp_fix_segv.diff
+fixes/list_util_off_by_two.diff
+fixes/sdbm_off_by_one.diff
+fixes/socket_unpack_sockaddr_un_heap_buffer_overflow.diff
diff --git a/ext/SDBM_File/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c
index c554e52..46be83e 100644
--- a/ext/SDBM_File/sdbm/sdbm.c
+++ b/ext/SDBM_File/sdbm/sdbm.c
@@ -78,8 +78,8 @@ sdbm_open(register char *file, register int flags, register int mode)
register char *dirname;
register char *pagname;
size_t filelen;
- const size_t dirfext_len = sizeof(DIRFEXT "");
- const size_t pagfext_len = sizeof(PAGFEXT "");
+ const size_t dirfext_size = sizeof(DIRFEXT "");
+ const size_t pagfext_size = sizeof(PAGFEXT "");
if (file == NULL || !*file)
return errno = EINVAL, (DBM *) NULL;
@@ -88,17 +88,17 @@ sdbm_open(register char *file, register int flags, register int mode)
*/
filelen = strlen(file);
- if ((dirname = (char *) malloc(filelen + dirfext_len + 1
- + filelen + pagfext_len + 1)) == NULL)
+ if ((dirname = (char *) malloc(filelen + dirfext_size
+ + filelen + pagfext_size)) == NULL)
return errno = ENOMEM, (DBM *) NULL;
/*
* build the file names
*/
memcpy(dirname, file, filelen);
- memcpy(dirname + filelen, DIRFEXT, dirfext_len + 1);
- pagname = dirname + filelen + dirfext_len + 1;
+ memcpy(dirname + filelen, DIRFEXT, dirfext_size);
+ pagname = dirname + filelen + dirfext_size;
memcpy(pagname, file, filelen);
- memcpy(pagname + filelen, PAGFEXT, pagfext_len + 1);
+ memcpy(pagname + filelen, PAGFEXT, pagfext_size);
db = sdbm_prep(dirname, pagname, flags, mode);
free((char *) dirname);
diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs
index 9214fc1..e5abb71 100644
--- a/ext/Socket/Socket.xs
+++ b/ext/Socket/Socket.xs
@@ -557,18 +557,22 @@ unpack_sockaddr_un(sun_sv)
STRLEN sockaddrlen;
char * sun_ad = SvPVbyte(sun_sv,sockaddrlen);
int addr_len;
-# ifndef __linux__
+# ifdef __linux__
/* On Linux sockaddrlen on sockets returned by accept, recvfrom,
getpeername and getsockname is not equal to sizeof(addr). */
- if (sockaddrlen != sizeof(addr)) {
- croak("Bad arg length for %s, length is %d, should be %d",
- "Socket::unpack_sockaddr_un",
- sockaddrlen, sizeof(addr));
+ if (sockaddrlen < sizeof(addr)) {
+ Copy(sun_ad, &addr, sockaddrlen, char);
+ Zero(((char*)&addr) + sockaddrlen, sizeof(addr) - sockaddrlen, char);
+ } else {
+ Copy(sun_ad, &addr, sizeof(addr), char);
}
+# else
+ if (sockaddrlen != sizeof(addr))
+ croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf,
+ "Socket::unpack_sockaddr_un", (UV)sockaddrlen, (UV)sizeof(addr));
+ Copy(sun_ad, &addr, sizeof(addr), char);
# endif
- Copy( sun_ad, &addr, sizeof addr, char );
-
if ( addr.sun_family != AF_UNIX ) {
croak("Bad address family for %s, got %d, should be %d",
"Socket::unpack_sockaddr_un",
diff --git a/pp_ctl.c b/pp_ctl.c
index cbeeeee..615b82e 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3088,6 +3088,7 @@ Perl_sv_compile_2op_is_broken(pTHX_ SV *sv, OP **startop, const char *code,
CV* runcv = NULL; /* initialise to avoid compiler warnings */
STRLEN len;
bool need_catch;
+ OP* ret;
PERL_ARGS_ASSERT_SV_COMPILE_2OP_IS_BROKEN;
@@ -3182,7 +3183,9 @@ Perl_sv_compile_2op_is_broken(pTHX_ SV *sv, OP **startop, const char *code,
PERL_UNUSED_VAR(newsp);
PERL_UNUSED_VAR(optype);
- return PL_eval_start;
+ ret = PL_eval_start;
+ PL_eval_start = NULL;
+ return ret;
}
@@ -3903,8 +3906,10 @@ PP(pp_require)
encoding = PL_encoding;
PL_encoding = NULL;
- if (doeval(gimme, NULL, NULL, PL_curcop->cop_seq))
+ if (doeval(gimme, NULL, NULL, PL_curcop->cop_seq)) {
op = DOCATCH(PL_eval_start);
+ PL_eval_start = NULL;
+ }
else
op = PL_op->op_next;
@@ -4029,6 +4034,7 @@ PP(pp_entereval)
PUTBACK;
if (doeval(gimme, NULL, runcv, seq)) {
+ OP *ret;
if (was != PL_breakable_sub_gen /* Some subs defined here. */
? (PERLDB_LINE || PERLDB_SAVESRC)
: PERLDB_SAVESRC_NOSUBS) {
@@ -4037,7 +4043,9 @@ PP(pp_entereval)
char *const safestr = savepvn(tmpbuf, len);
SAVEDELETE(PL_defstash, safestr, len);
}
- return DOCATCH(PL_eval_start);
+ ret = DOCATCH(PL_eval_start);
+ PL_eval_start = NULL;
+ return ret;
} else {
/* We have already left the scope set up earlier thanks to the LEAVE
in doeval(). */
diff --git a/regcomp.c b/regcomp.c
index b186c8d..b30e3bc 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -2647,13 +2647,13 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, I32 *min, U32 flags
}
#ifdef DEBUGGING
- /* Allow dumping */
+ /* Allow dumping but overwriting the collection of skipped
+ * ops and/or strings with fake optimized ops */
n = scan + NODE_SZ_STR(scan);
while (n <= stop) {
- if (PL_regkind[OP(n)] != NOTHING || OP(n) == NOTHING) {
- OP(n) = OPTIMIZED;
- NEXT_OFF(n) = 0;
- }
+ OP(n) = OPTIMIZED;
+ FLAGS(n) = 0;
+ NEXT_OFF(n) = 0;
n++;
}
#endif
