From: Andre Vehreschild <vehre@gmx.de>
To: Paul Richard Thomas <paul.richard.thomas@gmail.com>
Cc: "Dominique d'Humières" <dominiq@lps.ens.fr>,
gcc-patches <gcc-patches@gcc.gnu.org>,
"Mikael Morin" <mikael.morin@sfr.fr>,
"GNU GFortran" <fortran@gcc.gnu.org>
Subject: Re: [Patch, Fortran, 66927, v2] [6 Regression] ICE in gfc_conf_procedure_call
Date: Sun, 25 Oct 2015 12:31:00 -0000 [thread overview]
Message-ID: <20151025133102.2aa5ebd6@vepi2> (raw)
In-Reply-To: <CAGkQGiJXs31p+hriTEGoUfpurGX7a9ceOeBb=bArLi6qSnwmow@mail.gmail.com>
[-- Attachment #1: Type: text/plain, Size: 1718 bytes --]
Hi Paul, hi all,
thanks for the review. Submitted as r229294.
Regards,
Andre
On Sun, 25 Oct 2015 08:43:24 +0100
Paul Richard Thomas <paul.richard.thomas@gmail.com> wrote:
> Dear Andre,
>
> As far as I can see, the problems with PR57117 are specific to RESHAPE
> and need not affect committing your patch. To my surprise, the
> combination of your patch and mine for PR67171 fixes PR67044 in that
> the ICE no longer occurs. I have to get my head around how to write a
> testcase for it that tests the functionality though!
>
> You can commit this patch to trunk. As I said elsewhere, I will rename
> the testcase for PR67171.
>
> Many thanks for the patch.
>
> Paul
>
> On 23 October 2015 at 09:44, Paul Richard Thomas
> <paul.richard.thomas@gmail.com> wrote:
> > Dear Andre,
> >
> > I will wait until you fix the problems that Dominique has pointed out.
> > However, if by Sunday afternoon (rain forecast!) you haven't found the
> > time, I will see if I can locate the source of these new problems.
> >
> > With best regards
> >
> > Paul
> >
> > On 7 October 2015 at 19:51, Dominique d'Humières <dominiq@lps.ens.fr> wrote:
> >> This patch also fixes pr57117 comment 2, the original test and the test in comment 3 now give an ICE
> >>
> >> pr57117.f90:82:0:
> >>
> >> allocate(z(9), source=reshape(x, (/ 9 /)))
> >> 1
> >> internal compiler error: Segmentation fault: 11
> >>
> >> and pr67044.
> >>
> >> Thanks,
> >>
> >> Dominique
> >>
> >
> >
> >
> > --
> > Outside of a dog, a book is a man's best friend. Inside of a dog it's
> > too dark to read.
> >
> > Groucho Marx
>
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 12979 bytes --]
Index: gcc/fortran/trans.h
===================================================================
--- gcc/fortran/trans.h (Revision 229293)
+++ gcc/fortran/trans.h (Arbeitskopie)
@@ -378,7 +378,7 @@
void gfc_reset_vptr (stmtblock_t *, gfc_expr *);
void gfc_reset_len (stmtblock_t *, gfc_expr *);
tree gfc_get_vptr_from_expr (tree);
-tree gfc_get_class_array_ref (tree, tree);
+tree gfc_get_class_array_ref (tree, tree, tree);
tree gfc_copy_class_to_class (tree, tree, tree, bool);
bool gfc_add_finalizer_call (stmtblock_t *, gfc_expr *);
bool gfc_add_comp_finalizer_call (stmtblock_t *, tree, gfc_component *, bool);
Index: gcc/fortran/trans-array.c
===================================================================
--- gcc/fortran/trans-array.c (Revision 229293)
+++ gcc/fortran/trans-array.c (Arbeitskopie)
@@ -3250,7 +3250,7 @@
{
type = gfc_get_element_type (type);
tmp = TREE_OPERAND (cdecl, 0);
- tmp = gfc_get_class_array_ref (offset, tmp);
+ tmp = gfc_get_class_array_ref (offset, tmp, NULL_TREE);
tmp = fold_convert (build_pointer_type (type), tmp);
tmp = build_fold_indirect_ref_loc (input_location, tmp);
return tmp;
@@ -7107,9 +7107,20 @@
}
else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)) || se->use_offset)
{
+ bool toonebased;
tmp = gfc_conv_array_lbound (desc, n);
+ toonebased = integer_onep (tmp);
+ // lb(arr) - from (- start + 1)
tmp = fold_build2_loc (input_location, MINUS_EXPR,
TREE_TYPE (base), tmp, from);
+ if (onebased && toonebased)
+ {
+ tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ TREE_TYPE (base), tmp, start);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ TREE_TYPE (base), tmp,
+ gfc_index_one_node);
+ }
tmp = fold_build2_loc (input_location, MULT_EXPR,
TREE_TYPE (base), tmp,
gfc_conv_array_stride (desc, n));
@@ -7183,12 +7194,13 @@
/* For class arrays add the class tree into the saved descriptor to
enable getting of _vptr and the like. */
if (expr->expr_type == EXPR_VARIABLE && VAR_P (desc)
- && IS_CLASS_ARRAY (expr->symtree->n.sym)
- && DECL_LANG_SPECIFIC (expr->symtree->n.sym->backend_decl))
+ && IS_CLASS_ARRAY (expr->symtree->n.sym))
{
gfc_allocate_lang_decl (desc);
GFC_DECL_SAVED_DESCRIPTOR (desc) =
- GFC_DECL_SAVED_DESCRIPTOR (expr->symtree->n.sym->backend_decl);
+ DECL_LANG_SPECIFIC (expr->symtree->n.sym->backend_decl) ?
+ GFC_DECL_SAVED_DESCRIPTOR (expr->symtree->n.sym->backend_decl)
+ : expr->symtree->n.sym->backend_decl;
}
if (!se->direct_byref || se->byref_noassign)
{
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 229293)
+++ gcc/fortran/trans-expr.c (Arbeitskopie)
@@ -1039,9 +1039,10 @@
of the referenced element. */
tree
-gfc_get_class_array_ref (tree index, tree class_decl)
+gfc_get_class_array_ref (tree index, tree class_decl, tree data_comp)
{
- tree data = gfc_class_data_get (class_decl);
+ tree data = data_comp != NULL_TREE ? data_comp :
+ gfc_class_data_get (class_decl);
tree size = gfc_class_vtab_size_get (class_decl);
tree offset = fold_build2_loc (input_location, MULT_EXPR,
gfc_array_index_type,
@@ -1075,6 +1076,7 @@
tree stdcopy;
tree extcopy;
tree index;
+ bool is_from_desc = false, is_to_class = false;
args = NULL;
/* To prevent warnings on uninitialized variables. */
@@ -1088,7 +1090,19 @@
fcn_type = TREE_TYPE (TREE_TYPE (fcn));
if (from != NULL_TREE)
- from_data = gfc_class_data_get (from);
+ {
+ is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from));
+ if (is_from_desc)
+ {
+ from_data = from;
+ from = GFC_DECL_SAVED_DESCRIPTOR (from);
+ }
+ else
+ {
+ from_data = gfc_class_data_get (from);
+ is_from_desc = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data));
+ }
+ }
else
from_data = gfc_class_vtab_def_init_get (to);
@@ -1100,9 +1114,16 @@
from_len = integer_zero_node;
}
- to_data = gfc_class_data_get (to);
- if (unlimited)
- to_len = gfc_class_len_get (to);
+ if (GFC_CLASS_TYPE_P (TREE_TYPE (to)))
+ {
+ is_to_class = true;
+ to_data = gfc_class_data_get (to);
+ if (unlimited)
+ to_len = gfc_class_len_get (to);
+ }
+ else
+ /* When to is a BT_DERIVED and not a BT_CLASS, then to_data == to. */
+ to_data = to;
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (to_data)))
{
@@ -1118,15 +1139,23 @@
nelems = gfc_evaluate_now (tmp, &body);
index = gfc_create_var (gfc_array_index_type, "S");
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data)))
+ if (is_from_desc)
{
- from_ref = gfc_get_class_array_ref (index, from);
+ from_ref = gfc_get_class_array_ref (index, from, from_data);
vec_safe_push (args, from_ref);
}
else
vec_safe_push (args, from_data);
- to_ref = gfc_get_class_array_ref (index, to);
+ if (is_to_class)
+ to_ref = gfc_get_class_array_ref (index, to, to_data);
+ else
+ {
+ tmp = gfc_conv_array_data (to);
+ tmp = build_fold_indirect_ref_loc (input_location, tmp);
+ to_ref = gfc_build_addr_expr (NULL_TREE,
+ gfc_build_array_ref (tmp, index, to));
+ }
vec_safe_push (args, to_ref);
tmp = build_call_vec (fcn_type, fcn, args);
@@ -1183,7 +1212,7 @@
}
else
{
- gcc_assert (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (from_data)));
+ gcc_assert (!is_from_desc);
vec_safe_push (args, from_data);
vec_safe_push (args, to_data);
stdcopy = build_call_vec (fcn_type, fcn, args);
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 229293)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,20 @@
+2015-10-25 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ PR fortran/66927
+ PR fortran/67044
+ * trans-array.c (build_array_ref): Modified call to
+ gfc_get_class_array_ref to adhere to new interface.
+ (gfc_conv_expr_descriptor): For one-based arrays that
+ are filled by a loop starting at one the start index of the
+ source array has to be mangled into the offset.
+ * trans-expr.c (gfc_get_class_array_ref): When the tree to get
+ the _data component is present already, add a way to supply it.
+ (gfc_copy_class_to_class): Allow to copy to a derived type also.
+ * trans-stmt.c (gfc_trans_allocate): Do not conv_expr_descriptor
+ for functions returning a class or derived object. Get the
+ reference instead.
+ * trans.h: Interface change of gfc_get_class_array_ref.
+
2015-10-24 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/68055
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (Revision 229293)
+++ gcc/fortran/trans-stmt.c (Arbeitskopie)
@@ -5186,9 +5186,16 @@
/* In all other cases evaluate the expr3. */
symbol_attribute attr;
/* Get the descriptor for all arrays, that are not allocatable or
- pointer, because the latter are descriptors already. */
+ pointer, because the latter are descriptors already.
+ The exception are function calls returning a class object:
+ The descriptor is stored in their results _data component, which
+ is easier to access, when first a temporary variable for the
+ result is created and the descriptor retrieved from there. */
attr = gfc_expr_attr (code->expr3);
- if (code->expr3->rank != 0 && !attr.allocatable && !attr.pointer)
+ if (code->expr3->rank != 0
+ && ((!attr.allocatable && !attr.pointer)
+ || (code->expr3->expr_type == EXPR_FUNCTION
+ && code->expr3->ts.type != BT_CLASS)))
gfc_conv_expr_descriptor (&se, code->expr3);
else
gfc_conv_expr_reference (&se, code->expr3);
@@ -5205,17 +5212,40 @@
variable declaration. */
if (se.expr != NULL_TREE && temp_var_needed)
{
- tree var;
+ tree var, desc;
tmp = GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)) ?
se.expr
: build_fold_indirect_ref_loc (input_location, se.expr);
+
+ /* Get the array descriptor and prepare it to be assigned to the
+ temporary variable var. For classes the array descriptor is
+ in the _data component and the object goes into the
+ GFC_DECL_SAVED_DESCRIPTOR. */
+ if (code->expr3->ts.type == BT_CLASS
+ && code->expr3->rank != 0)
+ {
+ /* When an array_ref was in expr3, then the descriptor is the
+ first operand. */
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
+ {
+ desc = TREE_OPERAND (tmp, 0);
+ }
+ else
+ {
+ desc = tmp;
+ tmp = gfc_class_data_get (tmp);
+ }
+ e3_is = E3_DESC;
+ }
+ else
+ desc = se.expr;
/* 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 (se.expr)))
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp)))
{
gfc_allocate_lang_decl (var);
- GFC_DECL_SAVED_DESCRIPTOR (var) = se.expr;
+ GFC_DECL_SAVED_DESCRIPTOR (var) = desc;
}
gfc_add_modify_loc (input_location, &block, var, tmp);
@@ -5241,11 +5271,12 @@
expr3_len = se.string_length;
}
/* Store what the expr3 is to be used for. */
- e3_is = expr3 != NULL_TREE ?
- (code->ext.alloc.arr_spec_from_expr3 ?
- E3_DESC
- : (code->expr3->mold ? E3_MOLD : E3_SOURCE))
- : E3_UNSET;
+ if (e3_is == E3_UNSET)
+ e3_is = expr3 != NULL_TREE ?
+ (code->ext.alloc.arr_spec_from_expr3 ?
+ E3_DESC
+ : (code->expr3->mold ? E3_MOLD : E3_SOURCE))
+ : E3_UNSET;
/* Figure how to get the _vtab entry. This also obtains the tree
expression for accessing the _len component, because only
@@ -5254,11 +5285,17 @@
if (code->expr3->ts.type == BT_CLASS)
{
gfc_expr *rhs;
+ tmp = expr3 != NULL_TREE && POINTER_TYPE_P (TREE_TYPE (expr3)) ?
+ build_fold_indirect_ref (expr3): expr3;
/* Polymorphic SOURCE: VPTR must be determined at run time.
expr3 may be a temporary array declaration, therefore check for
GFC_CLASS_TYPE_P before trying to get the _vptr component. */
- if (expr3 != NULL_TREE && GFC_CLASS_TYPE_P (TREE_TYPE (expr3))
- && (VAR_P (expr3) || !code->expr3->ref))
+ 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))
+ || (VAR_P (tmp) && DECL_LANG_SPECIFIC (tmp))))
tmp = gfc_class_vptr_get (expr3);
else
{
@@ -5709,10 +5746,7 @@
/* Initialization via SOURCE block (or static default initializer).
Classes need some special handling, so catch them first. */
if (expr3 != NULL_TREE
- && ((POINTER_TYPE_P (TREE_TYPE (expr3))
- && TREE_CODE (expr3) != POINTER_PLUS_EXPR)
- || (VAR_P (expr3) && GFC_CLASS_TYPE_P (
- TREE_TYPE (expr3))))
+ && TREE_CODE (expr3) != POINTER_PLUS_EXPR
&& code->expr3->ts.type == BT_CLASS
&& (expr->ts.type == BT_CLASS
|| expr->ts.type == BT_DERIVED))
@@ -5731,7 +5765,7 @@
gfc_expr *ppc;
gfc_code *ppc_code;
gfc_ref *ref, *dataref;
- gfc_expr *rhs = gfc_copy_expr (code->expr3);
+ gfc_expr *rhs = e3rhs ? e3rhs : gfc_copy_expr (code->expr3);
/* Do a polymorphic deep copy. */
actual = gfc_get_actual_arglist ();
@@ -5827,7 +5861,8 @@
void_type_node, tmp, extcopy, stdcopy);
}
gfc_free_statements (ppc_code);
- gfc_free_expr (rhs);
+ if (rhs != e3rhs)
+ gfc_free_expr (rhs);
}
else
{
Index: gcc/testsuite/gfortran.dg/class_array_15.f03
===================================================================
--- gcc/testsuite/gfortran.dg/class_array_15.f03 (Revision 229293)
+++ gcc/testsuite/gfortran.dg/class_array_15.f03 (Arbeitskopie)
@@ -115,4 +115,4 @@
bh => bhGet(b,instance=2)
if (loc (b) .ne. loc(bh%hostNode)) call abort
end
-! { dg-final { scan-tree-dump-times "builtin_free" 12 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_free" 11 "original" } }
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (Revision 229293)
+++ gcc/testsuite/ChangeLog (Arbeitskopie)
@@ -1,3 +1,13 @@
+2015-10-25 Andre Vehreschild <vehre@gmx.de>
+
+ PR fortran/66927
+ PR fortran/67044
+ * gfortran.dg/allocate_with_source_10.f08: New test.
+ * gfortran.dg/allocate_with_source_11.f08: New test.
+ * gfortran.dg/class_array_15.f03: Changed count of expected
+ _builtin_frees to 11. One step of temporaries is spared, therefore
+ the allocatable component of that temporary is not to be freeed.
+
2015-10-24 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/68055
next prev parent reply other threads:[~2015-10-25 12:31 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
2015-10-25 7:43 Paul Richard Thomas
2015-10-25 12:31 ` Andre Vehreschild [this message]
2015-10-26 10:03 ` [Patch, Fortran, 66927, v2.1] " Andre Vehreschild
2015-10-26 12:04 ` Paul Richard Thomas
2015-10-26 13:04 ` Andre Vehreschild
-- strict thread matches above, loose matches on Subject: below --
2015-10-07 17:51 [Patch, Fortran, 66927, v2] " Dominique d'Humières
2015-10-23 7:45 ` Paul Richard Thomas
2015-10-23 7:48 ` Andre Vehreschild
2015-08-06 10:53 [Patch, Fortran, 66927, v1] " Andre Vehreschild
2015-08-06 12:01 ` Mikael Morin
2015-08-09 12:37 ` Mikael Morin
2015-09-29 13:59 ` [Patch, Fortran, 66927, v2] " Andre Vehreschild
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=20151025133102.2aa5ebd6@vepi2 \
--to=vehre@gmx.de \
--cc=dominiq@lps.ens.fr \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
--cc=mikael.morin@sfr.fr \
--cc=paul.richard.thomas@gmail.com \
/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).