Re: [PATCH, Fortran, pr78672, ctp1, v1] Gfortran test suite failures with a sanitized compiler

[Mikael Morin <morin-mikael at orange dot fr>]

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