From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001
From: upstream source tree <ports@midipix.org>
Date: Sun, 15 Mar 2015 20:14:05 -0400
Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified
 gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream
 tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
---
 gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90 | 183 ++++++++++++++++++++++++
 1 file changed, 183 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90

(limited to 'gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90')

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90
new file mode 100644
index 000000000..df830d3b1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_result_1.f90
@@ -0,0 +1,183 @@
+! { dg-do run }
+!
+! PR 36704: Procedure pointer as function result
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+module mo
+contains
+
+  function j()
+    implicit none
+    procedure(integer),pointer :: j
+    intrinsic iabs
+    j => iabs
+  end function
+
+  subroutine sub(y)
+    integer,intent(inout) :: y
+    y = y**2
+  end subroutine
+
+end module
+
+
+program proc_ptr_14
+use mo
+implicit none
+intrinsic :: iabs
+integer :: x
+procedure(integer),pointer :: p,p2
+procedure(sub),pointer :: ps
+
+p => a()
+if (p(-1)/=1) call abort()
+p => b()
+if (p(-2)/=2) call abort()
+p => c()
+if (p(-3)/=3) call abort()
+
+ps => d()
+x = 4
+call ps(x)
+if (x/=16) call abort()
+
+p => dd()
+if (p(-4)/=4) call abort()
+
+ps => e(sub)
+x = 5
+call ps(x)
+if (x/=25) call abort()
+
+p => ee()
+if (p(-5)/=5) call abort()
+p => f()
+if (p(-6)/=6) call abort()
+p => g()
+if (p(-7)/=7) call abort()
+
+ps => h(sub)
+x = 2
+call ps(x)
+if (x/=4) call abort()
+
+p => i()
+if (p(-8)/=8) call abort()
+p => j()
+if (p(-9)/=9) call abort()
+
+p => k(p2)
+if (p(-10)/=p2(-10)) call abort()
+
+p => l()
+if (p(-11)/=11) call abort()
+
+contains
+
+  function a()
+    procedure(integer),pointer :: a
+    a => iabs
+  end function
+
+  function b()
+    procedure(integer) :: b
+    pointer :: b
+    b => iabs
+  end function
+
+  function c()
+    pointer :: c
+    procedure(integer) :: c
+    c => iabs
+  end function
+
+  function d()
+    pointer :: d
+    external d
+    d => sub
+  end function
+
+  function dd()
+    pointer :: dd
+    external :: dd
+    integer :: dd
+    dd => iabs
+  end function
+
+  function e(arg)
+    external :: e,arg
+    pointer :: e
+    e => arg
+  end function
+
+  function ee()
+    integer :: ee
+    external :: ee
+    pointer :: ee
+    ee => iabs
+  end function
+
+  function f()
+    pointer :: f
+    interface
+      integer function f(x)
+        integer,intent(in) :: x
+      end function
+    end interface
+    f => iabs
+  end function
+
+  function g()
+    interface
+      integer function g(x)
+        integer,intent(in) :: x
+      end function g
+    end interface
+    pointer :: g
+    g => iabs
+  end function
+
+  function h(arg)
+    interface
+      subroutine arg(b)
+        integer,intent(inout) :: b
+      end subroutine arg
+    end interface
+    pointer :: h
+    interface
+      subroutine h(a)
+        integer,intent(inout) :: a
+      end subroutine h
+    end interface
+    h => arg
+  end function
+
+  function i()
+    pointer :: i
+    interface
+      function i(x)
+        integer :: i,x
+        intent(in) :: x
+      end function i
+    end interface
+    i => iabs
+  end function
+
+  function k(arg)
+    procedure(integer),pointer :: k,arg
+    k => iabs
+    arg => k
+  end function
+
+  function l()
+    procedure(iabs),pointer :: l
+    integer :: i
+    l => iabs
+    if (l(-11)/=11) call abort()
+  end function 
+
+end
+
+! { dg-final { cleanup-modules "mo" } }
+
-- 
cgit v1.2.3