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

Reply via email to