From patchwork Thu Apr 25 10:07:43 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 239451 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 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id C7B822C0109 for ; Thu, 25 Apr 2013 20:07:56 +1000 (EST) 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=pRcrwuhJMJ3svobs+bHWRON0IWVKy7I2wM6sH8tInWE7vzwMda JHBI00LzbmRSycqmr8OfnqyVRHsiQa+bjGq+Oq06USIrl+SYJWV04WAGrP6QTltS BMp/+gcij85JdZ482ESGCEiQ0UK3GIJaNHuuE0fAW7FDt9ezyj/kattR0= 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=ahL45PKDj2jZlrKG4GBiBMJSMHM=; b=vFmzQ3RwZHxaJ1cM6gmN MXXKU1fT8HTBOratxG+SnSfT4Q9agxSQNSlj7lj827/DShQCISh4S+tjcE5ZeuC6 oV6LN7txUuDzBAB2MMZEWiUVmJJ7S0wGxOg5USsK9jwvQHtkN+XVASqZJXD5SUa5 oqfhrHsm6tBpN4TwaZ7/Yrw= Received: (qmail 1657 invoked by alias); 25 Apr 2013 10:07:48 -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 1644 invoked by uid 89); 25 Apr 2013 10:07:47 -0000 X-Spam-SWARE-Status: No, score=-0.9 required=5.0 tests=AWL, BAYES_40, RCVD_IN_HOSTKARMA_NO autolearn=ham version=3.3.1 Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Thu, 25 Apr 2013 10:07:45 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id B80462E890; Thu, 25 Apr 2013 06:07:43 -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 gipUNV-9QoQ3; Thu, 25 Apr 2013 06:07:43 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 9893A2E7DC; Thu, 25 Apr 2013 06:07:43 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 8EEE13FF09; Thu, 25 Apr 2013 06:07:43 -0400 (EDT) Date: Thu, 25 Apr 2013 06:07:43 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Subject: [Ada] Ghost entities Message-ID: <20130425100743.GA28534@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) X-Virus-Found: No This patch provides partial support for ghost entities, in particular ghost subprograms. Ghost entities are no longer categorized as such by an aspect, instead one should use aspect/pragma Convention with convention_identifier Ghost. ------------ -- Source -- ------------ -- gen.ads generic type Element is private; with function Formal_Func (Val : Element) return Element; package Gen is end Gen; -- illegal_usage.ads with Gen; package Illegal_Usage is function Ghost_Func (Val : Integer) return Integer with Convention => Ghost; function Ren_GF_1 (Val : Integer) return Integer renames Ghost_Func; function Ren_GF_2 (Val : Integer) return Integer renames Ren_GF_1; subtype Nat_Subtype_1 is Natural with Dynamic_Predicate => Ghost_Func (Nat_Subtype_1) > 1; subtype Nat_Subtype_2 is Natural with Dynamic_Predicate => Ren_GF_1 (Nat_Subtype_2) > 1; subtype Nat_Subtype_3 is Natural with Dynamic_Predicate => Ren_GF_2 (Nat_Subtype_3) > 1; -- Ghost function cannot be called from subtype predicates package Inst is new Gen (Integer, Ghost_Func); -- Ghost function cannot act as generic actuals type Iface_1 is interface; function Func_1 return Iface_1 is abstract; function Func_2 return Iface_1 is abstract; type Impl_Type_1 is new Iface_1 with null record; overriding function Func_1 return Impl_Type_1 with Convention => Ghost; function Func_2 return Impl_Type_1 with Convention => Ghost; -- Ghost functions cannot override type Iface_2 is interface; function Func_3 return Iface_2 is abstract with Convention => Ghost; function Func_4 return Iface_2 is abstract with Convention => Ghost; type Impl_Type_2 is new Iface_2 with null record; overriding function Func_3 return Impl_Type_2 with Convention => Ghost; function Func_4 return Impl_Type_2 with Convention => Ghost; -- Ghost functions cannot override procedure Proc; -- An illegal context that does not allow the use of ghost functions end Illegal_Usage; -- illegal_usage.adb package body Illegal_Usage is overriding function Func_1 return Impl_Type_1 is Result : Impl_Type_1; begin return Result; end Func_1; function Func_2 return Impl_Type_1 is begin return Func_1; end Func_2; overriding function Func_3 return Impl_Type_2 is Result : Impl_Type_2; begin return Result; end Func_3; function Func_4 return Impl_Type_2 is begin return Func_3; end Func_4; function Ghost_Func (Val : Integer) return Integer is begin return Val + 1; end Ghost_Func; procedure Proc is type Ghost_Func_Ptr is access function (Val : Integer) return Integer; Ptr : constant Ghost_Func_Ptr := Ghost_Func'Access; -- Cannot take 'Access of a ghost function Var : Integer; begin Var := Ghost_Func (1); Var := Ren_GF_1 (2); Var := Ren_GF_2 (3); -- Cannot call ghost functions from a non-ghost function context end Proc; end Illegal_Usage; ---------------------------- -- Compilation and output -- ---------------------------- $ gcc -c -gnat12 -gnata illegal_usage.adb illegal_usage.adb:31:40: prefix of "Access" attribute cannot be a ghost subprogram illegal_usage.adb:37:14: call to ghost subprogram must appear in assertion expression or another ghost subprogram illegal_usage.adb:38:14: call to ghost subprogram must appear in assertion expression or another ghost subprogram illegal_usage.adb:39:14: call to ghost subprogram must appear in assertion expression or another ghost subprogram illegal_usage.ads:12:32: call to ghost subprogram must appear in assertion expression or another ghost subprogram illegal_usage.ads:14:32: call to ghost subprogram must appear in assertion expression or another ghost subprogram illegal_usage.ads:16:32: call to ghost subprogram must appear in assertion expression or another ghost subprogram illegal_usage.ads:19:38: ghost subprogram "Ghost_Func" cannot act as generic actual illegal_usage.ads:19:38: instantiation abandoned illegal_usage.ads:27:24: ghost subprogram "Func_1" cannot be overriding illegal_usage.ads:29:13: ghost subprogram "Func_2" cannot be overriding illegal_usage.ads:38:24: ghost subprogram "Func_3" cannot be overriding illegal_usage.ads:40:13: ghost subprogram "Func_4" cannot be overriding Tested on x86_64-pc-linux-gnu, committed on trunk 2013-04-25 Hristian Kirtchev * aspects.ads, aspects.adb: Remove aspect Ghost from all relevant tables. * einfo.adb: Remove with and use clause for Aspects. (Is_Ghost_Function): Removed. (Is_Ghost_Entity): New routine. (Is_Ghost_Subprogram): New routine. * einfo.ads: Remove synthesized attribute Is_Ghost_Function along with its uses in entities. Add synthesized attributes Is_Ghost_Entity and Is_Ghost_Subprogram along with uses in related entities. (Is_Ghost_Function): Removed. (Is_Ghost_Entity): New routine. (Is_Ghost_Subprogram): New routine. * par-prag.adb: Remove pragma Ghost from the processing machinery. * repinfo.adb (List_Mechanisms): Add a value for convention Ghost. * sem_attr.adb (Analyze_Access_Attribute): Update the check for ghost subprograms. * sem_ch4.adb (Analyze_Call): Update the check for calls to ghost subprograms. (Check_Ghost_Function_Call): Removed. (Check_Ghost_Subprogram_Call): New routine. * sem_ch6.adb (Check_Convention): Rewritten. (Check_Overriding_Indicator): Remove the check for overriding ghost functions. (Convention_Of): New routine. * sem_ch12.adb (Preanalyze_Actuals): Update the check for ghost generic actual subprograms. * sem_mech.adb (Set_Mechanisms): Add an entry for convention Ghost. * sem_prag.adb: Remove the value for pragma Ghost from table Sig_Flags. (Analyze_Pragma): Remove the processing for pragma Ghost. (Process_Convention): Emit an error when a ghost subprogram attempts to override. (Set_Convention_From_Pragma): Emit an error when a ghost subprogram attempts to override. * sinfo.ads: Clarify the usage of field Label_Construct. * snames.adb-tmpl (Get_Convention_Id): Add an entry for predefined name Ghost. (Get_Convention_Name): Add an entry for convention Ghost. * snames.ads-tmpl: Move predefined name Ghost to the sublist denoting conventions. Add convention id Ghost. Remove pragma id Ghost. Index: sinfo.ads =================================================================== --- sinfo.ads (revision 198223) +++ sinfo.ads (working copy) @@ -1414,10 +1414,10 @@ -- Label_Construct (Node2-Sem) -- Used in an N_Implicit_Label_Declaration node. Refers to an N_Label, -- N_Block_Statement or N_Loop_Statement node to which the label - -- declaration applies. This is not currently used in the compiler - -- itself, but it is useful in the implementation of ASIS queries. - -- This field is left empty for the special labels generated as part - -- of expanding raise statements with a local exception handler. + -- declaration applies. This attribute is used both in the compiler and + -- in the implementation of ASIS queries. The field is left empty for the + -- special labels generated as part of expanding raise statements with a + -- local exception handler. -- Library_Unit (Node4-Sem) -- In a stub node, Library_Unit points to the compilation unit node of Index: einfo.adb =================================================================== --- einfo.adb (revision 198235) +++ einfo.adb (working copy) @@ -32,7 +32,6 @@ pragma Style_Checks (All_Checks); -- Turn off subprogram ordering, not used for this unit -with Aspects; use Aspects; with Atree; use Atree; with Namet; use Namet; with Nlists; use Nlists; @@ -6575,27 +6574,41 @@ return Ekind (Id) = E_Procedure and then Chars (Id) = Name_uFinalizer; end Is_Finalizer; - ----------------------- - -- Is_Ghost_Function -- - ----------------------- + --------------------- + -- Is_Ghost_Entity -- + --------------------- - function Is_Ghost_Function (Id : E) return B is + function Is_Ghost_Entity (Id : E) return B is + begin + if Present (Id) and then Ekind (Id) = E_Variable then + return Convention (Id) = Convention_Ghost; + else + return Is_Ghost_Subprogram (Id); + end if; + end Is_Ghost_Entity; + + ------------------------- + -- Is_Ghost_Subprogram -- + ------------------------- + + function Is_Ghost_Subprogram (Id : E) return B is Subp_Id : Entity_Id := Id; begin - if Present (Subp_Id) and then Ekind (Subp_Id) = E_Function then + if Present (Subp_Id) + and then Ekind_In (Subp_Id, E_Function, E_Procedure) + then + -- Handle subprogram renamings - -- Handle renamings of functions - if Present (Alias (Subp_Id)) then Subp_Id := Alias (Subp_Id); end if; - return Has_Aspect (Subp_Id, Aspect_Ghost); + return Convention (Subp_Id) = Convention_Ghost; end if; return False; - end Is_Ghost_Function; + end Is_Ghost_Subprogram; -------------------- -- Is_Input_State -- Index: einfo.ads =================================================================== --- einfo.ads (revision 198235) +++ einfo.ads (working copy) @@ -2314,10 +2314,14 @@ -- package, generic function, generic procedure), and False for all -- other entities. --- Is_Ghost_Function (synthesized) --- Applies to all entities. Yields True for a function marked by aspect --- Ghost. +-- Is_Ghost_Entity (synthesized) +-- Applies to all entities. Yields True for a subprogram or a whole +-- object that has convention Ghost. +-- Is_Ghost_Subprogram (synthesized) +-- Applies to all entities. Yields True for a subprogram that has a Ghost +-- convention. + -- Is_Hidden (Flag57) -- Defined in all entities. Set true for all entities declared in the -- private part or body of a package. Also marks generic formals of a @@ -4219,6 +4223,7 @@ -- floating point subtype created by a floating point type declaration. E_Floating_Point_Subtype, + -- Floating point subtype, created by either a floating point subtype -- or floating point type declaration (in the latter case a floating -- point type is created for the base type, and this is the first @@ -5428,7 +5433,8 @@ -- Address_Clause (synth) -- First_Formal (synth) -- First_Formal_With_Extras (synth) - -- Is_Ghost_Function (synth) (non-generic case only) + -- Is_Ghost_Entity (synth) (non-generic case only) + -- Is_Ghost_Subprogram (synth) (non-generic case only) -- Last_Formal (synth) -- Number_Formals (synth) -- Scope_Depth (synth) @@ -5701,6 +5707,8 @@ -- First_Formal (synth) -- First_Formal_With_Extras (synth) -- Is_Finalizer (synth) + -- Is_Ghost_Entity (synth) (non-generic case only) + -- Is_Ghost_Subprogram (synth) (non-generic case only) -- Last_Formal (synth) -- Number_Formals (synth) @@ -5907,6 +5915,7 @@ -- Treat_As_Volatile (Flag41) -- Address_Clause (synth) -- Alignment_Clause (synth) + -- Is_Ghost_Entity (synth) -- Size_Clause (synth) -- E_Void @@ -6638,7 +6647,8 @@ function Is_Discriminal (Id : E) return B; function Is_Dynamic_Scope (Id : E) return B; function Is_Finalizer (Id : E) return B; - function Is_Ghost_Function (Id : E) return B; + function Is_Ghost_Entity (Id : E) return B; + function Is_Ghost_Subprogram (Id : E) return B; function Is_Input_State (Id : E) return B; function Is_Null_State (Id : E) return B; function Is_Output_State (Id : E) return B; Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 198244) +++ sem_prag.adb (working copy) @@ -4975,9 +4975,16 @@ and then Present (Overridden_Operation (E)) and then C /= Convention (Overridden_Operation (E)) then - Error_Pragma_Arg - ("cannot change convention for overridden dispatching " - & "operation", Arg1); + -- An attempt to override a subprogram with a ghost subprogram + -- appears as a mismatch in conventions. + + if C = Convention_Ghost then + Error_Msg_N ("ghost subprogram & cannot be overriding", E); + else + Error_Pragma_Arg + ("cannot change convention for overridden dispatching " + & "operation", Arg1); + end if; end if; -- Special checks for Convention_Stdcall @@ -5136,14 +5143,14 @@ if C = Convention_Ada_Pass_By_Copy then if not Is_First_Subtype (E) then Error_Pragma_Arg - ("convention `Ada_Pass_By_Copy` only " - & "allowed for types", Arg2); + ("convention `Ada_Pass_By_Copy` only allowed for types", + Arg2); end if; if Is_By_Reference_Type (E) then Error_Pragma_Arg - ("convention `Ada_Pass_By_Copy` not allowed for " - & "by-reference type", Arg1); + ("convention `Ada_Pass_By_Copy` not allowed for by-reference " + & "type", Arg1); end if; end if; @@ -5152,17 +5159,25 @@ if C = Convention_Ada_Pass_By_Reference then if not Is_First_Subtype (E) then Error_Pragma_Arg - ("convention `Ada_Pass_By_Reference` only " - & "allowed for types", Arg2); + ("convention `Ada_Pass_By_Reference` only allowed for types", + Arg2); end if; if Is_By_Copy_Type (E) then Error_Pragma_Arg - ("convention `Ada_Pass_By_Reference` not allowed for " - & "by-copy type", Arg1); + ("convention `Ada_Pass_By_Reference` not allowed for by-copy " + & "type", Arg1); end if; end if; + -- Ghost special checking + + if Is_Ghost_Subprogram (E) + and then Present (Overridden_Operation (E)) + then + Error_Msg_N ("ghost subprogram & cannot be overriding", E); + end if; + -- Go to renamed subprogram if present, since convention applies to -- the actual renamed entity, not to the renaming entity. If the -- subprogram is inherited, go to parent subprogram. @@ -5299,8 +5314,8 @@ Generate_Reference (E, Id, 'i'); end if; - -- If the pragma comes from from an aspect, it only applies - -- to the given entity, not its homonyms. + -- If the pragma comes from from an aspect, it only applies to the + -- given entity, not its homonyms. if From_Aspect_Specification (N) then return; @@ -11842,39 +11857,6 @@ end if; end Float_Representation; - ----------- - -- Ghost -- - ----------- - - -- pragma GHOST (function_LOCAL_NAME); - - when Pragma_Ghost => Ghost : declare - Subp : Node_Id; - Subp_Id : Entity_Id; - - begin - GNAT_Pragma; - S14_Pragma; - Check_Arg_Count (1); - Check_Arg_Is_Local_Name (Arg1); - - -- Ensure the proper placement of the pragma. Ghost must be - -- associated with a subprogram declaration. - - Subp := Parent (Corresponding_Aspect (N)); - - if Nkind (Subp) /= N_Subprogram_Declaration then - Pragma_Misplaced; - return; - end if; - - Subp_Id := Defining_Unit_Name (Specification (Subp)); - - if Ekind (Subp_Id) /= E_Function then - Error_Pragma ("pragma % must be applied to a function"); - end if; - end Ghost; - ------------ -- Global -- ------------ @@ -13120,6 +13102,7 @@ -- before the body is built (e.g. within an expression function). PDecl := Build_Invariant_Procedure_Declaration (Typ); + Insert_After (N, PDecl); Analyze (PDecl); @@ -17993,7 +17976,7 @@ Set_Is_Ignored (N, True); when Name_Disable => - Set_Is_Ignored (N, True); + Set_Is_Ignored (N, True); Set_Is_Disabled (N, True); when others => @@ -18277,7 +18260,6 @@ Pragma_Fast_Math => -1, Pragma_Finalize_Storage_Only => 0, Pragma_Float_Representation => 0, - Pragma_Ghost => 0, Pragma_Global => -1, Pragma_Ident => -1, Pragma_Implementation_Defined => -1, Index: sem_ch12.adb =================================================================== --- sem_ch12.adb (revision 198221) +++ sem_ch12.adb (working copy) @@ -12401,13 +12401,13 @@ Analyze (Act); end if; - -- Ensure that a ghost function does not act as generic actual + -- Ensure that a ghost subprogram does not act as generic actual if Is_Entity_Name (Act) - and then Is_Ghost_Function (Entity (Act)) + and then Is_Ghost_Subprogram (Entity (Act)) then Error_Msg_N - ("ghost function & cannot act as generic actual", Act); + ("ghost subprogram & cannot act as generic actual", Act); Abandon_Instantiation (Act); elsif Errs /= Serious_Errors_Detected then Index: sem_attr.adb =================================================================== --- sem_attr.adb (revision 198243) +++ sem_attr.adb (working copy) @@ -602,9 +602,9 @@ elsif Aname = Name_Unchecked_Access then Error_Attr ("attribute% cannot be applied to a subprogram", P); - elsif Is_Ghost_Function (Entity (P)) then + elsif Is_Ghost_Subprogram (Entity (P)) then Error_Attr_P - ("prefix of % attribute cannot be a ghost function"); + ("prefix of % attribute cannot be a ghost subprogram"); end if; -- Issue an error if the prefix denotes an eliminated subprogram Index: repinfo.adb =================================================================== --- repinfo.adb (revision 198235) +++ repinfo.adb (working copy) @@ -684,6 +684,8 @@ Write_Line ("Intrinsic"); when Convention_Entry => Write_Line ("Entry"); + when Convention_Ghost => + Write_Line ("Ghost"); when Convention_Protected => Write_Line ("Protected"); when Convention_Assembler => Index: sem_ch4.adb =================================================================== --- sem_ch4.adb (revision 198240) +++ sem_ch4.adb (working copy) @@ -854,10 +854,10 @@ -- Flag indicates whether an interpretation of the prefix is a -- parameterless call that returns an access_to_subprogram. - procedure Check_Ghost_Function_Call; - -- Verify the legality of a call to a ghost function. Such calls can + procedure Check_Ghost_Subprogram_Call; + -- Verify the legality of a call to a ghost subprogram. Such calls can -- appear only in assertion expressions except subtype predicates or - -- from within another ghost function. + -- from within another ghost subprogram. procedure Check_Mixed_Parameter_And_Named_Associations; -- Check that parameter and named associations are not mixed. This is @@ -873,15 +873,15 @@ procedure No_Interpretation; -- Output error message when no valid interpretation exists - ------------------------------- - -- Check_Ghost_Function_Call -- - ------------------------------- + --------------------------------- + -- Check_Ghost_Subprogram_Call -- + --------------------------------- - procedure Check_Ghost_Function_Call is + procedure Check_Ghost_Subprogram_Call is S : Entity_Id; begin - -- The ghost function appears inside an assertion expression + -- The ghost subprogram appears inside an assertion expression if In_Assertion_Expression (N) then return; @@ -890,9 +890,9 @@ S := Current_Scope; while Present (S) and then S /= Standard_Standard loop - -- The call appears inside another ghost function + -- The call appears inside another ghost subprogram - if Is_Ghost_Function (S) then + if Is_Ghost_Subprogram (S) then return; end if; @@ -901,9 +901,9 @@ end if; Error_Msg_N - ("call to ghost function must appear in assertion expression or " - & "another ghost function", N); - end Check_Ghost_Function_Call; + ("call to ghost subprogram must appear in assertion expression or " + & "another ghost subprogram", N); + end Check_Ghost_Subprogram_Call; -------------------------------------------------- -- Check_Mixed_Parameter_And_Named_Associations -- @@ -1275,11 +1275,11 @@ End_Interp_List; end if; - -- A call to a ghost function is allowed only in assertion expressions, - -- excluding subtype predicates, or from within another ghost function. + -- A call to a ghost subprogram is allowed only in assertion expressions + -- excluding subtype predicates or from within another ghost subprogram. - if Is_Ghost_Function (Get_Subprogram_Entity (N)) then - Check_Ghost_Function_Call; + if Is_Ghost_Subprogram (Get_Subprogram_Entity (N)) then + Check_Ghost_Subprogram_Call; end if; end Analyze_Call; Index: aspects.adb =================================================================== --- aspects.adb (revision 198221) +++ aspects.adb (working copy) @@ -358,7 +358,6 @@ Aspect_External_Name => Aspect_External_Name, Aspect_External_Tag => Aspect_External_Tag, Aspect_Favor_Top_Level => Aspect_Favor_Top_Level, - Aspect_Ghost => Aspect_Ghost, Aspect_Global => Aspect_Global, Aspect_Implicit_Dereference => Aspect_Implicit_Dereference, Aspect_Import => Aspect_Import, Index: sem_mech.adb =================================================================== --- sem_mech.adb (revision 198221) +++ sem_mech.adb (working copy) @@ -300,12 +300,14 @@ -- Ada -- --------- - -- Note: all RM defined conventions are treated the same - -- from the point of view of parameter passing mechanism + -- Note: all RM defined conventions are treated the same from + -- the point of view of parameter passing mechanism. Convention + -- Ghost has the same dynamic semantics as convention Ada. when Convention_Ada | Convention_Intrinsic | Convention_Entry | + Convention_Ghost | Convention_Protected | Convention_Stubbed => @@ -486,7 +488,6 @@ else Set_Mechanism (Formal, By_Reference); end if; - end case; end if; Index: aspects.ads =================================================================== --- aspects.ads (revision 198221) +++ aspects.ads (working copy) @@ -160,7 +160,6 @@ Aspect_Discard_Names, Aspect_Export, Aspect_Favor_Top_Level, -- GNAT - Aspect_Ghost, -- GNAT Aspect_Independent, Aspect_Independent_Components, Aspect_Import, @@ -215,7 +214,6 @@ Aspect_Dimension => True, Aspect_Dimension_System => True, Aspect_Favor_Top_Level => True, - Aspect_Ghost => True, Aspect_Global => True, Aspect_Inline_Always => True, Aspect_Invariant => True, @@ -380,7 +378,6 @@ Aspect_External_Tag => Name_External_Tag, Aspect_Export => Name_Export, Aspect_Favor_Top_Level => Name_Favor_Top_Level, - Aspect_Ghost => Name_Ghost, Aspect_Global => Name_Global, Aspect_Implicit_Dereference => Name_Implicit_Dereference, Aspect_Import => Name_Import, Index: sem_ch6.adb =================================================================== --- sem_ch6.adb (revision 198244) +++ sem_ch6.adb (working copy) @@ -6292,26 +6292,51 @@ ---------------------- procedure Check_Convention (Op : Entity_Id) is + function Convention_Of (Id : Entity_Id) return Convention_Id; + -- Given an entity, return its convention. The function treats Ghost + -- as convention Ada because the two have the same dynamic semantics. + + ------------------- + -- Convention_Of -- + ------------------- + + function Convention_Of (Id : Entity_Id) return Convention_Id is + Conv : constant Convention_Id := Convention (Id); + begin + if Conv = Convention_Ghost then + return Convention_Ada; + else + return Conv; + end if; + end Convention_Of; + + -- Local variables + + Op_Conv : constant Convention_Id := Convention_Of (Op); + Iface_Conv : Convention_Id; Iface_Elmt : Elmt_Id; Iface_Prim_Elmt : Elmt_Id; Iface_Prim : Entity_Id; + -- Start of processing for Check_Convention + begin Iface_Elmt := First_Elmt (Ifaces_List); while Present (Iface_Elmt) loop Iface_Prim_Elmt := - First_Elmt (Primitive_Operations (Node (Iface_Elmt))); + First_Elmt (Primitive_Operations (Node (Iface_Elmt))); while Present (Iface_Prim_Elmt) loop Iface_Prim := Node (Iface_Prim_Elmt); + Iface_Conv := Convention_Of (Iface_Prim); if Is_Interface_Conformant (Typ, Iface_Prim, Op) - and then Convention (Iface_Prim) /= Convention (Op) + and then Iface_Conv /= Op_Conv then Error_Msg_N ("inconsistent conventions in primitive operations", Typ); Error_Msg_Name_1 := Chars (Op); - Error_Msg_Name_2 := Get_Convention_Name (Convention (Op)); + Error_Msg_Name_2 := Get_Convention_Name (Op_Conv); Error_Msg_Sloc := Sloc (Op); if Comes_From_Source (Op) or else No (Alias (Op)) then @@ -6331,9 +6356,8 @@ end if; Error_Msg_Name_1 := Chars (Op); - Error_Msg_Name_2 := - Get_Convention_Name (Convention (Iface_Prim)); - Error_Msg_Sloc := Sloc (Iface_Prim); + Error_Msg_Name_2 := Get_Convention_Name (Iface_Conv); + Error_Msg_Sloc := Sloc (Iface_Prim); Error_Msg_N ("\\overridden operation % with " & "convention % defined #", Typ); @@ -6829,11 +6853,6 @@ else Set_Overridden_Operation (Subp, Overridden_Subp); end if; - - -- Ensure that a ghost function is not overriding another routine - - elsif Is_Ghost_Function (Subp) then - Error_Msg_N ("ghost function & cannot be overriding", Subp); end if; end if; @@ -12245,6 +12264,7 @@ if Ekind (Designator) /= E_Procedure and then Expander_Active + -- Check of Assertions_Enabled is certainly wrong ??? and then Assertions_Enabled then Func_Typ := Etype (Designator); @@ -12286,6 +12306,7 @@ -- IN OUT args. if Expander_Active and then Assertions_Enabled then + -- Check of Assertions_Enabled is certainly wrong ??? Formal := First_Formal (Designator); while Present (Formal) loop if Ekind (Formal) /= E_In_Parameter Index: par-prag.adb =================================================================== --- par-prag.adb (revision 198221) +++ par-prag.adb (working copy) @@ -1163,7 +1163,6 @@ Pragma_Fast_Math | Pragma_Finalize_Storage_Only | Pragma_Float_Representation | - Pragma_Ghost | Pragma_Global | Pragma_Ident | Pragma_Implementation_Defined | Index: snames.adb-tmpl =================================================================== --- snames.adb-tmpl (revision 198221) +++ snames.adb-tmpl (working copy) @@ -155,6 +155,7 @@ when Name_COBOL => return Convention_COBOL; when Name_CPP => return Convention_CPP; when Name_Fortran => return Convention_Fortran; + when Name_Ghost => return Convention_Ghost; when Name_Intrinsic => return Convention_Intrinsic; when Name_Java => return Convention_Java; when Name_Stdcall => return Convention_Stdcall; @@ -192,6 +193,7 @@ when Convention_CPP => return Name_CPP; when Convention_Entry => return Name_Entry; when Convention_Fortran => return Name_Fortran; + when Convention_Ghost => return Name_Ghost; when Convention_Intrinsic => return Name_Intrinsic; when Convention_Java => return Name_Java; when Convention_Protected => return Name_Protected; @@ -293,14 +295,14 @@ exit when Preset_Names (P_Index) = '#'; end loop; - -- Make sure that number of names in standard table is correct. If - -- this check fails, run utility program XSNAMES to construct a new - -- properly matching version of the body. + -- Make sure that number of names in standard table is correct. If this + -- check fails, run utility program XSNAMES to construct a new properly + -- matching version of the body. pragma Assert (Discard_Name = Last_Predefined_Name); - -- Initialize the convention identifiers table with the standard - -- set of synonyms that we recognize for conventions. + -- Initialize the convention identifiers table with the standard set of + -- synonyms that we recognize for conventions. Convention_Identifiers.Init; Index: snames.ads-tmpl =================================================================== --- snames.ads-tmpl (revision 198239) +++ snames.ads-tmpl (working copy) @@ -499,7 +499,6 @@ Name_Export_Valued_Procedure : constant Name_Id := N + $; -- GNAT Name_External : constant Name_Id := N + $; -- GNAT Name_Finalize_Storage_Only : constant Name_Id := N + $; -- GNAT - Name_Ghost : constant Name_Id := N + $; -- GNAT Name_Global : constant Name_Id := N + $; -- GNAT Name_Ident : constant Name_Id := N + $; -- VMS Name_Implementation_Defined : constant Name_Id := N + $; -- GNAT @@ -642,6 +641,7 @@ Name_COBOL : constant Name_Id := N + $; Name_CPP : constant Name_Id := N + $; Name_Fortran : constant Name_Id := N + $; + Name_Ghost : constant Name_Id := N + $; Name_Intrinsic : constant Name_Id := N + $; Name_Java : constant Name_Id := N + $; Name_Stdcall : constant Name_Id := N + $; @@ -1630,6 +1630,7 @@ Convention_Ada, Convention_Intrinsic, Convention_Entry, + Convention_Ghost, Convention_Protected, Convention_Stubbed, @@ -1795,7 +1796,6 @@ Pragma_Export_Valued_Procedure, Pragma_External, Pragma_Finalize_Storage_Only, - Pragma_Ghost, Pragma_Global, Pragma_Ident, Pragma_Implementation_Defined,