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_comp_23.f90 | 73 ++++++++++++++++++++++++++
 1 file changed, 73 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/proc_ptr_comp_23.f90

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

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_23.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_23.f90
new file mode 100644
index 000000000..8b1c6912d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_23.f90
@@ -0,0 +1,73 @@
+! { dg-do run }
+! Tests the fix for PR42104 in which the call to the procedure pointer
+! component caused an ICE because the "always_implicit flag was not used
+! to force the passing of a descriptor for the array argument.
+!
+! Contributed by Martien Hulsen <m.a.hulsen@tue.nl>
+!
+module poisson_functions_m
+
+  implicit none
+
+contains
+ 
+  function func ( nr, x )
+    integer, intent(in) :: nr
+    real, intent(in), dimension(:) :: x
+    real :: func
+
+    real :: pi 
+
+    pi = 4 * atan(1.)
+
+    select case(nr)
+      case(1)
+        func = 0
+      case(2)
+        func = 1
+      case(3)
+        func = 1 + cos(pi*x(1))*cos(pi*x(2))
+      case default
+        write(*,'(/a,i0/)') 'Error func: wrong function number: ', nr
+        stop
+    end select
+
+  end function func 
+
+end module poisson_functions_m
+ 
+module element_defs_m
+
+  implicit none
+
+  abstract interface 
+    function dummyfunc ( nr, x )
+      integer, intent(in) :: nr
+      real, intent(in), dimension(:) :: x
+      real :: dummyfunc
+    end function dummyfunc
+  end interface 
+
+  type function_p
+    procedure(dummyfunc), nopass, pointer :: p => null()
+  end type function_p
+
+end module element_defs_m
+
+program t
+
+use poisson_functions_m
+use element_defs_m
+
+procedure(dummyfunc), pointer :: p => null()
+type(function_p) :: funcp
+
+p => func
+funcp%p => func
+
+print *, func(nr=3,x=(/0.1,0.1/))
+print *, p(nr=3,x=(/0.1,0.1/))
+print *, funcp%p(nr=3,x=(/0.1,0.1/))
+
+end program t
+! { dg-final { cleanup-modules "poisson_functions_m element_defs_m" } }
-- 
cgit v1.2.3