#define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
-static I32 sortcv(pTHXo_ SV *a, SV *b);
-static I32 sortcv_stacked(pTHXo_ SV *a, SV *b);
-static I32 sortcv_xsub(pTHXo_ SV *a, SV *b);
-static I32 sv_ncmp(pTHXo_ SV *a, SV *b);
-static I32 sv_i_ncmp(pTHXo_ SV *a, SV *b);
-static I32 amagic_ncmp(pTHXo_ SV *a, SV *b);
-static I32 amagic_i_ncmp(pTHXo_ SV *a, SV *b);
-static I32 amagic_cmp(pTHXo_ SV *a, SV *b);
-static I32 amagic_cmp_locale(pTHXo_ SV *a, SV *b);
-static I32 run_user_filter(pTHXo_ int idx, SV *buf_sv, int maxlen);
-
-#ifdef PERL_OBJECT
-static I32 sv_cmp_static(pTHXo_ SV *a, SV *b);
-static I32 sv_cmp_locale_static(pTHXo_ SV *a, SV *b);
-#else
+static I32 sortcv(pTHX_ SV *a, SV *b);
+static I32 sortcv_stacked(pTHX_ SV *a, SV *b);
+static I32 sortcv_xsub(pTHX_ SV *a, SV *b);
+static I32 sv_ncmp(pTHX_ SV *a, SV *b);
+static I32 sv_i_ncmp(pTHX_ SV *a, SV *b);
+static I32 amagic_ncmp(pTHX_ SV *a, SV *b);
+static I32 amagic_i_ncmp(pTHX_ SV *a, SV *b);
+static I32 amagic_cmp(pTHX_ SV *a, SV *b);
+static I32 amagic_cmp_locale(pTHX_ SV *a, SV *b);
+static I32 run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen);
+
#define sv_cmp_static Perl_sv_cmp
#define sv_cmp_locale_static Perl_sv_cmp_locale
-#endif
PP(pp_wantarray)
{
rxres_restore(&cx->sb_rxres, rx);
if (cx->sb_iters++) {
+ I32 saviters = cx->sb_iters;
if (cx->sb_iters > cx->sb_maxiters)
DIE(aTHX_ "Substitution loop");
POPSUBST(cx);
RETURNOP(pm->op_next);
}
+ cx->sb_iters = saviters;
}
if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
m = s;
cx->blk_sub.oldcurpad = PL_curpad;
cx->blk_sub.argarray = av;
}
- qsortsv((myorigmark+1), max,
- is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
+ sortsv((myorigmark+1), max,
+ is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
POPBLOCK(cx,PL_curpm);
PL_stack_sp = newsp;
else {
if (max > 1) {
MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */
- qsortsv(ORIGMARK+1, max,
- (PL_op->op_private & OPpSORT_NUMERIC)
+ sortsv(ORIGMARK+1, max,
+ (PL_op->op_private & OPpSORT_NUMERIC)
? ( (PL_op->op_private & OPpSORT_INTEGER)
? ( overloading ? amagic_i_ncmp : sv_i_ncmp)
: ( overloading ? amagic_ncmp : sv_ncmp))
#endif
PerlIO *serr = Perl_error_log;
- PerlIO_write(serr, message, msglen);
+ PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen);
(void)PerlIO_flush(serr);
#ifdef USE_SFIO
errno = e;
SAVESPTR(*svp);
#else
SAVEPADSV(PL_op->op_targ);
- iterdata = (void*)PL_op->op_targ;
+ iterdata = INT2PTR(void*, PL_op->op_targ);
cxtype |= CXp_PADVAR;
#endif
}
PL_stack_sp--; /* There is no cv arg. */
/* Push a mark for the start of arglist */
PUSHMARK(mark);
- (void)(*CvXSUB(cv))(aTHXo_ cv);
+ (void)(*CvXSUB(cv))(aTHX_ cv);
/* Pop the current context like a decent sub should */
POPBLOCK(cx, PL_curpm);
/* Do _not_ use PUTBACK, keep the XSUB's return stack! */
#ifdef VMS
if (anum == 1 && (PL_op->op_private & OPpEXIT_VMSISH))
anum = 0;
+ VMSISH_HUSHED = VMSISH_HUSHED || (PL_op->op_private & OPpHUSH_VMSISH);
#endif
}
PL_exit_flags |= PERL_EXIT_EXPECTED;
PL_error_count = 0;
PL_curcop = &PL_compiling;
PL_curcop->cop_arybase = 0;
- SvREFCNT_dec(PL_rs);
- PL_rs = newSVpvn("\n", 1);
if (saveop && saveop->op_flags & OPf_SPECIAL)
PL_in_eval |= EVAL_KEEPERR;
else
Perl_croak(aTHX_ "%sCompilation failed in regexp",
(*msg ? msg : "Unknown error\n"));
}
- SvREFCNT_dec(PL_rs);
- PL_rs = SvREFCNT_inc(PL_nrs);
#ifdef USE_5005THREADS
MUTEX_LOCK(&PL_eval_mutex);
PL_eval_owner = 0;
#endif /* USE_5005THREADS */
RETPUSHUNDEF;
}
- SvREFCNT_dec(PL_rs);
- PL_rs = SvREFCNT_inc(PL_nrs);
CopLINE_set(&PL_compiling, 0);
if (startop) {
*startop = PL_eval_root;
GV *filter_child_proc = 0;
SV *filter_state = 0;
SV *filter_sub = 0;
+ SV *hook_sv = 0;
sv = POPs;
if (SvNIOKp(sv)) {
"v%d.%d.%d, stopped", rev, ver, sver, PERL_REVISION,
PERL_VERSION, PERL_SUBVERSION);
}
+ if (ckWARN(WARN_PORTABLE))
+ Perl_warner(aTHX_ WARN_PORTABLE,
+ "v-string in use/require non-portable");
RETPUSHYES;
}
else if (!SvPOKp(sv)) { /* require 5.005_03 */
if (sver == 0 && (rev > 5 || (rev == 5 && ver >= 100))) {
DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--"
"this is only v%d.%d.%d, stopped"
- " (did you mean v%"UVuf".%"UVuf".0?)",
+ " (did you mean v%"UVuf".%03"UVuf"?)",
rev, ver, sver, PERL_REVISION, PERL_VERSION,
PERL_SUBVERSION, rev, ver/100);
}
}
Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
- PTR2UV(SvANY(loader)), name);
+ PTR2UV(SvRV(dirsv)), name);
tryname = SvPVX(namesv);
tryrsfp = 0;
LEAVE;
if (tryrsfp) {
+ hook_sv = dirsv;
break;
}
SETERRNO(0, SS$_NORMAL);
/* Assume success here to prevent recursive requirement. */
- (void)hv_store(GvHVn(PL_incgv), name, strlen(name),
- newSVpv(CopFILE(&PL_compiling), 0), 0 );
+ len = strlen(name);
+ /* Check whether a hook in @INC has already filled %INC */
+ if (!hook_sv || !(svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
+ (void)hv_store(GvHVn(PL_incgv), name, len,
+ (hook_sv ? SvREFCNT_inc(hook_sv)
+ : newSVpv(CopFILE(&PL_compiling), 0)),
+ 0 );
+ }
ENTER;
SAVETMPS;
#ifdef TESTHARNESS
#include <sys/types.h>
typedef void SV;
-#define pTHXo_
#define pTHX_
#define STATIC
#define New(ID,VAR,N,TYPE) VAR=(TYPE *)malloc((N)*sizeof(TYPE))
#define Safefree(VAR) free(VAR)
-typedef int (*SVCOMPARE_t) (pTHXo_ SV*, SV*);
+typedef int (*SVCOMPARE_t) (pTHX_ SV*, SV*);
#endif /* TESTHARNESS */
typedef char * aptr; /* pointer for arithmetic on sizes */
** They make convenient temporary pointers in other places.
*/
-STATIC void
-S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp)
+/*
+=for apidoc sortsv
+
+Sort an array. Here is an example:
+
+ sortsv(AvARRAY(av), av_len(av)+1, Perl_sv_cmp_locale);
+
+=cut
+*/
+
+void
+Perl_sortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp)
{
int i, run;
int sense;
return;
}
-
-#ifdef PERL_OBJECT
-#undef this
-#define this pPerl
-#include "XSUB.h"
-#endif
-
-
static I32
-sortcv(pTHXo_ SV *a, SV *b)
+sortcv(pTHX_ SV *a, SV *b)
{
I32 oldsaveix = PL_savestack_ix;
I32 oldscopeix = PL_scopestack_ix;
}
static I32
-sortcv_stacked(pTHXo_ SV *a, SV *b)
+sortcv_stacked(pTHX_ SV *a, SV *b)
{
I32 oldsaveix = PL_savestack_ix;
I32 oldscopeix = PL_scopestack_ix;
}
static I32
-sortcv_xsub(pTHXo_ SV *a, SV *b)
+sortcv_xsub(pTHX_ SV *a, SV *b)
{
dSP;
I32 oldsaveix = PL_savestack_ix;
*++SP = a;
*++SP = b;
PUTBACK;
- (void)(*CvXSUB(cv))(aTHXo_ cv);
+ (void)(*CvXSUB(cv))(aTHX_ cv);
if (PL_stack_sp != PL_stack_base + 1)
Perl_croak(aTHX_ "Sort subroutine didn't return single value");
if (!SvNIOKp(*PL_stack_sp))
static I32
-sv_ncmp(pTHXo_ SV *a, SV *b)
+sv_ncmp(pTHX_ SV *a, SV *b)
{
NV nv1 = SvNV(a);
NV nv2 = SvNV(b);
}
static I32
-sv_i_ncmp(pTHXo_ SV *a, SV *b)
+sv_i_ncmp(pTHX_ SV *a, SV *b)
{
IV iv1 = SvIV(a);
IV iv2 = SvIV(b);
} STMT_END
static I32
-amagic_ncmp(pTHXo_ register SV *a, register SV *b)
+amagic_ncmp(pTHX_ register SV *a, register SV *b)
{
SV *tmpsv;
tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
return 1;
return d? -1 : 0;
}
- return sv_ncmp(aTHXo_ a, b);
+ return sv_ncmp(aTHX_ a, b);
}
static I32
-amagic_i_ncmp(pTHXo_ register SV *a, register SV *b)
+amagic_i_ncmp(pTHX_ register SV *a, register SV *b)
{
SV *tmpsv;
tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
return 1;
return d? -1 : 0;
}
- return sv_i_ncmp(aTHXo_ a, b);
+ return sv_i_ncmp(aTHX_ a, b);
}
static I32
-amagic_cmp(pTHXo_ register SV *str1, register SV *str2)
+amagic_cmp(pTHX_ register SV *str1, register SV *str2)
{
SV *tmpsv;
tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
}
static I32
-amagic_cmp_locale(pTHXo_ register SV *str1, register SV *str2)
+amagic_cmp_locale(pTHX_ register SV *str1, register SV *str2)
{
SV *tmpsv;
tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
}
static I32
-run_user_filter(pTHXo_ int idx, SV *buf_sv, int maxlen)
+run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
{
SV *datasv = FILTER_DATA(idx);
int filter_has_file = IoLINES(datasv);
return len;
}
-
-#ifdef PERL_OBJECT
-
-static I32
-sv_cmp_locale_static(pTHXo_ register SV *str1, register SV *str2)
-{
- return sv_cmp_locale(str1, str2);
-}
-
-static I32
-sv_cmp_static(pTHXo_ register SV *str1, register SV *str2)
-{
- return sv_cmp(str1, str2);
-}
-
-#endif /* PERL_OBJECT */
projects / p5sagit/p5-mst-13.2.git / blobdiff