X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=5a43c097b5c6c8a7086048e87aca2e08c93a982e;hb=5e79a27ab8657b40a1ba45b02fa151bd3d5fcd46;hp=cdb12a361f2a686df0d9e15062157a637b2b78bd;hpb=8e07c86ebc651fe92eb7e3b25f801f57cfb8dd6f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/toke.c b/toke.c
index cdb12a3..5a43c09 100644
--- a/toke.c
+++ b/toke.c
@@ -44,6 +44,7 @@ static I32 sublex_start _((void));
 static int uni _((I32 f, char *s));
 #endif
 static char * filter_gets _((SV *sv, FILE *fp));
+static void restore_rsfp _((void *f));
 
 /* The following are arranged oddly so that the guard on the switch statement
  * can get by with a single comparison (if the compiler is smart enough).
@@ -222,7 +223,7 @@ SV *line;
     SAVESPTR(linestr);
     SAVEPPTR(lex_brackstack);
     SAVEPPTR(lex_casestack);
-    SAVESPTR(rsfp);
+    SAVEDESTRUCTOR(restore_rsfp, rsfp);
 
     lex_state = LEX_NORMAL;
     lex_defer = 0;
@@ -257,10 +258,8 @@ SV *line;
     SvTEMP_off(linestr);
     oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr);
     bufend = bufptr + SvCUR(linestr);
-    rs = "\n";
-    rslen = 1;
-    rschar = '\n';
-    rspara = 0;
+    SvREFCNT_dec(rs);
+    rs = newSVpv("\n", 1);
     rsfp = 0;
 }
 
@@ -270,6 +269,19 @@ lex_end()
 }
 
 static void
+restore_rsfp(f)
+void *f;
+{
+    FILE *fp = (FILE*)f;
+
+    if (rsfp == stdin)
+	clearerr(rsfp);
+    else if (rsfp && (rsfp != fp))
+	fclose(rsfp);
+    rsfp = fp;
+}
+
+static void
 incline(s)
 char *s;
 {
@@ -678,8 +690,8 @@ char *start;
 		SvGROW(sv, SvLEN(sv) + 256);
 		d = SvPVX(sv) + i;
 		d -= 2;
-		max = d[1] & 0377;
-		for (i = (*d & 0377); i <= max; i++)
+		max = (U8)d[1];
+		for (i = (U8)*d; i <= max; i++)
 		    *d++ = i;
 		dorange = FALSE;
 		continue;
@@ -1069,13 +1081,21 @@ filter_read(idx, buf_sv, maxlen)
 
 	    /* ensure buf_sv is large enough */
 	    SvGROW(buf_sv, old_len + maxlen) ;
-	    if ((len = fread(SvPVX(buf_sv) + old_len, 1, maxlen, rsfp)) <= 0)
-		return len ;
+	    if ((len = fread(SvPVX(buf_sv) + old_len, 1, maxlen, rsfp)) <= 0){
+		if (ferror(rsfp))
+	            return -1;		/* error */
+	        else
+		    return 0 ;		/* end of file */
+	    }
 	    SvCUR_set(buf_sv, old_len + len) ;
 	} else {
 	    /* Want a line */
-            if (sv_gets(buf_sv, rsfp, (SvCUR(buf_sv)>0) ? 1 : 0) == NULL)
-	        return -1;		/* end of file */
+            if (sv_gets(buf_sv, rsfp, SvCUR(buf_sv)) == NULL) {
+		if (ferror(rsfp))
+	            return -1;		/* error */
+	        else
+		    return 0 ;		/* end of file */
+	    }
 	}
 	return SvCUR(buf_sv);
     }
@@ -1092,7 +1112,7 @@ filter_read(idx, buf_sv, maxlen)
 		idx, funcp, SvPV(datasv,na));
     /* Call function. The function is expected to 	*/
     /* call "FILTER_READ(idx+1, buf_sv)" first.		*/
-    /* Return: <0:error/eof, >=0:not eof (see yylex())	*/
+    /* Return: <0:error, =0:eof, >0:not eof 		*/
     return (*funcp)(idx, buf_sv, maxlen);
 }
 
@@ -1324,8 +1344,18 @@ yylex()
 	if (!in_eval && !preambled) {
 	    preambled = TRUE;
 	    sv_setpv(linestr,incl_perldb());
-	    if (autoboot_preamble)
-		sv_catpv(linestr, autoboot_preamble);
+	    if (SvCUR(linestr))
+		sv_catpv(linestr,";");
+	    if (preambleav){
+		while(AvFILL(preambleav) >= 0) {
+		    SV *tmpsv = av_shift(preambleav);
+		    sv_catsv(linestr, tmpsv);
+		    sv_catpv(linestr, ";");
+		    sv_free(tmpsv);
+		}
+		sv_free((SV*)preambleav);
+		preambleav = NULL;
+	    }
 	    if (minus_n || minus_p) {
 		sv_catpv(linestr, "LINE: while (<>) {");
 		if (minus_l)
@@ -1455,8 +1485,9 @@ yylex()
 		    if (*d++ == '-') {
 			while (d = moreswitches(d)) ;
 			if (perldb && !oldpdb ||
-			    minus_n && !oldn ||
-			    minus_p && !oldp)
+			    ( minus_n || minus_p ) && !(oldn || oldp) )
+			      /* if we have already added "LINE: while (<>) {",
+			         we must not do it again */
 			{
 			    sv_setpv(linestr, "");
 			    oldoldbufptr = oldbufptr = s = SvPVX(linestr);
@@ -1689,7 +1720,7 @@ yylex()
 		    lex_state = LEX_INTERPEND;
 	    }
 	}
-	TOKEN(']');
+	TERM(']');
     case '{':
       leftbracket:
 	s++;
@@ -1747,7 +1778,7 @@ yylex()
 		if (*s == '}')
 		    OPERATOR(HASHBRACK);
 		if (isALPHA(*s)) {
-		    for (t = s; t < bufend && isALPHA(*t); t++) ;
+		    for (t = s; t < bufend && isALNUM(*t); t++) ;
 		}
 		else if (*s == '\'' || *s == '"') {
 		    t = strchr(s+1,*s);
@@ -1807,7 +1838,7 @@ yylex()
 	    AOPERATOR(ANDAND);
 	s--;
 	if (expect == XOPERATOR) {
-	    if (isALPHA(*s) && bufptr == SvPVX(linestr)) {
+	    if (dowarn && isALPHA(*s) && bufptr == SvPVX(linestr)) {
 		curcop->cop_line--;
 		warn(warn_nosemi);
 		curcop->cop_line++;
@@ -1822,6 +1853,7 @@ yylex()
 	}
 	else
 	    PREREF('&');
+	yylval.ival = (OPpENTERSUB_AMPER<<8);
 	TERM('&');
 
     case '|':
@@ -1846,6 +1878,24 @@ yylex()
 	if (expect == XSTATE && isALPHA(tmp) &&
 		(s == SvPVX(linestr)+1 || s[-2] == '\n') )
 	{
+	    if (in_eval && !rsfp) {
+		d = bufend;
+		while (s < d) {
+		    if (*s++ == '\n') {
+			incline(s);
+			if (strnEQ(s,"=cut",4)) {
+			    s = strchr(s,'\n');
+			    if (s)
+				s++;
+			    else
+				s = d;
+			    incline(s);
+			    goto retry;
+			}
+		    }
+		}
+		goto retry;
+	    }
 	    s = bufend;
 	    doextract = TRUE;
 	    goto retry;
@@ -2003,25 +2053,33 @@ yylex()
 	    }
 	    else if (!strchr(tokenbuf,':')) {
 		if (oldexpect != XREF || oldoldbufptr == last_lop) {
-		    if (*s == '[')
-			tokenbuf[0] = '@';
-		    else if (*s == '{')
-			tokenbuf[0] = '%';
+		    if (intuit_more(s)) {
+			if (*s == '[')
+			    tokenbuf[0] = '@';
+			else if (*s == '{')
+			    tokenbuf[0] = '%';
+		    }
 		}
 		if (tmp = pad_findmy(tokenbuf)) {
+		    if (!tokenbuf[2] && *tokenbuf =='$' &&
+			tokenbuf[1] <= 'b' && tokenbuf[1] >= 'a')
+		    {
+			for (d = in_eval ? oldoldbufptr : SvPVX(linestr);
+			    d < bufend && *d != '\n';
+			    d++)
+			{
+			    if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
+			        croak("Can't use \"my %s\" in sort comparison",
+				    tokenbuf);
+			    }
+			}
+		    }
 		    nextval[nexttoke].opval = newOP(OP_PADANY, 0);
 		    nextval[nexttoke].opval->op_targ = tmp;
 		    force_next(PRIVATEREF);
 		}
-		else {
-		    if ((tainting || !euid) &&
-			!isLOWER(tokenbuf[1]) &&
-			(isDIGIT(tokenbuf[1]) ||
-			 strchr("&`'+", tokenbuf[1]) ||
-			 instr(tokenbuf,"MATCH") ))
-			hints |= HINT_BLOCK_SCOPE; /* Can't optimize block out*/
+		else
 		    force_ident(tokenbuf+1, *tokenbuf);
-		}
 	    }
 	    else
 		force_ident(tokenbuf+1, *tokenbuf);
@@ -2051,8 +2109,10 @@ yylex()
 		TERM('@');
 	    }
 	    else if (!strchr(tokenbuf,':')) {
-		if (*s == '{')
-		    tokenbuf[0] = '%';
+		if (intuit_more(s)) {
+		    if (*s == '{')
+			tokenbuf[0] = '%';
+		}
 		if (tmp = pad_findmy(tokenbuf)) {
 		    nextval[nexttoke].opval = newOP(OP_PADANY, 0);
 		    nextval[nexttoke].opval->op_targ = tmp;
@@ -2062,7 +2122,7 @@ yylex()
 	    }
 
 	    /* Force them to make up their mind on "@foo". */
-	    if (lex_state != LEX_NORMAL &&
+	    if (lex_state != LEX_NORMAL && !lex_brackets &&
 		    ( !(gv = gv_fetchpv(tokenbuf+1, FALSE, SVt_PVAV)) ||
 		      (*tokenbuf == '@'
 			? !GvAV(gv)
@@ -2168,7 +2228,13 @@ yylex()
 	}
 	if (!s)
 	    missingterm((char*)0);
-	yylval.ival = OP_STRINGIFY;
+	yylval.ival = OP_CONST;
+	for (d = SvPV(lex_stuff, len); len; len--, d++) {
+	    if (*d == '$' || *d == '@' || *d == '\\') {
+		yylval.ival = OP_STRINGIFY;
+		break;
+	    }
+	}
 	TERM(sublex_start());
 
     case '`':
@@ -2228,6 +2294,9 @@ yylex()
 	bufptr = s;
 	s = scan_word(s, tokenbuf, FALSE, &len);
 	
+	if (*s == ':' && s[1] == ':' && strNE(tokenbuf, "CORE"))
+	    goto just_a_word;
+
 	tmp = keyword(tokenbuf, len);
 
 	/* Is this a word before a => operator? */
@@ -2247,10 +2316,9 @@ yylex()
 	if (tmp < 0) {			/* second-class keyword? */
 	    GV* gv;
 	    if (expect != XOPERATOR &&
-	      (*s != ':' || s[1] != ':') &&
-	      (gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV)) &&
-	      (GvFLAGS(gv) & GVf_IMPORTED) &&
-	      GvCV(gv))
+		(*s != ':' || s[1] != ':') &&
+		(gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) &&
+		GvIMPORTED_CV(gv))
 	    {
 		tmp = 0;
 	    }
@@ -2344,6 +2412,7 @@ yylex()
 		    nextval[nexttoke].opval = yylval.opval;
 		    expect = XOPERATOR;
 		    force_next(WORD);
+		    yylval.ival = 0;
 		    TOKEN('&');
 		}
 
@@ -2363,10 +2432,12 @@ yylex()
 		/* Not a method, so call it a subroutine (if defined) */
 
 		if (gv && GvCV(gv)) {
-		    nextval[nexttoke].opval = yylval.opval;
+		    CV* cv = GvCV(gv);
 		    if (*s == '(') {
+			nextval[nexttoke].opval = yylval.opval;
 			expect = XTERM;
 			force_next(WORD);
+			yylval.ival = 0;
 			TOKEN('&');
 		    }
 		    if (lastchar == '-')
@@ -2374,6 +2445,23 @@ yylex()
 				tokenbuf, tokenbuf);
 		    last_lop = oldbufptr;
 		    last_lop_op = OP_ENTERSUB;
+		    /* Resolve to GV now. */
+		    op_free(yylval.opval);
+		    yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
+		    /* Is there a prototype? */
+		    if (SvPOK(cv)) {
+			STRLEN len;
+			char *proto = SvPV((SV*)cv, len);
+			if (!len)
+			    TERM(FUNC0SUB);
+			if (strEQ(proto, "$"))
+			    OPERATOR(UNIOPSUB);
+			if (*proto == '&' && *s == '{') {
+			    sv_setpv(subname,"__ANON__");
+			    PREBLOCK(LSTOPSUB);
+			}
+		    }
+		    nextval[nexttoke].opval = yylval.opval;
 		    expect = XTERM;
 		    force_next(WORD);
 		    TOKEN(NOAMP);
@@ -2426,14 +2514,14 @@ yylex()
 	    GV *gv;
 
 	    /*SUPPRESS 560*/
-	    if (!in_eval || tokenbuf[2] == 'D') {
+	    if (rsfp && (!in_eval || tokenbuf[2] == 'D')) {
 		char dname[256];
 		char *pname = "main";
 		if (tokenbuf[2] == 'D')
 		    pname = HvNAME(curstash ? curstash : defstash);
 		sprintf(dname,"%s::DATA", pname);
 		gv = gv_fetchpv(dname,TRUE, SVt_PVIO);
-		SvMULTI_on(gv);
+		GvMULTI_on(gv);
 		if (!GvIO(gv))
 		    GvIOp(gv) = newIO();
 		IoIFP(GvIOp(gv)) = rsfp;
@@ -2895,6 +2983,9 @@ yylex()
 	    checkcomma(s,tokenbuf,"filehandle");
 	    LOP(OP_PRTF,XREF);
 
+	case KEY_prototype:
+	    UNI(OP_PROTOTYPE);
+
 	case KEY_push:
 	    LOP(OP_PUSH,XTERM);
 
@@ -3150,13 +3241,10 @@ yylex()
 	case KEY_sub:
 	  really_sub:
 	    s = skipspace(s);
-	    if (*s == '{' && tmp == KEY_sub) {
-		sv_setpv(subname,"__ANON__");
-		PRETERMBLOCK(ANONSUB);
-	    }
-	    expect = XBLOCK;
+
 	    if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
 		char tmpbuf[128];
+		expect = XBLOCK;
 		d = scan_word(s, tmpbuf, TRUE, &len);
 		if (strchr(tmpbuf, ':'))
 		    sv_setpv(subname, tmpbuf);
@@ -3166,17 +3254,47 @@ yylex()
 		    sv_catpvn(subname,tmpbuf,len);
 		}
 		s = force_word(s,WORD,FALSE,TRUE,TRUE);
+		s = skipspace(s);
 	    }
-	    else
+	    else {
+		expect = XTERMBLOCK;
 		sv_setpv(subname,"?");
+	    }
 
-	    if (tmp != KEY_format)
-		PREBLOCK(SUB);
+	    if (tmp == KEY_format) {
+		s = skipspace(s);
+		if (*s == '=')
+		    lex_formbrack = lex_brackets + 1;
+		OPERATOR(FORMAT);
+	    }
 
-	    s = skipspace(s);
-	    if (*s == '=')
-		lex_formbrack = lex_brackets + 1;
-	    OPERATOR(FORMAT);
+	    /* Look for a prototype */
+	    if (*s == '(') {
+		s = scan_str(s);
+		if (!s) {
+		    if (lex_stuff)
+			SvREFCNT_dec(lex_stuff);
+		    lex_stuff = Nullsv;
+		    croak("Prototype not terminated");
+		}
+		nexttoke++;
+		nextval[1] = nextval[0];
+		nexttype[1] = nexttype[0];
+		nextval[0].opval = (OP*)newSVOP(OP_CONST, 0, lex_stuff);
+		nexttype[0] = THING;
+		if (nexttoke == 1) {
+		    lex_defer = lex_state;
+		    lex_expect = expect;
+		    lex_state = LEX_KNOWNEXT;
+		}
+		lex_stuff = Nullsv;
+	    }
+
+	    if (*SvPV(subname,na) == '?') {
+		sv_setpv(subname,"__ANON__");
+		TOKEN(ANONSUB);
+	    }
+	    PREBLOCK(SUB);
 
 	case KEY_system:
 	    set_csh();
@@ -3188,6 +3306,9 @@ yylex()
 	case KEY_syscall:
 	    LOP(OP_SYSCALL,XTERM);
 
+	case KEY_sysopen:
+	    LOP(OP_SYSOPEN,XTERM);
+
 	case KEY_sysread:
 	    LOP(OP_SYSREAD,XTERM);
 
@@ -3207,6 +3328,9 @@ yylex()
 	case KEY_tie:
 	    LOP(OP_TIE,XTERM);
 
+	case KEY_tied:
+	    UNI(OP_TIED);
+
 	case KEY_time:
 	    FUN0(OP_TIME);
 
@@ -3433,6 +3557,7 @@ I32 len;
 	    break;
 	case 6:
 	    if (strEQ(d,"exists"))		return KEY_exists;
+	    if (strEQ(d,"elseif")) warn("elseif should be elsif");
 	    break;
 	case 8:
 	    if (strEQ(d,"endgrent"))		return -KEY_endgrent;
@@ -3678,6 +3803,8 @@ I32 len;
 	case 7:
 	    if (strEQ(d,"package"))		return KEY_package;
 	    break;
+	case 9:
+	    if (strEQ(d,"prototype"))		return KEY_prototype;
 	}
 	break;
     case 'q':
@@ -3820,6 +3947,7 @@ I32 len;
 		if (strEQ(d,"system"))		return -KEY_system;
 		break;
 	    case 7:
+		if (strEQ(d,"sysopen"))		return -KEY_sysopen;
 		if (strEQ(d,"sysread"))		return -KEY_sysread;
 		if (strEQ(d,"symlink"))		return -KEY_symlink;
 		if (strEQ(d,"syscall"))		return -KEY_syscall;
@@ -3841,6 +3969,7 @@ I32 len;
 	    break;
 	case 4:
 	    if (strEQ(d,"tell"))		return -KEY_tell;
+	    if (strEQ(d,"tied"))		return KEY_tied;
 	    if (strEQ(d,"time"))		return -KEY_time;
 	    break;
 	case 5:
@@ -3951,7 +4080,7 @@ char *what;
 	if (*s == ',') {
 	    int kw;
 	    *s = '\0';
-	    kw = keyword(w, s - w);
+	    kw = keyword(w, s - w) || perl_get_cv(w, FALSE) != 0;
 	    *s = ',';
 	    if (kw)
 		return;
@@ -4132,6 +4261,7 @@ char *start;
     while (*s && strchr("iogmsx", *s))
 	pmflag(&pm->op_pmflags,*s++);
 
+    pm->op_pmpermflags = pm->op_pmflags;
     lex_op = (OP*)pm;
     yylval.ival = OP_MATCH;
     return s;
@@ -4194,6 +4324,7 @@ char *start;
 	lex_repl = repl;
     }
 
+    pm->op_pmpermflags = pm->op_pmflags;
     lex_op = (OP*)pm;
     yylval.ival = OP_SUBST;
     return s;
@@ -4303,12 +4434,15 @@ register char *s;
     SV *tmpstr;
     char term;
     register char *d;
+    char *peek;
 
     s += 2;
     d = tokenbuf;
     if (!rsfp)
 	*d++ = '\n';
-    if (*s && strchr("`'\"",*s)) {
+    for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
+    if (*peek && strchr("`'\"",*peek)) {
+	s = peek;
 	term = *s++;
 	s = cpytill(d,s,bufend,term,&len);
 	if (s < bufend)
@@ -4320,6 +4454,8 @@ register char *s;
 	    s++, term = '\'';
 	else
 	    term = '"';
+	if (!isALNUM(*s))
+	    deprecate("bare << to mean <<\"\"");
 	while (isALNUM(*s))
 	    *d++ = *s++;
     }				/* assuming tokenbuf won't clobber */
@@ -4422,7 +4558,7 @@ char *start;
     else
 	croak("Unterminated <> operator");
 
-    if (*d == '$') d++;
+    if (*d == '$' && d[1]) d++;
     while (*d && (isALNUM(*d) || *d == '\'' || *d == ':'))
 	d++;
     if (d - tokenbuf != len) {
@@ -4530,6 +4666,7 @@ char *start;
 
 	if (!rsfp ||
 	 !(oldoldbufptr = oldbufptr = s = filter_gets(linestr, rsfp))) {
+	    sv_free(sv);
 	    curcop->cop_line = multi_start;
 	    return Nullch;
 	}
@@ -4833,6 +4970,8 @@ char *s;
 	if (lex_state == LEX_NORMAL ||
 	   (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL))
 	    (void)strcpy(tname,"at end of line");
+	else if (lex_inpat)
+	    (void)strcpy(tname,"within pattern");
 	else
 	    (void)strcpy(tname,"within string");
     }
@@ -4851,11 +4990,12 @@ char *s;
     if (in_eval & 2)
 	warn("%s",buf);
     else if (in_eval)
-	sv_catpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),buf);
+	sv_catpv(GvSV(errgv),buf);
     else
 	fputs(buf,stderr);
     if (++error_count >= 10)
 	croak("%s has too many errors.\n",
 	SvPVX(GvSV(curcop->cop_filegv)));
+    in_my = 0;
     return 0;
 }