re PR fortran/40451 ([F03] procedure pointer assignment rejected)

2009-06-18  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40451
	* resolve.c (resolve_contained_fntype): Prevent implicit typing for
	procedures with explicit interface.
	* symbol.c (gfc_check_function_type): Ditto.

2009-06-18  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40451
	* gfortran.dg/proc_ptr_result_4.f90: New.

From-SVN: r148652

gcc/fortran/ChangeLog

+2009-06-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40451
+	* resolve.c (resolve_contained_fntype): Prevent implicit typing for
+	procedures with explicit interface.
+	* symbol.c (gfc_check_function_type): Ditto.
+
 2009-06-16  Ian Lance Taylor  <iant@google.com>
 
 	* decl.c (build_struct): Rewrite loop over constructor elements.

gcc/fortran/resolve.c

@@ -347,7 +347,7 @@ resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns)
     return;
 
   /* Try to find out of what the return type is.  */
-  if (sym->result->ts.type == BT_UNKNOWN)
+  if (sym->result->ts.type == BT_UNKNOWN && sym->result->ts.interface == NULL)
     {
       t = gfc_set_default_type (sym->result, 0, ns);
 

gcc/fortran/symbol.c

@@ -317,7 +317,7 @@ gfc_check_function_type (gfc_namespace *ns)
   if (!proc->attr.contained || proc->result->attr.implicit_type)
     return;
 
-  if (proc->result->ts.type == BT_UNKNOWN)
+  if (proc->result->ts.type == BT_UNKNOWN && proc->result->ts.interface == NULL)
     {
       if (gfc_set_default_type (proc->result, 0, gfc_current_ns)
 		== SUCCESS)

gcc/testsuite/ChangeLog

+2009-06-18  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40451
+	* gfortran.dg/proc_ptr_result_4.f90: New.
+
 2009-06-17  Adam Nemet  <anemet@caviumnetworks.com>
 
 	* gcc.c-torture/execute/bitfld-5.c: New test.

gcc/testsuite/gfortran.dg/proc_ptr_result_4.f90

+! { dg-do compile }
+!
+! PR 40451: [F03] procedure pointer assignment rejected 
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+
+contains
+
+  function f()
+    intrinsic :: sin
+    procedure(sin), pointer :: f
+    f => sin
+  end function f
+
+end
+