From patchwork Tue Jan 6 09:24:53 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 425581 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 530F61400B7 for ; Tue, 6 Jan 2015 20:25:26 +1100 (AEDT) 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=i0voyqcVAFdaYBxdNYqlbsw+wWlW4YB0W35kW0KUpYZkxgtRWO Ep7FI6hFp6XqwB0wSS7JQ/DwBrI3pbDnuBmkfHLAFrjuntt3KZqg0OgXnQLp9zji uoyhja82W5ypuwn652lxYniVYP6oboGq2cp/SPukkODlm6XaVPfMC0F/M= 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=v9HALfxN8zPbtwPjdlDSS+gF6qE=; b=Z8DiInG3DLcmfA6GDqm6 vTHZhZk8HfuYCfuQ1m5Cbb7Lwi4pmi/SyCpdDmd381SK4y0wA+OZ2t9wR+AN7TDJ INbio2JHxeY6aM8oglGd5cVAEVq0pUgLKzonBrVgdjpsemWPRWRdpmggHhCqK5w1 FQfgwHE1EWZ5WavND+XnrPE= Received: (qmail 32241 invoked by alias); 6 Jan 2015 09:24:57 -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 32176 invoked by uid 89); 6 Jan 2015 09:24:56 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham version=3.3.2 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 (AES256-SHA encrypted) ESMTPS; Tue, 06 Jan 2015 09:24:55 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 7C7AB116434; Tue, 6 Jan 2015 04:24:53 -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 XyGWcY9hrCxE; Tue, 6 Jan 2015 04:24:53 -0500 (EST) Received: from kwai.gnat.com (kwai.gnat.com [IPv6:2620:20:4000:0:7a2b:cbff:fe60:cb11]) by rock.gnat.com (Postfix) with ESMTP id 277C1116431; Tue, 6 Jan 2015 04:24:53 -0500 (EST) Received: by kwai.gnat.com (Postfix, from userid 4192) id 226B691A7D; Tue, 6 Jan 2015 04:24:53 -0500 (EST) Date: Tue, 6 Jan 2015 04:24:53 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Thomas Quinot Subject: [Ada] Function in RCI cannot have anonymous access result Message-ID: <20150106092453.GA17046@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.21 (2010-09-15) Enforce rule from E.2.3(14/3): the return type of an RCI function must support external streaming; per 13.13.2(52/3) an anonymous access type does not support external streaming. The following code is illegal and must be rejected: $ gcc -c rci_func_return_anon_access.adb rci_func_return_anon_access.ads:3:04: function in RCI unit cannot have access result package rci_func_return_anon_access is pragma Remote_Call_Interface; function F return access Integer; end rci_func_return_anon_access; package body rci_func_return_anon_access is X : aliased Integer; function F return access Integer is begin return X'Access; end F; end rci_func_return_anon_access; Tested on x86_64-pc-linux-gnu, committed on trunk 2015-01-06 Thomas Quinot * sem_cat.adb (In_RCI_Declaration): Remove unnecessary parameter and rename to... (In_RCI_Visible_Declarations): Fix handling of private part of nested package. (Validate_RCI_Subprogram_Declaration): Reject illegal function returning anonymous access in RCI unit. Index: sem_cat.adb =================================================================== --- sem_cat.adb (revision 219191) +++ sem_cat.adb (working copy) @@ -86,10 +86,10 @@ -- Return True if the entity or one of its subcomponents does not support -- external streaming. - function In_RCI_Declaration (N : Node_Id) return Boolean; - -- Determines if a declaration is within the visible part of a Remote - -- Call Interface compilation unit, for semantic checking purposes only - -- (returns false within an instance and within the package body). + function In_RCI_Visible_Declarations return Boolean; + -- Determines if the visible part of a remote call interface library unit + -- is being compiled, for semantic checking purposes (returns False within + -- an instance and within the package body). function In_RT_Declaration return Boolean; -- Determines if current scope is within the declaration of a Remote Types @@ -544,31 +544,40 @@ return Is_Pure (Current_Scope); end In_Pure_Unit; - ------------------------ - -- In_RCI_Declaration -- - ------------------------ + --------------------------------- + -- In_RCI_Visible_Declarations -- + --------------------------------- - function In_RCI_Declaration (N : Node_Id) return Boolean is - Unit_Entity : constant Entity_Id := Current_Scope; + function In_RCI_Visible_Declarations return Boolean is + Unit_Entity : Entity_Id := Current_Scope; Unit_Kind : constant Node_Kind := Nkind (Unit (Cunit (Current_Sem_Unit))); begin - -- There are no restrictions on the private part or body - -- of an RCI unit. + -- There are no restrictions on the private part or body of an RCI unit - return Is_Remote_Call_Interface (Unit_Entity) + if not (Is_Remote_Call_Interface (Unit_Entity) and then Is_Package_Or_Generic_Package (Unit_Entity) and then Unit_Kind /= N_Package_Body - and then List_Containing (N) = - Visible_Declarations (Package_Specification (Unit_Entity)) - and then not In_Package_Body (Unit_Entity) - and then not In_Instance; + and then not In_Instance) + then + return False; + end if; - -- What about the case of a nested package in the visible part??? - -- This case is missed by the List_Containing check above??? - end In_RCI_Declaration; + while Unit_Entity /= Standard_Standard loop + if In_Private_Part (Unit_Entity) then + return False; + end if; + Unit_Entity := Scope (Unit_Entity); + end loop; + + -- Here if in RCI declaration, and not in private part of any open + -- scope. + + return True; + end In_RCI_Visible_Declarations; + ----------------------- -- In_RT_Declaration -- ----------------------- @@ -1371,7 +1380,7 @@ -- The visible part of an RCI library unit must not contain the -- declaration of a variable (RM E.1.3(9)) - elsif In_RCI_Declaration (N) then + elsif In_RCI_Visible_Declarations then Error_Msg_N ("visible variable not allowed in 'R'C'I unit", N); -- The visible part of a Shared Passive library unit must not contain @@ -1609,7 +1618,7 @@ -- 1. from Analyze_Subprogram_Declaration. -- 2. from Validate_Object_Declaration (access to subprogram). - if not (Comes_From_Source (N) and then In_RCI_Declaration (N)) then + if not (Comes_From_Source (N) and then In_RCI_Visible_Declarations) then return; end if; @@ -1652,12 +1661,10 @@ -- Report error only if declaration is in source program - if Comes_From_Source - (Defining_Entity (Specification (N))) - then + if Comes_From_Source (Id) then Error_Msg_N ("subprogram in 'R'C'I unit cannot have access parameter", - Error_Node); + Error_Node); end if; -- For a limited private type parameter, we check only the private @@ -1680,8 +1687,15 @@ Next (Param_Spec); end loop; + end if; - -- No check on return type??? + if Ekind (Id) = E_Function + and then Ekind (Etype (Id)) = E_Anonymous_Access_Type + and then Comes_From_Source (Id) + then + Error_Msg_N + ("function in 'R'C'I unit cannot have access result", + Error_Node); end if; end Validate_RCI_Subprogram_Declaration; @@ -1698,8 +1712,8 @@ -- the given node is N_Access_To_Object_Definition. if not Comes_From_Source (T) - or else (not In_RCI_Declaration (Parent (T)) - and then not In_RT_Declaration) + or else (not In_RCI_Visible_Declarations + and then not In_RT_Declaration) then return; end if; @@ -1721,7 +1735,7 @@ if Ekind (T) /= E_General_Access_Type or else not Is_Class_Wide_Type (Designated_Type (T)) then - if In_RCI_Declaration (Parent (T)) then + if In_RCI_Visible_Declarations then Error_Msg_N ("error in access type in Remote_Call_Interface unit", T); else