This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Re: [PATCH] fortran/28866 -- Fix not so simple simple IF


Steve Kargl wrote:

The attached patch has been regression tested on i386-*-freebsd
with no new regression. This patch represents a fix to a previous
patch that I committed. I'm surprised it has not been flagged
by someone else. I apologies for breaking the compiler. :(

OK - except for two things:

(i) Why don't you remove my patch for PR28762 but keep the testcase? This fix of yours makes mine redundant. I have enclosed the modified patch, which regtests on FC5/Athlon

(ii) There is a knock-on that you should try to fix:

   integer, parameter :: i = 1
   integer j
   i = j
   if (j.eq.1) i = j
end

produces:

   i = j
   1
Error: Cannot assign to a named constant at (1)
In file steves_horror.f90:4

   if (j.eq.1) i = j
              1
Error: Unclassifiable statement in IF-clause at (1)

Regards

Paul
Index: gcc/fortran/match.c
===================================================================
*** gcc/fortran/match.c	(revision 116467)
--- gcc/fortran/match.c	(working copy)
*************** gfc_match_assignment (void)
*** 846,863 ****
    lvalue = rvalue = NULL;
    m = gfc_match (" %v =", &lvalue);
    if (m != MATCH_YES)
-     goto cleanup;
- 
-   if (lvalue->symtree->n.sym->attr.flavor == FL_PARAMETER)
      {
!       gfc_error ("Cannot assign to a PARAMETER variable at %C");
!       m = MATCH_ERROR;
!       goto cleanup;
      }
  
    m = gfc_match (" %e%t", &rvalue);
    if (m != MATCH_YES)
!     goto cleanup;
  
    gfc_set_sym_referenced (lvalue->symtree->n.sym);
  
--- 846,865 ----
    lvalue = rvalue = NULL;
    m = gfc_match (" %v =", &lvalue);
    if (m != MATCH_YES)
      {
!       gfc_current_locus = old_loc;
!       gfc_free_expr (lvalue);
!       return MATCH_NO;
      }
  
    m = gfc_match (" %e%t", &rvalue);
    if (m != MATCH_YES)
!     {
!       gfc_current_locus = old_loc;
!       gfc_free_expr (lvalue);
!       gfc_free_expr (rvalue);
!       return m;
!     }
  
    gfc_set_sym_referenced (lvalue->symtree->n.sym);
  
*************** gfc_match_assignment (void)
*** 868,879 ****
    gfc_check_do_variable (lvalue->symtree);
  
    return MATCH_YES;
- 
- cleanup:
-   gfc_current_locus = old_loc;
-   gfc_free_expr (lvalue);
-   gfc_free_expr (rvalue);
-   return m;
  }
  
  
--- 870,875 ----
Index: gcc/fortran/primary.c
===================================================================
*** gcc/fortran/primary.c	(revision 116467)
--- gcc/fortran/primary.c	(working copy)
***************
*** 1,6 ****
  /* Primary expression subroutines
!    Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006 Free Software
!    Foundation, Inc.
     Contributed by Andy Vaught
  
  This file is part of GCC.
--- 1,6 ----
  /* Primary expression subroutines
!    Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006
!    Free Software Foundation, Inc.
     Contributed by Andy Vaught
  
  This file is part of GCC.
*************** match_variable (gfc_expr ** result, int 
*** 2295,2310 ****
      case FL_VARIABLE:
        break;
  
-     case FL_PROGRAM:
-       return MATCH_NO;
-       break;
- 
      case FL_UNKNOWN:
        if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
  			  sym->name, NULL) == FAILURE)
  	return MATCH_ERROR;
        break;
  
      case FL_PROCEDURE:
        /* Check for a nonrecursive function result */
        if (sym->attr.function && (sym->result == sym || sym->attr.entry))
--- 2295,2314 ----
      case FL_VARIABLE:
        break;
  
      case FL_UNKNOWN:
        if (gfc_add_flavor (&sym->attr, FL_VARIABLE,
  			  sym->name, NULL) == FAILURE)
  	return MATCH_ERROR;
        break;
  
+     case FL_PARAMETER:
+       if (equiv_flag)
+ 	gfc_error ("Named constant at %C in an EQUIVALENCE");
+       else
+ 	gfc_error ("Cannot assign to a named constant at %C");
+       return MATCH_ERROR;
+       break;
+ 
      case FL_PROCEDURE:
        /* Check for a nonrecursive function result */
        if (sym->attr.function && (sym->result == sym || sym->attr.entry))

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]