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

	PR fortran/28866
	* match.c: Wrap copyright.
	(gfc_match_assignment):  Return MATCH_NO for failed lvalue.  Remove
	gotos.  Move error handling of FL_PARAMETER to ...
 	* gfc_match_if: Deal with MATCH_NO from above.
	* primary.c: Wrap copyright.
	(match_variable): ... here.  Improve error messages.

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

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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@116570 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a922dff..aeb3cb9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2006-08-29  Steven G. Kargl  <kargls@comcast.net>
+
+       PR fortran/28866
+       * match.c: Wrap copyright.
+       (gfc_match_assignment):  Return MATCH_NO for failed lvalue.  Remove
+       gotos.  Move error handling of FL_PARAMETER to ...
+       * gfc_match_if: Deal with MATCH_NO from above.
+       * primary.c: Wrap copyright.
+       (match_variable): ... here.  Improve error messages.
+
 2006-08-29  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/28788

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index e6a7689..8a67c20 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1,6 +1,6 @@
 /* Matching subroutines in all sizes, shapes and colors.
-   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
-   Foundation, Inc.
+   Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006
+   Free Software Foundation, Inc.
    Contributed by Andy Vaught
 
 This file is part of GCC.
@@ -843,21 +843,24 @@ gfc_match_assignment (void)
 
   old_loc = gfc_current_locus;
 
-  lvalue = rvalue = NULL;
+  lvalue = 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;
     }
 
+  rvalue = NULL;
   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 +871,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;
 }
 
 
@@ -1061,9 +1058,9 @@ gfc_match_if (gfc_statement * if_type)
   gfc_undo_symbols ();
   gfc_current_locus = old_loc;
 
-  /* m can be MATCH_NO or MATCH_ERROR, here.  For MATCH_NO, continue to
-     call the various matchers.  For MATCH_ERROR, a mangled assignment
-     was found.  */
+  /* m can be MATCH_NO or MATCH_ERROR, here.  For MATCH_ERROR, a mangled
+     assignment was found.  For MATCH_NO, continue to call the various
+     matchers.  */
   if (m == MATCH_ERROR)
     return MATCH_ERROR;
 
@@ -1089,30 +1086,43 @@ gfc_match_if (gfc_statement * if_type)
   gfc_clear_error ();
 
   match ("allocate", gfc_match_allocate, ST_ALLOCATE)
-    match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT)
-    match ("backspace", gfc_match_backspace, ST_BACKSPACE)
-    match ("call", gfc_match_call, ST_CALL)
-    match ("close", gfc_match_close, ST_CLOSE)
-    match ("continue", gfc_match_continue, ST_CONTINUE)
-    match ("cycle", gfc_match_cycle, ST_CYCLE)
-    match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE)
-    match ("end file", gfc_match_endfile, ST_END_FILE)
-    match ("exit", gfc_match_exit, ST_EXIT)
-    match ("flush", gfc_match_flush, ST_FLUSH)
-    match ("forall", match_simple_forall, ST_FORALL)
-    match ("go to", gfc_match_goto, ST_GOTO)
-    match ("if", match_arithmetic_if, ST_ARITHMETIC_IF)
-    match ("inquire", gfc_match_inquire, ST_INQUIRE)
-    match ("nullify", gfc_match_nullify, ST_NULLIFY)
-    match ("open", gfc_match_open, ST_OPEN)
-    match ("pause", gfc_match_pause, ST_NONE)
-    match ("print", gfc_match_print, ST_WRITE)
-    match ("read", gfc_match_read, ST_READ)
-    match ("return", gfc_match_return, ST_RETURN)
-    match ("rewind", gfc_match_rewind, ST_REWIND)
-    match ("stop", gfc_match_stop, ST_STOP)
-    match ("where", match_simple_where, ST_WHERE)
-    match ("write", gfc_match_write, ST_WRITE)
+  match ("assign", gfc_match_assign, ST_LABEL_ASSIGNMENT)
+  match ("backspace", gfc_match_backspace, ST_BACKSPACE)
+  match ("call", gfc_match_call, ST_CALL)
+  match ("close", gfc_match_close, ST_CLOSE)
+  match ("continue", gfc_match_continue, ST_CONTINUE)
+  match ("cycle", gfc_match_cycle, ST_CYCLE)
+  match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE)
+  match ("end file", gfc_match_endfile, ST_END_FILE)
+  match ("exit", gfc_match_exit, ST_EXIT)
+  match ("flush", gfc_match_flush, ST_FLUSH)
+  match ("forall", match_simple_forall, ST_FORALL)
+  match ("go to", gfc_match_goto, ST_GOTO)
+  match ("if", match_arithmetic_if, ST_ARITHMETIC_IF)
+  match ("inquire", gfc_match_inquire, ST_INQUIRE)
+  match ("nullify", gfc_match_nullify, ST_NULLIFY)
+  match ("open", gfc_match_open, ST_OPEN)
+  match ("pause", gfc_match_pause, ST_NONE)
+  match ("print", gfc_match_print, ST_WRITE)
+  match ("read", gfc_match_read, ST_READ)
+  match ("return", gfc_match_return, ST_RETURN)
+  match ("rewind", gfc_match_rewind, ST_REWIND)
+  match ("stop", gfc_match_stop, ST_STOP)
+  match ("where", match_simple_where, ST_WHERE)
+  match ("write", gfc_match_write, ST_WRITE)
+
+  /* The gfc_match_assignment() above may have returned a MATCH_NO
+     where the assignement was to a named constant.  Check that 
+     special case here.  */
+  m = gfc_match_assignment ();
+  if (m == MATCH_NO)
+   {
+      gfc_error ("Cannot assign to a named constant at %C");
+      gfc_free_expr (expr);
+      gfc_undo_symbols ();
+      gfc_current_locus = old_loc;
+      return MATCH_ERROR;
+   }
 
   /* All else has failed, so give up.  See if any of the matchers has
      stored an error message of some sort.  */

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index c0ed364..1428f4c 100644 (file)
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -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.
@@ -2295,16 +2295,20 @@ match_variable (gfc_expr ** result, int equiv_flag, int host_flag)
     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_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))

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5c2b9f4..6729166 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2006-08-29  Steven G. Kargl  <kargls@comcast.net>
+
+       PR fortran/28866
+       * gfortran.dg/simpleif_2.f90: New test.
+       * gfortran.dg/pr19936_1.f90: Adjust dg-error message.
+       * gfortran.dg/enum_5.f90: Ditto.
+
 2006-08-29  Volker Reichelt  <reichelt@igpm.rwth-aachen.de>
            Kazu Hirata  <kazu@codesourcery.com>
 

diff --git a/gcc/testsuite/gfortran.dg/enum_5.f90 b/gcc/testsuite/gfortran.dg/enum_5.f90
index 604e50d..b27aaf2 100644 (file)
--- a/gcc/testsuite/gfortran.dg/enum_5.f90
+++ b/gcc/testsuite/gfortran.dg/enum_5.f90
@@ -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 "" }

diff --git a/gcc/testsuite/gfortran.dg/pr19936_1.f90 b/gcc/testsuite/gfortran.dg/pr19936_1.f90
index cd5140f..516d514 100644 (file)
--- a/gcc/testsuite/gfortran.dg/pr19936_1.f90
+++ b/gcc/testsuite/gfortran.dg/pr19936_1.f90
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/simpleif_2.f90 b/gcc/testsuite/gfortran.dg/simpleif_2.f90
index 0d8e6dd..ee914b2 100644 (file)
--- a/gcc/testsuite/gfortran.dg/simpleif_2.f90
+++ b/gcc/testsuite/gfortran.dg/simpleif_2.f90
@@ -1,7 +1,15 @@
 ! { 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
+      integer, parameter :: n = 2
+      if (i .eq. 0) read(j,*) k
+      if (i .eq. 0) n = j    ! { dg-error "assign to a named constant" "" }
+    end subroutine a
+end module read