Remove old patches.
This commit is contained in:
parent
9ad077dcb4
commit
dafa5369fe
@ -1,12 +0,0 @@
|
|||||||
diff -up perl-5.10.0/lib/Net/Config.pm.disable_test_hosts perl-5.10.0/lib/Net/Config.pm
|
|
||||||
--- perl-5.10.0/lib/Net/Config.pm.disable_test_hosts 2007-12-21 11:41:12.000000000 -0500
|
|
||||||
+++ perl-5.10.0/lib/Net/Config.pm 2007-12-21 11:41:20.000000000 -0500
|
|
||||||
@@ -29,7 +29,7 @@ eval { local $SIG{__DIE__}; require Net:
|
|
||||||
ftp_firewall => undef,
|
|
||||||
ftp_ext_passive => 1,
|
|
||||||
ftp_int_passive => 1,
|
|
||||||
- test_hosts => 1,
|
|
||||||
+ test_hosts => 0,
|
|
||||||
test_exist => 1,
|
|
||||||
);
|
|
||||||
|
|
@ -1,59 +0,0 @@
|
|||||||
diff -up perl-5.10.0/perl.c.BAD perl-5.10.0/perl.c
|
|
||||||
--- perl-5.10.0/perl.c.BAD 2009-03-09 09:55:05.000000000 -0400
|
|
||||||
+++ perl-5.10.0/perl.c 2009-03-09 10:00:41.000000000 -0400
|
|
||||||
@@ -4753,9 +4753,6 @@ S_init_perllib(pTHX)
|
|
||||||
incpush(APPLLIB_EXP, TRUE, TRUE, TRUE, TRUE);
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-#ifdef ARCHLIB_EXP
|
|
||||||
- incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE);
|
|
||||||
-#endif
|
|
||||||
#ifdef MACOS_TRADITIONAL
|
|
||||||
{
|
|
||||||
Stat_t tmpstatbuf;
|
|
||||||
@@ -4764,6 +4761,10 @@ S_init_perllib(pTHX)
|
|
||||||
|
|
||||||
if (!macperl)
|
|
||||||
macperl = "";
|
|
||||||
+
|
|
||||||
+#ifdef ARCHLIB_EXP
|
|
||||||
+ incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE);
|
|
||||||
+#endif
|
|
||||||
|
|
||||||
Perl_sv_setpvf(aTHX_ privdir, "%slib:", macperl);
|
|
||||||
if (PerlLIO_stat(SvPVX(privdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode))
|
|
||||||
@@ -4777,14 +4778,6 @@ S_init_perllib(pTHX)
|
|
||||||
if (!PL_tainting)
|
|
||||||
incpush(":", FALSE, FALSE, TRUE, FALSE);
|
|
||||||
#else
|
|
||||||
-#ifndef PRIVLIB_EXP
|
|
||||||
-# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
|
|
||||||
-#endif
|
|
||||||
-#if defined(WIN32)
|
|
||||||
- incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE, TRUE);
|
|
||||||
-#else
|
|
||||||
- incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, TRUE);
|
|
||||||
-#endif
|
|
||||||
|
|
||||||
#ifdef SITEARCH_EXP
|
|
||||||
/* sitearch is always relative to sitelib on Windows for
|
|
||||||
@@ -4828,6 +4821,19 @@ S_init_perllib(pTHX)
|
|
||||||
incpush(PERL_VENDORLIB_STEM, FALSE, TRUE, TRUE, TRUE);
|
|
||||||
#endif
|
|
||||||
|
|
||||||
+#ifdef ARCHLIB_EXP
|
|
||||||
+ incpush(ARCHLIB_EXP, FALSE, FALSE, TRUE, TRUE);
|
|
||||||
+#endif
|
|
||||||
+
|
|
||||||
+#ifndef PRIVLIB_EXP
|
|
||||||
+# define PRIVLIB_EXP "/usr/local/lib/perl5:/usr/local/lib/perl"
|
|
||||||
+#endif
|
|
||||||
+#if defined(WIN32)
|
|
||||||
+ incpush(PRIVLIB_EXP, TRUE, FALSE, TRUE, TRUE);
|
|
||||||
+#else
|
|
||||||
+ incpush(PRIVLIB_EXP, FALSE, FALSE, TRUE, TRUE);
|
|
||||||
+#endif
|
|
||||||
+
|
|
||||||
#ifdef PERL_OTHERLIBDIRS
|
|
||||||
incpush(PERL_OTHERLIBDIRS, TRUE, TRUE, TRUE, TRUE);
|
|
||||||
#endif
|
|
@ -1,87 +0,0 @@
|
|||||||
diff -up perl-5.10.1/ext/re/t/regop.t.git perl-5.10.1/ext/re/t/regop.t
|
|
||||||
--- perl-5.10.1/ext/re/t/regop.t.git 2009-12-21 19:31:07.564141841 +0100
|
|
||||||
+++ perl-5.10.1/ext/re/t/regop.t 2009-12-21 19:31:55.158142088 +0100
|
|
||||||
@@ -233,12 +233,12 @@ anchored "ABC" at 0
|
|
||||||
#Freeing REx: "(\\.COM|\\.EXE|\\.BAT|\\.CMD|\\.VBS|\\.VBE|\\.JS|\\.JSE|\\."......
|
|
||||||
%MATCHED%
|
|
||||||
floating ""$ at 3..4 (checking floating)
|
|
||||||
-1:1[1] 3:2[1] 5:2[64] 45:83[1] 47:84[1] 48:85[0]
|
|
||||||
-stclass EXACTF <.> minlen 3
|
|
||||||
-Found floating substr ""$ at offset 30...
|
|
||||||
-Does not contradict STCLASS...
|
|
||||||
-Guessed: match at offset 26
|
|
||||||
-Matching stclass EXACTF <.> against ".exe"
|
|
||||||
+#1:1[1] 3:2[1] 5:2[64] 45:83[1] 47:84[1] 48:85[0]
|
|
||||||
+#stclass EXACTF <.> minlen 3
|
|
||||||
+#Found floating substr ""$ at offset 30...
|
|
||||||
+#Does not contradict STCLASS...
|
|
||||||
+#Guessed: match at offset 26
|
|
||||||
+#Matching stclass EXACTF <.> against ".exe"
|
|
||||||
---
|
|
||||||
#Compiling REx "[q]"
|
|
||||||
#size 12 nodes Got 100 bytes for offset annotations.
|
|
||||||
@@ -258,4 +258,4 @@ Got 100 bytes for offset annotations.
|
|
||||||
Offsets: [12]
|
|
||||||
1:1[3] 3:4[0]
|
|
||||||
%MATCHED%
|
|
||||||
-Freeing REx: "[q]"
|
|
||||||
\ No newline at end of file
|
|
||||||
+Freeing REx: "[q]"
|
|
||||||
diff -up perl-5.10.1/regcomp.c.git perl-5.10.1/regcomp.c
|
|
||||||
--- perl-5.10.1/regcomp.c.git 2009-12-21 19:32:05.893141719 +0100
|
|
||||||
+++ perl-5.10.1/regcomp.c 2009-12-21 19:33:35.106141384 +0100
|
|
||||||
@@ -2820,13 +2820,16 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
/*
|
|
||||||
- Currently we assume that the trie can handle unicode and ascii
|
|
||||||
- matches fold cased matches. If this proves true then the following
|
|
||||||
- define will prevent tries in this situation.
|
|
||||||
-
|
|
||||||
- #define TRIE_TYPE_IS_SAFE (UTF || optype==EXACT)
|
|
||||||
-*/
|
|
||||||
+ Currently we do not believe that the trie logic can
|
|
||||||
+ handle case insensitive matching properly when the
|
|
||||||
+ pattern is not unicode (thus forcing unicode semantics).
|
|
||||||
+ If/when this is fixed the following define can be swapped
|
|
||||||
+ in below to fully enable trie logic.
|
|
||||||
#define TRIE_TYPE_IS_SAFE 1
|
|
||||||
+
|
|
||||||
+*/
|
|
||||||
+#define TRIE_TYPE_IS_SAFE (UTF || optype==EXACT)
|
|
||||||
+
|
|
||||||
if ( last && TRIE_TYPE_IS_SAFE ) {
|
|
||||||
make_trie( pRExC_state,
|
|
||||||
startbranch, first, cur, tail, count,
|
|
||||||
diff -up perl-5.10.1/regexec.c.git perl-5.10.1/regexec.c
|
|
||||||
--- perl-5.10.1/regexec.c.git 2009-12-21 19:33:50.570141632 +0100
|
|
||||||
+++ perl-5.10.1/regexec.c 2009-12-21 19:36:41.300142175 +0100
|
|
||||||
@@ -1006,16 +1006,15 @@ Perl_re_intuit_start(pTHX_ REGEXP * cons
|
|
||||||
|
|
||||||
#define REXEC_TRIE_READ_CHAR(trie_type, trie, widecharmap, uc, uscan, len, \
|
|
||||||
uvc, charid, foldlen, foldbuf, uniflags) STMT_START { \
|
|
||||||
- UV uvc_unfolded = 0; \
|
|
||||||
switch (trie_type) { \
|
|
||||||
case trie_utf8_fold: \
|
|
||||||
if ( foldlen>0 ) { \
|
|
||||||
- uvc_unfolded = uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags ); \
|
|
||||||
+ uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags ); \
|
|
||||||
foldlen -= len; \
|
|
||||||
uscan += len; \
|
|
||||||
len=0; \
|
|
||||||
} else { \
|
|
||||||
- uvc_unfolded = uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \
|
|
||||||
+ uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags ); \
|
|
||||||
uvc = to_uni_fold( uvc, foldbuf, &foldlen ); \
|
|
||||||
foldlen -= UNISKIP( uvc ); \
|
|
||||||
uscan = foldbuf + UNISKIP( uvc ); \
|
|
||||||
@@ -1054,9 +1053,6 @@ uvc, charid, foldlen, foldbuf, uniflags)
|
|
||||||
charid = (U16)SvIV(*svpp); \
|
|
||||||
} \
|
|
||||||
} \
|
|
||||||
- if (!charid && trie_type == trie_utf8_fold && !UTF) { \
|
|
||||||
- charid = trie->charmap[uvc_unfolded]; \
|
|
||||||
- } \
|
|
||||||
} STMT_END
|
|
||||||
|
|
||||||
#define REXEC_FBC_EXACTISH_CHECK(CoNd) \
|
|
@ -1,112 +0,0 @@
|
|||||||
2009-12-02 Stepan Kasal <skasal@redhat.com>
|
|
||||||
|
|
||||||
* add the extra symbols, even though DEBUGGING is not defined
|
|
||||||
|
|
||||||
diff -ur perl-5.10.1.orig/hv.c perl-5.10.1/hv.c
|
|
||||||
--- perl-5.10.1.orig/hv.c 2009-06-10 14:36:34.000000000 +0200
|
|
||||||
+++ perl-5.10.1/hv.c 2009-12-02 15:05:07.000000000 +0100
|
|
||||||
@@ -2926,7 +2926,7 @@
|
|
||||||
=cut
|
|
||||||
*/
|
|
||||||
|
|
||||||
-#ifdef DEBUGGING
|
|
||||||
+/* #ifdef DEBUGGING */
|
|
||||||
|
|
||||||
void
|
|
||||||
Perl_hv_assert(pTHX_ HV *hv)
|
|
||||||
@@ -2991,7 +2991,7 @@
|
|
||||||
HvEITER_set(hv, eiter);
|
|
||||||
}
|
|
||||||
|
|
||||||
-#endif
|
|
||||||
+/* #endif */
|
|
||||||
|
|
||||||
/*
|
|
||||||
* Local variables:
|
|
||||||
diff -ur perl-5.10.1.orig/makedef.pl perl-5.10.1/makedef.pl
|
|
||||||
--- perl-5.10.1.orig/makedef.pl 2009-12-02 14:42:12.000000000 +0100
|
|
||||||
+++ perl-5.10.1/makedef.pl 2009-12-02 14:42:04.000000000 +0100
|
|
||||||
@@ -617,7 +617,7 @@
|
|
||||||
)];
|
|
||||||
}
|
|
||||||
|
|
||||||
-unless ($define{'DEBUGGING'}) {
|
|
||||||
+unless (1 || $define{'DEBUGGING'}) {
|
|
||||||
skip_symbols [qw(
|
|
||||||
Perl_deb_growlevel
|
|
||||||
Perl_debop
|
|
||||||
diff -ur perl-5.10.1.orig/pad.c perl-5.10.1/pad.c
|
|
||||||
--- perl-5.10.1.orig/pad.c 2009-04-22 23:43:43.000000000 +0200
|
|
||||||
+++ perl-5.10.1/pad.c 2009-12-02 14:39:21.000000000 +0100
|
|
||||||
@@ -912,7 +912,7 @@
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
-#ifdef DEBUGGING
|
|
||||||
+/* #ifdef DEBUGGING */
|
|
||||||
/*
|
|
||||||
=for apidoc pad_sv
|
|
||||||
|
|
||||||
@@ -963,7 +963,7 @@
|
|
||||||
);
|
|
||||||
PL_curpad[po] = sv;
|
|
||||||
}
|
|
||||||
-#endif
|
|
||||||
+/* #endif */
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
diff -ur perl-5.10.1.orig/perl.h perl-5.10.1/perl.h
|
|
||||||
--- perl-5.10.1.orig/perl.h 2009-07-06 13:18:58.000000000 +0200
|
|
||||||
+++ perl-5.10.1/perl.h 2009-12-02 15:06:44.000000000 +0100
|
|
||||||
@@ -4457,7 +4457,7 @@
|
|
||||||
EXTCONST unsigned char PL_freq[];
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-#ifdef DEBUGGING
|
|
||||||
+/* #ifdef DEBUGGING */
|
|
||||||
#ifdef DOINIT
|
|
||||||
EXTCONST char* const PL_block_type[] = {
|
|
||||||
"NULL",
|
|
||||||
@@ -4473,7 +4473,7 @@
|
|
||||||
#else
|
|
||||||
EXTCONST char* PL_block_type[];
|
|
||||||
#endif
|
|
||||||
-#endif
|
|
||||||
+/* #endif */
|
|
||||||
|
|
||||||
/* These are all the compile time options that affect binary compatibility.
|
|
||||||
Other compile time options that are binary compatible are in perl.c
|
|
||||||
diff -ur perl-5.10.1.orig/perlvars.h perl-5.10.1/perlvars.h
|
|
||||||
--- perl-5.10.1.orig/perlvars.h 2009-02-12 23:58:17.000000000 +0100
|
|
||||||
+++ perl-5.10.1/perlvars.h 2009-12-02 15:10:39.000000000 +0100
|
|
||||||
@@ -112,9 +112,9 @@
|
|
||||||
PERLVARI(Gsig_trapped, int, 0)
|
|
||||||
#endif
|
|
||||||
|
|
||||||
-#ifdef DEBUGGING
|
|
||||||
+/* #ifdef DEBUGGING */
|
|
||||||
PERLVAR(Gwatch_pvx, char*)
|
|
||||||
-#endif
|
|
||||||
+/* #endif */
|
|
||||||
|
|
||||||
#ifdef PERL_GLOBAL_STRUCT
|
|
||||||
PERLVAR(Gppaddr, Perl_ppaddr_t*) /* or opcode.h */
|
|
||||||
--- perl-5.10.1/proto.h.kasal 2009-12-02 15:18:39.000000000 +0100
|
|
||||||
+++ perl-5.10.1/proto.h 2009-12-02 15:29:51.000000000 +0100
|
|
||||||
@@ -6068,13 +6068,13 @@
|
|
||||||
#define PERL_ARGS_ASSERT_PAD_CHECK_DUP \
|
|
||||||
assert(name); assert(ourstash)
|
|
||||||
|
|
||||||
-#ifdef DEBUGGING
|
|
||||||
+/* #ifdef DEBUGGING */
|
|
||||||
PERL_CALLCONV void Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
|
|
||||||
__attribute__nonnull__(pTHX_2);
|
|
||||||
#define PERL_ARGS_ASSERT_PAD_SETSV \
|
|
||||||
assert(sv)
|
|
||||||
|
|
||||||
-#endif
|
|
||||||
+/* #endif */
|
|
||||||
PERL_CALLCONV void Perl_pad_block_start(pTHX_ int full);
|
|
||||||
PERL_CALLCONV void Perl_pad_tidy(pTHX_ padtidy_type type);
|
|
||||||
PERL_CALLCONV void Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
|
|
@ -1,246 +0,0 @@
|
|||||||
Backport of commit e9105d30 in blead perl.
|
|
||||||
|
|
||||||
diff -urpN perl-5.10.1.orig/embed.fnc perl-5.10.1/embed.fnc
|
|
||||||
--- perl-5.10.1.orig/embed.fnc 2009-08-15 18:36:34.000000000 +0200
|
|
||||||
+++ perl-5.10.1/embed.fnc 2009-11-26 00:12:48.000000000 +0100
|
|
||||||
@@ -1658,7 +1658,6 @@ ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN
|
|
||||||
#endif
|
|
||||||
ERsn |U8* |reghopmaybe3 |NN U8 *s|I32 off|NN const U8 *lim
|
|
||||||
ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK regmatch_info *reginfo
|
|
||||||
-Es |void |swap_match_buff|NN regexp * prog
|
|
||||||
Es |void |to_utf8_substr |NN regexp * prog
|
|
||||||
Es |void |to_byte_substr |NN regexp * prog
|
|
||||||
ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex \
|
|
||||||
diff -urpN perl-5.10.1.orig/embed.h perl-5.10.1/embed.h
|
|
||||||
--- perl-5.10.1.orig/embed.h 2009-07-27 23:37:52.000000000 +0200
|
|
||||||
+++ perl-5.10.1/embed.h 2009-11-26 00:12:48.000000000 +0100
|
|
||||||
@@ -1452,7 +1452,6 @@
|
|
||||||
#if defined(PERL_CORE) || defined(PERL_EXT)
|
|
||||||
#define reghopmaybe3 S_reghopmaybe3
|
|
||||||
#define find_byclass S_find_byclass
|
|
||||||
-#define swap_match_buff S_swap_match_buff
|
|
||||||
#define to_utf8_substr S_to_utf8_substr
|
|
||||||
#define to_byte_substr S_to_byte_substr
|
|
||||||
#define reg_check_named_buff_matched S_reg_check_named_buff_matched
|
|
||||||
@@ -3783,7 +3782,6 @@
|
|
||||||
#if defined(PERL_CORE) || defined(PERL_EXT)
|
|
||||||
#define reghopmaybe3 S_reghopmaybe3
|
|
||||||
#define find_byclass(a,b,c,d,e) S_find_byclass(aTHX_ a,b,c,d,e)
|
|
||||||
-#define swap_match_buff(a) S_swap_match_buff(aTHX_ a)
|
|
||||||
#define to_utf8_substr(a) S_to_utf8_substr(aTHX_ a)
|
|
||||||
#define to_byte_substr(a) S_to_byte_substr(aTHX_ a)
|
|
||||||
#define reg_check_named_buff_matched(a,b) S_reg_check_named_buff_matched(aTHX_ a,b)
|
|
||||||
diff -urpN perl-5.10.1.orig/ext/Devel-PPPort/parts/embed.fnc perl-5.10.1/ext/Devel-PPPort/parts/embed.fnc
|
|
||||||
--- perl-5.10.1.orig/ext/Devel-PPPort/parts/embed.fnc 2009-07-27 23:37:52.000000000 +0200
|
|
||||||
+++ perl-5.10.1/ext/Devel-PPPort/parts/embed.fnc 2009-11-26 00:12:48.000000000 +0100
|
|
||||||
@@ -1677,7 +1677,6 @@ ERsn |U8* |reghop4 |NN U8 *s|I32 off|NN
|
|
||||||
#endif
|
|
||||||
ERsn |U8* |reghopmaybe3 |NN U8 *s|I32 off|NN const U8 *lim
|
|
||||||
ERs |char* |find_byclass |NN regexp * prog|NN const regnode *c|NN char *s|NN const char *strend|NULLOK regmatch_info *reginfo
|
|
||||||
-Es |void |swap_match_buff|NN regexp * prog
|
|
||||||
Es |void |to_utf8_substr |NN regexp * prog
|
|
||||||
Es |void |to_byte_substr |NN regexp * prog
|
|
||||||
ERs |I32 |reg_check_named_buff_matched |NN const regexp *rex \
|
|
||||||
diff -urpN perl-5.10.1.orig/pod/perlreapi.pod perl-5.10.1/pod/perlreapi.pod
|
|
||||||
--- perl-5.10.1.orig/pod/perlreapi.pod 2009-07-27 23:37:52.000000000 +0200
|
|
||||||
+++ perl-5.10.1/pod/perlreapi.pod 2009-11-26 00:12:48.000000000 +0100
|
|
||||||
@@ -598,7 +598,7 @@ engine should use something else.
|
|
||||||
|
|
||||||
=head2 C<swap>
|
|
||||||
|
|
||||||
-TODO: document
|
|
||||||
+Unused. Left in for compatibility with perl 5.10.0.
|
|
||||||
|
|
||||||
=head2 C<offs>
|
|
||||||
|
|
||||||
diff -urpN perl-5.10.1.orig/pod/perlreguts.pod perl-5.10.1/pod/perlreguts.pod
|
|
||||||
--- perl-5.10.1.orig/pod/perlreguts.pod 2009-07-27 23:37:52.000000000 +0200
|
|
||||||
+++ perl-5.10.1/pod/perlreguts.pod 2009-11-26 00:12:48.000000000 +0100
|
|
||||||
@@ -810,13 +810,12 @@ value to other engine implementations.
|
|
||||||
|
|
||||||
=item C<swap>
|
|
||||||
|
|
||||||
-C<swap> is an extra set of startp/endp stored in a C<regexp_paren_ofs>
|
|
||||||
-struct. This is used when the last successful match was from the same pattern
|
|
||||||
-as the current pattern, so that a partial match doesn't overwrite the
|
|
||||||
-previous match's results. When this field is data filled the matching
|
|
||||||
-engine will swap buffers before every match attempt. If the match fails,
|
|
||||||
-then it swaps them back. If it's successful it leaves them. This field
|
|
||||||
-is populated on demand and is by default null.
|
|
||||||
+C<swap> formerly was an extra set of startp/endp stored in a
|
|
||||||
+C<regexp_paren_ofs> struct. This was used when the last successful match
|
|
||||||
+was from the same pattern as the current pattern, so that a partial
|
|
||||||
+match didn't overwrite the previous match's results, but it caused a
|
|
||||||
+problem with re-entrant code such as trying to build the UTF-8 swashes.
|
|
||||||
+Currently unused and left for backward compatibility with 5.10.0.
|
|
||||||
|
|
||||||
=item C<offsets>
|
|
||||||
|
|
||||||
diff -urpN perl-5.10.1.orig/proto.h perl-5.10.1/proto.h
|
|
||||||
--- perl-5.10.1.orig/proto.h 2009-08-15 18:36:34.000000000 +0200
|
|
||||||
+++ perl-5.10.1/proto.h 2009-11-26 00:12:48.000000000 +0100
|
|
||||||
@@ -5445,11 +5445,6 @@ STATIC char* S_find_byclass(pTHX_ regexp
|
|
||||||
#define PERL_ARGS_ASSERT_FIND_BYCLASS \
|
|
||||||
assert(prog); assert(c); assert(s); assert(strend)
|
|
||||||
|
|
||||||
-STATIC void S_swap_match_buff(pTHX_ regexp * prog)
|
|
||||||
- __attribute__nonnull__(pTHX_1);
|
|
||||||
-#define PERL_ARGS_ASSERT_SWAP_MATCH_BUFF \
|
|
||||||
- assert(prog)
|
|
||||||
-
|
|
||||||
STATIC void S_to_utf8_substr(pTHX_ regexp * prog)
|
|
||||||
__attribute__nonnull__(pTHX_1);
|
|
||||||
#define PERL_ARGS_ASSERT_TO_UTF8_SUBSTR \
|
|
||||||
diff -urpN perl-5.10.1.orig/regcomp.c perl-5.10.1/regcomp.c
|
|
||||||
--- perl-5.10.1.orig/regcomp.c 2009-07-27 23:37:52.000000000 +0200
|
|
||||||
+++ perl-5.10.1/regcomp.c 2009-11-26 00:12:48.000000000 +0100
|
|
||||||
@@ -9361,7 +9361,6 @@ Perl_pregfree(pTHX_ REGEXP *r)
|
|
||||||
if (r->saved_copy)
|
|
||||||
SvREFCNT_dec(r->saved_copy);
|
|
||||||
#endif
|
|
||||||
- Safefree(r->swap);
|
|
||||||
Safefree(r->offs);
|
|
||||||
Safefree(r);
|
|
||||||
}
|
|
||||||
@@ -9413,7 +9412,6 @@ Perl_reg_temp_copy (pTHX_ REGEXP *r) {
|
|
||||||
ret->saved_copy = NULL;
|
|
||||||
#endif
|
|
||||||
ret->mother_re = r;
|
|
||||||
- ret->swap = NULL;
|
|
||||||
|
|
||||||
return ret;
|
|
||||||
}
|
|
||||||
diff -urpN perl-5.10.1.orig/regexec.c perl-5.10.1/regexec.c
|
|
||||||
--- perl-5.10.1.orig/regexec.c 2009-07-27 23:37:52.000000000 +0200
|
|
||||||
+++ perl-5.10.1/regexec.c 2009-11-26 00:12:48.000000000 +0100
|
|
||||||
@@ -1733,28 +1733,6 @@ S_find_byclass(pTHX_ regexp * prog, cons
|
|
||||||
return s;
|
|
||||||
}
|
|
||||||
|
|
||||||
-static void
|
|
||||||
-S_swap_match_buff (pTHX_ regexp *prog)
|
|
||||||
-{
|
|
||||||
- regexp_paren_pair *t;
|
|
||||||
-
|
|
||||||
- PERL_ARGS_ASSERT_SWAP_MATCH_BUFF;
|
|
||||||
-
|
|
||||||
- if (!prog->swap) {
|
|
||||||
- /* We have to be careful. If the previous successful match
|
|
||||||
- was from this regex we don't want a subsequent paritally
|
|
||||||
- successful match to clobber the old results.
|
|
||||||
- So when we detect this possibility we add a swap buffer
|
|
||||||
- to the re, and switch the buffer each match. If we fail
|
|
||||||
- we switch it back, otherwise we leave it swapped.
|
|
||||||
- */
|
|
||||||
- Newxz(prog->swap, (prog->nparens + 1), regexp_paren_pair);
|
|
||||||
- }
|
|
||||||
- t = prog->swap;
|
|
||||||
- prog->swap = prog->offs;
|
|
||||||
- prog->offs = t;
|
|
||||||
-}
|
|
||||||
-
|
|
||||||
|
|
||||||
/*
|
|
||||||
- regexec_flags - match a regexp against a string
|
|
||||||
@@ -1783,7 +1761,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const
|
|
||||||
I32 multiline;
|
|
||||||
RXi_GET_DECL(prog,progi);
|
|
||||||
regmatch_info reginfo; /* create some info to pass to regtry etc */
|
|
||||||
- bool swap_on_fail = 0;
|
|
||||||
+ regexp_paren_pair *swap = NULL;
|
|
||||||
GET_RE_DEBUG_FLAGS_DECL;
|
|
||||||
|
|
||||||
PERL_ARGS_ASSERT_REGEXEC_FLAGS;
|
|
||||||
@@ -1861,9 +1839,16 @@ Perl_regexec_flags(pTHX_ REGEXP * const
|
|
||||||
reginfo.ganch = strbeg;
|
|
||||||
}
|
|
||||||
if (PL_curpm && (PM_GETRE(PL_curpm) == prog)) {
|
|
||||||
- swap_on_fail = 1;
|
|
||||||
- swap_match_buff(prog); /* do we need a save destructor here for
|
|
||||||
- eval dies? */
|
|
||||||
+ /* We have to be careful. If the previous successful match
|
|
||||||
+ was from this regex we don't want a subsequent partially
|
|
||||||
+ successful match to clobber the old results.
|
|
||||||
+ So when we detect this possibility we add a swap buffer
|
|
||||||
+ to the re, and switch the buffer each match. If we fail
|
|
||||||
+ we switch it back, otherwise we leave it swapped.
|
|
||||||
+ */
|
|
||||||
+ swap = prog->offs;
|
|
||||||
+ /* do we need a save destructor here for eval dies? */
|
|
||||||
+ Newxz(prog->offs, (prog->nparens + 1), regexp_paren_pair);
|
|
||||||
}
|
|
||||||
if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
|
|
||||||
re_scream_pos_data d;
|
|
||||||
@@ -2162,6 +2147,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const
|
|
||||||
goto phooey;
|
|
||||||
|
|
||||||
got_it:
|
|
||||||
+ Safefree(swap);
|
|
||||||
RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
|
|
||||||
|
|
||||||
if (PL_reg_eval_set)
|
|
||||||
@@ -2207,10 +2193,12 @@ phooey:
|
|
||||||
PL_colors[4], PL_colors[5]));
|
|
||||||
if (PL_reg_eval_set)
|
|
||||||
restore_pos(aTHX_ prog);
|
|
||||||
- if (swap_on_fail)
|
|
||||||
+ if (swap) {
|
|
||||||
/* we failed :-( roll it back */
|
|
||||||
- swap_match_buff(prog);
|
|
||||||
-
|
|
||||||
+ Safefree(prog->offs);
|
|
||||||
+ prog->offs = swap;
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
diff -urpN perl-5.10.1.orig/regexp.h perl-5.10.1/regexp.h
|
|
||||||
--- perl-5.10.1.orig/regexp.h 2009-07-27 23:37:52.000000000 +0200
|
|
||||||
+++ perl-5.10.1/regexp.h 2009-11-26 00:12:48.000000000 +0100
|
|
||||||
@@ -88,7 +88,7 @@ typedef struct regexp {
|
|
||||||
/* Data about the last/current match. These are modified during matching*/
|
|
||||||
U32 lastparen; /* last open paren matched */
|
|
||||||
U32 lastcloseparen; /* last close paren matched */
|
|
||||||
- regexp_paren_pair *swap; /* Swap copy of *offs */
|
|
||||||
+ regexp_paren_pair *swap; /* Unused: 5.10.1 and later */
|
|
||||||
regexp_paren_pair *offs; /* Array of offsets for (@-) and (@+) */
|
|
||||||
|
|
||||||
char *subbeg; /* saved or original string
|
|
||||||
diff -urpN perl-5.10.1.orig/t/op/pat.t perl-5.10.1/t/op/pat.t
|
|
||||||
--- perl-5.10.1.orig/t/op/pat.t 2009-07-27 23:37:52.000000000 +0200
|
|
||||||
+++ perl-5.10.1/t/op/pat.t 2009-11-26 00:12:48.000000000 +0100
|
|
||||||
@@ -13,7 +13,7 @@ sub run_tests;
|
|
||||||
|
|
||||||
$| = 1;
|
|
||||||
|
|
||||||
-my $EXPECTED_TESTS = 4065; # Update this when adding/deleting tests.
|
|
||||||
+my $EXPECTED_TESTS = 4066; # Update this when adding/deleting tests.
|
|
||||||
|
|
||||||
BEGIN {
|
|
||||||
chdir 't' if -d 't';
|
|
||||||
@@ -4349,6 +4349,24 @@ sub run_tests {
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
+ # This only works under -DEBUGGING because it relies on an assert().
|
|
||||||
+ {
|
|
||||||
+ local $BugId = '60508';
|
|
||||||
+ local $Message = "Check capture offset re-entrancy of utf8 code.";
|
|
||||||
+
|
|
||||||
+ sub fswash { $_[0] =~ s/([>X])//g; }
|
|
||||||
+
|
|
||||||
+ my $k1 = "." x 4 . ">>";
|
|
||||||
+ fswash($k1);
|
|
||||||
+
|
|
||||||
+ my $k2 = "\x{f1}\x{2022}";
|
|
||||||
+ $k2 =~ s/([\360-\362])/>/g;
|
|
||||||
+ fswash($k2);
|
|
||||||
+
|
|
||||||
+ iseq($k2, "\x{2022}", "utf8::SWASHNEW doesn't cause capture leaks");
|
|
||||||
+ }
|
|
||||||
+
|
|
||||||
+
|
|
||||||
{
|
|
||||||
local $BugId = 65372; # minimal CURLYM limited to 32767 matches
|
|
||||||
my @pat = (
|
|
@ -1,83 +0,0 @@
|
|||||||
From e57cc2468d765872b20810478b94ead3906f1912 Mon Sep 17 00:00:00 2001
|
|
||||||
From: Stepan Kasal <skasal@redhat.com>
|
|
||||||
Date: Wed, 3 Jun 2009 12:03:55 +0200
|
|
||||||
Subject: [PATCH] fix RT 39060, errno incorrectly set in perlio
|
|
||||||
|
|
||||||
---
|
|
||||||
MANIFEST | 1 +
|
|
||||||
perlio.c | 12 +++++++-----
|
|
||||||
t/io/errno.t | 26 ++++++++++++++++++++++++++
|
|
||||||
3 files changed, 34 insertions(+), 5 deletions(-)
|
|
||||||
create mode 100644 t/io/errno.t
|
|
||||||
|
|
||||||
diff --git a/MANIFEST b/MANIFEST
|
|
||||||
index b7c9341..be3be43 100644
|
|
||||||
--- a/MANIFEST
|
|
||||||
+++ b/MANIFEST
|
|
||||||
@@ -3899,6 +3899,7 @@ t/io/binmode.t See if binmode() works
|
|
||||||
t/io/crlf.t See if :crlf works
|
|
||||||
t/io/crlf_through.t See if pipe passes data intact with :crlf
|
|
||||||
t/io/dup.t See if >& works right
|
|
||||||
+t/io/errno.t See if $! is correctly set
|
|
||||||
t/io/fflush.t See if auto-flush on fork/exec/system/qx works
|
|
||||||
t/io/fs.t See if directory manipulations work
|
|
||||||
t/io/inplace.t See if inplace editing works
|
|
||||||
diff --git a/perlio.c b/perlio.c
|
|
||||||
index 0a086a8..e92a32a 100644
|
|
||||||
--- a/perlio.c
|
|
||||||
+++ b/perlio.c
|
|
||||||
@@ -1784,12 +1784,14 @@ PerlIO_has_base(PerlIO *f)
|
|
||||||
int
|
|
||||||
PerlIO_fast_gets(PerlIO *f)
|
|
||||||
{
|
|
||||||
- if (PerlIOValid(f) && (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)) {
|
|
||||||
- const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
|
|
||||||
+ if (PerlIOValid(f)) {
|
|
||||||
+ if (PerlIOBase(f)->flags & PERLIO_F_FASTGETS) {
|
|
||||||
+ const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
|
|
||||||
|
|
||||||
- if (tab)
|
|
||||||
- return (tab->Set_ptrcnt != NULL);
|
|
||||||
- SETERRNO(EINVAL, LIB_INVARG);
|
|
||||||
+ if (tab)
|
|
||||||
+ return (tab->Set_ptrcnt != NULL);
|
|
||||||
+ SETERRNO(EINVAL, LIB_INVARG);
|
|
||||||
+ }
|
|
||||||
}
|
|
||||||
else
|
|
||||||
SETERRNO(EBADF, SS_IVCHAN);
|
|
||||||
diff --git a/t/io/errno.t b/t/io/errno.t
|
|
||||||
new file mode 100644
|
|
||||||
index 0000000..b55e3db
|
|
||||||
--- /dev/null
|
|
||||||
+++ b/t/io/errno.t
|
|
||||||
@@ -0,0 +1,26 @@
|
|
||||||
+#!./perl
|
|
||||||
+# vim: ts=4 sts=4 sw=4:
|
|
||||||
+
|
|
||||||
+# $! may not be set if EOF was reached without any error.
|
|
||||||
+# http://rt.perl.org/rt3/Ticket/Display.html?id=39060
|
|
||||||
+
|
|
||||||
+use strict;
|
|
||||||
+require './test.pl';
|
|
||||||
+
|
|
||||||
+plan( tests => 16 );
|
|
||||||
+
|
|
||||||
+my $test_prog = 'while(<>){print}; print $!';
|
|
||||||
+
|
|
||||||
+for my $perlio ('perlio', 'stdio') {
|
|
||||||
+ $ENV{PERLIO} = $perlio;
|
|
||||||
+ for my $test_in ("test\n", "test") {
|
|
||||||
+ my $test_in_esc = $test_in;
|
|
||||||
+ $test_in_esc =~ s/\n/\\n/g;
|
|
||||||
+ for my $rs_code ('', '$/=undef', '$/=\2', '$/=\1024') {
|
|
||||||
+ is( runperl( prog => "$rs_code; $test_prog",
|
|
||||||
+ stdin => $test_in, stderr => 1),
|
|
||||||
+ $test_in,
|
|
||||||
+ "Wrong errno, PERLIO=$ENV{PERLIO} stdin='$test_in_esc'");
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+}
|
|
||||||
--
|
|
||||||
1.6.2
|
|
||||||
|
|
@ -1,11 +0,0 @@
|
|||||||
--- perl-5.10.1/installperl.orig 2009-11-18 15:44:47.000000000 +0100
|
|
||||||
+++ perl-5.10.1/installperl 2009-11-18 15:50:32.000000000 +0100
|
|
||||||
@@ -235,7 +235,7 @@
|
|
||||||
|
|
||||||
# Do some quick sanity checks.
|
|
||||||
|
|
||||||
-if (!$opts{notify} && $d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
|
|
||||||
+# if (!$opts{notify} && $d_dosuid && $>) { die "You must run as root to install suidperl\n"; }
|
|
||||||
|
|
||||||
$installbin || die "No installbin directory in config.sh\n";
|
|
||||||
-d $installbin || mkpath($installbin, $opts{verbose}, 0777);
|
|
File diff suppressed because it is too large
Load Diff
@ -1,287 +0,0 @@
|
|||||||
File-Path-2.08
|
|
||||||
|
|
||||||
diff -urN perl-5.10.1.orig/lib/File/Path.pm perl-5.10.1/lib/File/Path.pm
|
|
||||||
--- perl-5.10.1.orig/lib/File/Path.pm 2009-06-27 18:14:41.000000000 +0200
|
|
||||||
+++ perl-5.10.1/lib/File/Path.pm 2009-12-01 11:43:31.000000000 +0100
|
|
||||||
@@ -17,7 +17,7 @@
|
|
||||||
|
|
||||||
use Exporter ();
|
|
||||||
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
|
||||||
-$VERSION = '2.07_03';
|
|
||||||
+$VERSION = '2.08';
|
|
||||||
@ISA = qw(Exporter);
|
|
||||||
@EXPORT = qw(mkpath rmtree);
|
|
||||||
@EXPORT_OK = qw(make_path remove_tree);
|
|
||||||
@@ -81,6 +81,34 @@
|
|
||||||
$arg->{mode} = delete $arg->{mask} if exists $arg->{mask};
|
|
||||||
$arg->{mode} = 0777 unless exists $arg->{mode};
|
|
||||||
${$arg->{error}} = [] if exists $arg->{error};
|
|
||||||
+ $arg->{owner} = delete $arg->{user} if exists $arg->{user};
|
|
||||||
+ $arg->{owner} = delete $arg->{uid} if exists $arg->{uid};
|
|
||||||
+ if (exists $arg->{owner} and $arg->{owner} =~ /\D/) {
|
|
||||||
+ my $uid = (getpwnam $arg->{owner})[2];
|
|
||||||
+ if (defined $uid) {
|
|
||||||
+ $arg->{owner} = $uid;
|
|
||||||
+ }
|
|
||||||
+ else {
|
|
||||||
+ _error($arg, "unable to map $arg->{owner} to a uid, ownership not changed");
|
|
||||||
+ delete $arg->{owner};
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+ if (exists $arg->{group} and $arg->{group} =~ /\D/) {
|
|
||||||
+ my $gid = (getgrnam $arg->{group})[2];
|
|
||||||
+ if (defined $gid) {
|
|
||||||
+ $arg->{group} = $gid;
|
|
||||||
+ }
|
|
||||||
+ else {
|
|
||||||
+ _error($arg, "unable to map $arg->{group} to a gid, group ownership not changed");
|
|
||||||
+ delete $arg->{group};
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+ if (exists $arg->{owner} and not exists $arg->{group}) {
|
|
||||||
+ $arg->{group} = -1; # chown will leave group unchanged
|
|
||||||
+ }
|
|
||||||
+ if (exists $arg->{group} and not exists $arg->{owner}) {
|
|
||||||
+ $arg->{owner} = -1; # chown will leave owner unchanged
|
|
||||||
+ }
|
|
||||||
$paths = [@_];
|
|
||||||
}
|
|
||||||
return _mkpath($arg, $paths);
|
|
||||||
@@ -107,6 +135,12 @@
|
|
||||||
print "mkdir $path\n" if $arg->{verbose};
|
|
||||||
if (mkdir($path,$arg->{mode})) {
|
|
||||||
push(@created, $path);
|
|
||||||
+ if (exists $arg->{owner}) {
|
|
||||||
+ # NB: $arg->{group} guaranteed to be set during initialisation
|
|
||||||
+ if (!chown $arg->{owner}, $arg->{group}, $path) {
|
|
||||||
+ _error($arg, "Cannot change ownership of $path to $arg->{owner}:$arg->{group}");
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
my $save_bang = $!;
|
|
||||||
@@ -422,8 +456,8 @@
|
|
||||||
|
|
||||||
=head1 VERSION
|
|
||||||
|
|
||||||
-This document describes version 2.07 of File::Path, released
|
|
||||||
-2008-11-09.
|
|
||||||
+This document describes version 2.08 of File::Path, released
|
|
||||||
+2009-10-04.
|
|
||||||
|
|
||||||
=head1 SYNOPSIS
|
|
||||||
|
|
||||||
@@ -505,6 +539,34 @@
|
|
||||||
a fatal error that will cause the program will halt, unless trapped
|
|
||||||
in an C<eval> block.
|
|
||||||
|
|
||||||
+=item owner => $owner
|
|
||||||
+
|
|
||||||
+=item user => $owner
|
|
||||||
+
|
|
||||||
+=item uid => $owner
|
|
||||||
+
|
|
||||||
+If present, will cause any created directory to be owned by C<$owner>.
|
|
||||||
+If the value is numeric, it will be interpreted as a uid, otherwise
|
|
||||||
+as username is assumed. An error will be issued if the username cannot be
|
|
||||||
+mapped to a uid, or the uid does not exist, or the process lacks the
|
|
||||||
+privileges to change ownership.
|
|
||||||
+
|
|
||||||
+Ownwership of directories that already exist will not be changed.
|
|
||||||
+
|
|
||||||
+C<user> and C<uid> are aliases of C<owner>.
|
|
||||||
+
|
|
||||||
+=item group => $group
|
|
||||||
+
|
|
||||||
+If present, will cause any created directory to be owned by the group C<$group>.
|
|
||||||
+If the value is numeric, it will be interpreted as a gid, otherwise
|
|
||||||
+as group name is assumed. An error will be issued if the group name cannot be
|
|
||||||
+mapped to a gid, or the gid does not exist, or the process lacks the
|
|
||||||
+privileges to change group ownership.
|
|
||||||
+
|
|
||||||
+Group ownwership of directories that already exist will not be changed.
|
|
||||||
+
|
|
||||||
+ make_path '/var/tmp/webcache', {owner=>'nobody', group=>'nogroup'};
|
|
||||||
+
|
|
||||||
=back
|
|
||||||
|
|
||||||
=item mkpath( $dir )
|
|
||||||
@@ -672,6 +734,17 @@
|
|
||||||
|
|
||||||
use File::Path qw(remove_tree rmtree);
|
|
||||||
|
|
||||||
+=head3 API CHANGES
|
|
||||||
+
|
|
||||||
+The API was changed in the 2.0 branch. For a time, C<mkpath> and
|
|
||||||
+C<rmtree> tried, unsuccessfully, to deal with the two different
|
|
||||||
+calling mechanisms. This approach was considered a failure.
|
|
||||||
+
|
|
||||||
+The new semantics are now only available with C<make_path> and
|
|
||||||
+C<remove_tree>. The old semantics are only available through
|
|
||||||
+C<mkpath> and C<rmtree>. Users are strongly encouraged to upgrade
|
|
||||||
+to at least 2.08 in order to avoid surprises.
|
|
||||||
+
|
|
||||||
=head3 SECURITY CONSIDERATIONS
|
|
||||||
|
|
||||||
There were race conditions 1.x implementations of File::Path's
|
|
||||||
@@ -835,6 +908,20 @@
|
|
||||||
to restore the permissions on the file to a possibly less permissive
|
|
||||||
setting. (Permissions given in octal).
|
|
||||||
|
|
||||||
+=item unable to map [owner] to a uid, ownership not changed");
|
|
||||||
+
|
|
||||||
+C<make_path> was instructed to give the ownership of created
|
|
||||||
+directories to the symbolic name [owner], but C<getpwnam> did
|
|
||||||
+not return the corresponding numeric uid. The directory will
|
|
||||||
+be created, but ownership will not be changed.
|
|
||||||
+
|
|
||||||
+=item unable to map [group] to a gid, group ownership not changed
|
|
||||||
+
|
|
||||||
+C<make_path> was instructed to give the group ownership of created
|
|
||||||
+directories to the symbolic name [group], but C<getgrnam> did
|
|
||||||
+not return the corresponding numeric gid. The directory will
|
|
||||||
+be created, but group ownership will not be changed.
|
|
||||||
+
|
|
||||||
=back
|
|
||||||
|
|
||||||
=head1 SEE ALSO
|
|
||||||
@@ -885,7 +972,7 @@
|
|
||||||
=head1 COPYRIGHT
|
|
||||||
|
|
||||||
This module is copyright (C) Charles Bailey, Tim Bunce and
|
|
||||||
-David Landgren 1995-2008. All rights reserved.
|
|
||||||
+David Landgren 1995-2009. All rights reserved.
|
|
||||||
|
|
||||||
=head1 LICENSE
|
|
||||||
|
|
||||||
diff -urN perl-5.10.1.orig/lib/File/Path.t perl-5.10.1/lib/File/Path.t
|
|
||||||
--- perl-5.10.1.orig/lib/File/Path.t 2009-06-27 18:14:41.000000000 +0200
|
|
||||||
+++ perl-5.10.1/lib/File/Path.t 2009-12-01 11:43:48.000000000 +0100
|
|
||||||
@@ -2,7 +2,7 @@
|
|
||||||
|
|
||||||
use strict;
|
|
||||||
|
|
||||||
-use Test::More tests => 121;
|
|
||||||
+use Test::More tests => 129;
|
|
||||||
use Config;
|
|
||||||
|
|
||||||
BEGIN {
|
|
||||||
@@ -323,7 +323,7 @@
|
|
||||||
# test bug http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=487319
|
|
||||||
skip "Don't need Force_Writeable semantics on $^O", 4
|
|
||||||
if grep {$^O eq $_} qw(amigaos dos epoc MSWin32 MacOS os2);
|
|
||||||
- skip "Symlinks not available", 4 unless $Config{'d_symlink'};
|
|
||||||
+ skip "Symlinks not available", 4 unless $Config{d_symlink};
|
|
||||||
$dir = 'bug487319';
|
|
||||||
$dir2 = 'bug487319-symlink';
|
|
||||||
@created = make_path($dir, {mask => 0700});
|
|
||||||
@@ -381,7 +381,7 @@
|
|
||||||
SKIP: {
|
|
||||||
skip "extra scenarios not set up, see eg/setup-extra-tests", 14
|
|
||||||
unless -e $extra;
|
|
||||||
- skip "Symlinks not available", 14 unless $Config{'d_symlink'};
|
|
||||||
+ skip "Symlinks not available", 14 unless $Config{d_symlink};
|
|
||||||
|
|
||||||
my ($list, $err);
|
|
||||||
$dir = catdir( 'EXTRA', '1' );
|
|
||||||
@@ -434,6 +434,78 @@
|
|
||||||
}
|
|
||||||
|
|
||||||
SKIP: {
|
|
||||||
+ my $skip_count = 8; # DRY
|
|
||||||
+ skip "getpwent() not implemented on $^O", $skip_count
|
|
||||||
+ unless $Config{d_getpwent};
|
|
||||||
+ skip "getgrent() not implemented on $^O", $skip_count
|
|
||||||
+ unless $Config{d_getgrent};
|
|
||||||
+ skip 'not running as root', $skip_count
|
|
||||||
+ unless $< == 0;
|
|
||||||
+
|
|
||||||
+ my $dir_stem = $dir = catdir($tmp_base, 'owned-by');
|
|
||||||
+
|
|
||||||
+ # find the highest uid ('nobody' or similar)
|
|
||||||
+ my $max_uid = 0;
|
|
||||||
+ my $max_user = undef;
|
|
||||||
+ while (my @u = getpwent()) {
|
|
||||||
+ if ($max_uid < $u[2]) {
|
|
||||||
+ $max_uid = $u[2];
|
|
||||||
+ $max_user = $u[0];
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+ skip 'getpwent() appears to be insane', $skip_count
|
|
||||||
+ unless $max_uid > 0;
|
|
||||||
+
|
|
||||||
+ # find the highest gid ('nogroup' or similar)
|
|
||||||
+ my $max_gid = 0;
|
|
||||||
+ my $max_group = undef;
|
|
||||||
+ while (my @g = getgrent()) {
|
|
||||||
+ if ($max_gid < $g[2]) {
|
|
||||||
+ $max_gid = $g[2];
|
|
||||||
+ $max_group = $g[0];
|
|
||||||
+ }
|
|
||||||
+ }
|
|
||||||
+ skip 'getgrent() appears to be insane', $skip_count
|
|
||||||
+ unless $max_gid > 0;
|
|
||||||
+
|
|
||||||
+ $dir = catdir($dir_stem, 'aaa');
|
|
||||||
+ @created = make_path($dir, {owner => $max_user});
|
|
||||||
+ is(scalar(@created), 2, "created a directory owned by $max_user...");
|
|
||||||
+ my $dir_uid = (stat $created[0])[4];
|
|
||||||
+ is($dir_uid, $max_uid, "... owned by $max_uid");
|
|
||||||
+
|
|
||||||
+ $dir = catdir($dir_stem, 'aab');
|
|
||||||
+ @created = make_path($dir, {group => $max_group});
|
|
||||||
+ is(scalar(@created), 1, "created a directory owned by group $max_group...");
|
|
||||||
+ my $dir_gid = (stat $created[0])[5];
|
|
||||||
+ is($dir_gid, $max_gid, "... owned by group $max_gid");
|
|
||||||
+
|
|
||||||
+ $dir = catdir($dir_stem, 'aac');
|
|
||||||
+ @created = make_path($dir, {user => $max_user, group => $max_group});
|
|
||||||
+ is(scalar(@created), 1, "created a directory owned by $max_user:$max_group...");
|
|
||||||
+ ($dir_uid, $dir_gid) = (stat $created[0])[4,5];
|
|
||||||
+ is($dir_uid, $max_uid, "... owned by $max_uid");
|
|
||||||
+ is($dir_gid, $max_gid, "... owned by group $max_gid");
|
|
||||||
+
|
|
||||||
+ SKIP: {
|
|
||||||
+ skip 'Test::Output not available', 1
|
|
||||||
+ unless $has_Test_Output;
|
|
||||||
+
|
|
||||||
+ # invent a user and group that don't exist
|
|
||||||
+ do { ++$max_user } while (getpwnam($max_user));
|
|
||||||
+ do { ++$max_group } while (getgrnam($max_group));
|
|
||||||
+
|
|
||||||
+ $dir = catdir($dir_stem, 'aad');
|
|
||||||
+ stderr_like(
|
|
||||||
+ sub {make_path($dir, {user => $max_user, group => $max_group})},
|
|
||||||
+ qr{\Aunable to map $max_user to a uid, ownership not changed: .* at \S+ line \d+
|
|
||||||
+unable to map $max_group to a gid, group ownership not changed: .* at \S+ line \d+\b},
|
|
||||||
+ "created a directory not owned by $max_user:$max_group..."
|
|
||||||
+ );
|
|
||||||
+ }
|
|
||||||
+}
|
|
||||||
+
|
|
||||||
+SKIP: {
|
|
||||||
skip 'Test::Output not available', 14
|
|
||||||
unless $has_Test_Output;
|
|
||||||
|
|
||||||
@@ -574,15 +646,15 @@
|
|
||||||
my $xx = $x . "x";
|
|
||||||
|
|
||||||
# setup
|
|
||||||
- ok(mkpath($xx));
|
|
||||||
- ok(chdir($xx));
|
|
||||||
+ ok(mkpath($xx), "make $xx");
|
|
||||||
+ ok(chdir($xx), "... and chdir $xx");
|
|
||||||
END {
|
|
||||||
- ok(chdir($p));
|
|
||||||
- ok(rmtree($xx));
|
|
||||||
+ ok(chdir($p), "... now chdir $p");
|
|
||||||
+ ok(rmtree($xx), "... and finally rmtree $xx");
|
|
||||||
}
|
|
||||||
|
|
||||||
# create and delete directory
|
|
||||||
my $px = catdir($p, $x);
|
|
||||||
- ok(mkpath($px));
|
|
||||||
- ok(rmtree($px), "rmtree"); # fails in File-Path-2.07
|
|
||||||
+ ok(mkpath($px), 'create and delete directory 2.07');
|
|
||||||
+ ok(rmtree($px), '.. rmtree fails in File-Path-2.07');
|
|
||||||
}
|
|
File diff suppressed because it is too large
Load Diff
@ -1,12 +0,0 @@
|
|||||||
diff -up perl-5.10.1/lib/Parse/CPAN/Meta.pm.old perl-5.10.1/lib/Parse/CPAN/Meta.pm
|
|
||||||
--- perl-5.10.1/lib/Parse/CPAN/Meta.pm.old 2009-06-10 18:37:40.000000000 +0200
|
|
||||||
+++ perl-5.10.1/lib/Parse/CPAN/Meta.pm 2009-12-22 13:08:39.089184165 +0100
|
|
||||||
@@ -15,7 +15,7 @@ BEGIN {
|
|
||||||
# Class structure
|
|
||||||
require 5.004;
|
|
||||||
require Exporter;
|
|
||||||
- $Parse::CPAN::Meta::VERSION = '1.39';
|
|
||||||
+ $Parse::CPAN::Meta::VERSION = '1.40';
|
|
||||||
@Parse::CPAN::Meta::ISA = qw{ Exporter };
|
|
||||||
@Parse::CPAN::Meta::EXPORT_OK = qw{ Load LoadFile };
|
|
||||||
}
|
|
Loading…
Reference in New Issue
Block a user