Re: [PATCH, Fortran] Add diagnostic for F2018:C839 (TS29113:C535c)

2021-10-07 Thread Tobias Burnus

Hi Sandra,

On 06.10.21 23:37, Sandra Loosemore wrote:

This patch is for PR fortran/54753, to add a diagnostic for violations
of this constraint in the 2018 standard:

  C839 If an assumed-size or nonallocatable nonpointer assumed-rank
  array is an actual argument that corresponds to a dummy argument that
  is an INTENT (OUT) assumed-rank array, it shall not be polymorphic,
  finalizable, of a type with an allocatable ultimate component, or of a
  type for which default initialization is specified.

(It now uses an interface instead of an actual subroutine definition,
since Tobias recently committed a patch to fix interfaces in order to
unblock my work on this one.)  That bug is independent of enforcing
this constraint so I'm planning to open a new issue for it with its
own test case, if there isn't already one in Bugzilla.

I concur that that should be in a separate PR.

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
...
+  gfc_array_spec *fas, *aas;
+  bool pointer_arg, allocatable_arg;;

Remove either ";" or ";".

@@ -3329,13 +3331,48 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, 
gfc_formal_arglist *formal,
+  if (a->expr->expr_type != EXPR_VARIABLE)
+ {
+   aas = NULL;
+   pointer_arg = false;
+   allocatable_arg = false;


This code is not generic but rather specific.
But it is fine as used in the code.

The question is how to prevent "?" or wrong code for future
code readers and writers.

The issue is that:
* "alloc_array(:)" is not allocatable but allocatable_arg
  would be true.
* For var(5)%comp%comp2 - the aas and
  allocatable_arg/pointer_arg is based on 'var' and not on
  'comp2'.

As those vars are only used with expr->ref == NULL
(or expr->ref == whole-array ref) – and only with
assumed-rank or assumed-size dummys as actual argument,
it works fine as the not-handled code cannot occur.

 * * *

Solution: I think the simplest would be to add a comment.

Alternatively:

* For 'aas', one way might be to move to 'enum array_type'
  as that makes it clearer that 'aas' is for a special purpose,
  only. I mean something like:
enum array_type a_array_type = AS_UNKNOWN;
if (a->expr->expr_type == EXPR_VARIABLE && a->expr->symtree->n.sym
&& a->expr->symtree->n.sym->as && )
  a_array_type = a->expr->symtree->n.sym->as->type;
else if (... BT_CLASS ...)
  ...

For the attribute, either of the following would work:
* symbol_attribute arg_attr = gfc_expr_attr (e);
  This uses the big hammer when a small one would be sufficient,
  but it works in general.
or
* bool nonpointer_nonalloc_arg = ...
  This uses a more specific name. The attributes might not be
  correct, but the chance that it gets misused are reduced.

I think all variants work – and I am not sure what's the best.
There might be also other solutions, which are better/equally
good.


+  if (fas
+   && (fas->type == AS_ASSUMED_SHAPE
+   || fas->type == AS_DEFERRED
+   || (fas->type == AS_ASSUMED_RANK && f->sym->attr.pointer))
+   && aas
+   && aas->type == AS_ASSUMED_SIZE
&& (a->expr->ref == NULL
|| (a->expr->ref->type == REF_ARRAY
&& a->expr->ref->u.ar.type == AR_FULL)))

That's old code – but can you adapt it to handle BT_CLASS? I think
only 'f->sym->attr.pointer' causes the issue as it does not check for
CLASS_DATA()->attr.class_pointer – and the rest is fine, also because
of now using 'aas->type' which already encapsulates the classness.

Testcase:
--
type t
end type t
interface
  subroutine fc2 (x)
import :: t
class(t), pointer, intent(in) :: x(..)
  end
end interface
contains
  subroutine sub1(y)
type(t), target :: y(*)
call fc2 (y)  ! silently accepted
  end
end
--


+  subroutine test_assumed_size_polymorphic (a1, a2)
+class(t1) :: a1(*), a2(*)
+call poly (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
+call upoly (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
+  end subroutine

Can you also add a call like involving something like:
a1(5), a2(4:7), a1(:10) or a2(:-5) ? (Here, '(:-5)' is a
rank-1, size-zero array.)

Calls with those are valid as those pass the array size alongside.
From the patch it looks as if they should just work, but it is
still good to test this.


+  subroutine test_assumed_size_unlimited_polymorphic (a1, a2)
+class(*) :: a1(*), a2(*)
+call upoly (a1, a2)  ! { dg-error "(A|a)ssumed.rank" }
+  end subroutine

Likewise.

Otherwise, it looks good to me.

Thanks,

Tobias

-
Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201, 80634 
München; Gesellschaft mit beschränkter Haftung; Geschäftsführer: Thomas 
Heurung, Frank Thürauf; Sitz der Gesellschaft: München; Registergericht 
München, HRB 106955


[PATCH, Fortran] Add diagnostic for F2018:C839 (TS29113:C535c)

2021-10-06 Thread Sandra Loosemore
This patch is for PR fortran/54753, to add a diagnostic for violations 
of this constraint in the 2018 standard:


  C839 If an assumed-size or nonallocatable nonpointer assumed-rank
  array is an actual argument that corresponds to a dummy argument that
  is an INTENT (OUT) assumed-rank array, it shall not be polymorphic,
  finalizable, of a type with an allocatable ultimate component, or of a
  type for which default initialization is specified.

The last 3 clauses were fairly straightforward, but the "polymorphic" 
case gave me fits because I didn't initially understand that the front 
end stores flags for class types in different places than for non-class 
types.  I must give Tobias credit for straightening me out on that and 
some other obscure points that were confusing me, but he deserves none 
of the blame for this patch.  :-P


This patch fixes all the missing diagnostics and ICEs I previously 
reported in the PR, but I ended up completely rewriting the c535c-1 test 
case that formerly produced a bogus diagnostic.  (It now uses an 
interface instead of an actual subroutine definition, since Tobias 
recently committed a patch to fix interfaces in order to unblock my work 
on this one.)  That bug is independent of enforcing this constraint so 
I'm planning to open a new issue for it with its own test case, if there 
isn't already one in Bugzilla.


OK to commit?

-Sandra
commit d11d942503c884c06155f2743f8ed6c981a65533
Author: Sandra Loosemore 
Date:   Mon Sep 27 07:05:32 2021 -0700

Fortran: Add diagnostic for F2018:C839 (TS29113:C535c)

2021-10-06 Sandra Loosemore  

PR fortran/54753

gcc/fortran/
* interface.c (gfc_compare_actual_formal): Add diagnostic
for F2018:C839.  Refactor shared code and fix bugs with class
array info lookup, and add comments to diagnostic from PR94110
that is structured similarly to the new diagnostic.

gcc/testsuite/
* gfortran.dg/c-interop/c535c-1.f90: Rewrite and expand.
* gfortran.dg/c-interop/c535c-2.f90: Remove xfails.
* gfortran.dg/c-interop/c535c-3.f90: Likewise.
* gfortran.dg/c-interop/c535c-4.f90: Likewise.

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index a2fea0e97b8..9d13575cbf0 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -3061,6 +3061,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
   unsigned long actual_size, formal_size;
   bool full_array = false;
   gfc_array_ref *actual_arr_ref;
+  gfc_array_spec *fas, *aas;
+  bool pointer_arg, allocatable_arg;;
 
   actual = *ap;
 
@@ -3329,13 +3331,48 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  return false;
 	}
 
-  if (f->sym->as
-	  && (f->sym->as->type == AS_ASSUMED_SHAPE
-	  || f->sym->as->type == AS_DEFERRED
-	  || (f->sym->as->type == AS_ASSUMED_RANK && f->sym->attr.pointer))
-	  && a->expr->expr_type == EXPR_VARIABLE
-	  && a->expr->symtree->n.sym->as
-	  && a->expr->symtree->n.sym->as->type == AS_ASSUMED_SIZE
+  /* Class array variables and expressions store array info in a
+	 different place from non-class objects; consolidate the logic
+	 to access it here instead of repeating it below.  */
+  fas = (f->sym->ts.type == BT_CLASS
+	 ? CLASS_DATA (f->sym)->as
+	 : f->sym->as);
+  if (a->expr->expr_type != EXPR_VARIABLE)
+	{
+	  aas = NULL;
+	  pointer_arg = false;
+	  allocatable_arg = false;
+	}
+  else if (a->expr->ts.type == BT_CLASS
+	   && a->expr->symtree->n.sym
+	   && CLASS_DATA (a->expr->symtree->n.sym))
+	{
+	  gfc_component *classdata = CLASS_DATA (a->expr->symtree->n.sym);
+	  aas = classdata->as;
+	  pointer_arg = classdata->attr.class_pointer;
+	  allocatable_arg = classdata->attr.allocatable;
+	}
+  else
+	{
+	  aas = a->expr->symtree->n.sym->as;
+	  pointer_arg = a->expr->symtree->n.sym->attr.pointer;
+	  allocatable_arg = a->expr->symtree->n.sym->attr.allocatable;
+	}
+
+  /* F2018:9.5.2(2) permits assumed-size whole array expressions as
+	 actual arguments only if the shape is not required; thus it
+	 cannot be passed to an assumed-shape array dummy.
+	 F2018:15.5.2.(2) permits passing a nonpointer actual to an
+	 intent(in) pointer dummy argument and this is accepted by
+	 the compare_pointer check below, but this also requires shape
+	 information.
+	 There's more discussion of this in PR94110.  */
+  if (fas
+	  && (fas->type == AS_ASSUMED_SHAPE
+	  || fas->type == AS_DEFERRED
+	  || (fas->type == AS_ASSUMED_RANK && f->sym->attr.pointer))
+	  && aas
+	  && aas->type == AS_ASSUMED_SIZE
 	  && (a->expr->ref == NULL
 	  || (a->expr->ref->type == REF_ARRAY
 		  && a->expr->ref->u.ar.type == AR_FULL)))
@@ -3346,6 +3383,35 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
 	  return false;
 	}
 
+  /* Diagnose F2018 C839 (TS29113