[Patch,Fortran] PR 40632 - Add CONTIGUOUS attribute (part 1)

[Mikael Morin]

On 19.06.2010 00:57, Tobias Burnus wrote:
> Tobias Burnus wrote:
>> The patch implements the parsing and the constraint checking. The next
>> step is to use it also for procedure calls and for array operations
>
> This patch now does this; the right-most stride (dim[0]) is now one and
> there is no (un)pack done for procedure calls. Additionally, I added
> module and dump-parse-tree support, which I initially forgot.
>
> While the patch should be OK, I would be happy if someone could
> carefully read the patch; especially, the constraints, the
> simply-contiguous conditions and the trans*c part.
>
> Build and currently regtesting on x86-64-linux.
> OK for the trunk?
>
> Tobias
Hello,

I have little time, so this is FastReview(TM).

> Index: gcc/fortran/interface.c
> ===================================================================
> --- gcc/fortran/interface.c	(Revision 161011)
> +++ gcc/fortran/interface.c	(Arbeitskopie)
> @@ -1435,6 +1435,16 @@ compare_parameter (gfc_symbol *formal, g
>        return 1;
>      }
>
> +  /* F2008, C1241.  */
> +  if (formal->attr.pointer && formal->attr.contiguous
> +      && !gfc_is_simply_contiguous (actual, true))
> +    {
> +      if (where)
> +	gfc_error ("Actual argument to contiguous pointer dummy '%s' at %L "
> +		   "must be simply contigous", formal->name, &actual->where);
> +      return 0;
> +    }
> +
>    if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN)
>        && !gfc_compare_types (&formal->ts, &actual->ts))
>      {
> @@ -1502,6 +1512,34 @@ compare_parameter (gfc_symbol *formal, g
>  			: actual->symtree->n.sym->as->corank);
>  	  return 0;
>  	}
> +
> +      /* F2008, 12.5.2.8.  */
> +      if (formal->attr.dimension
> +	  && (formal->attr.contiguous || formal->as->type != AS_ASSUMED_SHAPE)
> +	  && !gfc_is_simply_contiguous (actual, true))
> +	{
> +	  if (where)
> +	    gfc_error ("Actual argument to '%s' at %L must be simply "
> +		       "contiguous", formal->name, &actual->where);
> +	  return 0;
> +	}
> +    }
> +
> +  /* F2008, C1239/C1240.  */
> +  if (actual->expr_type == EXPR_VARIABLE
> +      && (actual->symtree->n.sym->attr.asynchronous
> +         || actual->symtree->n.sym->attr.volatile_)
> +      &&  (formal->attr.asynchronous || formal->attr.volatile_)
> +      && actual->rank && !gfc_is_simply_contiguous (actual, true)
> +      && ((formal->as->type != AS_ASSUMED_SHAPE && !formal->attr.pointer)
> +	  || formal->attr.contiguous))
> +    {
> +      if (where)
> +	gfc_error ("Dummy argument '%s' has to be a pointer or assumed-shape "
> +		   "array without CONTIGUOUS attribute as actual argument at "
> +		   "%L is not not simply contiguous and both are ASYNCHRONOUS "
> +		   "or VOLATILE", formal->name, &actual->where);
> +      return 0;
>      }
The error message is a bit cryptic to me.

> Index: gcc/fortran/expr.c
> ===================================================================
> --- gcc/fortran/expr.c	(Revision 161011)
> +++ gcc/fortran/expr.c	(Arbeitskopie)
> @@ -4080,3 +4080,95 @@ gfc_has_ultimate_pointer (gfc_expr *e)
>    else
>      return false;
>  }
> +
> +
> +/* Check whether an expression is "simply contiguous", cf. F2008, 6.5.4.
> +   Note: A scalar is not regarded as "simply contiguous" by the standard.
> +   if bool is not strict, some futher checks are done - for instance,
> +   a "(::1)" is accepted.  */
> +
> +bool
> +gfc_is_simply_contiguous (gfc_expr *expr, bool strict)
> +{
> +  bool colon;
> +  int i;
> +  gfc_array_ref *ar = NULL;
> +  gfc_ref *ref, *part_ref = NULL;
> +
> +  if (expr->expr_type == EXPR_FUNCTION)
> +    return expr->symtree->n.sym->result->attr.contiguous;
> +  else if (expr->expr_type != EXPR_VARIABLE)
> +    return false;
> +
> +  if (expr->rank == 0)
> +    return false;
> +
> +  for (ref = expr->ref; ref; ref = ref->next)
> +    {
> +      if (ref->type == REF_COMPONENT)
> +	part_ref  = ref;
> +      else if (ref->type == REF_SUBSTRING)
> +	  return false;
> +      else
> +	{
> +	  if (ar)
> +	    return false; /* Array shall be last part-ref. */
I think this should be outside the else block. For array(:)%component cases.

> +	  if (ref->u.ar.type != AR_ELEMENT)
> +	    ar = &ref->u.ar;
> +	}
> +    }
> +
> +  if ((part_ref && !part_ref->u.c.component->attr.contiguous
> +       && part_ref->u.c.component->attr.pointer)
> +      || (!part_ref && !expr->symtree->n.sym->attr.contiguous
> +	  && (expr->symtree->n.sym->attr.pointer
> +	      || expr->symtree->n.sym->as->type == AS_ASSUMED_SHAPE)))
> +    return false;
> +
> +  if (!ar || ar->type == AR_FULL)
> +    return true;
> +
> +  gcc_assert (ar->type != AR_UNKNOWN);
You can even assert that ar->type == AR_SECTION.


> +
> +  /* Check for simply contiguous array */
> +  colon = true;
> +  for (i = 0; i < ar->dimen; i++)
> +    {
> +      gcc_assert (ar->dimen_type[i] != DIMEN_UNKNOWN);
> +
> +      if (ar->dimen_type[i] == DIMEN_VECTOR)
> +	return false;
> +
> +      /* Element or section. Following the standard, "(::1)" or - if known at
> +	 compile time - "(lbound:ubound)" are not simply contigous; if strict
> +	 is false, they are regarded as simple contiguous.  */
> +
> +      if (ar->stride[i] && (strict || ar->stride[i]->expr_type != EXPR_CONSTANT
> +			    || ar->stride[i]->ts.type != BT_INTEGER
> +			    || mpz_cmp_si (expr->value.integer, 1) != 0))
> +	return false;
> +
> +      if (ar->start[i]
> +	  && (strict || ar->start[i]->expr_type != EXPR_CONSTANT
> +	      || ar->as->lower[i]->expr_type != EXPR_CONSTANT
> +	      || mpz_cmp (ar->start[i]->value.integer,
> +			  ar->as->lower[i]->value.integer) != 0))
> +	{
> +	  if (!colon)
> +	    return false;
> +	  colon = false;
> +	}
> +      if (ar->end[i]
> +	  && (strict || ar->end[i]->expr_type != EXPR_CONSTANT
> +	      || ar->as->upper[i]->expr_type != EXPR_CONSTANT
> +	      || mpz_cmp (ar->end[i]->value.integer,
> +			  ar->as->upper[i]->value.integer) != 0))
> +	{
> +	  if (!colon)
> +	    return false;
> +	  colon = false;
> +	}
> +    }
> +
> +  return true;
> +}
I think you are not rejecting the case array(:,1,:)

Otherwise OK.
Thanks,

Mikael