cx->sb_m = m = rx->startp[0] + orig;
sv_catpvn(dstr, s, m-s);
cx->sb_s = rx->endp[0] + orig;
+ { /* Update the pos() information. */
+ SV *sv = cx->sb_targ;
+ MAGIC *mg;
+ I32 i;
+ if (SvTYPE(sv) < SVt_PVMG)
+ SvUPGRADE(sv, SVt_PVMG);
+ if (!(mg = mg_find(sv, 'g'))) {
+ sv_magic(sv, Nullsv, 'g', Nullch, 0);
+ mg = mg_find(sv, 'g');
+ }
+ i = m - orig;
+ if (DO_UTF8(sv))
+ sv_pos_b2u(sv, &i);
+ mg->mg_len = i;
+ }
cx->sb_rxtainted |= RX_MATCH_TAINTED(rx);
rxres_save(&cx->sb_rxres, rx);
RETURNOP(pm->op_pmreplstart);
case FF_MORE: name = "MORE"; break;
case FF_LINEMARK: name = "LINEMARK"; break;
case FF_END: name = "END"; break;
+ case FF_0DECIMAL: name = "0DECIMAL"; break;
}
if (arg >= 0)
PerlIO_printf(Perl_debug_log, "%-16s%ld\n", name, (long) arg);
t += fieldsize;
break;
+ case FF_0DECIMAL:
+ /* If the field is marked with ^ and the value is undefined,
+ blank it out. */
+ arg = *fpc++;
+ if ((arg & 512) && !SvOK(sv)) {
+ arg = fieldsize;
+ while (arg--)
+ *t++ = ' ';
+ break;
+ }
+ gotsome = TRUE;
+ value = SvNV(sv);
+ /* Formats aren't yet marked for locales, so assume "yes". */
+ {
+ STORE_NUMERIC_STANDARD_SET_LOCAL();
+#if defined(USE_LONG_DOUBLE)
+ if (arg & 256) {
+ sprintf(t, "%#0*.*" PERL_PRIfldbl,
+ (int) fieldsize, (int) arg & 255, value);
+/* is this legal? I don't have long doubles */
+ } else {
+ sprintf(t, "%0*.0" PERL_PRIfldbl, (int) fieldsize, value);
+ }
+#else
+ if (arg & 256) {
+ sprintf(t, "%#0*.*f",
+ (int) fieldsize, (int) arg & 255, value);
+ } else {
+ sprintf(t, "%0*.0f",
+ (int) fieldsize, value);
+ }
+#endif
+ RESTORE_NUMERIC_STANDARD();
+ }
+ t += fieldsize;
+ break;
+
case FF_NEWLINE:
f++;
while (t-- > linemark && *t == ' ') ;
else {
dTOPss;
SV *targ = PAD_SV(PL_op->op_targ);
-
- if ((PL_op->op_private & OPpFLIP_LINENUM)
- ? (PL_last_in_gv && SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)))
- : SvTRUE(sv) ) {
+ int flip;
+
+ if (PL_op->op_private & OPpFLIP_LINENUM) {
+ struct io *gp_io;
+ flip = PL_last_in_gv
+ && (gp_io = GvIOp(PL_last_in_gv))
+ && SvIV(sv) == (IV)IoLINES(gp_io);
+ } else {
+ flip = SvTRUE(sv);
+ }
+ if (flip) {
sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1);
if (PL_op->op_flags & OPf_SPECIAL) {
sv_setiv(targ, 1);
LEAVE;
+ /* LEAVE could clobber PL_curcop (see save_re_context())
+ * XXX it might be better to find a way to avoid messing with
+ * PL_curcop in save_re_context() instead, but this is a more
+ * minimal fix --GSAR */
+ PL_curcop = cx->blk_oldcop;
+
if (optype == OP_REQUIRE) {
char* msg = SvPVx(ERRSV, n_a);
DIE(aTHX_ "%sCompilation failed in require",
AV* comppadlist;
I32 i;
- PL_in_eval = EVAL_INEVAL;
+ PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
+ ? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL))
+ : EVAL_INEVAL);
PUSHMARK(SP);
CvDEPTH(PL_compcv) = 1;
SP = PL_stack_base + POPMARK; /* pop original mark */
PL_op = saveop; /* The caller may need it. */
+ PL_lex_state = LEX_NOTPARSING; /* $^S needs this. */
#ifdef USE_THREADS
MUTEX_LOCK(&PL_eval_mutex);
PL_eval_owner = 0;
if (SvNIOKp(sv)) {
if (SvPOK(sv) && SvNOK(sv)) { /* require v5.6.1 */
UV rev = 0, ver = 0, sver = 0;
- I32 len;
+ STRLEN len;
U8 *s = (U8*)SvPVX(sv);
U8 *end = (U8*)SvPVX(sv) + SvCUR(sv);
if (s < end) {
- rev = utf8_to_uv(s, &len);
+ rev = utf8_to_uv(s, end - s, &len, 0);
s += len;
if (s < end) {
- ver = utf8_to_uv(s, &len);
+ ver = utf8_to_uv(s, end - s, &len, 0);
s += len;
if (s < end)
- sver = utf8_to_uv(s, &len);
+ sver = utf8_to_uv(s, end - s, &len, 0);
}
}
if (PERL_REVISION < rev
}
*fpc++ = s - base; /* fieldsize for FETCH */
*fpc++ = FF_DECIMAL;
+ *fpc++ = arg;
+ }
+ else if (*s == '0' && s[1] == '#') { /* Zero padded decimals */
+ arg = ischop ? 512 : 0;
+ base = s - 1;
+ s++; /* skip the '0' first */
+ while (*s == '#')
+ s++;
+ if (*s == '.') {
+ char *f;
+ s++;
+ f = s;
+ while (*s == '#')
+ s++;
+ arg |= 256 + (s - f);
+ }
+ *fpc++ = s - base; /* fieldsize for FETCH */
+ *fpc++ = FF_0DECIMAL;
*fpc++ = arg;
}
else {
SvCOMPILED_on(sv);
}
+/*
+ * The mergesort implementation is by Peter M. Mcilroy <pmcilroy@lucent.com>.
+ *
+ * The original code was written in conjunction with BSD Computer Software
+ * Research Group at University of California, Berkeley.
+ *
+ * See also: "Optimistic Merge Sort" (SODA '92)
+ *
+ * The integration to Perl is by John P. Linderman <jpl@research.att.com>.
+ *
+ * The code can be distributed under the same terms as Perl itself.
+ *
+ */
#ifdef TESTHARNESS
#include <sys/types.h>
typedef int (*SVCOMPARE_t) (pTHXo_ SV*, SV*);
#endif /* TESTHARNESS */
-/*
- * The original author of the mergesort implementation included here
- * is Peter M. McIlroy <pmcilroy@lucent.com>, and the integrator of
- * it to the Perl source code is John Lindermann <jpl@research.att.com>.
- *
- * Both Peter and John agree with the inclusion of their code in here
- * and with their code being distributed under the same terms as Perl.
- *
- * Peter is the original copyright holder, UCB was just granted the
- * right to redistribute the code and has no rights to the original code.
- * Inclusion of the BSD copyright is just simple courtesy and no
- * indication of intellectual property. Keith Bostic <bostic@bostic.com>
- * agrees with this interpretation.
- *
- * --jhi */
-
typedef char * aptr; /* pointer for arithmetic on sizes */
typedef SV * gptr; /* pointers in our lists */
-/* Copyright notice from Peter's original sort,
-** which has been modified heavily. Good ideas are Peter's
-** bugs are jpl's
-*/
-
-/* The below advertising clause is ineffective as of July 22, 1999:
- *
- * ftp://ftp.cs.berkeley.edu/pub/4bsd/README.Impt.License.Change
- *
- */
-
-/* Much of this code is original source code from BSD4.4, and is
- * copyright (c) 1991 The Regents of the University of California.
- *
- * 1. Redistributions in binary form must reproduce the above copyright
- * notice, this list of conditions and the following disclaimer in the
- * documentation and/or other materials provided with the distribution.
- * 2. All advertising materials mentioning features or use of this software
- * must display the following acknowledgement:
- * This product includes software developed by the University of
- * California, Berkeley and its contributors.
- * 3. Neither the name of the University nor the names of its contributors
- * may be used to endorse or promote products derived from this software
- * without specific prior written permission.
- *
-*/
-
-/*
- * AUTHOR: Peter McIlroy
- * 1991-1992, See: Optimistic Merge Sort (SODA '92)
-*/
-
/* Binary merge internal sort, with a few special mods
** for the special perl environment it now finds itself in.
**
projects / p5sagit/p5-mst-13.2.git / blobdiff