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

[Steve Kargl]

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. :(

! Test fix for regression caused by 
! 2006-06-23  Steven G. Kargl  <kargls@comcast.net>
!    PR fortran/27981
!    * match.c (gfc_match_if):  Handle errors in assignment in simple if.
!
module read
  integer i, j, k
  contains
    subroutine a
      if (i .eq. 0) read(j,*) k  ! <-- This dies a horrible death.
    end subroutine a
end module read

The problem is gfc_match_assignment returned either MATCH_YES
or MATCH_ERROR.  In my original patch, I apparently thought
that it could also return a MATCH_NO.  This patch re-arranges
the error handling in gfc_match_assignment.  In particular,
the failure to match an lvalue now returns a MATCH_NO, and
the error checking for assignment to a PARAMETER has been 
pushed down into primary.c(match_variable).  One nice outcome
to checking for a PARAMETER in match_variables allows gfortran
to report a much more informative error message when someone
uses a named constant in an EQUIVALENCE.


2006-08-27  Steven G. Kargl  <kargls@comcast.net>

	PR fortran/28866 
	* match.c (gfc_match_assignment): Re-arrange error handling of failed
	matches.  Move FL_PARAMETER check to ...
	* primary.c: Wrap Copyright info.
	(match_variable): ... here.  Enhance error messages.

2006-08-27  Steven G. Kargl  <kargls@comcast.net>

	PR fortran/28866
	* gfortran.dg/simpleif_2.f90: New test.
	* gfortran.dg/pr19936_1.f90: Fix dg-error message.
	* gfortran.dg/enum_5.f90: Ditto.

-- 
Steve
-------------- next part --------------
Index: testsuite/gfortran.dg/simpleif_2.f90
===================================================================
--- testsuite/gfortran.dg/simpleif_2.f90	(revision 116493)
+++ testsuite/gfortran.dg/simpleif_2.f90	(working copy)
@@ -1,7 +1,13 @@
 ! { dg-do compile }
-! PR 27981
-program a
-   real x
-   real, pointer :: y
-   if (.true.) x = 12345678901 ! { dg-error "Integer too big" }
-end program a
+! Test fix for regression caused by 
+! 2006-06-23  Steven G. Kargl  <kargls@comcast.net>
+!    PR fortran/27981
+!    * match.c (gfc_match_if):  Handle errors in assignment in simple if.
+!
+module read
+  integer i, j, k
+  contains
+    subroutine a
+      if (i .eq. 0) read(j,*) k
+    end subroutine a
+end module read
Index: testsuite/gfortran.dg/pr19936_1.f90
===================================================================
--- testsuite/gfortran.dg/pr19936_1.f90	(revision 116493)
+++ testsuite/gfortran.dg/pr19936_1.f90	(working copy)
@@ -1,5 +1,5 @@
 ! { dg-do compile }
 program pr19936_1
   integer, parameter :: i=4
-  print *,(/(i,i=1,4)/) ! { dg-error "Expected VARIABLE" }
+  print *,(/(i,i=1,4)/) ! { dg-error "assign to a named constant" }
 end program pr19936_1
Index: testsuite/gfortran.dg/enum_5.f90
===================================================================
--- testsuite/gfortran.dg/enum_5.f90	(revision 116493)
+++ testsuite/gfortran.dg/enum_5.f90	(working copy)
@@ -10,6 +10,6 @@ program main
     enumerator :: blue = 1  
   end enum junk  ! { dg-error "Syntax error" }
 
-  blue = 10  ! { dg-error "Expected VARIABLE" }
+  blue = 10  ! { dg-error " assign to a named constant" }
 
 end program main  ! { dg-excess-errors "" }
Index: fortran/match.c
===================================================================
--- fortran/match.c	(revision 116493)
+++ fortran/match.c	(working copy)
@@ -846,18 +846,20 @@ gfc_match_assignment (void)
   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;
+      gfc_current_locus = old_loc;
+      gfc_free_expr (lvalue);
+      return MATCH_NO;
     }
 
   m = gfc_match (" %e%t", &rvalue);
   if (m != MATCH_YES)
-    goto cleanup;
+    {
+      gfc_current_locus = old_loc;
+      gfc_free_expr (lvalue);
+      gfc_free_expr (rvalue);
+      return m;
+    }
 
   gfc_set_sym_referenced (lvalue->symtree->n.sym);
 
@@ -868,12 +870,6 @@ gfc_match_assignment (void)
   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;
 }
 
 
Index: fortran/primary.c
===================================================================
--- fortran/primary.c	(revision 116493)
+++ fortran/primary.c	(working copy)
@@ -1,6 +1,6 @@
 /* Primary expression subroutines
-   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006 Free Software
-   Foundation, Inc.
+   Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006
+   Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -2303,6 +2303,14 @@ match_variable (gfc_expr ** result, int 
       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: