From: Andre Vehreschild <vehre@gmx.de>
To: GCC-Patches-ML <gcc-patches@gcc.gnu.org>,
GCC-Fortran-ML <fortran@gcc.gnu.org>
Subject: [Patch, fortran, pr67451, v1] [5/6 Regression] ICE with sourced allocation from coarray
Date: Fri, 29 Jan 2016 18:17:00 -0000 [thread overview]
Message-ID: <20160129191724.2eb47e1b@vepi2> (raw)
[-- Attachment #1: Type: text/plain, Size: 600 bytes --]
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
[-- Attachment #2: pr67451_1.patch --]
[-- Type: text/x-patch, Size: 6147 bytes --]
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index c5ae4c5..8f63d34 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1103,7 +1103,14 @@ gfc_copy_class_to_class (tree from, tree to, tree nelems, bool unlimited)
}
else
{
- from_data = gfc_class_data_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))
+ ? build_fold_indirect_ref (from) : from;
+ from_data =
+ (GFC_CLASS_TYPE_P (TREE_TYPE (tmp))
+ || (DECL_P (tmp) && GFC_DECL_CLASS (tmp)))
+ ? gfc_class_data_get (from) : from;
is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data));
}
}
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 310d2cd..5143c31 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5358,7 +5358,8 @@ gfc_trans_allocate (gfc_code * code)
expression. */
if (code->expr3)
{
- bool vtab_needed = false, temp_var_needed = false;
+ bool vtab_needed = false, temp_var_needed = false,
+ is_coarray = gfc_is_coarray (code->expr3);
/* Figure whether we need the vtab from expr3. */
for (al = code->ext.alloc.list; !vtab_needed && al != NULL;
@@ -5392,9 +5393,9 @@ gfc_trans_allocate (gfc_code * code)
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)))
+ && (TREE_CODE (TREE_OPERAND (se.expr, 0))
+ == POINTER_PLUS_EXPR
+ || is_coarray))
se.expr = TREE_OPERAND (se.expr, 0);
}
/* Create a temp variable only for component refs to prevent
@@ -5435,7 +5436,7 @@ gfc_trans_allocate (gfc_code * code)
if (se.expr != NULL_TREE && temp_var_needed)
{
tree var, desc;
- tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) ?
+ tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) || is_coarray ?
se.expr
: build_fold_indirect_ref_loc (input_location, se.expr);
@@ -5448,7 +5449,7 @@ gfc_trans_allocate (gfc_code * code)
{
/* When an array_ref was in expr3, then the descriptor is the
first operand. */
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)) || is_coarray)
{
desc = TREE_OPERAND (tmp, 0);
}
@@ -5460,11 +5461,12 @@ gfc_trans_allocate (gfc_code * code)
e3_is = E3_DESC;
}
else
- desc = se.expr;
+ desc = !is_coarray ? se.expr
+ : TREE_OPERAND (TREE_OPERAND (se.expr, 0), 0);
/* We need a regular (non-UID) symbol here, therefore give a
prefix. */
var = gfc_create_var (TREE_TYPE (tmp), "source");
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)) || is_coarray)
{
gfc_allocate_lang_decl (var);
GFC_DECL_SAVED_DESCRIPTOR (var) = desc;
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..46f34c0
--- /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, 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
+
[-- Attachment #3: pr67451_1.txt --]
[-- Type: text/plain, Size: 618 bytes --]
gcc/testsuite/ChangeLog:
2016-01-29 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/67451
PR fortran/69418
* gfortran.dg/coarray_allocate_2.f08: New test.
* gfortran.dg/coarray_allocate_3.f08: New test.
* gfortran.dg/coarray_allocate_4.f08: New test.
gcc/fortran/ChangeLog:
2016-01-29 Andre Vehreschild <vehre@gcc.gnu.org>
PR fortran/67451
PR fortran/69418
* trans-expr.c (gfc_copy_class_to_class): For coarrays just the
pointer is passed. Take it as is without trying to deref the
_data component.
* trans-stmt.c (gfc_trans_allocate): Take care of coarrays as
argument to source=-expression.
next reply other threads:[~2016-01-29 18:17 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
2016-01-29 18:17 Andre Vehreschild [this message]
2016-02-01 12:20 ` [Patch, fortran, pr67451, gcc-5, " Andre Vehreschild
2016-02-01 12:35 ` Andre Vehreschild
2016-02-02 18:44 ` Paul Richard Thomas
2016-02-03 10:39 ` Andre Vehreschild
2016-02-02 18:24 ` [Patch, fortran, pr67451, " Paul Richard Thomas
2016-02-10 11:26 ` Andre Vehreschild
2016-02-17 9:17 ` [PING, Patch, " Andre Vehreschild
2016-02-17 13:13 ` [Patch, " Paul Richard Thomas
2016-02-23 10:30 ` Andre Vehreschild
2016-02-10 16:48 Dominique d'Humières
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20160129191724.2eb47e1b@vepi2 \
--to=vehre@gmx.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).