[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.
This commit is contained in:
Bob Duff
Pierre-Marie de Rodat
parent
d1987ffdc2
commit
a2754419d0
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue