2010-08-02 Mikael Morin <mikael@gcc.gnu.org>

	    Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42051
	PR fortran/44064
	PR fortran/45151
	* intrinsic.c (gfc_get_intrinsic_sub_symbol): Commit changed symbol.
	* symbol.c (gen_cptr_param, gen_fptr_param, gen_shape_param,
	gfc_copy_formal_args, gfc_copy_formal_args_intr,
	gfc_copy_formal_args_ppc, generate_isocbinding_symbol): Ditto.
	* parse.c (parse_derived_contains, parse_spec, parse_progunit):
	Call reject_statement in case of error.
	(match_deferred_characteritics): Call gfc_undo_symbols in case match
	fails.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fa41c8a..a00ac81 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+2010-08-02  Mikael Morin  <mikael@gcc.gnu.org>
+           Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/42051
+       PR fortran/44064
+       PR fortran/45151
+       * intrinsic.c (gfc_get_intrinsic_sub_symbol): Commit changed symbol. 
+       * symbol.c (gen_cptr_param, gen_fptr_param, gen_shape_param,
+       gfc_copy_formal_args, gfc_copy_formal_args_intr,
+       gfc_copy_formal_args_ppc, generate_isocbinding_symbol): Ditto.
+       * parse.c (parse_derived_contains, parse_spec, parse_progunit): 
+       Call reject_statement in case of error. 
+       (match_deferred_characteritics): Call gfc_undo_symbols in case match
+       fails.
+
 2010-08-01  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/44912

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 87d9c80..121afc0 100644 (file)
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -112,6 +112,8 @@ gfc_get_intrinsic_sub_symbol (const char *name)
   sym->attr.flavor = FL_PROCEDURE;
   sym->attr.proc = PROC_INTRINSIC;
 
+  gfc_commit_symbol (sym);
+
   return sym;
 }
 

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 94440e9..d65ff1f 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1892,13 +1892,12 @@ parse_derived_contains (void)
 
        case ST_DATA_DECL:
          gfc_error ("Components in TYPE at %C must precede CONTAINS");
-         error_flag = true;
-         break;
+         goto error;
 
        case ST_PROCEDURE:
          if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003:  Type-bound"
                                             " procedure at %C") == FAILURE)
-           error_flag = true;
+           goto error;
 
          accept_statement (ST_PROCEDURE);
          seen_comps = true;
@@ -1907,7 +1906,7 @@ parse_derived_contains (void)
        case ST_GENERIC:
          if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003:  GENERIC binding"
                                             " at %C") == FAILURE)
-           error_flag = true;
+           goto error;
 
          accept_statement (ST_GENERIC);
          seen_comps = true;
@@ -1917,7 +1916,7 @@ parse_derived_contains (void)
          if (gfc_notify_std (GFC_STD_F2003,
                              "Fortran 2003:  FINAL procedure declaration"
                              " at %C") == FAILURE)
-           error_flag = true;
+           goto error;
 
          accept_statement (ST_FINAL);
          seen_comps = true;
@@ -1930,7 +1929,7 @@ parse_derived_contains (void)
              && (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: Derived type "
                                  "definition at %C with empty CONTAINS "
                                  "section") == FAILURE))
-           error_flag = true;
+           goto error;
 
          /* ST_END_TYPE is accepted by parse_derived after return.  */
          break;
@@ -1940,22 +1939,20 @@ parse_derived_contains (void)
            {
              gfc_error ("PRIVATE statement in TYPE at %C must be inside "
                         "a MODULE");
-             error_flag = true;
-             break;
+             goto error;
            }
 
          if (seen_comps)
            {
              gfc_error ("PRIVATE statement at %C must precede procedure"
                         " bindings");
-             error_flag = true;
-             break;
+             goto error;
            }
 
          if (seen_private)
            {
              gfc_error ("Duplicate PRIVATE statement at %C");
-             error_flag = true;
+             goto error;
            }
 
          accept_statement (ST_PRIVATE);
@@ -1965,18 +1962,22 @@ parse_derived_contains (void)
 
        case ST_SEQUENCE:
          gfc_error ("SEQUENCE statement at %C must precede CONTAINS");
-         error_flag = true;
-         break;
+         goto error;
 
        case ST_CONTAINS:
          gfc_error ("Already inside a CONTAINS block at %C");
-         error_flag = true;
-         break;
+         goto error;
 
        default:
          unexpected_statement (st);
          break;
        }
+
+      continue;
+
+error:
+      error_flag = true;
+      reject_statement ();
     }
 
   pop_state ();
@@ -2395,7 +2396,10 @@ match_deferred_characteristics (gfc_typespec * ts)
       gfc_commit_symbols ();
     }
   else
-    gfc_error_check ();
+    {
+      gfc_error_check ();
+      gfc_undo_symbols ();
+    }
 
   gfc_current_locus =loc;
   return m;
@@ -2467,6 +2471,7 @@ loop:
        case ST_STATEMENT_FUNCTION:
          gfc_error ("%s statement is not allowed inside of BLOCK at %C",
                     gfc_ascii_statement (st));
+         reject_statement ();
          break;
 
        default:
@@ -2553,6 +2558,7 @@ declSt:
            {
              gfc_error ("%s statement must appear in a MODULE",
                         gfc_ascii_statement (st));
+             reject_statement ();
              break;
            }
 
@@ -2560,6 +2566,7 @@ declSt:
            {
              gfc_error ("%s statement at %C follows another accessibility "
                         "specification", gfc_ascii_statement (st));
+             reject_statement ();
              break;
            }
 
@@ -4004,6 +4011,7 @@ contains:
     {
       gfc_error ("CONTAINS statement at %C is already in a contained "
                 "program unit");
+      reject_statement ();
       st = next_statement ();
       goto loop;
     }

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 0231da1..a4d0ec3 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3880,6 +3880,9 @@ gen_cptr_param (gfc_formal_arglist **head,
   formal_arg = gfc_get_formal_arglist ();
   /* Add arg to list of formal args (the CPTR arg).  */
   add_formal_arg (head, tail, formal_arg, param_sym);
+
+  /* Validate changes.  */
+  gfc_commit_symbol (param_sym);
 }
 
 
@@ -3925,6 +3928,9 @@ gen_fptr_param (gfc_formal_arglist **head,
   formal_arg = gfc_get_formal_arglist ();
   /* Add arg to list of formal args.  */
   add_formal_arg (head, tail, formal_arg, param_sym);
+
+  /* Validate changes.  */
+  gfc_commit_symbol (param_sym);
 }
 
 
@@ -3997,6 +4003,9 @@ gen_shape_param (gfc_formal_arglist **head,
   formal_arg = gfc_get_formal_arglist ();
   /* Add arg to list of formal args.  */
   add_formal_arg (head, tail, formal_arg, param_sym);
+
+  /* Validate changes.  */
+  gfc_commit_symbol (param_sym);
 }
 
 
@@ -4059,6 +4068,9 @@ gfc_copy_formal_args (gfc_symbol *dest, gfc_symbol *src)
 
       /* Add arg to list of formal args.  */
       add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
+
+      /* Validate changes.  */
+      gfc_commit_symbol (formal_arg->sym);
     }
 
   /* Add the interface to the symbol.  */
@@ -4116,6 +4128,9 @@ gfc_copy_formal_args_intr (gfc_symbol *dest, gfc_intrinsic_sym *src)
 
       /* Add arg to list of formal args.  */
       add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
+
+      /* Validate changes.  */
+      gfc_commit_symbol (formal_arg->sym);
     }
 
   /* Add the interface to the symbol.  */
@@ -4169,6 +4184,9 @@ gfc_copy_formal_args_ppc (gfc_component *dest, gfc_symbol *src)
 
       /* Add arg to list of formal args.  */
       add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
+
+      /* Validate changes.  */
+      gfc_commit_symbol (formal_arg->sym);
     }
 
   /* Add the interface to the symbol.  */
@@ -4548,6 +4566,7 @@ generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
       default:
        gcc_unreachable ();
     }
+  gfc_commit_symbol (tmp_sym);
 }