The following patch ensures that loops generated for aggregates as part
of ignored Ghost assignments are correctly eliminated from the generated
code.
------------
-- Source --
------------
-- pack.ads
package Pack is
type addr4k is new Integer range 0 .. 100 with Size => 32;
type Four_KB_Page_Property is record
Is_Scrubbed : Boolean := False;
end record with Ghost;
type Four_KB_Page_Array is
array (addr4k range <>) of Four_KB_Page_Property with Ghost;
type Base_Memory is tagged record
Four_KB_Pages : Four_KB_Page_Array (addr4k) :=
(others => (Is_Scrubbed => False));
end record with Ghost;
subtype Memory is Base_Memory with Ghost;
Global_Memory : Memory with Ghost;
procedure Assign;
end Pack;
-- pack.adb
package body Pack is
procedure Assign is
begin
Global_Memory.Four_KB_Pages := (others => (Is_Scrubbed => True));
end Assign;
end Pack;
----------------------------
-- Compilation and output --
----------------------------
$ gcc -c -gnatDG pack.adb
$ grep -c "loop" pack.adb.dg
0
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-11-14 Hristian Kirtchev <kirtc...@adacore.com>
gcc/ada/
* exp_ch4.adb (Expand_Concatenate): Use the proper routine to
set the need for debug info.
* exp_dbug.adb (Build_Subprogram_Instance_Renamings): Use the
proper routine to set the need for debug info.
* exp_prag.adb (Expand_Pragma_Initial_Condition): Use the proper
routine to set the need for debug info.
* exp_util.adb (Build_DIC_Procedure_Declaration): Use the proper
routine to set the need for debug info.
(Build_Invariant_Procedure_Declaration): Use the proper routine
to set the need for debug info.
* ghost.adb (Record_Ignored_Ghost_Node): Add statements as a
whole class to the list of top level ignored Ghost nodes.
* sem_util.adb (Set_Debug_Info_Needed): Do not generate debug
info for an ignored Ghost entity.--- gcc/ada/exp_ch4.adb
+++ gcc/ada/exp_ch4.adb
@@ -3368,8 +3368,8 @@ package body Exp_Ch4 is
-- entity, we make sure we have debug information for the result.
Ent := Make_Temporary (Loc, 'S');
- Set_Is_Internal (Ent);
- Set_Needs_Debug_Info (Ent);
+ Set_Is_Internal (Ent);
+ Set_Debug_Info_Needed (Ent);
-- If the bound is statically known to be out of range, we do not want
-- to abort, we want a warning and a runtime constraint error. Note that
--- gcc/ada/exp_dbug.adb
+++ gcc/ada/exp_dbug.adb
@@ -1053,7 +1053,7 @@ package body Exp_Dbug is
Name => New_Occurrence_Of (E, Loc));
Append (Decl, Declarations (N));
- Set_Needs_Debug_Info (Defining_Identifier (Decl));
+ Set_Debug_Info_Needed (Defining_Identifier (Decl));
end if;
Next_Entity (E);
--- gcc/ada/exp_prag.adb
+++ gcc/ada/exp_prag.adb
@@ -1688,7 +1688,7 @@ package body Exp_Prag is
-- condition is subject to Source Coverage Obligations.
if Generate_SCO then
- Set_Needs_Debug_Info (Proc_Id);
+ Set_Debug_Info_Needed (Proc_Id);
end if;
-- Generate:
@@ -1722,7 +1722,7 @@ package body Exp_Prag is
Proc_Body_Id := Defining_Entity (Proc_Body);
if Generate_SCO then
- Set_Needs_Debug_Info (Proc_Body_Id);
+ Set_Debug_Info_Needed (Proc_Body_Id);
end if;
-- The location of the initial condition procedure call must be as close
--- gcc/ada/exp_util.adb
+++ gcc/ada/exp_util.adb
@@ -1933,7 +1933,7 @@ package body Exp_Util is
-- is subject to Source Coverage Obligations.
if Generate_SCO then
- Set_Needs_Debug_Info (Proc_Id);
+ Set_Debug_Info_Needed (Proc_Id);
end if;
-- Obtain all views of the input type
@@ -3407,7 +3407,7 @@ package body Exp_Util is
-- subject to Source Coverage Obligations.
if Generate_SCO then
- Set_Needs_Debug_Info (Proc_Id);
+ Set_Debug_Info_Needed (Proc_Id);
end if;
-- Obtain all views of the input type
--- gcc/ada/ghost.adb
+++ gcc/ada/ghost.adb
@@ -1648,8 +1648,8 @@ package body Ghost is
or else Nkind (N) in N_Push_Pop_xxx_Label
or else Nkind (N) in N_Raise_xxx_Error
or else Nkind (N) in N_Representation_Clause
- or else Nkind_In (N, N_Assignment_Statement,
- N_Call_Marker,
+ or else Nkind (N) in N_Statement_Other_Than_Procedure_Call
+ or else Nkind_In (N, N_Call_Marker,
N_Freeze_Entity,
N_Freeze_Generic_Entity,
N_Itype_Reference,
--- gcc/ada/sem_util.adb
+++ gcc/ada/sem_util.adb
@@ -24184,18 +24184,27 @@ package body Sem_Util is
-- Start of processing for Set_Debug_Info_Needed
begin
- -- Nothing to do if argument is Empty or has Debug_Info_Off set, which
- -- indicates that Debug_Info_Needed is never required for the entity.
+ -- Nothing to do if there is no available entity
+
+ if No (T) then
+ return;
+
+ -- Nothing to do for an entity with suppressed debug information
+
+ elsif Debug_Info_Off (T) then
+ return;
+
+ -- Nothing to do for an ignored Ghost entity because the entity will be
+ -- eliminated from the tree.
+
+ elsif Is_Ignored_Ghost_Entity (T) then
+ return;
+
-- Nothing to do if entity comes from a predefined file. Library files
-- are compiled without debug information, but inlined bodies of these
-- routines may appear in user code, and debug information on them ends
-- up complicating debugging the user code.
- if No (T)
- or else Debug_Info_Off (T)
- then
- return;
-
elsif In_Inlined_Body and then In_Predefined_Unit (T) then
Set_Needs_Debug_Info (T, False);
end if;
