[Patch,Fortran] Copy more attributes for PROCEDURE() (PR35830)

[Tobias Burnus <tobias dot burnus at physik dot fu-berlin dot de>]

Hi all,

For 
  PROCEDURE(interface) :: foo
not all needed attributes where copied from interface to foo, which
caused rejected-valid (and accept-invalid) problems, but also wrong code.

I now copy now several more attributes. I hope I have not missed one.

Build and make check-gfortran tested on x86-64-linux.
OK for the trunk?

Tobias

2008-06-07  Tobias Burnus  <burnus@net-b.de>

	PR fortran/35830
	* resolve.c (resolve_symbol): Copy more attributes for
	PROCEDUREs with interfaces.

2008-06-07  Tobias Burnus  <burnus@net-b.de>

	PR fortran/35830
	* proc_decl_13.f90: New.
	* proc_decl_14.f90: New.

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 136537)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -7905,6 +7905,13 @@ resolve_symbol (gfc_symbol *sym)
 	  sym->ts.interface = ifc;
 	  sym->attr.function = ifc->attr.function;
 	  sym->attr.subroutine = ifc->attr.subroutine;
+	  sym->attr.pointer = ifc->attr.pointer;
+	  sym->attr.pure = ifc->attr.pure;
+	  sym->attr.elemental = ifc->attr.elemental;
+	  sym->attr.dimension = ifc->attr.dimension;
+	  sym->attr.recursive = ifc->attr.recursive;
+	  sym->attr.always_explicit = ifc->attr.always_explicit;
+	  sym->as = gfc_copy_array_spec (ifc->as);
 	  copy_formal_args (sym, ifc);
 	}
       else if (sym->ts.interface->name[0] != '\0')
Index: gcc/testsuite/gfortran.dg/proc_decl_13.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_decl_13.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/proc_decl_13.f90	(Revision 0)
@@ -0,0 +1,45 @@
+! { dg-do run }
+! PR fortran/35830
+!
+module m
+contains
+  subroutine one(a)
+      integer a(:)
+      print *, lbound(a), ubound(a), size(a)
+      if ((lbound(a,dim=1) /= 1) .or. (ubound(a,dim=1) /= 3)) &
+        call abort()
+      print *, a
+      if (any(a /= [1,2,3])) call abort()
+  end subroutine one
+end module m
+
+program test
+  use m
+  implicit none
+  call foo1(one)
+  call foo2(one)
+contains
+  subroutine foo1(f)
+    ! The following interface block is needed
+    ! for NAG f95 as it wrongly does not like
+    ! use-associated interfaces for PROCEDURE
+    ! (It is not needed for gfortran)
+    interface
+      subroutine bar(a)
+        integer a(:)
+      end subroutine
+    end interface
+    procedure(bar) :: f
+    call f([1,2,3]) ! Was failing before
+  end subroutine foo1
+  subroutine foo2(f)
+    interface
+      subroutine f(a)
+        integer a(:)
+      end subroutine
+    end interface
+    call f([1,2,3]) ! Works
+  end subroutine foo2
+
+! { dg-final { cleanup-modules "m" } }
+end program test
Index: gcc/testsuite/gfortran.dg/proc_decl_14.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_decl_14.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/proc_decl_14.f90	(Revision 0)
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! PR fortran/35830
+!
+abstract interface
+  function ptrfunc()
+    integer, pointer :: ptrfunc
+  end function ptrfunc
+  elemental subroutine elem(a)
+    integer,intent(in) :: a
+  end subroutine elem
+  function dims()
+    integer :: dims(3)
+  end function dims
+end interface
+
+procedure(ptrfunc) :: func_a
+procedure(elem)    :: func_b
+procedure(dims)     :: func_c
+
+integer, pointer :: ptr
+integer :: array(3)
+
+ptr => func_a()
+call func_b([1,2,3])
+array = func_c()
+end