STATIC int
S_tokereport(pTHX_ I32 rv, const YYSTYPE* lvalp)
{
- dVAR;
-
PERL_ARGS_ASSERT_TOKEREPORT;
if (DEBUG_T_TEST) {
STATIC int
S_ao(pTHX_ int toketype)
{
- dVAR;
if (*PL_bufptr == '=') {
PL_bufptr++;
if (toketype == ANDAND)
STATIC void
S_no_op(pTHX_ const char *const what, char *s)
{
- dVAR;
char * const oldbp = PL_bufptr;
const bool is_first = (PL_oldbufptr == PL_linestart);
STATIC void
S_missingterm(pTHX_ char *s)
{
- dVAR;
char tmpbuf[3];
char q;
if (s) {
bool
Perl_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen)
{
- dVAR;
char he_name[8 + MAX_FEATURE_LEN] = "feature_";
PERL_ARGS_ASSERT_FEATURE_IS_ENABLED;
void
Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
{
- dVAR;
const char *s = NULL;
yy_parser *parser, *oparser;
if (flags && flags & ~LEX_START_FLAGS)
STATIC void
S_incline(pTHX_ const char *s)
{
- dVAR;
const char *t;
const char *n;
const char *e;
if (*e != '\n' && *e != '\0')
return; /* false alarm */
- line_num = atoi(n)-1;
+ line_num = grok_atou(n, &e) - 1;
if (t - s > 0) {
const STRLEN len = t - s;
STATIC void
S_check_uni(pTHX)
{
- dVAR;
const char *s;
const char *t;
STATIC I32
S_lop(pTHX_ I32 f, int x, char *s)
{
- dVAR;
-
PERL_ARGS_ASSERT_LOP;
pl_yylval.ival = f;
STATIC void
S_force_next(pTHX_ I32 type)
{
- dVAR;
#ifdef DEBUGGING
if (DEBUG_T_TEST) {
PerlIO_printf(Perl_debug_log, "### forced token:\n");
static int
S_postderef(pTHX_ int const funny, char const next)
{
- dVAR;
assert(funny == DOLSHARP || strchr("$@%&*", funny));
assert(strchr("*[{", next));
if (next == '*') {
STATIC SV *
S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len)
{
- dVAR;
SV * const sv = newSVpvn_utf8(start, len,
!IN_BYTES
&& UTF
STATIC char *
S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack)
{
- dVAR;
char *s;
STRLEN len;
STATIC void
S_force_ident(pTHX_ const char *s, int kind)
{
- dVAR;
-
PERL_ARGS_ASSERT_FORCE_IDENT;
if (s[0]) {
STATIC char *
S_force_version(pTHX_ char *s, int guessing)
{
- dVAR;
OP *version = NULL;
char *d;
STATIC char *
S_force_strict_version(pTHX_ char *s)
{
- dVAR;
OP *version = NULL;
const char *errstr = NULL;
STATIC SV *
S_tokeq(pTHX_ SV *sv)
{
- dVAR;
char *s;
char *send;
char *d;
STATIC I32
S_sublex_start(pTHX)
{
- dVAR;
const I32 op_type = pl_yylval.ival;
if (op_type == OP_NULL) {
STATIC I32
S_sublex_push(pTHX)
{
- dVAR;
LEXSHARED *shared;
const bool is_heredoc = PL_multi_close == '<';
ENTER;
STATIC I32
S_sublex_done(pTHX)
{
- dVAR;
if (!PL_lex_starts++) {
SV * const sv = newSVpvs("");
if (SvUTF8(PL_linestr))
STATIC char *
S_scan_const(pTHX_ char *start)
{
- dVAR;
char *send = PL_bufend; /* end of the constant */
- SV *sv = newSV(send - start); /* sv for the constant. See
- note below on sizing. */
+ SV *sv = newSV(send - start); /* sv for the constant. See note below
+ on sizing. */
char *s = start; /* start of the constant */
char *d = SvPVX(sv); /* destination for copies */
- bool dorange = FALSE; /* are we in a translit range? */
- bool didrange = FALSE; /* did we just finish a range? */
- bool in_charclass = FALSE; /* within /[...]/ */
- bool has_utf8 = FALSE; /* Output constant is UTF8 */
- bool this_utf8 = cBOOL(UTF); /* Is the source string assumed
- to be UTF8? But, this can
- show as true when the source
- isn't utf8, as for example
- when it is entirely composed
- of hex constants */
+ bool dorange = FALSE; /* are we in a translit range? */
+ bool didrange = FALSE; /* did we just finish a range? */
+ bool in_charclass = FALSE; /* within /[...]/ */
+ bool has_utf8 = FALSE; /* Output constant is UTF8 */
+ bool this_utf8 = cBOOL(UTF); /* Is the source string assumed to be
+ UTF8? But, this can show as true
+ when the source isn't utf8, as for
+ example when it is entirely composed
+ of hex constants */
SV *res; /* result from charnames */
/* Note on sizing: The scanned constant is placed into sv, which is
i = d - SvPVX_const(sv); /* remember current offset */
#ifdef EBCDIC
SvGROW(sv,
- SvLEN(sv) + (has_utf8 ?
- (512 - UTF_CONTINUATION_MARK +
- UNISKIP(0x100))
+ SvLEN(sv) + ((has_utf8)
+ ? (512 - UTF_CONTINUATION_MARK
+ + UNISKIP(0x100))
: 256));
/* How many two-byte within 0..255: 128 in UTF-8,
* 96 in UTF-8-mod. */
}
#ifdef EBCDIC
+ /* Because of the discontinuities in EBCDIC A-Z and a-z, expand
+ * any subsets of these ranges into individual characters */
if (literal_endpoint == 2 &&
((isLOWER_A(min) && isLOWER_A(max)) ||
(isUPPER_A(min) && isUPPER_A(max))))
d += 5;
while (str < str_end) {
char hex_string[4];
- PERL_UNUSED_RESULT(
+ int len =
my_snprintf(hex_string,
sizeof(hex_string),
- "%02X.", (U8) *str));
+ "%02X.", (U8) *str);
+ PERL_MY_SNPRINTF_POST_GUARD(len, sizeof(hex_string));
Copy(hex_string, d, 3, char);
d += 3;
str++;
STATIC int
S_intuit_more(pTHX_ char *s)
{
- dVAR;
-
PERL_ARGS_ASSERT_INTUIT_MORE;
if (PL_lex_brackets)
STATIC int
S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
{
- dVAR;
char *s = start + (*start == '$');
char tmpbuf[sizeof PL_tokenbuf];
STRLEN len;
SV *
Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
{
- dVAR;
if (!funcp)
return NULL;
void
Perl_filter_del(pTHX_ filter_t funcp)
{
- dVAR;
SV *datasv;
PERL_ARGS_ASSERT_FILTER_DEL;
I32
Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
{
- dVAR;
filter_t funcp;
SV *datasv = NULL;
/* This API is bad. It should have been using unsigned int for maxlen.
STATIC char *
S_filter_gets(pTHX_ SV *sv, STRLEN append)
{
- dVAR;
-
PERL_ARGS_ASSERT_FILTER_GETS;
#ifdef PERL_CR_FILTER
STATIC HV *
S_find_in_my_stash(pTHX_ const char *pkgname, STRLEN len)
{
- dVAR;
GV *gv;
PERL_ARGS_ASSERT_FIND_IN_MY_STASH;
STATIC char *
S_tokenize_use(pTHX_ int is_use, char *s) {
- dVAR;
-
PERL_ARGS_ASSERT_TOKENIZE_USE;
if (PL_expect != XSTATE)
PL_lex_allbrackets++;
PL_expect = XSTATE;
break;
+ case XBLOCKTERM:
+ PL_lex_brackstack[PL_lex_brackets++] = XTERM;
+ PL_lex_allbrackets++;
+ PL_expect = XSTATE;
+ break;
default: {
const char *t;
if (PL_oldoldbufptr == PL_last_lop)
if (!PL_lex_allbrackets &&
PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
- PREBLOCK(METHOD);
+ PL_expect = XBLOCKTERM;
+ PL_bufptr = s;
+ return REPORT(METHOD);
}
/* If followed by a bareword, see if it looks like indir obj. */
PL_in_my_stash = find_in_my_stash(PL_tokenbuf, len);
if (!PL_in_my_stash) {
char tmpbuf[1024];
+ int len;
PL_bufptr = s;
- PERL_UNUSED_RESULT(my_snprintf(tmpbuf, sizeof(tmpbuf), "No such class %.1000s", PL_tokenbuf));
+ len = my_snprintf(tmpbuf, sizeof(tmpbuf), "No such class %.1000s", PL_tokenbuf);
+ PERL_MY_SNPRINTF_POST_GUARD(len, sizeof(tmpbuf));
yyerror_pv(tmpbuf, UTF ? SVf_UTF8 : 0);
}
}
static int
S_pending_ident(pTHX)
{
- dVAR;
PADOFFSET tmp = 0;
const char pit = (char)pl_yylval.ival;
const STRLEN tokenbuf_len = strlen(PL_tokenbuf);
STATIC void
S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
{
- dVAR;
-
PERL_ARGS_ASSERT_CHECKCOMMA;
if (*s == ' ' && s[1] == '(') { /* XXX gotta be a better way */
S_new_constant(pTHX_ const char *s, STRLEN len, const char *key, STRLEN keylen,
SV *sv, SV *pv, const char *type, STRLEN typelen)
{
- dVAR; dSP;
+ dSP;
HV * table = GvHV(PL_hintgv); /* ^H */
SV *res;
SV *errsv = NULL;
PERL_STATIC_INLINE void
S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, bool is_utf8) {
- dVAR;
PERL_ARGS_ASSERT_PARSE_IDENT;
for (;;) {
STATIC char *
S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
{
- dVAR;
char *d = dest;
char * const e = d + destlen - 3; /* two-character token, ending NUL */
bool is_utf8 = cBOOL(UTF);
STATIC char *
S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni)
{
- dVAR;
I32 herelines = PL_parser->herelines;
SSize_t bracket = -1;
char funny = *s++;
STATIC char *
S_scan_pat(pTHX_ char *start, I32 type)
{
- dVAR;
PMOP *pm;
char *s;
const char * const valid_flags =
STATIC char *
S_scan_subst(pTHX_ char *start)
{
- dVAR;
char *s;
PMOP *pm;
I32 first_start;
STATIC char *
S_scan_trans(pTHX_ char *start)
{
- dVAR;
char* s;
OP *o;
U8 squash;
STATIC char *
S_scan_heredoc(pTHX_ char *s)
{
- dVAR;
I32 op_type = OP_SCALAR;
I32 len;
SV *tmpstr;
STATIC char *
S_scan_inputsymbol(pTHX_ char *start)
{
- dVAR;
char *s = start; /* current position in buffer */
char *end;
I32 len;
newUNOP(OP_RV2SV, 0,
newGVOP(OP_GV, 0, gv)));
}
- if (!readline_overriden)
- PL_lex_op->op_flags |= OPf_SPECIAL;
/* we created the ops in PL_lex_op, so make pl_yylval.ival a null op */
pl_yylval.ival = OP_NULL;
}
char **delimp
)
{
- dVAR;
SV *sv; /* scalar value: string */
const char *tmps; /* temp string, used for delimiter matching */
char *s = start; /* current position in the buffer */
char *
Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
{
- dVAR;
const char *s = start; /* current position in buffer */
char *d; /* destination in temp buffer */
char *e; /* end of temp buffer */
STATIC char *
S_scan_formline(pTHX_ char *s)
{
- dVAR;
char *eol;
char *t;
SV * const stuff = newSVpvs("");
I32
Perl_start_subparse(pTHX_ I32 is_format, U32 flags)
{
- dVAR;
const I32 oldsavestack_ix = PL_savestack_ix;
CV* const outsidecv = PL_compcv;
static int
S_yywarn(pTHX_ const char *const s, U32 flags)
{
- dVAR;
-
PERL_ARGS_ASSERT_YYWARN;
PL_in_eval |= EVAL_WARNONLY;
int
Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags)
{
- dVAR;
const char *context = NULL;
int contlen = -1;
SV *msg;
STATIC char*
S_swallow_bom(pTHX_ U8 *s)
{
- dVAR;
const STRLEN slen = SvCUR(PL_linestr);
PERL_ARGS_ASSERT_SWALLOW_BOM;
static I32
S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
- dVAR;
SV *const filter = FILTER_DATA(idx);
/* We re-use this each time round, throwing the contents away before we
return. */
char *
Perl_scan_vstring(pTHX_ const char *s, const char *const e, SV *sv)
{
- dVAR;
const char *pos = s;
const char *start = s;
https://perl5.git.perl.org / perl5.git / blobdiff