re PR fortran/30520 (Conflics checking of VOLATILE attribute needs improvement)

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

       PR fortran/30520
       * interface.c (compare_actual_formal): Check conformance between
         actual and VOLATILE dummy arguments.
       * symbol.c (gfc_add_volatile): Allow setting of VOLATILE
         multiple times in different scopes.
       * decl.c (gfc_match_volatile): Search symbol in host association.

testsuite/
2007-01-31  Tobias Burnus  <burnus@net-b.de>

       PR fortran/30520
       * gfortran.dg/volatile8.f90: New argument conformance test.
       * gfortran.dg/volatile9.f90: New scope test.

From-SVN: r121379

1 files changed, 48 insertions, 0 deletions

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 91674bf..9ce42cc 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1417,6 +1417,54 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  return 0;
 	}
 
+      /* C1232 (R1221) For an actual argument which is an array section or
+	 an assumed-shape array, the dummy argument shall be an assumed-
+	 shape array, if the dummy argument has the VOLATILE attribute.  */
+
+      if (f->sym->attr.volatile_
+	  && a->expr->symtree->n.sym->as
+	  && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SHAPE
+	  && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
+	{
+	  if (where)
+	    gfc_error ("Assumed-shape actual argument at %L is "
+		       "incompatible with the non-assumed-shape "
+		       "dummy argument '%s' due to VOLATILE attribute",
+		       &a->expr->where,f->sym->name);
+	  return 0;
+	}
+
+      if (f->sym->attr.volatile_
+	  && a->expr->ref && a->expr->ref->u.ar.type == AR_SECTION
+	  && !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
+	{
+	  if (where)
+	    gfc_error ("Array-section actual argument at %L is "
+		       "incompatible with the non-assumed-shape "
+		       "dummy argument '%s' due to VOLATILE attribute",
+		       &a->expr->where,f->sym->name);
+	  return 0;
+	}
+
+      /* C1233 (R1221) For an actual argument which is a pointer array, the
+	 dummy argument shall be an assumed-shape or pointer array, if the
+	 dummy argument has the VOLATILE attribute.  */
+
+      if (f->sym->attr.volatile_
+	  && a->expr->symtree->n.sym->attr.pointer
+	  && a->expr->symtree->n.sym->as
+	  && !(f->sym->as
+	       && (f->sym->as->type == AS_ASSUMED_SHAPE
+		   || f->sym->attr.pointer)))
+	{
+	  if (where)
+	    gfc_error ("Pointer-array actual argument at %L requires "
+		       "an assumed-shape or pointer-array dummy "
+		       "argument '%s' due to VOLATILE attribute",
+		       &a->expr->where,f->sym->name);
+	  return 0;
+	}
+
     match:
       if (a == actual)
 	na = i;