re PR fortran/35830 (ICE with PROCEDURE(<interface>) containing array formal arguments)

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

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

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

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

From-SVN: r136554

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9fe66145beee2b38b19d31dd4394706f3324bf06..9c950697ddacdf94c8c21a8377c5ea1f51cb7536 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2008-06-08  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/35830
+       * resolve.c (resolve_symbol): Copy more attributes for
+       PROCEDUREs with interfaces.
+
 2008-06-07  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/36420

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2787e293021d32e0c48cb154e74267b4aa79df6f..9c0e45d63c649185b69ce18bc041c967900ad6c0 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7905,6 +7905,14 @@ resolve_symbol (gfc_symbol *sym)
          sym->ts.interface = ifc;
          sym->attr.function = ifc->attr.function;
          sym->attr.subroutine = ifc->attr.subroutine;
+         sym->attr.allocatable = ifc->attr.allocatable;
+         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')

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index cc02b94f1d9fec25c8ef28ca60d78b2ec80e6675..d6a0c031e3920da175a2eca5530a513bf4c51eed 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+2008-06-08  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/35830
+       * proc_decl_13.f90: New.
+       * proc_decl_14.f90: New.
+       * proc_decl_15.f90: New.
+
 2008-06-07  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/36420

diff --git a/gcc/testsuite/gfortran.dg/proc_decl_13.f90 b/gcc/testsuite/gfortran.dg/proc_decl_13.f90
new file mode 100644 (file)
index 0000000..b875376
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_13.f90
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/proc_decl_14.f90 b/gcc/testsuite/gfortran.dg/proc_decl_14.f90
new file mode 100644 (file)
index 0000000..d30ee7a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_14.f90
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/proc_decl_15.f90 b/gcc/testsuite/gfortran.dg/proc_decl_15.f90
new file mode 100644 (file)
index 0000000..f099c1d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_decl_15.f90
@@ -0,0 +1,20 @@
+! { dg-do run }
+! PR fortran/35830
+!
+function f()
+  real, allocatable :: f(:)
+  allocate(f(1:3))
+  f(1:3)= (/9,8,7/)
+end function
+
+program test
+  implicit none
+  abstract interface
+    function ai()
+      real, allocatable :: ai(:)
+    end function
+  end interface
+  procedure(ai) :: f
+  if(any(f() /= [9,8,7])) call abort()
+  if(size(f()) /= 3) call abort()
+end