interface.c (gfc_procedure_use): Return gfc_try instead of

2012-07-31  Tobias Burnus  <burnus@net-b.de>

        * interface.c (gfc_procedure_use): Return gfc_try instead of
        * void.
        * gfortran.h (gfc_procedure_use): Update prototype.
        * resolve.c (gfc_iso_c_func_interface): Allow noninteroperable
        procedures for c_funloc for TS29113.
        * (gfc_iso_c_sub_interface): Ditto for c_f_procpointer. Add
        diagnostic for c_ptr vs. c_funptr for c_f_(proc)pointer.

2012-07-31  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/c_funloc_tests_6.f90: New.
        * gfortran.dg/c_funloc_tests_7.f90: New.
        * gfortran.dg/c_funloc_tests_5.f03: Compile with -std=f2003.

From-SVN: r190003

1 files changed, 13 insertions, 9 deletions

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 098ec3d2..0f8951c 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2927,7 +2927,7 @@ check_intents (gfc_formal_arglist *f, gfc_actual_arglist *a)
    well, the actual argument list will also end up being properly
    sorted.  */
 
-void
+gfc_try
 gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 {
   /* Warn about calls with an implicit interface.  Special case
@@ -2954,7 +2954,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 	  gfc_error("The pointer object '%s' at %L must have an explicit "
 		    "function interface or be declared as array",
 		    sym->name, where);
-	  return;
+	  return FAILURE;
 	}
 
       if (sym->attr.allocatable && !sym->attr.external)
@@ -2962,14 +2962,14 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 	  gfc_error("The allocatable object '%s' at %L must have an explicit "
 		    "function interface or be declared as array",
 		    sym->name, where);
-	  return;
+	  return FAILURE;
 	}
 
       if (sym->attr.allocatable)
 	{
 	  gfc_error("Allocatable function '%s' at %L must have an explicit "
 		    "function interface", sym->name, where);
-	  return;
+	  return FAILURE;
 	}
 
       for (a = *ap; a; a = a->next)
@@ -3009,7 +3009,7 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 	      && a->expr->ts.type == BT_UNKNOWN)
 	    {
 	      gfc_error ("MOLD argument to NULL required at %L", &a->expr->where);
-	      return;
+	      return FAILURE;
 	    }
 
 	  /* TS 29113, C407b.  */
@@ -3018,19 +3018,23 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
 	    {
 	      gfc_error ("Assumed-rank argument requires an explicit interface "
 			 "at %L", &a->expr->where);
-	      return;
+	      return FAILURE;
 	    }
 	}
 
-      return;
+      return SUCCESS;
     }
 
   if (!compare_actual_formal (ap, sym->formal, 0, sym->attr.elemental, where))
-    return;
+    return FAILURE;
+
+  if (check_intents (sym->formal, *ap) == FAILURE)
+    return FAILURE;
 
-  check_intents (sym->formal, *ap);
   if (gfc_option.warn_aliasing)
     check_some_aliasing (sym->formal, *ap);
+
+  return SUCCESS;
 }