perl 5.003_01: pod/perlxstut.pod

[p5sagit/p5-mst-13.2.git] / toke.c

diff --git a/toke.c b/toke.c
index 7b882fa..5a43c09 100644 (file)
--- 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;
 {
@@ -1473,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);
@@ -1765,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);
@@ -1840,6 +1853,7 @@ yylex()
        }
        else
            PREREF('&');
+       yylval.ival = (OPpENTERSUB_AMPER<<8);
        TERM('&');
 
     case '|':
@@ -1864,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;
@@ -2029,6 +2061,19 @@ yylex()
                    }
                }
                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);
@@ -2271,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;
            }
@@ -2368,6 +2412,7 @@ yylex()
                    nextval[nexttoke].opval = yylval.opval;
                    expect = XOPERATOR;
                    force_next(WORD);
+                   yylval.ival = 0;
                    TOKEN('&');
                }
 
@@ -2388,10 +2433,11 @@ yylex()
 
                if (gv && GvCV(gv)) {
                    CV* cv = GvCV(gv);
-                   nextval[nexttoke].opval = yylval.opval;
                    if (*s == '(') {
+                       nextval[nexttoke].opval = yylval.opval;
                        expect = XTERM;
                        force_next(WORD);
+                       yylval.ival = 0;
                        TOKEN('&');
                    }
                    if (lastchar == '-')
@@ -2399,6 +2445,9 @@ 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;
@@ -2412,6 +2461,7 @@ yylex()
                            PREBLOCK(LSTOPSUB);
                        }
                    }
+                   nextval[nexttoke].opval = yylval.opval;
                    expect = XTERM;
                    force_next(WORD);
                    TOKEN(NOAMP);
@@ -2464,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;
@@ -2933,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);
 
@@ -3253,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);
 
@@ -3272,6 +3328,9 @@ yylex()
        case KEY_tie:
            LOP(OP_TIE,XTERM);
 
+       case KEY_tied:
+           UNI(OP_TIED);
+
        case KEY_time:
            FUN0(OP_TIME);
 
@@ -3744,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':
@@ -3886,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;
@@ -3907,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:
@@ -4603,6 +4666,7 @@ char *start;
 
        if (!rsfp ||
         !(oldoldbufptr = oldbufptr = s = filter_gets(linestr, rsfp))) {
+           sv_free(sv);
            curcop->cop_line = multi_start;
            return Nullch;
        }