X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=fb2b8f173d93061385aedfdf5b5dc5a2b0ec9b9e;hb=5db1039675bdeda8d9e4e8a1462abefb8ede0419;hp=09be2f7bdb740003b3e743d7169d5c2299d3938a;hpb=ed344e4f516e393bcdfd181ec61ffbb056bebd56;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index 09be2f7..fb2b8f1 100644 --- a/mg.c +++ b/mg.c @@ -67,11 +67,11 @@ Perl_mg_magical(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; if (vtbl) { - if ((vtbl->svt_get != NULL) && !(mg->mg_flags & MGf_GSKIP)) + if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP)) SvGMAGICAL_on(sv); if (vtbl->svt_set) SvSMAGICAL_on(sv); - if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || (vtbl->svt_clear != NULL)) + if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear) SvRMAGICAL_on(sv); } } @@ -92,7 +92,7 @@ Perl_mg_get(pTHX_ SV *sv) mgp = &SvMAGIC(sv); while ((mg = *mgp) != 0) { MGVTBL* vtbl = mg->mg_virtual; - if (!(mg->mg_flags & MGf_GSKIP) && vtbl && (vtbl->svt_get != NULL)) { + if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg); /* Ignore this magic if it's been deleted */ if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) && @@ -130,7 +130,7 @@ Perl_mg_set(pTHX_ SV *sv) mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */ (SSPTR(mgs_ix, MGS*))->mgs_flags = 0; } - if (vtbl && (vtbl->svt_set != NULL)) + if (vtbl && vtbl->svt_set) CALL_FPTR(vtbl->svt_set)(aTHX_ sv, mg); } @@ -147,7 +147,7 @@ Perl_mg_length(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; - if (vtbl && (vtbl->svt_len != NULL)) { + if (vtbl && vtbl->svt_len) { I32 mgs_ix; mgs_ix = SSNEW(sizeof(MGS)); @@ -171,7 +171,7 @@ Perl_mg_size(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; - if (vtbl && (vtbl->svt_len != NULL)) { + if (vtbl && vtbl->svt_len) { I32 mgs_ix; mgs_ix = SSNEW(sizeof(MGS)); @@ -209,7 +209,7 @@ Perl_mg_clear(pTHX_ SV *sv) MGVTBL* vtbl = mg->mg_virtual; /* omit GSKIP -- never set here */ - if (vtbl && (vtbl->svt_clear != NULL)) + if (vtbl && vtbl->svt_clear) CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg); } @@ -252,7 +252,7 @@ Perl_mg_free(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = moremagic) { MGVTBL* vtbl = mg->mg_virtual; moremagic = mg->mg_moremagic; - if (vtbl && (vtbl->svt_free != NULL)) + if (vtbl && vtbl->svt_free) CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') if (mg->mg_len >= 0) @@ -406,8 +406,19 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) case '\004': /* ^D */ sv_setiv(sv, (IV)(PL_debug & 32767)); +#if defined(YYDEBUG) && defined(DEBUGGING) + PL_yydebug = (PL_debug & 1); +#endif break; case '\005': /* ^E */ +#ifdef MACOS_TRADITIONAL + { + char msg[256]; + + sv_setnv(sv,(double)gLastMacOSErr); + sv_setpv(sv, gLastMacOSErr ? GetSysErrText(gLastMacOSErr, msg) : ""); + } +#else #ifdef VMS { # include @@ -453,6 +464,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) #endif #endif #endif +#endif SvNOK_on(sv); /* what a wonderful hack! */ break; case '\006': /* ^F */ @@ -656,26 +668,32 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) break; case '(': sv_setiv(sv, (IV)PL_gid); - Perl_sv_setpvf(aTHX_ sv, "%Vd", (IV)PL_gid); +#ifdef HAS_GETGROUPS + Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_gid); +#endif goto add_groups; case ')': sv_setiv(sv, (IV)PL_egid); - Perl_sv_setpvf(aTHX_ sv, "%Vd", (IV)PL_egid); +#ifdef HAS_GETGROUPS + Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_egid); +#endif add_groups: #ifdef HAS_GETGROUPS { Groups_t gary[NGROUPS]; i = getgroups(NGROUPS,gary); while (--i >= 0) - Perl_sv_catpvf(aTHX_ sv, " %Vd", (IV)gary[i]); + Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, gary[i]); } #endif SvIOK_on(sv); /* what a wonderful hack! */ break; case '*': break; +#ifndef MACOS_TRADITIONAL case '0': break; +#endif #ifdef USE_THREADS case '@': sv_setsv(sv, thr->errsv); @@ -807,7 +825,10 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) #if defined(VMS) Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system"); #else -# ifdef WIN32 +# ifdef PERL_IMPLICIT_SYS + PerlEnv_clearenv(); +# else +# ifdef WIN32 char *envv = GetEnvironmentStrings(); char *cur = envv; STRLEN len; @@ -823,13 +844,13 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) cur += len+1; } FreeEnvironmentStrings(envv); -# else -# ifdef CYGWIN +# else +# ifdef CYGWIN I32 i; for (i = 0; environ[i]; i++) - Safefree(environ[i]); -# else -# ifndef PERL_USE_SAFE_PUTENV + safesysfree(environ[i]); +# else +# ifndef PERL_USE_SAFE_PUTENV I32 i; if (environ == PL_origenviron) @@ -837,12 +858,13 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) else for (i = 0; environ[i]; i++) safesysfree(environ[i]); -# endif /* PERL_USE_SAFE_PUTENV */ -# endif /* CYGWIN */ +# endif /* PERL_USE_SAFE_PUTENV */ +# endif /* CYGWIN */ environ[0] = Nullch; -# endif /* WIN32 */ +# endif /* WIN32 */ +# endif /* PERL_IMPLICIT_SYS */ #endif /* VMS */ return 0; } @@ -1126,7 +1148,7 @@ int Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key) { dSP; - char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY"; + const char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY"; ENTER; SAVETMPS; @@ -1167,7 +1189,7 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) i = SvTRUE(sv); svp = av_fetch(GvAV(gv), atoi(MgPV(mg,n_a)), FALSE); - if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp))) + if (svp && SvIOKp(*svp) && (o = INT2PTR(OP*,SvIVX(*svp)))) o->op_private = i; else if (ckWARN_d(WARN_INTERNAL)) Perl_warner(aTHX_ WARN_INTERNAL, "Can't break at that line\n"); @@ -1568,15 +1590,19 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) DEBUG_x(dump_all()); break; case '\005': /* ^E */ -#ifdef VMS - set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); +#ifdef MACOS_TRADITIONAL + gLastMacOSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); #else -# ifdef WIN32 - SetLastError( SvIV(sv) ); +# ifdef VMS + set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); # else -# ifndef OS2 +# ifdef WIN32 + SetLastError( SvIV(sv) ); +# else +# ifndef OS2 /* will anyone ever use this? */ SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4); +# endif # endif # endif #endif @@ -1640,12 +1666,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_dowarn |= G_WARN_ONCE ; } } - } + } break; case '.': if (PL_localizing) { if (PL_localizing == 1) - save_sptr((SV**)&PL_last_in_gv); + SAVESPTR(PL_last_in_gv); } else if (SvOK(sv) && GvIO(PL_last_in_gv)) IoLINES(GvIOp(PL_last_in_gv)) = (long)SvIV(sv); @@ -1699,8 +1725,10 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) case '\\': if (PL_ors) Safefree(PL_ors); - if (SvOK(sv) || SvGMAGICAL(sv)) - PL_ors = savepv(SvPV(sv,PL_orslen)); + if (SvOK(sv) || SvGMAGICAL(sv)) { + s = SvPV(sv,PL_orslen); + PL_ors = savepvn(s,PL_orslen); + } else { PL_ors = Nullch; PL_orslen = 0; @@ -1871,6 +1899,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) case ':': PL_chopset = SvPV_force(sv,len); break; +#ifndef MACOS_TRADITIONAL case '0': if (!PL_origalen) { s = PL_origargv[0]; @@ -1928,6 +1957,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_origargv[i] = Nullch; } break; +#endif #ifdef USE_THREADS case '@': sv_setsv(thr->errsv, sv); @@ -1942,8 +1972,9 @@ int Perl_magic_mutexfree(pTHX_ SV *sv, MAGIC *mg) { dTHR; - DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%lx: magic_mutexfree 0x%lx\n", - (unsigned long)thr, (unsigned long)sv);) + DEBUG_S(PerlIO_printf(Perl_debug_log, + "0x%"UVxf": magic_mutexfree 0x%"UVxf"\n", + PTR2UV(thr), PTR2UV(sv));) if (MgOWNER(mg)) Perl_croak(aTHX_ "panic: magic_mutexfree"); MUTEX_DESTROY(MgMUTEXP(mg)); @@ -2067,7 +2098,6 @@ cleanup: #ifdef PERL_OBJECT -#define NO_XSLOCKS #include "XSUB.h" #endif