From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from d208-18.smtp-out.ca-central-1.amazonses.com (d208-18.smtp-out.ca-central-1.amazonses.com [23.249.208.18]) by sourceware.org (Postfix) with ESMTPS id EAD0E3858404 for ; Thu, 10 Aug 2023 05:27:13 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org EAD0E3858404 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=annexi-strayline.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=ca-central-1.amazonses.com DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/simple; s=k5b76xhpalcgrb3af3ji3mgpa4ove7c7; d=annexi-strayline.com; t=1691645233; h=From:To:Cc:References:In-Reply-To:Subject:Date:Message-ID:MIME-Version:Content-Type; bh=37nLQFMv5eiRvtqKi2KoMPI6TEmzE8WXM+7F7Re9ugY=; b=iLL/N6hTjyXkUQ6S7+QjSSX9Ov6RHHJCZrELR0eOLpMF69H2IUrWRA+HDEviThN1 /jRcK+8h382hAAIyyxS6r5MnVDTOCywl01WLM5Qujg2GIEoUF06H9pPcgwmokMEzjNk mW5D5m2RoeaKPGGG3VKCYkXkJ95RPJ9pmjaE5QI8= DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/simple; s=qpcfy54xse57bzmyicqs5kisv46vyagl; d=amazonses.com; t=1691645233; h=From:To:Cc:References:In-Reply-To:Subject:Date:Message-ID:MIME-Version:Content-Type:Feedback-ID; bh=37nLQFMv5eiRvtqKi2KoMPI6TEmzE8WXM+7F7Re9ugY=; b=HZOOBW2cGQtUjW8j1+1dVXoZmqf1Z1O0BqBXUQ9DtuZpLJ6gNdcVetbJ7VNbmeih ncNPWVPyZALGFImdPkFRbdGBnvH6OVd6Hgs/904Ku9x2Uwn356Y2mjf5kAxG9bVD4N3 Q1kfIQNg0+G9qPAuU9C9gqh2/TIvaHvvVhM/Lzk0= From: Richard Wai To: gcc-patches@gcc.gnu.org Cc: 'Eric Botcazou' , 'Arnaud Charlet' , 'Stephen Baird' References: <010d0189ddcc5ef0-fd001d71-0986-4cce-8d50-53fa385360db-000000@ca-central-1.amazonses.com> In-Reply-To: <010d0189ddcc5ef0-fd001d71-0986-4cce-8d50-53fa385360db-000000@ca-central-1.amazonses.com> Subject: [PATCH 2/2] Ada: Finalization of constrained subtypes of unconstrained synchronized private extensions Date: Thu, 10 Aug 2023 05:27:13 +0000 Message-ID: <010d0189dde9c811-5386a11a-f2ec-4265-b8c9-49e130af2d0e-000000@ca-central-1.amazonses.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="----=_NextPart_000_0079_01D9CB29.CA1D0F20" X-Mailer: Microsoft Outlook 16.0 Thread-Index: AdnLSwFkehgYe0ZGQ4qRF96ffMfVLQ== Content-Language: en-ca Feedback-ID: 1.ca-central-1.KKZpW0DP3lOi0JgzUh4V+obZyxLGOx2dpGS8+RWwiDg=:AmazonSES X-SES-Outgoing: 2023.08.10-23.249.208.18 X-Spam-Status: No, score=1.4 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,DOS_OUTLOOK_TO_MX,HEADER_FROM_DIFFERENT_DOMAINS,HTML_MESSAGE,RCVD_IN_DNSWL_NONE,RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,SPF_PASS,TXREP autolearn=no autolearn_force=no version=3.4.6 X-Spam-Level: * X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: This is a multipart message in MIME format. ------=_NextPart_000_0079_01D9CB29.CA1D0F20 Content-Type: multipart/alternative; boundary="----=_NextPart_001_007A_01D9CB29.CA1D0F20" ------=_NextPart_001_007A_01D9CB29.CA1D0F20 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit When generating TSS address finalization bodies for a tagged class-wide subtype, GNAT climbs the parent chain looking for the first "non-constrained" type. That type's underlying type's class-wide type is used as a "designated" type for a dispatching TSS deep finalize call to the designated class-wide type. In the case of a constrained subtype of an unconstrained synchronized private extension, this ends up designating the underlying type of that private extension. This means it targets the class-wide type of the actual underlying concurrent type rather than the corresponding record. Ultimately it ends up generating a call to the corresponding record's deep finalizer, but with incompatible types (concurrent_type'Class -> concurrent_typeV'Class). This causes compilation to fail. This patch adds extra logic to exp_ch7(Make_Finalize_Address_Stmts) to identify such cases and ensure that the designated type is the corresponding record type's class-wide type in that situation. Patch file is attached. -- Begin change log entry - ada: TSS finalize address subprogram generation for constrained subtypes of unconstrained synchronized private extensions should take care to designate the corresponding record of the underlying concurrent type. When generating TSS finalize address subprograms for class-wide types of constrained root types, it follows the parent chain looking for the first "non-constrained" type. It is possible that such a type is a private extension with the "synchronized" keyword, in which case the underlying type is a concurrent type. When that happens, the designated type of the finalize address subprogram should be the corresponding record's class-wide-type. Gcc/ada/ * exp_ch3(Expand_Freeze_Class_Wide_Type): Expanded comments explaining why TSS Finalize_Address is not generated for concurrent class-wide types. * exp_ch7(Make_Finalize_Address_Stmts): Handle cases where the underlying non-constrained parent type is a concurrent type, and adjust the designated type to be the corresponding record's class-wide type. -- End change log entry - This patch was bootstrapped on x86_64-*-freebsd13.2. One new test cases was added. Note that 4 gnat test cases fail currently on master and are unrelated to this patch. Check-ada output of this patch: === acats tests === Running chapter a ... Running chapter c2 ... Running chapter c3 ... Running chapter c4 ... Running chapter c5 ... Running chapter c6 ... Running chapter c7 ... Running chapter c8 ... Running chapter c9 ... Running chapter ca ... Running chapter cb ... Running chapter cc ... Running chapter cd ... Running chapter ce ... Running chapter cxa ... Running chapter cxb ... Running chapter cxf ... Running chapter cxg ... Running chapter cxh ... Running chapter cz ... Running chapter d ... Running chapter e ... Running chapter l ... === acats Summary === # of expected passes 2328 # of unexpected failures 0 Native configuration is x86_64-unknown-freebsd13.2 === gnat tests === Schedule of variations: unix Running target unix FAIL: gnat.dg/specs/alignment2.ads (test for warnings, line 14) FAIL: gnat.dg/specs/alignment2.ads (test for warnings, line 20) FAIL: gnat.dg/specs/alignment2.ads (test for warnings, line 38) FAIL: gnat.dg/specs/alignment2.ads (test for warnings, line 42) === gnat Summary === # of expected passes 3401 # of unexpected failures 4 # of expected failures 23 # of unsupported tests 10 gnatmake version 14.0.0 20230809 (experimental) Richard Wai ANNEXI-STRAYLINE ------=_NextPart_001_007A_01D9CB29.CA1D0F20-- ------=_NextPart_000_0079_01D9CB29.CA1D0F20 Content-Type: application/octet-stream; name="ada-tss-constrained-subtype-of-private-synchronized-extention.patch" Content-Transfer-Encoding: quoted-printable Content-Disposition: attachment; filename="ada-tss-constrained-subtype-of-private-synchronized-extention.patch" >From 73582f931e77e506b64b311486b8804a03b8a87f Mon Sep 17 00:00:00 2001=0A= From: Richard Wai =0A= Date: Wed, 9 Aug 2023 01:45:54 -0400=0A= Subject: [PATCH 2/2] ada: fix designated type selection for the creation of= =0A= finalize address bodies in the case of a constrained subtype of a unconstr= ained synchronized private extension.=0A= =0A= ---=0A= gcc/ada/exp_ch3.adb | 4 ++=0A= gcc/ada/exp_ch7.adb | 26 ++++++++-=0A= gcc/testsuite/gnat.dg/sync_tag_finalize.adb | 60 +++++++++++++++++++++=0A= 3 files changed, 88 insertions(+), 2 deletions(-)=0A= create mode 100644 gcc/testsuite/gnat.dg/sync_tag_finalize.adb=0A= =0A= diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb=0A= index 04c3ad8c631..bb015986200 100644=0A= --- a/gcc/ada/exp_ch3.adb=0A= +++ b/gcc/ada/exp_ch3.adb=0A= @@ -5000,6 +5000,10 @@ package body Exp_Ch3 is=0A= -- Do not create TSS routine Finalize_Address for concurrent class-= wide=0A= -- types. Ignore C, C++, CIL and Java types since it is assumed tha= t the=0A= -- non-Ada side will handle their destruction.=0A= + --=0A= + -- Concurrent Ada types are functionally represented by an associat= ed=0A= + -- "corresponding record type" (typenameV), which owns the actual T= SS=0A= + -- finalize bodies for the type (and technically class-wide type).= =0A= =20=0A= elsif Is_Concurrent_Type (Root)=0A= or else Is_C_Derivation (Root)=0A= diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb=0A= index aa16c707887..5b4381697c5 100644=0A= --- a/gcc/ada/exp_ch7.adb=0A= +++ b/gcc/ada/exp_ch7.adb=0A= @@ -8512,7 +8512,8 @@ package body Exp_Ch7 is=0A= Is_Empty_Elmt_List (Discriminant_Constraint (Root_Type (Typ)))= =0A= then=0A= declare=0A= - Parent_Typ : Entity_Id;=0A= + Parent_Typ : Entity_Id;=0A= + Parent_Utyp : Entity_Id;=0A= =20=0A= begin=0A= -- Climb the parent type chain looking for a non-constrained = type=0A= @@ -8533,7 +8534,28 @@ package body Exp_Ch7 is=0A= Parent_Typ :=3D Underlying_Record_View (Parent_Typ);=0A= end if;=0A= =20=0A= - Desig_Typ :=3D Class_Wide_Type (Underlying_Type (Parent_Typ));= =0A= + Parent_Utyp :=3D Underlying_Type (Parent_Typ);=0A= +=0A= + -- Handle views created for a synchronized private extension = with=0A= + -- known, non-defaulted discriminants. In that case, parent_t= yp=0A= + -- will be the private extension, as it is the first "non=0A= + -- -constrained" type in the parent chain. Unfortunately, the= =0A= + -- underlying type, being a protected or task type, is not th= e=0A= + -- "real" type needing finalization. Rather, the "correspondi= ng=0A= + -- record type" should be the designated type here. In fact, = TSS=0A= + -- finalizer generation is specifically skipped for the nomin= al=0A= + -- class-wide type of (the full view of) a concurrent type (s= ee=0A= + -- exp_ch7.Expand_Freeze_Class_Wide_Type). If we don't design= ate=0A= + -- the underlying record (Tprot_typeVC), we will end up tryin= g to=0A= + -- dispatch to prot_typeVDF from an incorrectly designated=0A= + -- Tprot_typeC, which is, of course, not actually a member of= =0A= + -- prot_typeV'Class, and thus incompatible.=0A= +=0A= + if Present (Corresponding_Record_Type (Parent_Utyp)) then=0A= + Parent_Utyp :=3D Corresponding_Record_Type (Parent_Utyp);= =0A= + end if;=0A= +=0A= + Desig_Typ :=3D Class_Wide_Type (Parent_Utyp);=0A= end;=0A= =20=0A= -- General case=0A= diff --git a/gcc/testsuite/gnat.dg/sync_tag_finalize.adb b/gcc/testsuite/gn= at.dg/sync_tag_finalize.adb=0A= new file mode 100644=0A= index 00000000000..1e9df0edbaa=0A= --- /dev/null=0A= +++ b/gcc/testsuite/gnat.dg/sync_tag_finalize.adb=0A= @@ -0,1 +1,60 @@=0A= +-- In previous versions of GNAT there was a curious bug that caused=0A= +-- compilation to fail in the case of a synchronized private extension=0A= +-- with non-default discriminants, where the creation of a constrained ob= ject=0A= +-- (and thus subtype) caused the TSS deep finalize machinery of the inter= nal=0A= +-- class-wide constratined subtype (TConstrainedC) to construct a malform= ed=0A= +-- TSS finalize address body. The issue was that the machinery climbs=0A= +-- the type parent chain looking for a "non-constrained" type to use as a= =0A= +-- designated (class-wide) type for a dispatching call to a higher TSS DF= =0A= +-- subprogram. When there is a discriminated synchronized private extensi= on=0A= +-- with known, non-default discriminants (thus unconstrained/indefinite),= =20=0A= +-- that search ends up at that private extension declaration. Since the= =0A= +-- underlying type is actually a concurrent type, class-wide TSS finalize= rs=0A= +-- are not built for the type, but rather the corresponding record type. = The=0A= +-- TSS machinery that selects the designated type was prevsiously unaware= of=0A= +-- this caveat, and thus selected an incompatible designated type, leadin= g to=0A= +-- failed compilation.=0A= +--=0A= +-- TL;DR: When creating a constrained subtype of a synchronized private= =0A= +-- extension with known non-defaulted disciminants, the class-wide TSS=0A= +-- address finalization body for the constrained subtype should dispatch = to=0A= +-- the corresponding record (class-wide) type deep finalize subprogram.= =0A= +=0A= +-- { dg-do compile }=0A= +=0A= +procedure Sync_Tag_Finalize is=0A= +=20=20=20=0A= + package Ifaces is=0A= +=20=20=20=20=20=20=0A= + type Test_Interface is synchronized interface;=0A= +=20=20=20=20=20=20=0A= + procedure Interface_Action (Test: in out Test_Interface) is abstract= ;=0A= +=20=20=20=20=20=20=0A= + end Ifaces;=0A= +=20=20=20=0A= +=20=20=20=0A= + package Implementation is=0A= + type Test_Implementation=0A= + (Constraint: Positive) is=0A= + synchronized new Ifaces.Test_Interface with private;=0A= +=20=20=20=20=20=20=0A= + private=0A= + protected type Test_Implementation=0A= + (Constraint: Positive)=0A= + is new Ifaces.Test_Interface with=0A= +=20=20=20=20=20=20=0A= + overriding procedure Interface_Action;=0A= +=20=20=20=20=20=20=20=20=20=0A= + end Test_Implementation;=0A= + end Implementation;=0A= +=20=20=20=0A= + package body Implementation is=0A= + protected body Test_Implementation is=0A= + procedure Interface_Action is null;=0A= + end;=0A= + end Implementation;=0A= +=20=20=20=0A= + Constrained: Implementation.Test_Implementation(2);=0A= +begin=0A= + null;=0A= +end;=0A= --=20=0A= 2.40.1=0A= =0A= ------=_NextPart_000_0079_01D9CB29.CA1D0F20--