FORTRAN: Patch for PR #10986

[Bud Davis <bdavis9659 at comcast dot net>]

Two instances of non-legal code that causes an ICE:

newbug.f
      ASSIGN 1 TO A
      GOTO A
1     CONTINUE
      END
newbug2.f
     goto a 
     end

Results:

[bdavis@f77 ~]$ /usr/local/bin/g77 newbug.f
newbug.f: In program `MAIN__':
newbug.f:1: 
         ASSIGN 1 TO A
                     ^
Expression at (^) has incorrect data type or rank for its context
newbug.f:2: 
         GOTO A
              ^
Expression at (^) has incorrect data type or rank for its context
newbug.f:1: internal compiler error: tree check: expected class 't', have 'x'
(error_mark) in ffeste_R838, at f/ste.c:2956
Please submit a full bug report,
with preprocessed source if appropriate.
See <URL:http://gcc.gnu.org/bugs.html> for instructions.

[bdavis@f77 ~]$ /usr/local/bin/g77 newbug2.f
newbug2.f: In program `MAIN__':
newbug2.f:1: 
        goto a 
             ^
Expression at (^) has incorrect data type or rank for its context
newbug2.f:1: internal compiler error: tree check: expected class 't', have 'x'
(error_mark) in ffeste_R839, at f/ste.c:2984
Please submit a full bug report,
with preprocessed source if appropriate.
See <URL:http://gcc.gnu.org/bugs.html> for instructions.

They do not ICE with gcc-2.95

The patch to fix this is below

Index: gcc/gcc/f/ste.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/f/ste.c,v
retrieving revision 1.36
diff -c -3 -p -r1.36 ste.c
*** gcc/gcc/f/ste.c	3 May 2003 16:39:50 -0000	1.36
--- gcc/gcc/f/ste.c	27 May 2003 01:28:15 -0000
*************** ffeste_R838 (ffelab label, ffebld target
*** 2950,2965 ****
       TREE_CONSTANT (label_tree) = 1;
 
       target_tree = ffecom_expr_assign_w (target);
!       if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (target_tree)))
! 	  < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (label_tree))))
! 	error ("ASSIGN to variable that is too small");
 
!       label_tree = convert (TREE_TYPE (target_tree), label_tree);
 
!       expr_tree = ffecom_modify (void_type_node,
 				 target_tree,
 				 label_tree);
!       expand_expr_stmt (expr_tree);
     }
 }
 
--- 2950,2968 ----
       TREE_CONSTANT (label_tree) = 1;
 
       target_tree = ffecom_expr_assign_w (target);
!       if (TREE_CODE (target_tree)!= ERROR_MARK)
!       {
!         if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (target_tree)))
!             < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (label_tree))))
! 	  error ("ASSIGN to variable that is too small");
 
!         label_tree = convert (TREE_TYPE (target_tree), label_tree);
 
!         expr_tree = ffecom_modify (void_type_node,
 				 target_tree,
 				 label_tree);
!         expand_expr_stmt (expr_tree);
!       }
     }
 }
 
*************** ffeste_R839 (ffebld target)
*** 2978,2988 ****
      seen here should never require use of temporaries.  */
 
   t = ffecom_expr_assign (target);
-   if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t)))
-       < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
-     error ("ASSIGNed GOTO target variable is too small");
 
!   expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t));
 }
 
 /* Arithmetic IF statement.  */
--- 2981,2995 ----
      seen here should never require use of temporaries.  */
 
   t = ffecom_expr_assign (target);
 
!   if (TREE_CODE (t) != ERROR_MARK)
!   {
!        if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t)))
!          < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
!        error ("ASSIGNed GOTO target variable is too small");
! 
!        expand_computed_goto (convert (TREE_TYPE (null_pointer_node), t));
!   }
 }
 
 /* Arithmetic IF statement.  */