diff mbox

[fortran,pr67451,gcc-5,v1,5/6,Regression] ICE with sourced allocation from coarray

Message ID 20160201133448.36c1115b@vepi2
State New
Headers show

Commit Message

Andre Vehreschild Feb. 1, 2016, 12:34 p.m. UTC 
Oh, well, now with attachments. I am sorry.

- Andre

On Mon, 1 Feb 2016 13:20:24 +0100
Andre Vehreschild <vehre@gmx.de> wrote:

> Hi all,
> 
> here is the backport of the patch for pr67451 for gcc-5. Because the
> structure of the allocate() in trunk is quite different the patch looks
> somewhat different, too, but essentially does the same.
> 
> Bootstrapped and regtests ok on x86_64-linux-gnu/F23.
> 
> Ok for gcc-5-branch?
> 
> Here is the link to the mainline patch:
> https://gcc.gnu.org/ml/fortran/2016-01/msg00093.html
> 
> Regards,
> 	Andre
> 
> On Fri, 29 Jan 2016 19:17:24 +0100
> Andre Vehreschild <vehre@gmx.de> wrote:
> 
> > Hi all,
> > 
> > attached is a patch to fix a regression in current gfortran when a
> > coarray is used in the source=-expression of an allocate(). The ICE was
> > caused by the class information, i.e., _vptr and so on, not at the
> > expected place. The patch fixes this.
> > 
> > The patch also fixes pr69418, which I will flag as a duplicate in a
> > second.
> > 
> > Bootstrapped and regtested ok on x86_64-linux-gnu/F23.
> > 
> > Ok for trunk?
> > 
> > Backport to gcc-5 is pending, albeit more difficult, because the
> > allocate() implementation on 5 is not as advanced the one in 6.
> > 
> > Regards,
> > 	Andre  
> 
>

Comments

Paul Richard Thomas Feb. 2, 2016, 6:44 p.m. UTC | #1 
Hi Andre,

This one looks good too. As every day goes by, I see more and more why
Tobias was so keen to incorporate all objects into a single descriptor
type :-)

OK for 5-branch.

Thanks for both the patches

Paul

On 1 February 2016 at 13:34, Andre Vehreschild <vehre@gmx.de> wrote:
> Oh, well, now with attachments. I am sorry.
>
> - Andre
>
> On Mon, 1 Feb 2016 13:20:24 +0100
> Andre Vehreschild <vehre@gmx.de> wrote:
>
>> Hi all,
>>
>> here is the backport of the patch for pr67451 for gcc-5. Because the
>> structure of the allocate() in trunk is quite different the patch looks
>> somewhat different, too, but essentially does the same.
>>
>> Bootstrapped and regtests ok on x86_64-linux-gnu/F23.
>>
>> Ok for gcc-5-branch?
>>
>> Here is the link to the mainline patch:
>> https://gcc.gnu.org/ml/fortran/2016-01/msg00093.html
>>
>> Regards,
>>       Andre
>>
>> On Fri, 29 Jan 2016 19:17:24 +0100
>> Andre Vehreschild <vehre@gmx.de> wrote:
>>
>> > Hi all,
>> >
>> > attached is a patch to fix a regression in current gfortran when a
>> > coarray is used in the source=-expression of an allocate(). The ICE was
>> > caused by the class information, i.e., _vptr and so on, not at the
>> > expected place. The patch fixes this.
>> >
>> > The patch also fixes pr69418, which I will flag as a duplicate in a
>> > second.
>> >
>> > Bootstrapped and regtested ok on x86_64-linux-gnu/F23.
>> >
>> > Ok for trunk?
>> >
>> > Backport to gcc-5 is pending, albeit more difficult, because the
>> > allocate() implementation on 5 is not as advanced the one in 6.
>> >
>> > Regards,
>> >     Andre
>>
>>
>
>
> --
> Andre Vehreschild * Email: vehre ad gmx dot de
diff mbox

Patch

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 4c368a8..0daa631 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1019,6 +1019,7 @@  gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
   tree fcn;
   tree fcn_type;
   tree from_data;
+  tree from_class_base = NULL;
   tree from_len;
   tree to_data;
   tree to_len;
@@ -1035,21 +1036,41 @@  gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
   from_len = to_len = NULL_TREE;
 
   if (from != NULL_TREE)
-    fcn = gfc_class_vtab_copy_get (from);
+    {
+      /* Check that from is a class.  When the class is part of a coarray,
+	 then from is a common pointer and is to be used as is.  */
+      tmp = POINTER_TYPE_P (TREE_TYPE (from)) && !DECL_P (from)
+	  ? TREE_OPERAND (from, 0) : from;
+      if (GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
+	  || (DECL_P (tmp) && GFC_DECL_CLASS (tmp)))
+	{
+	  from_class_base = from;
+	  from_data = gfc_class_data_get (from_class_base);
+	}
+      else
+	{
+	  /* For arrays two component_refs can be present.  */
+	  if (TREE_CODE (tmp) == COMPONENT_REF)
+	    tmp = TREE_OPERAND (tmp, 0);
+	  if (TREE_CODE (tmp) == COMPONENT_REF)
+	    tmp = TREE_OPERAND (tmp, 0);
+	  from_class_base = tmp;
+	  from_data = from;
+	}
+      fcn = gfc_class_vtab_copy_get (from_class_base);
+    }
   else
-    fcn = gfc_class_vtab_copy_get (to);
+    {
+      fcn = gfc_class_vtab_copy_get (to);
+      from_data = gfc_class_vtab_def_init_get (to);
+    }
 
   fcn_type = TREE_TYPE (TREE_TYPE (fcn));
 
-  if (from != NULL_TREE)
-      from_data = gfc_class_data_get (from);
-  else
-    from_data = gfc_class_vtab_def_init_get (to);
-
   if (unlimited)
     {
-      if (from != NULL_TREE && unlimited)
-	from_len = gfc_class_len_get (from);
+      if (from_class_base != NULL_TREE)
+	from_len = gfc_class_len_get (from_class_base);
       else
 	from_len = integer_zero_node;
     }
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 0be92cd..9c1f920 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5180,7 +5180,7 @@  gfc_trans_allocate (gfc_code * code)
      _vptr, _len and element_size for expr3.  */
   if (code->expr3)
     {
-      bool vtab_needed = false;
+      bool vtab_needed = false, is_coarray = gfc_is_coarray (code->expr3);
       /* expr3_tmp gets the tree when code->expr3.mold is set, i.e.,
 	 the expression is only needed to get the _vptr, _len a.s.o.  */
       tree expr3_tmp = NULL_TREE;
@@ -5245,7 +5245,8 @@  gfc_trans_allocate (gfc_code * code)
 		{
 		  tree var;
 
-		  tmp = build_fold_indirect_ref_loc (input_location,
+		  tmp = is_coarray ? se.expr
+				  : build_fold_indirect_ref_loc (input_location,
 						     se.expr);
 
 		  /* We need a regular (non-UID) symbol here, therefore give a
@@ -5297,6 +5298,16 @@  gfc_trans_allocate (gfc_code * code)
 	  else if (expr3_tmp != NULL_TREE
 		   && (VAR_P (expr3_tmp) ||!code->expr3->ref))
 	    tmp = gfc_class_vptr_get (expr3_tmp);
+	  else if (is_coarray && expr3 != NULL_TREE)
+	    {
+	      /* Get the ref to coarray's data.  May be wrapped in a
+		 NOP_EXPR.  */
+	      tmp = POINTER_TYPE_P (TREE_TYPE (expr3)) ? TREE_OPERAND (expr3, 0)
+						       : tmp;
+	      /* Get to the base variable, i.e., strip _data.data.  */
+	      tmp = TREE_OPERAND (TREE_OPERAND (tmp, 0), 0);
+	      tmp = gfc_class_vptr_get (tmp);
+	    }
 	  else
 	    {
 	      rhs = gfc_find_and_cut_at_last_class_ref (code->expr3);
diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_2.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_2.f08
new file mode 100644
index 0000000..7a712a9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_allocate_2.f08
@@ -0,0 +1,26 @@ 
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Contributed by Ian Harvey  <ian_harvey@bigpond.com>
+! Extended by Andre Vehreschild  <vehre@gcc.gnu.org>
+! to test that coarray references in allocate work now
+! PR fortran/67451
+
+  program main
+    implicit none
+    type foo
+      integer :: bar = 99
+    end type
+    class(foo), allocatable :: foobar[:]
+    class(foo), allocatable :: some_local_object
+    allocate(foobar[*])
+
+    allocate(some_local_object, source=foobar)
+
+    if (.not. allocated(foobar)) call abort()
+    if (.not. allocated(some_local_object)) call abort()
+
+    deallocate(some_local_object)
+    deallocate(foobar)
+  end program
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_3.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_3.f08
new file mode 100644
index 0000000..b9413b6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_allocate_3.f08
@@ -0,0 +1,28 @@ 
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Contributed by Ian Harvey  <ian_harvey@bigpond.com>
+! Extended by Andre Vehreschild  <vehre@gcc.gnu.org>
+! to test that coarray references in allocate work now
+! PR fortran/67451
+
+  program main
+    implicit none
+    type foo
+      integer :: bar = 99
+    end type
+    class(foo), dimension(:), allocatable :: foobar[:]
+    class(foo), dimension(:), allocatable :: some_local_object
+    allocate(foobar(10)[*])
+
+    allocate(some_local_object(10), source=foobar)
+
+    if (.not. allocated(foobar)) call abort()
+    if (lbound(foobar, 1) /= 1 .OR. ubound(foobar, 1) /= 10) call abort()
+    if (.not. allocated(some_local_object)) call abort()
+    if (any(some_local_object(:)%bar /= [99, 99,  99, 99, 99, 99, 99, 99, 99, 99])) call abort()
+
+    deallocate(some_local_object)
+    deallocate(foobar)
+  end program
+
diff --git a/gcc/testsuite/gfortran.dg/coarray_allocate_4.f08 b/gcc/testsuite/gfortran.dg/coarray_allocate_4.f08
new file mode 100644
index 0000000..a36d796
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_allocate_4.f08
@@ -0,0 +1,43 @@ 
+! { dg-do run }
+! { dg-options "-fcoarray=single" }
+!
+! Contributed by Gerhard Steinmetz  <gerhard.steinmetz.fortran@t-online.de>
+!               Andre Vehreschild <vehre@gcc.gnu.org>
+! Check that PR fortran/69451 is fixed.
+
+program main
+
+implicit none
+
+type foo
+end type
+
+class(foo), allocatable :: p[:]
+class(foo), pointer :: r
+class(*), allocatable, target :: z
+
+allocate(p[*])
+
+call s(p, z)
+select type (z)
+  class is (foo) 
+        r => z
+  class default
+     call abort()
+end select
+
+if (.not. associated(r)) call abort()
+
+deallocate(r)
+deallocate(p)
+
+contains
+
+subroutine s(x, z) 
+   class(*) :: x[*]
+   class(*), allocatable:: z
+   allocate (z, source=x)
+end
+
+end
+