X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=904381a06965fa7807cfecef077da76ed3bd956d;hb=10c8fecdc2f0a2ef9c548abff5961fa25cd83eca;hp=edabb1156282d22c887aa500bae2253638546cb1;hpb=954c1994944eafa74aaac1bab94e820b6e447da9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index edabb11..904381a 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. @@ -567,10 +567,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setiv(sv, (IV)PL_basetime); #endif 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) { @@ -583,6 +583,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 '&': @@ -609,6 +611,10 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) PL_tainted = FALSE; } sv_setpvn(sv, s, i); + if ((PL_curpm->op_pmdynflags & PMdf_UTF8) && !IN_BYTE) + SvUTF8_on(sv); + else + SvUTF8_off(sv); if (PL_tainting) PL_tainted = (was_tainted || RX_MATCH_TAINTED(rx)); break; @@ -909,7 +915,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]); @@ -923,7 +929,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; @@ -1003,7 +1009,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; } @@ -1286,7 +1292,7 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg) if (mg && mg->mg_len >= 0) { dTHR; I32 i = mg->mg_len; - if (IN_UTF8) + if (DO_UTF8(lsv)) sv_pos_b2u(lsv, &i); sv_setiv(sv, i + PL_curcop->cop_arybase); return 0; @@ -1323,7 +1329,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) pos = SvIV(sv) - PL_curcop->cop_arybase; - if (IN_UTF8) { + if (DO_UTF8(lsv)) { ulen = sv_len_utf8(lsv); if (ulen) len = ulen; @@ -1703,7 +1709,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_basetime = (Time_t)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); #endif 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); @@ -1711,8 +1717,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 ; @@ -1729,6 +1740,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) { @@ -2167,7 +2180,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)