Skip to content

R
riscv-gcc-1
Commit 4f94fa11 by Arnaud Charlet
Options

[multiple changes] 

2017-01-19  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.adb (Expand_Call): Remove side effects on
	actuals that are allocators with qualified expression since the
	initialization of the object is performed by means of individual
	statements (and hence it must be done before the call).

2017-01-19  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Analyze_Declarations): Minor reformatting.
	(Build_Derived_Enumeration_Type): If the derived type inherits a
	dynamic predicate from its parent, the bounds of the type must
	freeze because an explicit constraint is constructed for the
	type and the corresponding range is elaborated now.

2017-01-19  Arnaud Charlet  <charlet@adacore.com>

	* sem_attr.ads: minor fix of inconsistent casing in comment
	* lib-writ.ads: minor align comments in columns
	* sem_ch3.adb: Minor reformatting.
	* spark_xrefs.ads: minor fix typo in SPARK-related comment
	* table.ads: minor style fix in comment
	* lib-xref-spark_specific.adb
	(Add_SPARK_Xrefs): simplify processing of SPARK cross-references.
	* sem_ch12.adb: minor whitespace fix
	* freeze.adb: Add comment.
	* sem_util.adb (Unique_Name): for instances of
	generic subprograms ignore the name of the wrapper package.

2017-01-19  Javier Miranda  <miranda@adacore.com>

	* exp_aggr.adb (Resolve_Record_Aggregate):
	Factorize code needed for aggregates of limited and unlimited
	types in a new routine.
	(Pass_Aggregate_To_Back_End): New subprogram.

2017-01-19  Yannick Moy  <moy@adacore.com>

	* sinfo.adb (Pragma_Name): Only access up to Last_Pair of Pragma_Map.

From-SVN: r244622
parent 4fcf700c
Showing with 322 additions and 216 deletions
gcc/ada/ChangeLog
2017-01-19 Javier Miranda <miranda@adacore.com>
* exp_ch6.adb (Expand_Call): Remove side effects on
actuals that are allocators with qualified expression since the
initialization of the object is performed by means of individual
statements (and hence it must be done before the call).
2017-01-19 Ed Schonberg <schonberg@adacore.com>
* sem_ch3.adb (Analyze_Declarations): Minor reformatting.
(Build_Derived_Enumeration_Type): If the derived type inherits a
dynamic predicate from its parent, the bounds of the type must
freeze because an explicit constraint is constructed for the
type and the corresponding range is elaborated now.
2017-01-19 Arnaud Charlet <charlet@adacore.com>
* sem_attr.ads: minor fix of inconsistent casing in comment
* lib-writ.ads: minor align comments in columns
* sem_ch3.adb: Minor reformatting.
* spark_xrefs.ads: minor fix typo in SPARK-related comment
* table.ads: minor style fix in comment
* lib-xref-spark_specific.adb
(Add_SPARK_Xrefs): simplify processing of SPARK cross-references.
* sem_ch12.adb: minor whitespace fix
* freeze.adb: Add comment.
* sem_util.adb (Unique_Name): for instances of
generic subprograms ignore the name of the wrapper package.
2017-01-19 Javier Miranda <miranda@adacore.com>
* exp_aggr.adb (Resolve_Record_Aggregate):
Factorize code needed for aggregates of limited and unlimited
types in a new routine.
(Pass_Aggregate_To_Back_End): New subprogram.
2017-01-19 Yannick Moy <moy@adacore.com>
* sinfo.adb (Pragma_Name): Only access up to Last_Pair of Pragma_Map.
2017-01-19 Ed Schonberg <schonberg@adacore.com>
* sem_ch4.ads, sem_ch4.adb (Try_Object_Operation): Make subprogram
......
gcc/ada/exp_aggr.adb
......@@ -6545,6 +6545,9 @@ package body Exp_Aggr is
-- because it will not be set when type and its parent are in the
-- same scope, and the parent component needs expansion.
procedure Pass_Aggregate_To_Back_End;
-- Build a proper aggregate to be handled by the back-end
function Top_Level_Aggregate (N : Node_Id) return Node_Id;
-- For nested aggregates return the ultimate enclosing aggregate; for
-- non-nested aggregates return N.
......@@ -6723,155 +6726,16 @@ package body Exp_Aggr is
end loop;
end Has_Visible_Private_Ancestor;
-------------------------
-- Top_Level_Aggregate --
-------------------------
--------------------------------
-- Pass_Aggregate_To_Back_End --
--------------------------------
function Top_Level_Aggregate (N : Node_Id) return Node_Id is
Aggr : Node_Id;
procedure Pass_Aggregate_To_Back_End is
Comp : Entity_Id;
New_Comp : Node_Id;
Tag_Value : Node_Id;
begin
Aggr := N;
while Present (Parent (Aggr))
and then Nkind_In (Parent (Aggr), N_Component_Association,
N_Aggregate)
loop
Aggr := Parent (Aggr);
end loop;
return Aggr;
end Top_Level_Aggregate;
-- Local variables
Top_Level_Aggr : constant Node_Id := Top_Level_Aggregate (N);
Tag_Value : Node_Id;
Comp : Entity_Id;
New_Comp : Node_Id;
-- Start of processing for Expand_Record_Aggregate
begin
-- If the aggregate is to be assigned to an atomic/VFA variable, we have
-- to prevent a piecemeal assignment even if the aggregate is to be
-- expanded. We create a temporary for the aggregate, and assign the
-- temporary instead, so that the back end can generate an atomic move
-- for it.
if Is_Atomic_VFA_Aggregate (N) then
return;
-- No special management required for aggregates used to initialize
-- statically allocated dispatch tables
elsif Is_Static_Dispatch_Table_Aggregate (N) then
return;
end if;
-- Ada 2005 (AI-318-2): We need to convert to assignments if components
-- are build-in-place function calls. The assignments will each turn
-- into a build-in-place function call. If components are all static,
-- we can pass the aggregate to the backend regardless of limitedness.
-- Extension aggregates, aggregates in extended return statements, and
-- aggregates for C++ imported types must be expanded.
if Ada_Version >= Ada_2005 and then Is_Limited_View (Typ) then
if not Nkind_In (Parent (N), N_Object_Declaration,
N_Component_Association)
then
Convert_To_Assignments (N, Typ);
elsif Nkind (N) = N_Extension_Aggregate
or else Convention (Typ) = Convention_CPP
then
Convert_To_Assignments (N, Typ);
elsif not Size_Known_At_Compile_Time (Typ)
or else Component_Not_OK_For_Backend
or else not Static_Components
then
Convert_To_Assignments (N, Typ);
else
Set_Compile_Time_Known_Aggregate (N);
Set_Expansion_Delayed (N, False);
end if;
-- Gigi doesn't properly handle temporaries of variable size so we
-- generate it in the front-end
elsif not Size_Known_At_Compile_Time (Typ)
and then Tagged_Type_Expansion
then
Convert_To_Assignments (N, Typ);
-- An aggregate used to initialize a controlled object must be turned
-- into component assignments as the components themselves may require
-- finalization actions such as adjustment.
elsif Needs_Finalization (Typ) then
Convert_To_Assignments (N, Typ);
-- Ada 2005 (AI-287): In case of default initialized components we
-- convert the aggregate into assignments.
elsif Has_Default_Init_Comps (N) then
Convert_To_Assignments (N, Typ);
-- Check components
elsif Component_Not_OK_For_Backend then
Convert_To_Assignments (N, Typ);
-- If an ancestor is private, some components are not inherited and we
-- cannot expand into a record aggregate.
elsif Has_Visible_Private_Ancestor (Typ) then
Convert_To_Assignments (N, Typ);
-- ??? The following was done to compile fxacc00.ads in the ACVCs. Gigi
-- is not able to handle the aggregate for Late_Request.
elsif Is_Tagged_Type (Typ) and then Has_Discriminants (Typ) then
Convert_To_Assignments (N, Typ);
-- If the tagged types covers interface types we need to initialize all
-- hidden components containing pointers to secondary dispatch tables.
elsif Is_Tagged_Type (Typ) and then Has_Interfaces (Typ) then
Convert_To_Assignments (N, Typ);
-- If some components are mutable, the size of the aggregate component
-- may be distinct from the default size of the type component, so
-- we need to expand to insure that the back-end copies the proper
-- size of the data. However, if the aggregate is the initial value of
-- a constant, the target is immutable and might be built statically
-- if components are appropriate.
elsif Has_Mutable_Components (Typ)
and then
(Nkind (Parent (Top_Level_Aggr)) /= N_Object_Declaration
or else not Constant_Present (Parent (Top_Level_Aggr))
or else not Static_Components)
then
Convert_To_Assignments (N, Typ);
-- If the type involved has bit aligned components, then we are not sure
-- that the back end can handle this case correctly.
elsif Type_May_Have_Bit_Aligned_Components (Typ) then
Convert_To_Assignments (N, Typ);
-- When generating C, only generate an aggregate when declaring objects
-- since C does not support aggregates in e.g. assignment statements.
elsif Modify_Tree_For_C and then not In_Object_Declaration (N) then
Convert_To_Assignments (N, Typ);
-- In all other cases, build a proper aggregate to be handled by gigi
else
if Nkind (N) = N_Aggregate then
-- If the aggregate is static and can be handled by the back-end,
......@@ -7164,8 +7028,158 @@ package body Exp_Aggr is
end;
end if;
end if;
end Pass_Aggregate_To_Back_End;
-------------------------
-- Top_Level_Aggregate --
-------------------------
function Top_Level_Aggregate (N : Node_Id) return Node_Id is
Aggr : Node_Id;
begin
Aggr := N;
while Present (Parent (Aggr))
and then Nkind_In (Parent (Aggr), N_Component_Association,
N_Aggregate)
loop
Aggr := Parent (Aggr);
end loop;
return Aggr;
end Top_Level_Aggregate;
-- Local variables
Top_Level_Aggr : constant Node_Id := Top_Level_Aggregate (N);
-- Start of processing for Expand_Record_Aggregate
begin
-- If the aggregate is to be assigned to an atomic/VFA variable, we have
-- to prevent a piecemeal assignment even if the aggregate is to be
-- expanded. We create a temporary for the aggregate, and assign the
-- temporary instead, so that the back end can generate an atomic move
-- for it.
if Is_Atomic_VFA_Aggregate (N) then
return;
-- No special management required for aggregates used to initialize
-- statically allocated dispatch tables
elsif Is_Static_Dispatch_Table_Aggregate (N) then
return;
end if;
-- Ada 2005 (AI-318-2): We need to convert to assignments if components
-- are build-in-place function calls. The assignments will each turn
-- into a build-in-place function call. If components are all static,
-- we can pass the aggregate to the backend regardless of limitedness.
-- Extension aggregates, aggregates in extended return statements, and
-- aggregates for C++ imported types must be expanded.
if Ada_Version >= Ada_2005 and then Is_Limited_View (Typ) then
if not Nkind_In (Parent (N), N_Object_Declaration,
N_Component_Association)
then
Convert_To_Assignments (N, Typ);
elsif Nkind (N) = N_Extension_Aggregate
or else Convention (Typ) = Convention_CPP
then
Convert_To_Assignments (N, Typ);
elsif not Size_Known_At_Compile_Time (Typ)
or else Component_Not_OK_For_Backend
or else not Static_Components
then
Convert_To_Assignments (N, Typ);
-- In all other cases, build a proper aggregate to be handled by
-- the back-end
else
Pass_Aggregate_To_Back_End;
end if;
-- Gigi doesn't properly handle temporaries of variable size so we
-- generate it in the front-end
elsif not Size_Known_At_Compile_Time (Typ)
and then Tagged_Type_Expansion
then
Convert_To_Assignments (N, Typ);
-- An aggregate used to initialize a controlled object must be turned
-- into component assignments as the components themselves may require
-- finalization actions such as adjustment.
elsif Needs_Finalization (Typ) then
Convert_To_Assignments (N, Typ);
-- Ada 2005 (AI-287): In case of default initialized components we
-- convert the aggregate into assignments.
elsif Has_Default_Init_Comps (N) then
Convert_To_Assignments (N, Typ);
-- Check components
elsif Component_Not_OK_For_Backend then
Convert_To_Assignments (N, Typ);
-- If an ancestor is private, some components are not inherited and we
-- cannot expand into a record aggregate.
elsif Has_Visible_Private_Ancestor (Typ) then
Convert_To_Assignments (N, Typ);
-- ??? The following was done to compile fxacc00.ads in the ACVCs. Gigi
-- is not able to handle the aggregate for Late_Request.
elsif Is_Tagged_Type (Typ) and then Has_Discriminants (Typ) then
Convert_To_Assignments (N, Typ);
-- If the tagged types covers interface types we need to initialize all
-- hidden components containing pointers to secondary dispatch tables.
elsif Is_Tagged_Type (Typ) and then Has_Interfaces (Typ) then
Convert_To_Assignments (N, Typ);
-- If some components are mutable, the size of the aggregate component
-- may be distinct from the default size of the type component, so
-- we need to expand to insure that the back-end copies the proper
-- size of the data. However, if the aggregate is the initial value of
-- a constant, the target is immutable and might be built statically
-- if components are appropriate.
elsif Has_Mutable_Components (Typ)
and then
(Nkind (Parent (Top_Level_Aggr)) /= N_Object_Declaration
or else not Constant_Present (Parent (Top_Level_Aggr))
or else not Static_Components)
then
Convert_To_Assignments (N, Typ);
-- If the type involved has bit aligned components, then we are not sure
-- that the back end can handle this case correctly.
elsif Type_May_Have_Bit_Aligned_Components (Typ) then
Convert_To_Assignments (N, Typ);
-- When generating C, only generate an aggregate when declaring objects
-- since C does not support aggregates in e.g. assignment statements.
elsif Modify_Tree_For_C and then not In_Object_Declaration (N) then
Convert_To_Assignments (N, Typ);
-- In all other cases, build a proper aggregate to be handled by gigi
else
Pass_Aggregate_To_Back_End;
end if;
end Expand_Record_Aggregate;
----------------------------
......
gcc/ada/exp_ch6.adb
......@@ -3315,6 +3315,17 @@ package body Exp_Ch6 is
Add_View_Conversion_Invariants (Formal, Actual);
end if;
-- Generating C the initialization of an allocator is performed by
-- means of individual statements, and hence it must be done before
-- the call.
if Modify_Tree_For_C
and then Nkind (Actual) = N_Allocator
and then Nkind (Expression (Actual)) = N_Qualified_Expression
then
Remove_Side_Effects (Actual);
end if;
-- This label is required when skipping extra actual generation for
-- Unchecked_Union parameters.
......
gcc/ada/freeze.adb
......@@ -5305,6 +5305,9 @@ package body Freeze is
-- trigger the analysis of aspect expressions, so in this case we
-- want to continue the freezing process.
-- Is_Generic_Unit (Scope (E)) is dubious here, do we want instead
-- In_Generic_Scope (E)???
if Present (Scope (E))
and then Is_Generic_Unit (Scope (E))
and then
......
gcc/ada/lib-writ.ads
......@@ -192,8 +192,8 @@ package Lib.Writ is
-- the units in this file, where x is the first character
-- (upper case) of the policy name (e.g. 'C' for Concurrent).
-- FX Units in this file use front-end exceptions, with explicit
-- handlers to trigger AT-END actions on exception paths.
-- FX Units in this file use front-end exceptions, with explicit
-- handlers to trigger AT-END actions on exception paths.
-- GP Set if this compilation was done in GNATprove mode, either
-- from direct use of GNATprove, or from use of -gnatdF.
......@@ -240,12 +240,12 @@ package Lib.Writ is
-- (upper case) of the corresponding policy name (e.g. 'F'
-- for FIFO_Within_Priorities).
-- UA Unreserve_All_Interrupts pragma was processed in one or
-- more units in this file
-- UA Unreserve_All_Interrupts pragma was processed in one or
-- more units in this file
-- ZX Units in this file use zero-cost exceptions and have
-- generated exception tables. If ZX is not present, the
-- longjmp/setjmp exception scheme is in use.
-- ZX Units in this file use zero-cost exceptions and have
-- generated exception tables. If ZX is not present, the
-- longjmp/setjmp exception scheme is in use.
-- Note that language defined units never output policy (Lx, Tx, Qx)
-- parameters. Language defined units must correctly handle all
......@@ -570,22 +570,22 @@ package Lib.Writ is
-- code is required. Set if N_Compilation_Unit node has flag
-- Has_No_Elaboration_Code set.
-- OL The units in this file are compiled with a local pragma
-- Optimize_Alignment, so no consistency requirement applies
-- to these units. All internal units have this status since
-- they have an automatic default of Optimize_Alignment (Off).
-- OL The units in this file are compiled with a local pragma
-- Optimize_Alignment, so no consistency requirement applies
-- to these units. All internal units have this status since
-- they have an automatic default of Optimize_Alignment (Off).
--
-- OO Optimize_Alignment (Off) is the default setting for all
-- units in this file. All files in the partition that specify
-- a default must specify the same default.
-- OO Optimize_Alignment (Off) is the default setting for all
-- units in this file. All files in the partition that specify
-- a default must specify the same default.
-- OS Optimize_Alignment (Space) is the default setting for all
-- units in this file. All files in the partition that specify
-- a default must specify the same default.
-- OS Optimize_Alignment (Space) is the default setting for all
-- units in this file. All files in the partition that specify
-- a default must specify the same default.
-- OT Optimize_Alignment (Time) is the default setting for all
-- units in this file. All files in the partition that specify
-- a default must specify the same default.
-- OT Optimize_Alignment (Time) is the default setting for all
-- units in this file. All files in the partition that specify
-- a default must specify the same default.
-- PF The unit has a library-level (package) finalizer
......
gcc/ada/lib-xref-spark_specific.adb
......@@ -381,7 +381,7 @@ package body SPARK_Specific is
Rnums : array (0 .. Nrefs + Nrefs_Add) of Nat;
-- This array contains numbers of references in the Xrefs table. This
-- list is sorted in output order. The extra 0'th entry is convenient
-- for the call to sort. When we sort the table, we move the entries in
-- for the call to sort. When we sort the table, we move the indices in
-- Rnums around, but we do not move the original table entries.
---------------------
......@@ -683,7 +683,7 @@ package body SPARK_Specific is
Col : Nat;
From_Index : Xref_Index;
Line : Nat;
Loc : Source_Ptr;
Prev_Loc : Source_Ptr;
Prev_Typ : Character;
Ref_Count : Nat;
Ref_Id : Entity_Id;
......@@ -701,17 +701,9 @@ package body SPARK_Specific is
end;
end loop;
-- Set up the pointer vector for the sort
for Index in 1 .. Nrefs loop
Rnums (Index) := Index;
end loop;
for Index in Drefs.First .. Drefs.Last loop
Xrefs.Append (Drefs.Table (Index));
Nrefs := Nrefs + 1;
Rnums (Nrefs) := Xrefs.Last;
Nrefs := Nrefs + 1;
end loop;
-- Capture the definition Sloc values. As in the case of normal cross
......@@ -730,7 +722,7 @@ package body SPARK_Specific is
for Index in 1 .. Ref_Count loop
declare
Ref : Xref_Key renames Xrefs.Table (Rnums (Index)).Key;
Ref : Xref_Key renames Xrefs.Table (Index).Key;
begin
if SPARK_Entities (Ekind (Ref.Ent))
......@@ -745,7 +737,7 @@ package body SPARK_Specific is
and then Get_Scope_Num (Ref.Ref_Scope) /= No_Scope
then
Nrefs := Nrefs + 1;
Rnums (Nrefs) := Rnums (Index);
Rnums (Nrefs) := Index;
end if;
end;
end loop;
......@@ -778,7 +770,7 @@ package body SPARK_Specific is
Ref_Count := Nrefs;
Nrefs := 0;
Loc := No_Location;
Prev_Loc := No_Location;
Prev_Typ := 'm';
for Index in 1 .. Ref_Count loop
......@@ -786,10 +778,10 @@ package body SPARK_Specific is
Ref : Xref_Key renames Xrefs.Table (Rnums (Index)).Key;
begin
if Ref.Loc /= Loc
if Ref.Loc /= Prev_Loc
or else (Prev_Typ = 'm' and then Ref.Typ = 'r')
then
Loc := Ref.Loc;
Prev_Loc := Ref.Loc;
Prev_Typ := Ref.Typ;
Nrefs := Nrefs + 1;
Rnums (Nrefs) := Rnums (Index);
......
gcc/ada/sem_attr.ads
......@@ -402,7 +402,7 @@ package Sem_Attr is
-- fixed-point types and discrete types. For fixed-point types and
-- discrete types, this attribute gives the size used for default
-- allocation of objects and components of the size. See section in
-- Einfo ("Handling of type'Size values") for further details.
-- Einfo ("Handling of Type'Size values") for further details.
-------------------------
-- Passed_By_Reference --
......
gcc/ada/sem_ch12.adb
......@@ -6372,8 +6372,7 @@ package body Sem_Ch12 is
Set_Is_Generic_Actual_Type (E, True);
Set_Is_Hidden (E, False);
Set_Is_Potentially_Use_Visible (E,
In_Use (Instance));
Set_Is_Potentially_Use_Visible (E, In_Use (Instance));
-- We constructed the generic actual type as a subtype of the
-- supplied type. This means that it normally would not inherit
......
gcc/ada/sem_ch3.adb
......@@ -2466,6 +2466,8 @@ package body Sem_Ch3 is
Freeze_All (First_Entity (Current_Scope), Decl);
Freeze_From := Last_Entity (Current_Scope);
-- Current scope is a package specification
elsif Scope (Current_Scope) /= Standard_Standard
and then not Is_Child_Unit (Current_Scope)
and then No (Generic_Parent (Parent (L)))
......@@ -2485,6 +2487,8 @@ package body Sem_Ch3 is
then
Adjust_Decl;
-- End of a package declaration
-- In compilation mode the expansion of freeze node takes care
-- of resolving expressions of all aspects in the list. In ASIS
-- mode this must be done explicitly.
......@@ -2495,6 +2499,9 @@ package body Sem_Ch3 is
Resolve_Aspects;
end if;
-- This is a freeze point because it is the end of a
-- compilation unit.
Freeze_All (First_Entity (Current_Scope), Decl);
Freeze_From := Last_Entity (Current_Scope);
......@@ -2561,6 +2568,12 @@ package body Sem_Ch3 is
end if;
Adjust_Decl;
-- The generated body of an expression function does not freeze,
-- unless it is a completion, in which case only the expression
-- itself freezes. THis is handled when the body itself is
-- analyzed (see Freeze_Expr_Types, sem_ch6.adb).
Freeze_All (Freeze_From, Decl);
Freeze_From := Last_Entity (Current_Scope);
end if;
......@@ -6740,8 +6753,12 @@ package body Sem_Ch3 is
-- If we constructed a default range for the case where no range
-- was given, then the expressions in the range must not freeze
-- since they do not correspond to expressions in the source.
-- However, if the type inherits predicates the expressions will
-- be elaborated earlier and must freeze.
if Nkind (Indic) /= N_Subtype_Indication then
if Nkind (Indic) /= N_Subtype_Indication
and then not Has_Predicates (Derived_Type)
then
Set_Must_Not_Freeze (Lo);
Set_Must_Not_Freeze (Hi);
Set_Must_Not_Freeze (Rang_Expr);
......
gcc/ada/sem_util.adb
......@@ -20971,48 +20971,78 @@ package body Sem_Util is
function Unique_Name (E : Entity_Id) return String is
-- Names of E_Subprogram_Body or E_Package_Body entities are not
-- Names in E_Subprogram_Body or E_Package_Body entities are not
-- reliable, as they may not include the overloading suffix. Instead,
-- when looking for the name of E or one of its enclosing scope, we get
-- the name of the corresponding Unique_Entity.
function Get_Scoped_Name (E : Entity_Id) return String;
-- Return the name of E prefixed by all the names of the scopes to which
-- E belongs, except for Standard.
U : constant Entity_Id := Unique_Entity (E);
---------------------
-- Get_Scoped_Name --
---------------------
function This_Name return String;
---------------
-- This_Name --
---------------
function Get_Scoped_Name (E : Entity_Id) return String is
Name : constant String := Get_Name_String (Chars (E));
function This_Name return String is
begin
if Has_Fully_Qualified_Name (E)
or else Scope (E) = Standard_Standard
then
return Name;
else
return Get_Scoped_Name (Unique_Entity (Scope (E))) & "__" & Name;
end if;
end Get_Scoped_Name;
return Get_Name_String (Chars (U));
end This_Name;
-- Start of processing for Unique_Name
begin
if E = Standard_Standard then
return Get_Name_String (Name_Standard);
elsif Scope (E) = Standard_Standard
and then not (Ekind (E) = E_Package or else Is_Subprogram (E))
if E = Standard_Standard
or else Has_Fully_Qualified_Name (E)
then
return Get_Name_String (Name_Standard) & "__" &
Get_Name_String (Chars (E));
return This_Name;
elsif Ekind (E) = E_Enumeration_Literal then
return Unique_Name (Etype (E)) & "__" & Get_Name_String (Chars (E));
return Unique_Name (Etype (E)) & "__" & This_Name;
else
return Get_Scoped_Name (Unique_Entity (E));
declare
S : constant Entity_Id := Scope (U);
pragma Assert (Present (S));
begin
-- Prefix names of predefined types with standard__, but leave
-- names of user-defined packages and subprograms without prefix
-- (even if technically they are nested in the Standard package).
if S = Standard_Standard then
if Ekind (U) = E_Package or else Is_Subprogram (U) then
return This_Name;
else
return Unique_Name (S) & "__" & This_Name;
end if;
-- For intances of generic subprograms use the name of the related
-- instace and skip the scope of its wrapper package.
elsif Is_Wrapper_Package (S) then
pragma Assert (Scope (S) = Scope (Related_Instance (S)));
-- Wrapper package and the instantiation are in the same scope
declare
Enclosing_Name : constant String :=
Unique_Name (Scope (S)) & "__" &
Get_Name_String (Chars (Related_Instance (S)));
begin
if Is_Subprogram (U)
and then not Is_Generic_Actual_Subprogram (U)
then
return Enclosing_Name;
else
return Enclosing_Name & "__" & This_Name;
end if;
end;
else
return Unique_Name (S) & "__" & This_Name;
end if;
end;
end if;
end Unique_Name;
......
gcc/ada/sinfo.adb
......@@ -6895,7 +6895,7 @@ package body Sinfo is
function Pragma_Name (N : Node_Id) return Name_Id is
Result : constant Name_Id := Pragma_Name_Unmapped (N);
begin
for J in Pragma_Map'Range loop
for J in Pragma_Map'First .. Last_Pair loop
if Result = Pragma_Map (J).Key then
return Pragma_Map (J).Value;
end if;
......
gcc/ada/spark_xrefs.ads
......@@ -137,7 +137,7 @@ package SPARK_Xrefs is
-- dependency-number and filename identify a file in FD lines
-- entity-number and entity identify a scope in FS lines
-- for the file previously identified file.
-- for the previously identified file.
-- (filename and entity are just a textual representations of
-- dependency-number and entity-number)
......
gcc/ada/table.ads
......@@ -221,8 +221,8 @@ package Table is
-- Writes out contents of table using Tree_IO
procedure Tree_Read;
-- Initializes table by reading contents previously written
-- with the Tree_Write call (also using Tree_IO)
-- Initializes table by reading contents previously written with the
-- Tree_Write call (also using Tree_IO).
private
......
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