summaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2017-09-06 11:52:28 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2017-09-06 11:52:28 +0000
commita613cd8ac36acb90822c7b26f26afc7619a75d6b (patch)
tree54b3897bca2b75985a9cc0bce9004d96c83d1e91 /gcc
parente12c5305ef4848cec4c53816c469a0df6954ff59 (diff)
downloadgcc-a613cd8ac36acb90822c7b26f26afc7619a75d6b.tar.gz
2017-09-06 Hristian Kirtchev <kirtchev@adacore.com>
* a-comlin.adb, exp_aggr.adb, exp_ch6.adb, frontend.adb, gnatbind.adb, sem_ch3.adb, sem_util.adb: Minor reformatting. 2017-09-06 Yannick Moy <moy@adacore.com> * freeze.adb (Check_Inherited_Conditions): Rewriting of inherited preconditions and postconditions should only occur in GNATprove mode, that is, when GNATprove_Mode is True, not to be confused with SPARK_Mode being On. 2017-09-06 Yannick Moy <moy@adacore.com> * sem_warn.adb (Check_References): Take into account possibility of attribute reference as original node. 2017-09-06 Yannick Moy <moy@adacore.com> * exp_attr.adb (Expand_N_Attribute_Reference): Protect against invalid use of attribute. 2017-09-06 Eric Botcazou <ebotcazou@adacore.com> * inline.adb (Split_Unconstrained_Function): Also set Is_Inlined on the procedure created to encapsulate the body. * sem_ch7.adb: Add with clause for GNAT.HTable. (Entity_Table_Size): New constant. (Entity_Hash): New function. (Subprogram_Table): New instantiation of GNAT.Htable.Simple_HTable. (Is_Subprogram_Ref): Rename into... (Scan_Subprogram_Ref): ...this. Record references to subprograms in the table instead of bailing out on them. Scan the value of constants if it is not known at compile time. (Contains_Subprograms_Refs): Rename into... (Scan_Subprogram_Refs): ...this. (Has_Referencer): Scan the body of all inlined subprograms. Reset the Is_Public flag on subprograms if they are not actually referenced. (Hide_Public_Entities): Beef up comment on the algorithm. Reset the table of subprograms on entry. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@251781 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/ChangeLog41
-rw-r--r--gcc/ada/a-comlin.adb2
-rw-r--r--gcc/ada/exp_aggr.adb6
-rw-r--r--gcc/ada/exp_attr.adb3
-rw-r--r--gcc/ada/exp_ch6.adb6
-rw-r--r--gcc/ada/freeze.adb4
-rw-r--r--gcc/ada/frontend.adb26
-rw-r--r--gcc/ada/gnatbind.adb8
-rw-r--r--gcc/ada/inline.adb3
-rw-r--r--gcc/ada/sem_ch3.adb8
-rw-r--r--gcc/ada/sem_ch7.adb238
-rw-r--r--gcc/ada/sem_util.adb8
-rw-r--r--gcc/ada/sem_warn.adb14
13 files changed, 227 insertions, 140 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2d8077d3e24..0f142f5fe12 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,44 @@
+2017-09-06 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * a-comlin.adb, exp_aggr.adb, exp_ch6.adb, frontend.adb, gnatbind.adb,
+ sem_ch3.adb, sem_util.adb: Minor reformatting.
+
+2017-09-06 Yannick Moy <moy@adacore.com>
+
+ * freeze.adb (Check_Inherited_Conditions): Rewriting
+ of inherited preconditions and postconditions should only occur
+ in GNATprove mode, that is, when GNATprove_Mode is True, not to
+ be confused with SPARK_Mode being On.
+
+2017-09-06 Yannick Moy <moy@adacore.com>
+
+ * sem_warn.adb (Check_References): Take into
+ account possibility of attribute reference as original node.
+
+2017-09-06 Yannick Moy <moy@adacore.com>
+
+ * exp_attr.adb (Expand_N_Attribute_Reference): Protect against invalid
+ use of attribute.
+
+2017-09-06 Eric Botcazou <ebotcazou@adacore.com>
+
+ * inline.adb (Split_Unconstrained_Function): Also set Is_Inlined
+ on the procedure created to encapsulate the body.
+ * sem_ch7.adb: Add with clause for GNAT.HTable.
+ (Entity_Table_Size): New constant.
+ (Entity_Hash): New function.
+ (Subprogram_Table): New instantiation of GNAT.Htable.Simple_HTable.
+ (Is_Subprogram_Ref): Rename into...
+ (Scan_Subprogram_Ref): ...this. Record references to subprograms in
+ the table instead of bailing out on them. Scan the value of constants
+ if it is not known at compile time.
+ (Contains_Subprograms_Refs): Rename into...
+ (Scan_Subprogram_Refs): ...this.
+ (Has_Referencer): Scan the body of all inlined subprograms. Reset the
+ Is_Public flag on subprograms if they are not actually referenced.
+ (Hide_Public_Entities): Beef up comment on the algorithm.
+ Reset the table of subprograms on entry.
+
2017-09-06 Yannick Moy <moy@adacore.com>
* inline.adb: Add comments to Can_Be_Inlined_In_GNATprove_Mode.
diff --git a/gcc/ada/a-comlin.adb b/gcc/ada/a-comlin.adb
index 49caca5abaf..a555410cf13 100644
--- a/gcc/ada/a-comlin.adb
+++ b/gcc/ada/a-comlin.adb
@@ -63,7 +63,7 @@ package body Ada.Command_Line is
declare
Num : constant Positive :=
- (if Remove_Args = null then Number else Remove_Args (Number));
+ (if Remove_Args = null then Number else Remove_Args (Number));
Arg : aliased String (1 .. Len_Arg (Num));
begin
Fill_Arg (Arg'Address, Num);
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 549be9673ef..9ab9573edd1 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -644,8 +644,8 @@ package body Exp_Aggr is
return False;
end if;
- -- Checks 11: The C code generator cannot handle aggregates that
- -- are not part of an object declaration.
+ -- Checks 11: The C code generator cannot handle aggregates that are
+ -- not part of an object declaration.
if Modify_Tree_For_C then
declare
@@ -653,7 +653,7 @@ package body Exp_Aggr is
begin
-- Skip enclosing nested aggregates and their qualified
- -- expressions
+ -- expressions.
while Nkind (Par) = N_Aggregate
or else Nkind (Par) = N_Qualified_Expression
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index d1908bd04f9..60a975fe049 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -6884,7 +6884,8 @@ package body Exp_Attr is
-- are any non-valid scalar subcomponents, and call the function.
elsif Is_Record_Type (Ftyp)
- and then Nkind (Type_Definition (Declaration_Node (Ftyp))) =
+ and then Present (Declaration_Node (Ftyp))
+ and then Nkind (Type_Definition (Declaration_Node (Ftyp))) =
N_Record_Definition
then
Rewrite (N,
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 55831e48f29..0a219f5c10f 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -3952,9 +3952,9 @@ package body Exp_Ch6 is
(RTE (RE_Address), Relocate_Node (First_Actual (Call_Node))));
return;
- -- A call to a null procedure is replaced by a null statement, but
- -- we are not allowed to ignore possible side effects of the call,
- -- so we make sure that actuals are evaluated.
+ -- A call to a null procedure is replaced by a null statement, but we
+ -- are not allowed to ignore possible side effects of the call, so we
+ -- make sure that actuals are evaluated.
elsif Is_Null_Procedure (Subp) then
Actual := First_Actual (Call_Node);
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 42c7463bed8..caccb7e425b 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1494,12 +1494,12 @@ package body Freeze is
Analyze_Entry_Or_Subprogram_Contract (Par_Prim);
- -- In SPARK mode this is where we can collect the inherited
+ -- In GNATprove mode this is where we can collect the inherited
-- conditions, because we do not create the Check pragmas that
-- normally convey the the modified class-wide conditions on
-- overriding operations.
- if SPARK_Mode = On then
+ if GNATprove_Mode then
Collect_Inherited_Class_Wide_Conditions (Prim);
-- Otherwise build the corresponding pragmas to check for legality
diff --git a/gcc/ada/frontend.adb b/gcc/ada/frontend.adb
index 461c04bcc73..378aacdffd1 100644
--- a/gcc/ada/frontend.adb
+++ b/gcc/ada/frontend.adb
@@ -133,15 +133,15 @@ begin
-- Read and process configuration pragma files if present
declare
- Config_Pragmas : List_Id := Empty_List;
- -- Gather configuration pragmas
-
- Gnat_Adc : constant File_Name_Type := Name_Find ("gnat.adc");
Dot_Gnat_Adc : constant File_Name_Type := Name_Find ("./gnat.adc");
+ Gnat_Adc : constant File_Name_Type := Name_Find ("gnat.adc");
Save_Style_Check : constant Boolean := Opt.Style_Check;
-- Save style check mode so it can be restored later
+ Config_Pragmas : List_Id := Empty_List;
+ -- Gather configuration pragmas
+
Source_Config_File : Source_File_Index;
-- Source reference for -gnatec configuration file
@@ -191,19 +191,21 @@ begin
declare
Len : constant Natural := Config_File_Names (Index)'Length;
Str : constant String (1 .. Len) :=
- Config_File_Names (Index).all;
+ Config_File_Names (Index).all;
+
Config_Name : constant File_Name_Type := Name_Find (Str);
- Temp_File : constant Boolean := Len > 4
- and then
- (Str (Len - 3 .. Len) = ".TMP"
- or else
- Str (Len - 3 .. Len) = ".tmp");
+ Temp_File : constant Boolean :=
+ Len > 4
+ and then
+ (Str (Len - 3 .. Len) = ".TMP"
+ or else
+ Str (Len - 3 .. Len) = ".tmp");
-- Extension indicating a temporary config file?
begin
-- Skip it if it's the default name, already loaded above.
- -- Otherwise, we get confusing warning messages about
- -- seeing the same thing twice.
+ -- Otherwise, we get confusing warning messages about seeing
+ -- the same thing twice.
if Config_Name /= Gnat_Adc
and then Config_Name /= Dot_Gnat_Adc
diff --git a/gcc/ada/gnatbind.adb b/gcc/ada/gnatbind.adb
index 63e79652143..baba9feef7c 100644
--- a/gcc/ada/gnatbind.adb
+++ b/gcc/ada/gnatbind.adb
@@ -522,10 +522,10 @@ procedure Gnatbind is
declare
Arguments : constant Argument_List :=
System.Response_File.Arguments_From
- (Response_File_Name =>
- Next_Argv (2 .. Next_Argv'Last),
- Recursive => True,
- Ignore_Non_Existing_Files => True);
+ (Response_File_Name =>
+ Next_Argv (2 .. Next_Argv'Last),
+ Recursive => True,
+ Ignore_Non_Existing_Files => True);
begin
for J in Arguments'Range loop
Action (Arguments (J).all);
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 0bbe9cfd9de..f023d721824 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -1607,7 +1607,7 @@ package body Inline is
-- N is an inlined function body that returns an unconstrained type and
-- has a single extended return statement. Split N in two subprograms:
-- a procedure P' and a function F'. The formals of P' duplicate the
- -- formals of N plus an extra formal which is used return a value;
+ -- formals of N plus an extra formal which is used to return a value;
-- its body is composed by the declarations and list of statements
-- of the extended return statement of N.
@@ -1915,6 +1915,7 @@ package body Inline is
Pop_Scope;
Build_Procedure (Proc_Id, Decl_List);
Insert_Actions (N, Decl_List);
+ Set_Is_Inlined (Proc_Id);
Push_Scope (Scope);
end;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index be241a43ced..b1ecf5285f1 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -16311,7 +16311,7 @@ package body Sem_Ch3 is
then
declare
Partial_View : constant Entity_Id :=
- Find_Partial_View (Parent_Type);
+ Find_Partial_View (Parent_Type);
begin
-- If the partial view was not found then the parent type is not a
@@ -16321,9 +16321,9 @@ package body Sem_Ch3 is
if Present (Partial_View)
and then not Is_Tagged_Type (Partial_View)
then
- Error_Msg_NE ("cannot derive from & declared as "
- & "untagged private (SPARK RM 3.4(1))",
- N, Partial_View);
+ Error_Msg_NE
+ ("cannot derive from & declared as untagged private "
+ & "(SPARK RM 3.4(1))", N, Partial_View);
end if;
end;
end if;
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index e62d7e189df..841aff8a5db 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -70,6 +70,8 @@ with Sinput; use Sinput;
with Style;
with Uintp; use Uintp;
+with GNAT.HTable;
+
package body Sem_Ch7 is
-----------------------------------
@@ -187,6 +189,38 @@ package body Sem_Ch7 is
end if;
end Analyze_Package_Body;
+ ------------------------------------------------------
+ -- Analyze_Package_Body_Helper Data and Subprograms --
+ ------------------------------------------------------
+
+ Entity_Table_Size : constant := 4096;
+ -- Number of headers in hash table
+
+ subtype Entity_Header_Num is Integer range 0 .. Entity_Table_Size - 1;
+ -- Range of headers in hash table
+
+ function Entity_Hash (Id : Entity_Id) return Entity_Header_Num;
+ -- Simple hash function for Entity_Ids
+
+ package Subprogram_Table is new GNAT.Htable.Simple_HTable
+ (Header_Num => Entity_Header_Num,
+ Element => Boolean,
+ No_Element => False,
+ Key => Entity_Id,
+ Hash => Entity_Hash,
+ Equal => "=");
+ -- Hash table to record which subprograms are referenced. It is declared
+ -- at library level to avoid elaborating it for every call to Analyze.
+
+ -----------------
+ -- Entity_Hash --
+ -----------------
+
+ function Entity_Hash (Id : Entity_Id) return Entity_Header_Num is
+ begin
+ return Entity_Header_Num (Id mod Entity_Table_Size);
+ end Entity_Hash;
+
---------------------------------
-- Analyze_Package_Body_Helper --
---------------------------------
@@ -200,8 +234,8 @@ package body Sem_Ch7 is
-- Attempt to hide all public entities found in declarative list Decls
-- by resetting their Is_Public flag to False depending on whether the
-- entities are not referenced by inlined or generic bodies. This kind
- -- of processing is a conservative approximation and may still leave
- -- certain entities externally visible.
+ -- of processing is a conservative approximation and will still leave
+ -- entities externally visible if the package is not simple enough.
procedure Install_Composite_Operations (P : Entity_Id);
-- Composite types declared in the current scope may depend on types
@@ -214,11 +248,6 @@ package body Sem_Ch7 is
--------------------------
procedure Hide_Public_Entities (Decls : List_Id) is
- function Contains_Subprograms_Refs (N : Node_Id) return Boolean;
- -- Subsidiary to routine Has_Referencer. Determine whether a node
- -- contains a reference to a subprogram.
- -- WARNING: this is a very expensive routine as it performs a full
- -- tree traversal.
function Has_Referencer
(Decls : List_Id;
@@ -229,76 +258,15 @@ package body Sem_Ch7 is
-- in the range Last (Decls) .. Referencer are hidden from external
-- visibility.
- -------------------------------
- -- Contains_Subprograms_Refs --
- -------------------------------
-
- function Contains_Subprograms_Refs (N : Node_Id) return Boolean is
- Reference_Seen : Boolean := False;
-
- function Is_Subprogram_Ref (N : Node_Id) return Traverse_Result;
- -- Determine whether a node denotes a reference to a subprogram
-
- -----------------------
- -- Is_Subprogram_Ref --
- -----------------------
-
- function Is_Subprogram_Ref
- (N : Node_Id) return Traverse_Result
- is
- Val : Node_Id;
-
- begin
- -- Detect a reference of the form
- -- Subp_Call
-
- if Nkind (N) in N_Subprogram_Call
- and then Is_Entity_Name (Name (N))
- then
- Reference_Seen := True;
- return Abandon;
-
- -- Detect a reference of the form
- -- Subp'Some_Attribute
-
- elsif Nkind (N) = N_Attribute_Reference
- and then Is_Entity_Name (Prefix (N))
- and then Present (Entity (Prefix (N)))
- and then Is_Subprogram (Entity (Prefix (N)))
- then
- Reference_Seen := True;
- return Abandon;
-
- -- Constants can be substituted by their value in gigi, which
- -- may contain a reference, so be conservative for them.
-
- elsif Is_Entity_Name (N)
- and then Present (Entity (N))
- and then Ekind (Entity (N)) = E_Constant
- then
- Val := Constant_Value (Entity (N));
-
- if Present (Val)
- and then not Compile_Time_Known_Value (Val)
- then
- Reference_Seen := True;
- return Abandon;
- end if;
- end if;
+ function Scan_Subprogram_Ref (N : Node_Id) return Traverse_Result;
+ -- Determine whether a node denotes a reference to a subprogram
- return OK;
- end Is_Subprogram_Ref;
-
- procedure Find_Subprograms_Ref is
- new Traverse_Proc (Is_Subprogram_Ref);
-
- -- Start of processing for Contains_Subprograms_Refs
-
- begin
- Find_Subprograms_Ref (N);
-
- return Reference_Seen;
- end Contains_Subprograms_Refs;
+ procedure Scan_Subprogram_Refs is
+ new Traverse_Proc (Scan_Subprogram_Ref);
+ -- Subsidiary to routine Has_Referencer. Determine whether a node
+ -- contains references to a subprogram and record them.
+ -- WARNING: this is a very expensive routine as it performs a full
+ -- tree traversal.
--------------------
-- Has_Referencer --
@@ -313,10 +281,9 @@ package body Sem_Ch7 is
Spec : Node_Id;
Has_Non_Subprograms_Referencer : Boolean := False;
- -- Flag set if a subprogram body was detected as a referencer but
- -- does not contain references to other subprograms. In this case,
- -- if we still are top level, we do not return True immediately,
- -- but keep hiding subprograms from external visibility.
+ -- Set if an inlined subprogram body was detected as a referencer.
+ -- In this case, we do not return True immediately but keep hiding
+ -- subprograms from external visibility.
begin
if No (Decls) then
@@ -402,17 +369,13 @@ package body Sem_Ch7 is
if Is_Inlined (Decl_Id)
or else Has_Pragma_Inline (Decl_Id)
then
+ Has_Non_Subprograms_Referencer := True;
+
-- Inspect the statements of the subprogram body
-- to determine whether the body references other
-- subprograms.
- if Top_Level
- and then not Contains_Subprograms_Refs (Decl)
- then
- Has_Non_Subprograms_Referencer := True;
- else
- return True;
- end if;
+ Scan_Subprogram_Refs (Decl);
end if;
-- Otherwise this is a stand alone subprogram body
@@ -420,21 +383,22 @@ package body Sem_Ch7 is
else
Decl_Id := Defining_Entity (Decl);
- -- An inlined body acts as a referencer, see above. Note
- -- that an inlined subprogram remains Is_Public as gigi
- -- requires the flag to be set.
+ -- An inlined subprogram body acts as a referencer
if Is_Inlined (Decl_Id)
or else Has_Pragma_Inline (Decl_Id)
then
- if Top_Level
- and then not Contains_Subprograms_Refs (Decl)
- then
- Has_Non_Subprograms_Referencer := True;
- else
- return True;
- end if;
- else
+ Has_Non_Subprograms_Referencer := True;
+
+ -- Inspect the statements of the subprogram body
+ -- to determine whether the body references other
+ -- subprograms.
+
+ Scan_Subprogram_Refs (Decl);
+
+ -- Otherwise we can reset Is_Public right away
+
+ elsif not Subprogram_Table.Get (Decl_Id) then
Set_Is_Public (Decl_Id, False);
end if;
end if;
@@ -443,9 +407,7 @@ package body Sem_Ch7 is
-- if they are not followed by a construct which can reference
-- and export them. The Is_Public flag is reset on top level
-- entities only as anything nested is local to its context.
- -- Likewise for subprograms, but we work harder for them as
- -- their visibility can have a significant impact on inlining
- -- decisions in the back end.
+ -- Likewise for subprograms, but we work harder for them.
elsif Nkind_In (Decl, N_Exception_Declaration,
N_Object_Declaration,
@@ -461,7 +423,8 @@ package body Sem_Ch7 is
and then No (Interface_Name (Decl_Id))
and then
(not Has_Non_Subprograms_Referencer
- or else Nkind (Decl) = N_Subprogram_Declaration)
+ or else (Nkind (Decl) = N_Subprogram_Declaration
+ and then not Subprogram_Table.Get (Decl_Id)))
then
Set_Is_Public (Decl_Id, False);
end if;
@@ -473,6 +436,53 @@ package body Sem_Ch7 is
return Has_Non_Subprograms_Referencer;
end Has_Referencer;
+ -------------------------
+ -- Scan_Subprogram_Ref --
+ -------------------------
+
+ function Scan_Subprogram_Ref (N : Node_Id) return Traverse_Result is
+ begin
+ -- Detect a reference of the form
+ -- Subp_Call
+
+ if Nkind (N) in N_Subprogram_Call
+ and then Is_Entity_Name (Name (N))
+ and then Present (Entity (Name (N)))
+ and then Is_Subprogram (Entity (Name (N)))
+ then
+ Subprogram_Table.Set (Entity (Name (N)), True);
+
+ -- Detect a reference of the form
+ -- Subp'Some_Attribute
+
+ elsif Nkind (N) = N_Attribute_Reference
+ and then Is_Entity_Name (Prefix (N))
+ and then Present (Entity (Prefix (N)))
+ and then Is_Subprogram (Entity (Prefix (N)))
+ then
+ Subprogram_Table.Set (Entity (Prefix (N)), True);
+
+ -- Constants can be substituted by their value in gigi, which may
+ -- contain a reference, so scan the value recursively.
+
+ elsif Is_Entity_Name (N)
+ and then Present (Entity (N))
+ and then Ekind (Entity (N)) = E_Constant
+ then
+ declare
+ Val : constant Node_Id := Constant_Value (Entity (N));
+ begin
+ if Present (Val)
+ and then not Compile_Time_Known_Value (Val)
+ then
+ Scan_Subprogram_Refs (Val);
+ end if;
+ end;
+ end if;
+
+ return OK;
+ end Scan_Subprogram_Ref;
+
-- Local variables
Discard : Boolean := True;
@@ -513,6 +523,30 @@ package body Sem_Ch7 is
-- not always be the case. The algorithm takes a conservative stance
-- and leaves entity External_Obj public.
+ -- This very conservative algorithm is supplemented by a more precise
+ -- processing for inlined bodies. For them, we traverse the syntactic
+ -- tree and record which subprograms are actually referenced from it.
+ -- This makes it possible to compute a much smaller set of externally
+ -- visible subprograms, which can have a significant impact on the
+ -- inlining decisions made in the back end. We do it only for inlined
+ -- bodies because they are supposed to be reasonably small and tree
+ -- traversal is very expensive.
+
+ -- Note that even this special processing is not optimal for inlined
+ -- bodies, because we treat all inlined subprograms alike. An optimal
+ -- algorithm would require computing the transitive closure of the
+ -- inlined subprograms that can really be referenced from other units
+ -- in the source code.
+
+ -- We could extend this processing for inlined bodies and record all
+ -- entities, not just subprograms, referenced from them, which would
+ -- make it possible to compute a much smaller set of all externally
+ -- visible entities in the absence of generic bodies. But this would
+ -- mean implementing a more thorough tree traversal of the bodies,
+ -- i.e. not just syntactic, and the gain would very likely be worth
+ -- neither the hassle nor the slowdown of the compiler.
+
+ Subprogram_Table.Reset;
Discard := Has_Referencer (Decls, Top_Level => True);
end Hide_Public_Entities;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index ffbe86afbc2..c4d09a29e99 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -14131,7 +14131,7 @@ package body Sem_Util is
function Is_Object_Image (Prefix : Node_Id) return Boolean is
begin
-- When the type of the prefix is not scalar then the prefix is not
- -- valid in any senario.
+ -- valid in any scenario.
if not Is_Scalar_Type (Etype (Prefix)) then
return False;
@@ -14139,7 +14139,7 @@ package body Sem_Util is
-- Here we test for the case that the prefix is not a type and assume
-- if it is not then it must be a named value or an object reference.
- -- This is because the parser always checks that prefix's of attributes
+ -- This is because the parser always checks that prefixes of attributes
-- are named.
return not (Is_Entity_Name (Prefix) and then Is_Type (Entity (Prefix)));
@@ -15554,7 +15554,9 @@ package body Sem_Util is
begin
case Ekind (E) is
- when Entry_Kind | Subprogram_Kind =>
+ when Entry_Kind
+ | Subprogram_Kind
+ =>
Scop := Scope (E);
while Present (Scop) loop
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index fd31316eb5d..ecc47e4f24c 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -1382,16 +1382,22 @@ package body Sem_Warn is
-- deal with case where original unset reference has been
-- rewritten during expansion.
- -- In some cases, the original node may be a type conversion
- -- or qualification, and in this case we want the object
- -- entity inside.
+ -- In some cases, the original node may be a type
+ -- conversion, a qualification or an attribute reference and
+ -- in this case we want the object entity inside. Same for
+ -- an expression with actions.
UR := Original_Node (UR);
while Nkind (UR) = N_Type_Conversion
or else Nkind (UR) = N_Qualified_Expression
or else Nkind (UR) = N_Expression_With_Actions
+ or else Nkind (UR) = N_Attribute_Reference
loop
- UR := Expression (UR);
+ if Nkind (UR) = N_Attribute_Reference then
+ UR := Prefix (UR);
+ else
+ UR := Expression (UR);
+ end if;
end loop;
-- Don't issue warning if appearing inside Initial_Condition