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
