diff mbox series

PR fortran/101536 - ICE in gfc_conv_expr_descriptor, at fortran/trans-array.c:7324

Message ID trinity-9c25b827-d151-4dbe-af4f-81d559618fb4-1626898979598@3c-app-gmx-bap01
State New
Headers show
Series PR fortran/101536 - ICE in gfc_conv_expr_descriptor, at fortran/trans-array.c:7324 | expand

Commit Message

Harald Anlauf July 21, 2021, 8:22 p.m. UTC
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?

Thanks,
Harald


Fortran: extend check for array arguments and reject CLASS array elements.

gcc/fortran/ChangeLog:

	PR fortran/101536
	* check.c (array_check): Array elements of CLASS type are not
	arrays.

gcc/testsuite/ChangeLog:

	PR fortran/101536
	* gfortran.dg/pr101536.f90: New test.

Comments

Tobias Burnus July 22, 2021, 4:47 p.m. UTC | #1
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
Harald Anlauf July 22, 2021, 7:03 p.m. UTC | #2
Hi Tobias,

you are right in that I was barking up the wrong tree.
I was focussed too much on the testcase in the PR.

> 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

Well, I tried and this does not work.

However, an additional plain check on e->rank != 0 also in the
CLASS cases fixes the original issue as well as your example:

> 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

And regtests ok. :-)

See attached updated patch.

Anything else I am missing?

Thanks for the constructive review!

Harald
Tobias Burnus July 23, 2021, 7:58 a.m. UTC | #3
Hi Harald,

On 22.07.21 21:03, Harald Anlauf wrote:
> you are right in that I was barking up the wrong tree.
> I was focussed too much on the testcase in the PR.
> [...]
> Well, I tried and this does not work.

Which makes sense if one thinks about it:

When using 'a(5,:)', the parser already sets e->rank = 1.

while for 'a', the 'a' is the class wrapper with rank == 0 and
then overriding the e->rank by CLASS_DATA(e)->as.rank
+ adding AR_FULL makes sense.

> However, an additional plain check on e->rank != 0 also in the
> CLASS cases fixes the original issue as well as your example:
[...]
> And regtests ok. :-)
> See attached updated patch.

I think you still need to remove the 'return true;' from
the 'if (e->rank != 0 && e->ts.type == BT_CLASS' block – to
fall through to the e->rank check after the block.
(When 'return true;' is gone, the '{' and '}' can also be removed.)

Reason: Assume 'CLASS(...) x'. In this case, 'x' is a scalar.
And even after calling gfc_add_class_array_ref it remains
a scalar and e->rank == 0.

Or in other words: I think with your current patch,
     class(u)              :: z
     f = size (z)
is wrongly accepted without an error.

Thus: OK with a scalar CLASS entry added which gives an error,
which I believe requires the removal of the 'return true;' line.

Thanks for the patch – and I find it surprising how many
combinations exist which all can go wrong.

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
Harald Anlauf July 23, 2021, 7:08 p.m. UTC | #4
Hi Tobias,

> > However, an additional plain check on e->rank != 0 also in the
> > CLASS cases fixes the original issue as well as your example:
> [...]
> > And regtests ok. :-)
> > See attached updated patch.
> 
> I think you still need to remove the 'return true;' from
> the 'if (e->rank != 0 && e->ts.type == BT_CLASS' block – to
> fall through to the e->rank check after the block.
> (When 'return true;' is gone, the '{' and '}' can also be removed.)
> 
> Reason: Assume 'CLASS(...) x'. In this case, 'x' is a scalar.
> And even after calling gfc_add_class_array_ref it remains
> a scalar and e->rank == 0.
> 
> Or in other words: I think with your current patch,
>      class(u)              :: z
>      f = size (z)
> is wrongly accepted without an error.

did you really check that?  My related testing succeeded without
and with the return (which was in the original commit by Paul).

I have nevertheless followed your advice to remove the return
statement, extended the testcase and regtested again.

Committed as https://gcc.gnu.org/g:e314cfc371d8b2405a1d81e51b90f9fb24b9061f

Thanks,
Harald
diff mbox series

Patch

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 27bf3a7eafe..6d2d9fe4007 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -735,6 +735,10 @@  array_check (gfc_expr *e, int n)
 	&& 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;
+
       gfc_add_class_array_ref (e);
       return true;
     }
@@ -742,6 +746,7 @@  array_check (gfc_expr *e, int n)
   if (e->rank != 0 && e->ts.type != BT_PROCEDURE)
     return true;

+error:
   gfc_error ("%qs argument of %qs intrinsic at %L must be an array",
 	     gfc_current_intrinsic_arg[n]->name, gfc_current_intrinsic,
 	     &e->where);
diff --git a/gcc/testsuite/gfortran.dg/pr101536.f90 b/gcc/testsuite/gfortran.dg/pr101536.f90
new file mode 100644
index 00000000000..14cb4100bd6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr101536.f90
@@ -0,0 +1,12 @@ 
+! { dg-do compile }
+! PR fortran/101536 - ICE in gfc_conv_expr_descriptor
+
+program p
+  type t
+  end type
+contains
+  integer function f(x)
+    class(t), allocatable :: x(:)
+    f = size (x(1)) ! { dg-error "must be an array" }
+  end
+end