From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 34315 invoked by alias); 3 Dec 2018 15:52:12 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Received: (qmail 34305 invoked by uid 89); 3 Dec 2018 15:52:12 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.9 required=5.0 tests=BAYES_00,GIT_PATCH_2,GIT_PATCH_3,RCVD_IN_DNSWL_NONE,SPF_PASS autolearn=ham version=3.3.2 spammy=explained, Full, delayed X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 03 Dec 2018 15:52:09 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 5C238116538; Mon, 3 Dec 2018 10:52:08 -0500 (EST) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id Eb22OvULxs6G; Mon, 3 Dec 2018 10:52:08 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 663331163EB; Mon, 3 Dec 2018 10:52:07 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4862) id 653B73561; Mon, 3 Dec 2018 10:52:07 -0500 (EST) Date: Mon, 03 Dec 2018 15:52:00 -0000 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Fix internal error on package instantiation on private type Message-ID: <20181203155207.GA28479@adacore.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="fUYQa+Pmc3FrFX/N" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes X-SW-Source: 2018-12/txt/msg00093.txt.bz2 --fUYQa+Pmc3FrFX/N Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 1159 This fixes an assertion failure in gigi triggered by the instantiation of a generic package, in a visible part of another package, done on a private type whose full view is a type derived from a scalar or an access type. The problem is that the front-end creates and inserts two different freeze nodes in the expanded tree for the partial and the full views of the private subtype created by the instantiation, which is not correct: partial and full views of a given (sub)type must point to the same freeze node, if any. The patch also adds an assertion checking this property in the front-end so as to catch the inconsistency higher in the chain. Tested on x86_64-pc-linux-gnu, committed on trunk 2018-12-03 Eric Botcazou gcc/ada/ * freeze.adb (Freeze_Entity): Do not freeze the partial view of a private subtype if its base type is also private with delayed freeze before the full type declaration of the base type has been seen. * sem_ch7.adb (Preserve_Full_Attributes): Add assertion on freeze node. gcc/testsuite/ * gnat.dg/generic_inst2.adb, gnat.dg/generic_inst2.ads, gnat.dg/generic_inst2_c.ads: New testcase. --fUYQa+Pmc3FrFX/N Content-Type: text/x-diff; charset=us-ascii Content-Disposition: attachment; filename="patch.diff" Content-length: 3167 --- gcc/ada/freeze.adb +++ gcc/ada/freeze.adb @@ -6239,13 +6239,34 @@ package body Freeze is goto Leave; - -- Case of no full view present. If entity is derived or subtype, + -- Case of no full view present. If entity is subtype or derived, -- it is safe to freeze, correctness depends on the frozen status -- of parent. Otherwise it is either premature usage, or a Taft -- amendment type, so diagnosis is at the point of use and the -- type might be frozen later. - elsif E /= Base_Type (E) or else Is_Derived_Type (E) then + elsif E /= Base_Type (E) then + declare + Btyp : constant Entity_Id := Base_Type (E); + + begin + -- However, if the base type is itself private and has no + -- (underlying) full view either, wait until the full type + -- declaration is seen and all the full views are created. + + if Is_Private_Type (Btyp) + and then No (Full_View (Btyp)) + and then No (Underlying_Full_View (Btyp)) + and then Has_Delayed_Freeze (Btyp) + and then No (Freeze_Node (Btyp)) + then + Set_Is_Frozen (E, False); + Result := No_List; + goto Leave; + end if; + end; + + elsif Is_Derived_Type (E) then null; else --- gcc/ada/sem_ch7.adb +++ gcc/ada/sem_ch7.adb @@ -2733,6 +2733,15 @@ package body Sem_Ch7 is Propagate_Concurrent_Flags (Priv, Base_Type (Full)); end if; + -- As explained in Freeze_Entity, private types are required to point + -- to the same freeze node as their corresponding full view, if any. + -- But we ought not to overwrite a node already inserted in the tree. + + pragma Assert (Serious_Errors_Detected /= 0 + or else No (Freeze_Node (Priv)) + or else No (Parent (Freeze_Node (Priv))) + or else Freeze_Node (Priv) = Freeze_Node (Full)); + Set_Freeze_Node (Priv, Freeze_Node (Full)); -- Propagate Default_Initial_Condition-related attributes from the --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/generic_inst2.adb @@ -0,0 +1,5 @@ +-- { dg-do compile } + +package body Generic_Inst2 is + procedure Foo (X : not null access T) is null; +end; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/generic_inst2.ads @@ -0,0 +1,10 @@ +with Generic_Inst2_C; + +package Generic_Inst2 is + type T is private; + procedure Foo (X : not null access T); + package CI is new Generic_Inst2_C (T, Foo => Foo); +private + type S is access Integer; + type T is new S; +end; --- /dev/null new file mode 100644 +++ gcc/testsuite/gnat.dg/generic_inst2_c.ads @@ -0,0 +1,5 @@ +generic + type T; + with procedure Foo (X : not null access T) is null; + with procedure Bar (X : not null access T) is null; +package Generic_Inst2_C is end; --fUYQa+Pmc3FrFX/N--