Le 08/12/2016 à 14:39, Andre Vehreschild a écrit :
Hi all, hi Dominique,
this is the "compile time part 1" (ctp1) patch to fix the issues reported in
gfortran by a sanitized compiler when compiling the testsuite. The patch
addresses all issues besides leaks (ASAN_OPTIONS="detect_leaks=false". Most of
the issues were about assuming certain kinds of data without explicitly
checking, e.g., taking a component-ref for an array-ref and similar.
So this patch only addresses the -fsanitize=address,undefined reports (without
leaks) for running the compiler. I liked to keep this patch small to get it
reviewed quickly.
I see some other areas of work:
compile time part 2: address the leaks
testsuite run time: address the runtime issues (might have to be split in
others and leaks, too)
So far, is this patch bootstrapping and regtesting fine on x86_64-linux/f23. Ok
for trunk?
Regards,
Andre
PS: @Dominique: I will not commit before you are better and had the time to
test this.
diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 139ce88..4f835b3 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -186,7 +186,7 @@ create_character_initializer (gfc_expr *init, gfc_typespec
*ts,
for (i = 0; i < len; i++)
dest[start+i] = rvalue->representation.string[i];
}
- else
+ else if (rvalue->value.character.string)
This one looks fishy.
Either rvalue is a character constant and its string should be set, or
it’s not a character constant and the value.character.string should not
be accessed at all.
memcpy (&dest[start], rvalue->value.character.string,
len * sizeof (gfc_char_t));
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 8afba84..4e4d17c 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -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_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 "
That one was just reformatting, right?
@@ -3039,13 +3041,28 @@ 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)
+ {
+ gfc_ref *ref = a->expr->ref;
+
+ do
+ {
+ if (ref->type == REF_ARRAY)
+ actual_arr_ref = ref;
+ ref = ref->next;
+ }
+ while (ref != NULL);
+ }
beware, for the expression foo%c(:)%c2(1), this returns the array ref on
c2, not the one on c. Is it what you want?
If not, maybe you can use gfc_find_array_ref.
+
if (f->sym->as && f->sym->as->type == AS_ASSUMED_SHAPE
&& a->expr->expr_type == EXPR_VARIABLE
&& a->expr->symtree->n.sym->as
&& a->expr->symtree->n.sym->as->type == AS_ASSUMED_SIZE
- && (a->expr->ref == NULL
- || (a->expr->ref->type == REF_ARRAY
- && a->expr->ref->u.ar.type == AR_FULL)))
+ && (actual_arr_ref == NULL
+ || (actual_arr_ref->type == REF_ARRAY
+ && actual_arr_ref->u.ar.type == AR_FULL)))
If I understand the code correctly, it’s trying to detect variables with
assumed size, but I think you break that. In the case of an expression
foo(1)%c(:), where foo is assumed size, the if condition would be true.
{
if (where)
gfc_error ("Actual argument for %qs cannot be an assumed-size"
@@ -3196,14 +3213,14 @@ compare_actual_formal (gfc_actual_arglist **ap,
gfc_formal_arglist *formal,
}
if (f->sym->attr.volatile_
- && a->expr->ref && a->expr->ref->u.ar.type == AR_SECTION
+ && actual_arr_ref && actual_arr_ref->u.ar.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;
}
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index e727ade..713f272 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -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)
{
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 2e6ef2a..8173ba9 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1019,7 +1019,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
I suppose one should replace as->rank with as->rank + as->corank instead
of this.
&& GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1) != NULL_TREE
&& VAR_P (GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1)))
{
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 5ca716b..d953ec8 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -6464,7 +6464,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)))
I’m a bit surprised by the need for this. Are there cases where coarrays
don’t have a descriptor?
{
/* Add the ref to the data member only, when this is not
a regular array or deallocate_alloc_comp will try to
The rest looks good.
Mikael
