2013-04-25 Robert Dewar <dewar@adacore.com>
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 25 Apr 2013 08:35:16 +0000 (08:35 +0000)
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 25 Apr 2013 08:35:16 +0000 (08:35 +0000)
* gnat_rm.texi: Minor fix to Loop_Variant doc (Loop_Entry allowed).
* s-tarest.adb: Minor reformatting.

2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

* 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.

2013-04-25  Ed Schonberg  <schonberg@adacore.com>

* sem_ch7.adb (Swap_Private_Dependents): Do no recurse on child
units if within a generic hierarchy.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@198275 138bc75d-0d04-0410-961f-82ee72b054a4

19 files changed:
gcc/ada/ChangeLog
gcc/ada/aspects.adb
gcc/ada/aspects.ads
gcc/ada/einfo.adb
gcc/ada/einfo.ads
gcc/ada/gnat_rm.texi
gcc/ada/par-prag.adb
gcc/ada/repinfo.adb
gcc/ada/s-tarest.adb
gcc/ada/sem_attr.adb
gcc/ada/sem_ch12.adb
gcc/ada/sem_ch4.adb
gcc/ada/sem_ch6.adb
gcc/ada/sem_ch7.adb
gcc/ada/sem_mech.adb
gcc/ada/sem_prag.adb
gcc/ada/sinfo.ads
gcc/ada/snames.adb-tmpl
gcc/ada/snames.ads-tmpl

index cfa0ea7..ce32cbc 100644 (file)
@@ -1,3 +1,58 @@
+2013-04-25  Robert Dewar  <dewar@adacore.com>
+
+       * gnat_rm.texi: Minor fix to Loop_Variant doc (Loop_Entry allowed).
+       * s-tarest.adb: Minor reformatting.
+
+2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * 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.
+
+2013-04-25  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch7.adb (Swap_Private_Dependents): Do no recurse on child
+       units if within a generic hierarchy.
+
 2013-04-24  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * exp_ch6.adb (Expand_Actuals): Add a predicate check on an
index 401928b..71f7493 100644 (file)
@@ -358,7 +358,6 @@ package body Aspects is
     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 ee8676a..c9560b8 100644 (file)
@@ -160,7 +160,6 @@ package Aspects is
       Aspect_Discard_Names,
       Aspect_Export,
       Aspect_Favor_Top_Level,               -- GNAT
-      Aspect_Ghost,                         -- GNAT
       Aspect_Independent,
       Aspect_Independent_Components,
       Aspect_Import,
@@ -215,7 +214,6 @@ package Aspects is
       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 @@ package Aspects is
       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 96e875e..50735a3 100644 (file)
@@ -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 @@ package body Einfo is
       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
-
-         --  Handle renamings of functions
+      if Present (Subp_Id)
+        and then Ekind_In (Subp_Id, E_Function, E_Procedure)
+      then
+         --  Handle subprogram renamings
 
          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 62cdb8e..fd38a1f 100644 (file)
@@ -2314,9 +2314,13 @@ package Einfo is
 --       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
@@ -4219,6 +4223,7 @@ package Einfo is
       --  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 @@ package Einfo is
    --    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 @@ package Einfo is
    --    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 @@ package Einfo is
    --    Treat_As_Volatile                   (Flag41)
    --    Address_Clause                      (synth)
    --    Alignment_Clause                    (synth)
+   --    Is_Ghost_Entity                     (synth)
    --    Size_Clause                         (synth)
 
    --  E_Void
@@ -6638,7 +6647,8 @@ package Einfo is
    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 6b2574b..05e938f 100644 (file)
@@ -4112,6 +4112,9 @@ to ignore the check (in which case the pragma has no effect on the program),
 or @code{Disable} in which case the pragma is not even checked for correct
 syntax.
 
+The @code{Loop_Entry} attribute may be used within the expressions of the
+@code{Loop_Variant} pragma to refer to values on entry to the loop.
+
 @node Pragma Machine_Attribute
 @unnumberedsec Pragma Machine_Attribute
 @findex Machine_Attribute
index 180bf7c..4910cd7 100644 (file)
@@ -1163,7 +1163,6 @@ begin
            Pragma_Fast_Math                      |
            Pragma_Finalize_Storage_Only          |
            Pragma_Float_Representation           |
-           Pragma_Ghost                          |
            Pragma_Global                         |
            Pragma_Ident                          |
            Pragma_Implementation_Defined         |
index 9f13f32..1c0222f 100644 (file)
@@ -684,6 +684,8 @@ package body Repinfo is
             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 399437f..71b116c 100644 (file)
@@ -268,7 +268,7 @@ package body System.Tasking.Restricted.Stages is
             Save_Occurrence (EO, E);
       end;
 
-      --  Look for a fall-back handler.
+      --  Look for a fall-back handler
 
       --  This package is part of the restricted run time which supports
       --  neither task hierarchies (No_Task_Hierarchy) nor specific task
index 5ee023b..59c83bb 100644 (file)
@@ -602,9 +602,9 @@ package body Sem_Attr is
             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 11ea3ea..5e1da8a 100644 (file)
@@ -12401,13 +12401,13 @@ package body Sem_Ch12 is
                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 ae69805..eb36597 100644 (file)
@@ -854,10 +854,10 @@ package body Sem_Ch4 is
       --  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 @@ package body Sem_Ch4 is
       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 @@ package body Sem_Ch4 is
             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 @@ package body Sem_Ch4 is
          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 @@ package body Sem_Ch4 is
          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 b9be549..2ca1310 100644 (file)
@@ -6292,26 +6292,51 @@ package body Sem_Ch6 is
       ----------------------
 
       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 @@ package body Sem_Ch6 is
                   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 @@ package body Sem_Ch6 is
                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 @@ package body Sem_Ch6 is
 
       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 @@ package body Sem_Ch6 is
       --  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 b98bf9c..fa80d68 100644 (file)
@@ -1860,10 +1860,14 @@ package body Sem_Ch7 is
                Set_Is_Potentially_Use_Visible
                  (Priv, Is_Potentially_Use_Visible (Node (Priv_Elmt)));
 
-               --  Within a child unit, recurse
+               --  Within a child unit, recurse, except in generic child
+               --  unit, which (unfortunately) handle private_dependents
+               --  separately.
 
                if Is_Priv
                  and then Is_Child_Unit (Cunit_Entity (Current_Sem_Unit))
+                 and then not Is_Empty_Elmt_List (Deps)
+                 and then not Inside_A_Generic
                then
                   Swap_Private_Dependents (Deps);
                end if;
index 924b58c..f71a477 100644 (file)
@@ -300,12 +300,14 @@ package body Sem_Mech is
                -- 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 @@ package body Sem_Mech is
                   else
                      Set_Mechanism (Formal, By_Reference);
                   end if;
-
             end case;
          end if;
 
index 18fd9ea..040d7f8 100644 (file)
@@ -4975,9 +4975,16 @@ package body Sem_Prag is
               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 @@ package body Sem_Prag is
          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 @@ package body Sem_Prag is
          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 @@ package body Sem_Prag is
                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 @@ package body Sem_Prag is
             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 @@ package body Sem_Prag is
             --  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 @@ package body Sem_Prag is
                      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 @@ package body Sem_Prag is
       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 04a64ab..830a2af 100644 (file)
@@ -1414,10 +1414,10 @@ package Sinfo is
    --  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 9255395..f79e481 100644 (file)
@@ -155,6 +155,7 @@ package body Snames is
          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 @@ package body Snames is
          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 @@ package body Snames is
          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 320bf76..2ddae4d 100644 (file)
@@ -499,7 +499,6 @@ package Snames is
    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 @@ package Snames is
    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 @@ package Snames is
       Convention_Ada,
       Convention_Intrinsic,
       Convention_Entry,
+      Convention_Ghost,
       Convention_Protected,
       Convention_Stubbed,
 
@@ -1795,7 +1796,6 @@ package Snames is
       Pragma_Export_Valued_Procedure,
       Pragma_External,
       Pragma_Finalize_Storage_Only,
-      Pragma_Ghost,
       Pragma_Global,
       Pragma_Ident,
       Pragma_Implementation_Defined,