Hi all,
thanks for the input and reviews. I have committed this patch as r243647.
Regards,
Andre
On Sun, 11 Dec 2016 15:49:33 +0100
Paul Richard Thomas <paul.richard.tho...@gmail.com> wrote:
> Hi Andre,
>
> Thanks for doing this work with the instrumented compiler. It was a
> great help with PR78350.
>
> As for the patch - OK for trunk.
>
> Paul
>
> On 11 December 2016 at 14:01, Andre Vehreschild <ve...@gmx.de> wrote:
> > Hi Mikael, hi Jerry, hi Steve, hi Jane, hi Thomas, hi Paul, hi all,
> >
> > thanks for all the input you gave on the patch I have present. I tried to
> > address all of it in the new version of the patch attached.
> >
> > Mikael: data.c::create_character_initializer()
> > I have remove the test for rvalue->value.character.string and went to
> > gfc_assign_data_value () line 483 to prevent calling the routine when
> > rvalue is not an EXPR_CONSTANT (third chunk of the patch).
> >
> > interface.c::compare_actual_formal()
> > I have reverted the change to look at actual_arr_ref when looking for
> > assumed size arrays which are dummy argument arrays. That chunk (#5) is now
> > only additionally checking whether f.sym is really of type BT_CHARACTER
> > before accessing its ts.u.cl.lenght.
> >
> > For the second occurrence of actual_arr_ref I have extended
> > gfc_find_array_ref() with a flag to pass the search when no array ref is
> > found (Chunks #1, 2 and 6).
> >
> > Jerry: trans-expr.c::gfc_conv_cst_int_power()
> > I have added comment to new C++ code. Would you like to add something to it?
> >
> > The updated patch bootstraps and regtests fine on x86_64-linux/f23 on a
> > regular and on an instrumented gfortran. How do you like this patch?
> >
> > Regards,
> > Andre
> > --
> > Andre Vehreschild * Email: vehre ad gmx dot de
>
>
>
--
Andre Vehreschild * Email: vehre ad gmx dot de
Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog (Revision 243646)
+++ gcc/fortran/ChangeLog (Arbeitskopie)
@@ -1,3 +1,22 @@
+2016-12-14 Andre Vehreschild <ve...@gcc.gnu.org>
+
+ PR fortran/78672
+ * array.c (gfc_find_array_ref): Add flag to return NULL when no ref is
+ found instead of erroring out.
+ * data.c (gfc_assign_data_value): Only constant expressions are valid
+ for initializers.
+ * gfortran.h: Reflect change of gfc_find_array_ref's signature.
+ * interface.c (compare_actual_formal): Access the non-elemental
+ array-ref. Prevent taking a REF_COMPONENT for a REF_ARRAY. Correct
+ indentation.
+ * module.c (load_omp_udrs): Clear typespec before reading into it.
+ * trans-decl.c (gfc_build_qualified_array): Prevent accessing the array
+ when it is a coarray.
+ * trans-expr.c (gfc_conv_cst_int_power): Use wi::abs()-function instead
+ of crutch preventing sanitizer's bickering here.
+ * trans-stmt.c (gfc_trans_deallocate): Only get data-component when it
+ is a descriptor-array here.
+
2016-12-13 Janus Weil <ja...@gcc.gnu.org>
PR fortran/78798
Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c (Revision 243646)
+++ gcc/fortran/array.c (Arbeitskopie)
@@ -2563,7 +2563,7 @@
characterizes the reference. */
gfc_array_ref *
-gfc_find_array_ref (gfc_expr *e)
+gfc_find_array_ref (gfc_expr *e, bool allow_null)
{
gfc_ref *ref;
@@ -2573,7 +2573,12 @@
break;
if (ref == NULL)
- gfc_internal_error ("gfc_find_array_ref(): No ref found");
+ {
+ if (allow_null)
+ return NULL;
+ else
+ gfc_internal_error ("gfc_find_array_ref(): No ref found");
+ }
return &ref->u.ar;
}
Index: gcc/fortran/data.c
===================================================================
--- gcc/fortran/data.c (Revision 243646)
+++ gcc/fortran/data.c (Arbeitskopie)
@@ -483,7 +483,10 @@
if (ref || last_ts->type == BT_CHARACTER)
{
- if (lvalue->ts.u.cl->length == NULL && !(ref && ref->u.ss.length != NULL))
+ /* An initializer has to be constant. */
+ if (rvalue->expr_type != EXPR_CONSTANT
+ || (lvalue->ts.u.cl->length == NULL
+ && !(ref && ref->u.ss.length != NULL)))
return false;
expr = create_character_initializer (init, last_ts, ref, rvalue);
}
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (Revision 243646)
+++ gcc/fortran/gfortran.h (Arbeitskopie)
@@ -3214,7 +3214,7 @@
bool gfc_array_size (gfc_expr *, mpz_t *);
bool gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
bool gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
-gfc_array_ref *gfc_find_array_ref (gfc_expr *);
+gfc_array_ref *gfc_find_array_ref (gfc_expr *, bool a = false);
tree gfc_conv_array_initializer (tree type, gfc_expr *);
bool spec_size (gfc_array_spec *, mpz_t *);
bool spec_dimen_size (gfc_array_spec *, int, mpz_t *);
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c (Revision 243646)
+++ gcc/fortran/interface.c (Arbeitskopie)
@@ -2803,6 +2803,7 @@
int i, n, na;
unsigned long actual_size, formal_size;
bool full_array = false;
+ gfc_array_ref *actual_arr_ref;
actual = *ap;
@@ -2942,37 +2943,38 @@
and assumed-shape dummies, the string length needs to match
exactly. */
if (a->expr->ts.type == BT_CHARACTER
- && a->expr->ts.u.cl && a->expr->ts.u.cl->length
- && a->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT
- && f->sym->ts.u.cl && f->sym->ts.u.cl && f->sym->ts.u.cl->length
- && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
- && (f->sym->attr.pointer || f->sym->attr.allocatable
- || (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
- && (mpz_cmp (a->expr->ts.u.cl->length->value.integer,
- f->sym->ts.u.cl->length->value.integer) != 0))
- {
- if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
- gfc_warning (OPT_Wargument_mismatch,
- "Character length mismatch (%ld/%ld) between actual "
- "argument and pointer or allocatable dummy argument "
- "%qs at %L",
- mpz_get_si (a->expr->ts.u.cl->length->value.integer),
- mpz_get_si (f->sym->ts.u.cl->length->value.integer),
- f->sym->name, &a->expr->where);
- else if (where)
- gfc_warning (OPT_Wargument_mismatch,
- "Character length mismatch (%ld/%ld) between actual "
- "argument and assumed-shape dummy argument %qs "
- "at %L",
- mpz_get_si (a->expr->ts.u.cl->length->value.integer),
- mpz_get_si (f->sym->ts.u.cl->length->value.integer),
- f->sym->name, &a->expr->where);
- return 0;
- }
+ && a->expr->ts.u.cl && a->expr->ts.u.cl->length
+ && a->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT
+ && f->sym->ts.type == BT_CHARACTER && f->sym->ts.u.cl
+ && f->sym->ts.u.cl->length
+ && f->sym->ts.u.cl->length->expr_type == EXPR_CONSTANT
+ && (f->sym->attr.pointer || f->sym->attr.allocatable
+ || (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
+ && (mpz_cmp (a->expr->ts.u.cl->length->value.integer,
+ f->sym->ts.u.cl->length->value.integer) != 0))
+ {
+ if (where && (f->sym->attr.pointer || f->sym->attr.allocatable))
+ gfc_warning (OPT_Wargument_mismatch,
+ "Character length mismatch (%ld/%ld) between actual "
+ "argument and pointer or allocatable dummy argument "
+ "%qs at %L",
+ mpz_get_si (a->expr->ts.u.cl->length->value.integer),
+ mpz_get_si (f->sym->ts.u.cl->length->value.integer),
+ f->sym->name, &a->expr->where);
+ else if (where)
+ gfc_warning (OPT_Wargument_mismatch,
+ "Character length mismatch (%ld/%ld) between actual "
+ "argument and assumed-shape dummy argument %qs "
+ "at %L",
+ mpz_get_si (a->expr->ts.u.cl->length->value.integer),
+ mpz_get_si (f->sym->ts.u.cl->length->value.integer),
+ f->sym->name, &a->expr->where);
+ return 0;
+ }
if ((f->sym->attr.pointer || f->sym->attr.allocatable)
- && f->sym->ts.deferred != a->expr->ts.deferred
- && a->expr->ts.type == BT_CHARACTER)
+ && f->sym->ts.deferred != a->expr->ts.deferred
+ && a->expr->ts.type == BT_CHARACTER)
{
if (where)
gfc_error ("Actual argument at %L to allocatable or "
@@ -3195,8 +3197,13 @@
return 0;
}
+ /* Find the last array_ref. */
+ actual_arr_ref = NULL;
+ if (a->expr->ref)
+ actual_arr_ref = gfc_find_array_ref (a->expr, true);
+
if (f->sym->attr.volatile_
- && a->expr->ref && a->expr->ref->u.ar.type == AR_SECTION
+ && actual_arr_ref && actual_arr_ref->type == AR_SECTION
&& !(f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE))
{
if (where)
@@ -3203,7 +3210,7 @@
gfc_error ("Array-section actual argument at %L is "
"incompatible with the non-assumed-shape "
"dummy argument %qs due to VOLATILE attribute",
- &a->expr->where,f->sym->name);
+ &a->expr->where, f->sym->name);
return 0;
}
Index: gcc/fortran/module.c
===================================================================
--- gcc/fortran/module.c (Revision 243646)
+++ gcc/fortran/module.c (Arbeitskopie)
@@ -4710,6 +4710,7 @@
mio_lparen ();
mio_pool_string (&name);
+ gfc_clear_ts (&ts);
mio_typespec (&ts);
if (strncmp (name, "operator ", sizeof ("operator ") - 1) == 0)
{
Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (Revision 243646)
+++ gcc/fortran/trans-decl.c (Arbeitskopie)
@@ -1053,7 +1053,7 @@
layout_type (type);
}
- if (TYPE_NAME (type) != NULL_TREE
+ if (TYPE_NAME (type) != NULL_TREE && as->rank > 0
&& GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1) != NULL_TREE
&& VAR_P (GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1)))
{
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (Revision 243646)
+++ gcc/fortran/trans-expr.c (Arbeitskopie)
@@ -2864,9 +2864,9 @@
return 0;
m = wrhs.to_shwi ();
- /* There's no ABS for HOST_WIDE_INT, so here we go. It also takes care
- of the asymmetric range of the integer type. */
- n = (unsigned HOST_WIDE_INT) (m < 0 ? -m : m);
+ /* Use the wide_int's routine to reliably get the absolute value on all
+ platforms. Then convert it to a HOST_WIDE_INT like above. */
+ n = wi::abs (wrhs).to_shwi ();
type = TREE_TYPE (lhs);
sgn = tree_int_cst_sgn (rhs);
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (Revision 243646)
+++ gcc/fortran/trans-stmt.c (Arbeitskopie)
@@ -6483,7 +6483,8 @@
&& !(!last && expr->symtree->n.sym->attr.pointer))
{
if (is_coarray && expr->rank == 0
- && (!last || !last->u.c.component->attr.dimension))
+ && (!last || !last->u.c.component->attr.dimension)
+ && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr)))
{
/* Add the ref to the data member only, when this is not
a regular array or deallocate_alloc_comp will try to
