Hi Harald,

On 21.07.21 22:22, Harald Anlauf via Fortran wrote:
Another one of Gerhard's infamous testcases.  We did not properly detect
and reject array elements of type CLASS as argument to an intrinsic when
it should be an array.

Regtested on x86_64-pc-linux-gnu.  OK for mainline / 11-branch when it
reopens?
...
+    class(t), allocatable :: x(:)
+    f = size (x(1)) ! { dg-error "must be an array" }
...
   if (e->ts.type == BT_CLASS && gfc_expr_attr (e).class_ok
         && CLASS_DATA (e)->attr.dimension
         && CLASS_DATA (e)->as->rank)
     {
+      if (e->ref && e->ref->type == REF_ARRAY
+       && e->ref->u.ar.type == AR_ELEMENT)
+     goto error;

I think that one is wrong. While CLASS_DATA (e) accesses 
e->ts.u.derived->components,
which always works, your code assumes that there is only 'c' and not 'x%c' where
'c' is of type BT_CLASS and 'x' is of type BT_DERIVED.

I wonder whether it works if you simply remove 'return true;'
as gfc_add_class_array_ref sets 'e->rank = CLASS(e)->rank (and
adds an AR_FULL ref, if needed). In the nonerror case, the
'return true' is obtained via:
   if (e->rank != 0 && e->ts.type != BT_PROCEDURE)
     return true;
And, otherwise, it falls through to the error.

OK if that works – but please also add a test like

type t
  class(*), allocatable :: c(:)
end type t
type(t) :: x
x%c = [1,2,3,4]
print *, size(x%c)
print *, size(x%c(1)) ! { dg-error ... }
end

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

Reply via email to