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 5C8DF3857831; Fri, 12 Mar 2021 20:43:16 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 5C8DF3857831 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [93.207.90.50] ([93.207.90.50]) by web-mail.gmx.net (3c-app-gmx-bap22.server.lan [172.19.172.92]) (via HTTP); Fri, 12 Mar 2021 21:43:14 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] PR fortran/99112 - [11 Regression] ICE with runtime diagnostics for SIZE intrinsic function Content-Type: multipart/mixed; boundary=sgnirk-6861a9de-4509-47de-bbe5-a5230ed40c30 Date: Fri, 12 Mar 2021 21:43:14 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:0HqoPxCpq/KSp5QQRSY3FAqr7pAjKlGVlk8KXUwLMeUMF5vtkaQODwW+MldUCbBEUpaYG K/l7Vnqq2pYoQS3NftPLDGRTHHk2uek2EPYo3Wxiah+j8FNCL3aWzKtI0F3b6ExEuRapb8R0e0Up zb+jRLCWMZHUwRdaw+pILM61QfvMq6S5ZIUk32RpMmrfmMPmQ+S7iBuUNdGGvHgF5qEhWWFkXzDX uOA8FxCFzS+lsgDwqTHc9e5FuZwLGe/uaq2hn6RtLW3vLrJHYnzmFzSmtgaCOSQVk4ep+QnDHble 10= X-UI-Out-Filterresults: notjunk:1;V03:K0:OGBCquDgAl8=:hVec/WaqbABElzVBh/ktpK AEv92Bw4SZ93Jknym2Cul4zdyx7wmoytFFPC7yA0HJX1CnBZhq/Byq39zhAn1S0bCz31by5Zq VnZQLMRTasyXyjmfMAnQ8bvEY+rfNuTUnsaoHAWs61egbQPKIYnG8q/MIYApCfUk+TtOGVTf0 skE2LvG3IRO6Cz/n+43VFJqkpRcVwN2zst3/518h8Abwp1Fx0OlBWNuAWoTW/ww662QyJKxsu j+5FvHaRYGlXFDgQsjckZX8S96U7qMBC54FymBmwPaIBUpfgKi9snjY2Z8lgK+DIosdoNhzRV iwaTc2wDRoidYCi6aHryPBSulYSF1meztQ9Vl54p/WDmMc7AQYRRm0rXGN3mrj4vLtWt/WitY Pwh1AHvkn9C8UkwueDYuCFrhPpPiRe5YJSzXbrKiGLvRl2d2BAkBy9T2M87WwpZamM6GZ/kv+ OgYvPb1Y4DeDtGLKCecmUSdAkvnpQO2nTRbKYEr70o8EHXZII+BBchjglyiGmQAozDW83neVu xtMNoOAhQvx0vxmW7l+C5PJ+7ZCTFJyIPRY0d0gpAZ0Srpp4eKlRtowYFeWLRFDk+QZ9F77FR Wxj7a2ivgDpoE= X-Spam-Status: No, score=-12.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) 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: Fri, 12 Mar 2021 20:43:18 -0000 --sgnirk-6861a9de-4509-47de-bbe5-a5230ed40c30 Content-Type: text/plain; charset=UTF-8 Dear all, the addition of runtime checks for the SIZE intrinsic created a regression that showed up for certain CLASS arguments to procedures. Paul did most of the work (~ 99%), but asked me to dig into an issue with an inappropriately selected error message. This actually turned out to be a simple one-liner on top of Paul's patch. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald P.S.: I couldn't find a Changelog entry that uses co-authors. Is the version below correct? PR fortran/99112 - ICE with runtime diagnostics for SIZE intrinsic function Add/fix handling of runtime checks for CLASS arguments with ALLOCATABLE or POINTER attribute. gcc/fortran/ChangeLog: * trans-expr.c (gfc_conv_procedure_call): Fix runtime checks for CLASS arguments. * trans-intrinsic.c (gfc_conv_intrinsic_size): Likewise. gcc/testsuite/ChangeLog: * gfortran.dg/pr99112.f90: New test. Co-authored-by: Paul Thomas --sgnirk-6861a9de-4509-47de-bbe5-a5230ed40c30 Content-Type: text/x-patch Content-Disposition: attachment; filename=pr99112.patch Content-Transfer-Encoding: quoted-printable diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 85c16d7f4c3..53c47e18dfd 100644 =2D-- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -6662,6 +6662,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * s= ym, symbol_attribute attr; char *msg; tree cond; + tree temp; if (e->expr_type =3D=3D EXPR_VARIABLE || e->expr_type =3D=3D EXPR_FUNC= TION) attr =3D gfc_expr_attr (e); @@ -6732,16 +6733,25 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *= sym, else goto end_pointer_check; - tmp =3D parmse.expr; + if (fsym && fsym->ts.type =3D=3D BT_CLASS) + { + temp =3D build_fold_indirect_ref_loc (input_location, + parmse.expr); + temp =3D gfc_class_data_get (temp); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (temp))) + temp =3D gfc_conv_descriptor_data_get (temp); + } + else + temp =3D parmse.expr; /* If the argument is passed by value, we need to strip the INDIRECT_REF. */ - if (!POINTER_TYPE_P (TREE_TYPE (parmse.expr))) - tmp =3D gfc_build_addr_expr (NULL_TREE, tmp); + if (!POINTER_TYPE_P (TREE_TYPE (temp))) + temp =3D gfc_build_addr_expr (NULL_TREE, temp); cond =3D fold_build2_loc (input_location, EQ_EXPR, - logical_type_node, tmp, - fold_convert (TREE_TYPE (tmp), + logical_type_node, temp, + fold_convert (TREE_TYPE (temp), null_pointer_node)); } diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 9cf3642f694..5e53d1162fa 100644 =2D-- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -8006,8 +8006,10 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * ex= pr) { symbol_attribute attr; char *msg; + tree temp; + tree cond; - attr =3D gfc_expr_attr (e); + attr =3D sym ? sym->attr : gfc_expr_attr (e); if (attr.allocatable) msg =3D xasprintf ("Allocatable argument '%s' is not allocated", e->symtree->n.sym->name); @@ -8017,14 +8019,24 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * e= xpr) else goto end_arg_check; - argse.descriptor_only =3D 1; - gfc_conv_expr_descriptor (&argse, actual->expr); - tree temp =3D gfc_conv_descriptor_data_get (argse.expr); - tree cond =3D fold_build2_loc (input_location, EQ_EXPR, - logical_type_node, temp, - fold_convert (TREE_TYPE (temp), - null_pointer_node)); + if (sym) + { + temp =3D gfc_class_data_get (sym->backend_decl); + temp =3D gfc_conv_descriptor_data_get (temp); + } + else + { + argse.descriptor_only =3D 1; + gfc_conv_expr_descriptor (&argse, actual->expr); + temp =3D gfc_conv_descriptor_data_get (argse.expr); + } + + cond =3D fold_build2_loc (input_location, EQ_EXPR, + logical_type_node, temp, + fold_convert (TREE_TYPE (temp), + null_pointer_node)); gfc_trans_runtime_check (true, false, cond, &argse.pre, &e->where, = msg); + free (msg); } end_arg_check: diff --git a/gcc/testsuite/gfortran.dg/pr99112.f90 b/gcc/testsuite/gfortra= n.dg/pr99112.f90 new file mode 100644 index 00000000000..94010615b83 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr99112.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } +! { dg-options "-fcheck=3Dpointer -fdump-tree-original" } +! PR99112 - ICE with runtime diagnostics for SIZE intrinsic function + +module m + type t + end type +contains + function f (x, y) result(z) + class(t) :: x(:) + class(t) :: y(size(x)) + type(t) :: z(size(x)) + end + function g (x) result(z) + class(*) :: x(:) + type(t) :: z(size(x)) + end + subroutine s () + class(t), allocatable :: a(:), b(:), c(:), d(:) + class(t), pointer :: p(:) + c =3D f (a, b) + d =3D g (p) + end +end +! { dg-final { scan-tree-dump-times "_gfortran_runtime_error_at" 3 "origi= nal" } } +! { dg-final { scan-tree-dump-times "Allocatable actual argument" 2 "orig= inal" } } +! { dg-final { scan-tree-dump-times "Pointer actual argument" 1 "original= " } } --sgnirk-6861a9de-4509-47de-bbe5-a5230ed40c30--