From: Gurusamy Sarathy Date: Tue, 11 Jul 2000 18:43:26 +0000 (+0000) Subject: integrate cfgperl changes#6252..6260 into mainline X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=036b4402dc24284de44ae733b52896d6fd4fbb77;p=p5sagit%2Fp5-mst-13.2.git integrate cfgperl changes#6252..6260 into mainline p4raw-link: @6260 on //depot/cfgperl: fc865a0069737312ca5ef9762fe8a9be7aa37747 p4raw-link: @6252 on //depot/cfgperl: 0e4dedf1581344244dfa297db1d00c01c5f821aa p4raw-id: //depot/perl@6362 p4raw-integrated: from //depot/cfgperl@6361 'copy in' t/pragma/constant.t (@5717..) t/op/pack.t t/pragma/warn/op (@5996..) pp_proto.h (@6243..) t/op/my_stash.t (@6250..) lib/IPC/Open3.pm (@6253..) 'ignore' t/pragma/warn/regcomp (@6241..) lib/Exporter.pm (@6251..) p4raw-integrated: from //depot/cfgperl@6260 'copy in' pp.c (@6217..) pod/perlfunc.pod (@6248..) p4raw-integrated: from //depot/cfgperl@6259 'copy in' MANIFEST (@6250..) p4raw-integrated: from //depot/cfgperl@6257 'copy in' op.c (@6228..) 'merge in' sv.c (@6244..) p4raw-integrated: from //depot/cfgperl@6256 'copy in' doop.c (@6254..) p4raw-integrated: from //depot/cfgperl@6254 'copy in' t/op/tr.t (@6192..) 'ignore' embedvar.h objXSUB.h (@6243..) 'merge in' embed.h (@6243..) embed.pl proto.h (@6250..) --- diff --git a/MANIFEST b/MANIFEST index 25765e6..6573182 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1167,6 +1167,7 @@ pod/perlmodinstall.pod Installing CPAN Modules pod/perlmodlib.pod Module policy info pod/perlmodlib.PL Generate pod/perlmodlib.pod pod/perlnumber.pod Semantics of numbers and numeric operations +pod/perlnewmod.pod Preparing a new module for distribution pod/perlobj.pod Object info pod/perlop.pod Operator info pod/perlopentut.pod open() tutorial diff --git a/doop.c b/doop.c index fe2df46..7dc5a2b 100644 --- a/doop.c +++ b/doop.c @@ -22,12 +22,13 @@ #endif STATIC I32 -S_do_trans_CC_simple(pTHX_ SV *sv) +S_do_trans_simple(pTHX_ SV *sv) /* SPC - OK */ { dTHR; U8 *s; U8 *send; I32 matches = 0; + I32 hasutf = SvUTF8(sv); STRLEN len; short *tbl; I32 ch; @@ -40,11 +41,15 @@ S_do_trans_CC_simple(pTHX_ SV *sv) send = s + len; while (s < send) { - if ((ch = tbl[*s]) >= 0) { - matches++; - *s = ch; - } + if (hasutf && *s & 0x80) + s+=UTF8SKIP(s); /* Given that we're here because tbl is !UTF8...*/ + else { + if ((ch = tbl[*s]) >= 0) { + matches++; + *s = ch; + } s++; + } } SvSETMAGIC(sv); @@ -52,12 +57,13 @@ S_do_trans_CC_simple(pTHX_ SV *sv) } STATIC I32 -S_do_trans_CC_count(pTHX_ SV *sv) +S_do_trans_count(pTHX_ SV *sv)/* SPC - OK */ { dTHR; U8 *s; U8 *send; I32 matches = 0; + I32 hasutf = SvUTF8(sv); STRLEN len; short *tbl; @@ -69,21 +75,26 @@ S_do_trans_CC_count(pTHX_ SV *sv) send = s + len; while (s < send) { - if (tbl[*s] >= 0) - matches++; - s++; + if (hasutf && *s & 0x80) + s+=UTF8SKIP(s); + else { + if (tbl[*s] >= 0) + matches++; + s++; + } } return matches; } STATIC I32 -S_do_trans_CC_complex(pTHX_ SV *sv) +S_do_trans_complex(pTHX_ SV *sv)/* SPC - OK */ { dTHR; U8 *s; U8 *send; U8 *d; + I32 hasutf = SvUTF8(sv); I32 matches = 0; STRLEN len; short *tbl; @@ -101,29 +112,37 @@ S_do_trans_CC_complex(pTHX_ SV *sv) U8* p = send; while (s < send) { - if ((ch = tbl[*s]) >= 0) { - *d = ch; - matches++; - if (p == d - 1 && *p == *d) - matches--; - else - p = d++; - } - else if (ch == -1) /* -1 is unmapped character */ - *d++ = *s; /* -2 is delete character */ - s++; + if (hasutf && *s & 0x80) + s+=UTF8SKIP(s); + else { + if ((ch = tbl[*s]) >= 0) { + *d = ch; + matches++; + if (p == d - 1 && *p == *d) + matches--; + else + p = d++; + } + else if (ch == -1) /* -1 is unmapped character */ + *d++ = *s; /* -2 is delete character */ + s++; + } } } else { while (s < send) { - if ((ch = tbl[*s]) >= 0) { - *d = ch; - matches++; - d++; - } - else if (ch == -1) /* -1 is unmapped character */ - *d++ = *s; /* -2 is delete character */ - s++; + if (hasutf && *s & 0x80) + s+=UTF8SKIP(s); + else { + if ((ch = tbl[*s]) >= 0) { + *d = ch; + matches++; + d++; + } + else if (ch == -1) /* -1 is unmapped character */ + *d++ = *s; /* -2 is delete character */ + s++; + } } } matches += send - d; /* account for disappeared chars */ @@ -135,12 +154,14 @@ S_do_trans_CC_complex(pTHX_ SV *sv) } STATIC I32 -S_do_trans_UU_simple(pTHX_ SV *sv) +S_do_trans_simple_utf8(pTHX_ SV *sv)/* SPC - OK */ { dTHR; U8 *s; U8 *send; U8 *d; + U8 *start; + U8 *dstart; I32 matches = 0; STRLEN len; @@ -151,43 +172,83 @@ S_do_trans_UU_simple(pTHX_ SV *sv) UV extra = none + 1; UV final; UV uv; + I32 isutf; + I32 howmany; + isutf = SvUTF8(sv); s = (U8*)SvPV(sv, len); send = s + len; + start = s; svp = hv_fetch(hv, "FINAL", 5, FALSE); if (svp) final = SvUV(*svp); - d = s; + /* d needs to be bigger than s, in case e.g. upgrading is required */ + Newz(0, d, len*2+1, U8); + dstart = d; while (s < send) { if ((uv = swash_fetch(rv, s)) < none) { s += UTF8SKIP(s); matches++; + if (uv & 0x80 && !isutf) { + /* Sneaky-upgrade dstart...d */ + U8* new; + STRLEN len; + len = dstart - d; + new = bytes_to_utf8(dstart, &len); + Copy(new,dstart,len,U8*); + d = dstart + len; + isutf++; + } d = uv_to_utf8(d, uv); } else if (uv == none) { int i; - for (i = UTF8SKIP(s); i; i--) - *d++ = *s++; + i = UTF8SKIP(s); + if (i > 1 && !isutf) { + U8* new; + STRLEN len; + len = dstart - d; + new = bytes_to_utf8(dstart, &len); + Copy(new,dstart,len,U8*); + d = dstart + len; + isutf++; + } + while(i--) + *d++ = *s++; } else if (uv == extra) { - s += UTF8SKIP(s); + int i; + i = UTF8SKIP(s); + s += i; matches++; + if (i > 1 && !isutf) { + U8* new; + STRLEN len; + len = dstart - d; + new = bytes_to_utf8(dstart, &len); + Copy(new,dstart,len,U8*); + d = dstart + len; + isutf++; + } d = uv_to_utf8(d, final); } else s += UTF8SKIP(s); } *d = '\0'; - SvCUR_set(sv, d - (U8*)SvPVX(sv)); + SvPV_set(sv, dstart); + SvCUR_set(sv, d - dstart); SvSETMAGIC(sv); + if (isutf) + SvUTF8_on(sv); return matches; } STATIC I32 -S_do_trans_UU_count(pTHX_ SV *sv) +S_do_trans_count_utf8(pTHX_ SV *sv)/* SPC - OK */ { dTHR; U8 *s; @@ -202,6 +263,8 @@ S_do_trans_UU_count(pTHX_ SV *sv) UV uv; s = (U8*)SvPV(sv, len); + if (!SvUTF8(sv)) + s = bytes_to_utf8(s, &len); send = s + len; while (s < send) { @@ -214,7 +277,7 @@ S_do_trans_UU_count(pTHX_ SV *sv) } STATIC I32 -S_do_trans_UU_complex(pTHX_ SV *sv) +S_do_trans_complex_utf8(pTHX_ SV *sv) /* SPC - NOT OK */ { dTHR; U8 *s; @@ -403,6 +466,8 @@ Perl_do_trans(pTHX_ SV *sv) { dTHR; STRLEN len; + I32 hasutf = (PL_op->op_private & + (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)); if (SvREADONLY(sv) && !(PL_op->op_private & OPpTRANS_IDENTICAL)) Perl_croak(aTHX_ PL_no_modify); @@ -417,24 +482,24 @@ Perl_do_trans(pTHX_ SV *sv) DEBUG_t( Perl_deb(aTHX_ "2.TBL\n")); - switch (PL_op->op_private & 63) { + switch (PL_op->op_private & ~hasutf & 63) { case 0: - if (SvUTF8(sv)) - return do_trans_UU_simple(sv); + if (hasutf) + return do_trans_simple_utf8(sv); else - return do_trans_CC_simple(sv); + return do_trans_simple(sv); case OPpTRANS_IDENTICAL: - if (SvUTF8(sv)) - return do_trans_UU_count(sv); + if (hasutf) + return do_trans_count_utf8(sv); else - return do_trans_CC_count(sv); + return do_trans_count(sv); default: - if (SvUTF8(sv)) - return do_trans_UU_complex(sv); /* could be UC or CU too */ + if (hasutf) + return do_trans_complex_utf8(sv); else - return do_trans_CC_complex(sv); + return do_trans_complex(sv); } } diff --git a/embed.h b/embed.h index 8562cf4..c426975 100644 --- a/embed.h +++ b/embed.h @@ -847,14 +847,12 @@ #define avhv_index S_avhv_index #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -#define do_trans_CC_simple S_do_trans_CC_simple -#define do_trans_CC_count S_do_trans_CC_count -#define do_trans_CC_complex S_do_trans_CC_complex -#define do_trans_UU_simple S_do_trans_UU_simple -#define do_trans_UU_count S_do_trans_UU_count -#define do_trans_UU_complex S_do_trans_UU_complex -#define do_trans_UC_trivial S_do_trans_UC_trivial -#define do_trans_CU_trivial S_do_trans_CU_trivial +#define do_trans_simple S_do_trans_simple +#define do_trans_count S_do_trans_count +#define do_trans_complex S_do_trans_complex +#define do_trans_simple_utf8 S_do_trans_simple_utf8 +#define do_trans_count_utf8 S_do_trans_count_utf8 +#define do_trans_complex_utf8 S_do_trans_complex_utf8 #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) #define gv_init_sv S_gv_init_sv @@ -1106,6 +1104,7 @@ #define sublex_push S_sublex_push #define sublex_start S_sublex_start #define filter_gets S_filter_gets +#define find_in_my_stash S_find_in_my_stash #define new_constant S_new_constant #define ao S_ao #define depcom S_depcom @@ -2291,14 +2290,12 @@ #define avhv_index(a,b,c) S_avhv_index(aTHX_ a,b,c) #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -#define do_trans_CC_simple(a) S_do_trans_CC_simple(aTHX_ a) -#define do_trans_CC_count(a) S_do_trans_CC_count(aTHX_ a) -#define do_trans_CC_complex(a) S_do_trans_CC_complex(aTHX_ a) -#define do_trans_UU_simple(a) S_do_trans_UU_simple(aTHX_ a) -#define do_trans_UU_count(a) S_do_trans_UU_count(aTHX_ a) -#define do_trans_UU_complex(a) S_do_trans_UU_complex(aTHX_ a) -#define do_trans_UC_trivial(a) S_do_trans_UC_trivial(aTHX_ a) -#define do_trans_CU_trivial(a) S_do_trans_CU_trivial(aTHX_ a) +#define do_trans_simple(a) S_do_trans_simple(aTHX_ a) +#define do_trans_count(a) S_do_trans_count(aTHX_ a) +#define do_trans_complex(a) S_do_trans_complex(aTHX_ a) +#define do_trans_simple_utf8(a) S_do_trans_simple_utf8(aTHX_ a) +#define do_trans_count_utf8(a) S_do_trans_count_utf8(aTHX_ a) +#define do_trans_complex_utf8(a) S_do_trans_complex_utf8(aTHX_ a) #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) #define gv_init_sv(a,b) S_gv_init_sv(aTHX_ a,b) @@ -2549,6 +2546,7 @@ #define sublex_push() S_sublex_push(aTHX) #define sublex_start() S_sublex_start(aTHX) #define filter_gets(a,b,c) S_filter_gets(aTHX_ a,b,c) +#define find_in_my_stash(a,b) S_find_in_my_stash(aTHX_ a,b) #define new_constant(a,b,c,d,e,f) S_new_constant(aTHX_ a,b,c,d,e,f) #define ao(a) S_ao(aTHX_ a) #define depcom() S_depcom(aTHX) @@ -4483,22 +4481,18 @@ #define avhv_index S_avhv_index #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -#define S_do_trans_CC_simple CPerlObj::S_do_trans_CC_simple -#define do_trans_CC_simple S_do_trans_CC_simple -#define S_do_trans_CC_count CPerlObj::S_do_trans_CC_count -#define do_trans_CC_count S_do_trans_CC_count -#define S_do_trans_CC_complex CPerlObj::S_do_trans_CC_complex -#define do_trans_CC_complex S_do_trans_CC_complex -#define S_do_trans_UU_simple CPerlObj::S_do_trans_UU_simple -#define do_trans_UU_simple S_do_trans_UU_simple -#define S_do_trans_UU_count CPerlObj::S_do_trans_UU_count -#define do_trans_UU_count S_do_trans_UU_count -#define S_do_trans_UU_complex CPerlObj::S_do_trans_UU_complex -#define do_trans_UU_complex S_do_trans_UU_complex -#define S_do_trans_UC_trivial CPerlObj::S_do_trans_UC_trivial -#define do_trans_UC_trivial S_do_trans_UC_trivial -#define S_do_trans_CU_trivial CPerlObj::S_do_trans_CU_trivial -#define do_trans_CU_trivial S_do_trans_CU_trivial +#define S_do_trans_simple CPerlObj::S_do_trans_simple +#define do_trans_simple S_do_trans_simple +#define S_do_trans_count CPerlObj::S_do_trans_count +#define do_trans_count S_do_trans_count +#define S_do_trans_complex CPerlObj::S_do_trans_complex +#define do_trans_complex S_do_trans_complex +#define S_do_trans_simple_utf8 CPerlObj::S_do_trans_simple_utf8 +#define do_trans_simple_utf8 S_do_trans_simple_utf8 +#define S_do_trans_count_utf8 CPerlObj::S_do_trans_count_utf8 +#define do_trans_count_utf8 S_do_trans_count_utf8 +#define S_do_trans_complex_utf8 CPerlObj::S_do_trans_complex_utf8 +#define do_trans_complex_utf8 S_do_trans_complex_utf8 #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) #define S_gv_init_sv CPerlObj::S_gv_init_sv @@ -4957,6 +4951,8 @@ #define sublex_start S_sublex_start #define S_filter_gets CPerlObj::S_filter_gets #define filter_gets S_filter_gets +#define S_find_in_my_stash CPerlObj::S_find_in_my_stash +#define find_in_my_stash S_find_in_my_stash #define S_new_constant CPerlObj::S_new_constant #define new_constant S_new_constant #define S_ao CPerlObj::S_ao diff --git a/embed.pl b/embed.pl index b88235b..862fc32 100755 --- a/embed.pl +++ b/embed.pl @@ -2200,14 +2200,12 @@ s |I32 |avhv_index |AV* av|SV* sv|U32 hash #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -s |I32 |do_trans_CC_simple |SV *sv -s |I32 |do_trans_CC_count |SV *sv -s |I32 |do_trans_CC_complex |SV *sv -s |I32 |do_trans_UU_simple |SV *sv -s |I32 |do_trans_UU_count |SV *sv -s |I32 |do_trans_UU_complex |SV *sv -s |I32 |do_trans_UC_trivial |SV *sv -s |I32 |do_trans_CU_trivial |SV *sv +s |I32 |do_trans_simple |SV *sv +s |I32 |do_trans_count |SV *sv +s |I32 |do_trans_complex |SV *sv +s |I32 |do_trans_simple_utf8 |SV *sv +s |I32 |do_trans_count_utf8 |SV *sv +s |I32 |do_trans_complex_utf8 |SV *sv #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm index 6d91c81..5c9c69a 100644 --- a/lib/IPC/Open3.pm +++ b/lib/IPC/Open3.pm @@ -44,6 +44,9 @@ by an autogenerated filehandle. If so, you must pass a valid lvalue in the parameter slot so it can be overwritten in the caller, or an exception will be raised. +The filehandles may also be integers, in which case they are understood +as file descriptors. + open3() returns the process ID of the child process. It doesn't return on failure: it just raises an exception matching C. However, C failures in the child are not detected. You'll have to @@ -137,14 +140,13 @@ sub xclose { close $_[0] or croak "$Me: close($_[0]) failed: $!"; } -sub xfileno { - my ($fh) = @_; - return $1 if $fh =~ /^=?(\d+)$/; # deal with $fh just being an fd - return fileno $fh; +sub fh_is_fd { + return $_[0] =~ /\A=?(\d+)\z/; } -sub fh_is_fd { - return $_[0] =~ /^=?\d+$/; +sub xfileno { + return $1 if $_[0] =~ /\A=?(\d+)\z/; # deal with fh just being an fd + return fileno $_[0]; } my $do_spawn = $^O eq 'os2' || $^O eq 'MSWin32'; diff --git a/op.c b/op.c index fb060d3..3f71cfa 100644 --- a/op.c +++ b/op.c @@ -2574,6 +2574,12 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) complement = o->op_private & OPpTRANS_COMPLEMENT; del = o->op_private & OPpTRANS_DELETE; squash = o->op_private & OPpTRANS_SQUASH; + + if (SvUTF8(tstr)) + o->op_private |= OPpTRANS_FROM_UTF; + + if (SvUTF8(rstr)) + o->op_private |= OPpTRANS_TO_UTF; if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) { SV* listsv = newSVpvn("# comment\n",10); @@ -2645,16 +2651,9 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl) r = t; rlen = tlen; rend = tend; } if (!squash) { - if (to_utf && from_utf) { /* only counting characters */ if (t == r || (tlen == rlen && memEQ((char *)t, (char *)r, tlen))) o->op_private |= OPpTRANS_IDENTICAL; - } - else { /* straight latin-1 translation */ - if (tlen == 4 && memEQ((char *)t, "\0\377\303\277", 4) && - rlen == 4 && memEQ((char *)r, "\0\377\303\277", 4)) - o->op_private |= OPpTRANS_IDENTICAL; - } } while (t < tend || tfirst <= tlast) { diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 6b4e971..00fc860 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -3202,6 +3202,15 @@ equal $foo). =item * +If the pattern begins with a C, the resulting string will be treated +as Unicode-encoded. You can force UTF8 encoding on in a string with an +initial C, and the bytes that follow will be interpreted as Unicode +characters. If you don't want this to happen, you can begin your pattern +with C (or anything else) to force Perl not to UTF8 encode your +string, and then follow this with a C somewhere in your pattern. + +=item * + You must yourself do any alignment or padding by inserting for example enough C<'x'>es while packing. There is no way to pack() and unpack() could know where the bytes are going to or coming from. Therefore diff --git a/pp.c b/pp.c index 428b2e4..efea0c1 100644 --- a/pp.c +++ b/pp.c @@ -4375,6 +4375,7 @@ PP(pp_pack) register I32 items; STRLEN fromlen; register char *pat = SvPVx(*++MARK, fromlen); + char *patcopy; register char *patend = pat + fromlen; register I32 len; I32 datumtype; @@ -4405,6 +4406,7 @@ PP(pp_pack) items = SP - MARK; MARK++; sv_setpvn(cat, "", 0); + patcopy = pat; while (pat < patend) { SV *lengthcode = Nullsv; #define NEXTFROM ( lengthcode ? lengthcode : items-- > 0 ? *MARK++ : &PL_sv_no) @@ -4412,8 +4414,12 @@ PP(pp_pack) #ifdef PERL_NATINT_PACK natint = 0; #endif - if (isSPACE(datumtype)) + if (isSPACE(datumtype)) { + patcopy++; continue; + } + if (datumtype == 'U' && pat==patcopy+1) + SvUTF8_on(cat); if (datumtype == '#') { while (pat < patend && *pat != '\n') pat++; diff --git a/proto.h b/proto.h index 28b4908..71a912e 100644 --- a/proto.h +++ b/proto.h @@ -960,14 +960,12 @@ STATIC I32 S_avhv_index(pTHX_ AV* av, SV* sv, U32 hash); #endif #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) -STATIC I32 S_do_trans_CC_simple(pTHX_ SV *sv); -STATIC I32 S_do_trans_CC_count(pTHX_ SV *sv); -STATIC I32 S_do_trans_CC_complex(pTHX_ SV *sv); -STATIC I32 S_do_trans_UU_simple(pTHX_ SV *sv); -STATIC I32 S_do_trans_UU_count(pTHX_ SV *sv); -STATIC I32 S_do_trans_UU_complex(pTHX_ SV *sv); -STATIC I32 S_do_trans_UC_trivial(pTHX_ SV *sv); -STATIC I32 S_do_trans_CU_trivial(pTHX_ SV *sv); +STATIC I32 S_do_trans_simple(pTHX_ SV *sv); +STATIC I32 S_do_trans_count(pTHX_ SV *sv); +STATIC I32 S_do_trans_complex(pTHX_ SV *sv); +STATIC I32 S_do_trans_simple_utf8(pTHX_ SV *sv); +STATIC I32 S_do_trans_count_utf8(pTHX_ SV *sv); +STATIC I32 S_do_trans_complex_utf8(pTHX_ SV *sv); #endif #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) diff --git a/sv.c b/sv.c index 5861ca4..1b39437 100644 --- a/sv.c +++ b/sv.c @@ -2768,7 +2768,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) if(const_sv) const_changed = sv_cmp(const_sv, op_const_sv(CvSTART((CV*)sref), - Nullcv)); + (CV*)sref)); /* ahem, death to those who redefine * active sort subs */ if (PL_curstackinfo->si_type == PERLSI_SORT && @@ -2776,7 +2776,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) Perl_croak(aTHX_ "Can't redefine active sort subroutine %s", GvENAME((GV*)dstr)); - if ((const_changed || const_sv) && ckWARN(WARN_REDEFINE)) + if ((const_changed && const_sv) || ckWARN(WARN_REDEFINE)) Perl_warner(aTHX_ WARN_REDEFINE, const_sv ? "Constant subroutine %s redefined" : "Subroutine %s redefined", diff --git a/t/op/my_stash.t b/t/op/my_stash.t index ba266bf..79f3f28 100644 --- a/t/op/my_stash.t +++ b/t/op/my_stash.t @@ -2,6 +2,10 @@ package Foo; +BEGIN { + unshift @INC, "../lib"; +} + use Test; plan tests => 7; diff --git a/t/op/pack.t b/t/op/pack.t index dda1cc7..5c215c6 100755 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -6,7 +6,7 @@ BEGIN { require Config; import Config; } -print "1..156\n"; +print "1..159\n"; $format = "c2 x5 C C x s d i l a6"; # Need the expression in here to force ary[5] to be numeric. This avoids @@ -406,3 +406,13 @@ $z = pack < 1 ; }; -test 59, @warnings == 14 ; +test 59, @warnings == 15 ; test 60, (shift @warnings) =~ /^Constant name 'BEGIN' is a Perl keyword at/; +shift @warnings; #Constant subroutine BEGIN redefined at test 61, (shift @warnings) =~ /^Constant name 'INIT' is a Perl keyword at/; test 62, (shift @warnings) =~ /^Constant name 'CHECK' is a Perl keyword at/; test 63, (shift @warnings) =~ /^Constant name 'END' is a Perl keyword at/; diff --git a/t/pragma/warn/op b/t/pragma/warn/op index 2c9e0fd..7368275 100644 --- a/t/pragma/warn/op +++ b/t/pragma/warn/op @@ -716,6 +716,20 @@ EXPECT Constant subroutine fred redefined at - line 4. ######## # op.c +no warnings 'redefine' ; +sub fred () { 1 } +sub fred () { 2 } +EXPECT +Constant subroutine fred redefined at - line 4. +######## +# op.c +no warnings 'redefine' ; +sub fred () { 1 } +*fred = sub () { 2 }; +EXPECT +Constant subroutine fred redefined at - line 4. +######## +# op.c use warnings 'redefine' ; format FRED = .