2010-10-06 Mikael Morin <mikael@gcc.gnu.org>

[pf3gnuchains/gcc-fork.git] / gcc / fortran / decl.c

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 5baa400..5b4ab18 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1312,9 +1312,10 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus)
        }
 
       /* Check if the assignment can happen. This has to be put off
-        until later for a derived type variable.  */
+        until later for derived type variables and procedure pointers.  */
       if (sym->ts.type != BT_DERIVED && init->ts.type != BT_DERIVED
          && sym->ts.type != BT_CLASS && init->ts.type != BT_CLASS
+         && !sym->attr.proc_pointer 
          && gfc_check_assign_symbol (sym, init) == FAILURE)
        return FAILURE;
 
@@ -1652,6 +1653,48 @@ gfc_match_null (gfc_expr **result)
 }
 
 
+/* Match the initialization expr for a data pointer or procedure pointer.  */
+
+static match
+match_pointer_init (gfc_expr **init, int procptr)
+{
+  match m;
+
+  if (gfc_pure (NULL) && gfc_state_stack->state != COMP_DERIVED)
+    {
+      gfc_error ("Initialization of pointer at %C is not allowed in "
+                "a PURE procedure");
+      return MATCH_ERROR;
+    }
+
+  /* Match NULL() initilization.  */
+  m = gfc_match_null (init);
+  if (m != MATCH_NO)
+    return m;
+
+  /* Match non-NULL initialization.  */
+  gfc_matching_procptr_assignment = procptr;
+  m = gfc_match_rvalue (init);
+  gfc_matching_procptr_assignment = 0;
+  if (m == MATCH_ERROR)
+    return MATCH_ERROR;
+  else if (m == MATCH_NO)
+    {
+      gfc_error ("Error in pointer initialization at %C");
+      return MATCH_ERROR;
+    }
+
+  if (!procptr)
+    gfc_resolve_expr (*init);
+  
+  if (gfc_notify_std (GFC_STD_F2008, "Fortran 2008: non-NULL pointer "
+                     "initialization at %C") == FAILURE)
+    return MATCH_ERROR;
+
+  return MATCH_YES;
+}
+
+
 /* Match a variable name with an optional initializer.  When this
    subroutine is called, a variable is expected to be parsed next.
    Depending on what is happening at the moment, updates either the
@@ -1899,23 +1942,9 @@ variable_decl (int elem)
              goto cleanup;
            }
 
-         m = gfc_match_null (&initializer);
-         if (m == MATCH_NO)
-           {
-             gfc_error ("Pointer initialization requires a NULL() at %C");
-             m = MATCH_ERROR;
-           }
-
-         if (gfc_pure (NULL) && gfc_state_stack->state != COMP_DERIVED)
-           {
-             gfc_error ("Initialization of pointer at %C is not allowed in "
-                        "a PURE procedure");
-             m = MATCH_ERROR;
-           }
-
+         m = match_pointer_init (&initializer, 0);
          if (m != MATCH_YES)
            goto cleanup;
-
        }
       else if (gfc_match_char ('=') == MATCH_YES)
        {
@@ -3511,7 +3540,7 @@ match_attr_spec (void)
          break;
 
        case DECL_SAVE:
-         t = gfc_add_save (&current_attr, NULL, &seen_at[d]);
+         t = gfc_add_save (&current_attr, SAVE_EXPLICIT, NULL, &seen_at[d]);
          break;
 
        case DECL_TARGET:
@@ -3551,6 +3580,10 @@ match_attr_spec (void)
        }
     }
 
+  /* Module variables implicitly have the SAVE attribute.  */
+  if (gfc_current_state () == COMP_MODULE && !current_attr.save)
+    current_attr.save = SAVE_IMPLICIT;
+
   colon_seen = 1;
   return MATCH_YES;
 
@@ -4675,20 +4708,7 @@ match_procedure_decl (void)
              goto cleanup;
            }
 
-         m = gfc_match_null (&initializer);
-         if (m == MATCH_NO)
-           {
-             gfc_error ("Pointer initialization requires a NULL() at %C");
-             m = MATCH_ERROR;
-           }
-
-         if (gfc_pure (NULL))
-           {
-             gfc_error ("Initialization of pointer at %C is not allowed in "
-                        "a PURE procedure");
-             m = MATCH_ERROR;
-           }
-
+         m = match_pointer_init (&initializer, 1);
          if (m != MATCH_YES)
            goto cleanup;
 
@@ -4815,18 +4835,7 @@ match_ppc_decl (void)
 
       if (gfc_match (" =>") == MATCH_YES)
        {
-         m = gfc_match_null (&initializer);
-         if (m == MATCH_NO)
-           {
-             gfc_error ("Pointer initialization requires a NULL() at %C");
-             m = MATCH_ERROR;
-           }
-         if (gfc_pure (NULL))
-           {
-             gfc_error ("Initialization of pointer at %C is not allowed in "
-                        "a PURE procedure");
-             m = MATCH_ERROR;
-           }
+         m = match_pointer_init (&initializer, 1);
          if (m != MATCH_YES)
            {
              gfc_free_expr (initializer);
@@ -6720,8 +6729,8 @@ gfc_match_save (void)
       switch (m)
        {
        case MATCH_YES:
-         if (gfc_add_save (&sym->attr, sym->name, &gfc_current_locus)
-             == FAILURE)
+         if (gfc_add_save (&sym->attr, SAVE_EXPLICIT, sym->name,
+                           &gfc_current_locus) == FAILURE)
            return MATCH_ERROR;
          goto next_item;