PR fortrsn/101564 - ICE in resolve_allocate_deallocate, at fortran/resolve.c:8169

Message ID trinity-6ca0c1c7-5c7d-41e0-ac49-aefde33e340b-1626899770647@3c-app-gmx-bap01
State New
Headers show
Series
  • PR fortrsn/101564 - ICE in resolve_allocate_deallocate, at fortran/resolve.c:8169
Related show

Commit Message

Ian Lance Taylor via Gcc-patches July 21, 2021, 8:36 p.m.
I have the impression that Gerhard is a hydra: one PR down, he submits
two new ones... :-(
Anyway, here's a straightforward fix for a NULL pointer dereference for
an invalid argument to STAT.  For an alternative patch by Steve see PR.

Regtested on x86_64-pc-linux-gnu.  OK for mainline / 11-branch when it
reopens?

Thanks,
Harald


Fortran: ICE in resolve_allocate_deallocate for invalid STAT argument

gcc/fortran/ChangeLog:

	PR fortran/101564
	* resolve.c (resolve_allocate_deallocate): Avoid NULL pointer
	dereference and shortcut for bad STAT argument to (DE)ALLOCATE.

gcc/testsuite/ChangeLog:

	PR fortran/101564
	* gfortran.dg/pr101564.f90: New test.

Comments

Tobias Burnus July 22, 2021, 5:55 p.m. | #1
On 21.07.21 22:36, Harald Anlauf via Gcc-patches wrote:

> Anyway, here's a straightforward fix for a NULL pointer dereference for

> an invalid argument to STAT.  For an alternative patch by Steve see PR.

>

> Regtested on x86_64-pc-linux-gnu.  OK for mainline / 11-branch when it

> reopens?

..
> Fortran: ICE in resolve_allocate_deallocate for invalid STAT argument

>

> gcc/fortran/ChangeLog:

>

>       PR fortran/101564

>       * resolve.c (resolve_allocate_deallocate): Avoid NULL pointer

>       dereference and shortcut for bad STAT argument to (DE)ALLOCATE.

>

> gcc/testsuite/ChangeLog:

>

>       PR fortran/101564

>       * gfortran.dg/pr101564.f90: New test.

> diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c

> index 45c3ad387ac..51d312116eb 100644

> --- a/gcc/fortran/resolve.c

> +++ b/gcc/fortran/resolve.c

> @@ -8165,6 +8165,9 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)

>       gfc_error ("Stat-variable at %L must be a scalar INTEGER "

>                  "variable", &stat->where);

>

> +      if (stat->expr_type == EXPR_CONSTANT || stat->symtree == NULL)

> +     goto done_stat;

> +


I wonder whether this will catch all cases, e.g. stat->symtree != NULL
but using something else than '->n.sym'. I currently cannot spot
whether a user operator or a type-bound procedure is possible
in this case, but if so, n.sym->something is not well defined.

Additionally, I wonder whether that will work with:

integer, pointer :: ptr
integer function f()
   pointer :: f
   f = ptr
end
allocate(A, stat=f())

The f() is a variable and definable – but I am currently not sure it sets stat->symtree
and not only stat->value.function.esym, but I have not tested it.
(Answer: it does set it - at least there is an assert in gfc_check_vardef_context
that symtree != NULL for EXPR_FUNCTION.)


Can't we just as a 'if (!' + ') goto done_stat;' around:

       gfc_check_vardef_context (stat, false, false, false,
                                 _("STAT variable"));


Additionally, I have to admit that I do not understand the
following existing condition, which you did not touch:

       if ((stat->ts.type != BT_INTEGER
            && !(stat->ref && (stat->ref->type == REF_ARRAY
                               || stat->ref->type == REF_COMPONENT)))
           || stat->rank > 0)
         gfc_error ("Stat-variable at %L must be a scalar INTEGER "
                    "variable", &stat->where);

I mean the ts.type != BT_INTEGER and stat->rank != 0 is clear,
but what's the reason for the refs?

My impression is that it is supposed to handle REF_INQUIRY
such as  x%kind – but that does not seem to handle x%y%kind.

It looks as if gfc_check_vardef_context needs an additional
check for REF_INQUIRY – and then the check above can be
simplified to the obvious version.


Can you check? That's

* use if (!gfc_check_vardef_context ()) goto done_stat;
* Add REF_INQUIRY check to gfc_check_vardef_context
* Simplify the check to !BT_INTEGER || rank != 0

And possibly add a testcase for stat=f() [valid]
and stat=x%y%kind [invalid] as well?

Thanks,

Tobias

>         for (p = code->ext.alloc.list; p; p = p->next)

>       if (p->expr->symtree->n.sym->name == stat->symtree->n.sym->name)

>         {

> @@ -8192,6 +8195,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)

>         }

>       }

>

> +done_stat:

> +

>     /* Check the errmsg variable.  */

>     if (errmsg)

>       {

> diff --git a/gcc/testsuite/gfortran.dg/pr101564.f90 b/gcc/testsuite/gfortran.dg/pr101564.f90

> new file mode 100644

> index 00000000000..1e7c9911ce6

> --- /dev/null

> +++ b/gcc/testsuite/gfortran.dg/pr101564.f90

> @@ -0,0 +1,9 @@

> +! { dg-do compile }

> +! PR fortran/101564 - ICE in resolve_allocate_deallocate

> +

> +program p

> +  integer, allocatable :: x(:)

> +  integer              :: stat

> +  allocate (x(2), stat=stat)

> +  deallocate (x,  stat=stat%kind) ! { dg-error "(STAT variable)" }

> +end

-----------------
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
Ian Lance Taylor via Gcc-patches July 22, 2021, 7:50 p.m. | #2
Hi Tobias,

I am afraid we're really opening a can of worms here....

> Additionally, I wonder whether that will work with:

> 

> integer, pointer :: ptr

> integer function f()

>    pointer :: f

>    f = ptr

> end

> allocate(A, stat=f())

> 

> The f() is a variable and definable – but I am currently not sure it sets stat->symtree

> and not only stat->value.function.esym, but I have not tested it.


I think a "working" testcase for this could be:

program p
  implicit none
  integer, target  :: ptr
  integer, pointer :: A
  allocate (A, stat=f())
  print *, ptr
contains
  function f()
    integer, pointer :: f
    f => ptr
  end function f
end

This works as expected with Intel and AOCC, but gives a
syntax error with every gfortran tested because of match.c:

alloc_opt_list:

      m = gfc_match (" stat = %v", &tmp);

where the comment before gfc_match states:

   %v  Matches a variable expression (an lvalue)

although it matches only variables and not every type of lvalue.
We therefore never get to the interesting checks elsewhere...

> Additionally, I have to admit that I do not understand the

> following existing condition, which you did not touch:

> 

>        if ((stat->ts.type != BT_INTEGER

>             && !(stat->ref && (stat->ref->type == REF_ARRAY

>                                || stat->ref->type == REF_COMPONENT)))

>            || stat->rank > 0)

>          gfc_error ("Stat-variable at %L must be a scalar INTEGER "

>                     "variable", &stat->where);

> 

> I mean the ts.type != BT_INTEGER and stat->rank != 0 is clear,

> but what's the reason for the refs?


Well, that needs to be answered by Steve (see commit 3759634).

[...]

> And possibly add a testcase for stat=f() [valid]

> and stat=x%y%kind [invalid] as well?


Well, I need to go back to the drawing board then...

Thanks,
Harald
Tobias Burnus July 23, 2021, 8:17 a.m. | #3
Hi Harald,

On 22.07.21 21:50, Harald Anlauf wrote:
> I am afraid we're really opening a can of worms here....

which is not too bad if there are only two earthworms in there ;-)
>> Additionally, I wonder whether that will work with:

> I think a "working" testcase for this could be:

>

> program p

>    implicit none

>    integer, target  :: ptr

>    integer, pointer :: A

>    allocate (A, stat=f())

>    print *, ptr

> contains

>    function f()

>      integer, pointer :: f

>      f => ptr

>    end function f

> end

Indeed that I meant.
> This works as expected with Intel and AOCC, but gives a

> syntax error with every gfortran tested because of match.c:

>

> alloc_opt_list:

>        m = gfc_match (" stat = %v", &tmp);


I think we can simply change that one to %e; the definable
check should ensure that any non variable (in the Fortran sense)
is rejected.

And we should update the comment for %v / match_variable to state
that it does not include function references.

In some cases, like with OpenMP, we still do not want to match
functions, hence, changing match_variable is probably not what we
want to do. Additionally, for all %v replaced by %e we need to
ensure that there is a definable check. (Which should be there
already as INTENT(IN) or named constants or ... are also invalid.)

Also affected: Some I/O items, a bunch of other stat=%v and
errmsg=%v.

Talking about errmsg: In the same function, the same check is
done for errmsg as for stat – hence, the patch should update
also errmsg.

>> Additionally, I have to admit that I do not understand the

>> following existing condition, which you did not touch:

>>

>>         if ((stat->ts.type != BT_INTEGER

>>              && !(stat->ref && (stat->ref->type == REF_ARRAY

>>                                 || stat->ref->type == REF_COMPONENT)))

>>             || stat->rank > 0)

>>           gfc_error ("Stat-variable at %L must be a scalar INTEGER "

>>                      "variable", &stat->where);

>>

>> I mean the ts.type != BT_INTEGER and stat->rank != 0 is clear,

>> but what's the reason for the refs?

> Well, that needs to be answered by Steve (see commit 3759634).


(https://gcc.gnu.org/g:3759634f3208cbc1226bec19d22cbff989a287c3 (svn
r145331))

The reason for the ref checks is unclear and seem to be wrong. The added
testcases also only use 'x' (real) and n or i (integer) as input, i.e.
they do not exercise this. I did not look for the patch email for reasoning.

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
Ian Lance Taylor via Gcc-patches July 26, 2021, 9:55 p.m. | #4
Hi Tobias,

> > This works as expected with Intel and AOCC, but gives a

> > syntax error with every gfortran tested because of match.c:

> >

> > alloc_opt_list:

> >        m = gfc_match (" stat = %v", &tmp);

> 

> I think we can simply change that one to %e; the definable

> check should ensure that any non variable (in the Fortran sense)

> is rejected.

> 

> And we should update the comment for %v / match_variable to state

> that it does not include function references.


I've updated this for ALLOCATE/DEALLOCATE and STAT/ERRMSG, see
attached patch.  This required updating the error messages of
two existing files in the testsuite.

> Also affected: Some I/O items, a bunch of other stat=%v and

> errmsg=%v.


We should rather open a separate PR on auditing the related uses
of gfc_match.

> Talking about errmsg: In the same function, the same check is

> done for errmsg as for stat – hence, the patch should update

> also errmsg.


Done.

> >> Additionally, I have to admit that I do not understand the

> >> following existing condition, which you did not touch:

> >>

> >>         if ((stat->ts.type != BT_INTEGER

> >>              && !(stat->ref && (stat->ref->type == REF_ARRAY

> >>                                 || stat->ref->type == REF_COMPONENT)))

> >>             || stat->rank > 0)

> >>           gfc_error ("Stat-variable at %L must be a scalar INTEGER "

> >>                      "variable", &stat->where);

> >>

> >> I mean the ts.type != BT_INTEGER and stat->rank != 0 is clear,

> >> but what's the reason for the refs?

> > Well, that needs to be answered by Steve (see commit 3759634).

> 

> (https://gcc.gnu.org/g:3759634f3208cbc1226bec19d22cbff989a287c3 (svn

> r145331))

> 

> The reason for the ref checks is unclear and seem to be wrong. The added

> testcases also only use 'x' (real) and n or i (integer) as input, i.e.

> they do not exercise this. I did not look for the patch email for reasoning.


Well, there is some text in the standard that I added in front of
the for loops, and this code is now exercised in the new testcase.

Regtested on x86_64-pc-linux-gnu.  OK?

Thanks,
Harald

Fortran: ICE in resolve_allocate_deallocate for invalid STAT argument

gcc/fortran/ChangeLog:

	PR fortran/101564
	* match.c (gfc_match): Fix comment for %v code.
	(gfc_match_allocate, gfc_match_deallocate): Replace use of %v code
	by %e in gfc_match to allow for function references as STAT and
	ERRMSG arguments.
	* resolve.c (resolve_allocate_deallocate): Avoid NULL pointer
	dereferences and shortcut for bad STAT and ERRMSG argument to
	(DE)ALLOCATE.

gcc/testsuite/ChangeLog:

	PR fortran/101564
	* gfortran.dg/allocate_stat_3.f90: New test.
	* gfortran.dg/allocate_stat.f90: Adjust error messages.
	* gfortran.dg/implicit_11.f90: Adjust error messages.
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index d148de3e3b5..b1105481099 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1109,7 +1109,8 @@ gfc_match_char (char c)
    %t  Matches end of statement.
    %o  Matches an intrinsic operator, returned as an INTRINSIC enum.
    %l  Matches a statement label
-   %v  Matches a variable expression (an lvalue)
+   %v  Matches a variable expression (an lvalue, except function references
+   having a data pointer result)
    %   Matches a required space (in free form) and optional spaces.  */

 match
@@ -4405,7 +4406,7 @@ gfc_match_allocate (void)

 alloc_opt_list:

-      m = gfc_match (" stat = %v", &tmp);
+      m = gfc_match (" stat = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_YES)
@@ -4434,7 +4435,7 @@ alloc_opt_list:
 	    goto alloc_opt_list;
 	}

-      m = gfc_match (" errmsg = %v", &tmp);
+      m = gfc_match (" errmsg = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_YES)
@@ -4777,7 +4778,7 @@ gfc_match_deallocate (void)

 dealloc_opt_list:

-      m = gfc_match (" stat = %v", &tmp);
+      m = gfc_match (" stat = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_YES)
@@ -4799,7 +4800,7 @@ dealloc_opt_list:
 	    goto dealloc_opt_list;
 	}

-      m = gfc_match (" errmsg = %v", &tmp);
+      m = gfc_match (" errmsg = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_YES)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 45c3ad387ac..809a4ad86d1 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8165,6 +8165,12 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	gfc_error ("Stat-variable at %L must be a scalar INTEGER "
 		   "variable", &stat->where);

+      if (stat->expr_type == EXPR_CONSTANT || stat->symtree == NULL)
+	goto done_stat;
+
+      /* F2018:9.7.4: The stat-variable shall not be allocated or deallocated
+       * within the ALLOCATE or DEALLOCATE statement in which it appears ...
+       */
       for (p = code->ext.alloc.list; p; p = p->next)
 	if (p->expr->symtree->n.sym->name == stat->symtree->n.sym->name)
 	  {
@@ -8192,6 +8198,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	  }
     }

+done_stat:
+
   /* Check the errmsg variable.  */
   if (errmsg)
     {
@@ -8215,6 +8223,12 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	gfc_error ("ERRMSG variable at %L shall be a scalar default CHARACTER "
 		   "variable", &errmsg->where);

+      if (errmsg->expr_type == EXPR_CONSTANT || errmsg->symtree == NULL)
+	goto done_errmsg;
+
+      /* F2018:9.7.5: The errmsg-variable shall not be allocated or deallocated
+       * within the ALLOCATE or DEALLOCATE statement in which it appears ...
+       */
       for (p = code->ext.alloc.list; p; p = p->next)
 	if (p->expr->symtree->n.sym->name == errmsg->symtree->n.sym->name)
 	  {
@@ -8242,6 +8256,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	  }
     }

+done_errmsg:
+
   /* Check that an allocate-object appears only once in the statement.  */

   for (p = code->ext.alloc.list; p; p = p->next)
diff --git a/gcc/testsuite/gfortran.dg/allocate_stat.f90 b/gcc/testsuite/gfortran.dg/allocate_stat.f90
index 7f9eaf58d6d..f8a12913c91 100644
--- a/gcc/testsuite/gfortran.dg/allocate_stat.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_stat.f90
@@ -38,7 +38,7 @@ function func2() result(res)
   implicit none
   real, pointer :: gain
   integer :: res
-  allocate (gain,STAT=func2) ! { dg-error "is not a variable" }
+  allocate (gain,STAT=func2) ! { dg-error "requires an argument list" }
   deallocate(gain)
   res = 0
 end function func2
@@ -51,7 +51,7 @@ subroutine sub()
   end interface
   real, pointer :: gain
   integer, parameter :: res = 2
-  allocate (gain,STAT=func2) ! { dg-error "is not a variable" }
+  allocate (gain,STAT=func2) ! { dg-error "requires an argument list" }
   deallocate(gain)
 end subroutine sub

@@ -68,9 +68,9 @@ contains
  end function one
  subroutine sub()
    integer, pointer :: p
-   allocate(p, stat=one) ! { dg-error "is not a variable" }
+   allocate(p, stat=one) ! { dg-error "requires an argument list" }
    if(associated(p)) deallocate(p)
-   allocate(p, stat=two) ! { dg-error "is not a variable" }
+   allocate(p, stat=two) ! { dg-error "requires an argument list" }
    if(associated(p)) deallocate(p)
  end subroutine sub
 end module test
diff --git a/gcc/testsuite/gfortran.dg/allocate_stat_3.f90 b/gcc/testsuite/gfortran.dg/allocate_stat_3.f90
new file mode 100644
index 00000000000..c5ba6b892da
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_stat_3.f90
@@ -0,0 +1,50 @@
+! { dg-do compile }
+! PR fortran/101564 - ICE in resolve_allocate_deallocate
+
+program p
+  integer, allocatable :: x(:)
+  integer              :: stat
+  integer, pointer     :: A
+  integer, target      :: ptr
+  real,    target      :: r
+  character(4)         :: c
+  type t
+     integer :: stat
+     real    :: r
+  end type t
+  type(t), allocatable :: y
+  allocate (x(2), stat=stat)
+  deallocate (x,  stat=stat)
+  allocate (A, stat=f())
+  deallocate (A, stat=f())
+  allocate (A, stat=y%stat)
+  deallocate (A, stat=y%stat)
+  allocate (A, stat=y%r)
+  deallocate (A, stat=y%r)
+  allocate (x(2), stat=stat%kind) ! { dg-error "STAT tag" }
+  deallocate (x,  stat=stat%kind) ! { dg-error "STAT variable" }
+  allocate (A,    stat=A%kind)    ! { dg-error "STAT tag" }
+  deallocate (A,  stat=A%kind)    ! { dg-error "STAT variable" }
+  allocate (A,    stat=c%len)     ! { dg-error "STAT tag" }
+  deallocate (A,  stat=c%len)     ! { dg-error "STAT variable" }
+  allocate (y, stat=y%stat) ! { dg-error "within the same ALLOCATE statement" }
+  allocate (y, stat=y%r)    ! { dg-error "within the same ALLOCATE statement" }
+  allocate (y, stat=r)      ! { dg-error "must be a scalar INTEGER variable" }
+  allocate (y, stat=g())    ! { dg-error "must be a scalar INTEGER variable" }
+  deallocate (y, stat=g())  ! { dg-error "must be a scalar INTEGER variable" }
+  allocate (A, stat=f)      ! { dg-error "requires an argument list" }
+  deallocate (A, stat=f)    ! { dg-error "requires an argument list" }
+  allocate (y, stat=g)      ! { dg-error "requires an argument list" }
+  deallocate (y, stat=g)    ! { dg-error "requires an argument list" }
+  allocate (A,   stat=f(), errmsg="") ! { dg-error "ERRMSG variable" }
+  deallocate (A, stat=f(), errmsg="") ! { dg-error "ERRMSG variable" }
+contains
+  integer function f()
+    pointer :: f
+    f = ptr
+  end function f
+  real function g()
+    pointer :: g
+    g = r
+  end function g
+end
diff --git a/gcc/testsuite/gfortran.dg/implicit_11.f90 b/gcc/testsuite/gfortran.dg/implicit_11.f90
index 61091ec41a0..8f93704ac4c 100644
--- a/gcc/testsuite/gfortran.dg/implicit_11.f90
+++ b/gcc/testsuite/gfortran.dg/implicit_11.f90
@@ -31,6 +31,6 @@
      SUBROUTINE AD0001
        REAL RLA1(:)
        ALLOCATABLE RLA1
-       ALLOCATE (RLA1(NF10), STAT = ISTAT2) ! { dg-error "is not a variable" }
+       ALLOCATE (RLA1(NF10), STAT = ISTAT2) ! { dg-error "requires an argument list" }
      END SUBROUTINE
      END MODULE tests2
Tobias Burnus July 27, 2021, 7:52 a.m. | #5
Hi Harald,

On 26.07.21 23:55, Harald Anlauf wrote:
> I've updated this for ALLOCATE/DEALLOCATE and STAT/ERRMSG, see

> attached patch.  This required updating the error messages of

> two existing files in the testsuite.

Thanks.
>> Also affected: Some I/O items, a bunch of other stat=%v and

>> errmsg=%v.

> We should rather open a separate PR on auditing the related uses

> of gfc_match.


I concur – I just wanted to quickly check how many %v are there –
besides %v, there are also direct calls to gfc_match_variable.

Can you open a PR?

>>>>          if ((stat->ts.type != BT_INTEGER

>>>>               && !(stat->ref && (stat->ref->type == REF_ARRAY

>>>>                                  || stat->ref->type == REF_COMPONENT)))

>>>>              || stat->rank > 0)

>>>>            gfc_error ("Stat-variable at %L must be a scalar INTEGER "

>>>>                       "variable", &stat->where);

>>>> I mean the ts.type != BT_INTEGER and stat->rank != 0 is clear,

>>>> but what's the reason for the refs?

>>> Well, that needs to be answered by Steve (see commit 3759634).

>>>

>>> (https://gcc.gnu.org/g:3759634f3208cbc1226bec19d22cbff989a287c3 (svn

>>> r145331))

>>>

>>> The reason for the ref checks is unclear and seem to be wrong. The added

>>> testcases also only use 'x' (real) and n or i (integer) as input, i.e.

>>> they do not exercise this. I did not look for the patch email for reasoning.

> Well, there is some text in the standard that I added in front of

> the for loops, and this code is now exercised in the new testcase.


The loops are clear – but the
  '!stat->ref || (...ref->type != ARRAY || ref->type != COMPONENT))'
is still not clear to me.

   * * *

Can you add the (working) test:
   allocate (A, stat=y%stat%kind)  ! { dg-error "cannot be a constant" }
   deallocate (A, stat=y%stat%kind)  ! { dg-error "cannot be a constant" }
to your testcase gcc/testsuite/gfortran.dg/allocate_stat_3.f90 ?


And also the following one, which does not get diagnosed and, hence,
later gives an ICE during gimplification.

   type tc
     character (len=:), allocatable :: str
   end type tc
...
   type(tc) :: z
...
   allocate(character(len=13) :: z%str)
   allocate (A, stat=z%str%len)
   deallocate (A, stat=z%str%len)

To fix it, I think the solution is to do the following:
* In gfc_check_vardef_context, handle also REF_INQUIRY; in the
     for (ref = e->ref; ref && check_intentin; ref = ref->next)
   loop, I think there should be a
     if (ref->type == REF_INQUIRY)
       {
         if (context)
          gfc_error ("Type parameter inquiry for %qs in "
                     "variable definition context (%s) at %L",
                     name, context, &e->where);
         return false;
       }
(untested)

I assume (but have not tested it) that will give
two error messages for:
   allocate (A, errmsg=z%str%len)
   deallocate (A, errmsg=z%str%len)
one for the new type-param-inquiry check and one for
   != BT_CHARACTER
if you want to prevent the double error, consider to
replace
    gfc_check_vardef_context (...);
by
    if (!gfc_check_vardef_context (...))
      goto done_errmsg;

> Regtested on x86_64-pc-linux-gnu.  OK?

LGTM - except for the two testcase additions proposed above
and fixing the ICE. If you are happy with my changes and they
work, feel free add them and commit without further review.
In either case, I have the feeling we are nearly there. :-)

Thanks for the patch and the review-modification-review-... patience!

Tobias

> Fortran: ICE in resolve_allocate_deallocate for invalid STAT argument

>

> gcc/fortran/ChangeLog:

>

>       PR fortran/101564

>       * match.c (gfc_match): Fix comment for %v code.

>       (gfc_match_allocate, gfc_match_deallocate): Replace use of %v code

>       by %e in gfc_match to allow for function references as STAT and

>       ERRMSG arguments.

>       * resolve.c (resolve_allocate_deallocate): Avoid NULL pointer

>       dereferences and shortcut for bad STAT and ERRMSG argument to

>       (DE)ALLOCATE.

>

> gcc/testsuite/ChangeLog:

>

>       PR fortran/101564

>       * gfortran.dg/allocate_stat_3.f90: New test.

>       * gfortran.dg/allocate_stat.f90: Adjust error messages.

>       * gfortran.dg/implicit_11.f90: Adjust error messages.

-----------------
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
Ian Lance Taylor via Gcc-patches July 27, 2021, 9:42 p.m. | #6
Hi Tobias,

> > We should rather open a separate PR on auditing the related uses

> > of gfc_match.

> 

> I concur – I just wanted to quickly check how many %v are there –

> besides %v, there are also direct calls to gfc_match_variable.

> 

> Can you open a PR?


this is now https://gcc.gnu.org/bugzilla/show_bug.cgi?id=101652

> The loops are clear – but the

>   '!stat->ref || (...ref->type != ARRAY || ref->type != COMPONENT))'

> is still not clear to me.


Ah, I was really missing the point and looking in the wrong place.
Actually, I also do not understand the reason for this version of
the check, and it also leads to a strange accepts-invalid for
certain non-integer STAT variables.  Removing the stat->ref part
fixes that without introducing any regression in the testsuite.
(There was an analogous part in the check for ERRMSG.)

> Can you add the (working) test:

>    allocate (A, stat=y%stat%kind)  ! { dg-error "cannot be a constant" }

>    deallocate (A, stat=y%stat%kind)  ! { dg-error "cannot be a constant" }

> to your testcase gcc/testsuite/gfortran.dg/allocate_stat_3.f90 ?


Done.

> And also the following one, which does not get diagnosed and, hence,

> later gives an ICE during gimplification.

> 

>    type tc

>      character (len=:), allocatable :: str

>    end type tc

> ...

>    type(tc) :: z

> ...

>    allocate(character(len=13) :: z%str)

>    allocate (A, stat=z%str%len)

>    deallocate (A, stat=z%str%len)

> 

> To fix it, I think the solution is to do the following:

> * In gfc_check_vardef_context, handle also REF_INQUIRY; in the

>      for (ref = e->ref; ref && check_intentin; ref = ref->next)

>    loop, I think there should be a

>      if (ref->type == REF_INQUIRY)

>        {

>          if (context)

>           gfc_error ("Type parameter inquiry for %qs in "

>                      "variable definition context (%s) at %L",

>                      name, context, &e->where);

>          return false;

>        }

> (untested)


This almost worked, needing only a restriction to %KIND and %LEN.
Note that %RE and %IM are usually definable.

> I assume (but have not tested it) that will give

> two error messages for:

>    allocate (A, errmsg=z%str%len)

>    deallocate (A, errmsg=z%str%len)

> one for the new type-param-inquiry check and one for

>    != BT_CHARACTER

> if you want to prevent the double error, consider to

> replace

>     gfc_check_vardef_context (...);

> by

>     if (!gfc_check_vardef_context (...))

>       goto done_errmsg;


Yes, that is reasonable.  Done.

> > Regtested on x86_64-pc-linux-gnu.  OK?

> LGTM - except for the two testcase additions proposed above

> and fixing the ICE. If you are happy with my changes and they

> work, feel free add them and commit without further review.

> In either case, I have the feeling we are nearly there. :-)


I have added the updated "final" version of the patch to give
everybody another 24h to have a look, and will commit if nobody
complains.

> Thanks for the patch and the review-modification-review-... patience!


Well, I believe this was really a worthwile review process,
with fixing a few issues on the way before Gerhard finds them...

Thanks,
Harald


Fortran: ICE in resolve_allocate_deallocate for invalid STAT argument

gcc/fortran/ChangeLog:

	PR fortran/101564
	* expr.c (gfc_check_vardef_context): Add check for KIND and LEN
	parameter inquiries.
	* match.c (gfc_match): Fix comment for %v code.
	(gfc_match_allocate, gfc_match_deallocate): Replace use of %v code
	by %e in gfc_match to allow for function references as STAT and
	ERRMSG arguments.
	* resolve.c (resolve_allocate_deallocate): Avoid NULL pointer
	dereferences and shortcut for bad STAT and ERRMSG argument to
	(DE)ALLOCATE.  Remove bogus parts of checks for STAT and ERRMSG.

gcc/testsuite/ChangeLog:

	PR fortran/101564
	* gfortran.dg/allocate_stat_3.f90: New test.
	* gfortran.dg/allocate_stat.f90: Adjust error messages.
	* gfortran.dg/implicit_11.f90: Likewise.
	* gfortran.dg/inquiry_type_ref_3.f90: Likewise.
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index b11ae7ce5c5..35563a78697 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -6199,6 +6199,16 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 	  if (!pointer)
 	    check_intentin = false;
 	}
+      if (ref->type == REF_INQUIRY
+	  && (ref->u.i == INQUIRY_KIND || ref->u.i == INQUIRY_LEN))
+	{
+	  if (context)
+	    gfc_error ("%qs parameter inquiry for %qs in "
+		       "variable definition context (%s) at %L",
+		       ref->u.i == INQUIRY_KIND ? "KIND" : "LEN",
+		       sym->name, context, &e->where);
+	  return false;
+	}
     }

   if (check_intentin
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index d148de3e3b5..b1105481099 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1109,7 +1109,8 @@ gfc_match_char (char c)
    %t  Matches end of statement.
    %o  Matches an intrinsic operator, returned as an INTRINSIC enum.
    %l  Matches a statement label
-   %v  Matches a variable expression (an lvalue)
+   %v  Matches a variable expression (an lvalue, except function references
+   having a data pointer result)
    %   Matches a required space (in free form) and optional spaces.  */

 match
@@ -4405,7 +4406,7 @@ gfc_match_allocate (void)

 alloc_opt_list:

-      m = gfc_match (" stat = %v", &tmp);
+      m = gfc_match (" stat = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_YES)
@@ -4434,7 +4435,7 @@ alloc_opt_list:
 	    goto alloc_opt_list;
 	}

-      m = gfc_match (" errmsg = %v", &tmp);
+      m = gfc_match (" errmsg = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_YES)
@@ -4777,7 +4778,7 @@ gfc_match_deallocate (void)

 dealloc_opt_list:

-      m = gfc_match (" stat = %v", &tmp);
+      m = gfc_match (" stat = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_YES)
@@ -4799,7 +4800,7 @@ dealloc_opt_list:
 	    goto dealloc_opt_list;
 	}

-      m = gfc_match (" errmsg = %v", &tmp);
+      m = gfc_match (" errmsg = %e", &tmp);
       if (m == MATCH_ERROR)
 	goto cleanup;
       if (m == MATCH_YES)
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 45c3ad387ac..592364689f9 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8155,16 +8155,21 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
   /* Check the stat variable.  */
   if (stat)
     {
-      gfc_check_vardef_context (stat, false, false, false,
-				_("STAT variable"));
+      if (!gfc_check_vardef_context (stat, false, false, false,
+				     _("STAT variable")))
+	  goto done_stat;

-      if ((stat->ts.type != BT_INTEGER
-	   && !(stat->ref && (stat->ref->type == REF_ARRAY
-			      || stat->ref->type == REF_COMPONENT)))
+      if (stat->ts.type != BT_INTEGER
 	  || stat->rank > 0)
 	gfc_error ("Stat-variable at %L must be a scalar INTEGER "
 		   "variable", &stat->where);

+      if (stat->expr_type == EXPR_CONSTANT || stat->symtree == NULL)
+	goto done_stat;
+
+      /* F2018:9.7.4: The stat-variable shall not be allocated or deallocated
+       * within the ALLOCATE or DEALLOCATE statement in which it appears ...
+       */
       for (p = code->ext.alloc.list; p; p = p->next)
 	if (p->expr->symtree->n.sym->name == stat->symtree->n.sym->name)
 	  {
@@ -8192,6 +8197,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	  }
     }

+done_stat:
+
   /* Check the errmsg variable.  */
   if (errmsg)
     {
@@ -8199,22 +8206,26 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	gfc_warning (0, "ERRMSG at %L is useless without a STAT tag",
 		     &errmsg->where);

-      gfc_check_vardef_context (errmsg, false, false, false,
-				_("ERRMSG variable"));
+      if (!gfc_check_vardef_context (errmsg, false, false, false,
+				     _("ERRMSG variable")))
+	  goto done_errmsg;

       /* F18:R928  alloc-opt             is ERRMSG = errmsg-variable
 	 F18:R930  errmsg-variable       is scalar-default-char-variable
 	 F18:R906  default-char-variable is variable
 	 F18:C906  default-char-variable shall be default character.  */
-      if ((errmsg->ts.type != BT_CHARACTER
-	   && !(errmsg->ref
-		&& (errmsg->ref->type == REF_ARRAY
-		    || errmsg->ref->type == REF_COMPONENT)))
+      if (errmsg->ts.type != BT_CHARACTER
 	  || errmsg->rank > 0
 	  || errmsg->ts.kind != gfc_default_character_kind)
 	gfc_error ("ERRMSG variable at %L shall be a scalar default CHARACTER "
 		   "variable", &errmsg->where);

+      if (errmsg->expr_type == EXPR_CONSTANT || errmsg->symtree == NULL)
+	goto done_errmsg;
+
+      /* F2018:9.7.5: The errmsg-variable shall not be allocated or deallocated
+       * within the ALLOCATE or DEALLOCATE statement in which it appears ...
+       */
       for (p = code->ext.alloc.list; p; p = p->next)
 	if (p->expr->symtree->n.sym->name == errmsg->symtree->n.sym->name)
 	  {
@@ -8242,6 +8253,8 @@ resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	  }
     }

+done_errmsg:
+
   /* Check that an allocate-object appears only once in the statement.  */

   for (p = code->ext.alloc.list; p; p = p->next)
diff --git a/gcc/testsuite/gfortran.dg/allocate_stat.f90 b/gcc/testsuite/gfortran.dg/allocate_stat.f90
index 7f9eaf58d6d..f8a12913c91 100644
--- a/gcc/testsuite/gfortran.dg/allocate_stat.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_stat.f90
@@ -38,7 +38,7 @@ function func2() result(res)
   implicit none
   real, pointer :: gain
   integer :: res
-  allocate (gain,STAT=func2) ! { dg-error "is not a variable" }
+  allocate (gain,STAT=func2) ! { dg-error "requires an argument list" }
   deallocate(gain)
   res = 0
 end function func2
@@ -51,7 +51,7 @@ subroutine sub()
   end interface
   real, pointer :: gain
   integer, parameter :: res = 2
-  allocate (gain,STAT=func2) ! { dg-error "is not a variable" }
+  allocate (gain,STAT=func2) ! { dg-error "requires an argument list" }
   deallocate(gain)
 end subroutine sub

@@ -68,9 +68,9 @@ contains
  end function one
  subroutine sub()
    integer, pointer :: p
-   allocate(p, stat=one) ! { dg-error "is not a variable" }
+   allocate(p, stat=one) ! { dg-error "requires an argument list" }
    if(associated(p)) deallocate(p)
-   allocate(p, stat=two) ! { dg-error "is not a variable" }
+   allocate(p, stat=two) ! { dg-error "requires an argument list" }
    if(associated(p)) deallocate(p)
  end subroutine sub
 end module test
diff --git a/gcc/testsuite/gfortran.dg/allocate_stat_3.f90 b/gcc/testsuite/gfortran.dg/allocate_stat_3.f90
new file mode 100644
index 00000000000..1fa38925d6f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_stat_3.f90
@@ -0,0 +1,67 @@
+! { dg-do compile }
+! PR fortran/101564 - ICE in resolve_allocate_deallocate
+
+program p
+  implicit none
+  integer, allocatable :: x(:)
+  integer              :: stat
+  integer, pointer     :: A
+  integer, target      :: ptr
+  real,    target      :: r
+  character(4)         :: c
+  type t
+     integer :: stat
+     real    :: r
+     complex :: z
+  end type t
+  type(t), allocatable :: y
+  type tc
+     character(len=:), allocatable :: s
+  end type tc
+  type(tc) :: z
+  allocate (character(42) :: z%s, stat=stat)
+  allocate (A,   stat=stat, errmsg=z%s)
+  deallocate (A, stat=stat, errmsg=z%s)
+  allocate (x(2), stat=stat)
+  deallocate (x,  stat=stat)
+  allocate (A, stat=f())
+  deallocate (A, stat=f())
+  allocate (A, stat=y%stat)
+  deallocate (A, stat=y%stat)
+  allocate (A,    stat=y%r)  ! { dg-error "must be a scalar INTEGER variable" }
+  deallocate (A,  stat=y%r)  ! { dg-error "must be a scalar INTEGER variable" }
+  allocate (x(2), stat=stat%kind) ! { dg-error "STAT tag" }
+  deallocate (x,  stat=stat%kind) ! { dg-error "STAT variable" }
+  allocate (A,    stat=A%kind)    ! { dg-error "STAT tag" }
+  deallocate (A,  stat=A%kind)    ! { dg-error "STAT variable" }
+  allocate (A,    stat=c%len)     ! { dg-error "STAT tag" }
+  deallocate (A,  stat=c%len)     ! { dg-error "STAT variable" }
+  allocate (A,    stat=y%stat%kind) ! { dg-error "STAT tag" }
+  deallocate (A,  stat=y%stat%kind) ! { dg-error "STAT variable" }
+  allocate (y, stat=y%stat) ! { dg-error "within the same ALLOCATE statement" }
+  allocate (y, stat=r)      ! { dg-error "must be a scalar INTEGER variable" }
+  allocate (A, stat=y%z%re)   ! { dg-error "must be a scalar INTEGER variable" }
+  deallocate (A, stat=y%z%im) ! { dg-error "must be a scalar INTEGER variable" }
+  allocate (y, stat=g())    ! { dg-error "must be a scalar INTEGER variable" }
+  deallocate (y, stat=g())  ! { dg-error "must be a scalar INTEGER variable" }
+  allocate (A, stat=f)      ! { dg-error "requires an argument list" }
+  deallocate (A, stat=f)    ! { dg-error "requires an argument list" }
+  allocate (y, stat=g)      ! { dg-error "requires an argument list" }
+  deallocate (y, stat=g)    ! { dg-error "requires an argument list" }
+  allocate (A, stat=z%s%len)   ! { dg-error "parameter inquiry" }
+  deallocate (A, stat=z%s%len) ! { dg-error "parameter inquiry" }
+  allocate (A,   stat=f(), errmsg="") ! { dg-error "ERRMSG variable" }
+  deallocate (A, stat=f(), errmsg="") ! { dg-error "ERRMSG variable" }
+  allocate (A,   stat=stat, errmsg=z%s%len) ! { dg-error "ERRMSG variable" }
+  deallocate (A, stat=stat, errmsg=z%s%len) ! { dg-error "ERRMSG variable" }
+  deallocate (z%s, stat=stat, errmsg=z%s)   ! { dg-error "within the same DEALLOCATE statement" }
+contains
+  integer function f()
+    pointer :: f
+    f => ptr
+  end function f
+  real function g()
+    pointer :: g
+    g => r
+  end function g
+end
diff --git a/gcc/testsuite/gfortran.dg/implicit_11.f90 b/gcc/testsuite/gfortran.dg/implicit_11.f90
index 61091ec41a0..8f93704ac4c 100644
--- a/gcc/testsuite/gfortran.dg/implicit_11.f90
+++ b/gcc/testsuite/gfortran.dg/implicit_11.f90
@@ -31,6 +31,6 @@
      SUBROUTINE AD0001
        REAL RLA1(:)
        ALLOCATABLE RLA1
-       ALLOCATE (RLA1(NF10), STAT = ISTAT2) ! { dg-error "is not a variable" }
+       ALLOCATE (RLA1(NF10), STAT = ISTAT2) ! { dg-error "requires an argument list" }
      END SUBROUTINE
      END MODULE tests2
diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_3.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_3.f90
index 4e8d8a07b4e..7c1bf43785c 100644
--- a/gcc/testsuite/gfortran.dg/inquiry_type_ref_3.f90
+++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_3.f90
@@ -17,7 +17,7 @@ program main
    type(t) :: s
    b = "abcdefg"
    a%kind = 2        ! { dg-error "Assignment to a constant expression" }
-   b%len = 2         ! { dg-error "Assignment to a LEN or KIND part_ref" }
+   b%len = 2         ! { dg-error "parameter inquiry" }
    i = a%kind        ! OK
    i = b%len         ! OK
    print *, z%re     ! { dg-error "must be applied to a COMPLEX expression" }
Tobias Burnus July 28, 2021, 10:23 a.m. | #7
Hi Harald,

On 27.07.21 23:42, Harald Anlauf wrote:
> This almost worked, needing only a restriction to %KIND and %LEN.

> Note that %RE and %IM are usually definable.

Well spotted :-)
> Regtested on x86_64-pc-linux-gnu.  OK?

>> LGTM - except [...] feel free add them and commit without further review.

>> [...]

> I have added the updated "final" version of the patch to give

> everybody another 24h to have a look, and will commit if nobody

> complains.

LGTM - thanks again.

> [...] with fixing a few issues on the way before Gerhard finds them...


:-)

Tobias

> Fortran: ICE in resolve_allocate_deallocate for invalid STAT argument

>

> gcc/fortran/ChangeLog:

>

>       PR fortran/101564

>       * expr.c (gfc_check_vardef_context): Add check for KIND and LEN

>       parameter inquiries.

>       * match.c (gfc_match): Fix comment for %v code.

>       (gfc_match_allocate, gfc_match_deallocate): Replace use of %v code

>       by %e in gfc_match to allow for function references as STAT and

>       ERRMSG arguments.

>       * resolve.c (resolve_allocate_deallocate): Avoid NULL pointer

>       dereferences and shortcut for bad STAT and ERRMSG argument to

>       (DE)ALLOCATE.  Remove bogus parts of checks for STAT and ERRMSG.

>

> gcc/testsuite/ChangeLog:

>

>       PR fortran/101564

>       * gfortran.dg/allocate_stat_3.f90: New test.

>       * gfortran.dg/allocate_stat.f90: Adjust error messages.

>       * gfortran.dg/implicit_11.f90: Likewise.

>       * gfortran.dg/inquiry_type_ref_3.f90: Likewise.

-----------------
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

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 45c3ad387ac..51d312116eb 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -8165,6 +8165,9 @@  resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	gfc_error ("Stat-variable at %L must be a scalar INTEGER "
 		   "variable", &stat->where);

+      if (stat->expr_type == EXPR_CONSTANT || stat->symtree == NULL)
+	goto done_stat;
+
       for (p = code->ext.alloc.list; p; p = p->next)
 	if (p->expr->symtree->n.sym->name == stat->symtree->n.sym->name)
 	  {
@@ -8192,6 +8195,8 @@  resolve_allocate_deallocate (gfc_code *code, const char *fcn)
 	  }
     }

+done_stat:
+
   /* Check the errmsg variable.  */
   if (errmsg)
     {
diff --git a/gcc/testsuite/gfortran.dg/pr101564.f90 b/gcc/testsuite/gfortran.dg/pr101564.f90
new file mode 100644
index 00000000000..1e7c9911ce6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr101564.f90
@@ -0,0 +1,9 @@ 
+! { dg-do compile }
+! PR fortran/101564 - ICE in resolve_allocate_deallocate
+
+program p
+  integer, allocatable :: x(:)
+  integer              :: stat
+  allocate (x(2), stat=stat)
+  deallocate (x,  stat=stat%kind) ! { dg-error "(STAT variable)" }
+end