From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.19]) by sourceware.org (Postfix) with ESMTPS id 4008E3987014; Tue, 27 Jul 2021 21:42:50 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 4008E3987014 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [79.251.12.39] ([79.251.12.39]) by web-mail.gmx.net (3c-app-gmx-bs70.server.lan [172.19.170.215]) (via HTTP); Tue, 27 Jul 2021 23:42:45 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: Tobias Burnus Cc: fortran , gcc-patches Subject: Re: [PATCH] PR fortrsn/101564 - ICE in resolve_allocate_deallocate, at fortran/resolve.c:8169 Content-Type: multipart/mixed; boundary=trekuen-3f015fc2-81e4-450c-bf92-ad6d064cfdc0 Date: Tue, 27 Jul 2021 23:42:45 +0200 Importance: normal Sensitivity: Normal In-Reply-To: <6ed7f80c-c59f-026a-c67f-933f5a3ea89c@codesourcery.com> References: <9b6187f0-d3dd-bb2d-d6f3-ada831cdecf0@codesourcery.com> <217aa918-f12a-ebb5-2941-63b87c84b69c@codesourcery.com> <6ed7f80c-c59f-026a-c67f-933f5a3ea89c@codesourcery.com> X-UI-Message-Type: mail X-Priority: 3 X-Provags-ID: V03:K1:xQKXPDd4p8nd2VdZKSgLwTJx2o1sFM0O9AvPQI0ZiExCv4UmvAOCDRSRVBQJGa2lktoy8 ChqoxFKKs7WkZQQQ2mMcJ2eWlSq4lseh8zVTmIorlcIyGkLF7HBuT4/A76yxxhjufZ0eXZN9B9AJ twMd5JfvbfYLSPTle+E1mjpyQxX+Yqmvq75hZz6P3V1fqpqOmgyzlcZ0spUe1gj7gba/OQTBtWXY bnvoMgWziW7I7QRvw+j1dMnr5+lFXkjLKEiQsH+xoCNdFwiMXznrpqZVStk750NRg2P3msn4kSI0 l0= X-UI-Out-Filterresults: notjunk:1;V03:K0:xE/o+Nxf9PU=:RlKRkBdy5gOPZT9tKLM46b jtPmEBsiLiQL3bXcKFPCdR/CzEMPlWhtkY4lqM+0BQFec7pXXBRv0CE6gVm4fS/wduYYZwU1Z 4cdkxPGqKQYrUIiKlGPyikFetPZEgK9AV8Nox1sSECXvPNd4eMMYWSthgnbg49Qf7U/LkH+cD lQJ7nxD30k3+2RjIGTBKkYOuLxFTylxxFst72SMph/mJgCdqr3uVSDyFIWyHBK+wfnRUC8WK3 b3tZZ0OBYtBFIuuar2Lo/k97OUyD6IBYHDkgqO4VEOQ0U4LIAUIl26rfxR7rWCGNIBA4ysMiQ 5NgFYJDCF3ZOilyuUm9h7zREySuv1jv5SoGw8zbjKTfFfz3z7V07f/HGdOOsmGilh4DP9j1uW 7uRaHoj3G0V6Dl89kWDST9kGIIKcw2awWnpvldVAymN+eBI17qYi3aMSpL4Q0da8IMqW2YJka emkWO9YG91D76TN/k0WoLaP3tHMAkCnEN4Kna5PsnFBxPszNqFMaV3sh7Jn0k8CdRfftZnoot K67Ic3V/+7iv6rqJlJNusEUCXARUAbUArng4+nriF/G8ZtV8SNvvcrZZhGQLKL8DK3XT4BxEW Ezb6wZFGxF2VYqkFpUN2/h9MZolDJRrVzMQVHVjVBeFwGRGgunPwhfqs6CLOXYKyvsQ2nCA9u vDrGjupCHeQO8W+721BuBUPmZean6OwXy/jJncQD4gcsVbcya5v0tgoOA0N6U06AfMz6k8zYx Hh/HPGxU8lCPV2EtzF1UmeBr6lUuliu0sOmtIsPDPCJew9gu0BAm2gtQzBfwL/Z0vZVFnW5N9 vfJPVp8fR+vJHAhUw52CTs09s4iBA== X-Spam-Status: No, score=-12.0 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, KAM_NUMSUBJECT, KAM_SHORT, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Tue, 27 Jul 2021 21:42:53 -0000 --trekuen-3f015fc2-81e4-450c-bf92-ad6d064cfdc0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Hi Tobias, > > We should rather open a separate PR on auditing the related uses > > of gfc_match=2E >=20 > I concur =E2=80=93 I just wanted to quickly check how many %v are there = =E2=80=93 > besides %v, there are also direct calls to gfc_match_variable=2E >=20 > Can you open a PR? this is now https://gcc=2Egnu=2Eorg/bugzilla/show_bug=2Ecgi?id=3D101652 > The loops are clear =E2=80=93 but the > '!stat->ref || (=2E=2E=2Eref->type !=3D ARRAY || ref->type !=3D COMPON= ENT))' > is still not clear to me=2E Ah, I was really missing the point and looking in the wrong place=2E 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=2E Removing the stat->ref part fixes that without introducing any regression in the testsuite=2E (There was an analogous part in the check for ERRMSG=2E) > Can you add the (working) test: > allocate (A, stat=3Dy%stat%kind) ! { dg-error "cannot be a constant"= } > deallocate (A, stat=3Dy%stat%kind) ! { dg-error "cannot be a constan= t" } > to your testcase gcc/testsuite/gfortran=2Edg/allocate_stat_3=2Ef90 ? Done=2E > And also the following one, which does not get diagnosed and, hence, > later gives an ICE during gimplification=2E >=20 > type tc > character (len=3D:), allocatable :: str > end type tc > =2E=2E=2E > type(tc) :: z > =2E=2E=2E > allocate(character(len=3D13) :: z%str) > allocate (A, stat=3Dz%str%len) > deallocate (A, stat=3Dz%str%len) >=20 > 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 =3D e->ref; ref && check_intentin; ref =3D ref->next) > loop, I think there should be a > if (ref->type =3D=3D 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=2E Note that %RE and %IM are usually definable=2E > I assume (but have not tested it) that will give > two error messages for: > allocate (A, errmsg=3Dz%str%len) > deallocate (A, errmsg=3Dz%str%len) > one for the new type-param-inquiry check and one for > !=3D BT_CHARACTER > if you want to prevent the double error, consider to > replace > gfc_check_vardef_context (=2E=2E=2E); > by > if (!gfc_check_vardef_context (=2E=2E=2E)) > goto done_errmsg; Yes, that is reasonable=2E Done=2E > > Regtested on x86_64-pc-linux-gnu=2E OK? > LGTM - except for the two testcase additions proposed above > and fixing the ICE=2E If you are happy with my changes and they > work, feel free add them and commit without further review=2E > In either case, I have the feeling we are nearly there=2E :-) 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=2E > Thanks for the patch and the review-modification-review-=2E=2E=2E patien= ce! Well, I believe this was really a worthwile review process, with fixing a few issues on the way before Gerhard finds them=2E=2E=2E Thanks, Harald Fortran: ICE in resolve_allocate_deallocate for invalid STAT argument gcc/fortran/ChangeLog: PR fortran/101564 * expr=2Ec (gfc_check_vardef_context): Add check for KIND and LEN parameter inquiries=2E * match=2Ec (gfc_match): Fix comment for %v code=2E (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=2E * resolve=2Ec (resolve_allocate_deallocate): Avoid NULL pointer dereferences and shortcut for bad STAT and ERRMSG argument to (DE)ALLOCATE=2E Remove bogus parts of checks for STAT and ERRMSG=2E gcc/testsuite/ChangeLog: PR fortran/101564 * gfortran=2Edg/allocate_stat_3=2Ef90: New test=2E * gfortran=2Edg/allocate_stat=2Ef90: Adjust error messages=2E * gfortran=2Edg/implicit_11=2Ef90: Likewise=2E * gfortran=2Edg/inquiry_type_ref_3=2Ef90: Likewise=2E --trekuen-3f015fc2-81e4-450c-bf92-ad6d064cfdc0 Content-Type: text/x-patch Content-Disposition: attachment; filename=pr101564-v3.patch Content-Transfer-Encoding: quoted-printable diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index b11ae7ce5c5..35563a78697 100644 =2D-- 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 =3D false; } + if (ref->type =3D=3D REF_INQUIRY + && (ref->u.i =3D=3D INQUIRY_KIND || ref->u.i =3D=3D INQUIRY_LEN)) + { + if (context) + gfc_error ("%qs parameter inquiry for %qs in " + "variable definition context (%s) at %L", + ref->u.i =3D=3D 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 =2D-- 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 referenc= es + 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 =3D gfc_match (" stat =3D %v", &tmp); + m =3D gfc_match (" stat =3D %e", &tmp); if (m =3D=3D MATCH_ERROR) goto cleanup; if (m =3D=3D MATCH_YES) @@ -4434,7 +4435,7 @@ alloc_opt_list: goto alloc_opt_list; } - m =3D gfc_match (" errmsg =3D %v", &tmp); + m =3D gfc_match (" errmsg =3D %e", &tmp); if (m =3D=3D MATCH_ERROR) goto cleanup; if (m =3D=3D MATCH_YES) @@ -4777,7 +4778,7 @@ gfc_match_deallocate (void) dealloc_opt_list: - m =3D gfc_match (" stat =3D %v", &tmp); + m =3D gfc_match (" stat =3D %e", &tmp); if (m =3D=3D MATCH_ERROR) goto cleanup; if (m =3D=3D MATCH_YES) @@ -4799,7 +4800,7 @@ dealloc_opt_list: goto dealloc_opt_list; } - m =3D gfc_match (" errmsg =3D %v", &tmp); + m =3D gfc_match (" errmsg =3D %e", &tmp); if (m =3D=3D MATCH_ERROR) goto cleanup; if (m =3D=3D MATCH_YES) diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 45c3ad387ac..592364689f9 100644 =2D-- 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 !=3D BT_INTEGER - && !(stat->ref && (stat->ref->type =3D=3D REF_ARRAY - || stat->ref->type =3D=3D REF_COMPONENT))) + if (stat->ts.type !=3D BT_INTEGER || stat->rank > 0) gfc_error ("Stat-variable at %L must be a scalar INTEGER " "variable", &stat->where); + if (stat->expr_type =3D=3D EXPR_CONSTANT || stat->symtree =3D=3D NU= LL) + goto done_stat; + + /* F2018:9.7.4: The stat-variable shall not be allocated or dealloc= ated + * within the ALLOCATE or DEALLOCATE statement in which it appears = ... + */ for (p =3D code->ext.alloc.list; p; p =3D p->next) if (p->expr->symtree->n.sym->name =3D=3D stat->symtree->n.sym->name) { @@ -8192,6 +8197,8 @@ resolve_allocate_deallocate (gfc_code *code, const c= har *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 =3D 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 !=3D BT_CHARACTER - && !(errmsg->ref - && (errmsg->ref->type =3D=3D REF_ARRAY - || errmsg->ref->type =3D=3D REF_COMPONENT))) + if (errmsg->ts.type !=3D BT_CHARACTER || errmsg->rank > 0 || errmsg->ts.kind !=3D gfc_default_character_kind) gfc_error ("ERRMSG variable at %L shall be a scalar default CHARACTER " "variable", &errmsg->where); + if (errmsg->expr_type =3D=3D EXPR_CONSTANT || errmsg->symtree =3D= =3D NULL) + goto done_errmsg; + + /* F2018:9.7.5: The errmsg-variable shall not be allocated or deall= ocated + * within the ALLOCATE or DEALLOCATE statement in which it appears = ... + */ for (p =3D code->ext.alloc.list; p; p =3D p->next) if (p->expr->symtree->n.sym->name =3D=3D errmsg->symtree->n.sym->name) { @@ -8242,6 +8253,8 @@ resolve_allocate_deallocate (gfc_code *code, const c= har *fcn) } } +done_errmsg: + /* Check that an allocate-object appears only once in the statement. *= / for (p =3D code->ext.alloc.list; p; p =3D p->next) diff --git a/gcc/testsuite/gfortran.dg/allocate_stat.f90 b/gcc/testsuite/g= fortran.dg/allocate_stat.f90 index 7f9eaf58d6d..f8a12913c91 100644 =2D-- 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=3Dfunc2) ! { dg-error "is not a variable" } + allocate (gain,STAT=3Dfunc2) ! { dg-error "requires an argument list" } deallocate(gain) res =3D 0 end function func2 @@ -51,7 +51,7 @@ subroutine sub() end interface real, pointer :: gain integer, parameter :: res =3D 2 - allocate (gain,STAT=3Dfunc2) ! { dg-error "is not a variable" } + allocate (gain,STAT=3Dfunc2) ! { 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=3Done) ! { dg-error "is not a variable" } + allocate(p, stat=3Done) ! { dg-error "requires an argument list" } if(associated(p)) deallocate(p) - allocate(p, stat=3Dtwo) ! { dg-error "is not a variable" } + allocate(p, stat=3Dtwo) ! { 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 =2D-- /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=3D:), allocatable :: s + end type tc + type(tc) :: z + allocate (character(42) :: z%s, stat=3Dstat) + allocate (A, stat=3Dstat, errmsg=3Dz%s) + deallocate (A, stat=3Dstat, errmsg=3Dz%s) + allocate (x(2), stat=3Dstat) + deallocate (x, stat=3Dstat) + allocate (A, stat=3Df()) + deallocate (A, stat=3Df()) + allocate (A, stat=3Dy%stat) + deallocate (A, stat=3Dy%stat) + allocate (A, stat=3Dy%r) ! { dg-error "must be a scalar INTEGER var= iable" } + deallocate (A, stat=3Dy%r) ! { dg-error "must be a scalar INTEGER var= iable" } + allocate (x(2), stat=3Dstat%kind) ! { dg-error "STAT tag" } + deallocate (x, stat=3Dstat%kind) ! { dg-error "STAT variable" } + allocate (A, stat=3DA%kind) ! { dg-error "STAT tag" } + deallocate (A, stat=3DA%kind) ! { dg-error "STAT variable" } + allocate (A, stat=3Dc%len) ! { dg-error "STAT tag" } + deallocate (A, stat=3Dc%len) ! { dg-error "STAT variable" } + allocate (A, stat=3Dy%stat%kind) ! { dg-error "STAT tag" } + deallocate (A, stat=3Dy%stat%kind) ! { dg-error "STAT variable" } + allocate (y, stat=3Dy%stat) ! { dg-error "within the same ALLOCATE stat= ement" } + allocate (y, stat=3Dr) ! { dg-error "must be a scalar INTEGER vari= able" } + allocate (A, stat=3Dy%z%re) ! { dg-error "must be a scalar INTEGER va= riable" } + deallocate (A, stat=3Dy%z%im) ! { dg-error "must be a scalar INTEGER va= riable" } + allocate (y, stat=3Dg()) ! { dg-error "must be a scalar INTEGER vari= able" } + deallocate (y, stat=3Dg()) ! { dg-error "must be a scalar INTEGER vari= able" } + allocate (A, stat=3Df) ! { dg-error "requires an argument list" } + deallocate (A, stat=3Df) ! { dg-error "requires an argument list" } + allocate (y, stat=3Dg) ! { dg-error "requires an argument list" } + deallocate (y, stat=3Dg) ! { dg-error "requires an argument list" } + allocate (A, stat=3Dz%s%len) ! { dg-error "parameter inquiry" } + deallocate (A, stat=3Dz%s%len) ! { dg-error "parameter inquiry" } + allocate (A, stat=3Df(), errmsg=3D"") ! { dg-error "ERRMSG variable" = } + deallocate (A, stat=3Df(), errmsg=3D"") ! { dg-error "ERRMSG variable" = } + allocate (A, stat=3Dstat, errmsg=3Dz%s%len) ! { dg-error "ERRMSG vari= able" } + deallocate (A, stat=3Dstat, errmsg=3Dz%s%len) ! { dg-error "ERRMSG vari= able" } + deallocate (z%s, stat=3Dstat, errmsg=3Dz%s) ! { dg-error "within the = same DEALLOCATE statement" } +contains + integer function f() + pointer :: f + f =3D> ptr + end function f + real function g() + pointer :: g + g =3D> r + end function g +end diff --git a/gcc/testsuite/gfortran.dg/implicit_11.f90 b/gcc/testsuite/gfo= rtran.dg/implicit_11.f90 index 61091ec41a0..8f93704ac4c 100644 =2D-- 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 =3D ISTAT2) ! { dg-error "is not a vari= able" } + ALLOCATE (RLA1(NF10), STAT =3D ISTAT2) ! { dg-error "requires an a= rgument list" } END SUBROUTINE END MODULE tests2 diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_3.f90 b/gcc/testsu= ite/gfortran.dg/inquiry_type_ref_3.f90 index 4e8d8a07b4e..7c1bf43785c 100644 =2D-- 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 =3D "abcdefg" a%kind =3D 2 ! { dg-error "Assignment to a constant expression"= } - b%len =3D 2 ! { dg-error "Assignment to a LEN or KIND part_ref= " } + b%len =3D 2 ! { dg-error "parameter inquiry" } i =3D a%kind ! OK i =3D b%len ! OK print *, z%re ! { dg-error "must be applied to a COMPLEX expressio= n" } --trekuen-3f015fc2-81e4-450c-bf92-ad6d064cfdc0--