X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_hot.c;h=6027766e2fde1222a577f2b978909e33747862a1;hb=68435ea717a7cd7f41241ff44917b542abd94222;hp=8697d36df83fb3ad6b873948dd617a64e9a9996f;hpb=638eceb6656bf10acb1a6dc2a55880f5e1a6c8c4;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_hot.c b/pp_hot.c index 8697d36..6027766 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -1,6 +1,6 @@ /* pp_hot.c * - * Copyright (c) 1991-1999, Larry Wall + * Copyright (c) 1991-2000, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -22,14 +22,6 @@ #ifdef I_UNISTD #include #endif -#ifdef I_FCNTL -#include -#endif -#ifdef I_SYS_FILE -#include -#endif - -#define HOP(pos,off) (IN_UTF8 ? utf8_hop(pos, off) : (pos + off)) /* Hot code. */ @@ -88,6 +80,8 @@ PP(pp_stringify) char *s; s = SvPV(TOPs,len); sv_setpvn(TARG,s,len); + if (SvUTF8(TOPs) && !IN_BYTE) + SvUTF8_on(TARG); SETTARG; RETURN; } @@ -153,8 +147,14 @@ PP(pp_concat) dPOPTOPssrl; STRLEN len; char *s; + if (TARG != left) { s = SvPV(left,len); + if (TARG == right) { + sv_insert(TARG, 0, 0, s, len); + SETs(TARG); + RETURN; + } sv_setpvn(TARG,s,len); } else if (SvGMAGICAL(TARG)) @@ -166,18 +166,27 @@ PP(pp_concat) s = SvPV(right,len); if (SvOK(TARG)) { #if defined(PERL_Y2KWARN) - if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_MISC)) { + if ((SvIOK(right) || SvNOK(right)) && ckWARN(WARN_Y2K)) { STRLEN n; char *s = SvPV(TARG,n); if (n >= 2 && s[n-2] == '1' && s[n-1] == '9' && (n == 2 || !isDIGIT(s[n-3]))) { - Perl_warner(aTHX_ WARN_MISC, "Possible Y2K bug: %s", + Perl_warner(aTHX_ WARN_Y2K, "Possible Y2K bug: %s", "about to append an integer to '19'"); } } #endif + if (DO_UTF8(right)) + sv_utf8_upgrade(TARG); sv_catpvn(TARG,s,len); + if (!IN_BYTE) { + if (SvUTF8(right)) + SvUTF8_on(TARG); + } + else if (!SvUTF8(right)) { + SvUTF8_off(TARG); + } } else sv_setpvn(TARG,s,len); /* suppress warning */ @@ -360,15 +369,15 @@ PP(pp_print) } else if (!(fp = IoOFP(io))) { if (ckWARN2(WARN_CLOSED, WARN_IO)) { - SV* sv = sv_newmortal(); - gv_efullname3(sv, gv, Nullch); - if (IoIFP(io)) + if (IoIFP(io)) { + SV* sv = sv_newmortal(); + gv_efullname3(sv, gv, Nullch); Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for input", SvPV(sv,n_a)); + } else if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, - "print on closed filehandle %s", SvPV(sv,n_a)); + report_closed_fh(gv, io, "print", "filehandle"); } SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); goto just_say_no; @@ -459,7 +468,7 @@ PP(pp_rv2av) PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_usym, "an ARRAY"); if (ckWARN(WARN_UNINITIALIZED)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); if (GIMME == G_ARRAY) { (void)POPs; RETURN; @@ -559,7 +568,7 @@ PP(pp_rv2hv) PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_usym, "a HASH"); if (ckWARN(WARN_UNINITIALIZED)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); if (GIMME == G_ARRAY) { SP--; RETURN; @@ -708,14 +717,14 @@ PP(pp_aassign) if (relem == lastrelem) { if (*relem) { HE *didstore; - if (ckWARN(WARN_UNSAFE)) { + if (ckWARN(WARN_MISC)) { if (relem == firstrelem && SvROK(*relem) && ( SvTYPE(SvRV(*relem)) == SVt_PVAV || SvTYPE(SvRV(*relem)) == SVt_PVHV ) ) - Perl_warner(aTHX_ WARN_UNSAFE, "Reference found where even-sized list expected"); + Perl_warner(aTHX_ WARN_MISC, "Reference found where even-sized list expected"); else - Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment"); + Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment"); } tmpstr = NEWSV(29,0); didstore = hv_store_ent(hash,*relem,tmpstr,0); @@ -1036,6 +1045,7 @@ yup: /* Confirmed by INTUIT */ rx->startp[0] = s - truebase; rx->endp[0] = s - truebase + rx->minlen; } + rx->nparens = rx->lastparen = 0; /* used by @- and @+ */ LEAVE_SCOPE(oldsave); RETPUSHYES; @@ -1246,18 +1256,13 @@ Perl_do_readline(pTHX) } } if (!fp) { - if (ckWARN(WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) { + if (ckWARN2(WARN_GLOB,WARN_CLOSED) && io && !(IoFLAGS(io) & IOf_START)) { if (type == OP_GLOB) - Perl_warner(aTHX_ WARN_CLOSED, + Perl_warner(aTHX_ WARN_GLOB, "glob failed (can't start child: %s)", Strerror(errno)); - else { - SV* sv = sv_newmortal(); - gv_efullname3(sv, PL_last_in_gv, Nullch); - Perl_warner(aTHX_ WARN_CLOSED, - "Read on closed filehandle %s", - SvPV_nolen(sv)); - } + else + report_closed_fh(PL_last_in_gv, io, "readline", "filehandle"); } if (gimme == G_SCALAR) { (void)SvOK_off(TARG); @@ -1284,12 +1289,11 @@ Perl_do_readline(pTHX) offset = 0; } -/* flip-flop EOF state for a snarfed empty file */ +/* delay EOF state for a snarfed empty file */ #define SNARF_EOF(gimme,rs,io,sv) \ - ((gimme != G_SCALAR || SvCUR(sv) \ - || (IoFLAGS(io) & IOf_NOLINE) || IoLINES(io) || !RsSNARF(rs)) \ - ? ((IoFLAGS(io) &= ~IOf_NOLINE), TRUE) \ - : ((IoFLAGS(io) |= IOf_NOLINE), FALSE)) + (gimme != G_SCALAR || SvCUR(sv) \ + || !RsSNARF(rs) || (IoFLAGS(io) & IOf_NOLINE) \ + || ((IoFLAGS(io) |= IOf_NOLINE), FALSE)) for (;;) { if (!sv_gets(sv, fp, offset) @@ -1303,10 +1307,10 @@ Perl_do_readline(pTHX) (void)do_close(PL_last_in_gv, FALSE); } else if (type == OP_GLOB) { - if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) { - Perl_warner(aTHX_ WARN_CLOSED, + if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_GLOB)) { + Perl_warner(aTHX_ WARN_GLOB, "glob failed (child exited with status %d%s)", - STATUS_CURRENT >> 8, + (int)(STATUS_CURRENT >> 8), (STATUS_CURRENT & 0x80) ? ", core dumped" : ""); } } @@ -2738,7 +2742,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) !(ob=(SV*)GvIO(iogv))) { if (!packname || - ((*(U8*)packname >= 0xc0 && IN_UTF8) + ((*(U8*)packname >= 0xc0 && DO_UTF8(sv)) ? !isIDFIRST_utf8((U8*)packname) : !isIDFIRST(*packname) ))