re PR fortran/29624 (Fortran 2003: Support intent for pointers)

fortran/
2007-01-05  Tobias Burnus  <burnus@net-b.de>

        PR fortran/29624
        * interface.c (compare_parameter_intent): New function.
          (check_intents): Support pointer intents.
        * symbol.c (check_conflict): Support pointer intents,
          better conflict_std message.
        * expr.c (gfc_check_assign,gfc_check_pointer_assign):
          Support pointer intents.
        * resolve.c (resolve_deallocate_expr,resolve_allocate_expr):
          Support pointer intents.

testsuite/
2006-01-05  Tobias Burnus  <burnus@net-b.de>

        PR fortran/29624
        * gfortran.dg/alloc_alloc_expr_1.f90: Add check for
          invalid deallocate.
        * gfortran.dg/allocatable_dummy_2.f90: Update dg-error.
        * gfortran.dg/protected_4.f90: Add pointer intent check.
        * gfortran.dg/protected_6.f90: Add pointer intent check.
        * gfortran.dg/pointer_intent_1.f90: New test.
        * gfortran.dg/pointer_intent_2.f90: New test.
        * gfortran.dg/pointer_intent_3.f90: New test.

From-SVN: r120472

1 files changed, 40 insertions, 4 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 7f6c699..7c2069c 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2188,12 +2188,25 @@ try
 gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
 {
   gfc_symbol *sym;
+  gfc_ref *ref;
+  int has_pointer;
 
   sym = lvalue->symtree->n.sym;
 
-  if (sym->attr.intent == INTENT_IN)
+  /* Check INTENT(IN), unless the object itself is the component or
+     sub-component of a pointer.  */
+  has_pointer = sym->attr.pointer;
+
+  for (ref = lvalue->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
+      {
+	has_pointer = 1;
+	break;
+      }
+
+  if (!has_pointer && sym->attr.intent == INTENT_IN)
     {
-      gfc_error ("Can't assign to INTENT(IN) variable '%s' at %L",
+      gfc_error ("Cannot assign to INTENT(IN) variable '%s' at %L",
 		 sym->name, &lvalue->where);
       return FAILURE;
     }
@@ -2318,7 +2331,9 @@ try
 gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
 {
   symbol_attribute attr;
+  gfc_ref *ref;
   int is_pure;
+  int pointer, check_intent_in;
 
   if (lvalue->symtree->n.sym->ts.type == BT_UNKNOWN)
     {
@@ -2336,8 +2351,29 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
       return FAILURE;
     }
 
-  attr = gfc_variable_attr (lvalue, NULL);
-  if (!attr.pointer)
+
+  /* Check INTENT(IN), unless the object itself is the component or
+     sub-component of a pointer.  */
+  check_intent_in = 1;
+  pointer = lvalue->symtree->n.sym->attr.pointer;
+
+  for (ref = lvalue->ref; ref; ref = ref->next)
+    {
+      if (pointer)
+        check_intent_in = 0;
+
+      if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
+        pointer = 1;
+    }
+
+  if (check_intent_in && lvalue->symtree->n.sym->attr.intent == INTENT_IN)
+    {
+      gfc_error ("Cannot assign to INTENT(IN) variable '%s' at %L",
+                 lvalue->symtree->n.sym->name, &lvalue->where);
+      return FAILURE;
+    }
+
+  if (!pointer)
     {
       gfc_error ("Pointer assignment to non-POINTER at %L", &lvalue->where);
       return FAILURE;