pkgsrc-Changes-HG archive
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index][Old Index]
[pkgsrc/trunk]: pkgsrc/lang/perl5 Patch for issue raised in Russ Cox's "Glob ...
details: https://anonhg.NetBSD.org/pkgsrc/rev/4db8519cdbb8
branches: trunk
changeset: 361912:4db8519cdbb8
user: sevan <sevan%pkgsrc.org@localhost>
date: Fri Apr 28 22:59:48 2017 +0000
description:
Patch for issue raised in Russ Cox's "Glob Matching Can Be Simple And Fast Too" post.
https://research.swtch.com/glob
https://perl5.git.perl.org/perl.git/commit/33252c318625f3c6c89b816ee88481940e3e6f95
Reviewed by: wiz
diffstat:
lang/perl5/Makefile.common | 3 +-
lang/perl5/distinfo | 5 +-
lang/perl5/patches/patch-MANIFEST | 16 +++
lang/perl5/patches/patch-ext_File-Glob_bsd_glob.c | 89 +++++++++++++++++
lang/perl5/patches/patch-ext_File-Glob_t_rt131211.t | 103 ++++++++++++++++++++
5 files changed, 214 insertions(+), 2 deletions(-)
diffs (260 lines):
diff -r 65b0356ac3eb -r 4db8519cdbb8 lang/perl5/Makefile.common
--- a/lang/perl5/Makefile.common Fri Apr 28 20:00:22 2017 +0000
+++ b/lang/perl5/Makefile.common Fri Apr 28 22:59:48 2017 +0000
@@ -1,9 +1,10 @@
-# $NetBSD: Makefile.common,v 1.28 2017/01/27 09:39:40 adam Exp $
+# $NetBSD: Makefile.common,v 1.29 2017/04/28 22:59:48 sevan Exp $
#
# used by lang/perl5/Makefile
# used by databases/p5-gdbm/Makefile
DISTNAME= perl-5.24.1
+PKGREVISION= 1
CATEGORIES= lang devel perl5
MASTER_SITES= ${MASTER_SITE_PERL_CPAN:S,/modules/by-module/$,/src/5.0/,}
DISTFILES+= ${DISTNAME}${EXTRACT_SUFX}
diff -r 65b0356ac3eb -r 4db8519cdbb8 lang/perl5/distinfo
--- a/lang/perl5/distinfo Fri Apr 28 20:00:22 2017 +0000
+++ b/lang/perl5/distinfo Fri Apr 28 22:59:48 2017 +0000
@@ -1,10 +1,11 @@
-$NetBSD: distinfo,v 1.139 2017/01/27 09:39:40 adam Exp $
+$NetBSD: distinfo,v 1.140 2017/04/28 22:59:48 sevan Exp $
SHA1 (perl-5.24.1.tar.bz2) = d43ac3d39686462f86eed35b3c298ace74f1ffa0
RMD160 (perl-5.24.1.tar.bz2) = e824cb74998ebbbc3286fa353e64e75104d4c5b1
SHA512 (perl-5.24.1.tar.bz2) = 5a6e5f5fcd65e7add7ba2126d530a8e2a912cb076cfe61bbf7e49b28e4e63aa0d474183a6f8a388c67d03ea6a44f367efb3b3a768e971ef52b769e737eeb048b
Size (perl-5.24.1.tar.bz2) = 14088312 bytes
SHA1 (patch-Configure) = 13455c1b32b0f602b339787af4ddcd481f9c2dd5
+SHA1 (patch-MANIFEST) = 7037a7a1881da3d2db03d4a5d6a61a7a6d3bc11b
SHA1 (patch-Makefile.SH) = 32ffc30831b0af49f90119510021037b066367dc
SHA1 (patch-aa) = 9bbcc9395080b11934528a32808e0a509f1d831c
SHA1 (patch-ab) = c899b7221a78e74cc9b1480834baba047dd19f38
@@ -17,6 +18,8 @@
SHA1 (patch-dist_Carp_lib_Carp.pm) = fb628ee983462cec9303ceea09852378ec654ecf
SHA1 (patch-dist_Time-HiRes_HiRes.xs) = 067911a23881d48d2ad431076b3babeb585b83d7
SHA1 (patch-ext_Errno_Errno__pm.PL) = 4f135e267da17de38f8f1e7e03d5209bfd09a323
+SHA1 (patch-ext_File-Glob_bsd_glob.c) = e43252b55f04bb1cd69d48e8155aa110532c9fbe
+SHA1 (patch-ext_File-Glob_t_rt131211.t) = 9aeddad078cdc920e64ed2e73f952be341745d7e
SHA1 (patch-ext_XS-APItest_Makefile.PL) = 7094aa4cb021c1f29054a40c4f5f4c15c59f13de
SHA1 (patch-hints_cygwin.sh) = 1b21d927d6b7379754c4cd64a2b05d3632c35470
SHA1 (patch-hints_netbsd.sh) = 0d549a48800372d75fe34b783529a78cba90f646
diff -r 65b0356ac3eb -r 4db8519cdbb8 lang/perl5/patches/patch-MANIFEST
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lang/perl5/patches/patch-MANIFEST Fri Apr 28 22:59:48 2017 +0000
@@ -0,0 +1,16 @@
+$NetBSD: patch-MANIFEST,v 1.1 2017/04/28 22:59:48 sevan Exp $
+
+[perl #131211] fixup File::Glob degenerate matching
+https://research.swtch.com/glob
+https://perl5.git.perl.org/perl.git/commit/33252c318625f3c6c89b816ee88481940e3e6f95
+
+--- MANIFEST.orig 2017-04-28 18:35:00.000000000 +0000
++++ MANIFEST
+@@ -3706,6 +3706,7 @@ ext/File-Glob/t/case.t See if File::Glo
+ ext/File-Glob/t/global.t See if File::Glob works
+ ext/File-Glob/TODO File::Glob extension todo list
+ ext/File-Glob/t/rt114984.t See if File::Glob works
++ext/File-Glob/t/rt131211.t See if File::Glob works
+ ext/File-Glob/t/taint.t See if File::Glob works
+ ext/File-Glob/t/threads.t See if File::Glob + threads works
+ ext/GDBM_File/GDBM_File.pm GDBM extension Perl module
diff -r 65b0356ac3eb -r 4db8519cdbb8 lang/perl5/patches/patch-ext_File-Glob_bsd_glob.c
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lang/perl5/patches/patch-ext_File-Glob_bsd_glob.c Fri Apr 28 22:59:48 2017 +0000
@@ -0,0 +1,89 @@
+$NetBSD: patch-ext_File-Glob_bsd_glob.c,v 1.1 2017/04/28 22:59:48 sevan Exp $
+
+[perl #131211] fixup File::Glob degenerate matching
+https://research.swtch.com/glob
+https://perl5.git.perl.org/perl.git/commit/33252c318625f3c6c89b816ee88481940e3e6f95
+
+--- ext/File-Glob/bsd_glob.c.orig 2017-04-28 18:41:33.000000000 +0000
++++ ext/File-Glob/bsd_glob.c
+@@ -911,33 +911,43 @@ globextend(const Char *path, glob_t *pgl
+ /*
+ * pattern matching function for filenames. Each occurrence of the *
+ * pattern causes a recursion level.
++ *
++ * Note, this function differs from the original as per the discussion
++ * here: https://research.swtch.com/glob
++ *
++ * Basically we removed the recursion and made it use the algorithm
++ * from Russ Cox to not go quadratic on cases like a file called ("a" x 100) . "x"
++ * matched against a pattern like "a*a*a*a*a*a*a*y".
++ *
+ */
+ static int
+ match(Char *name, Char *pat, Char *patend, int nocase)
+ {
+ int ok, negate_range;
+ Char c, k;
++ Char *nextp = NULL;
++ Char *nextn = NULL;
+
++ loop:
+ while (pat < patend) {
+ c = *pat++;
+ switch (c & M_MASK) {
+ case M_ALL:
+ if (pat == patend)
+ return(1);
+- do
+- if (match(name, pat, patend, nocase))
+- return(1);
+- while (*name++ != BG_EOS)
+- ;
+- return(0);
++ if (*name == BG_EOS)
++ return 0;
++ nextn = name + 1;
++ nextp = pat - 1;
++ break;
+ case M_ONE:
+ if (*name++ == BG_EOS)
+- return(0);
++ goto fail;
+ break;
+ case M_SET:
+ ok = 0;
+ if ((k = *name++) == BG_EOS)
+- return(0);
++ goto fail;
+ if ((negate_range = ((*pat & M_MASK) == M_NOT)) != BG_EOS)
+ ++pat;
+ while (((c = *pat++) & M_MASK) != M_END)
+@@ -953,16 +963,25 @@ match(Char *name, Char *pat, Char *paten
+ } else if (nocase ? (tolower(c) == tolower(k)) : (c == k))
+ ok = 1;
+ if (ok == negate_range)
+- return(0);
++ goto fail;
+ break;
+ default:
+ k = *name++;
+ if (nocase ? (tolower(k) != tolower(c)) : (k != c))
+- return(0);
++ goto fail;
+ break;
+ }
+ }
+- return(*name == BG_EOS);
++ if (*name == BG_EOS)
++ return 1;
++
++ fail:
++ if (nextn) {
++ pat = nextp;
++ name = nextn;
++ goto loop;
++ }
++ return 0;
+ }
+
+ /* Free allocated data belonging to a glob_t structure. */
diff -r 65b0356ac3eb -r 4db8519cdbb8 lang/perl5/patches/patch-ext_File-Glob_t_rt131211.t
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lang/perl5/patches/patch-ext_File-Glob_t_rt131211.t Fri Apr 28 22:59:48 2017 +0000
@@ -0,0 +1,103 @@
+$NetBSD: patch-ext_File-Glob_t_rt131211.t,v 1.1 2017/04/28 22:59:48 sevan Exp $
+
+[perl #131211] fixup File::Glob degenerate matching
+https://research.swtch.com/glob
+https://perl5.git.perl.org/perl.git/commit/33252c318625f3c6c89b816ee88481940e3e6f95
+
+--- ext/File-Glob/t/rt131211.t.orig 2017-04-28 18:37:15.000000000 +0000
++++ ext/File-Glob/t/rt131211.t
+@@ -0,0 +1,94 @@
++use strict;
++use warnings;
++use v5.16.0;
++use File::Temp 'tempdir';
++use File::Spec::Functions;
++use Test::More;
++use Time::HiRes qw(time);
++
++plan tests => 13;
++
++my $path = tempdir uc cleanup => 1;
++my @files= (
++ "x".("a" x 50)."b", # 0
++ "abbbbbbbbbbbbc", # 1
++ "abbbbbbbbbbbbd", # 2
++ "aaabaaaabaaaabc", # 3
++ "pq", # 4
++ "r", # 5
++ "rttiiiiiii", # 6
++ "wewewewewewe", # 7
++ "weeeweeeweee", # 8
++ "weewweewweew", # 9
++ "wewewewewewewewewewewewewewewewewq", # 10
++ "wtttttttetttttttwr", # 11
++);
++
++
++foreach (@files) {
++ open(my $f, ">", catfile $path, $_);
++}
++
++my $elapsed_fail= 0;
++my $elapsed_match= 0;
++my @got_files;
++my @no_files;
++my $count = 0;
++
++while (++$count < 10) {
++ $elapsed_match -= time;
++ @got_files= glob catfile $path, "x".("a*" x $count) . "b";
++ $elapsed_match += time;
++
++ $elapsed_fail -= time;
++ @no_files= glob catfile $path, "x".("a*" x $count) . "c";
++ $elapsed_fail += time;
++ last if $elapsed_fail > $elapsed_match * 100;
++}
++
++is $count,10,
++ "tried all the patterns without bailing out";
++
++cmp_ok $elapsed_fail/$elapsed_match,"<",2,
++ "time to fail less than twice the time to match";
++is "@got_files", catfile($path, $files[0]),
++ "only got the expected file for xa*..b";
++is "@no_files", "", "shouldnt have files for xa*..c";
++
++
++@got_files= glob catfile $path, "a*b*b*b*bc";
++is "@got_files", catfile($path, $files[1]),
++ "only got the expected file for a*b*b*b*bc";
++
++@got_files= sort glob catfile $path, "a*b*b*bc";
++is "@got_files", catfile($path, $files[3])." ".catfile($path,$files[1]),
++ "got the expected two files for a*b*b*bc";
++
++@got_files= sort glob catfile $path, "p*";
++is "@got_files", catfile($path, $files[4]),
++ "p* matches pq";
++
++@got_files= sort glob catfile $path, "r*???????";
++is "@got_files", catfile($path, $files[6]),
++ "r*??????? works as expected";
++
++@got_files= sort glob catfile $path, "w*e*w??e";
++is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8)),
++ "w*e*w??e works as expected";
++
++@got_files= sort glob catfile $path, "w*e*we??";
++is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8,9,10)),
++ "w*e*we?? works as expected";
++
++@got_files= sort glob catfile $path, "w**e**w";
++is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (9)),
++ "w**e**w works as expected";
++
++@got_files= sort glob catfile $path, "*wee*";
++is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (8,9)),
++ "*wee* works as expected";
++
++@got_files= sort glob catfile $path, "we*";
++is "@got_files", join(" ", sort map { catfile($path, $files[$_]) } (7,8,9,10)),
++ "we* works as expected";
++
Home |
Main Index |
Thread Index |
Old Index