Initial checkin of GCC 4.9.0 from trunk (r208799).

Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba

1 files changed, 69 insertions, 0 deletions

diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/proc_ptr_result_8.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/proc_ptr_result_8.f90
new file mode 100644
index 000000000..be23f5196
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/proc_ptr_result_8.f90
@@ -0,0 +1,69 @@
+! { dg-do compile }
+! Test fix for PR54286.
+!
+! Contributed by Janus Weil  <janus@gcc.gnu.org>
+! Module 'm' added later because original fix missed possibility of
+! null interfaces - thanks to Dominique Dhumieres  <dominiq@lps.ens.fr>
+!
+module m
+  type :: foobar
+    real, pointer :: array(:)
+    procedure (), pointer, nopass :: f
+  end type
+contains
+  elemental subroutine fooAssgn (a1, a2)
+    type(foobar), intent(out) :: a1
+    type(foobar), intent(in) :: a2
+    allocate (a1%array(size(a2%array)))
+    a1%array = a2%array
+    a1%f => a2%f
+  end subroutine
+end module m
+
+implicit integer (a)
+type :: t
+  procedure(a), pointer, nopass :: p
+end type
+type(t) :: x
+
+! We cannot use iabs directly as it is elemental
+abstract interface
+  integer pure function interf_iabs(x)
+    integer, intent(in) :: x
+  end function interf_iabs
+end interface
+
+procedure(interf_iabs), pointer :: pp
+procedure(foo), pointer :: pp1
+
+x%p => a     ! ok
+if (x%p(0) .ne. loc(foo)) call abort
+if (x%p(1) .ne. loc(iabs)) call abort
+
+x%p => a(1)  ! { dg-error "PROCEDURE POINTER mismatch in function result" }
+
+pp => a(1)   ! ok
+if (pp(-99) .ne. iabs(-99)) call abort
+
+pp1 => a(2)   ! ok
+if (pp1(-99) .ne. -iabs(-99)) call abort
+
+pp => a  ! { dg-error "PROCEDURE POINTER mismatch in function result" }
+
+contains
+
+  function a (c) result (b)
+    integer, intent(in) :: c
+    procedure(interf_iabs), pointer :: b
+    if (c .eq. 1) then
+      b => iabs
+    else
+      b => foo
+    end if
+  end function
+
+  pure integer function foo (arg)
+    integer, intent (in) :: arg
+    foo = -iabs(arg)
+  end function
+end