From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.17.22]) by sourceware.org (Postfix) with ESMTPS id 47D5239B90B3; Thu, 19 Aug 2021 19:11:22 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 47D5239B90B3 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [93.207.82.204] ([93.207.82.204]) by web-mail.gmx.net (3c-app-gmx-bap35.server.lan [172.19.172.105]) (via HTTP); Thu, 19 Aug 2021 21:11:16 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: Tobias Burnus Cc: Tobias Burnus , Bernhard Reutner-Fischer , Harald Anlauf via Gcc-patches , fortran Subject: Re: [PATCH] PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.c:5514 Content-Type: multipart/mixed; boundary=trekuen-af117fca-c33f-461b-adac-37a16641c60b Date: Thu, 19 Aug 2021 21:11:16 +0200 Importance: normal Sensitivity: Normal In-Reply-To: <8d25c317-74fa-d8a2-724f-de6944fa602e@codesourcery.com> References: <20210610122435.296a207d@nbbrfq> <8d25c317-74fa-d8a2-724f-de6944fa602e@codesourcery.com> X-UI-Message-Type: mail X-Priority: 3 X-Provags-ID: V03:K1:SHrojQoOUKeajfVuOaUJwMi1gIT4yUYMvbUbMjsgiQL7kMrH5SMCWotrmXeYmsy9FfGio GwYwm3lBbs2q54QSym9fTsr6o06l778w+t5a/E3tE2soI/GfIaS247Ai4h8KAh6jAJcmmrR2lLWX Y/gu26o2WNkJSHiZ1qIXTTa9VqlLHtf3BgtOSbD6gUlkvJgTvLbV+WfVHG7fNJZhL5mbqIUJ9au7 N8kBo/o4nQYbUoE8n8IHP++XYfm9AI50ZyrOidQNb5Z1zEaJuuA+nC3jOgXWssPRN7wyDZxslXIq FQ= X-UI-Out-Filterresults: notjunk:1;V03:K0:S2NaEooDrKY=:p3fNQtLmUD6PNYoWS2ej8F 9o1qi591fb7AMIXqwwntA8GIMPEYBsa4jk1WhLBhB6OLnCC566KyN7J0pZEEA5GCttsPKZj1z HhR/V2O2eDagH5IYvqhUOxvV0Yz5AvoYAfLjfHeq4Stn7xLyzkYX1zXJMNOkmQgnxm4a8tYXS UzgBJz6YhZvXrouRapxaKXjW4clLkDh1kyib3gUld8181uBdjomVaU/Uk30RTc6+7lPvYN6SH 55m0+e5UQaeagncDCQoqSg56G6Yg3eEPswhr4i0RHYIrClxGIQi40kU391PwdfRnXOy0vfPSU YvKpuZsUuKd6TMEHpX5B9WfqJ8AQC2LeTV/FG9otYEaVrMc26XHHEHdt98z/OvkyaqdU9CHjx mbqHuF9nVyeJNgCq/vIbhQAcGnWQ0bAk3SEnovRh2FTlyHHmZjbFCl8O6Ku3ywomo0ldBka9N gG5gjsfcWSKz9bRMwnrLmrSG+LQv/gdTQYXaYKsV+h+iiY5zFwPAYqn/BrAlnJwYs/CYeoh/c WThpPrWTnnh4rkdo4VbQrDECUmqcJKsDIxY4xvApQmXZemabaE2tGzM1w/4/QM47FPb9zFEOp 0vDQqzdXnADX512YfZRDqKa4tgqbVOKUAB2Wh//2yGrp25mZieP9aMR0JPz8Tw8Tbs4ROxo0z 6J5fsChTiXG2SoOD12eDZzUX2cOglmij+R6WHGXQ2ONsde1AVHlq5CLZPLXKEXS8KR799D5aX CJzIe5J44h+8JA0vfrzvFvApG6jcgDfbAsh/r9jBREDCBwAmzuU65VkmeLs+/juJOn0xFbzPv Q8jTRO3fIgm37O4yqadatsdezdpRw== X-Spam-Status: No, score=-11.5 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, KAM_NUMSUBJECT, 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: fortran@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Fortran mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Thu, 19 Aug 2021 19:11:24 -0000 --trekuen-af117fca-c33f-461b-adac-37a16641c60b Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: quoted-printable Hi Tobias, > I am inclined to say that the Intel compiler has a bug by not > accepting it =E2=80=93 but as written before, I regard sub-string length > (esp=2E with const expr) inquiries as an odd corner case which > is unlikely to occur in real-world code=2E ok=2E > Still does not work =E2=80=93 or rather: =2E=2E=2E%t(:)(3:4) [i=2Ee=2E s= ubstring with array section] > and =2E=2E=2E%str(3:4) [i=2Ee=2E substring of deferred-length scalar] bo= th do work > but if one combines the two (=E2=86=92 =2E=2E=2E%str2(:)(3:4), i=2Ee=2E = substring of deferred-length > array section), it does not: >=20 > Array =E2=80=98r=E2=80=99 at (1) is a variable, which does not reduce to= a constant expression >=20 > for: >=20 > --- a/gcc/testsuite/gfortran=2Edg/pr100950=2Ef90 > +++ b/gcc/testsuite/gfortran=2Edg/pr100950=2Ef90 > @@ -15,2 +15,3 @@ program p > character(len=3D:), allocatable :: str > + character(len=3D:), allocatable :: str2(:) > end type t_ > @@ -24,2 +25,4 @@ program p > integer, parameter :: l6 =3D len (r(1)%str (3:4)) > + integer, parameter :: l7 =3D len (r(1)%str2(1)(3:4)) > + integer, parameter :: l8 =3D len (r(1)%str2(:)(3:4)) >=20 >=20 > which feels odd=2E I agree=2E I have revised the code slightly to accept substrings of deferred-length=2E Your suggested variants now work correctly=2E > In principle, LGTM =E2=80=93 except I wonder what we do about the > len(r(1)%str(1)(3:4)); > I think we really do handle most code available and I would like to > close this > topic =E2=80=93 but still it feels a bit odd to leave this bit out=2E That is handle now as discussed, see attached final patch=2E Regtested again=2E > I was also wondering whether we should check that the > compile-time simplification works =E2=80=93 i=2Ee=2E use -fdump-tree-ori= ginal for this; > I attached a patch for this=2E I added this to the final patch and taken the liberty to push the result to master as d881460deb1f0bdfc3e8fa2d391a03a9763cbff4=2E Thanks for your patience, given the rather extensive review=2E=2E=2E Harald --trekuen-af117fca-c33f-461b-adac-37a16641c60b Content-Type: text/x-patch Content-Disposition: attachment; filename=pr100950-v5.patch Content-Transfer-Encoding: quoted-printable diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index c27b47aa98f..492867e12cb 100644 =2D-- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -4512,6 +4512,78 @@ gfc_simplify_leadz (gfc_expr *e) } +/* Check for constant length of a substring. */ + +static bool +substring_has_constant_len (gfc_expr *e) +{ + gfc_ref *ref; + HOST_WIDE_INT istart, iend, length; + bool equal_length =3D false; + + if (e->ts.type !=3D BT_CHARACTER) + return false; + + for (ref =3D e->ref; ref; ref =3D ref->next) + if (ref->type !=3D REF_COMPONENT && ref->type !=3D REF_ARRAY) + break; + + if (!ref + || ref->type !=3D REF_SUBSTRING + || !ref->u.ss.start + || ref->u.ss.start->expr_type !=3D EXPR_CONSTANT + || !ref->u.ss.end + || ref->u.ss.end->expr_type !=3D EXPR_CONSTANT + || !ref->u.ss.length) + return false; + + /* For non-deferred strings the given length shall be constant. */ + if (!e->ts.deferred + && (!ref->u.ss.length->length + || ref->u.ss.length->length->expr_type !=3D EXPR_CONSTANT)) + return false; + + /* Basic checks on substring starting and ending indices. */ + if (!gfc_resolve_substring (ref, &equal_length)) + return false; + + istart =3D gfc_mpz_get_hwi (ref->u.ss.start->value.integer); + iend =3D gfc_mpz_get_hwi (ref->u.ss.end->value.integer); + + if (istart <=3D iend) + { + if (istart < 1) + { + gfc_error ("Substring start index (" HOST_WIDE_INT_PRINT_DEC + ") at %L below 1", + istart, &ref->u.ss.start->where); + return false; + } + + /* For deferred strings use end index as proxy for length. */ + if (e->ts.deferred) + length =3D iend; + else + length =3D gfc_mpz_get_hwi (ref->u.ss.length->length->value.integer); + if (iend > length) + { + gfc_error ("Substring end index (" HOST_WIDE_INT_PRINT_DEC + ") at %L exceeds string length", + iend, &ref->u.ss.end->where); + return false; + } + length =3D iend - istart + 1; + } + else + length =3D 0; + + /* Fix substring length. */ + e->value.character.length =3D length; + + return true; +} + + gfc_expr * gfc_simplify_len (gfc_expr *e, gfc_expr *kind) { @@ -4521,7 +4593,8 @@ gfc_simplify_len (gfc_expr *e, gfc_expr *kind) if (k =3D=3D -1) return &gfc_bad_expr; - if (e->expr_type =3D=3D EXPR_CONSTANT) + if (e->expr_type =3D=3D EXPR_CONSTANT + || substring_has_constant_len (e)) { result =3D gfc_get_constant_expr (BT_INTEGER, k, &e->where); mpz_set_si (result->value.integer, e->value.character.length); diff --git a/gcc/testsuite/gfortran.dg/pr100950.f90 b/gcc/testsuite/gfortr= an.dg/pr100950.f90 new file mode 100644 index 00000000000..cb9d126bc18 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr100950.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! { dg-additional-options "-fdump-tree-original" } +! PR fortran/100950 - ICE in output_constructor_regular_field, at varasm.= c:5514 + +program p + character(8), parameter :: u =3D "123" + character(8) :: x =3D "", s + character(2) :: w(2) =3D [character(len(x(3:4))) :: 'a','b' = ] + character(*), parameter :: y(*) =3D [character(len(u(3:4))) :: 'a','b' = ] + character(*), parameter :: z(*) =3D [character(len(x(3:4))) :: 'a','b' = ] + character(*), parameter :: t(*) =3D [character(len(x( :2))) :: 'a','b' = ] + character(*), parameter :: v(*) =3D [character(len(x(7: ))) :: 'a','b' = ] + type t_ + character(len=3D5) :: s + character(len=3D8) :: t(4) + character(len=3D8), pointer :: u(:) + character(len=3D:), allocatable :: str + character(len=3D:), allocatable :: str2(:) + end type t_ + type(t_) :: q, r(1) + integer, parameter :: lq =3D len (q%s(3:4)), lr =3D len (r%s(3:4)) + integer, parameter :: l1 =3D len (q %t(1)(3:4)) + integer, parameter :: l2 =3D len (q %t(:)(3:4)) + integer, parameter :: l3 =3D len (q %str (3:4)) + integer, parameter :: l4 =3D len (r(:)%t(1)(3:4)) + integer, parameter :: l5 =3D len (r(1)%t(:)(3:4)) + integer, parameter :: l6 =3D len (r(1)%str (3:4)) + integer, parameter :: l7 =3D len (r(1)%str2(1)(3:4)) + integer, parameter :: l8 =3D len (r(1)%str2(:)(3:4)) + + if (len (y) /=3D 2) stop 1 + if (len (z) /=3D 2) stop 2 + if (any (w /=3D y)) stop 3 + if (len ([character(len(u(3:4))) :: 'a','b' ]) /=3D 2) stop 4 + if (len ([character(len(x(3:4))) :: 'a','b' ]) /=3D 2) stop 5 + if (any ([character(len(x(3:4))) :: 'a','b' ] /=3D y)) stop 6 + write(s,*) [character(len(x(3:4))) :: 'a','b' ] + if (s /=3D " a b ") stop 7 + if (len (t) /=3D 2) stop 8 + if (len (v) /=3D 2) stop 9 + if (lq /=3D 2 .or. lr /=3D 2) stop 10 + if (l1 /=3D 2 .or. l2 /=3D 2 .or. l4 /=3D 2 .or. l5 /=3D 2) stop 11 + if (l3 /=3D 2 .or. l6 /=3D 2 .or. l7 /=3D 2 .or. l8 /=3D 2) stop 12 + + block + integer, parameter :: l9 =3D len (r(1)%u(:)(3:4)) + if (l9 /=3D 2) stop 13 + end block +end + +! { dg-final { scan-tree-dump-times "_gfortran_stop_numeric" 2 "original"= } } +! { dg-final { scan-tree-dump "_gfortran_stop_numeric \\(3, 0\\);" "origi= nal" } } +! { dg-final { scan-tree-dump "_gfortran_stop_numeric \\(7, 0\\);" "origi= nal" } } --trekuen-af117fca-c33f-461b-adac-37a16641c60b--