| Message ID | 20161208143937.0153b2a8@vepi2 |
|---|---|
| State | New |
| Headers | show |
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
Hello, Le 08/12/2016 à 23:49, Mikael Morin a écrit : > Le 08/12/2016 à 14:39, Andre Vehreschild a écrit : >> 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. > I remember now that rank can be negative, so your change is fine. >> && GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1) != NULL_TREE >> && VAR_P (GFC_TYPE_ARRAY_UBOUND (type, as->rank - 1))) >> { > Mikael
Hi Mikael, thanks a lot for your comments. Note I also have added the reply to your latest email here. On Thu, 8 Dec 2016 23:49:57 +0100 Mikael Morin <morin-mikael@orange.fr> wrote: <snipp> > > 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. You are completely right. This can *only* occur when invalid-code is given to the compiler. In this case the offending code was: data c / = NULL() / The syntax may not be correct (just out of my head), but I hope you get the idea. The sanitizers complaint was that the second argument to the memcpy below must not be NULL. The above if () makes sure the memcpy does not get called in this case. So this merely to prevent the compiler from ICEing on systems whose memcpy is not robust. > > 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)) > > + { <snip> > > + && a->expr->ts.type == BT_CHARACTER) > > { > > if (where) > > gfc_error ("Actual argument at %L to allocatable or " > That one was just reformatting, right? No, the check for the correct has been added at ^^^. I agree that reformatting and the change was not a good idea. > > > @@ -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. Well, I am actually not quite sure, what I need here. This phase of the compilation is quite new to me. The intention of the code above was to reliably get the array-ref. The checks further down did not always care that the ref they looked at (always the first one in the expression) was an array-ref. So I tried to get the array-ref here. Can you propose a way to get the array-ref in expressions like the one you gave suitable for the checks below? I understand that in our example the array-ref we look at should be c(:) and not the scalar ultimate one. > > + > > 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. Well, I am not sure, whether I understand completely. Please mind the background why I propose these changes: The sanitizer complained about the code. So what would be needed to also catch expressions like bar(5)%foo(1)%c(:)? <snip> > > 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. That would not prevent the error. The as->rank > 0 is guarding the next two line against accessing the array of ubounds with and index of -1. For a corank to my knowledge only the lbound is set for the right-most dimension. So that would at least access a NULL-pointer then. From your follow-up mail: > I remember now that rank can be negative, so your change is fine. Well, that is not the reason the change is mandated: When the rank is 0 but a corank is present, then the above still holds. > > > && 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? With my recently added support of allocatable components for coarrays of derived types such an allocatable component can be a scalar. It is not a full coarray because the coarray is one of its father objects. I hope my comments helped a bit to shed some light why I propose these changes. I am happy to get better solutions! Improvements, comments and ideas are very welcome!!! Regards, Andre -- Andre Vehreschild * Email: vehre ad gmx dot de
Hello, Le 09/12/2016 à 11:55, Andre Vehreschild a écrit : > Hi Mikael, > > thanks a lot for your comments. Note I also have added the reply to your latest > email here. > > On Thu, 8 Dec 2016 23:49:57 +0100 > Mikael Morin <morin-mikael@orange.fr> wrote: > > <snipp> > >>> 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. > > You are completely right. This can *only* occur when invalid-code is given to > the compiler. In this case the offending code was: > > data c / = NULL() / > > The syntax may not be correct (just out of my head), but I hope you get the > idea. The sanitizers complaint was that the second argument to the memcpy below > must not be NULL. The above if () makes sure the memcpy does not get called in > this case. So this merely to prevent the compiler from ICEing on systems whose > memcpy is not robust. Ok, I have been able to reproduce this case, and indeed the function is called with null() as rvalue expression. But my comment still holds. Accessing rvalue->value.character.string when rvalue hasn’t type EXPR_CONSTANT is undefined. A slightly better patch would use rvalue->expr_type == EXPR_CONSTANT as else if condition, but the problem remains earlier in the function in the assignment to len. I think the function just should not be called if rvalue is null(). > >>> 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)) >>> + { > > <snip> > >>> + && a->expr->ts.type == BT_CHARACTER) >>> { >>> if (where) >>> gfc_error ("Actual argument at %L to allocatable or " >> That one was just reformatting, right? > > No, the check for the correct has been added at ^^^. I agree that reformatting > and the change was not a good idea. > >> >>> @@ -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. > > Well, I am actually not quite sure, what I need here. This phase of the > compilation is quite new to me. The intention of the code above was to reliably > get the array-ref. That’s exactly my point, the code above doesn’t get it reliably. You have to exclude array element references like it’s done in gfc_find_array_ref for example. > The checks further down did not always care that the ref > they looked at (always the first one in the expression) was an array-ref. So I > tried to get the array-ref here. Can you propose a way to get the array-ref in > expressions like the one you gave suitable for the checks below? I understand > that in our example the array-ref we look at should be c(:) and not the scalar > ultimate one. > Well, it depends on how/where it is used. >>> + >>> 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. > > Well, I am not sure, whether I understand completely. Please mind the > background why I propose these changes: The sanitizer complained about the > code. So what would be needed to also catch expressions like bar(5)%foo(1)%c(:)? > For example, here we want to catch assumed size arrays, which are dummy argument arrays, so the array ref can only be the first one. [There is a side question whether assumed_size%component is assumed size, but I’m not sure I want to ask it.] There is a check that the reference is an array reference, so I don’t see what the sanitizer complains about. I think the condition bu originally written is the more correct one. Regarding the other use of actual_arr_ref, I agree that your changes is an improvement (with the remark above). > <snip> > >>> 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. > > That would not prevent the error. The as->rank > 0 is guarding the next two > line against accessing the array of ubounds with and index of -1. For a corank > to my knowledge only the lbound is set for the right-most dimension. So that > would at least access a NULL-pointer then. > > From your follow-up mail: >> I remember now that rank can be negative, so your change is fine. > > Well, that is not the reason the change is mandated: When the rank is 0 but a > corank is present, then the above still holds. > Ok, you win the point. >> >>> && 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? > > With my recently added support of allocatable components for coarrays of derived > types such an allocatable component can be a scalar. It is not a full coarray > because the coarray is one of its father objects. > And here as well. Mikael
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) 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 " @@ -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); + } + 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 (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 && 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-expr.c b/gcc/fortran/trans-expr.c index 8d7e881..3064e50 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -2864,9 +2864,7 @@ 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); + n = wi::abs (wrhs).to_shwi (); type = TREE_TYPE (lhs); sgn = tree_int_cst_sgn (rhs); 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))) { /* Add the ref to the data member only, when this is not a regular array or deallocate_alloc_comp will try to