diff mbox

[pr69011,fortran,v1,6,Regression,OOP] ICE in gfc_advance_chain for ALLOCATE with SOURCE

Message ID 20151228165557.304669c8@vepi2
State New
Headers show

Commit Message

Andre Vehreschild Dec. 28, 2015, 3:55 p.m. UTC 
Hi all,

for bug pr69011 I like to propose the attached patch. The patch fixes
the ICE and furthermore makes sure, that for this case of referencing a
polymorphic object the correct vtype is selected. Previously the
declared vtype of the source=-expression was taken for the object(s) to
allocate. Now the actual vtype is taken, i.e., the vptr component of
source='s object is taken. This is important when source references a
subclass.

Bootstrapped and regtested ok on x86_64-pc-linux-gnu/f23.

Ok for trunk?

Regards,
	Andre

Comments

Thomas Koenig Dec. 28, 2015, 5:31 p.m. UTC | #1 
Hi Andre,

> for bug pr69011 I like to propose the attached patch. The patch fixes
> the ICE and furthermore makes sure, that for this case of referencing a
> polymorphic object the correct vtype is selected. Previously the
> declared vtype of the source=-expression was taken for the object(s) to
> allocate. Now the actual vtype is taken, i.e., the vptr component of
> source='s object is taken. This is important when source references a
> subclass.
>
> Bootstrapped and regtested ok on x86_64-pc-linux-gnu/f23.
>
> Ok for trunk?

The patch also solves the original problem.

OK for trunk, and thanks a lot for the patch!


	Thomas
diff mbox

Patch

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 72416d4..3c6fae1 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5377,7 +5377,20 @@  gfc_trans_allocate (gfc_code * code)
 	      if (code->ext.alloc.arr_spec_from_expr3 || code->expr3->rank != 0)
 		gfc_conv_expr_descriptor (&se, code->expr3);
 	      else
-		gfc_conv_expr_reference (&se, code->expr3);
+		{
+		  gfc_conv_expr_reference (&se, code->expr3);
+
+		  /* gfc_conv_expr_reference wraps POINTER_PLUS_EXPR in a
+		     NOP_EXPR, which prevents gfortran from getting the vptr
+		     from the source=-expression.  Remove the NOP_EXPR and go
+		     with the POINTER_PLUS_EXPR in this case.  */
+		  if (code->expr3->ts.type == BT_CLASS
+		      && TREE_CODE (se.expr) == NOP_EXPR
+		      && TREE_CODE (TREE_OPERAND (se.expr, 0))
+							   == POINTER_PLUS_EXPR)
+		      //&& ! GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)))
+		    se.expr = TREE_OPERAND (se.expr, 0);
+		}
 	      /* Create a temp variable only for component refs to prevent
 		 having to go through the full deref-chain each time and to
 		 simplfy computation of array properties.  */
@@ -5494,7 +5507,6 @@  gfc_trans_allocate (gfc_code * code)
 	     expr3 may be a temporary array declaration, therefore check for
 	     GFC_CLASS_TYPE_P before trying to get the _vptr component.  */
 	  if (tmp != NULL_TREE
-	      && TREE_CODE (tmp) != POINTER_PLUS_EXPR
 	      && (e3_is == E3_DESC
 		  || (GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
 		      && (VAR_P (tmp) || !code->expr3->ref))
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_16.f90 b/gcc/testsuite/gfortran.dg/allocate_with_source_16.f90
new file mode 100644
index 0000000..cb5f16f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_16.f90
@@ -0,0 +1,76 @@ 
+! { dg-do run }
+! Test the fix for pr69011, preventing an ICE and making sure
+! that the correct dynamic type is used.
+!
+! Contributed by Thomas Koenig  <tkoenig@gcc.gnu.org>
+!                Andre Vehreschild  <vehre@gcc.gnu.org>
+!
+ 
+module m1
+implicit none
+private
+public :: basetype
+
+type:: basetype
+  integer :: i
+  contains
+endtype basetype
+
+abstract interface
+endinterface
+
+endmodule m1
+
+module m2
+use m1, only : basetype
+implicit none
+integer, parameter :: I_P = 4
+
+private
+public :: factory, exttype
+
+type, extends(basetype) :: exttype
+  integer :: i2
+  contains
+endtype exttype
+
+type :: factory
+  integer(I_P) :: steps=-1 
+  contains
+    procedure, pass(self), public :: construct
+endtype factory
+contains
+
+  function construct(self, previous)
+  class(basetype), intent(INOUT) :: previous(1:)
+  class(factory), intent(IN) :: self
+  class(basetype), pointer :: construct
+  allocate(construct, source=previous(self%steps))
+  endfunction construct
+endmodule m2
+
+  use m2
+  use m1
+  class(factory), allocatable :: c1
+  class(exttype), allocatable :: prev(:)
+  class(basetype), pointer :: d
+
+  allocate(c1)
+  allocate(prev(2))
+  prev(:)%i = [ 2, 3]
+  prev(:)%i2 = [ 5, 6]
+  c1%steps= 1
+  d=> c1%construct(prev)
+
+  if (.not. associated(d) ) call abort()
+  select type (d)
+    class is (exttype)
+      if (d%i2 /= 5) call abort()
+    class default
+      call abort()
+  end select 
+  if (d%i /= 2) call abort()
+  deallocate(c1)
+  deallocate(prev)
+  deallocate(d)
+end