Fortran candidate patches for gcc-2.95.3.

[Toon Moene <toon at moene dot indiv dot nluug dot nl>]

Bernd,

Is it OK if I apply the following two patches to (respectively) the
Fortran Frontend and libf2c on the gcc-2_95-branch ?

FFE (fixes g77.f-torture/execute/20000630-2.f):

2000-07-22  Toon Moene  <toon@moene.indiv.nluug.nl>

        * com.c (ffecom_expr_intrinsic_): case FFEINTRIN_impFGETC_subr,
        FFEINTRIN_impFPUTC_subr: Check for arg3 being NULL.

$ diff -rcp2N com.c.orig com.c
*** com.c.orig  Thu Jul 13 14:27:35 2000
--- com.c       Sat Jul 22 13:41:59 2000
*************** ffecom_expr_intrinsic_ (ffebld expr, tre
*** 5179,5183 ****
  
        arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len);
!       arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
  
        arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
--- 5179,5186 ----
  
        arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len);
!       if (arg3 != NULL)
!         arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
!       else
!         arg3_tree = NULL_TREE;
  
        arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
*************** ffecom_expr_intrinsic_ (ffebld expr, tre
*** 5194,5200 ****
                                  NULL_TREE, NULL, NULL, NULL_TREE,
TRUE,
                                  ffebld_nonter_hook (expr));
!       expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
!                                  convert (TREE_TYPE (arg3_tree),
!                                           expr_tree));
        }
        return expr_tree;
--- 5197,5204 ----
                                  NULL_TREE, NULL, NULL, NULL_TREE,
TRUE,
                                  ffebld_nonter_hook (expr));
!       if (arg3_tree != NULL_TREE)
!         expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
!                                    convert (TREE_TYPE (arg3_tree),
!                                             expr_tree));
        }
        return expr_tree;


libf2c (fixes g77.f-torture/execute/20001201.f):

2000-12-09  Toon Moene  <toon@moene.indiv.nluug.nl>

	* libI77/lread.c: Fix reading of namelist logical values
	followed by <name>= where <name> starts with T or F.

*** lread.c.orig        Wed Mar 17 09:21:19 1999
--- lread.c     Sat Dec  9 13:12:28 2000
*************** l_C(Void)
*** 340,348 ****
  }
  
   static int
  l_L(Void)
  {
!       int ch;
!       if(f__lcount>0) return(0);
        f__lcount = 1;
        f__ltype=0;
--- 340,430 ----
  }
  
+  static char nmLbuf[256], *nmL_next;
+  static int (*nmL_getc_save)(Void);
+ #ifdef KR_headers
+  static int (*nmL_ungetc_save)(/* int, FILE* */);
+ #else
+  static int (*nmL_ungetc_save)(int, FILE*);
+ #endif
+ 
+  static int
+ nmL_getc(Void)
+ {
+       int rv;
+       if (rv = *nmL_next++)
+               return rv;
+       l_getc = nmL_getc_save;
+       l_ungetc = nmL_ungetc_save;
+       return (*l_getc)();
+       }
+ 
+  static int
+ #ifdef KR_headers
+ nmL_ungetc(x, f) int x; FILE *f;
+ #else
+ nmL_ungetc(int x, FILE *f)
+ #endif
+ {
+       f = f;  /* banish non-use warning */
+       return *--nmL_next = x;
+       }
+ 
+  static int
+ #ifdef KR_headers
+ Lfinish(ch, dot, rvp) int ch, dot, *rvp;
+ #else
+ Lfinish(int ch, int dot, int *rvp)
+ #endif
+ {
+       char *s, *se;
+       static char what[] = "namelist input";
+ 
+       s = nmLbuf + 2;
+       se = nmLbuf + sizeof(nmLbuf) - 1;
+       *s++ = ch;
+       while(!issep(GETC(ch)) && ch!=EOF) {
+               if (s >= se) {
+  nmLbuf_ovfl:
+                       return *rvp = err__fl(f__elist->cierr,131,what);
+                       }
+               *s++ = ch;
+               if (ch != '=')
+                       continue;
+               if (dot)
+                       return *rvp = err__fl(f__elist->cierr,112,what);
+  got_eq:
+               *s = 0;
+               nmL_getc_save = l_getc;
+               l_getc = nmL_getc;
+               nmL_ungetc_save = l_ungetc;
+               l_ungetc = nmL_ungetc;
+               nmLbuf[1] = *(nmL_next = nmLbuf) = ',';
+               *rvp = f__lcount = 0;
+               return 1;
+               }
+       if (dot)
+               goto done;
+       for(;;) {
+               if (s >= se)
+                       goto nmLbuf_ovfl;
+               *s++ = ch;
+               if (!isblnk(ch))
+                       break;
+               if (GETC(ch) == EOF)
+                       goto done;
+               }
+       if (ch == '=')
+               goto got_eq;
+  done:
+       Ungetc(ch, f__cf);
+       return 0;
+       }
+ 
   static int
  l_L(Void)
  {
!       int ch, rv, sawdot;
!       if(f__lcount>0)
!               return(0);
        f__lcount = 1;
        f__ltype=0;
*************** l_L(Void)
*** 358,370 ****
                GETC(ch);
        }
!       if(ch == '.') GETC(ch);
        switch(ch)
        {
        case 't':
        case 'T':
                f__lx=1;
                break;
        case 'f':
        case 'F':
                f__lx=0;
                break;
--- 440,460 ----
                GETC(ch);
        }
!       sawdot = 0;
!       if(ch == '.') {
!               sawdot = 1;
!               GETC(ch);
!               }
        switch(ch)
        {
        case 't':
        case 'T':
+               if (nml_read && Lfinish(ch, sawdot, &rv))
+                       return rv;
                f__lx=1;
                break;
        case 'f':
        case 'F':
+               if (nml_read && Lfinish(ch, sawdot, &rv))
+                       return rv;
                f__lx=0;
                break;

Thanks in advance,

-- 
Toon Moene - mailto:toon@moene.indiv.nluug.nl - phoneto: +31 346 214290
Saturnushof 14, 3738 XG  Maartensdijk, The Netherlands
Maintainer, GNU Fortran 77: http://gcc.gnu.org/onlinedocs/g77_news.html
Join GNU Fortran 95: http://g95.sourceforge.net/ (under construction)