re PR fortran/23994 (PROTECTED attribute (F2003) is not implemented)

fortran/
2006-12-10  Tobias Burnus  <burnus@net-b.de>

    PR fortran/23994
    * interface.c (compare_actual_formal): PROTECTED is incompatible
with intent(out).
    * symbol.c (check_conflict): Check for PROTECTED conflicts.
      (gfc_add_protected): New function.
      (gfc_copy_attr): Copy PROTECTED attribute.
    * decl.c (match_attr_spec): Add PROTECTED support.
      (gfc_match_protected): New function.
    * dump-parse-tree.c (gfc_show_attr): Add PROTECTED support.
    * gfortran.h (gfc_symbol): Add protected flag.
      Add gfc_add_protected prototype.
    * expr.c (gfc_check_pointer_assign): Add PROTECTED support.
    * module.c (ab_attribute, attr_bits, mio_symbol_attribute,
mio_symbol_attribute):
       Add PROTECTED support.
    * resolve.c (resolve_equivalence): Add PROTECTED support.
    * match.c (gfc_match_assignment,)gfc_match_pointer_assignment:
       Check PROTECTED attribute.
    * match.h: Add gfc_match_protected prototype.
    * parse.c (decode_statement): Match PROTECTED statement.
    * primary.c (match_variable): Add PROTECTED support.

testsuite/
2006-12-10  Tobias Burnus  <burnus@net-b.de>

    PR fortran/23994
    * gfortran.dg/protected_1.f90: New test.
    * gfortran.dg/protected_2.f90: New test.
    * gfortran.dg/protected_3.f90: New test.
    * gfortran.dg/protected_4.f90: New test.
    * gfortran.dg/protected_5.f90: New test.
    * gfortran.dg/protected_6.f90: New test.

From-SVN: r119709

1 files changed, 40 insertions, 0 deletions

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index bcf95f5..28747e0 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1206,6 +1206,36 @@ compare_parameter (gfc_symbol * formal, gfc_expr * actual,
 }
 
 
+/* Given a symbol of a formal argument list and an expression, see if
+   the two are compatible as arguments.  Returns nonzero if
+   compatible, zero if not compatible.  */
+
+static int
+compare_parameter_protected (gfc_symbol * formal, gfc_expr * actual)
+{
+  if (actual->expr_type != EXPR_VARIABLE)
+    return 1;
+
+  if (!actual->symtree->n.sym->attr.protected)
+    return 1;
+
+  if (!actual->symtree->n.sym->attr.use_assoc)
+    return 1;
+
+  if (formal->attr.intent == INTENT_IN
+      || formal->attr.intent == INTENT_UNKNOWN)
+    return 1;
+
+  if (!actual->symtree->n.sym->attr.pointer)
+    return 0;
+
+  if (actual->symtree->n.sym->attr.pointer && formal->attr.pointer)
+    return 0;
+
+  return 1;
+}
+
+
 /* Given formal and actual argument lists, see if they are compatible.
    If they are compatible, the actual argument list is sorted to
    correspond with the formal list, and elements for missing optional
@@ -1393,6 +1423,16 @@ compare_actual_formal (gfc_actual_arglist ** ap,
           return 0;
         }
 
+      if (!compare_parameter_protected(f->sym, a->expr))
+	{
+	  if (where)
+	    gfc_error ("Actual argument at %L is use-associated with "
+		       "PROTECTED attribute and dummy argument '%s' is "
+		       "INTENT = OUT/INOUT",
+		       &a->expr->where,f->sym->name);
+          return 0;
+	}
+
     match:
       if (a == actual)
 	na = i;