sv_upgrade(sv, SVt_PVMG);
sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr);
+ (void)SvIOK_on(sv);
+ SvIVX(sv) = 0;
av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
}
}
continue;
- /* \N{latin small letter a} is a named character */
+ /* \N{LATIN SMALL LETTER A} is a named character */
case 'N':
++s;
if (*s == '{') {
d = SvPVX(sv) + SvCUR(sv);
has_utf8 = TRUE;
}
- if (len > e - s + 4) {
+ if (len > e - s + 4) { /* I _guess_ 4 is \N{} --jhi */
char *odest = SvPVX(sv);
SvGROW(sv, (SvLEN(sv) + len - (e - s + 4)));
Perl_croak(aTHX_ "panic: constant overflowed allocated space");
SvPOK_on(sv);
+ if (PL_encoding && !has_utf8) {
+ Perl_sv_recode_to_utf8(aTHX_ sv, PL_encoding);
+ has_utf8 = TRUE;
+ }
if (has_utf8) {
SvUTF8_on(sv);
if (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op) {
IoANY(datasv) = (void *)funcp; /* stash funcp into spare field */
IoFLAGS(datasv) |= IOf_FAKE_DIRP;
DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
- funcp, SvPV_nolen(datasv)));
+ (void*)funcp, SvPV_nolen(datasv)));
av_unshift(PL_rsfp_filters, 1);
av_store(PL_rsfp_filters, 0, datasv) ;
return(datasv);
Perl_filter_del(pTHX_ filter_t funcp)
{
SV *datasv;
- DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", funcp));
+ DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", (void*)funcp));
if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
funcp = (filter_t)IoANY(datasv);
DEBUG_P(PerlIO_printf(Perl_debug_log,
"filter_read %d: via function %p (%s)\n",
- idx, funcp, SvPV_nolen(datasv)));
+ idx, (void*)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 */
if (PL_minus_F) {
if (strchr("/'\"", *PL_splitstr)
&& strchr(PL_splitstr + 1, *PL_splitstr))
- Perl_sv_catpvf(aTHX_ PL_linestr, "@F=split(%s);", PL_splitstr);
+ Perl_sv_catpvf(aTHX_ PL_linestr, "our @F=split(%s);", PL_splitstr);
else {
char delim;
s = "'~#\200\1'"; /* surely one char is unused...*/
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
+ (void)SvIOK_on(sv);
+ SvIVX(sv) = 0;
av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
goto retry;
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
+ (void)SvIOK_on(sv);
+ SvIVX(sv) = 0;
av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv);
}
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
* at least, set argv[0] to the basename of the Perl
* interpreter. So, having found "#!", we'll set it right.
*/
- SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
+ SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV)); /* $^X */
assert(SvPOK(x) || SvGMAGICAL(x));
if (sv_eq(x, CopFILESV(PL_curcop))) {
sv_setpvn(x, ipath, ipathend - ipath);
while (SPACE_OR_TAB(*d)) d++;
if (*d++ == '-') {
+ bool switches_done = PL_doswitches;
do {
if (*d == 'M' || *d == 'm') {
char *m = d;
(void)gv_fetchfile(PL_origfilename);
goto retry;
}
+ if (PL_doswitches && !switches_done) {
+ int argc = PL_origargc;
+ char **argv = PL_origargv;
+ do {
+ argc--,argv++;
+ } while (argc && argv[0][0] == '-' && argv[0][1]);
+ init_argv_symbols(argc,argv);
+ }
}
}
}
char tmpbuf[sizeof PL_tokenbuf];
SSize_t tboffset = 0;
expectation attrful;
- bool have_name, have_proto;
+ bool have_name, have_proto, bad_proto;
int key = tmp;
s = skipspace(s);
s = scan_str(s,FALSE,FALSE);
if (!s)
Perl_croak(aTHX_ "Prototype not terminated");
- /* strip spaces */
+ /* strip spaces and check for bad characters */
d = SvPVX(PL_lex_stuff);
tmp = 0;
+ bad_proto = FALSE;
for (p = d; *p; ++p) {
+ if (!strchr("$@%*;[]&\\ ", *p))
+ bad_proto = TRUE;
if (!isSPACE(*p))
d[tmp++] = *p;
}
d[tmp] = '\0';
+ if (bad_proto)
+ Perl_croak(aTHX_ "Malformed prototype for %s : %s",
+ SvPVX(PL_subname), d);
SvCUR(PL_lex_stuff) = tmp;
have_proto = TRUE;
case KEY_write:
#ifdef EBCDIC
{
- static char ctl_l[2];
-
- if (ctl_l[0] == '\0')
- ctl_l[0] = toCTRL('L');
+ char ctl_l[2];
+ ctl_l[0] = toCTRL('L');
+ ctl_l[1] = '\0';
gv_fetchpv(ctl_l,TRUE, SVt_PV);
}
#else
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
+ (void)SvIOK_on(sv);
+ SvIVX(sv) = 0;
av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv);
}
if (*s == term && memEQ(s,PL_tokenbuf,len)) {
add symbol table ops
*/
if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
- OP *o = newOP(OP_PADSV, 0);
- o->op_targ = tmp;
- PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, o);
+ SV *namesv = AvARRAY(PL_comppad_name)[tmp];
+ if (SvFLAGS(namesv) & SVpad_OUR) {
+ SV *sym = sv_2mortal(newSVpv(HvNAME(GvSTASH(namesv)),0));
+ sv_catpvn(sym, "::", 2);
+ sv_catpv(sym, d+1);
+ d = SvPVX(sym);
+ goto intro_sym;
+ }
+ else {
+ OP *o = newOP(OP_PADSV, 0);
+ o->op_targ = tmp;
+ PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, o);
+ }
}
else {
- GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
+ GV *gv;
+ ++d;
+intro_sym:
+ gv = gv_fetchpv(d,
+ (PL_in_eval
+ ? (GV_ADDMULTI | GV_ADDINEVAL)
+ : TRUE),
+ SVt_PV);
PL_lex_op = (OP*)newUNOP(OP_READLINE, 0,
newUNOP(OP_RV2SV, 0,
newGVOP(OP_GV, 0, gv)));
sv_upgrade(sv, SVt_PVMG);
sv_setsv(sv,PL_linestr);
+ (void)SvIOK_on(sv);
+ SvIVX(sv) = 0;
av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv);
}
}
if (*s == '.' && isDIGIT(s[1])) {
/* oops, it's really a v-string, but without the "v" */
- s = start - 1;
+ s = start;
goto vstring;
}
}
/* if it starts with a v, it could be a v-string */
case 'v':
vstring:
- {
- char *pos = s;
- pos++;
- while (isDIGIT(*pos) || *pos == '_')
- pos++;
- if (!isALPHA(*pos)) {
- UV rev;
- U8 tmpbuf[UTF8_MAXLEN+1];
- U8 *tmpend;
- s++; /* get past 'v' */
-
- sv = NEWSV(92,5);
- sv_setpvn(sv, "", 0);
-
- for (;;) {
- if (*s == '0' && isDIGIT(s[1]))
- yyerror("Octal number in vector unsupported");
- rev = 0;
- {
- /* this is atoi() that tolerates underscores */
- char *end = pos;
- UV mult = 1;
- while (--end >= s) {
- UV orev;
- if (*end == '_')
- continue;
- orev = rev;
- rev += (*end - '0') * mult;
- mult *= 10;
- if (orev > rev && ckWARN_d(WARN_OVERFLOW))
- Perl_warner(aTHX_ WARN_OVERFLOW,
- "Integer overflow in decimal number");
- }
- }
- /* Append native character for the rev point */
- tmpend = uvchr_to_utf8(tmpbuf, rev);
- sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
- if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(rev)))
- SvUTF8_on(sv);
- if (*pos == '.' && isDIGIT(pos[1]))
- s = ++pos;
- else {
- s = pos;
- break;
- }
- while (isDIGIT(*pos) || *pos == '_')
- pos++;
- }
- SvPOK_on(sv);
- SvREADONLY_on(sv);
- }
- }
+ sv = NEWSV(92,5); /* preallocate storage space */
+ s = new_vstring(s,sv);
break;
}
return count;
}
#endif
+
https://perl5.git.perl.org / perl5.git / blobdiff