if (!sv) {
AvARYLEN(av) = sv = NEWSV(0,0);
sv_upgrade(sv, SVt_IV);
- sv_magic(sv, (SV*)av, '#', Nullch, 0);
+ sv_magic(sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0);
}
SETs(sv);
RETURN;
if (PL_op->op_flags & OPf_MOD || LVRET) {
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
- sv_magic(TARG, Nullsv, '.', Nullch, 0);
+ sv_magic(TARG, Nullsv, PERL_MAGIC_pos, Nullch, 0);
}
LvTYPE(TARG) = '.';
MAGIC* mg;
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
- mg = mg_find(sv, 'g');
+ mg = mg_find(sv, PERL_MAGIC_regex_global);
if (mg && mg->mg_len >= 0) {
I32 i = mg->mg_len;
if (DO_UTF8(sv))
else if (n && str[0] == ';' && seen_question)
goto set; /* XXXX system, exec */
if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
- && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
+ && (oa & (OA_OPTIONAL - 1)) <= OA_SCALARREF
+ /* But globs are already references (kinda) */
+ && (oa & (OA_OPTIONAL - 1)) != OA_FILEREF
+ ) {
str[n++] = '\\';
}
- /* What to do with R ((un)tie, tied, (sys)read, recv)? */
str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
oa = oa >> 4;
}
}
SvSCREAM_on(sv);
- sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */
+ /* piggyback on m//g magic */
+ sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0);
RETPUSHYES;
}
RETPUSHNO;
switch (SvTYPE(sv)) {
case SVt_PVAV:
- if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
+ if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)
+ || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
RETPUSHYES;
break;
case SVt_PVHV:
- if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
+ if (HvARRAY(sv) || SvGMAGICAL(sv)
+ || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
RETPUSHYES;
break;
case SVt_PVCV:
{
dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
- UV left;
- UV right;
+ UV left = 0;
+ UV right = 0;
bool left_neg;
bool right_neg;
bool use_double = 0;
- NV dright;
- NV dleft;
+ NV dright = 0.0;
+ NV dleft = 0.0;
if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
IV i = SvIVX(POPs);
/* Unless the left argument is integer in range we are going to have to
use NV maths. Hence only attempt to coerce the right argument if
we know the left is integer. */
- register UV auv;
- bool auvok;
+ register UV auv = 0;
+ bool auvok = FALSE;
bool a_valid = 0;
if (!useleft) {
PP(pp_ne)
{
dSP; tryAMAGICbinSET(ne,0);
+#ifndef NV_PRESERVES_UV
+ if (SvROK(TOPs) && SvROK(TOPm1s)) {
+ SETs(boolSV(SvRV(TOPs) != SvRV(TOPm1s)));
+ RETURN;
+ }
+#endif
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_scmp)
{
dSP; dTARGET; tryAMAGICbin(scmp,0);
-#ifndef NV_PRESERVES_UV
- if (SvROK(TOPs) && SvROK(TOPm1s)) {
- SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
- RETURN;
- }
-#endif
{
dPOPTOPssrl;
int cmp = ((PL_op->op_private & OPpLOCALE)
dSP; dTARGET;
char *tmps;
STRLEN argtype;
- STRLEN n_a;
+ STRLEN len;
- tmps = POPpx;
+ tmps = (SvPVx(POPs, len));
argtype = 1; /* allow underscores */
- XPUSHn(scan_hex(tmps, 99, &argtype));
+ XPUSHn(scan_hex(tmps, len, &argtype));
RETURN;
}
NV value;
STRLEN argtype;
char *tmps;
- STRLEN n_a;
+ STRLEN len;
- tmps = POPpx;
- while (*tmps && isSPACE(*tmps))
- tmps++;
+ tmps = (SvPVx(POPs, len));
+ while (*tmps && len && isSPACE(*tmps))
+ tmps++, len--;
if (*tmps == '0')
- tmps++;
+ tmps++, len--;
argtype = 1; /* allow underscores */
if (*tmps == 'x')
- value = scan_hex(++tmps, 99, &argtype);
+ value = scan_hex(++tmps, --len, &argtype);
else if (*tmps == 'b')
- value = scan_bin(++tmps, 99, &argtype);
+ value = scan_bin(++tmps, --len, &argtype);
else
- value = scan_oct(tmps, 99, &argtype);
+ value = scan_oct(tmps, len, &argtype);
XPUSHn(value);
RETURN;
}
{
dSP; dTARGET;
SV *sv;
- I32 len;
+ I32 len = 0;
STRLEN curlen;
STRLEN utf8_curlen;
I32 pos;
sv_pos_u2b(sv, &pos, &rem);
tmps += pos;
sv_setpvn(TARG, tmps, rem);
+#ifdef USE_LOCALE_COLLATE
+ sv_unmagic(TARG, PERL_MAGIC_collxfrm);
+#endif
if (utf8_curlen)
SvUTF8_on(TARG);
if (repl) {
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
- sv_magic(TARG, Nullsv, 'x', Nullch, 0);
+ sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);
}
LvTYPE(TARG) = 'x';
if (lvalue) { /* it's an lvalue! */
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
- sv_magic(TARG, Nullsv, 'v', Nullch, 0);
+ sv_magic(TARG, Nullsv, PERL_MAGIC_vec, Nullch, 0);
}
LvTYPE(TARG) = 'v';
if (LvTARG(TARG) != src) {
(void)SvUPGRADE(TARG,SVt_PV);
- if (value > 255 && !IN_BYTE) {
+ if (value > 255 && !IN_BYTES) {
SvGROW(TARG, UNISKIP(value)+1);
tmps = (char*)uvchr_to_utf8((U8*)SvPVX(TARG), value);
SvCUR_set(TARG, tmps - SvPVX(TARG));
while (++MARK <= SP) {
SV *keysv = *MARK;
SV **svp;
- I32 preeminent = SvRMAGICAL(hv) ? 1 : hv_exists_ent(hv, keysv, 0);
+ I32 preeminent = SvRMAGICAL(hv) ? 1 :
+ realhv ? hv_exists_ent(hv, keysv, 0)
+ : avhv_exists_ent((AV*)hv, keysv, 0);
if (realhv) {
HE *he = hv_fetch_ent(hv, keysv, lval, 0);
svp = he ? &HeVAL(he) : 0;
SV **tmparyval = 0;
MAGIC *mg;
- if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+ if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
*MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
register SV *sv = &PL_sv_undef;
MAGIC *mg;
- if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+ if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
*MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
register I32 i = 0;
MAGIC *mg;
- if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+ if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
*MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
register char *patend = pat + llen;
I32 datumtype;
register I32 len;
- register I32 bits;
+ register I32 bits = 0;
register char *str;
/* These must not be in registers: */
float afloat;
double adouble;
I32 checksum = 0;
- register U32 culong;
- NV cdouble;
+ register U32 culong = 0;
+ NV cdouble = 0.0;
int commas = 0;
int star;
#ifdef PERL_NATINT_PACK
case 'c':
while (len-- > 0) {
fromstr = NEXTFROM;
- aint = SvIV(fromstr);
- achar = aint;
- sv_catpvn(cat, &achar, sizeof(char));
+ switch (datumtype) {
+ case 'C':
+ aint = SvIV(fromstr);
+ if ((aint < 0 || aint > 255) &&
+ ckWARN(WARN_PACK))
+ Perl_warner(aTHX_ WARN_PACK,
+ "Character in \"C\" format wrapped");
+ achar = aint & 255;
+ sv_catpvn(cat, &achar, sizeof(char));
+ break;
+ case 'c':
+ aint = SvIV(fromstr);
+ if ((aint < -128 || aint > 127) &&
+ ckWARN(WARN_PACK))
+ Perl_warner(aTHX_ WARN_PACK,
+ "Character in \"c\" format wrapped");
+ achar = aint & 255;
+ sv_catpvn(cat, &achar, sizeof(char));
+ break;
+ }
}
break;
case 'U':
av_extend(ary,0);
av_clear(ary);
SPAGAIN;
- if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+ if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)ary, mg));
}
void
Perl_unlock_condpair(pTHX_ void *svv)
{
- MAGIC *mg = mg_find((SV*)svv, 'm');
+ MAGIC *mg = mg_find((SV*)svv, PERL_MAGIC_mutex);
if (!mg)
Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex");
projects / p5sagit/p5-mst-13.2.git / blobdiff