From: Paul Thomas <pault@gcc.gnu.org>
Date: Fri, 20 Nov 2009 06:43:13 +0000 (+0000)
Subject: re PR fortran/42104 ([F03] runtime segfault with procedure pointer component)
X-Git-Tag: upstream/12.2.0~96120
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=9f29c05e324de7a69a317e3f5ce2b1e214652dca;p=platform%2Fupstream%2Fgcc.git

re PR fortran/42104 ([F03] runtime segfault with procedure pointer component)

2009-11-20  Paul Thomas  <pault@gcc.gnu.org>
	    Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42104
	* trans-expr.c (gfc_conv_procedure_call): If procedure pointer
	component call, use the component's 'always_explicit' attr
	for array arguments.

2009-11-20  Paul Thomas  <pault@gcc.gnu.org>
	    Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42104
	* gfortran.dg/proc_ptr_comp_23.f90 : New test.


Co-Authored-By: Janus Weil <janus@gcc.gnu.org>

From-SVN: r154358
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 95e761f..1d28abf 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2009-11-20  Paul Thomas  <pault@gcc.gnu.org>
+	    Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42104
+	* trans-expr.c (gfc_conv_procedure_call): If procedure pointer
+	component call, use the component's 'always_explicit' attr
+	for array arguments.
+
 2009-11-19  Janus Weil  <janus@gcc.gnu.org>
 
 	* trans-expr.c (conv_isocbinding_procedure): New function.
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index c0df678..6646b26 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2979,7 +2979,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	      f = (fsym != NULL)
 		  && !(fsym->attr.pointer || fsym->attr.allocatable)
 		  && fsym->as->type != AS_ASSUMED_SHAPE;
-	      f = f || !sym->attr.always_explicit;
+	      if (comp)
+		f = f || !comp->attr.always_explicit;
+	      else
+		f = f || !sym->attr.always_explicit;
 
 	      if (e->expr_type == EXPR_VARIABLE
 		    && is_subref_array (e))
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ecebcb1..fdc14b9 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2009-11-20  Paul Thomas  <pault@gcc.gnu.org>
+	    Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42104
+	* gfortran.dg/proc_ptr_comp_23.f90 : New test.
+
 2009-11-19  Jason Merrill  <jason@redhat.com>
 
 	PR c++/42115
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 0000000..270d2c4
--- /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" }}