From: Janus Weil <janus@gcc.gnu.org>
Date: Tue, 19 Jan 2010 22:21:35 +0000 (+0100)
Subject: re PR fortran/42804 (ICE with -fcheck=bounds and type bound procedure call on array... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=63894de2a2b9c1520afee0622d4d87e81dd3f200;p=gcc.git

re PR fortran/42804 (ICE with -fcheck=bounds and type bound procedure call on array element)

gcc/fortran/
2010-01-19  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42804
	* resolve.c (extract_compcall_passed_object): Set locus for
	passed-object argument.
	(extract_ppc_passed_object): Set locus and correctly remove PPC
	reference.

gcc/testsuite/
2010-01-19  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42804
	* gfortran.dg/proc_ptr_comp_pass_6.f90: New test.
	* gfortran.dg/typebound_call_12.f03: New test.

From-SVN: r156049
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bbf484cd755..1c29ff473b3 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2010-01-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42804
+	* resolve.c (extract_compcall_passed_object): Set locus for
+	passed-object argument.
+	(extract_ppc_passed_object): Set locus and correctly remove PPC
+	reference.
+
 2010-01-19  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/42783
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8f32d1a3b66..fe98b7e0a54 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4777,6 +4777,7 @@ extract_compcall_passed_object (gfc_expr* e)
       po->expr_type = EXPR_VARIABLE;
       po->symtree = e->symtree;
       po->ref = gfc_copy_ref (e->ref);
+      po->where = e->where;
     }
 
   if (gfc_resolve_expr (po) == FAILURE)
@@ -4831,11 +4832,12 @@ extract_ppc_passed_object (gfc_expr *e)
   po->expr_type = EXPR_VARIABLE;
   po->symtree = e->symtree;
   po->ref = gfc_copy_ref (e->ref);
+  po->where = e->where;
 
   /* Remove PPC reference.  */
   ref = &po->ref;
   while ((*ref)->next)
-    (*ref) = (*ref)->next;
+    ref = &(*ref)->next;
   gfc_free_ref_list (*ref);
   *ref = NULL;
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index bdbed55c45b..33e9cc84bf7 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2010-01-19  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42804
+	* gfortran.dg/proc_ptr_comp_pass_6.f90: New test.
+	* gfortran.dg/typebound_call_12.f03: New test.
+
 2010-01-19  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/42783
diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_6.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_6.f90
new file mode 100644
index 00000000000..8898a597d53
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_6.f90
@@ -0,0 +1,35 @@
+! { dg-do compile }
+! { dg-options "-fcheck=bounds" }
+!
+! PR 42804: ICE with -fcheck=bounds and type bound procedure call on array element
+!
+! Contributed by Ian Harvey <ian_harvey@bigpond.com>
+
+MODULE ModA
+  IMPLICIT NONE
+  TYPE, PUBLIC :: A
+    PROCEDURE(a_proc),pointer :: Proc
+  END TYPE A
+CONTAINS
+  SUBROUTINE a_proc(this, stat)
+    CLASS(A), INTENT(INOUT) :: this
+    INTEGER, INTENT(OUT) :: stat
+    WRITE (*, *) 'a_proc'
+    stat = 0
+  END SUBROUTINE a_proc
+END MODULE ModA
+
+PROGRAM ProgA
+  USE ModA
+  IMPLICIT NONE
+  INTEGER :: ierr
+  INTEGER :: i
+  TYPE(A), ALLOCATABLE :: arr(:)
+  ALLOCATE(arr(2))
+  DO i = 1, 2
+    arr(i)%proc => a_proc
+    CALL arr(i)%Proc(ierr)
+  END DO
+END PROGRAM ProgA
+
+! { dg-final { cleanup-modules "ModA" } }
diff --git a/gcc/testsuite/gfortran.dg/typebound_call_12.f03 b/gcc/testsuite/gfortran.dg/typebound_call_12.f03
new file mode 100644
index 00000000000..afb0fda71a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_12.f03
@@ -0,0 +1,36 @@
+! { dg-do compile }
+! { dg-options "-fcheck=bounds" }
+!
+! PR 42804: ICE with -fcheck=bounds and type bound procedure call on array element
+!
+! Contributed by Ian Harvey <ian_harvey@bigpond.com>
+
+MODULE ModA
+  IMPLICIT NONE
+  PRIVATE
+  TYPE, PUBLIC :: A
+  CONTAINS
+    PROCEDURE :: Proc => a_proc
+  END TYPE A
+CONTAINS
+  SUBROUTINE a_proc(this, stat)
+    CLASS(A), INTENT(INOUT) :: this
+    INTEGER, INTENT(OUT) :: stat
+    WRITE (*, *) 'a_proc'
+    stat = 0
+  END SUBROUTINE a_proc
+END MODULE ModA
+
+PROGRAM ProgA
+  USE ModA
+  IMPLICIT NONE
+  INTEGER :: ierr
+  INTEGER :: i
+  TYPE(A), ALLOCATABLE :: arr(:)
+  ALLOCATE(arr(2))
+  DO i = 1, 2
+    CALL arr(i)%Proc(ierr)
+  END DO
+END PROGRAM ProgA
+ 
+! { dg-final { cleanup-modules "ModA" } }