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, 27 insertions, 1 deletions

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index a809082..12c5749 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -275,7 +275,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
     *dimension = "DIMENSION", *in_equivalence = "EQUIVALENCE",
     *use_assoc = "USE ASSOCIATED", *cray_pointer = "CRAY POINTER",
     *cray_pointee = "CRAY POINTEE", *data = "DATA", *value = "VALUE",
-    *volatile_ = "VOLATILE";
+    *volatile_ = "VOLATILE", *protected = "PROTECTED";
   static const char *threadprivate = "THREADPRIVATE";
 
   const char *a1, *a2;
@@ -404,6 +404,10 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
   conf (data, allocatable);
   conf (data, use_assoc);
 
+  conf (protected, intrinsic)
+  conf (protected, external)
+  conf (protected, in_common)
+
   conf (value, pointer)
   conf (value, allocatable)
   conf (value, subroutine)
@@ -451,6 +455,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
       conf2 (save);
       conf2 (volatile_);
       conf2 (pointer);
+      conf2 (protected);
       conf2 (target);
       conf2 (external);
       conf2 (intrinsic);
@@ -537,6 +542,7 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
       conf2 (subroutine);
       conf2 (entry);
       conf2 (pointer);
+      conf2 (protected);
       conf2 (target);
       conf2 (dummy);
       conf2 (in_common);
@@ -781,6 +787,24 @@ gfc_add_cray_pointee (symbol_attribute * attr, locus * where)
   return check_conflict (attr, NULL, where);
 }
 
+try
+gfc_add_protected (symbol_attribute * attr, const char *name, locus * where)
+{
+  if (check_used (attr, name, where))
+    return FAILURE;
+
+  if (attr->protected)
+    {
+	if (gfc_notify_std (GFC_STD_LEGACY, 
+			    "Duplicate PROTECTED attribute specified at %L",
+			    where) 
+	    == FAILURE)
+	  return FAILURE;
+    }
+
+  attr->protected = 1;
+  return check_conflict (attr, name, where);
+}
 
 try
 gfc_add_result (symbol_attribute * attr, const char *name, locus * where)
@@ -1293,6 +1317,8 @@ gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
     goto fail;
   if (src->pointer && gfc_add_pointer (dest, where) == FAILURE)
     goto fail;
+  if (src->protected && gfc_add_protected (dest, NULL, where) == FAILURE)
+    goto fail;
   if (src->save && gfc_add_save (dest, NULL, where) == FAILURE)
     goto fail;
   if (src->value && gfc_add_value (dest, NULL, where) == FAILURE)