aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2013-04-25 10:35:16 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2013-04-25 10:35:16 +0200
commit9f6aaa5cc7f2ae57aa27ea8ddc8b8a3b1d0e0a3c (patch)
tree875bece5d69b206fb74a8bb9c08d7d0a7c4f9913 /gcc/ada
parent41c34e94ff45983dbb12e1ee76290e3343bf9e9a (diff)
downloadgcc-9f6aaa5cc7f2ae57aa27ea8ddc8b8a3b1d0e0a3c.zip
gcc-9f6aaa5cc7f2ae57aa27ea8ddc8b8a3b1d0e0a3c.tar.gz
gcc-9f6aaa5cc7f2ae57aa27ea8ddc8b8a3b1d0e0a3c.tar.bz2
[multiple changes]
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. From-SVN: r198275
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog55
-rw-r--r--gcc/ada/aspects.adb1
-rw-r--r--gcc/ada/aspects.ads3
-rw-r--r--gcc/ada/einfo.adb33
-rw-r--r--gcc/ada/einfo.ads20
-rw-r--r--gcc/ada/gnat_rm.texi3
-rw-r--r--gcc/ada/par-prag.adb1
-rw-r--r--gcc/ada/repinfo.adb2
-rw-r--r--gcc/ada/s-tarest.adb2
-rw-r--r--gcc/ada/sem_attr.adb4
-rw-r--r--gcc/ada/sem_ch12.adb6
-rw-r--r--gcc/ada/sem_ch4.adb34
-rw-r--r--gcc/ada/sem_ch6.adb43
-rw-r--r--gcc/ada/sem_ch7.adb6
-rw-r--r--gcc/ada/sem_mech.adb7
-rw-r--r--gcc/ada/sem_prag.adb78
-rw-r--r--gcc/ada/sinfo.ads8
-rw-r--r--gcc/ada/snames.adb-tmpl12
-rw-r--r--gcc/ada/snames.ads-tmpl4
19 files changed, 205 insertions, 117 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index cfa0ea7..ce32cbc 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index 401928b..71f7493 100644
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -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,
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index ee8676a..c9560b8 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -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,
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index 96e875e..50735a3 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -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 --
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 62cdb8e..fd38a1f 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -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;
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 6b2574b..05e938f 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -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
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 180bf7c..4910cd7 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1163,7 +1163,6 @@ begin
Pragma_Fast_Math |
Pragma_Finalize_Storage_Only |
Pragma_Float_Representation |
- Pragma_Ghost |
Pragma_Global |
Pragma_Ident |
Pragma_Implementation_Defined |
diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb
index 9f13f32..1c0222f 100644
--- a/gcc/ada/repinfo.adb
+++ b/gcc/ada/repinfo.adb
@@ -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 =>
diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb
index 399437f..71b116c 100644
--- a/gcc/ada/s-tarest.adb
+++ b/gcc/ada/s-tarest.adb
@@ -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
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 5ee023b..59c83bb 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -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
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 11ea3ea..5e1da8a 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -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
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index ae69805..eb36597 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -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;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index b9be549..2ca1310 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -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
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index b98bf9c..fa80d68 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -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;
diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb
index 924b58c..f71a477b 100644
--- a/gcc/ada/sem_mech.adb
+++ b/gcc/ada/sem_mech.adb
@@ -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;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 18fd9ea..040d7f8 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -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,
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 04a64ab..830a2af 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -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
diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl
index 9255395..f79e481 100644
--- a/gcc/ada/snames.adb-tmpl
+++ b/gcc/ada/snames.adb-tmpl
@@ -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;
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 320bf76..2ddae4d 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -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,