* 1999-02-27 mjd-perl-patch@plover.com */
#define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
+/* On MacOS, respect nonbreaking spaces */
+#ifdef MACOS_TRADITIONAL
+#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\312'||(c)=='\t')
+#else
+#define SPACE_OR_TAB(c) ((c)==' '||(c)=='\t')
+#endif
+
/* LEX_* are values for PL_lex_state, the state of the lexer.
* They are arranged oddly so that the guard on the switch statement
* can get by with a single comparison (if the compiler is smart enough).
* LOOPX : loop exiting command (goto, last, dump, etc)
* FTST : file test operator
* FUN0 : zero-argument function
- * FUN1 : not used
+ * FUN1 : not used, except for not, which isn't a UNIOP
* BOop : bitwise or or xor
* BAop : bitwise and
* SHop : shift operator
SAVESPTR(PL_linestr);
SAVEPPTR(PL_lex_brackstack);
SAVEPPTR(PL_lex_casestack);
- SAVEDESTRUCTOR(restore_rsfp, PL_rsfp);
+ SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp);
SAVESPTR(PL_lex_stuff);
SAVEI32(PL_lex_defer);
SAVEI32(PL_sublex_info.sub_inwhat);
SAVESPTR(PL_lex_repl);
- SAVEDESTRUCTOR(restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */
- SAVEDESTRUCTOR(restore_lex_expect, PL_tokenbuf + PL_expect);
+ SAVEDESTRUCTOR_X(restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */
+ SAVEDESTRUCTOR_X(restore_lex_expect, PL_tokenbuf + PL_expect);
PL_lex_state = LEX_NORMAL;
PL_lex_defer = 0;
char ch;
int sawline = 0;
+ PERL_ASYNC_CHECK();
PL_curcop->cop_line++;
if (*s++ != '#')
return;
- while (*s == ' ' || *s == '\t') s++;
+ while (SPACE_OR_TAB(*s)) s++;
if (strnEQ(s, "line ", 5)) {
s += 5;
sawline = 1;
n = s;
while (isDIGIT(*s))
s++;
- while (*s == ' ' || *s == '\t')
+ while (SPACE_OR_TAB(*s))
s++;
if (*s == '"' && (t = strchr(s+1, '"')))
s++;
ch = *t;
*t = '\0';
if (t - s > 0)
- PL_curcop->cop_filegv = gv_fetchfile(s);
+ CopFILEGV_set(PL_curcop, gv_fetchfile(s));
else
- PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename);
+ CopFILEGV_set(PL_curcop, gv_fetchfile(PL_origfilename));
*t = ch;
PL_curcop->cop_line = atoi(n)-1;
}
{
dTHR;
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
- while (s < PL_bufend && (*s == ' ' || *s == '\t'))
+ while (s < PL_bufend && SPACE_OR_TAB(*s))
s++;
return s;
}
sv_upgrade(sv, SVt_PVMG);
sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
- av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv);
}
}
}
? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ?
OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF))
: UTF;
- char *leaveit = /* set of acceptably-backslashed characters */
+ const char *leaveit = /* set of acceptably-backslashed characters */
PL_lex_inpat
? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#"
: "";
/* \132 indicates an octal constant */
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
- *d++ = scan_oct(s, 3, &len);
+ *d++ = (char)scan_oct(s, 3, &len);
s += len;
continue;
}
/* note: utf always shorter than hex */
d = (char*)uv_to_utf8((U8*)d,
- scan_hex(s + 1, e - s - 1, &len));
+ (UV)scan_hex(s + 1, e - s - 1, &len));
s = e + 1;
}
else {
SV *
Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
{
- if (!funcp){ /* temporary handy debugging hack to be deleted */
- PL_filter_debug = atoi((char*)datasv);
- return NULL;
- }
+ if (!funcp)
+ return Nullsv;
+
if (!PL_rsfp_filters)
PL_rsfp_filters = newAV();
if (!datasv)
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 */
+ DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
+ funcp, SvPV_nolen(datasv)));
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 */
+ DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", funcp));
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 */
+ DEBUG_P(PerlIO_printf(Perl_debug_log,
+ "filter_read %d: from rsfp\n", idx));
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 */
+ DEBUG_P(PerlIO_printf(Perl_debug_log,
+ "filter_read %d: skipped (filter deleted)\n",
+ idx));
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 */
+ DEBUG_P(PerlIO_printf(Perl_debug_log,
+ "filter_read %d: via function %p (%s)\n",
+ idx, funcp, SvPV_nolen(datasv)));
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
PL_oldoldbufptr = PL_oldbufptr;
PL_oldbufptr = s;
DEBUG_p( {
- PerlIO_printf(PerlIO_stderr(), "### Tokener expecting %s at %s\n", exp_name[PL_expect], s);
+ PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at %s\n",
+ exp_name[PL_expect], s);
} )
retry:
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv);
}
goto retry;
}
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop),(I32)PL_curcop->cop_line,sv);
}
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
if (PL_curcop->cop_line == 1) {
*/
SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
assert(SvPOK(x) || SvGMAGICAL(x));
- if (sv_eq(x, GvSV(PL_curcop->cop_filegv))) {
+ if (sv_eq(x, CopFILESV(PL_curcop))) {
sv_setpvn(x, ipath, ipathend - ipath);
SvSETMAGIC(x);
}
*s = '#'; /* Don't try to parse shebang line */
}
#endif /* ALTERNATE_SHEBANG */
+#ifndef MACOS_TRADITIONAL
if (!d &&
*s == '#' &&
ipathend > ipath &&
PerlProc_execv(ipath, newargv);
Perl_croak(aTHX_ "Can't exec %s", ipath);
}
+#endif
if (d) {
U32 oldpdb = PL_perldb;
bool oldn = PL_minus_n;
bool oldp = PL_minus_p;
while (*d && !isSPACE(*d)) d++;
- while (*d == ' ' || *d == '\t') d++;
+ while (SPACE_OR_TAB(*d)) d++;
if (*d++ == '-') {
do {
"(Maybe you didn't strip carriage returns after a network transfer?)\n");
#endif
case ' ': case '\t': case '\f': case 013:
+#ifdef MACOS_TRADITIONAL
+ case '\312': /* Them nonbreaking spaces again */
+#endif
s++;
goto retry;
case '#':
PL_bufptr = s;
tmp = *s++;
- while (s < PL_bufend && (*s == ' ' || *s == '\t'))
+ while (s < PL_bufend && SPACE_OR_TAB(*s))
s++;
if (strnEQ(s,"=>",2)) {
PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
OPERATOR(HASHBRACK);
case XOPERATOR:
- while (s < PL_bufend && (*s == ' ' || *s == '\t'))
+ while (s < PL_bufend && SPACE_OR_TAB(*s))
s++;
d = s;
PL_tokenbuf[0] = '\0';
if (d < PL_bufend && *d == '-') {
PL_tokenbuf[0] = '-';
d++;
- while (d < PL_bufend && (*d == ' ' || *d == '\t'))
+ while (d < PL_bufend && SPACE_OR_TAB(*d))
d++;
}
if (d < PL_bufend && isIDFIRST_lazy(d)) {
d = scan_word(d, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
FALSE, &len);
- while (d < PL_bufend && (*d == ' ' || *d == '\t'))
+ while (d < PL_bufend && SPACE_OR_TAB(*d))
d++;
if (*d == '}') {
char minus = (PL_tokenbuf[0] == '-');
if (PL_lex_brackets < PL_lex_formbrack) {
char *t;
#ifdef PERL_STRICT_CR
- for (t = s; *t == ' ' || *t == '\t'; t++) ;
+ for (t = s; SPACE_OR_TAB(*t); t++) ;
#else
- for (t = s; *t == ' ' || *t == '\t' || *t == '\r'; t++) ;
+ for (t = s; SPACE_OR_TAB(*t) || *t == '\r'; t++) ;
#endif
if (*t == '\n' || *t == '#') {
s--;
if (*s == '(') {
CLINE;
if (gv && GvCVu(gv)) {
- for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
+ for (d = s + 1; SPACE_OR_TAB(*d); d++) ;
if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
s = d + 1;
goto its_constant;
case KEY___FILE__:
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
- newSVsv(GvSV(PL_curcop->cop_filegv)));
+ newSVsv(CopFILESV(PL_curcop)));
TERM(THING);
case KEY___LINE__:
-#ifdef IV_IS_QUAD
- yylval.opval = (OP*)newSVOP(OP_CONST, 0,
- Perl_newSVpvf(aTHX_ "%" PERL_PRId64, (IV)PL_curcop->cop_line));
-#else
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
- Perl_newSVpvf(aTHX_ "%ld", (long)PL_curcop->cop_line));
-#endif
+ Perl_newSVpvf(aTHX_ "%"IVdf, (IV)PL_curcop->cop_line));
TERM(THING);
case KEY___PACKAGE__:
case KEY_DESTROY:
case KEY_BEGIN:
case KEY_END:
+ case KEY_STOP:
case KEY_INIT:
if (PL_expect == XSTATE) {
s = PL_bufptr;
case KEY_crypt:
#ifdef FCRYPT
- if (!PL_cryptseen++)
+ if (!PL_cryptseen) {
+ PL_cryptseen = TRUE;
init_des();
+ }
#endif
LOP(OP_CRYPT,XTERM);
OPERATOR(USE);
case KEY_not:
- OPERATOR(NOTOP);
+ if (*s == '(' || (s = skipspace(s), *s == '('))
+ FUN1(OP_NOT);
+ else
+ OPERATOR(NOTOP);
case KEY_open:
s = skipspace(s);
UNI(OP_STAT);
case KEY_study:
- PL_sawstudy++;
UNI(OP_STUDY);
case KEY_substr:
UNI(OP_VALUES);
case KEY_vec:
- PL_sawvec = TRUE;
LOP(OP_VEC,XTERM);
case KEY_while:
break;
}
break;
+ case 'S':
+ if (strEQ(d,"STOP")) return KEY_STOP;
+ break;
case 's':
switch (d[1]) {
case 0: return KEY_s;
and type is used with error messages only. */
STATIC SV *
-S_new_constant(pTHX_ char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
+S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv,
+ const char *type)
{
dSP;
HV *table = GvHV(PL_hintgv); /* ^H */
SV *res;
SV **cvp;
SV *cv, *typesv;
- char *why, *why1, *why2;
+ const char *why, *why1, *why2;
if (!(PL_hints & HINT_LOCALIZE_HH)) {
SV *msg;
STRLEN n_a;
sv_catpv(ERRSV, "Propagated");
yyerror(SvPV(ERRSV, n_a)); /* Duplicates the message inside eval */
- POPs ;
+ (void)POPs;
res = SvREFCNT_inc(sv);
}
else {
res = POPs;
- SvREFCNT_inc(res);
+ (void)SvREFCNT_inc(res);
}
PUTBACK ;
if (isSPACE(s[-1])) {
while (s < send) {
char ch = *s++;
- if (ch != ' ' && ch != '\t') {
+ if (!SPACE_OR_TAB(ch)) {
*d = ch;
break;
}
Perl_croak(aTHX_ ident_too_long);
}
*d = '\0';
- while (s < send && (*s == ' ' || *s == '\t')) s++;
+ while (s < send && SPACE_OR_TAB(*s)) s++;
if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
dTHR; /* only for ckWARN */
if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
- char *brack = *s == '[' ? "[...]" : "{...}";
+ const char *brack = *s == '[' ? "[...]" : "{...}";
Perl_warner(aTHX_ WARN_AMBIGUOUS,
"Ambiguous use of %c{%s%s} resolved to %c%s%s",
funny, dest, brack, funny, dest, brack);
e = PL_tokenbuf + sizeof PL_tokenbuf - 1;
if (!outer)
*d++ = '\n';
- for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
+ for (peek = s; SPACE_OR_TAB(*peek); peek++) ;
if (*peek && strchr("`'\"",*peek)) {
s = peek;
term = *s++;
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(GvAV(PL_curcop->cop_filegv),
- (I32)PL_curcop->cop_line,sv);
+ av_store(CopFILEAV(PL_curcop), (I32)PL_curcop->cop_line,sv);
}
if (*s == term && memEQ(s,PL_tokenbuf,len)) {
s = PL_bufend - 1;
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
- av_store(GvAV(PL_curcop->cop_filegv),
- (I32)PL_curcop->cop_line, sv);
+ av_store(CopFILEAV(PL_curcop), (I32)PL_curcop->cop_line, sv);
}
/* having changed the buffer, we must update PL_bufend */
if (*s == '.' || *s == '}') {
/*SUPPRESS 530*/
#ifdef PERL_STRICT_CR
- for (t = s+1;*t == ' ' || *t == '\t'; t++) ;
+ for (t = s+1;SPACE_OR_TAB(*t); t++) ;
#else
- for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ;
+ for (t = s+1;SPACE_OR_TAB(*t) || *t == '\r'; t++) ;
#endif
if (*t == '\n' || t == PL_bufend)
break;
where = SvPVX(where_sv);
}
msg = sv_2mortal(newSVpv(s, 0));
-#ifdef IV_IS_QUAD
- Perl_sv_catpvf(aTHX_ msg, " at %_ line %" PERL_PRId64 ", ",
- GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line);
-#else
- Perl_sv_catpvf(aTHX_ msg, " at %_ line %ld, ",
- GvSV(PL_curcop->cop_filegv), (long)PL_curcop->cop_line);
-#endif
+ Perl_sv_catpvf(aTHX_ msg, " at %_ line %"IVdf", ",
+ CopFILESV(PL_curcop), (IV)PL_curcop->cop_line);
if (context)
Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context);
else
Perl_sv_catpvf(aTHX_ msg, "%s\n", where);
- if (PL_multi_start < PL_multi_end && (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) {
-#ifdef IV_IS_QUAD
+ if (PL_multi_start < PL_multi_end &&
+ (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) {
Perl_sv_catpvf(aTHX_ msg,
- " (Might be a runaway multi-line %c%c string starting on line %" PERL_\
-PRId64 ")\n",
+ " (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n",
(int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start);
-#else
- Perl_sv_catpvf(aTHX_ msg,
- " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
- (int)PL_multi_open,(int)PL_multi_close,(long)PL_multi_start);
-#endif
PL_multi_end = 0;
}
if (PL_in_eval & EVAL_WARNONLY)
else
qerror(msg);
if (PL_error_count >= 10)
- Perl_croak(aTHX_ "%_ has too many errors.\n", GvSV(PL_curcop->cop_filegv));
+ Perl_croak(aTHX_ "%_ has too many errors.\n", CopFILESV(PL_curcop));
PL_in_my = 0;
PL_in_my_stash = Nullhv;
return 0;
#ifdef PERL_OBJECT
-#define NO_XSLOCKS
#include "XSUB.h"
#endif
projects / p5sagit/p5-mst-13.2.git / blobdiff