2009-07-13 Janus Weil <janus@gcc.gnu.org>

	PR fortran/40646
	* module.c (mio_symbol): If the symbol has formal arguments,
	the formal namespace will be present.
	* resolve.c (resolve_actual_arglist): Correctly handle 'called'
	procedure pointer components as actual arguments.
	(resolve_fl_derived,resolve_symbol): Make sure the formal namespace
	is present.
	* trans-expr.c (gfc_conv_procedure_call): Correctly handle the formal
	arguments of procedure pointer components.


2009-07-13  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/40646
	* gfortran.dg/proc_ptr_22.f90: Extended.
	* gfortran.dg/proc_ptr_comp_12.f90: Extended.



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

7 files changed, 56 insertions, 14 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 220693141b9..6eabe0da140 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2009-07-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40646
+	* module.c (mio_symbol): If the symbol has formal arguments,
+	the formal namespace will be present.
+	* resolve.c (resolve_actual_arglist): Correctly handle 'called'
+	procedure pointer components as actual arguments.
+	(resolve_fl_derived,resolve_symbol): Make sure the formal namespace
+	is present.
+	* trans-expr.c (gfc_conv_procedure_call): Correctly handle the formal
+	arguments of procedure pointer components.
+
 2009-07-12  Tobias Burnus  <burnus@net-b.de>
 	    Philippe Marguinaud <philippe.marguinaud@meteo.fr>
 
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 7e6e8ff93c4..aa08c2c67b6 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -3439,19 +3439,8 @@ mio_symbol (gfc_symbol *sym)
   mio_symbol_attribute (&sym->attr);
   mio_typespec (&sym->ts);
 
-  /* Contained procedures don't have formal namespaces.  Instead we output the
-     procedure namespace.  The will contain the formal arguments.  */
   if (iomode == IO_OUTPUT)
-    {
-      formal = sym->formal;
-      while (formal && !formal->sym)
-	formal = formal->next;
-
-      if (formal)
-	mio_namespace_ref (&formal->sym->ns);
-      else
-	mio_namespace_ref (&sym->formal_ns);
-    }
+    mio_namespace_ref (&sym->formal_ns);
   else
     {
       mio_namespace_ref (&sym->formal_ns);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 9b091ad0162..880dfd0e886 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1239,7 +1239,14 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
       if (gfc_is_proc_ptr_comp (e, &comp))
 	{
 	  e->ts = comp->ts;
-	  e->expr_type = EXPR_VARIABLE;
+	  if (e->value.compcall.actual == NULL)
+	    e->expr_type = EXPR_VARIABLE;
+	  else
+	    {
+	      if (comp->as != NULL)
+		e->rank = comp->as->rank;
+	      e->expr_type = EXPR_FUNCTION;
+	    }
 	  goto argument_list;
 	}
 
@@ -8993,6 +9000,9 @@ ensure_not_abstract (gfc_symbol* sub, gfc_symbol* ancestor)
 }
 
 
+static void resolve_symbol (gfc_symbol *sym);
+
+
 /* Resolve the components of a derived type.  */
 
 static gfc_try
@@ -9031,6 +9041,9 @@ resolve_fl_derived (gfc_symbol *sym)
 	    {
 	      gfc_symbol *ifc = c->ts.interface;
 
+	      if (ifc->formal && !ifc->formal_ns)
+		resolve_symbol (ifc);
+
 	      if (ifc->attr.intrinsic)
 		resolve_intrinsic (ifc, &ifc->declared_at);
 
@@ -9832,6 +9845,20 @@ resolve_symbol (gfc_symbol *sym)
   if (sym->formal_ns && sym->formal_ns != gfc_current_ns)
     gfc_resolve (sym->formal_ns);
 
+  /* Make sure the formal namespace is present.  */
+  if (sym->formal && !sym->formal_ns)
+    {
+      gfc_formal_arglist *formal = sym->formal;
+      while (formal && !formal->sym)
+	formal = formal->next;
+
+      if (formal)
+	{
+	  sym->formal_ns = formal->sym->ns;
+	  sym->formal_ns->refs++;
+	}
+    }
+
   /* Check threadprivate restrictions.  */
   if (sym->attr.threadprivate && !sym->attr.save && !sym->ns->save_all
       && (!sym->attr.in_common
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b6a825a8125..787251d7627 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2560,7 +2560,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 						!= EXPR_CONSTANT)
 			      || (comp && comp->attr.dimension)
 			      || (!comp && sym->attr.dimension));
-  formal = sym->formal;
+  if (comp)
+    formal = comp->formal;
+  else
+    formal = sym->formal;
   /* Evaluate the arguments.  */
   for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
     {
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 08989dbf5da..c97a8d74409 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2009-07-13  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/40646
+	* gfortran.dg/proc_ptr_22.f90: Extended.
+	* gfortran.dg/proc_ptr_comp_12.f90: Extended.
+
 2009-07-13  Ira Rosen  <irar@il.ibm.com>
 
 	* gfortran.dg/vect/vect-6.f: New test.
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_22.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_22.f90
index 6dfa1f23899..3b1f5c64e8b 100644
--- a/gcc/testsuite/gfortran.dg/proc_ptr_22.f90
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_22.f90
@@ -7,6 +7,7 @@
 
 module bugTestMod
   implicit none
+  procedure(returnMat), pointer :: pp2
 contains
   function returnMat( a, b ) result( mat )
     integer:: a, b
@@ -21,6 +22,8 @@ program bugTest
   procedure(returnMat), pointer :: pp
   pp => returnMat
   if (sum(pp(2,2))/=4) call abort()
+  pp2 => returnMat
+  if (sum(pp2(3,2))/=6) call abort()
 end program bugTest
 
 ! { dg-final { cleanup-modules "bugTestMod" } }
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_12.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_12.f90
index 314bcf8253b..5f26a782ed9 100644
--- a/gcc/testsuite/gfortran.dg/proc_ptr_comp_12.f90
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_12.f90
@@ -27,6 +27,8 @@ program bugTest
   testCatch = testObj%test(2,2)
   print *,testCatch
   if (sum(testCatch)/=4) call abort()
+  print *,testObj%test(3,3)
+  if (sum(testObj%test(3,3))/=9) call abort()
 end program bugTest
 
 ! { dg-final { cleanup-modules "bugTestMod" } }