[PATCH 2/4] [GOMP4] [Fortran] OpenACC 1.0+ support in fortran front-end

[Tobias Burnus]

[Resend as it was initially HTML - sorry for those who are CCed.]

Ilmir Usmanov wrote:
> OpenACC 1.0 fortran FE support -- matching and resolving.

> +gfc_match_oacc_cache (void)
> +{
...
> +  if (gfc_current_state() != COMP_DO)
>       {
> -      gfc_free_omp_clauses (c);
> +      gfc_error ("ACC CACHE directive must be inside of loop %C");
> +      gfc_free_omp_clauses(c);
>         return MATCH_ERROR;
>       }

Shouldn't it also be supported in DO CONCURRENT? The following is 
currently rejected:

real :: b
!$acc loop
outer: do concurrent(i=1:5)
!$acc cache(b)
end do outer
end

(Side question: Is !$acc permitted in DO ... WHILE? If so, you need to 
also add EXEC_DO_WHILE.)

> +static void
> +resolve_oacc_positive_int_expr (gfc_expr *expr, const char *clause)
> +{
> +  resolve_oacc_scalar_int_expr (expr, clause);
> +  if (expr->expr_type == EXPR_CONSTANT && expr->ts.type == BT_INTEGER
> +      && expr->value.integer->_mp_size <= 0)
> +    gfc_warning ("INTEGER expression of %s clause at %L must be positive",
> +		     clause, &expr->where);

You shouldn't access internal variables of mpz_t. Use mpz_sgn() instead: 
https://gmplib.org/manual/Integer-Comparisons.html

> +  if ((sym->ts.type == BT_ASSUMED && sym->attr.pointer)
> +      || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
> +	  && CLASS_DATA (sym)->attr.pointer))

The second line should use BT_CLASS instead of BT_ASSUMED.


> +    gfc_error ("POINTER object '%s' of polymorphic type in %s clause at %L",
> +	       sym->name, name, &loc);
> +  if ((sym->ts.type == BT_ASSUMED && sym->attr.cray_pointer)
> +      || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
> +	  && CLASS_DATA (sym)->attr.cray_pointer))

Ditto.

> +    gfc_error ("Cray pointer object of polymorphic type '%s' in %s clause at %L",
> +	       sym->name, name, &loc);
> +  if ((sym->ts.type == BT_ASSUMED && sym->attr.cray_pointee)
> +      || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
> +	  && CLASS_DATA (sym)->attr.cray_pointee))
> +    gfc_error ("Cray pointee object of polymorphic type '%s' in %s clause at %L",
> +	       sym->name, name, &loc);

Ditto.


> +static void
> +check_array_not_assumed (gfc_symbol *sym, locus loc, const char *name)
> +{
> +  if (sym->as && sym->as->type == AS_ASSUMED_SIZE)
> +    gfc_error ("Assumed size array '%s' in %s clause at %L",
> +	       sym->name, name, &loc);
> +  if (sym->as && sym->as->type == AS_ASSUMED_SHAPE)
> +    gfc_error ("Assumed shape array '%s' in %s clause at %L",
> +	       sym->name, name, &loc);
> +  if (sym->as && sym->as->type == AS_ASSUMED_RANK)
> +    gfc_error ("Assumed rank array '%s' in %s clause at %L",
> +	       sym->name, name, &loc);
> +}

Actually, I wonder whether one needs to reject assumed-shape: I don't 
know what OpenACC says, but my impression is that the problem is that 
those can be noncontiguous. However, if they are marked as contiguous 
["attr.contiguous"] Â…


On the other hand, your code seems to permit deferred-shape arrays like:

real, pointer :: b(:)
!$acc data copyin(b)
end

The problem is that pointers to deferred-shape arrays can be 
noncontiguous. But deferred-shape array are always contiguous when they 
are either attr.allocatable or have the "attr.contiguous" attribute.


> +  if ((sym->ts.type == BT_ASSUMED && sym->attr.allocatable)
> +      || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
> +	  && CLASS_DATA (sym)->attr.allocatable))
As above: BT_CLASS in the second line.

> +resolve_oacc_deviceptr_clause (gfc_symbol *sym, locus loc, const char *name)
> +{
> +  if (sym->ts.type == BT_DERIVED && sym->attr.allocatable)
> +    gfc_error ("ALLOCATABLE object '%s' of derived type in %s clause at %L",
> +	       sym->name, name, &loc);
> +  if ((sym->ts.type == BT_ASSUMED && sym->attr.allocatable)
> +      || (sym->ts.type == BT_ASSUMED && CLASS_DATA (sym)
> +	  && CLASS_DATA (sym)->attr.allocatable))
Ditto.

> +    gfc_error ("ALLOCATABLE object '%s' of polymorphic type "
> +	       "in %s clause at %L", sym->name, name, &loc);
> +  if (sym->attr.pointer)
> +    gfc_error ("POINTER object '%s' in %s clause at %L",
> +	       sym->name, name, &loc);

Shouldn't you also add

|| (sym->ts.type == BT_CLASS && CLASS_DATA (sym) + && CLASS_DATA 
(sym)->attr.class_pointer)

here?

> +	  case OMP_LIST_USE_DEVICE:
> +	      if (n->sym->attr.allocatable)
> +		gfc_error ("ALLOCATABLE object '%s' in %s clause at %L",
> +			   n->sym->name, name, &code->loc);
> +	      if (n->sym->attr.pointer)
> +		gfc_error ("POINTER object '%s' in %s clause at %L",
> +			   n->sym->name, name, &code->loc);

Do you also need to handle BT_CLASS here for allocatable/pointer?


Otherwise, it looks good to me.

Tobias