static I32 sortcv _((SV *a, SV *b));
static void qsortsv _((SV **array, size_t num_elts, I32 (*fun)(SV *a, SV *b)));
static OP *doeval _((int gimme, OP** startop));
+static I32 sv_ncmp _((SV *a, SV *b));
+static I32 sv_i_ncmp _((SV *a, SV *b));
+static I32 amagic_ncmp _((SV *a, SV *b));
+static I32 amagic_i_ncmp _((SV *a, SV *b));
static I32 amagic_cmp _((SV *str1, SV *str2));
static I32 amagic_cmp_locale _((SV *str1, SV *str2));
#endif
/* Are we done */
if (cx->sb_once || !CALLREGEXEC(rx, s, cx->sb_strend, orig,
- s == m, Nullsv, NULL,
- cx->sb_safebase ? 0 : REXEC_COPY_STR))
+ s == m, cx->sb_targ, NULL,
+ ((cx->sb_rflags & REXEC_COPY_STR)
+ ? REXEC_IGNOREPOS
+ : (REXEC_COPY_STR|REXEC_IGNOREPOS))))
{
SV *targ = cx->sb_targ;
sv_catpvn(dstr, s, cx->sb_strend - s);
break;
case FF_MORE:
- if (itemsize) {
+ s = chophere;
+ send = item + len;
+ if (chopspace) {
+ while (*s && isSPACE(*s) && s < send)
+ s++;
+ }
+ if (s < send) {
arg = fieldsize - itemsize;
if (arg) {
fieldsize -= arg;
ENTER; /* enter outer scope */
SAVETMPS;
-#ifdef USE_THREADS
- /* SAVE_DEFSV does *not* suffice here */
- save_sptr(&THREADSV(0));
-#else
- SAVESPTR(GvSV(PL_defgv));
-#endif /* USE_THREADS */
+ /* SAVE_DEFSV does *not* suffice here for USE_THREADS */
+ SAVESPTR(DEFSV);
ENTER; /* enter inner scope */
SAVESPTR(PL_curpm);
}
}
+STATIC I32
+sv_ncmp (SV *a, SV *b)
+{
+ double nv1 = SvNV(a);
+ double nv2 = SvNV(b);
+ return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
+}
+STATIC I32
+sv_i_ncmp (SV *a, SV *b)
+{
+ IV iv1 = SvIV(a);
+ IV iv2 = SvIV(b);
+ return iv1 < iv2 ? -1 : iv1 > iv2 ? 1 : 0;
+}
#define tryCALL_AMAGICbin(left,right,meth,svp) STMT_START { \
*svp = Nullsv; \
if (PL_amagic_generation) { \
} STMT_END
STATIC I32
+amagic_ncmp(register SV *a, register SV *b)
+{
+ SV *tmpsv;
+ tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
+ if (tmpsv) {
+ double d;
+
+ if (SvIOK(tmpsv)) {
+ I32 i = SvIVX(tmpsv);
+ if (i > 0)
+ return 1;
+ return i? -1 : 0;
+ }
+ d = SvNV(tmpsv);
+ if (d > 0)
+ return 1;
+ return d? -1 : 0;
+ }
+ return sv_ncmp(a, b);
+}
+
+STATIC I32
+amagic_i_ncmp(register SV *a, register SV *b)
+{
+ SV *tmpsv;
+ tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
+ if (tmpsv) {
+ double d;
+
+ if (SvIOK(tmpsv)) {
+ I32 i = SvIVX(tmpsv);
+ if (i > 0)
+ return 1;
+ return i? -1 : 0;
+ }
+ d = SvNV(tmpsv);
+ if (d > 0)
+ return 1;
+ return d? -1 : 0;
+ }
+ return sv_i_ncmp(a, b);
+}
+
+STATIC I32
amagic_cmp(register SV *str1, register SV *str2)
{
SV *tmpsv;
if (*up = *++MARK) { /* Weed out nulls. */
SvTEMP_off(*up);
if (!PL_sortcop && !SvPOK(*up)) {
+ STRLEN n_a;
if (SvAMAGIC(*up))
overloading = 1;
else
- (void)sv_2pv(*up, &PL_na);
+ (void)sv_2pv(*up, &n_a);
}
up++;
}
qsortsv((myorigmark+1), max, FUNC_NAME_TO_PTR(sortcv));
POPBLOCK(cx,PL_curpm);
+ PL_stack_sp = newsp;
POPSTACK;
CATCH_SET(oldcatch);
}
if (max > 1) {
MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */
qsortsv(ORIGMARK+1, max,
- (PL_op->op_private & OPpLOCALE)
- ? ( overloading
- ? FUNC_NAME_TO_PTR(amagic_cmp_locale)
- : FUNC_NAME_TO_PTR(sv_cmp_locale))
- : ( overloading
- ? FUNC_NAME_TO_PTR(amagic_cmp)
- : FUNC_NAME_TO_PTR(sv_cmp) ));
+ (PL_op->op_private & OPpSORT_NUMERIC)
+ ? ( (PL_op->op_private & OPpSORT_INTEGER)
+ ? ( overloading
+ ? FUNC_NAME_TO_PTR(amagic_i_ncmp)
+ : FUNC_NAME_TO_PTR(sv_i_ncmp))
+ : ( overloading
+ ? FUNC_NAME_TO_PTR(amagic_ncmp)
+ : FUNC_NAME_TO_PTR(sv_ncmp)))
+ : ( (PL_op->op_private & OPpLOCALE)
+ ? ( overloading
+ ? FUNC_NAME_TO_PTR(amagic_cmp_locale)
+ : FUNC_NAME_TO_PTR(sv_cmp_locale))
+ : ( overloading
+ ? FUNC_NAME_TO_PTR(amagic_cmp)
+ : FUNC_NAME_TO_PTR(sv_cmp) )));
+ if (PL_op->op_private & OPpSORT_REVERSE) {
+ SV **p = ORIGMARK+1;
+ SV **q = ORIGMARK+max;
+ while (p < q) {
+ SV *tmp = *p;
+ *p++ = *q;
+ *q-- = tmp;
+ }
+ }
}
}
LEAVE;
if (GIMME == G_ARRAY) {
dPOPPOPssrl;
- register I32 i;
+ register I32 i, j;
register SV *sv;
I32 max;
+ if (SvGMAGICAL(left))
+ mg_get(left);
+ if (SvGMAGICAL(right))
+ mg_get(right);
+
if (SvNIOKp(left) || !SvPOKp(left) ||
(looks_like_number(left) && *SvPVX(left) != '0') )
{
- if (SvNV(left) < IV_MIN || SvNV(right) >= IV_MAX)
+ if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX)
croak("Range iterator outside integer range");
i = SvIV(left);
max = SvIV(right);
if (max >= i) {
- EXTEND_MORTAL(max - i + 1);
- EXTEND(SP, max - i + 1);
+ j = max - i + 1;
+ EXTEND_MORTAL(j);
+ EXTEND(SP, j);
}
- while (i <= max) {
+ else
+ j = 0;
+ while (j--) {
sv = sv_2mortal(newSViv(i++));
PUSHs(sv);
}
}
else {
SV *final = sv_mortalcopy(right);
- STRLEN len;
+ STRLEN len, n_a;
char *tmps = SvPV(final, len);
sv = sv_mortalcopy(left);
- SvPV_force(sv,PL_na);
+ SvPV_force(sv,n_a);
while (!SvNIOKp(sv) && SvCUR(sv) <= len) {
XPUSHs(sv);
if (strEQ(SvPVX(sv),tmps))
die_where(char *message)
{
dSP;
+ STRLEN n_a;
if (PL_in_eval) {
I32 cxix;
register PERL_CONTEXT *cx;
SvGROW(err, SvCUR(err)+sizeof(prefix)+klen);
sv_catpvn(err, prefix, sizeof(prefix)-1);
sv_catpvn(err, message, klen);
+ if (ckWARN(WARN_UNSAFE)) {
+ STRLEN start = SvCUR(err)-klen-sizeof(prefix)+1;
+ warner(WARN_UNSAFE, SvPVX(err)+start);
+ }
}
sv_inc(*svp);
}
sv_setpv(ERRSV, message);
}
else
- message = SvPVx(ERRSV, PL_na);
+ message = SvPVx(ERRSV, n_a);
while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) {
dounwind(-1);
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPVx(ERRSV, PL_na);
+ char* msg = SvPVx(ERRSV, n_a);
DIE("%s", *msg ? msg : "Compilation failed in require");
}
return pop_return();
}
}
if (!message)
- message = SvPVx(ERRSV, PL_na);
+ message = SvPVx(ERRSV, n_a);
PerlIO_printf(PerlIO_stderr(), "%s",message);
PerlIO_flush(PerlIO_stderr());
my_failure_exit();
{
djSP;
char *tmps;
+ STRLEN n_a;
if (MAXARG < 1)
tmps = "";
else
- tmps = POPp;
+ tmps = POPpx;
sv_reset(tmps, PL_curcop->cop_stash);
PUSHs(&PL_sv_yes);
RETURN;
SAVETMPS;
#ifdef USE_THREADS
- if (PL_op->op_flags & OPf_SPECIAL)
- svp = save_threadsv(PL_op->op_targ); /* per-thread variable */
+ if (PL_op->op_flags & OPf_SPECIAL) {
+ dTHR;
+ svp = &THREADSV(PL_op->op_targ); /* per-thread variable */
+ SAVEGENERICSV(*svp);
+ *svp = NEWSV(0,0);
+ }
else
#endif /* USE_THREADS */
if (PL_op->op_targ) {
SAVESPTR(*svp);
}
else {
- GV *gv = (GV*)POPs;
- (void)save_scalar(gv);
- svp = &GvSV(gv); /* symbol table variable */
+ svp = &GvSV((GV*)POPs); /* symbol table variable */
+ SAVEGENERICSV(*svp);
+ *svp = NEWSV(0,0);
}
ENTER;
OP *enterops[GOTO_DEPTH];
char *label;
int do_dump = (PL_op->op_type == OP_DUMP);
+ static char must_have_label[] = "goto must have label";
label = 0;
if (PL_op->op_flags & OPf_STACKED) {
SV *sv = POPs;
+ STRLEN n_a;
/* This egregious kludge implements goto &subroutine */
if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) {
RETURNOP(CvSTART(cv));
}
}
- else
- label = SvPV(sv,PL_na);
+ else {
+ label = SvPV(sv,n_a);
+ if (!(do_dump || *label))
+ DIE(must_have_label);
+ }
}
else if (PL_op->op_flags & OPf_SPECIAL) {
if (! do_dump)
- DIE("goto must have label");
+ DIE(must_have_label);
}
else
label = cPVOP->op_pv;
if (PL_multiline)
PL_op = PL_op->op_next; /* can't assume anything */
else {
- match = *(SvPVx(GvSV(cCOP->cop_gv), PL_na)) & 255;
+ STRLEN n_a;
+ match = *(SvPVx(GvSV(cCOP->cop_gv), n_a)) & 255;
match -= cCOP->uop.scop.scop_offset;
if (match < 0)
match = 0;
I32 gimme;
PERL_CONTEXT *cx;
I32 optype = 0; /* Might be reset by POPEVAL. */
+ STRLEN n_a;
PL_op = saveop;
if (PL_eval_root) {
lex_end();
LEAVE;
if (optype == OP_REQUIRE) {
- char* msg = SvPVx(ERRSV, PL_na);
+ char* msg = SvPVx(ERRSV, n_a);
DIE("%s", *msg ? msg : "Compilation failed in require");
} else if (startop) {
- char* msg = SvPVx(ERRSV, PL_na);
+ char* msg = SvPVx(ERRSV, n_a);
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
SV** svp;
I32 gimme = G_SCALAR;
PerlIO *tryrsfp = 0;
+ STRLEN n_a;
sv = POPs;
if (SvNIOKp(sv) && !SvPOKp(sv)) {
SET_NUMERIC_STANDARD();
if (atof(PL_patchlevel) + 0.00000999 < SvNV(sv))
DIE("Perl %s required--this is only version %s, stopped",
- SvPV(sv,PL_na),PL_patchlevel);
+ SvPV(sv,n_a),PL_patchlevel);
RETPUSHYES;
}
name = SvPV(sv, len);
{
namesv = NEWSV(806, 0);
for (i = 0; i <= AvFILL(ar); i++) {
- char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na);
+ char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
#ifdef VMS
char *unixdir;
if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
sv_catpv(msg, " (did you run h2ph?)");
sv_catpv(msg, " (@INC contains:");
for (i = 0; i <= AvFILL(ar); i++) {
- char *dir = SvPVx(*av_fetch(ar, i, TRUE), PL_na);
+ char *dir = SvPVx(*av_fetch(ar, i, TRUE), n_a);
sv_setpvf(dirmsgsv, " %s", dir);
sv_catsv(msg, dirmsgsv);
}
projects / p5sagit/p5-mst-13.2.git / blobdiff