#define PERL_5_9_PLUS
#endif
+#if !defined(PERL_5_9_PLUS) && defined(PERL_IMPLICIT_CONTEXT)
+/* These two are not exported from the core on Windows. With 5.9+
+ it's not an issue, because they're part of the PL_parser structure,
+ which is exported. On multiplicity/thread builds we can work
+ around the lack of export by this formulation, where we provide
+ a substitute implementation of the unexported accessor functions.
+ On single-interpreter builds we can't, because access is directly
+ via symbols that are not exported. */
+# define Perl_Ilinestart_ptr my_Ilinestart_ptr
+char **my_Ilinestart_ptr(pTHX) { return &(aTHX->Ilinestart); }
+# define Perl_Isublex_info_ptr my_Isublex_info_ptr
+static SUBLEXINFO *my_Isublex_info_ptr(pTHX) { return &(aTHX->Isublex_info); }
+#endif
+
#ifdef PERL_5_9_PLUS
/* 5.9+ moves a bunch of things to a PL_parser struct so we need to
declare the backcompat macros for things to still work (mst) */
#define SvPV_nolen_const SvPV_nolen
#endif
+/* Name changed in 5.17; use new name in our code. Apparently we're meant
+ to use something else instead, but no non-underscored way to achieve
+ this is apparent. */
+
+#ifndef _is_utf8_mark
+#define _is_utf8_mark is_utf8_mark
+#endif
+
+/* utf8_to_uvchr_buf() not defined in earlier perls, but less-capable
+ * substitute is available */
+
+#ifndef utf8_to_uvchr_buf
+#define utf8_to_uvchr_buf(s, e, lp) ((e), utf8_to_uvchr(s, lp))
+#endif
+
/* and now we're back to the toke.c stuff again (mst) */
static const char ident_too_long[] =
SSize_t oldprevlen, oldoldprevlen;
SSize_t oldloplen = 0, oldunilen = 0;
while (s < PL_bufend && isSPACE(*s)) {
- if (*s++ == '\n' && ((incline == 2) || PL_in_eval && !PL_rsfp && !incline))
+ if (*s++ == '\n' && ((incline == 2) || (PL_in_eval && !PL_rsfp && !incline)))
incline(s);
}
* of the buffer, we're not reading from a source filter, and
* we're in normal lexing mode
*/
- if (s < PL_bufend || !PL_rsfp || PL_sublex_info.sub_inwhat ||
+ if (s < PL_bufend || !PL_rsfp || PL_lex_inwhat ||
PL_lex_state == LEX_FORMLINE)
return s;
* so store the line into the debugger's array of lines
*/
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV * const sv = NEWSV(85,0);
-
- sv_upgrade(sv, SVt_PVMG);
- sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
- (void)SvIOK_on(sv);
- SvIV_set(sv, 0);
- av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
+ AV *fileav = CopFILEAV(PL_curcop);
+ if (fileav) {
+ SV * const sv = NEWSV(85,0);
+ sv_upgrade(sv, SVt_PVMG);
+ sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
+ (void)SvIOK_on(sv);
+ SvIV_set(sv, 0);
+ av_store(fileav,(I32)CopLINE(PL_curcop),sv);
+ }
}
}
}
}
else if (UTF && UTF8_IS_START(*s) && isALNUM_utf8((U8*)s)) {
char *t = s + UTF8SKIP(s);
- while (UTF8_IS_CONTINUED(*t) && is_utf8_mark((U8*)t))
+ while (UTF8_IS_CONTINUED(*t) && _is_utf8_mark((U8*)t))
t += UTF8SKIP(t);
if (d + (t - s) > e)
Perl_croak(aTHX_ ident_too_long);
termlen = 1;
}
else {
- termcode = utf8_to_uvchr((U8*)s, &termlen);
+ termcode = utf8_to_uvchr_buf((U8*)s, PL_bufend, &termlen);
Copy(s, termstr, termlen, U8);
if (!UTF8_IS_INVARIANT(term))
has_utf8 = TRUE;
/* update debugger info */
if (PERLDB_LINE && PL_curstash != PL_debstash) {
- SV *sv = NEWSV(88,0);
-
- sv_upgrade(sv, SVt_PVMG);
- sv_setsv(sv,PL_linestr);
- (void)SvIOK_on(sv);
- SvIV_set(sv, 0);
- av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv);
+ AV *fileav = CopFILEAV(PL_curcop);
+ if (fileav) {
+ SV *sv = NEWSV(88,0);
+ sv_upgrade(sv, SVt_PVMG);
+ sv_setsv(sv,PL_linestr);
+ (void)SvIOK_on(sv);
+ SvIV_set(sv, 0);
+ av_store(fileav, (I32)CopLINE(PL_curcop), sv);
+ }
}
/* having changed the buffer, we must update PL_bufend */
return s;
}
-/*
- * S_force_next
- * When the lexer realizes it knows the next token (for instance,
- * it is reordering tokens for the parser) then it can call S_force_next
- * to know what token to return the next time the lexer is called. Caller
- * will need to set PL_nextval[], and possibly PL_expect to ensure the lexer
- * handles the token correctly.
- */
-
-STATIC void
-S_force_next(pTHX_ I32 type)
-{
-#ifdef PERL_MAD
- dVAR;
- if (PL_curforce < 0)
- start_force(PL_lasttoke);
- PL_nexttoke[PL_curforce].next_type = type;
- if (PL_lex_state != LEX_KNOWNEXT)
- PL_lex_defer = PL_lex_state;
- PL_lex_state = LEX_KNOWNEXT;
- PL_lex_expect = PL_expect;
- PL_curforce = -1;
-#else
- PL_nexttype[PL_nexttoke] = type;
- PL_nexttoke++;
- if (PL_lex_state != LEX_KNOWNEXT) {
- PL_lex_defer = PL_lex_state;
- PL_lex_expect = PL_expect;
- PL_lex_state = LEX_KNOWNEXT;
- }
-#endif
-}
-
#define XFAKEBRACK 128
STATIC char *
}
else if (UTF && UTF8_IS_START(*s) && isALNUM_utf8((U8*)s)) {
char *t = s + UTF8SKIP(s);
- while (UTF8_IS_CONTINUED(*t) && is_utf8_mark((U8*)t))
+ while (UTF8_IS_CONTINUED(*t) && _is_utf8_mark((U8*)t))
t += UTF8SKIP(t);
if (d + (t - s) > e)
Perl_croak(aTHX_ ident_too_long);
if (*s == '{') {
bracket = s;
s++;
+ } else if (ck_uni) {
+ /* we always call this with ck_uni == 0, so no need for check_uni() */
+ /* check_uni(); */
}
- /* we always call this with ck_uni == 0 (rafl) */
- /*
- else if (ck_uni)
- check_uni();
- */
if (s < send)
*d = *s++;
d[1] = '\0';
e = s;
while ((e < send && isALNUM_lazy_if(e,UTF)) || *e == ':') {
e += UTF8SKIP(e);
- while (e < send && UTF8_IS_CONTINUED(*e) && is_utf8_mark((U8*)e))
+ while (e < send && UTF8_IS_CONTINUED(*e) && _is_utf8_mark((U8*)e))
e += UTF8SKIP(e);
}
Copy(s, d, e - s, char);
projects / p5sagit/Devel-Declare.git / blobdiff