resolve.c (resolve_global_procedure): Improved checking if an explicit interface is required.

gcc/fortran/:
2010-06-12  Daniel Franke  <franke.daniel@gmail.com>

        * resolve.c (resolve_global_procedure): Improved checking if an
        explicit interface is required.

gcc/testsuite/:
2010-06-12  Daniel Franke  <franke.daniel@gmail.com>

        * gfortran.dg/whole_file_20.f03: New.

From-SVN: r160663

gcc/fortran/ChangeLog

@@ -1,3 +1,8 @@
+2010-06-12  Daniel Franke  <franke.daniel@gmail.com>
+
+        * resolve.c (resolve_global_procedure): Improved checking if an
+        explicit interface is required.
+
 2010-06-12  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
 	* trans-decl.c (gfc_build_intrinsic_function_decls): Fix

gcc/fortran/resolve.c

@@ -1858,29 +1858,6 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 	    }
 	}
 
-      if (gsym->ns->proc_name->attr.function
-	    && gsym->ns->proc_name->as
-	    && gsym->ns->proc_name->as->rank
-	    && (!sym->as || sym->as->rank != gsym->ns->proc_name->as->rank))
-	gfc_error ("The reference to function '%s' at %L either needs an "
-		   "explicit INTERFACE or the rank is incorrect", sym->name,
-		   where);
-
-      /* Non-assumed length character functions.  */
-      if (sym->attr.function && sym->ts.type == BT_CHARACTER
-	  && gsym->ns->proc_name->ts.u.cl->length != NULL)
-	{
-	  gfc_charlen *cl = sym->ts.u.cl;
-
-	  if (!sym->attr.entry_master && sym->attr.if_source == IFSRC_UNKNOWN
-	      && cl && cl->length && cl->length->expr_type != EXPR_CONSTANT)
-	    {
-	      gfc_error ("Nonconstant character-length function '%s' at %L "
-			 "must have an explicit interface", sym->name,
-			 &sym->declared_at);
-	    }
-	}
-
       /* Differences in constant character lengths.  */
       if (sym->attr.function && sym->ts.type == BT_CHARACTER)
 	{
@@ -1911,26 +1888,108 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
 		   sym->name, &sym->declared_at, gfc_typename (&sym->ts),
 		   gfc_typename (&gsym->ns->proc_name->ts));
 
-      /* Assumed shape arrays as dummy arguments.  */
       if (gsym->ns->proc_name->formal)
 	{
 	  gfc_formal_arglist *arg = gsym->ns->proc_name->formal;
 	  for ( ; arg; arg = arg->next)
-	    if (arg->sym && arg->sym->as
+	    if (!arg->sym)
+	      continue;
+	    /* F2003, 12.3.1.1 (2a); F2008, 12.4.2.2 (2a)  */
+	    else if (arg->sym->attr.allocatable
+		     || arg->sym->attr.asynchronous
+		     || arg->sym->attr.optional
+		     || arg->sym->attr.pointer
+		     || arg->sym->attr.target
+		     || arg->sym->attr.value
+		     || arg->sym->attr.volatile_)
+	      {
+		gfc_error ("Dummy argument '%s' of procedure '%s' at %L "
+			   "has an attribute that requires an explicit "
+			   "interface for this procedure", arg->sym->name,
+			   sym->name, &sym->declared_at);
+		break;
+	      }
+	    /* F2003, 12.3.1.1 (2b); F2008, 12.4.2.2 (2b)  */
+	    else if (arg->sym && arg->sym->as
 		     && arg->sym->as->type == AS_ASSUMED_SHAPE)
 	      {
 		gfc_error ("Procedure '%s' at %L with assumed-shape dummy "
-			   "'%s' argument must have an explicit interface",
+			   "argument '%s' must have an explicit interface",
 			   sym->name, &sym->declared_at, arg->sym->name);
 		break;
 	      }
-	    else if (arg->sym && arg->sym->attr.optional)
+	    /* F2008, 12.4.2.2 (2c)  */
+	    else if (arg->sym->attr.codimension)
 	      {
-		gfc_error ("Procedure '%s' at %L with optional dummy argument "
+		gfc_error ("Procedure '%s' at %L with coarray dummy argument "
 			   "'%s' must have an explicit interface",
 			   sym->name, &sym->declared_at, arg->sym->name);
 		break;
 	      }
+	    /* F2003, 12.3.1.1 (2c); F2008, 12.4.2.2 (2d)   */
+	    else if (false) /* TODO: is a parametrized derived type  */
+	      {
+		gfc_error ("Procedure '%s' at %L with parametrized derived "
+			   "type argument '%s' must have an explicit "
+			   "interface", sym->name, &sym->declared_at,
+			   arg->sym->name);
+		break;
+	      }
+	    /* F2003, 12.3.1.1 (2d); F2008, 12.4.2.2 (2e)   */
+	    else if (arg->sym->ts.type == BT_CLASS)
+	      {
+		gfc_error ("Procedure '%s' at %L with polymorphic dummy "
+			   "argument '%s' must have an explicit interface",
+			   sym->name, &sym->declared_at, arg->sym->name);
+		break;
+	      }
+	}
+
+      if (gsym->ns->proc_name->attr.function)
+	{
+	  /* F2003, 12.3.1.1 (3a); F2008, 12.4.2.2 (3a) */
+	  if (gsym->ns->proc_name->as
+	      && gsym->ns->proc_name->as->rank
+	      && (!sym->as || sym->as->rank != gsym->ns->proc_name->as->rank))
+	    gfc_error ("The reference to function '%s' at %L either needs an "
+		       "explicit INTERFACE or the rank is incorrect", sym->name,
+		       where);
+
+	  /* F2003, 12.3.1.1 (3b); F2008, 12.4.2.2 (3b) */
+	  if (gsym->ns->proc_name->result->attr.pointer
+	      || gsym->ns->proc_name->result->attr.allocatable)
+	    gfc_error ("Function '%s' at %L with a POINTER or ALLOCATABLE "
+		       "result must have an explicit interface", sym->name,
+		       where);
+
+	  /* F2003, 12.3.1.1 (3c); F2008, 12.4.2.2 (3c)  */
+	  if (sym->ts.type == BT_CHARACTER
+	      && gsym->ns->proc_name->ts.u.cl->length != NULL)
+	    {
+	      gfc_charlen *cl = sym->ts.u.cl;
+
+	      if (!sym->attr.entry_master && sym->attr.if_source == IFSRC_UNKNOWN
+		  && cl && cl->length && cl->length->expr_type != EXPR_CONSTANT)
+		{
+		  gfc_error ("Nonconstant character-length function '%s' at %L "
+			     "must have an explicit interface", sym->name,
+			     &sym->declared_at);
+		}
+	    }
+	}
+
+      /* F2003, 12.3.1.1 (4); F2008, 12.4.2.2 (4) */
+      if (gsym->ns->proc_name->attr.elemental)
+	{
+	  gfc_error ("ELEMENTAL procedure '%s' at %L must have an explicit "
+		     "interface", sym->name, &sym->declared_at);
+	}
+
+      /* F2003, 12.3.1.1 (5); F2008, 12.4.2.2 (5) */
+      if (gsym->ns->proc_name->attr.is_bind_c)
+	{
+	  gfc_error ("Procedure '%s' at %L with BIND(C) attribute must have "
+		     "an explicit interface", sym->name, &sym->declared_at);
 	}
 
       if (gfc_option.flag_whole_file == 1

gcc/testsuite/ChangeLog

@@ -1,3 +1,7 @@
+2010-06-12  Daniel Franke  <franke.daniel@gmail.com>
+
+        * gfortran.dg/whole_file_20.f03: New.
+
 2010-06-12  Jan Hubicka  <jh@suse.cz>
 
 	* gcc.c-torture/compile/pc44485.c: New testcase.

gcc/testsuite/gfortran.dg/whole_file_20.f03

@@ -0,0 +1,33 @@
+! { dg-do "compile" }
+! { dg-options "-fwhole-file -fcoarray=single" }
+!
+! Procedures with dummy arguments that are coarrays or polymorphic
+! must have an explicit interface in the calling routine.
+!
+
+MODULE classtype
+  type :: t
+    integer :: comp
+  end type
+END MODULE
+
+PROGRAM main
+  USE classtype
+  CLASS(t), POINTER :: tt
+
+  INTEGER :: coarr[*]
+
+  CALL coarray(coarr)         ! { dg-error " must have an explicit interface" }
+  CALL polymorph(tt)          ! { dg-error " must have an explicit interface" }
+END PROGRAM
+
+SUBROUTINE coarray(a)
+  INTEGER :: a[*]
+END SUBROUTINE
+
+SUBROUTINE polymorph(b)
+  USE classtype
+  CLASS(t) :: b
+END SUBROUTINE
+
+! { dg-final { cleanup-modules "classtype" } }