perl 5.003_07: t/lib/io_pipe.t
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index 118079c..c6d56ed 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -16,6 +16,7 @@
 
 static void check_uni _((void));
 static void  force_next _((I32 type));
+static char *force_version _((char *start));
 static char *force_word _((char *start, int token, int check_keyword, int allow_pack, int allow_tick));
 static SV *q _((SV *sv));
 static char *scan_const _((char *start));
@@ -43,7 +44,10 @@ static I32 sublex_start _((void));
 #ifdef CRIPPLED_CC
 static int uni _((I32 f, char *s));
 #endif
-static char * filter_gets _((SV *sv, FILE *fp));
+static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append));
+static void restore_rsfp _((void *f));
+
+static char *linestart;                /* beg. of most recently read line */
 
 /* 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).
@@ -67,6 +71,12 @@ static char * filter_gets _((SV *sv, FILE *fp));
 #include <sys/file.h>
 #endif
 
+/* XXX If this causes problems, set i_unistd=undef in the hint file.  */
+#ifdef I_UNISTD
+#  include <unistd.h> /* Needed for execv() */
+#endif
+
+
 #ifdef ff_next
 #undef ff_next
 #endif
@@ -139,7 +149,7 @@ char *s;
 {
     char tmpbuf[128];
     char *oldbp = bufptr;
-    bool is_first = (oldbufptr == SvPVX(linestr));
+    bool is_first = (oldbufptr == linestart);
     bufptr = s;
     sprintf(tmpbuf, "%s found where operator expected", what);
     yywarn(tmpbuf);
@@ -219,10 +229,11 @@ SV *line;
     SAVEPPTR(bufend);
     SAVEPPTR(oldbufptr);
     SAVEPPTR(oldoldbufptr);
+    SAVEPPTR(linestart);
     SAVESPTR(linestr);
     SAVEPPTR(lex_brackstack);
     SAVEPPTR(lex_casestack);
-    SAVESPTR(rsfp);
+    SAVEDESTRUCTOR(restore_rsfp, rsfp);
 
     lex_state = LEX_NORMAL;
     lex_defer = 0;
@@ -255,12 +266,10 @@ SV *line;
        sv_catpvn(linestr, "\n;", 2);
     }
     SvTEMP_off(linestr);
-    oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr);
+    oldoldbufptr = oldbufptr = bufptr = linestart = 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 +279,19 @@ lex_end()
 }
 
 static void
+restore_rsfp(f)
+void *f;
+{
+    PerlIO *fp = (PerlIO*)f;
+
+    if (rsfp == PerlIO_stdin())
+       PerlIO_clearerr(rsfp);
+    else if (rsfp && (rsfp != fp))
+       PerlIO_close(rsfp);
+    rsfp = fp;
+}
+
+static void
 incline(s)
 char *s;
 {
@@ -320,6 +342,7 @@ register char *s;
        return s;
     }
     for (;;) {
+       STRLEN prevlen;
        while (s < bufend && isSPACE(*s))
            s++;
        if (s < bufend && *s == '#') {
@@ -330,7 +353,7 @@ register char *s;
        }
        if (s < bufend || !rsfp || lex_state != LEX_NORMAL)
            return s;
-       if ((s = filter_gets(linestr, rsfp)) == Nullch) {
+       if ((s = filter_gets(linestr, rsfp, (prevlen = SvCUR(linestr)))) == Nullch) {
            if (minus_n || minus_p) {
                sv_setpv(linestr,minus_p ? ";}continue{print" : "");
                sv_catpv(linestr,";}");
@@ -338,25 +361,26 @@ register char *s;
            }
            else
                sv_setpv(linestr,";");
-           oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr);
+           oldoldbufptr = oldbufptr = bufptr = s = linestart = SvPVX(linestr);
            bufend = SvPVX(linestr) + SvCUR(linestr);
            if (preprocess && !in_eval)
                (void)my_pclose(rsfp);
-           else if ((FILE*)rsfp == stdin)
-               clearerr(stdin);
+           else if ((PerlIO*)rsfp == PerlIO_stdin())
+               PerlIO_clearerr(rsfp);
            else
-               (void)fclose(rsfp);
+               (void)PerlIO_close(rsfp);
            rsfp = Nullfp;
            return s;
        }
-       oldoldbufptr = oldbufptr = bufptr = s;
-       bufend = bufptr + SvCUR(linestr);
+       linestart = bufptr = s + prevlen;
+       bufend = s + SvCUR(linestr);
+       s = bufptr;
        incline(s);
        if (perldb && curstash != debstash) {
            SV *sv = NEWSV(85,0);
 
            sv_upgrade(sv, SVt_PVMG);
-           sv_setsv(sv,linestr);
+           sv_setpvn(sv,bufptr,bufend-bufptr);
            av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
        }
     }
@@ -503,6 +527,34 @@ int kind;
     }
 }
 
+static char *
+force_version(s)
+char *s;
+{
+    OP *version = Nullop;
+
+    s = skipspace(s);
+
+    /* default VERSION number -- GBARR */
+
+    if(isDIGIT(*s)) {
+        char *d;
+        int c;
+        for( d=s, c = 1; isDIGIT(*d) || (*d == '.' && c--); d++);
+        if((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') {
+            s = scan_num(s);
+            /* real VERSION number -- GBARR */
+            version = yylval.opval;
+        }
+    }
+
+    /* NOTE: The parser sees the package name and the VERSION swapped */
+    nextval[nexttoke].opval = version;
+    force_next(WORD); 
+
+    return (s);
+}
+
 static SV *
 q(sv)
 SV *sv;
@@ -566,6 +618,7 @@ sublex_start()
     SAVEPPTR(bufptr);
     SAVEPPTR(oldbufptr);
     SAVEPPTR(oldoldbufptr);
+    SAVEPPTR(linestart);
     SAVESPTR(linestr);
     SAVEPPTR(lex_brackstack);
     SAVEPPTR(lex_casestack);
@@ -573,7 +626,7 @@ sublex_start()
     linestr = lex_stuff;
     lex_stuff = Nullsv;
 
-    bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr);
+    bufend = bufptr = oldbufptr = oldoldbufptr = linestart = SvPVX(linestr);
     bufend += SvCUR(linestr);
     SAVEFREESV(linestr);
 
@@ -625,7 +678,7 @@ sublex_done()
     if (lex_repl && (lex_inwhat == OP_SUBST || lex_inwhat == OP_TRANS)) {
        linestr = lex_repl;
        lex_inpat = 0;
-       bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr);
+       bufend = bufptr = oldbufptr = oldoldbufptr = linestart = SvPVX(linestr);
        bufend += SvCUR(linestr);
        SAVEFREESV(linestr);
        lex_dojoin = FALSE;
@@ -678,8 +731,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;
@@ -953,7 +1006,7 @@ GV *gv;
        if (indirgv && GvCV(indirgv))
            return 0;
        /* filehandle or package name makes it a method */
-       if (!gv || GvIO(indirgv) || gv_stashpv(tmpbuf, FALSE)) {
+       if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) {
            s = skipspace(s);
            nextval[nexttoke].opval =
                (OP*)newSVOP(OP_CONST, 0,
@@ -1069,8 +1122,8 @@ 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){
-               if (ferror(rsfp))
+           if ((len = PerlIO_read(rsfp, SvPVX(buf_sv) + old_len, maxlen)) <= 0){
+               if (PerlIO_error(rsfp))
                    return -1;          /* error */
                else
                    return 0 ;          /* end of file */
@@ -1079,7 +1132,7 @@ filter_read(idx, buf_sv, maxlen)
        } else {
            /* Want a line */
             if (sv_gets(buf_sv, rsfp, SvCUR(buf_sv)) == NULL) {
-               if (ferror(rsfp))
+               if (PerlIO_error(rsfp))
                    return -1;          /* error */
                else
                    return 0 ;          /* end of file */
@@ -1105,9 +1158,10 @@ filter_read(idx, buf_sv, maxlen)
 }
 
 static char *
-filter_gets(sv,fp)
+filter_gets(sv,fp, append)
 register SV *sv;
-register FILE *fp;
+register PerlIO *fp;
+STRLEN append;
 {
     if (rsfp_filters) {
 
@@ -1118,7 +1172,7 @@ register FILE *fp;
            return Nullch ;
     }
     else 
-        return (sv_gets(sv, fp, 0)) ;
+        return (sv_gets(sv, fp, append));
     
 }
 
@@ -1187,7 +1241,7 @@ yylex()
                return ')';
            }
            if (lex_casemods > 10) {
-               char* newlb = (char*)realloc(lex_casestack, lex_casemods + 2);
+               char* newlb = Renew(lex_casestack, lex_casemods + 2, char);
                if (newlb != lex_casestack) {
                    SAVEFREEPV(newlb);
                    lex_casestack = newlb;
@@ -1308,7 +1362,7 @@ yylex()
     oldoldbufptr = oldbufptr;
     oldbufptr = s;
     DEBUG_p( {
-       fprintf(stderr,"### Tokener expecting %s at %s\n", exp_name[expect], s);
+       PerlIO_printf(PerlIO_stderr(), "### Tokener expecting %s at %s\n", exp_name[expect], s);
     } )
 
   retry:
@@ -1332,8 +1386,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)
@@ -1354,7 +1418,7 @@ yylex()
                }
            }
            sv_catpv(linestr, "\n");
-           oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+           oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
            bufend = SvPVX(linestr) + SvCUR(linestr);
            if (perldb && curstash != debstash) {
                SV *sv = NEWSV(85,0);
@@ -1366,26 +1430,26 @@ yylex()
            goto retry;
        }
        do {
-           if ((s = filter_gets(linestr, rsfp)) == Nullch) {
+           if ((s = filter_gets(linestr, rsfp, 0)) == Nullch) {
              fake_eof:
                if (rsfp) {
                    if (preprocess && !in_eval)
                        (void)my_pclose(rsfp);
-                   else if ((FILE*)rsfp == stdin)
-                       clearerr(stdin);
+                   else if ((PerlIO *)rsfp == PerlIO_stdin())
+                       PerlIO_clearerr(rsfp);
                    else
-                       (void)fclose(rsfp);
+                       (void)PerlIO_close(rsfp);
                    rsfp = Nullfp;
                }
                if (!in_eval && (minus_n || minus_p)) {
                    sv_setpv(linestr,minus_p ? ";}continue{print" : "");
                    sv_catpv(linestr,";}");
-                   oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+                   oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
                    bufend = SvPVX(linestr) + SvCUR(linestr);
                    minus_n = minus_p = 0;
                    goto retry;
                }
-               oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+               oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
                sv_setpv(linestr,"");
                TOKEN(';');     /* not infinite loop because rsfp is NULL now */
            }
@@ -1396,14 +1460,14 @@ yylex()
                /* Incest with pod. */
                if (*s == '=' && strnEQ(s, "=cut", 4)) {
                    sv_setpv(linestr, "");
-                   oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+                   oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
                    bufend = SvPVX(linestr) + SvCUR(linestr);
                    doextract = FALSE;
                }
            }
            incline(s);
        } while (doextract);
-       oldoldbufptr = oldbufptr = bufptr = s;
+       oldoldbufptr = oldbufptr = bufptr = linestart = s;
        if (perldb && curstash != debstash) {
            SV *sv = NEWSV(85,0);
 
@@ -1458,16 +1522,17 @@ yylex()
                    int oldp = minus_p;
 
                    while (*d && !isSPACE(*d)) d++;
-                   while (*d == ' ') d++;
+                   while (*d == ' ' || *d == '\t') d++;
 
                    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);
+                           oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
                            bufend = SvPVX(linestr) + SvCUR(linestr);
                            preambled = FALSE;
                            if (perldb)
@@ -1702,7 +1767,7 @@ yylex()
       leftbracket:
        s++;
        if (lex_brackets > 100) {
-           char* newlb = (char*)realloc(lex_brackstack, lex_brackets + 1);
+           char* newlb = Renew(lex_brackstack, lex_brackets + 1, char);
            if (newlb != lex_brackstack) {
                SAVEFREEPV(newlb);
                lex_brackstack = newlb;
@@ -1723,7 +1788,7 @@ yylex()
        case XOPERATOR:
            while (s < bufend && (*s == ' ' || *s == '\t'))
                s++;
-           if (s < bufend && isALPHA(*s)) {
+           if (s < bufend && (isALPHA(*s) || *s == '_')) {
                d = scan_word(s, tokenbuf, FALSE, &len);
                while (d < bufend && (*d == ' ' || *d == '\t'))
                    d++;
@@ -1755,7 +1820,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);
@@ -1815,7 +1880,7 @@ yylex()
            AOPERATOR(ANDAND);
        s--;
        if (expect == XOPERATOR) {
-           if (dowarn && isALPHA(*s) && bufptr == SvPVX(linestr)) {
+           if (dowarn && isALPHA(*s) && bufptr == linestart) {
                curcop->cop_line--;
                warn(warn_nosemi);
                curcop->cop_line++;
@@ -1830,6 +1895,7 @@ yylex()
        }
        else
            PREREF('&');
+       yylval.ival = (OPpENTERSUB_AMPER<<8);
        TERM('&');
 
     case '|':
@@ -1852,8 +1918,26 @@ yylex()
            warn("Reversed %c= operator",tmp);
        s--;
        if (expect == XSTATE && isALPHA(tmp) &&
-               (s == SvPVX(linestr)+1 || s[-2] == '\n') )
+               (s == linestart+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;
@@ -2019,6 +2103,20 @@ yylex()
                    }
                }
                if (tmp = pad_findmy(tokenbuf)) {
+                   if (last_lop_op == OP_SORT &&
+                       !tokenbuf[2] && *tokenbuf =='$' &&
+                       tokenbuf[1] <= 'b' && tokenbuf[1] >= 'a')
+                   {
+                       for (d = in_eval ? oldoldbufptr : linestart;
+                           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);
@@ -2115,7 +2213,7 @@ yylex()
 
     case '.':
        if (lex_formbrack && lex_brackets == lex_formbrack && s[1] == '\n' &&
-               (s == SvPVX(linestr) || s[-1] == '\n') ) {
+               (s == linestart || s[-1] == '\n') ) {
            lex_formbrack = 0;
            expect = XSTATE;
            goto rightbracket;
@@ -2261,10 +2359,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;
            }
@@ -2300,7 +2397,7 @@ yylex()
                    }
                }
                else if (expect == XOPERATOR) {
-                   if (bufptr == SvPVX(linestr)) {
+                   if (bufptr == linestart) {
                        curcop->cop_line--;
                        warn(warn_nosemi);
                        curcop->cop_line++;
@@ -2358,6 +2455,7 @@ yylex()
                    nextval[nexttoke].opval = yylval.opval;
                    expect = XOPERATOR;
                    force_next(WORD);
+                   yylval.ival = 0;
                    TOKEN('&');
                }
 
@@ -2378,10 +2476,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 == '-')
@@ -2389,6 +2488,20 @@ yylex()
                                tokenbuf, tokenbuf);
                    last_lop = oldbufptr;
                    last_lop_op = OP_ENTERSUB;
+                   /* Check for a constant sub */
+                   {
+                       SV *sv = cv_const_sv(cv);
+                       if (sv) {
+                           SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
+                           ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc(sv);
+                           yylval.opval->op_private = 0;
+                           TOKEN(WORD);
+                       }
+                   }
+
+                   /* 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;
@@ -2402,6 +2515,7 @@ yylex()
                            PREBLOCK(LSTOPSUB);
                        }
                    }
+                   nextval[nexttoke].opval = yylval.opval;
                    expect = XTERM;
                    force_next(WORD);
                    TOKEN(NOAMP);
@@ -2410,6 +2524,7 @@ yylex()
                if (hints & HINT_STRICT_SUBS &&
                    lastchar != '-' &&
                    strnNE(s,"->",2) &&
+                   last_lop_op != OP_TRUNCATE &&  /* S/F prototype in opcode.pl */
                    last_lop_op != OP_ACCEPT &&
                    last_lop_op != OP_PIPE_OP &&
                    last_lop_op != OP_SOCKPAIR)
@@ -2454,26 +2569,28 @@ 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;
 #if defined(HAS_FCNTL) && defined(F_SETFD)
                {
-                   int fd = fileno(rsfp);
+                   int fd = PerlIO_fileno(rsfp);
                    fcntl(fd,F_SETFD,fd >= 3);
                }
 #endif
+               /* Mark this internal pseudo-handle as clean */
+               IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT;
                if (preprocess)
                    IoTYPE(GvIOp(gv)) = '|';
-               else if ((FILE*)rsfp == stdin)
+               else if ((PerlIO*)rsfp == PerlIO_stdin())
                    IoTYPE(GvIOp(gv)) = '-';
                else
                    IoTYPE(GvIOp(gv)) = '<';
@@ -2884,6 +3001,7 @@ yylex()
            if (expect != XSTATE)
                yyerror("\"no\" not allowed in expression");
            s = force_word(s,WORD,FALSE,TRUE,FALSE);
+           s = force_version(s);
            yylval.ival = 0;
            OPERATOR(USE);
 
@@ -2923,6 +3041,9 @@ yylex()
            checkcomma(s,tokenbuf,"filehandle");
            LOP(OP_PRTF,XREF);
 
+       case KEY_prototype:
+           UNI(OP_PROTOTYPE);
+
        case KEY_push:
            LOP(OP_PUSH,XTERM);
 
@@ -2996,7 +3117,7 @@ yylex()
            *tokenbuf = '\0';
            s = force_word(s,WORD,TRUE,TRUE,FALSE);
            if (isIDFIRST(*tokenbuf))
-               gv_stashpv(tokenbuf, TRUE);
+               gv_stashpvn(tokenbuf, strlen(tokenbuf), TRUE);
            else if (*s == '<')
                yyerror("<> should be quotes");
            UNI(OP_REQUIRE);
@@ -3243,6 +3364,9 @@ yylex()
        case KEY_syscall:
            LOP(OP_SYSCALL,XTERM);
 
+       case KEY_sysopen:
+           LOP(OP_SYSOPEN,XTERM);
+
        case KEY_sysread:
            LOP(OP_SYSREAD,XTERM);
 
@@ -3262,6 +3386,9 @@ yylex()
        case KEY_tie:
            LOP(OP_TIE,XTERM);
 
+       case KEY_tied:
+           UNI(OP_TIED);
+
        case KEY_time:
            FUN0(OP_TIME);
 
@@ -3314,7 +3441,18 @@ yylex()
        case KEY_use:
            if (expect != XSTATE)
                yyerror("\"use\" not allowed in expression");
-           s = force_word(s,WORD,FALSE,TRUE,FALSE);
+           s = skipspace(s);
+           if(isDIGIT(*s)) {
+               s = force_version(s);
+               if(*s == ';' || (s = skipspace(s), *s == ';')) {
+                   nextval[nexttoke].opval = Nullop;
+                   force_next(WORD);
+               }
+           }
+           else {
+               s = force_word(s,WORD,FALSE,TRUE,FALSE);
+               s = force_version(s);
+           }
            yylval.ival = 1;
            OPERATOR(USE);
 
@@ -3734,6 +3872,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':
@@ -3876,6 +4016,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;
@@ -3897,6 +4038,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:
@@ -4414,7 +4556,7 @@ register char *s;
     if (!rsfp) {
        d = s;
        while (s < bufend &&
-         (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
+         (*s != term || memcmp(s,tokenbuf,len) != 0) ) {
            if (*s++ == '\n')
                curcop->cop_line++;
        }
@@ -4426,14 +4568,14 @@ register char *s;
        s += len - 1;
        sv_catpvn(herewas,s,bufend-s);
        sv_setsv(linestr,herewas);
-       oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr);
+       oldoldbufptr = oldbufptr = bufptr = s = linestart = SvPVX(linestr);
        bufend = SvPVX(linestr) + SvCUR(linestr);
     }
     else
        sv_setpvn(tmpstr,"",0);   /* avoid "uninitialized" warning */
     while (s >= bufend) {      /* multiple line string? */
        if (!rsfp ||
-        !(oldoldbufptr = oldbufptr = s = filter_gets(linestr, rsfp))) {
+        !(oldoldbufptr = oldbufptr = s = linestart = filter_gets(linestr, rsfp, 0))) {
            curcop->cop_line = multi_start;
            missingterm(tokenbuf);
        }
@@ -4447,7 +4589,7 @@ register char *s;
              (I32)curcop->cop_line,sv);
        }
        bufend = SvPVX(linestr) + SvCUR(linestr);
-       if (*s == term && bcmp(s,tokenbuf,len) == 0) {
+       if (*s == term && memcmp(s,tokenbuf,len) == 0) {
            s = bufend - 1;
            *s = ' ';
            sv_catsv(linestr,herewas);
@@ -4592,7 +4734,8 @@ char *start;
     if (s < bufend) break;     /* string ends on this line? */
 
        if (!rsfp ||
-        !(oldoldbufptr = oldbufptr = s = filter_gets(linestr, rsfp))) {
+        !(oldoldbufptr = oldbufptr = s = linestart = filter_gets(linestr, rsfp, 0))) {
+           sv_free(sv);
            curcop->cop_line = multi_start;
            return Nullch;
        }
@@ -4770,8 +4913,8 @@ register char *s;
        }
        s = eol;
        if (rsfp) {
-           s = filter_gets(linestr, rsfp);
-           oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr);
+           s = filter_gets(linestr, rsfp, 0);
+           oldoldbufptr = oldbufptr = bufptr = linestart = SvPVX(linestr);
            bufend = bufptr + SvCUR(linestr);
            if (!s) {
                s = bufptr;
@@ -4820,9 +4963,11 @@ start_subparse()
     CV* outsidecv = compcv;
     AV* comppadlist;
 
+#ifndef __QNX__
     if (compcv) {
        assert(SvTYPE(compcv) == SVt_PVCV);
     }
+#endif
     save_I32(&subline);
     save_item(subname);
     SAVEINT(padix);
@@ -4918,7 +5063,7 @@ char *s;
     else if (in_eval)
        sv_catpv(GvSV(errgv),buf);
     else
-       fputs(buf,stderr);
+       PerlIO_printf(PerlIO_stderr(), "%s",buf);
     if (++error_count >= 10)
        croak("%s has too many errors.\n",
        SvPVX(GvSV(curcop->cop_filegv)));