From: Harald Anlauf <anlauf@gmx.de>
To: Tobias Burnus <tobias@codesourcery.com>
Cc: fortran <fortran@gcc.gnu.org>, gcc-patches <gcc-patches@gcc.gnu.org>
Subject: Re: [PATCH] PR fortrsn/101564 - ICE in resolve_allocate_deallocate, at fortran/resolve.c:8169
Date: Mon, 26 Jul 2021 23:55:11 +0200 [thread overview]
Message-ID: <trinity-9086b3e8-d798-4fb7-b2a7-038d9f639141-1627336511169@3c-app-gmx-bap37> (raw)
In-Reply-To: <217aa918-f12a-ebb5-2941-63b87c84b69c@codesourcery.com>
[-- Attachment #1: Type: text/plain, Size: 2853 bytes --]
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.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr101564-v2.patch --]
[-- Type: text/x-patch, Size: 7443 bytes --]
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
next prev parent reply other threads:[~2021-07-26 21:55 UTC|newest]
Thread overview: 8+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-07-21 20:36 Harald Anlauf
2021-07-22 17:55 ` Tobias Burnus
2021-07-22 19:50 ` Harald Anlauf
2021-07-23 8:17 ` Tobias Burnus
2021-07-26 21:55 ` Harald Anlauf [this message]
2021-07-27 7:52 ` Tobias Burnus
2021-07-27 21:42 ` Harald Anlauf
2021-07-28 10:23 ` Tobias Burnus
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=trinity-9086b3e8-d798-4fb7-b2a7-038d9f639141-1627336511169@3c-app-gmx-bap37 \
--to=anlauf@gmx.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
--cc=tobias@codesourcery.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).