X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=96d268bfc71517267f33815eb73e36dcd1e4ddcc;hb=e4783991709775389a3fc70c841522b0165cd076;hp=f0c3bf3d8c08462065d7d122438a763a7c543403;hpb=d41ff1b8ad987cfcb928deba4254681c1a4c0e36;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index f0c3bf3..96d268b 100644 --- a/mg.c +++ b/mg.c @@ -1,6 +1,6 @@ /* mg.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. @@ -339,10 +339,7 @@ U32 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) { dTHR; - register char *s; - register I32 i; register REGEXP *rx; - char *t; if (PL_curpm && (rx = PL_curpm->op_pmregexp)) { if (mg->mg_obj) /* @+ */ @@ -387,10 +384,8 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg) { dTHR; register I32 paren; - register char *s; register I32 i; register REGEXP *rx; - char *t; switch (*mg->mg_ptr) { case '1': case '2': case '3': case '4': @@ -458,7 +453,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) register char *s; register I32 i; register REGEXP *rx; - char *t; switch (*mg->mg_ptr) { case '\001': /* ^A */ @@ -553,7 +547,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) { dTHR; if (PL_lex_state != LEX_NOTPARSING) - SvOK_off(sv); + (void)SvOK_off(sv); else if (PL_in_eval) sv_setiv(sv, 1); else @@ -567,13 +561,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setiv(sv, (IV)PL_basetime); #endif break; - case '\025': /* ^U */ - sv_setiv(sv, (IV)PL_bigchar); - break; - case '\027': /* ^W & $^Warnings*/ + case '\027': /* ^W & $^WARNING_BITS & ^WIDE_SYSTEM_CALLS */ if (*(mg->mg_ptr+1) == '\0') sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE)); - else if (strEQ(mg->mg_ptr, "\027arnings")) { + else if (strEQ(mg->mg_ptr, "\027ARNING_BITS")) { if (PL_compiling.cop_warnings == WARN_NONE || PL_compiling.cop_warnings == WARN_STD) { @@ -586,6 +577,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setsv(sv, PL_compiling.cop_warnings); } } + else if (strEQ(mg->mg_ptr, "\027IDE_SYSTEM_CALLS")) + sv_setiv(sv, (IV)PL_widesyscalls); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '&': @@ -757,7 +750,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, gary[i]); } #endif - SvIOK_on(sv); /* what a wonderful hack! */ + (void)SvIOK_on(sv); /* what a wonderful hack! */ break; case '*': break; @@ -880,7 +873,7 @@ Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg) STRLEN n_a; magic_clear_all_env(sv,mg); hv_iterinit((HV*)sv); - while (entry = hv_iternext((HV*)sv)) { + while ((entry = hv_iternext((HV*)sv))) { I32 keylen; my_setenv(hv_iterkey(entry, &keylen), SvPV(hv_iterval((HV*)sv, entry), n_a)); @@ -916,7 +909,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) } FreeEnvironmentStrings(envv); # else -# ifdef CYGWIN +# ifdef __CYGWIN__ I32 i; for (i = 0; environ[i]; i++) safesysfree(environ[i]); @@ -930,7 +923,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) for (i = 0; environ[i]; i++) safesysfree(environ[i]); # endif /* PERL_USE_SAFE_PUTENV */ -# endif /* CYGWIN */ +# endif /* __CYGWIN__ */ environ[0] = Nullch; @@ -1010,7 +1003,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) else { i = whichsig(s); /* ...no, a brick */ if (!i) { - if (ckWARN(WARN_SIGNAL) || strEQ(s,"ALARM")) + if (ckWARN(WARN_SIGNAL)) Perl_warner(aTHX_ WARN_SIGNAL, "No such signal: SIG%s", s); return 0; } @@ -1086,7 +1079,7 @@ Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg) i = HvKEYS(hv); else { /*SUPPRESS 560*/ - while (entry = hv_iternext(hv)) { + while ((entry = hv_iternext(hv))) { i++; } } @@ -1421,7 +1414,7 @@ Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg) { dTHR; TAINT_IF((mg->mg_len & 1) || - (mg->mg_len & 2) && mg->mg_obj == sv); /* kludge */ + ((mg->mg_len & 2) && mg->mg_obj == sv)); /* kludge */ return 0; } @@ -1448,7 +1441,7 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg) SV *lsv = LvTARG(sv); if (!lsv) { - SvOK_off(sv); + (void)SvOK_off(sv); return 0; } @@ -1571,7 +1564,7 @@ Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg) Perl_croak(aTHX_ "panic: magic_killbackrefs"); /* XXX Should we check that it hasn't changed? */ SvRV(svp[i]) = 0; - SvOK_off(svp[i]); + (void)SvOK_off(svp[i]); SvWEAKREF_off(svp[i]); svp[i] = &PL_sv_undef; } @@ -1710,10 +1703,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); #endif break; - case '\025': /* ^U */ - PL_bigchar = SvTRUE(sv); - break; - case '\027': /* ^W & $^Warnings */ + case '\027': /* ^W & $^WARNING_BITS & ^WIDE_SYSTEM_CALLS */ if (*(mg->mg_ptr+1) == '\0') { if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); @@ -1721,8 +1711,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) | (i ? G_WARN_ON : G_WARN_OFF) ; } } - else if (strEQ(mg->mg_ptr, "\027arnings")) { + else if (strEQ(mg->mg_ptr, "\027ARNING_BITS")) { if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { + if (!SvPOK(sv) && PL_localizing) { + sv_setpvn(sv, WARN_NONEstring, WARNsize); + PL_compiling.cop_warnings = WARN_NONE; + break; + } if (memEQ(SvPVX(sv), WARN_ALLstring, WARNsize)) { PL_compiling.cop_warnings = WARN_ALL; PL_dowarn |= G_WARN_ONCE ; @@ -1739,6 +1734,8 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) } } } + else if (strEQ(mg->mg_ptr, "\027IDE_SYSTEM_CALLS")) + PL_widesyscalls = SvTRUE(sv); break; case '.': if (PL_localizing) { @@ -2087,7 +2084,7 @@ Perl_sighandler(int sig) CV *cv = Nullcv; OP *myop = PL_op; U32 flags = 0; - I32 o_save_i = PL_savestack_ix, type; + I32 o_save_i = PL_savestack_ix; XPV *tXpv = PL_Xpv; if (PL_savestack_ix + 15 <= PL_savestack_max) @@ -2177,7 +2174,7 @@ static void restore_magic(pTHXo_ void *p) { dTHR; - MGS* mgs = SSPTR((I32)p, MGS*); + MGS* mgs = SSPTR(PTR2IV(p), MGS*); SV* sv = mgs->mgs_sv; if (!sv)