Skip to content

R
riscv-gcc-1
Commit 0d6014fa by Arnaud Charlet
Options

[multiple changes] 

2016-04-18  Eric Botcazou  <ebotcazou@adacore.com>

	* layout.adb: Fix more minor typos in comments.

2016-04-18  Hristian Kirtchev  <kirtchev@adacore.com>

	* a-calend.ads, sem_prag.adb, sem_ch6.adb: Minor reformatting.

From-SVN: r235114
parent 539ca5ec
Showing with 147 additions and 127 deletions
gcc/ada/ChangeLog
2016-04-18 Eric Botcazou <ebotcazou@adacore.com>
* layout.adb: Fix more minor typos in comments.
2016-04-18 Hristian Kirtchev <kirtchev@adacore.com>
* a-calend.ads, sem_prag.adb, sem_ch6.adb: Minor reformatting.
2016-04-18 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): In GNATprove
......
gcc/ada/a-calend.ads
......@@ -115,8 +115,9 @@ is
Time_Error : exception;
private
-- Mark private part as SPARK_Mode Off to avoid accounting for variable
-- Mark the private part as SPARK_Mode Off to avoid accounting for variable
-- Invalid_Time_Zone_Offset in abstract state.
pragma SPARK_Mode (Off);
pragma Inline (Clock);
......
gcc/ada/layout.adb
......@@ -3247,7 +3247,7 @@ package body Layout is
A := 2 * A;
end loop;
-- If alignment is currently not set, then we can safetly set it to
-- If alignment is currently not set, then we can safely set it to
-- this new calculated value.
if Unknown_Alignment (E) then
......@@ -3256,7 +3256,7 @@ package body Layout is
-- Cases where we have inherited an alignment
-- For constructed types, always reset the alignment, these are
-- Generally invisible to the user anyway, and that way we are
-- generally invisible to the user anyway, and that way we are
-- sure that no constructed types have weird alignments.
elsif not Comes_From_Source (E) then
......@@ -3282,23 +3282,23 @@ package body Layout is
-- It seems quite bogus in this case to inherit an alignment of 1
-- from the parent type Character. Furthermore, if that's what the
-- programmer really wanted for some odd reason, then they could
-- specify the alignment they wanted.
-- programmer really wanted for some odd reason, then he could
-- specify the alignment directly.
-- Furthermore we really don't want to inherit the alignment in
-- the case of a specified Object_Size for a subtype, since then
-- there would be no way of overriding to give a reasonable value
-- (we don't have an Object_Subtype attribute). Consider:
-- subtype R is new Character;
-- subtype R is Character;
-- for R'Object_Size use 16;
-- If we inherit the alignment of 1, then we have an odd
-- inefficient alignment for the subtype, which cannot be fixed.
-- If we inherit the alignment of 1, then we have an inefficient
-- alignment for the subtype, which cannot be fixed.
-- So we make the decision that if Size (or Object_Size) is given
-- (and, in the case of a first subtype, the alignment is not set
-- with a specific alignment clause). We reset the alignment to
-- with a specific alignment clause), we reset the alignment to
-- the appropriate value for the specified size. This is a nice
-- simple rule to implement and document.
......@@ -3311,15 +3311,15 @@ package body Layout is
-- type S is new R;
-- for S'Size use Character'Size;
-- Now the alignment of S is 1 instead of 2, as a result of
-- applying the above rule to the confirming rep clause for S. Not
-- clear this is worth worrying about. If we recorded whether a
-- size clause was confirming we could avoid this, but right now
-- Now the alignment of S is changed to 1 instead of 2 as a result
-- of applying the above rule to the confirming rep clause for S.
-- Not clear this is worth worrying about. If we recorded whether
-- a size clause was confirming we could avoid this, but right now
-- we have no way of doing that or easily figuring it out, so we
-- don't bother.
-- Historical note. In versions of GNAT prior to Nov 6th, 2011, an
-- odd distinction was made between inherited alignments greater
-- Historical note: in versions of GNAT prior to Nov 6th, 2011, an
-- odd distinction was made between inherited alignments larger
-- than the computed alignment (where the larger alignment was
-- inherited) and inherited alignments smaller than the computed
-- alignment (where the smaller alignment was overridden). This
......@@ -3337,7 +3337,7 @@ package body Layout is
-- for R'Alignment use 1;
-- subtype S is R;
-- Here we have R has a default Object_Size of 32, and a specified
-- Here we have R with a default Object_Size of 32, and a specified
-- alignment of 1, and it seeems right for S to inherit both values.
else
......
gcc/ada/sem_ch6.adb
......@@ -3754,9 +3754,9 @@ package body Sem_Ch6 is
Build_Body_To_Inline (N, Spec_Id);
end if;
-- When generating code, inherited pre/postconditions are handled
-- when expanding the corresponding contract. If GNATprove mode we
-- must process them when the body is analyzed.
-- When generating code, inherited pre/postconditions are handled when
-- expanding the corresponding contract. In GNATprove the annotations
-- must be processed when the body is analyzed.
if GNATprove_Mode
and then Present (Spec_Id)
......
gcc/ada/sem_prag.adb
......@@ -23198,8 +23198,8 @@ package body Sem_Prag is
if Class_Present (N) then
-- Verify that a class-wide condition is legal, i.e. the operation
-- is a primitive of a tagged type.
-- Verify that a class-wide condition is legal, i.e. the operation is
-- a primitive of a tagged type.
Disp_Typ := Find_Dispatching_Type (Spec_Id);
......@@ -26045,61 +26045,32 @@ package body Sem_Prag is
Subp_Id : Entity_Id := Empty;
Inher_Id : Entity_Id := Empty) return Node_Id
is
Map : Elist_Id;
-- List containing the following mappings
-- * Formal parameters of inherited subprogram Inher_Id and subprogram
-- Subp_Id.
--
-- * The dispatching type of Inher_Id and the dispatching type of
-- Subp_Id.
--
-- * Primitives of the dispatching type of Inher_Id and primitives of
-- the dispatching type of Subp_Id.
function Replace_Entity (N : Node_Id) return Traverse_Result;
-- Replace reference to formal of inherited operation or to primitive
-- operation of root type, with corresponding entity for derived type.
function Suppress_Reference (N : Node_Id) return Traverse_Result;
-- Detect whether node N references a formal parameter subject to
-- pragma Unreferenced. If this is the case, set Comes_From_Source
-- to False to suppress the generation of a reference when analyzing
-- N later on.
------------------------
-- Suppress_Reference --
------------------------
function Suppress_Reference (N : Node_Id) return Traverse_Result is
Formal : Entity_Id;
begin
if Is_Entity_Name (N) and then Present (Entity (N)) then
Formal := Entity (N);
-- The formal parameter is subject to pragma Unreferenced.
-- Prevent the generation of a reference by resetting the
-- Comes_From_Source flag.
if Is_Formal (Formal)
and then Has_Pragma_Unreferenced (Formal)
then
Set_Comes_From_Source (N, False);
end if;
end if;
return OK;
end Suppress_Reference;
procedure Suppress_References is
new Traverse_Proc (Suppress_Reference);
-- Local variables
Loc : constant Source_Ptr := Sloc (Prag);
Prag_Nam : constant Name_Id := Pragma_Name (Prag);
Check_Prag : Node_Id;
Formals_Map : Elist_Id;
Inher_Formal : Entity_Id;
Msg_Arg : Node_Id;
Nam : Name_Id;
Subp_Formal : Entity_Id;
function Replace_Entity (N : Node_Id) return Traverse_Result;
-- Replace reference to formal of inherited operation or to primitive
-- operation of root type, with corresponding entity for derived type.
--------------------
-- Replace_Entity --
--------------------
function Replace_Entity (N : Node_Id) return Traverse_Result
is
function Replace_Entity (N : Node_Id) return Traverse_Result is
Elmt : Elmt_Id;
New_E : Entity_Id;
......@@ -26112,9 +26083,9 @@ package body Sem_Prag is
(Nkind (Parent (N)) /= N_Attribute_Reference
or else Attribute_Name (Parent (N)) /= Name_Class)
then
-- The replacement does not apply to dispatching calls within
-- the condition, but only to calls whose static tag is that
-- of the parent type.
-- The replacement does not apply to dispatching calls within the
-- condition, but only to calls whose static tag is that of the
-- parent type.
if Is_Subprogram (Entity (N))
and then Nkind (Parent (N)) = N_Function_Call
......@@ -26126,7 +26097,7 @@ package body Sem_Prag is
-- Loop to find out if entity has a renaming
New_E := Empty;
Elmt := First_Elmt (Formals_Map);
Elmt := First_Elmt (Map);
while Present (Elmt) loop
if Node (Elmt) = Entity (N) then
New_E := Node (Next_Elmt (Elmt));
......@@ -26142,7 +26113,7 @@ package body Sem_Prag is
end if;
if not Is_Abstract_Subprogram (Inher_Id)
and then Nkind (N) = N_Function_Call
and then Nkind (N) = N_Function_Call
and then Present (Entity (Name (N)))
and then Is_Abstract_Subprogram (Entity (Name (N)))
then
......@@ -26157,99 +26128,139 @@ package body Sem_Prag is
return OK;
end Replace_Entity;
------------------------
-- Suppress_Reference --
------------------------
function Suppress_Reference (N : Node_Id) return Traverse_Result is
Formal : Entity_Id;
begin
if Is_Entity_Name (N) and then Present (Entity (N)) then
Formal := Entity (N);
-- The formal parameter is subject to pragma Unreferenced.
-- Prevent the generation of a reference by resetting the
-- Comes_From_Source flag.
if Is_Formal (Formal)
and then Has_Pragma_Unreferenced (Formal)
then
Set_Comes_From_Source (N, False);
end if;
end if;
return OK;
end Suppress_Reference;
procedure Replace_Condition_Entities is
new Traverse_Proc (Replace_Entity);
procedure Suppress_References is
new Traverse_Proc (Suppress_Reference);
-- Local variables
Loc : constant Source_Ptr := Sloc (Prag);
Prag_Nam : constant Name_Id := Pragma_Name (Prag);
Check_Prag : Node_Id;
Inher_Formal : Entity_Id;
Msg_Arg : Node_Id;
Nam : Name_Id;
Subp_Formal : Entity_Id;
-- Start of processing for Build_Pragma_Check_Equivalent
begin
Formals_Map := No_Elist;
Map := No_Elist;
-- When the pre- or postcondition is inherited, map the formals of
-- the inherited subprogram to those of the current subprogram.
-- In addition, map primitive operations of the parent type into the
-- corresponding primitive operations of the descendant.
-- When the pre- or postcondition is inherited, map the formals of the
-- inherited subprogram to those of the current subprogram. In addition,
-- map primitive operations of the parent type into the corresponding
-- primitive operations of the descendant.
if Present (Inher_Id) then
pragma Assert (Present (Subp_Id));
Formals_Map := New_Elmt_List;
Map := New_Elmt_List;
-- Create a mapping <inherited formal> => <subprogram formal>
Inher_Formal := First_Formal (Inher_Id);
Subp_Formal := First_Formal (Subp_Id);
while Present (Inher_Formal) and then Present (Subp_Formal) loop
Append_Elmt (Inher_Formal, Formals_Map);
Append_Elmt (Subp_Formal, Formals_Map);
Append_Elmt (Inher_Formal, Map);
Append_Elmt (Subp_Formal, Map);
Next_Formal (Inher_Formal);
Next_Formal (Subp_Formal);
end loop;
-- Map primitive operations of the parent type into the corresponding
-- operations of the descendant. The descendant type might not be
-- frozen yet, so we cannot use the dispatch table directly.
-- Map primitive operations of the parent type to the corresponding
-- operations of the descendant. Note that the descendant type may
-- not be frozen yet, so we cannot use the dispatch table directly.
declare
T : constant Entity_Id := Find_Dispatching_Type (Subp_Id);
Old_T : constant Entity_Id := Find_Dispatching_Type (Inher_Id);
D : Node_Id;
E : Entity_Id;
Old_E : Entity_Id;
Old_Typ : constant Entity_Id := Find_Dispatching_Type (Inher_Id);
Typ : constant Entity_Id := Find_Dispatching_Type (Subp_Id);
Decl : Node_Id;
Old_Prim : Entity_Id;
Prim : Entity_Id;
begin
D := First (List_Containing (Unit_Declaration_Node (Subp_Id)));
Decl := First (List_Containing (Unit_Declaration_Node (Subp_Id)));
-- Look for primitive operations of the current type that have
-- overridden an operation of the type related to the original
-- class-wide precondition. There may be several intermediate
-- overridings between them.
while Present (D) loop
if Nkind (D) = N_Subprogram_Declaration then
E := Defining_Entity (D);
if Is_Subprogram (E)
and then Present (Overridden_Operation (E))
and then Find_Dispatching_Type (E) = T
while Present (Decl) loop
if Nkind (Decl) = N_Subprogram_Declaration then
Prim := Defining_Entity (Decl);
if Is_Subprogram (Prim)
and then Present (Overridden_Operation (Prim))
and then Find_Dispatching_Type (Prim) = Typ
then
Old_E := Overridden_Operation (E);
while Present (Overridden_Operation (Old_E))
and then Scope (Old_E) /= Scope (Inher_Id)
Old_Prim := Overridden_Operation (Prim);
while Present (Overridden_Operation (Old_Prim))
and then Scope (Old_Prim) /= Scope (Inher_Id)
loop
Old_E := Overridden_Operation (Old_E);
Old_Prim := Overridden_Operation (Old_Prim);
end loop;
Append_Elmt (Old_E, Formals_Map);
Append_Elmt (E, Formals_Map);
Append_Elmt (Old_Prim, Map);
Append_Elmt (Prim, Map);
end if;
end if;
Next (D);
Next (Decl);
end loop;
E := First_Entity (Scope (Subp_Id));
while Present (E) loop
if not Comes_From_Source (E)
and then Ekind (E) = E_Function
and then Present (Alias (E))
Prim := First_Entity (Scope (Subp_Id));
while Present (Prim) loop
if not Comes_From_Source (Prim)
and then Ekind (Prim) = E_Function
and then Present (Alias (Prim))
then
Old_E := Alias (E);
while Present (Alias (Old_E))
and then Scope (Old_E) /= Scope (Inher_Id)
Old_Prim := Alias (Prim);
while Present (Alias (Old_Prim))
and then Scope (Old_Prim) /= Scope (Inher_Id)
loop
Old_E := Alias (Old_E);
Old_Prim := Alias (Old_Prim);
end loop;
Append_Elmt (Old_E, Formals_Map);
Append_Elmt (E, Formals_Map);
Append_Elmt (Old_Prim, Map);
Append_Elmt (Prim, Map);
end if;
Next_Entity (E);
Next_Entity (Prim);
end loop;
if Formals_Map /= No_Elist then
Append_Elmt (Old_T, Formals_Map);
Append_Elmt (T, Formals_Map);
if Map /= No_Elist then
Append_Elmt (Old_Typ, Map);
Append_Elmt (Typ, Map);
end if;
end;
end if;
......@@ -26257,14 +26268,14 @@ package body Sem_Prag is
-- Copy the original pragma while performing substitutions (if
-- applicable).
Check_Prag := New_Copy_Tree (Source => Prag);
Check_Prag := New_Copy_Tree (Source => Prag);
if Formals_Map /= No_Elist then
if Map /= No_Elist then
Replace_Condition_Entities (Check_Prag);
end if;
-- Mark the pragma as being internally generated and reset the
-- Analyzed flag.
-- Mark the pragma as being internally generated and reset the Analyzed
-- flag.
Set_Analyzed (Check_Prag, False);
Set_Comes_From_Source (Check_Prag, False);
......@@ -26294,8 +26305,8 @@ package body Sem_Prag is
Nam := Prag_Nam;
end if;
-- Convert the copy into pragma Check by correcting the name and
-- adding a check_kind argument.
-- Convert the copy into pragma Check by correcting the name and adding
-- a check_kind argument.
Set_Pragma_Identifier
(Check_Prag, Make_Identifier (Loc, Name_Check));
......@@ -26795,7 +26806,7 @@ package body Sem_Prag is
Bod : Node_Id)
is
Parent_Subp : constant Entity_Id := Overridden_Operation (Subp);
Prags : constant Node_Id := Contract (Parent_Subp);
Prags : constant Node_Id := Contract (Parent_Subp);
Prag : Node_Id;
begin
......@@ -26806,15 +26817,15 @@ package body Sem_Prag is
Prag := Pre_Post_Conditions (Prags);
while Present (Prag) loop
if Pragma_Name (Prag) = Name_Precondition
or else Pragma_Name (Prag) = Name_Postcondition
if Nam_In (Pragma_Name (Prag), Name_Precondition,
Name_Postcondition)
then
if No (Declarations (Bod)) then
Set_Declarations (Bod, Empty_List);
end if;
Append (Build_Pragma_Check_Equivalent (Prag, Subp, Parent_Subp),
To => Declarations (Bod));
Append_To (Declarations (Bod),
Build_Pragma_Check_Equivalent (Prag, Subp, Parent_Subp));
end if;
Prag := Next_Pragma (Prag);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment