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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148652 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 39bc27f..d6a6082 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 3a67042..4117d80 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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);
 

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 326d73e..71062fb 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/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)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c20d839..c16ecd0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_4.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_4.f90
new file mode 100644 (file)
index 0000000..97e67e5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_4.f90
@@ -0,0 +1,16 @@
+! { 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
+