Commit 923ecd0e by Hristian Kirtchev Committed by Pierre-Marie de Rodat

[Ada] Lingering loop for ignored Ghost assignment

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

2018-11-14  Hristian Kirtchev  <kirtchev@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.

From-SVN: r266111
parent e3548b69
2018-11-14 Hristian Kirtchev <kirtchev@adacore.com>
* 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.
2018-11-14 Piotr Trojanek <trojanek@adacore.com> 2018-11-14 Piotr Trojanek <trojanek@adacore.com>
* bindgen.adb, exp_cg.adb, repinfo.adb, sprint.adb: Minor reuse * bindgen.adb, exp_cg.adb, repinfo.adb, sprint.adb: Minor reuse
......
...@@ -3368,8 +3368,8 @@ package body Exp_Ch4 is ...@@ -3368,8 +3368,8 @@ package body Exp_Ch4 is
-- entity, we make sure we have debug information for the result. -- entity, we make sure we have debug information for the result.
Ent := Make_Temporary (Loc, 'S'); Ent := Make_Temporary (Loc, 'S');
Set_Is_Internal (Ent); Set_Is_Internal (Ent);
Set_Needs_Debug_Info (Ent); Set_Debug_Info_Needed (Ent);
-- If the bound is statically known to be out of range, we do not want -- 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 -- to abort, we want a warning and a runtime constraint error. Note that
......
...@@ -1053,7 +1053,7 @@ package body Exp_Dbug is ...@@ -1053,7 +1053,7 @@ package body Exp_Dbug is
Name => New_Occurrence_Of (E, Loc)); Name => New_Occurrence_Of (E, Loc));
Append (Decl, Declarations (N)); Append (Decl, Declarations (N));
Set_Needs_Debug_Info (Defining_Identifier (Decl)); Set_Debug_Info_Needed (Defining_Identifier (Decl));
end if; end if;
Next_Entity (E); Next_Entity (E);
......
...@@ -1688,7 +1688,7 @@ package body Exp_Prag is ...@@ -1688,7 +1688,7 @@ package body Exp_Prag is
-- condition is subject to Source Coverage Obligations. -- condition is subject to Source Coverage Obligations.
if Generate_SCO then if Generate_SCO then
Set_Needs_Debug_Info (Proc_Id); Set_Debug_Info_Needed (Proc_Id);
end if; end if;
-- Generate: -- Generate:
...@@ -1722,7 +1722,7 @@ package body Exp_Prag is ...@@ -1722,7 +1722,7 @@ package body Exp_Prag is
Proc_Body_Id := Defining_Entity (Proc_Body); Proc_Body_Id := Defining_Entity (Proc_Body);
if Generate_SCO then if Generate_SCO then
Set_Needs_Debug_Info (Proc_Body_Id); Set_Debug_Info_Needed (Proc_Body_Id);
end if; end if;
-- The location of the initial condition procedure call must be as close -- The location of the initial condition procedure call must be as close
......
...@@ -1933,7 +1933,7 @@ package body Exp_Util is ...@@ -1933,7 +1933,7 @@ package body Exp_Util is
-- is subject to Source Coverage Obligations. -- is subject to Source Coverage Obligations.
if Generate_SCO then if Generate_SCO then
Set_Needs_Debug_Info (Proc_Id); Set_Debug_Info_Needed (Proc_Id);
end if; end if;
-- Obtain all views of the input type -- Obtain all views of the input type
...@@ -3407,7 +3407,7 @@ package body Exp_Util is ...@@ -3407,7 +3407,7 @@ package body Exp_Util is
-- subject to Source Coverage Obligations. -- subject to Source Coverage Obligations.
if Generate_SCO then if Generate_SCO then
Set_Needs_Debug_Info (Proc_Id); Set_Debug_Info_Needed (Proc_Id);
end if; end if;
-- Obtain all views of the input type -- Obtain all views of the input type
......
...@@ -1648,8 +1648,8 @@ package body Ghost is ...@@ -1648,8 +1648,8 @@ package body Ghost is
or else Nkind (N) in N_Push_Pop_xxx_Label 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_Raise_xxx_Error
or else Nkind (N) in N_Representation_Clause or else Nkind (N) in N_Representation_Clause
or else Nkind_In (N, N_Assignment_Statement, or else Nkind (N) in N_Statement_Other_Than_Procedure_Call
N_Call_Marker, or else Nkind_In (N, N_Call_Marker,
N_Freeze_Entity, N_Freeze_Entity,
N_Freeze_Generic_Entity, N_Freeze_Generic_Entity,
N_Itype_Reference, N_Itype_Reference,
......
...@@ -24184,18 +24184,27 @@ package body Sem_Util is ...@@ -24184,18 +24184,27 @@ package body Sem_Util is
-- Start of processing for Set_Debug_Info_Needed -- Start of processing for Set_Debug_Info_Needed
begin begin
-- Nothing to do if argument is Empty or has Debug_Info_Off set, which -- Nothing to do if there is no available entity
-- indicates that Debug_Info_Needed is never required for the 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 -- Nothing to do if entity comes from a predefined file. Library files
-- are compiled without debug information, but inlined bodies of these -- are compiled without debug information, but inlined bodies of these
-- routines may appear in user code, and debug information on them ends -- routines may appear in user code, and debug information on them ends
-- up complicating debugging the user code. -- 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 elsif In_Inlined_Body and then In_Predefined_Unit (T) then
Set_Needs_Debug_Info (T, False); Set_Needs_Debug_Info (T, False);
end if; end if;
......
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