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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2206931..6eabe0d 100644 (file)
--- 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 7e6e8ff..aa08c2c 100644 (file)
--- 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 9b091ad..880dfd0 100644 (file)
--- 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 b6a825a..787251d 100644 (file)
--- 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 08989db..c97a8d7 100644 (file)
--- 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 6dfa1f2..3b1f5c6 100644 (file)
--- 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 314bcf8..5f26a78 100644 (file)
--- 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" } }