static char ident_too_long[] = "Identifier too long";
+static void restore_rsfp(pTHXo_ void *f);
+static void restore_expect(pTHXo_ void *e);
+static void restore_lex_expect(pTHXo_ void *e);
+
#define UTF (PL_hints & HINT_UTF8)
/*
* Note: we try to be careful never to call the isXXX_utf8() functions
SAVESPTR(PL_linestr);
SAVEPPTR(PL_lex_brackstack);
SAVEPPTR(PL_lex_casestack);
- SAVEDESTRUCTOR(S_restore_rsfp, PL_rsfp);
+ SAVEDESTRUCTOR(restore_rsfp, PL_rsfp);
SAVESPTR(PL_lex_stuff);
SAVEI32(PL_lex_defer);
SAVESPTR(PL_lex_repl);
- SAVEDESTRUCTOR(S_restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */
- SAVEDESTRUCTOR(S_restore_lex_expect, PL_tokenbuf + PL_expect);
+ SAVEDESTRUCTOR(restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */
+ SAVEDESTRUCTOR(restore_lex_expect, PL_tokenbuf + PL_expect);
PL_lex_state = LEX_NORMAL;
PL_lex_defer = 0;
}
STATIC void
-S_restore_rsfp(pTHX_ void *f)
-{
- PerlIO *fp = (PerlIO*)f;
-
- if (PL_rsfp == PerlIO_stdin())
- PerlIO_clearerr(PL_rsfp);
- else if (PL_rsfp && (PL_rsfp != fp))
- PerlIO_close(PL_rsfp);
- PL_rsfp = fp;
-}
-
-STATIC void
-S_restore_expect(pTHX_ void *e)
-{
- /* a safe way to store a small integer in a pointer */
- PL_expect = (expectation)((char *)e - PL_tokenbuf);
-}
-
-STATIC void
-S_restore_lex_expect(pTHX_ void *e)
-{
- /* a safe way to store a small integer in a pointer */
- PL_lex_expect = (expectation)((char *)e - PL_tokenbuf);
-}
-
-STATIC void
S_incline(pTHX_ char *s)
{
dTHR;
S_check_uni(pTHX)
{
char *s;
- char ch;
char *t;
+ dTHR;
if (PL_oldoldbufptr != PL_last_uni)
return;
for (s = PL_last_uni; isALNUM_lazy(s) || *s == '-'; s++) ;
if ((t = strchr(s, '(')) && t < PL_bufptr)
return;
- ch = *s;
- *s = '\0';
- Perl_warn(aTHX_ "Warning: Use of \"%s\" without parens is ambiguous", PL_last_uni);
- *s = ch;
+ if (ckWARN_d(WARN_AMBIGUOUS)){
+ char ch = *s;
+ *s = '\0';
+ Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ "Warning: Use of \"%s\" without parens is ambiguous",
+ PL_last_uni);
+ *s = ch;
+ }
}
#ifdef CRIPPLED_CC
if (!SvUPGRADE(datasv, SVt_PVIO))
Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO");
IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
+#ifdef DEBUGGING
if (PL_filter_debug) {
STRLEN n_a;
Perl_warn(aTHX_ "filter_add func %p (%s)", funcp, SvPV(datasv, n_a));
}
+#endif /* DEBUGGING */
av_unshift(PL_rsfp_filters, 1);
av_store(PL_rsfp_filters, 0, datasv) ;
return(datasv);
void
Perl_filter_del(pTHX_ filter_t funcp)
{
+#ifdef DEBUGGING
if (PL_filter_debug)
Perl_warn(aTHX_ "filter_del func %p", funcp);
+#endif /* DEBUGGING */
if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
if (idx > AvFILLp(PL_rsfp_filters)){ /* Any more filters? */
/* Provide a default input filter to make life easy. */
/* Note that we append to the line. This is handy. */
+#ifdef DEBUGGING
if (PL_filter_debug)
Perl_warn(aTHX_ "filter_read %d: from rsfp\n", idx);
+#endif /* DEBUGGING */
if (maxlen) {
/* Want a block */
int len ;
}
/* Skip this filter slot if filter has been deleted */
if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef){
+#ifdef DEBUGGING
if (PL_filter_debug)
Perl_warn(aTHX_ "filter_read %d: skipped (filter deleted)\n", idx);
+#endif /* DEBUGGING */
return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
}
/* Get function pointer hidden within datasv */
funcp = (filter_t)IoDIRP(datasv);
+#ifdef DEBUGGING
if (PL_filter_debug) {
STRLEN n_a;
Perl_warn(aTHX_ "filter_read %d: via function %p (%s)\n",
idx, funcp, SvPV(datasv,n_a));
}
+#endif /* DEBUGGING */
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
if (gv && GvCVu(gv)) {
CV* cv;
- if (lastchar == '-')
- Perl_warn(aTHX_ "Ambiguous use of -%s resolved as -&%s()",
+ if (lastchar == '-' && ckWARN_d(WARN_AMBIGUOUS))
+ Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ "Ambiguous use of -%s resolved as -&%s()",
PL_tokenbuf, PL_tokenbuf);
/* Check for a constant sub */
cv = GvCV(gv);
}
safe_bareword:
- if (lastchar && strchr("*%&", lastchar)) {
- Perl_warn(aTHX_ "Operator or semicolon missing before %c%s",
+ if (lastchar && strchr("*%&", lastchar) && ckWARN_d(WARN_AMBIGUOUS)) {
+ Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ "Operator or semicolon missing before %c%s",
lastchar, PL_tokenbuf);
- Perl_warn(aTHX_ "Ambiguous use of %c resolved as operator %c",
+ Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ "Ambiguous use of %c resolved as operator %c",
lastchar, lastchar);
}
TOKEN(WORD);
char *t;
for (d = s; isALNUM_lazy(d); d++) ;
t = skipspace(d);
- if (strchr("|&*+-=!?:.", *t))
- Perl_warn(aTHX_ "Precedence problem: open %.*s should be open(%.*s)",
- d-s,s, d-s,s);
+ if (strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_AMBIGUOUS))
+ Perl_warner(aTHX_ WARN_AMBIGUOUS,
+ "Precedence problem: open %.*s should be open(%.*s)",
+ d-s,s, d-s,s);
}
LOP(OP_OPEN,XTERM);
we in octal/hex/binary?" indicator to disallow hex characters
when in octal mode.
*/
+ dTHR;
UV u;
I32 shift;
bool overflowed = FALSE;
digit:
n = u << shift; /* make room for the digit */
if (!overflowed && (n >> shift) != u
- && !(PL_hints & HINT_NEW_BINARY)) {
- Perl_warn(aTHX_ "Integer overflow in %s number",
- (shift == 4) ? "hex"
- : ((shift == 3) ? "octal" : "binary"));
+ && !(PL_hints & HINT_NEW_BINARY))
+ {
+ if (ckWARN_d(WARN_UNSAFE))
+ Perl_warner(aTHX_ WARN_UNSAFE,
+ "Integer overflow in %s number",
+ (shift == 4) ? "hex"
+ : ((shift == 3) ? "octal" : "binary"));
overflowed = TRUE;
}
u = n | b; /* add the digit to the end */
}
+#ifdef PERL_OBJECT
+#define NO_XSLOCKS
+#include "XSUB.h"
+#endif
+
+static void
+restore_rsfp(pTHXo_ void *f)
+{
+ PerlIO *fp = (PerlIO*)f;
+
+ if (PL_rsfp == PerlIO_stdin())
+ PerlIO_clearerr(PL_rsfp);
+ else if (PL_rsfp && (PL_rsfp != fp))
+ PerlIO_close(PL_rsfp);
+ PL_rsfp = fp;
+}
+
+static void
+restore_expect(pTHXo_ void *e)
+{
+ /* a safe way to store a small integer in a pointer */
+ PL_expect = (expectation)((char *)e - PL_tokenbuf);
+}
+
+static void
+restore_lex_expect(pTHXo_ void *e)
+{
+ /* a safe way to store a small integer in a pointer */
+ PL_lex_expect = (expectation)((char *)e - PL_tokenbuf);
+}
+