From patchwork Tue Apr 25 09:28:59 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 754660 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org 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 3wByb02RPpz9s2G for ; Tue, 25 Apr 2017 19:29:14 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="nbdRuqqk"; dkim-atps=neutral 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=EMKP4BAlCKTrrLjHhcqV24Vj5DqANSFZ75cvWSYqUcUr5D9SM4 ux2Dtpcn262CcG3H8hVeADE8BUAoml4rMJfYMYL/0IaDzfBAGzaxkWZcfdSxbWy9 HpaTA3N2TMyWSKp1YMJir2vY7uS/bzdHPAgKB4fXMZ+VXZnvK+ot8fISg= 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=SG/ai+TkFwn2YyzRR8+OmQA5lho=; b=nbdRuqqkNptwxbcshPyx ktkGEjfFLFy3d++p6Ms0iHDL0fMN7L4Xa9l/PzW+AgqIxu0+KrgyrddLYO3h8Kpp sDBrFe0tluJ7oGT/PCD7s6yLXdCJ0TAJfas3wF7oWoOHN/hTClOx7JiqpnKCZcYi aJ3BIs87SOD1oz8ZwLqJ9sA= Received: (qmail 13082 invoked by alias); 25 Apr 2017 09:29:02 -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 11072 invoked by uid 89); 25 Apr 2017 09:29:02 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-14.5 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=Expo, sk:corresp 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; Tue, 25 Apr 2017 09:28:59 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 1582B3546; Tue, 25 Apr 2017 05:29:00 -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 MM+p+9Av8cJy; Tue, 25 Apr 2017 05:29:00 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id 016FE129D58; Tue, 25 Apr 2017 05:29:00 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4192) id EF4E4521; Tue, 25 Apr 2017 05:28:59 -0400 (EDT) Date: Tue, 25 Apr 2017 05:28:59 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Justin Squirek Subject: [Ada] Visibility problem using Import aspect Message-ID: <20170425092859.GA47984@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch corrects an issue whereby an import aspect used within a generic package would fail to resolve. By analyzing the expresions within the aspect's arguments (a.k.a "interfacing" aspects) in addition to the generated pragma's arguments the generic template gets properly resolved names for instance creation. ------------ -- Source -- ------------ -- p.ads package P is type T1 is new Integer; end P; -- p-q.ads generic package P.Q is type T2 is new Integer; end P.Q; -- p-q-r.adb with Ada.Text_IO; with P.W.Z; package body P.Q.R is X : constant Integer with Import, Convention => Ada, External_Name => W.Z.S; procedure Proc is begin Ada.Text_IO.Put_Line (Item => X'Img); end Proc; end P.Q.R; -- p-q-r.ads generic package P.Q.R is procedure Proc; end P.Q.R; -- p-w.ads package P.W is type T3 is new Integer; end P.W; -- p-w-z.ads package P.W.Z is S : constant String := "Halloween"; end P.W.Z; -- x.ads with P.Q.R; package X is package X1 is new P.Q; package X2 is new X1.R; end X; ---------------------------- -- Compilation and output -- ---------------------------- $ gcc -c x.ads Tested on x86_64-pc-linux-gnu, committed on trunk 2017-04-25 Justin Squirek * sem_ch13.adb (Get_Interfacing_Aspects): Moved to sem_util.adb. * sem_prag.adb (Analyze_Pragma, Process_Import_Or_Interface): Add extra parameter for Process_Interface_Name. (Process_Interface_Name): Add parameter for pragma to analyze corresponding aspect. * sem_util.ads, sem_util.adb (Get_Interfacing_Aspects): Added from sem_ch13.adb Index: sem_ch13.adb =================================================================== --- sem_ch13.adb (revision 247146) +++ sem_ch13.adb (working copy) @@ -147,27 +147,6 @@ -- Uint value. If the value is inappropriate, then error messages are -- posted as required, and a value of No_Uint is returned. - procedure Get_Interfacing_Aspects - (Iface_Asp : Node_Id; - Conv_Asp : out Node_Id; - EN_Asp : out Node_Id; - Expo_Asp : out Node_Id; - Imp_Asp : out Node_Id; - LN_Asp : out Node_Id; - Do_Checks : Boolean := False); - -- Given a single interfacing aspect Iface_Asp, retrieve other interfacing - -- aspects that apply to the same related entity. The aspects considered by - -- this routine are as follows: - -- - -- Conv_Asp - aspect Convention - -- EN_Asp - aspect External_Name - -- Expo_Asp - aspect Export - -- Imp_Asp - aspect Import - -- LN_Asp - aspect Link_Name - -- - -- When flag Do_Checks is set, this routine will flag duplicate uses of - -- aspects. - function Is_Operational_Item (N : Node_Id) return Boolean; -- A specification for a stream attribute is allowed before the full type -- is declared, as explained in AI-00137 and the corrigendum. Attributes @@ -11214,106 +11193,6 @@ end if; end Get_Alignment_Value; - ----------------------------- - -- Get_Interfacing_Aspects -- - ----------------------------- - - procedure Get_Interfacing_Aspects - (Iface_Asp : Node_Id; - Conv_Asp : out Node_Id; - EN_Asp : out Node_Id; - Expo_Asp : out Node_Id; - Imp_Asp : out Node_Id; - LN_Asp : out Node_Id; - Do_Checks : Boolean := False) - is - procedure Save_Or_Duplication_Error - (Asp : Node_Id; - To : in out Node_Id); - -- Save the value of aspect Asp in node To. If To already has a value, - -- then this is considered a duplicate use of aspect. Emit an error if - -- flag Do_Checks is set. - - ------------------------------- - -- Save_Or_Duplication_Error -- - ------------------------------- - - procedure Save_Or_Duplication_Error - (Asp : Node_Id; - To : in out Node_Id) - is - begin - -- Detect an extra aspect and issue an error - - if Present (To) then - if Do_Checks then - Error_Msg_Name_1 := Chars (Identifier (Asp)); - Error_Msg_Sloc := Sloc (To); - Error_Msg_N ("aspect % previously given #", Asp); - end if; - - -- Otherwise capture the aspect - - else - To := Asp; - end if; - end Save_Or_Duplication_Error; - - -- Local variables - - Asp : Node_Id; - Asp_Id : Aspect_Id; - - -- The following variables capture each individual aspect - - Conv : Node_Id := Empty; - EN : Node_Id := Empty; - Expo : Node_Id := Empty; - Imp : Node_Id := Empty; - LN : Node_Id := Empty; - - -- Start of processing for Get_Interfacing_Aspects - - begin - -- The input interfacing aspect should reside in an aspect specification - -- list. - - pragma Assert (Is_List_Member (Iface_Asp)); - - -- Examine the aspect specifications of the related entity. Find and - -- capture all interfacing aspects. Detect duplicates and emit errors - -- if applicable. - - Asp := First (List_Containing (Iface_Asp)); - while Present (Asp) loop - Asp_Id := Get_Aspect_Id (Asp); - - if Asp_Id = Aspect_Convention then - Save_Or_Duplication_Error (Asp, Conv); - - elsif Asp_Id = Aspect_External_Name then - Save_Or_Duplication_Error (Asp, EN); - - elsif Asp_Id = Aspect_Export then - Save_Or_Duplication_Error (Asp, Expo); - - elsif Asp_Id = Aspect_Import then - Save_Or_Duplication_Error (Asp, Imp); - - elsif Asp_Id = Aspect_Link_Name then - Save_Or_Duplication_Error (Asp, LN); - end if; - - Next (Asp); - end loop; - - Conv_Asp := Conv; - EN_Asp := EN; - Expo_Asp := Expo; - Imp_Asp := Imp; - LN_Asp := LN; - end Get_Interfacing_Aspects; - ------------------------------------- -- Inherit_Aspects_At_Freeze_Point -- ------------------------------------- Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 247157) +++ sem_prag.adb (working copy) @@ -3927,7 +3927,8 @@ procedure Process_Interface_Name (Subprogram_Def : Entity_Id; Ext_Arg : Node_Id; - Link_Arg : Node_Id); + Link_Arg : Node_Id; + Prag : Node_Id); -- Given the last two arguments of pragma Import, pragma Export, or -- pragma Interface_Name, performs validity checks and sets the -- Interface_Name field of the given subprogram entity to the @@ -3936,7 +3937,9 @@ -- Ext_Arg may represent the Link_Name if Link_Arg is missing, and -- appropriate named notation is used for Ext_Arg. If neither Ext_Arg -- nor Link_Arg is present, the interface name is set to the default - -- from the subprogram name. + -- from the subprogram name. In addition, the pragma itself is passed + -- to analyze any expressions in the case the pragma came from an aspect + -- specification. procedure Process_Interrupt_Or_Attach_Handler; -- Common processing for Interrupt and Attach_Handler pragmas @@ -8421,7 +8424,7 @@ Set_Imported (Def_Id); end if; - Process_Interface_Name (Def_Id, Arg3, Arg4); + Process_Interface_Name (Def_Id, Arg3, Arg4, N); -- Note that we do not set Is_Public here. That's because we -- only want to set it if there is no address clause, and we @@ -8583,7 +8586,7 @@ end if; end; - Process_Interface_Name (Def_Id, Arg3, Arg4); + Process_Interface_Name (Def_Id, Arg3, Arg4, N); end if; if Is_Compilation_Unit (Hom_Id) then @@ -9128,7 +9131,8 @@ procedure Process_Interface_Name (Subprogram_Def : Entity_Id; Ext_Arg : Node_Id; - Link_Arg : Node_Id) + Link_Arg : Node_Id; + Prag : Node_Id) is Ext_Nam : Node_Id; Link_Nam : Node_Id; @@ -9179,6 +9183,40 @@ -- Start of processing for Process_Interface_Name begin + -- If we are looking at a pragma that comes from an aspect then it + -- needs to have its corresponding aspect argument expressions + -- analyzed in addition to the generated pragma so that aspects + -- within generic units get properly resolved. + + if Present (Prag) and then From_Aspect_Specification (Prag) then + declare + Asp : constant Node_Id := Corresponding_Aspect (Prag); + Dummy_1 : Node_Id; + Dummy_2 : Node_Id; + Dummy_3 : Node_Id; + EN : Node_Id; + LN : Node_Id; + + begin + -- Obtain all interfacing aspects used to construct the pragma + + Get_Interfacing_Aspects + (Asp, Dummy_1, EN, Dummy_2, Dummy_3, LN); + + -- Analyze the expression of aspect External_Name + + if Present (EN) then + Analyze (Expression (EN)); + end if; + + -- Analyze the expressio of aspect Link_Name + + if Present (LN) then + Analyze (Expression (LN)); + end if; + end; + end if; + if No (Link_Arg) then if No (Ext_Arg) then return; @@ -13497,7 +13535,7 @@ if Arg_Count >= 2 then Set_Imported (Def_Id); Set_Is_Public (Def_Id); - Process_Interface_Name (Def_Id, Arg2, Arg3); + Process_Interface_Name (Def_Id, Arg2, Arg3, N); end if; Set_Has_Completion (Def_Id); @@ -14648,7 +14686,7 @@ (Get_Pragma_Arg (Arg2), Sure => False); end if; - Process_Interface_Name (Def_Id, Arg3, Arg4); + Process_Interface_Name (Def_Id, Arg3, Arg4, N); Set_Exported (Def_Id, Arg2); end if; @@ -15154,7 +15192,7 @@ Note_Possible_Modification (Get_Pragma_Arg (Arg2), Sure => False); - Process_Interface_Name (E, Arg3, Arg4); + Process_Interface_Name (E, Arg3, Arg4, N); Set_Exported (E, Arg2); end External; @@ -16607,7 +16645,7 @@ end if; Set_Is_Public (Def_Id); - Process_Interface_Name (Def_Id, Arg2, Arg3); + Process_Interface_Name (Def_Id, Arg2, Arg3, N); end if; -- Otherwise must be subprogram @@ -16627,7 +16665,7 @@ Def_Id := Get_Base_Subprogram (Hom_Id); if Is_Imported (Def_Id) then - Process_Interface_Name (Def_Id, Arg2, Arg3); + Process_Interface_Name (Def_Id, Arg2, Arg3, N); Found := True; end if; Index: sem_util.adb =================================================================== --- sem_util.adb (revision 247156) +++ sem_util.adb (working copy) @@ -8181,6 +8181,106 @@ end if; end Get_Index_Bounds; + ----------------------------- + -- Get_Interfacing_Aspects -- + ----------------------------- + + procedure Get_Interfacing_Aspects + (Iface_Asp : Node_Id; + Conv_Asp : out Node_Id; + EN_Asp : out Node_Id; + Expo_Asp : out Node_Id; + Imp_Asp : out Node_Id; + LN_Asp : out Node_Id; + Do_Checks : Boolean := False) + is + procedure Save_Or_Duplication_Error + (Asp : Node_Id; + To : in out Node_Id); + -- Save the value of aspect Asp in node To. If To already has a value, + -- then this is considered a duplicate use of aspect. Emit an error if + -- flag Do_Checks is set. + + ------------------------------- + -- Save_Or_Duplication_Error -- + ------------------------------- + + procedure Save_Or_Duplication_Error + (Asp : Node_Id; + To : in out Node_Id) + is + begin + -- Detect an extra aspect and issue an error + + if Present (To) then + if Do_Checks then + Error_Msg_Name_1 := Chars (Identifier (Asp)); + Error_Msg_Sloc := Sloc (To); + Error_Msg_N ("aspect % previously given #", Asp); + end if; + + -- Otherwise capture the aspect + + else + To := Asp; + end if; + end Save_Or_Duplication_Error; + + -- Local variables + + Asp : Node_Id; + Asp_Id : Aspect_Id; + + -- The following variables capture each individual aspect + + Conv : Node_Id := Empty; + EN : Node_Id := Empty; + Expo : Node_Id := Empty; + Imp : Node_Id := Empty; + LN : Node_Id := Empty; + + -- Start of processing for Get_Interfacing_Aspects + + begin + -- The input interfacing aspect should reside in an aspect specification + -- list. + + pragma Assert (Is_List_Member (Iface_Asp)); + + -- Examine the aspect specifications of the related entity. Find and + -- capture all interfacing aspects. Detect duplicates and emit errors + -- if applicable. + + Asp := First (List_Containing (Iface_Asp)); + while Present (Asp) loop + Asp_Id := Get_Aspect_Id (Asp); + + if Asp_Id = Aspect_Convention then + Save_Or_Duplication_Error (Asp, Conv); + + elsif Asp_Id = Aspect_External_Name then + Save_Or_Duplication_Error (Asp, EN); + + elsif Asp_Id = Aspect_Export then + Save_Or_Duplication_Error (Asp, Expo); + + elsif Asp_Id = Aspect_Import then + Save_Or_Duplication_Error (Asp, Imp); + + elsif Asp_Id = Aspect_Link_Name then + Save_Or_Duplication_Error (Asp, LN); + end if; + + Next (Asp); + end loop; + + Conv_Asp := Conv; + EN_Asp := EN; + Expo_Asp := Expo; + Imp_Asp := Imp; + LN_Asp := LN; + end Get_Interfacing_Aspects; + --------------------------------- -- Get_Iterable_Type_Primitive -- --------------------------------- Index: sem_util.ads =================================================================== --- sem_util.ads (revision 247156) +++ sem_util.ads (working copy) @@ -923,6 +923,27 @@ -- the index type turns out to be a partial view; this case should not -- arise during normal compilation of semantically correct programs. + procedure Get_Interfacing_Aspects + (Iface_Asp : Node_Id; + Conv_Asp : out Node_Id; + EN_Asp : out Node_Id; + Expo_Asp : out Node_Id; + Imp_Asp : out Node_Id; + LN_Asp : out Node_Id; + Do_Checks : Boolean := False); + -- Given a single interfacing aspect Iface_Asp, retrieve other interfacing + -- aspects that apply to the same related entity. The aspects considered by + -- this routine are as follows: + -- + -- Conv_Asp - aspect Convention + -- EN_Asp - aspect External_Name + -- Expo_Asp - aspect Export + -- Imp_Asp - aspect Import + -- LN_Asp - aspect Link_Name + -- + -- When flag Do_Checks is set, this routine will flag duplicate uses of + -- aspects. + function Get_Enum_Lit_From_Pos (T : Entity_Id; Pos : Uint;