From: Gurusamy Sarathy Date: Mon, 2 Jul 2001 07:12:10 +0000 (+0000) Subject: win32 fixes: fix various syntax errors ("no preprocessor directives X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=25716404fbbde2ca91832aab8c9157aafcdcc7e8;p=p5sagit%2Fp5-mst-13.2.git win32 fixes: fix various syntax errors ("no preprocessor directives within macro arguments") and warnings ("unary minus applied to unsigned type", among others) p4raw-id: //depot/perl@11066 --- diff --git a/gv.c b/gv.c index bbe8d47..1851f8b 100644 --- a/gv.c +++ b/gv.c @@ -1361,15 +1361,11 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0; #ifdef DEBUGGING int fl=0; - HV* stash=NULL; #endif + HV* stash=NULL; if (!(AMGf_noleft & flags) && SvAMAGIC(left) - && (mg = mg_find((SV*)( -#ifdef DEGUGGING - stash= -#endif - SvSTASH(SvRV(left))), - PERL_MAGIC_overload_table)) + && (stash = SvSTASH(SvRV(left))) + && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table)) && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table : (CV **) NULL)) @@ -1486,12 +1482,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } if (!cv) goto not_found; } else if (!(AMGf_noright & flags) && SvAMAGIC(right) - && (mg = mg_find((SV*)( -#ifdef DEBUGGING - stash= -#endif - SvSTASH(SvRV(right))), - PERL_MAGIC_overload_table)) + && (stash = SvSTASH(SvRV(right))) + && (mg = mg_find((SV*)stash, PERL_MAGIC_overload_table)) && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (amtp = (AMT*)mg->mg_ptr)->table : (CV **) NULL)) @@ -1590,7 +1582,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) flags & AMGf_unary? "" : lr==1 ? " for right argument": " for left argument", flags & AMGf_unary? " for argument" : "", - HvNAME(stash), + stash ? HvNAME(stash) : "null", fl? ",\n\tassignment variant used": "") ); } #endif diff --git a/hv.c b/hv.c index 48cb2cc..76180f2 100644 --- a/hv.c +++ b/hv.c @@ -441,7 +441,7 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 has #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv, PERL_MAGIC_env)) { key = savepvn(key,klen); - key = strupr(key); + key = (const char*)strupr((char*)key); hash = 0; } #endif @@ -598,9 +598,9 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash) entry = new_HE(); if (HvSHAREKEYS(hv)) - HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash); + HeKEY_hek(entry) = share_hek(key, is_utf8?-(I32)klen:klen, hash); else /* gotta do the real thing */ - HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash); + HeKEY_hek(entry) = save_hek(key, is_utf8?-(I32)klen:klen, hash); if (key != keysave) Safefree(key); HeVAL(entry) = val; diff --git a/op.c b/op.c index 90e86e0..b15f9bc 100644 --- a/op.c +++ b/op.c @@ -6901,9 +6901,9 @@ Perl_peep(pTHX_ register OP *o) svp = cSVOPx_svp(((BINOP*)o)->op_last); if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) { key = SvPV(sv, keylen); - if (SvUTF8(sv)) - keylen = -keylen; - lexname = newSVpvn_share(key, keylen, 0); + lexname = newSVpvn_share(key, + SvUTF8(sv) ? -(I32)keylen : keylen, + 0); SvREFCNT_dec(sv); *svp = lexname; } @@ -6921,9 +6921,8 @@ Perl_peep(pTHX_ register OP *o) if (!fields || !GvHV(*fields)) break; key = SvPV(*svp, keylen); - if (SvUTF8(*svp)) - keylen = -keylen; - indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE); + indsvp = hv_fetch(GvHV(*fields), key, + SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE); if (!indsvp) { Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" in variable %s of type %s", key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname))); @@ -6988,9 +6987,8 @@ Perl_peep(pTHX_ register OP *o) key_op = (SVOP*)key_op->op_sibling) { svp = cSVOPx_svp(key_op); key = SvPV(*svp, keylen); - if (SvUTF8(*svp)) - keylen = -keylen; - indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE); + indsvp = hv_fetch(GvHV(*fields), key, + SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE); if (!indsvp) { Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" " "in variable %s of type %s", diff --git a/pp.c b/pp.c index 0b74794..51e10de 100644 --- a/pp.c +++ b/pp.c @@ -943,7 +943,7 @@ PP(pp_multiply) /* 2s complement assumption that (UV)-IV_MIN is correct. */ /* -ve result, which could overflow an IV */ SP--; - SETi( -product ); + SETi( -(IV)product ); RETURN; } /* else drop to NVs below. */ } else { @@ -980,7 +980,7 @@ PP(pp_multiply) /* 2s complement assumption again */ /* -ve result, which could overflow an IV */ SP--; - SETi( -product_low ); + SETi( -(IV)product_low ); RETURN; } /* else drop to NVs below. */ } diff --git a/sv.c b/sv.c index 6ed638c..630603f 100644 --- a/sv.c +++ b/sv.c @@ -4101,7 +4101,7 @@ Perl_sv_force_normal_flags(pTHX_ register SV *sv, U32 flags) *SvEND(sv) = '\0'; SvFAKE_off(sv); SvREADONLY_off(sv); - unsharepvn(pvx,SvUTF8(sv)?-len:len,hash); + unsharepvn(pvx, SvUTF8(sv) ? -(I32)len : len, hash); } else if (PL_curcop != &PL_compiling) Perl_croak(aTHX_ PL_no_modify); @@ -4946,7 +4946,9 @@ Perl_sv_clear(pTHX_ register SV *sv) else if (SvPVX(sv) && SvLEN(sv)) Safefree(SvPVX(sv)); else if (SvPVX(sv) && SvREADONLY(sv) && SvFAKE(sv)) { - unsharepvn(SvPVX(sv),SvUTF8(sv)?-SvCUR(sv):SvCUR(sv),SvUVX(sv)); + unsharepvn(SvPVX(sv), + SvUTF8(sv) ? -(I32)SvCUR(sv) : SvCUR(sv), + SvUVX(sv)); SvFAKE_off(sv); } break; diff --git a/toke.c b/toke.c index e177cef..55f656a 100644 --- a/toke.c +++ b/toke.c @@ -1257,7 +1257,7 @@ S_scan_const(pTHX_ char *start) char *e = d++; while (e-- > c) *(e + 1) = *e; - *c = UTF_TO_NATIVE(0xff); + *c = (char)UTF_TO_NATIVE(0xff); /* mark the range as done, and continue */ dorange = FALSE; didrange = TRUE; @@ -1308,7 +1308,7 @@ S_scan_const(pTHX_ char *start) Perl_croak(aTHX_ "Ambiguous range in transliteration operator"); } if (has_utf8) { - *d++ = UTF_TO_NATIVE(0xff); /* use illegal utf8 byte--see pmtrans */ + *d++ = (char)UTF_TO_NATIVE(0xff); /* use illegal utf8 byte--see pmtrans */ s++; continue; }