[Ada] Put_Image attribute: Rtsfind cleanups

2020-06-05  Bob Duff  <duff@adacore.com>

gcc/ada/

	* rtsfind.adb, rtsfind.ads: Move subtypes of RTU_Id into package
	body, because they are not needed by clients. Change "Child_" to
	"Descendant", because grandchildren and great grandchildren are
	involved.  Replace all the repetitive comments with a single
	concise one.  Change the parent subtypes to be more consistent;
	use the most specific parent.

diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index c43561c..d190115 100644 (file)
--- a/gcc/ada/rtsfind.adb
+++ b/gcc/ada/rtsfind.adb
@@ -540,87 +540,166 @@ package body Rtsfind is
    -- Get_Unit_Name --
    -------------------
 
+   --  The following subtypes include all the proper descendants of each unit
+   --  that has such descendants. For example, Ada_Calendar_Descendant includes
+   --  all the descendents of Ada.Calendar (except Ada.Calendar itself). These
+   --  are used by Get_Unit_Name to know where to change "_" to ".", and by
+   --  Is_Text_IO_Special_Package to detect the special generic pseudo-children
+   --  of [[Wide_]Wide_]Text_IO.
+
+   subtype Ada_Descendant is RTU_Id
+     range Ada_Calendar .. Ada_Wide_Wide_Text_IO_Modular_IO;
+
+   subtype Ada_Calendar_Descendant is Ada_Descendant
+     range Ada_Calendar_Delays .. Ada_Calendar_Delays;
+
+   subtype Ada_Dispatching_Descendant is Ada_Descendant
+     range Ada_Dispatching_EDF .. Ada_Dispatching_EDF;
+
+   subtype Ada_Interrupts_Descendant is Ada_Descendant range
+     Ada_Interrupts_Names .. Ada_Interrupts_Names;
+
+   subtype Ada_Numerics_Descendant is Ada_Descendant
+     range Ada_Numerics_Generic_Elementary_Functions ..
+           Ada_Numerics_Generic_Elementary_Functions;
+
+   subtype Ada_Real_Time_Descendant is Ada_Descendant
+     range Ada_Real_Time_Delays .. Ada_Real_Time_Timing_Events;
+
+   subtype Ada_Streams_Descendant is Ada_Descendant
+     range Ada_Streams_Stream_IO .. Ada_Streams_Stream_IO;
+
+   subtype Ada_Strings_Descendant is Ada_Descendant
+     range Ada_Strings_Superbounded .. Ada_Strings_Text_Output_Utils;
+
+   subtype Ada_Strings_Text_Output_Descendant is Ada_Strings_Descendant
+     range Ada_Strings_Text_Output_Utils .. Ada_Strings_Text_Output_Utils;
+
+   subtype Ada_Text_IO_Descendant is Ada_Descendant
+     range Ada_Text_IO_Decimal_IO .. Ada_Text_IO_Modular_IO;
+
+   subtype Ada_Wide_Text_IO_Descendant is Ada_Descendant
+     range Ada_Wide_Text_IO_Decimal_IO .. Ada_Wide_Text_IO_Modular_IO;
+
+   subtype Ada_Wide_Wide_Text_IO_Descendant is Ada_Descendant
+     range Ada_Wide_Wide_Text_IO_Decimal_IO ..
+           Ada_Wide_Wide_Text_IO_Modular_IO;
+
+   subtype Interfaces_Descendant is RTU_Id
+     range Interfaces_Packed_Decimal .. Interfaces_Packed_Decimal;
+
+   subtype System_Descendant is RTU_Id
+     range System_Address_Image .. System_Tasking_Stages;
+
+   subtype System_Dim_Descendant is System_Descendant
+     range System_Dim_Float_IO .. System_Dim_Integer_IO;
+
+   subtype System_Multiprocessors_Descendant is System_Descendant
+     range System_Multiprocessors_Dispatching_Domains ..
+       System_Multiprocessors_Dispatching_Domains;
+
+   subtype System_Storage_Pools_Descendant is System_Descendant
+     range System_Storage_Pools_Subpools .. System_Storage_Pools_Subpools;
+
+   subtype System_Strings_Descendant is System_Descendant
+     range System_Strings_Stream_Ops .. System_Strings_Stream_Ops;
+
+   subtype System_Tasking_Descendant is System_Descendant
+     range System_Tasking_Async_Delays .. System_Tasking_Stages;
+
+   subtype System_Tasking_Protected_Objects_Descendant is
+     System_Tasking_Descendant
+     range System_Tasking_Protected_Objects_Entries ..
+       System_Tasking_Protected_Objects_Single_Entry;
+
+   subtype System_Tasking_Restricted_Descendant is System_Tasking_Descendant
+     range System_Tasking_Restricted_Stages ..
+       System_Tasking_Restricted_Stages;
+
+   subtype System_Tasking_Async_Delays_Descendant is System_Tasking_Descendant
+     range System_Tasking_Async_Delays_Enqueue_Calendar ..
+       System_Tasking_Async_Delays_Enqueue_RT;
+
    function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type is
       Uname_Chars : constant String := RTU_Id'Image (U_Id);
-
    begin
       Name_Len := Uname_Chars'Length;
       Name_Buffer (1 .. Name_Len) := Uname_Chars;
       Set_Casing (All_Lower_Case);
 
-      if U_Id in Ada_Child then
+      if U_Id in Ada_Descendant then
          Name_Buffer (4) := '.';
 
-         if U_Id in Ada_Calendar_Child then
+         if U_Id in Ada_Calendar_Descendant then
             Name_Buffer (13) := '.';
 
-         elsif U_Id in Ada_Dispatching_Child then
+         elsif U_Id in Ada_Dispatching_Descendant then
             Name_Buffer (16) := '.';
 
-         elsif U_Id in Ada_Interrupts_Child then
+         elsif U_Id in Ada_Interrupts_Descendant then
             Name_Buffer (15) := '.';
 
-         elsif U_Id in Ada_Numerics_Child then
+         elsif U_Id in Ada_Numerics_Descendant then
             Name_Buffer (13) := '.';
 
-         elsif U_Id in Ada_Real_Time_Child then
+         elsif U_Id in Ada_Real_Time_Descendant then
             Name_Buffer (14) := '.';
 
-         elsif U_Id in Ada_Streams_Child then
+         elsif U_Id in Ada_Streams_Descendant then
             Name_Buffer (12) := '.';
 
-         elsif U_Id in Ada_Strings_Child then
+         elsif U_Id in Ada_Strings_Descendant then
             Name_Buffer (12) := '.';
 
-            if U_Id in Ada_Strings_Text_Output_Child then
+            if U_Id in Ada_Strings_Text_Output_Descendant then
                Name_Buffer (24) := '.';
             end if;
 
-         elsif U_Id in Ada_Text_IO_Child then
+         elsif U_Id in Ada_Text_IO_Descendant then
             Name_Buffer (12) := '.';
 
-         elsif U_Id in Ada_Wide_Text_IO_Child then
+         elsif U_Id in Ada_Wide_Text_IO_Descendant then
             Name_Buffer (17) := '.';
 
-         elsif U_Id in Ada_Wide_Wide_Text_IO_Child then
+         elsif U_Id in Ada_Wide_Wide_Text_IO_Descendant then
             Name_Buffer (22) := '.';
          end if;
 
-      elsif U_Id in Interfaces_Child then
+      elsif U_Id in Interfaces_Descendant then
          Name_Buffer (11) := '.';
 
-      elsif U_Id in System_Child then
+      elsif U_Id in System_Descendant then
          Name_Buffer (7) := '.';
 
-         if U_Id in System_Dim_Child then
+         if U_Id in System_Dim_Descendant then
             Name_Buffer (11) := '.';
          end if;
 
-         if U_Id in System_Multiprocessors_Child then
+         if U_Id in System_Multiprocessors_Descendant then
             Name_Buffer (23) := '.';
          end if;
 
-         if U_Id in System_Storage_Pools_Child then
+         if U_Id in System_Storage_Pools_Descendant then
             Name_Buffer (21) := '.';
          end if;
 
-         if U_Id in System_Strings_Child then
+         if U_Id in System_Strings_Descendant then
             Name_Buffer (15) := '.';
          end if;
 
-         if U_Id in System_Tasking_Child then
+         if U_Id in System_Tasking_Descendant then
             Name_Buffer (15) := '.';
          end if;
 
-         if U_Id in System_Tasking_Restricted_Child then
+         if U_Id in System_Tasking_Restricted_Descendant then
             Name_Buffer (26) := '.';
          end if;
 
-         if U_Id in System_Tasking_Protected_Objects_Child then
+         if U_Id in System_Tasking_Protected_Objects_Descendant then
             Name_Buffer (33) := '.';
          end if;
 
-         if U_Id in System_Tasking_Async_Delays_Child then
+         if U_Id in System_Tasking_Async_Delays_Descendant then
             Name_Buffer (28) := '.';
          end if;
       end if;
@@ -769,19 +848,19 @@ package body Rtsfind is
 
       --  ??? detection with a scope climbing might be more efficient
 
-      for U in Ada_Text_IO_Child loop
+      for U in Ada_Text_IO_Descendant loop
          if Is_RTU (E, U) then
             return True;
          end if;
       end loop;
 
-      for U in Ada_Wide_Text_IO_Child loop
+      for U in Ada_Wide_Text_IO_Descendant loop
          if Is_RTU (E, U) then
             return True;
          end if;
       end loop;
 
-      for U in Ada_Wide_Wide_Text_IO_Child loop
+      for U in Ada_Wide_Wide_Text_IO_Descendant loop
          if Is_RTU (E, U) then
             return True;
          end if;

diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads
index 13d2253..5074e18 100644 (file)
--- a/gcc/ada/rtsfind.ads
+++ b/gcc/ada/rtsfind.ads
@@ -59,6 +59,9 @@ package Rtsfind is
    --  the compilation except in the presence of use clauses, which might
    --  result in unexpected ambiguities.
 
+   --  NOTE: If RTU_Id is modified, the subtypes of RTU_Id in the package body
+   --  might need to be modified. See Get_Unit_Name.
+
    type RTU_Id is (
 
       --  Runtime packages, for list of accessible entities in each package,
@@ -380,97 +383,6 @@ package Rtsfind is
       System_Tasking_Rendezvous,
       System_Tasking_Stages);
 
-   subtype Ada_Child is RTU_Id
-     range Ada_Calendar .. Ada_Wide_Wide_Text_IO_Modular_IO;
-   --  Range of values for children or grandchildren of Ada
-
-   subtype Ada_Calendar_Child is Ada_Child
-     range Ada_Calendar_Delays .. Ada_Calendar_Delays;
-   --  Range of values for children of Ada.Calendar
-
-   subtype Ada_Dispatching_Child is RTU_Id
-     range Ada_Dispatching_EDF .. Ada_Dispatching_EDF;
-   --  Range of values for children of Ada.Dispatching
-
-   subtype Ada_Interrupts_Child is Ada_Child range
-     Ada_Interrupts_Names .. Ada_Interrupts_Names;
-   --  Range of values for children of Ada.Interrupts
-
-   subtype Ada_Numerics_Child is Ada_Child
-     range Ada_Numerics_Generic_Elementary_Functions ..
-           Ada_Numerics_Generic_Elementary_Functions;
-   --  Range of values for children of Ada.Numerics
-
-   subtype Ada_Real_Time_Child is Ada_Child
-     range Ada_Real_Time_Delays .. Ada_Real_Time_Timing_Events;
-   --  Range of values for children of Ada.Real_Time
-
-   subtype Ada_Streams_Child is Ada_Child
-     range Ada_Streams_Stream_IO .. Ada_Streams_Stream_IO;
-   --  Range of values for children of Ada.Streams
-
-   subtype Ada_Strings_Child is Ada_Child
-     range Ada_Strings_Superbounded .. Ada_Strings_Text_Output_Utils;
-   --  Range of values for children and grandchildren of Ada.Strings
-
-   subtype Ada_Strings_Text_Output_Child is Ada_Child
-     range Ada_Strings_Text_Output_Utils .. Ada_Strings_Text_Output_Utils;
-   --  Range of values for children of Ada.Strings.Text_Output
-
-   subtype Ada_Text_IO_Child is Ada_Child
-     range Ada_Text_IO_Decimal_IO .. Ada_Text_IO_Modular_IO;
-   --  Range of values for children of Ada.Text_IO
-
-   subtype Ada_Wide_Text_IO_Child is Ada_Child
-     range Ada_Wide_Text_IO_Decimal_IO .. Ada_Wide_Text_IO_Modular_IO;
-   --  Range of values for children of Ada.Text_IO
-
-   subtype Ada_Wide_Wide_Text_IO_Child is Ada_Child
-     range Ada_Wide_Wide_Text_IO_Decimal_IO ..
-           Ada_Wide_Wide_Text_IO_Modular_IO;
-
-   subtype Interfaces_Child is RTU_Id
-     range Interfaces_Packed_Decimal .. Interfaces_Packed_Decimal;
-   --  Range of values for children of Interfaces
-
-   subtype System_Child is RTU_Id
-     range System_Address_Image .. System_Tasking_Stages;
-   --  Range of values for children or grandchildren of System
-
-   subtype System_Dim_Child is RTU_Id
-     range System_Dim_Float_IO .. System_Dim_Integer_IO;
-   --  Range of values for children of System.Dim
-
-   subtype System_Multiprocessors_Child is RTU_Id
-     range System_Multiprocessors_Dispatching_Domains ..
-       System_Multiprocessors_Dispatching_Domains;
-   --  Range of values for children of System.Multiprocessors
-
-   subtype System_Storage_Pools_Child is RTU_Id
-     range System_Storage_Pools_Subpools .. System_Storage_Pools_Subpools;
-
-   subtype System_Strings_Child is RTU_Id
-     range System_Strings_Stream_Ops .. System_Strings_Stream_Ops;
-
-   subtype System_Tasking_Child is System_Child
-     range System_Tasking_Async_Delays .. System_Tasking_Stages;
-   --  Range of values for children of System.Tasking
-
-   subtype System_Tasking_Protected_Objects_Child is System_Tasking_Child
-     range System_Tasking_Protected_Objects_Entries ..
-       System_Tasking_Protected_Objects_Single_Entry;
-   --  Range of values for children of System.Tasking.Protected_Objects
-
-   subtype System_Tasking_Restricted_Child is System_Tasking_Child
-     range System_Tasking_Restricted_Stages ..
-       System_Tasking_Restricted_Stages;
-   --  Range of values for children of System.Tasking.Restricted
-
-   subtype System_Tasking_Async_Delays_Child is System_Tasking_Child
-     range System_Tasking_Async_Delays_Enqueue_Calendar ..
-       System_Tasking_Async_Delays_Enqueue_RT;
-   --  Range of values for children of System.Tasking.Async_Delays
-
    --------------------------
    -- Runtime Entity Table --
    --------------------------
@@ -3193,6 +3105,7 @@ package Rtsfind is
    --  Ada RM defines to be nested in Ada.Text_IO, but GNAT defines as its
    --  private children. This is similar to Is_Text_IO_Special_Unit, but is
    --  meant to be used on a fully resolved AST, especially in the backends.
+   --  This is used by SPARK.
 
    function RTE (E : RE_Id) return Entity_Id;
    --  Given the entity defined in the above tables, as identified by the