From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wr1-x430.google.com (mail-wr1-x430.google.com [IPv6:2a00:1450:4864:20::430]) by sourceware.org (Postfix) with ESMTPS id 2DE403858298 for ; Tue, 8 Nov 2022 08:44:05 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 2DE403858298 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-wr1-x430.google.com with SMTP id w14so19775185wru.8 for ; Tue, 08 Nov 2022 00:44:05 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=NxABMzgiER8Gdek6L1aNZtWMZx+iDJwY5L7wNosL1Co=; b=YoFYVAeNqM0+1kCrxG02m+Xi6Bqweyh73YLVXFaXXtYxL/RMkfjtPQP6WTbTqy9rDG DSCM99adlBNdoAV17AqfggcZrnVKM6svUpmNWEnWwJjzIg/Z81qIFnAPIRwQgbiLL0N4 3b8y+51P2faM/m8HKty+XJC1n45TurKvxie+GIQ4YHFAhJapUFVvKxznCfOl7CXp/WDZ 1Dy8S5M7cTVJeq32i7up3IwRj6yR/GKVO+AbyxxjkHooP9m9V7CzxlPcQHMbgn719le5 fX/FxIuJwsdQj4Uh/dvt+b2YkyMVlTpACMgQ6+GK4+2qcvpnsHiOhPdThOq2Rk2ozfDZ dybg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=NxABMzgiER8Gdek6L1aNZtWMZx+iDJwY5L7wNosL1Co=; b=U7daPipZcAW8blCKGRec6lC2re2B2trm1hGlg36Jz7BZbYL192Bb7KvfOZJoaFkXyK xfeN5rIjFWl9jGcy7BY9kSCpj8X9an1IbZVZ5f3hlJbVDJIJiAZrQ0l/dMiU5W5PxqIT G7Rp/cO2jG72SmVxrNHfgeU8PvSVuT3VPYc77YG2k4s+ZP7grWTOQs2sUFs6pJ2f5i1R FrbYnrzhgVmz/xEUWZiTGSGJA7oD14K/pRW1wGe4Sc8LSa+c4+sfyhL14v+X6MjHfZXK MU+7xmrn2sS3Gir/Bx3eKSbAAgCs+dIDPlQKM+O3B7kAaAEVaslC9q4IwK6ySHafkuV3 kFig== X-Gm-Message-State: ACrzQf3noYZ7LdulTyInJ6Cev26QWd/Cn+535/56IiwVHT27XCAC83JT G4bPnaeS+KjJ+obayAVmIXUafGSQl/ggQQ== X-Google-Smtp-Source: AMsMyM6gKeYu2cg7bYb3rC1T3H+b6zRXSyZLlCwkykNsNZwxxqPNaaj1uxROGMy/sPnaQlpBV9byRw== X-Received: by 2002:adf:f092:0:b0:236:6753:cc3a with SMTP id n18-20020adff092000000b002366753cc3amr35085539wro.62.1667897044085; Tue, 08 Nov 2022 00:44:04 -0800 (PST) Received: from localhost.localdomain (static-176-191-105-132.ftth.abo.bbox.fr. [176.191.105.132]) by smtp.gmail.com with ESMTPSA id t188-20020a1c46c5000000b003cfa622a18asm7162190wma.3.2022.11.08.00.44.03 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 08 Nov 2022 00:44:03 -0800 (PST) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Fix oversight in implementation of allocators for storage models Date: Tue, 8 Nov 2022 09:44:00 +0100 Message-Id: <20221108084400.302294-1-poulhies@adacore.com> X-Mailer: git-send-email 2.34.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-13.4 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,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 List-Id: From: Eric Botcazou When the allocator is of an unconstrained array type and has an initializing expression, the copy of the initializing expression must be done separately from that of the bounds. gcc/ada/ * gcc-interface/utils2.cc (build_allocator): For unconstrained array types with a storage model and an initializing expression, copy the initialization expression separately from the bounds. In all cases with a storage model, pass the locally computed size for the store. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/gcc-interface/utils2.cc | 33 ++++++++++++++++++++++++++------- 1 file changed, 26 insertions(+), 7 deletions(-) diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc index ef81f8dd56a..80d550c91e1 100644 --- a/gcc/ada/gcc-interface/utils2.cc +++ b/gcc/ada/gcc-interface/utils2.cc @@ -2439,8 +2439,8 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, tree storage_ptr_type = build_pointer_type (storage_type); tree lhs, rhs; - size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (TYPE_SIZE_UNIT (storage_type), - init); + size = TYPE_SIZE_UNIT (storage_type); + size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (size, init); /* If the size overflows, pass -1 so Storage_Error will be raised. */ if (TREE_CODE (size) == INTEGER_CST && !valid_constant_size_p (size)) @@ -2454,8 +2454,10 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, /* If there is an initializing expression, then make a constructor for the entire object including the bounds and copy it into the object. - If there is no initializing expression, just set the bounds. */ - if (init) + If there is no initializing expression, just set the bounds. Note + that, if we have a storage model, we need to copy the initializing + expression separately from the bounds. */ + if (init && !pool_is_storage_model) { vec *v; vec_alloc (v, 2); @@ -2472,11 +2474,28 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, { lhs = build_component_ref (storage_deref, TYPE_FIELDS (storage_type), false); - rhs = build_template (template_type, type, NULL_TREE); + rhs = build_template (template_type, type, init); } if (pool_is_storage_model) - storage_init = build_storage_model_store (gnat_pool, lhs, rhs); + { + storage_init = build_storage_model_store (gnat_pool, lhs, rhs); + if (init) + { + start_stmt_group (); + add_stmt (storage_init); + lhs + = build_component_ref (storage_deref, + DECL_CHAIN (TYPE_FIELDS (storage_type)), + false); + rhs = init; + size = TYPE_SIZE_UNIT (TREE_TYPE (lhs)); + size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (size, init); + tree t = build_storage_model_store (gnat_pool, lhs, rhs, size); + add_stmt (t); + storage_init = end_stmt_group (); + } + } else storage_init = build_binary_op (INIT_EXPR, NULL_TREE, lhs, rhs); @@ -2520,7 +2539,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, TREE_THIS_NOTRAP (storage_deref) = 1; if (pool_is_storage_model) storage_init - = build_storage_model_store (gnat_pool, storage_deref, init); + = build_storage_model_store (gnat_pool, storage_deref, init, size); else storage_init = build_binary_op (INIT_EXPR, NULL_TREE, storage_deref, init); -- 2.34.1