From patchwork Wed Sep 6 09:34:42 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 810464 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-461564-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="gQM1kOvH"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3xnJMh1GPbz9s3T for ; Wed, 6 Sep 2017 19:34:55 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=LfMCosRW8TGRN61tnEP8Xlu7ysihKYFeV1W5XGgaZnzRMBmEql Y+RaKFFKNiYfsK5Jcgdt+47thbIaPLqhww9Svcfrt7zoDfPjjJ7WJRukoNhJbJcq RdLcexqu4QQFBrpd6ZfsEfU3UWfVqwlWLQbYHjQTZ/yINCwduU0LjtnNI= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=RlHnq2b4IxZggSSSL5ApaGHih2U=; b=gQM1kOvHDEfglZy77D6U yJYHP0F9EzD32n31buOtmhNz8lZGtIEVN84W4aj3lKrxS9en1kNZEc3DeyO+WEnU QAtfSAi/vFRBBKSvH7Wg7txqWdI/URv931U8eBzLqy6Qz8rQrw0w2RnXJRKB2emU cWsY/D5t/U9dSWMLAWJ9EAo= Received: (qmail 29261 invoked by alias); 6 Sep 2017 09:34:46 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 29195 invoked by uid 89); 6 Sep 2017 09:34:45 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.4 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=quietly 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; Wed, 06 Sep 2017 09:34:43 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 2BBBD5614B; Wed, 6 Sep 2017 05:34:42 -0400 (EDT) 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 aovoc4+U1FbF; Wed, 6 Sep 2017 05:34:42 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 1A3D75606C; Wed, 6 Sep 2017 05:34:42 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id 14C614FC; Wed, 6 Sep 2017 05:34:42 -0400 (EDT) Date: Wed, 6 Sep 2017 05:34:42 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Spurious error with formal incomplete types Message-ID: <20170906093442.GA125179@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch fixes a spurious error on the use of of a generic unit with formal incomplete types, as a formal package in another generic unit, when the actuals for the incomplete types are themselves formal incomplete types. The treatment of incomplete subtypes that are created for such formals is now more consistent with the handling of other subtypes, given their increased use in Ada2012. The following must compile quietly: --- gcc -c promote_2_streams.ads ---- generic type Data_Stream_Type; type Data_Type; with function Has_Data (Stream : not null access Data_Stream_Type) return Boolean; with function Consume (Stream : not null access Data_Stream_Type) return Data_Type; package Data_Streams is end; --- with Data_Streams; generic type Data1_Type is private; type Data2_Type is private; with package DS1 is new Data_Streams (Data_Type => Data1_Type, others => <>); with package DS2 is new Data_Streams (Data_Type => Data2_Type, others => <>); package Promote_2_Streams is type Which_Type is range 1 .. 2; type Data_Type (Which : Which_Type := 1) is record case Which is when 1 => Data1 : Data1_Type; when 2 => Data2 : Data2_Type; end case; end record; function Consume1 (Stream : not null access DS1.Data_Stream_Type) return Data_Type is ((Which => 1, Data1 => DS1.Consume (Stream))); function Consume2 (Stream : not null access DS2.Data_Stream_Type) return Data_Type is ((Which => 2, Data2 => DS2.Consume (Stream))); package PS1 is new Data_Streams (DS1.Data_Stream_Type, Data_Type, DS1.Has_Data, Consume1); package PS2 is new Data_Streams (DS2.Data_Stream_Type, Data_Type, DS2.Has_Data, Consume2); end Promote_2_Streams; Tested on x86_64-pc-linux-gnu, committed on trunk 2017-09-06 Ed Schonberg * einfo.adb (Designated_Type): Use Is_Incomplete_Type to handle properly incomplete subtypes that may be created by explicit or implicit declarations. (Is_Base_Type): Take E_Incomplete_Subtype into account. (Subtype_Kind): Ditto. * sem_ch3.adb (Build_Discriminated_Subtype): Set properly the Ekind of a subtype of a discriminated incomplete type. (Fixup_Bad_Constraint): Use Subtype_Kind in all cases, including incomplete types, to preserve error reporting. (Process_Incomplete_Dependents): Do not create a subtype declaration for an incomplete subtype that is created internally. * sem_ch7.adb (Analyze_Package_Specification): Handle properly incomplete subtypes that do not require a completion, either because they are limited views, of they are generic actuals. Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 251753) +++ sem_ch3.adb (working copy) @@ -10094,7 +10094,11 @@ -- elaboration, because only the access type is needed in the -- initialization procedure. - Set_Ekind (Def_Id, Ekind (T)); + if Ekind (T) = E_Incomplete_Type then + Set_Ekind (Def_Id, E_Incomplete_Subtype); + else + Set_Ekind (Def_Id, Ekind (T)); + end if; if For_Access and then Within_Init_Proc then null; @@ -13629,15 +13633,9 @@ procedure Fixup_Bad_Constraint is begin - -- Set a reasonable Ekind for the entity. For an incomplete type, - -- we can't do much, but for other types, we can set the proper - -- corresponding subtype kind. + -- Set a reasonable Ekind for the entity, including incomplete types. - if Ekind (T) = E_Incomplete_Type then - Set_Ekind (Def_Id, Ekind (T)); - else - Set_Ekind (Def_Id, Subtype_Kind (Ekind (T))); - end if; + Set_Ekind (Def_Id, Subtype_Kind (Ekind (T))); -- Set Etype to the known type, to reduce chances of cascaded errors @@ -20802,7 +20800,9 @@ -- Ada 2005 (AI-412): Transform a regular incomplete subtype into a -- corresponding subtype of the full view. - elsif Ekind (Priv_Dep) = E_Incomplete_Subtype then + elsif Ekind (Priv_Dep) = E_Incomplete_Subtype + and then Comes_From_Source (Priv_Dep) + then Set_Subtype_Indication (Parent (Priv_Dep), New_Occurrence_Of (Full_T, Sloc (Priv_Dep))); Set_Etype (Priv_Dep, Full_T); Index: sem_ch7.adb =================================================================== --- sem_ch7.adb (revision 251753) +++ sem_ch7.adb (working copy) @@ -1441,11 +1441,14 @@ -- Check on incomplete types - -- AI05-0213: A formal incomplete type has no completion + -- AI05-0213: A formal incomplete type has no completion, + -- and neither does the corresponding subtype in an instance. - if Ekind (E) = E_Incomplete_Type + if Is_Incomplete_Type (E) and then No (Full_View (E)) and then not Is_Generic_Type (E) + and then not From_Limited_With (E) + and then not Is_Generic_Actual_Type (E) then Error_Msg_N ("no declaration in visible part for incomplete}", E); end if; Index: einfo.adb =================================================================== --- einfo.adb (revision 251758) +++ einfo.adb (working copy) @@ -7151,13 +7151,13 @@ begin Desig_Type := Directly_Designated_Type (Id); - if Ekind (Desig_Type) = E_Incomplete_Type + if Is_Incomplete_Type (Desig_Type) and then Present (Full_View (Desig_Type)) then return Full_View (Desig_Type); elsif Is_Class_Wide_Type (Desig_Type) - and then Ekind (Etype (Desig_Type)) = E_Incomplete_Type + and then Is_Incomplete_Type (Etype (Desig_Type)) and then Present (Full_View (Etype (Desig_Type))) and then Present (Class_Wide_Type (Full_View (Etype (Desig_Type)))) then @@ -7364,11 +7364,11 @@ function Get_Full_View (T : Entity_Id) return Entity_Id is begin - if Ekind (T) = E_Incomplete_Type and then Present (Full_View (T)) then + if Is_Incomplete_Type (T) and then Present (Full_View (T)) then return Full_View (T); elsif Is_Class_Wide_Type (T) - and then Ekind (Root_Type (T)) = E_Incomplete_Type + and then Is_Incomplete_Type (Root_Type (T)) and then Present (Full_View (Root_Type (T))) then return Class_Wide_Type (Full_View (Root_Type (T))); @@ -7800,7 +7800,7 @@ Entity_Is_Base_Type : constant array (Entity_Kind) of Boolean := (E_Enumeration_Subtype | - E_Incomplete_Type | + E_Incomplete_Subtype | E_Signed_Integer_Subtype | E_Modular_Integer_Subtype | E_Floating_Point_Subtype | @@ -9174,6 +9174,9 @@ when Enumeration_Kind => Kind := E_Enumeration_Subtype; + when E_Incomplete_Type => + Kind := E_Incomplete_Subtype; + when Float_Kind => Kind := E_Floating_Point_Subtype;