view release on metacpan or  search on metacpan

lib/Devel/PatchPerl.pm  view on Meta::CPAN

         if (UTF8_IS_INVARIANT(c) || (! utf8_target && ! is_utf8_pat)) {
-            if (utf8_target && scan + max < loceol) {
+            if (utf8_target && loceol - scan > max) {
                 /* We didn't adjust <loceol> because is UTF-8, but ok to do so,
                  * since here, to match at all, 1 char == 1 byte */
                 loceol = scan + max;
@@ -6910,7 +6910,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
         /* FALLTHROUGH */
 
     case POSIXA:
-        if (utf8_target && scan + max < loceol) {
+        if (utf8_target && loceol - scan > max) {
 
             /* We didn't adjust <loceol> at the beginning of this routine
              * because is UTF-8, but it is actually ok to do so, since here, to
diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
index 2244fdf..9a9b5f5 100644
--- t/re/pat_rt_report.t
+++ t/re/pat_rt_report.t
@@ -22,7 +22,7 @@ BEGIN {
 }
 
 
-plan tests => 2530;  # Update this when adding/deleting tests.
+plan tests => 2532;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -1158,6 +1158,21 @@ EOP
             '$_ = "abc"; /b/g; $_ = "hello"; print eval q|$\'|,"\n"',
             "c\n", {}, '$\' first mentioned after match');
     }
+
+    {
+	# [perl #118175] threaded perl-5.18.0 fails pat_rt_report_thr.t
+	# this tests some related failures
+	#
+	# The tests in the block *only* fail when run on 32-bit systems
+	# with a malloc that allocates above the 2GB line.  On the system
+	# in the report above that only happened in a thread.
+	my $s = "\x{1ff}" . "f" x 32;
+	ok($s =~ /\x{1ff}[[:alpha:]]+/gca, "POSIXA pointer wrap");
+
+	# this one segfaulted under the conditions above
+	# of course, CANY is evil, maybe it should crash
+	ok($s =~ /.\C+/, "CANY pointer wrap");
+    }
 } # End of sub run_tests
 
 1;
BOBBLE
}

sub _patch_makefile_sh_phony {
  _patch(<<'END');
diff --git a/Makefile.SH b/Makefile.SH
index ac5ade4..8e66603 100755
--- Makefile.SH
+++ Makefile.SH
@@ -295,6 +295,30 @@ obj = $(obj1) $(obj2) $(obj3) $(ARCHOBJS)
 # EMBEDDING is on by default, and MULTIPLICITY doesn't work.
 #

+.PHONY: all compile translators utilities \
+       FORCE \
+       preplibrary \
+       install install-strip install-all install-verbose install-silent \
+       no-install install.perl install.man installman install.html installhtml \
+       check_byacc run_byacc \
+       regen_headers regen_pods regen_all \
+       clean _tidy _mopup _cleaner1 _cleaner2 \
+       realclean _realcleaner clobber _clobber \
+       distclean veryclean _verycleaner \
+       lint \
+       depend \
+       test check test_prep _test_prep \
+       test_tty test-tty _test_tty test_notty test-notty _test_notty \
+       utest ucheck test.utf8 check.utf8 \
+       test.third check.third utest.third ucheck.third test_notty.third \
+       test.deparse test_notty.deparse \
+       minitest \
+       ok okfile oknack okfilenack nok nokfile noknack nokfilenack \
+       clist hlist shlist pllist \
+       distcheck \
+       elc \
+       etags ctags tags
+
 lintflags = -hbvxac

 .c$(OBJ_EXT):
END
}

sub _patch_cow_speed {
  _patch(<<'COWSAY');
diff --git a/sv.c b/sv.c
index 06c0b83..ac1d972 100644
--- sv.c
+++ sv.c
@@ -1574,14 +1574,19 @@ Perl_sv_grow(pTHX_ SV *const sv, STRLEN newlen)
         newlen++;
 #endif
 
+#if defined(PERL_USE_MALLOC_SIZE) && defined(Perl_safesysmalloc_size)
+#define PERL_UNWARANTED_CHUMMINESS_WITH_MALLOC
+#endif
+
     if (newlen > SvLEN(sv)) {		/* need more room? */
 	STRLEN minlen = SvCUR(sv);
 	minlen += (minlen >> PERL_STRLEN_EXPAND_SHIFT) + 10;
 	if (newlen < minlen)
 	    newlen = minlen;
-#ifndef Perl_safesysmalloc_size
-        if (SvLEN(sv))
+#ifndef PERL_UNWARANTED_CHUMMINESS_WITH_MALLOC
+        if (SvLEN(sv)) {
             newlen = PERL_STRLEN_ROUNDUP(newlen);
+        }
 #endif
 	if (SvLEN(sv) && s) {
 	    s = (char*)saferealloc(s, newlen);