This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 4.0 patch 36: (combined patch)
[perl5.git] / x2p / walk.c
index 58494c9..4e11076 100644 (file)
@@ -1,25 +1,26 @@
-/* $Header: walk.c,v 3.0.1.4 90/03/01 10:32:45 lwall Locked $
+/* $RCSfile: walk.c,v $$Revision: 4.0.1.3 $$Date: 92/06/08 17:33:46 $
  *
- *    Copyright (c) 1989, Larry Wall
+ *    Copyright (c) 1991, Larry Wall
  *
- *    You may distribute under the terms of the GNU General Public License
- *    as specified in the README file that comes with the perl 3.0 kit.
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
  *
  * $Log:       walk.c,v $
- * Revision 3.0.1.4  90/03/01  10:32:45  lwall
- * patch9: a2p didn't put a $ on ExitValue
+ * Revision 4.0.1.3  92/06/08  17:33:46  lwall
+ * patch20: in a2p, simplified the filehandle model
+ * patch20: in a2p, made RS="" translate to $/ = "\n\n"
+ * patch20: in a2p, do {...} while ... was missing some reconstruction code
+ * patch20: in a2p, getline should allow variable to be array element
  * 
- * Revision 3.0.1.3  89/12/21  20:32:35  lwall
- * patch7: in a2p, user-defined functions didn't work on some machines
+ * Revision 4.0.1.2  91/11/05  19:25:09  lwall
+ * patch11: in a2p, split on whitespace produced extra null field
  * 
- * Revision 3.0.1.2  89/11/17  15:53:00  lwall
- * patch5: on Pyramids, index(s, '}' + 128) doesn't find meta-}
+ * Revision 4.0.1.1  91/06/07  12:22:04  lwall
+ * patch4: new copyright notice
+ * patch4: a2p didn't correctly implement -n switch
  * 
- * Revision 3.0.1.1  89/11/11  05:09:33  lwall
- * patch2: in a2p, awk script with no line actions still needs main loop
- * 
- * Revision 3.0  89/10/18  15:35:48  lwall
- * 3.0 baseline
+ * Revision 4.0  91/03/20  01:58:36  lwall
+ * 4.0 baseline.
  * 
  */
 
@@ -34,9 +35,11 @@ bool saw_getline = FALSE;
 bool subretnum = FALSE;
 bool saw_FNR = FALSE;
 bool saw_argv0 = FALSE;
+bool saw_fh = FALSE;
 int maxtmp = 0;
 char *lparen;
 char *rparen;
+char *limit;
 STR *subs;
 STR *curargs = Nullstr;
 
@@ -72,6 +75,20 @@ int minprec;                 /* minimum precedence without parens */
     type &= 255;
     switch (type) {
     case OPROG:
+       arymax = 0;
+       if (namelist) {
+           while (isalpha(*namelist)) {
+               for (d = tokenbuf,s=namelist;
+                 isalpha(*s) || isdigit(*s) || *s == '_';
+                 *d++ = *s++) ;
+               *d = '\0';
+               while (*s && !isalpha(*s)) s++;
+               namelist = s;
+               nameary[++arymax] = savestr(tokenbuf);
+           }
+       }
+       if (maxfld < arymax)
+           maxfld = arymax;
        opens = str_new(0);
        subs = str_new(0);
        str = walk(0,level,ops[node+1].ival,&numarg,P_MIN);
@@ -127,20 +144,6 @@ int minprec;                       /* minimum precedence without parens */
                str_cat(str,"chop;\t# strip record separator\n");
                tab(str,level);
            }
-           arymax = 0;
-           if (namelist) {
-               while (isalpha(*namelist)) {
-                   for (d = tokenbuf,s=namelist;
-                     isalpha(*s) || isdigit(*s) || *s == '_';
-                     *d++ = *s++) ;
-                   *d = '\0';
-                   while (*s && !isalpha(*s)) s++;
-                   namelist = s;
-                   nameary[++arymax] = savestr(tokenbuf);
-               }
-           }
-           if (maxfld < arymax)
-               maxfld = arymax;
            if (do_split)
                emit_split(str,level);
            str_scat(str,fstr);
@@ -182,7 +185,7 @@ int minprec;                        /* minimum precedence without parens */
                            str_cat(str,"    $FNRbase = $. if eof;\n");
                    }
                    if (len & 1)
-                       str_cat(str,"    local($_)\n");
+                       str_cat(str,"    local($_);\n");
                    if (len & 2)
                        str_cat(str,
                          "    if ($getline_ok = (($_ = <$fh>) ne ''))");
@@ -214,11 +217,8 @@ int minprec;                       /* minimum precedence without parens */
            str_cat(str,"\n\
 sub Pick {\n\
     local($mode,$name,$pipe) = @_;\n\
-    $fh = $opened{$name};\n\
-    if (!$fh) {\n\
-       $fh = $opened{$name} = 'fh_' . ($nextfh++ + 0);\n\
-       open($fh,$mode.$name.$pipe);\n\
-    }\n\
+    $fh = $name;\n\
+    open($name,$mode.$name.$pipe) unless $opened{$name}++;\n\
 }\n\
 ");
        }
@@ -327,6 +327,16 @@ sub Pick {\n\
        str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,prec));
        str_free(fstr);
        break;
+    case OCOND:
+       prec = P_COND;
+       str = walk(1,level,ops[node+1].ival,&numarg,prec);
+       str_cat(str," ? ");
+       str_scat(str,fstr=walk(1,level,ops[node+2].ival,&numarg,prec+1));
+       str_free(fstr);
+       str_cat(str," : ");
+       str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec+1));
+       str_free(fstr);
+       break;
     case OCPAREN:
        str = str_new(0);
        str_set(str,"(");
@@ -461,6 +471,8 @@ sub Pick {\n\
        str_scat(str,fstr=walk(1,level,ops[node+3].ival,&numarg,prec));
        str_free(fstr);
        numeric |= numarg;
+       if (strEQ(str->str_ptr,"$/ = ''"))
+           str_set(str, "$/ = \"\\n\\n\"");
        break;
     case OADD:
        prec = P_ADD;
@@ -563,10 +575,9 @@ sub Pick {\n\
        if (useval)
            str_cat(str,"(");
        if (len > 0) {
-           str_cat(str,"$");
            str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
            if (!*fstr->str_ptr) {
-               str_cat(str,"_");
+               str_cat(str,"$_");
                len = 2;                /* a legal fiction */
            }
            str_free(fstr);
@@ -586,11 +597,13 @@ sub Pick {\n\
                s = savestr(tokenbuf);
                for (t = tokenbuf; *t; t++) {
                    *t &= 127;
+                   if (islower(*t))
+                       *t = toupper(*t);
                    if (!isalpha(*t) && !isdigit(*t))
                        *t = '_';
                }
                if (!index(tokenbuf,'_'))
-                   strcpy(t,"_fh");
+                   strcpy(t,"_FH");
                tmp3str = hfetch(symtab,tokenbuf);
                if (!tmp3str) {
                    do_opens = TRUE;
@@ -665,6 +678,7 @@ sub Pick {\n\
        break;
     case OSPLIT:
        str = str_new(0);
+       limit = ", 9999)";
        numeric = 1;
        tmpstr = walk(1,level,ops[node+2].ival,&numarg,P_MIN);
        if (useval)
@@ -679,6 +693,8 @@ sub Pick {\n\
                i = fstr->str_ptr[1] & 127;
                if (index("*+?.[]()|^$\\",i))
                    sprintf(tokenbuf,"/\\%c/",i);
+               else if (i == ' ')
+                   sprintf(tokenbuf,"' '");
                else
                    sprintf(tokenbuf,"/%c/",i);
                str_cat(str,tokenbuf);
@@ -693,12 +709,14 @@ sub Pick {\n\
        }
        else if (saw_FS)
            str_cat(str,"$FS");
-       else
+       else {
            str_cat(str,"' '");
+           limit = ")";
+       }
        str_cat(str,", ");
        str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_COMMA+1));
        str_free(fstr);
-       str_cat(str,", 999)");
+       str_cat(str,limit);
        if (useval) {
            str_cat(str,")");
        }
@@ -918,7 +936,7 @@ sub Pick {\n\
                s = "\"";
                *d++ = *t++ + 128;
                switch (*t) {
-               case '\\': case '"': case 'n': case 't':
+               case '\\': case '"': case 'n': case 't': case '$':
                    break;
                default:        /* hide this from perl */
                    *d++ = '\\' + 128;
@@ -1110,19 +1128,21 @@ sub Pick {\n\
            s = savestr(tokenbuf);
            for (t = tokenbuf; *t; t++) {
                *t &= 127;
+               if (islower(*t))
+                   *t = toupper(*t);
                if (!isalpha(*t) && !isdigit(*t))
                    *t = '_';
            }
            if (!index(tokenbuf,'_'))
-               strcpy(t,"_fh");
+               strcpy(t,"_FH");
            str_free(tmpstr);
            safefree(s);
            str_set(str,"close ");
            str_cat(str,tokenbuf);
        }
        else {
-           sprintf(tokenbuf,"$fh = delete $opened{%s} && close($fh)",
-              tmpstr->str_ptr);
+           sprintf(tokenbuf,"delete $opened{%s} && close(%s)",
+              tmpstr->str_ptr, tmpstr->str_ptr);
            str_free(tmpstr);
            str_set(str,tokenbuf);
        }
@@ -1145,11 +1165,13 @@ sub Pick {\n\
                s = savestr(tokenbuf);
                for (t = tokenbuf; *t; t++) {
                    *t &= 127;
+                   if (islower(*t))
+                       *t = toupper(*t);
                    if (!isalpha(*t) && !isdigit(*t))
                        *t = '_';
                }
                if (!index(tokenbuf,'_'))
-                   strcpy(t,"_fh");
+                   strcpy(t,"_FH");
                tmp3str = hfetch(symtab,tokenbuf);
                if (!tmp3str) {
                    str_cat(opens,"open(");
@@ -1195,9 +1217,12 @@ sub Pick {\n\
            str_cat(str,"printf");
        else
            str_cat(str,"print");
+       saw_fh = 0;
        if (len == 3 || do_fancy_opens) {
-           if (*tokenbuf)
+           if (*tokenbuf) {
                str_cat(str," ");
+               saw_fh = 1;
+           }
            str_cat(str,tokenbuf);
        }
        tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg,P_MIN);
@@ -1224,7 +1249,13 @@ sub Pick {\n\
        }
        if (*tmpstr->str_ptr) {
            str_cat(str," ");
-           str_scat(str,tmpstr);
+           if (!saw_fh && *tmpstr->str_ptr == '(') {
+               str_cat(str,"(");
+               str_scat(str,tmpstr);
+               str_cat(str,")");
+           }
+           else
+               str_scat(str,tmpstr);
        }
        else {
            str_cat(str," $_");
@@ -1270,7 +1301,7 @@ sub Pick {\n\
            tmpstr = walk(1,level,ops[node+1].ival,&numarg,P_MIN);
        else
            tmpstr = str_new(0);;
-       if (!*tmpstr->str_ptr) {
+       if (!tmpstr->str_ptr || !*tmpstr->str_ptr) {
            if (lval_field) {
                t = saw_OFS ? "$," : "' '";
                if (split_to_array) {
@@ -1388,6 +1419,18 @@ sub Pick {\n\
        str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
        str_free(fstr);
        break;
+    case ODO:
+       str = str_new(0);
+       str_set(str,"do ");
+       str_scat(str,fstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN));
+       str_free(fstr);
+       if (str->str_ptr[str->str_cur - 1] == '\n')
+           --str->str_cur;;
+       str_cat(str," while (");
+       str_scat(str,fstr=walk(0,level,ops[node+2].ival,&numarg,P_MIN));
+       str_free(fstr);
+       str_cat(str,");");
+       break;
     case OFOR:
        str = str_new(0);
        str_set(str,"for (");
@@ -1441,7 +1484,7 @@ sub Pick {\n\
        tmp2str = hfetch(symtab,str->str_ptr);
        if (tmp2str && atoi(tmp2str->str_ptr)) {
            sprintf(tokenbuf,
-             "foreach %s (@%s) ",
+             "foreach %s ($[ .. $#%s) ",
              s,
              d+1);
        }
@@ -1587,13 +1630,13 @@ int level;
        str_cat(str,tokenbuf);
     }
     if (const_FS) {
-       sprintf(tokenbuf," = split(/[%c\\n]/, $_, 999);\n",const_FS);
+       sprintf(tokenbuf," = split(/[%c\\n]/, $_, 9999);\n",const_FS);
        str_cat(str,tokenbuf);
     }
     else if (saw_FS)
-       str_cat(str," = split($FS, $_, 999);\n");
+       str_cat(str," = split($FS, $_, 9999);\n");
     else
-       str_cat(str," = split(' ', $_, 999);\n");
+       str_cat(str," = split(' ', $_, 9999);\n");
     tab(str,level);
 }