From patchwork Wed Sep 20 07:03:39 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 142254 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a05:612c:172:b0:3f2:4152:657d with SMTP id h50csp3931242vqi; Wed, 20 Sep 2023 00:05:03 -0700 (PDT) X-Google-Smtp-Source: AGHT+IFm2RshTTd5ybePwUYGu2QB2YvPQ31Is++Qyf4jJFv4Q/b1pMQoJ5P2Mb/hrGrQ0vAQHIRT X-Received: by 2002:a17:907:2ccf:b0:9ad:f403:745 with SMTP id hg15-20020a1709072ccf00b009adf4030745mr1086971ejc.73.1695193502449; Wed, 20 Sep 2023 00:05:02 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1695193502; cv=none; d=google.com; s=arc-20160816; b=XOw2jkZuLsib1EopnrOy12KvviKCxOPiUCBkmLAc2Un+7Q3mE297kbNddU73SJHBJl 9uYs8lfbTQL5tpigL6hGr9cCU+fZ+Tf59IpKzbOFh8VLjidT9THuqqUxn8D744rR4N07 SE8xhRxxqqLNeNEAgqNCR/wLjwJqFtVg+gTHk1jrol9g5Y/lnVr+d8z5Uzai8mrmAwYX mEh3gLtQ6s1WOd8YU6eEhr1k1OmPj8HV4GkgGOhOvm3c8il1lYg4Q/yJE0s5Hj+9r3Js aS5LwkWbALxBIURTmQwBIzRcDiZ+XJ0ahOAfC4nvDOFNSJMm9P4DpGbgMMSWRkZI6dLX FT8g== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=errors-to:list-subscribe:list-help:list-post:list-archive :list-unsubscribe:list-id:precedence:to:subject:message-id:date:from :mime-version:dkim-signature:dmarc-filter:delivered-to; bh=25voc7i3ae+PonofhDI99P8owcaqjYH00CHXepGuyZc=; fh=GSsCLkWBfXoFiGnDCFSEBskKkonF6jVDtKqqw8KzaAo=; b=TWMuOF6p7xhkXDsy29zhPxqCrsBaNKl9/c0HsnyMAJ1j+kdkw9QojyZ6MEQNVaqeh7 OmW2mp6BpmSfA/zP73D/IWB5fH9EEvMr6ysBwFzxJk3pSsLNp2v7MtWtqnQZcgtk6JMv iuqDf1TFM3G7uaOcBBntEdUkymWaC6qjPSHRlWmAf9GqnJ6LD05PHQTn4J4YmYZHTd0v 1kYZWccX9o0NVkeR/dhIgSv1yDVvlBIe/TkHcAYbvUXXJt0jQuuU7tIU9XQULQvpdvSN cTxgztka5GBNbXrTFLDakhyYxQHsis6sJ/XeqCfIVUjSzTmrkyvLasHBTKgICNdnfCgn x6Ig== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gmail.com header.s=20230601 header.b=Ir8QpG+D; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=QUARANTINE dis=NONE) header.from=gmail.com Received: from server2.sourceware.org (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id p17-20020a1709060dd100b0099ce780a194si10767857eji.667.2023.09.20.00.05.02 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 20 Sep 2023 00:05:02 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gmail.com header.s=20230601 header.b=Ir8QpG+D; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=QUARANTINE dis=NONE) header.from=gmail.com Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id EB0E83858296 for ; Wed, 20 Sep 2023 07:04:29 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-lf1-x135.google.com (mail-lf1-x135.google.com [IPv6:2a00:1450:4864:20::135]) by sourceware.org (Postfix) with ESMTPS id 5F6063858281; Wed, 20 Sep 2023 07:03:55 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 5F6063858281 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmail.com Received: by mail-lf1-x135.google.com with SMTP id 2adb3069b0e04-50325ce89e9so3727776e87.0; Wed, 20 Sep 2023 00:03:55 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1695193432; x=1695798232; darn=gcc.gnu.org; h=to:subject:message-id:date:from:mime-version:from:to:cc:subject :date:message-id:reply-to; bh=25voc7i3ae+PonofhDI99P8owcaqjYH00CHXepGuyZc=; b=Ir8QpG+Dkr5rzTZGhfpoWLScdwPI+iKLyldH7dM1wjMiULy9DzUke7i8MR9AIhIzAA ugppDxV783IrbEfgtFnX8XgD9r5H/ACIcs74SgFcfdjr/Cah/acgyfdc2YVFieo3xCwc kNbcfKDbsmfCAPi86KfvSUe6l7tyAiIFZ8G6+cvo3ujNSbYYM6qdGR+yfyazwR9m/6ij Fyj/gjpQNDciwrsFHxxiawM7rH34BdUDTffbYs5WY1O1jqDrOgoPiuDKXuQTxj8uuQa+ 95o9zjtC8+/BCjcn215cZ+NFllgAudIWrEvdai0lp9A0+L27YmQnb+ze+bayL9zLNOjR 62CQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1695193432; x=1695798232; h=to:subject:message-id:date:from:mime-version:x-gm-message-state :from:to:cc:subject:date:message-id:reply-to; bh=25voc7i3ae+PonofhDI99P8owcaqjYH00CHXepGuyZc=; b=eiESI6i7J5Jzbx6ZSchzlXpjSSbZhhLX75af2AbcSv0bUk4MrQiWjNQM72rk9wCkra vnzOWMBEsbMR7WSTwtwOVlsPpA1MBZ8jlaggP/Sdr+I2wS82UbJGmao2XHCCHg1MGt+l Kx4LoQPh/yHqqx7IUrl63gZbKIWmqdt++OPQRG4ScmFEJ6hIcRCnl+VbLRiJnWBv+jJm QisAOh5C6wKdcf27JqtTKQu8g1OYj4A/ZFw6kQi/8fdXvKgRpByPLRdxgRKem/SBdDa1 DYtqrMUqBH7+mOtYWhrACU9OE+sDcVyRwBudVr+R1/Rf3/bjReqDUfRBecuJ5Jwjklo2 Wnlw== X-Gm-Message-State: AOJu0Yz0BxhMPJYvrhZ8Z8hSdzCA5qvDZwWZXgK4fAsz8OmHk7p+Bj9D FgbXVYg9Ed1Ur70IQMC1OSEm/mCil0kwUUyI5Z0+UZRgqiU= X-Received: by 2002:a05:6512:36d1:b0:503:3587:fd15 with SMTP id e17-20020a05651236d100b005033587fd15mr1285023lfs.61.1695193431921; Wed, 20 Sep 2023 00:03:51 -0700 (PDT) MIME-Version: 1.0 From: Paul Richard Thomas Date: Wed, 20 Sep 2023 08:03:39 +0100 Message-ID: Subject: [Patch, fortran] PR68155 - ICE on initializing character array in type (len_lhs <> len_rhs) To: "fortran@gcc.gnu.org" , gcc-patches X-Spam-Status: No, score=-6.5 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org X-getmail-retrieved-from-mailbox: INBOX X-GMAIL-THRID: 1777539222255245962 X-GMAIL-MSGID: 1777539222255245962 Hi All, This is a straightforward patch that is adequately explained by the ChangeLog. Regtests fine - OK for trunk? Cheers Paul Fortran: Pad mismatched charlens in component initializers [PR68155] 2023-09-20 Paul Thomas gcc/fortran PR fortran/68155 * decl.cc (fix_initializer_charlen): New function broken out of add_init_expr_to_sym. (add_init_expr_to_sym, build_struct): Call the new function. gcc/testsuite/ PR fortran/68155 * gfortran.dg/pr68155.f90: New test. diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 8182ef29f43..4a3c5b86de0 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -1960,6 +1960,45 @@ gfc_free_enum_history (void) } +/* Function to fix initializer character length if the length of the + symbol or component is constant. */ + +static bool +fix_initializer_charlen (gfc_typespec *ts, gfc_expr *init) +{ + if (!gfc_specification_expr (ts->u.cl->length)) + return false; + + int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, false); + + /* resolve_charlen will complain later on if the length + is too large. Just skip the initialization in that case. */ + if (mpz_cmp (ts->u.cl->length->value.integer, + gfc_integer_kinds[k].huge) <= 0) + { + HOST_WIDE_INT len + = gfc_mpz_get_hwi (ts->u.cl->length->value.integer); + + if (init->expr_type == EXPR_CONSTANT) + gfc_set_constant_character_len (len, init, -1); + else if (init->expr_type == EXPR_ARRAY) + { + gfc_constructor *cons; + + /* Build a new charlen to prevent simplification from + deleting the length before it is resolved. */ + init->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); + init->ts.u.cl->length = gfc_copy_expr (ts->u.cl->length); + cons = gfc_constructor_first (init->value.constructor); + for (; cons; cons = gfc_constructor_next (cons)) + gfc_set_constant_character_len (len, cons->expr, -1); + } + } + + return true; +} + + /* Function called by variable_decl() that adds an initialization expression to a symbol. */ @@ -2073,40 +2112,10 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) gfc_copy_expr (init->ts.u.cl->length); } } - /* Update initializer character length according symbol. */ - else if (sym->ts.u.cl->length->expr_type == EXPR_CONSTANT) - { - if (!gfc_specification_expr (sym->ts.u.cl->length)) - return false; - - int k = gfc_validate_kind (BT_INTEGER, gfc_charlen_int_kind, - false); - /* resolve_charlen will complain later on if the length - is too large. Just skeep the initialization in that case. */ - if (mpz_cmp (sym->ts.u.cl->length->value.integer, - gfc_integer_kinds[k].huge) <= 0) - { - HOST_WIDE_INT len - = gfc_mpz_get_hwi (sym->ts.u.cl->length->value.integer); - - if (init->expr_type == EXPR_CONSTANT) - gfc_set_constant_character_len (len, init, -1); - else if (init->expr_type == EXPR_ARRAY) - { - gfc_constructor *c; - - /* Build a new charlen to prevent simplification from - deleting the length before it is resolved. */ - init->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); - init->ts.u.cl->length - = gfc_copy_expr (sym->ts.u.cl->length); - - for (c = gfc_constructor_first (init->value.constructor); - c; c = gfc_constructor_next (c)) - gfc_set_constant_character_len (len, c->expr, -1); - } - } - } + /* Update initializer character length according to symbol. */ + else if (sym->ts.u.cl->length->expr_type == EXPR_CONSTANT + && !fix_initializer_charlen (&sym->ts, init)) + return false; } if (sym->attr.flavor == FL_PARAMETER && sym->attr.dimension && sym->as @@ -2369,6 +2378,13 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, c->initializer = *init; *init = NULL; + /* Update initializer character length according to component. */ + if (c->ts.type == BT_CHARACTER && c->ts.u.cl->length + && c->ts.u.cl->length->expr_type == EXPR_CONSTANT + && c->initializer && c->initializer->ts.type == BT_CHARACTER + && !fix_initializer_charlen (&c->ts, c->initializer)) + return false; + c->as = *as; if (c->as != NULL) {