X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=fdaf3bb005a029c813a618293c261300ef3d685c;hb=363b4d598618baccb2a68ae886e2608f45cd3cb5;hp=09be2f7bdb740003b3e743d7169d5c2299d3938a;hpb=ed344e4f516e393bcdfd181ec61ffbb056bebd56;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index 09be2f7..fdaf3bb 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) @@ -408,6 +408,14 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) sv_setiv(sv, (IV)(PL_debug & 32767)); 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 +461,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 +665,28 @@ 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); + Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_gid); goto add_groups; case ')': sv_setiv(sv, (IV)PL_egid); - Perl_sv_setpvf(aTHX_ sv, "%Vd", (IV)PL_egid); + Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_egid); 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); @@ -1126,7 +1137,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; @@ -1568,15 +1579,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,7 +1655,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_dowarn |= G_WARN_ONCE ; } } - } + } break; case '.': if (PL_localizing) { @@ -1699,8 +1714,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 +1888,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 +1946,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 +1961,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 +2087,6 @@ cleanup: #ifdef PERL_OBJECT -#define NO_XSLOCKS #include "XSUB.h" #endif