[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 26ffdfc..8a42f4f 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,20 @@
+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>
 
        * bindgen.adb, exp_cg.adb, repinfo.adb, sprint.adb: Minor reuse

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index ace501b..98c1d31 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/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

diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb
index a50dad9..34a97c8 100644 (file)
--- a/gcc/ada/exp_dbug.adb
+++ b/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);

diff --git a/gcc/ada/exp_prag.adb b/gcc/ada/exp_prag.adb
index 65cfe1f..485f066 100644 (file)
--- a/gcc/ada/exp_prag.adb
+++ b/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

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index cf277c1..b24cab7 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/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

diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
index 47912aa..ffb5d50 100644 (file)
--- a/gcc/ada/ghost.adb
+++ b/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,

diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 7235c96..f4b6579 100644 (file)
--- a/gcc/ada/sem_util.adb
+++ b/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;