OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/78672 (Gfortran test suite failures with a sanitized compiler) 

gcc/fortran/ChangeLog:

2016-12-14  Andre Vehreschild  <vehre@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.

From-SVN: r243647
This commit is contained in:
Andre Vehreschild 2016-12-14 12:52:09 +01:00
parent e397febfb8
commit eb401400f5
9 changed files with 76 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
gcc/fortran/ChangeLog
View File

@ -1,3 +1,22 @@
2016-12-14 Andre Vehreschild <vehre@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 <janus@gcc.gnu.org>
PR fortran/78798

9
gcc/fortran/array.c
View File

@ -2563,7 +2563,7 @@ cleanup:
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 @@ gfc_find_array_ref (gfc_expr *e)
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;
}

5
gcc/fortran/data.c
View File

@ -483,7 +483,10 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index,
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);
}

2
gcc/fortran/gfortran.h
View File

@ -3214,7 +3214,7 @@ bool gfc_check_constructor (gfc_expr *, bool (*)(gfc_expr *));
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 *);

69
gcc/fortran/interface.c
View File

@ -2803,6 +2803,7 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
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 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
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,15 +3197,20 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
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)
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;
}

1
gcc/fortran/module.c
View File

@ -4710,6 +4710,7 @@ load_omp_udrs (void)
mio_lparen ();
mio_pool_string (&name);
gfc_clear_ts (&ts);
mio_typespec (&ts);
if (strncmp (name, "operator ", sizeof ("operator ") - 1) == 0)
{

2
gcc/fortran/trans-decl.c
View File

@ -1053,7 +1053,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
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)))
{

6
gcc/fortran/trans-expr.c
View File

@ -2864,9 +2864,9 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
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);

3
gcc/fortran/trans-stmt.c
View File

@ -6483,7 +6483,8 @@ gfc_trans_deallocate (gfc_code *code)
&& !(!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