Commit 150bbaff by Arnaud Charlet

rtsfind.adb (Check_CRT): Take into account RTE_Available_Call Fixes another case where...

	* rtsfind.adb (Check_CRT): Take into account RTE_Available_Call
	Fixes another case where RTE_Available_Call was ignored instead of being
	taken into account.
	(Load_Fail): Ditto.

	* rtsfind.ads: Add new entries.

From-SVN: r130848
parent cadf64d1
...@@ -110,47 +110,46 @@ package body Rtsfind is ...@@ -110,47 +110,46 @@ package body Rtsfind is
-- Generation of WITH's -- -- Generation of WITH's --
-------------------------- --------------------------
-- When a unit is implicitly loaded as a result of a call to RTE, it -- When a unit is implicitly loaded as a result of a call to RTE, it is
-- is necessary to create an implicit WITH to ensure that the object -- necessary to create an implicit WITH to ensure that the object is
-- is correctly loaded by the binder. Such WITH statements are only -- correctly loaded by the binder. Such WITH statements are only required
-- required when the request is from the extended main unit (if a -- when the request is from the extended main unit (if a client needs a
-- client needs a WITH, that will be taken care of when the client -- WITH, that will be taken care of when the client is compiled).
-- is compiled).
-- We always attach the WITH to the main unit. This is not perfectly -- We always attach the WITH to the main unit. This is not perfectly
-- accurate in terms of elaboration requirements, but it is close -- accurate in terms of elaboration requirements, but it is close enough,
-- enough, since the units that are accessed using rtsfind do not -- since the units that are accessed using rtsfind do not have delicate
-- have delicate elaboration requirements. -- elaboration requirements.
-- The flag Withed in the unit table record is initially set to False. -- The flag Withed in the unit table record is initially set to False. It
-- It is set True if a WITH has been generated for the main unit for -- is set True if a WITH has been generated for the main unit for the
-- the corresponding unit. -- corresponding unit.
----------------------- -----------------------
-- Local Subprograms -- -- Local Subprograms --
----------------------- -----------------------
function Check_CRT (E : RE_Id; Eid : Entity_Id) return Entity_Id; function Check_CRT (E : RE_Id; Eid : Entity_Id) return Entity_Id;
-- Check entity Eid to ensure that configurable run-time restrictions -- Check entity Eid to ensure that configurable run-time restrictions are
-- are met. May generate an error message and raise RE_Not_Available -- met. May generate an error message (if RTE_Available_Call is false) and
-- if the entity E does not exist (i.e. Eid is Empty) -- raise RE_Not_Available if entity E does not exist (e.g. Eid is Empty).
-- Above documentation not clear ???
procedure Entity_Not_Defined (Id : RE_Id); procedure Entity_Not_Defined (Id : RE_Id);
-- Outputs error messages for an entity that is not defined in the -- Outputs error messages for an entity that is not defined in the run-time
-- run-time library (the form of the error message is tailored for -- library (the form of the error message is tailored for no run time or
-- no run time/configurable run time mode as required). -- configurable run time mode as required).
function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type; function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type;
-- Retrieves the Unit Name given a unit id represented by its -- Retrieves the Unit Name given a unit id represented by its enumeration
-- enumeration value in RTU_Id. -- value in RTU_Id.
procedure Load_Fail (S : String; U_Id : RTU_Id; Id : RE_Id); procedure Load_Fail (S : String; U_Id : RTU_Id; Id : RE_Id);
-- Internal procedure called if we can't sucessfully locate or -- Internal procedure called if we can't sucessfully locate or process a
-- process a run-time unit. The parameters give information about -- run-time unit. The parameters give information about the error message
-- the error message to be given. S is a reason for failing to -- to be given. S is a reason for failing to compile the file and U_Id is
-- compile the file and U_Id is the unit id. RE_Id is the RE_Id -- the unit id. RE_Id is the RE_Id originally passed to RTE. The message in
-- originally passed to RTE. The message in S is one of the -- S is one of the following:
-- following:
-- --
-- "not found" -- "not found"
-- "had parser errors" -- "had parser errors"
...@@ -166,16 +165,16 @@ package body Rtsfind is ...@@ -166,16 +165,16 @@ package body Rtsfind is
Use_Setting : Boolean := False); Use_Setting : Boolean := False);
-- Load the unit whose Id is given if not already loaded. The unit is -- Load the unit whose Id is given if not already loaded. The unit is
-- loaded, analyzed, and added to the WITH list, and the entry in -- loaded, analyzed, and added to the WITH list, and the entry in
-- RT_Unit_Table is updated to reflect the load. Use_Setting is used -- RT_Unit_Table is updated to reflect the load. Use_Setting is used to
-- to indicate the initial setting for the Is_Potentially_Use_Visible -- indicate the initial setting for the Is_Potentially_Use_Visible flag of
-- flag of the entity for the loaded unit (if it is indeed loaded). -- the entity for the loaded unit (if it is indeed loaded). A value of
-- A value of False means nothing special need be done. A value of -- False means nothing special need be done. A value of True indicates that
-- True indicates that this flag must be set to True. It is needed -- this flag must be set to True. It is needed only in the Text_IO_Kludge
-- only in the Text_IO_Kludge procedure, which may materialize an -- procedure, which may materialize an entity of Text_IO (or
-- entity of Text_IO (or [Wide_]Wide_Text_IO) that was previously unknown. -- [Wide_]Wide_Text_IO) that was previously unknown. Id is the RE_Id value
-- Id is the RE_Id value of the entity which was originally requested. -- of the entity which was originally requested. Id is used only for error
-- Id is used only for error message detail, and if it is RE_Null, then -- message detail, and if it is RE_Null, then the attempt to output the
-- the attempt to output the entity name is ignored. -- entity name is ignored.
function Make_Unit_Name (E : RE_Id; N : Node_Id) return Node_Id; function Make_Unit_Name (E : RE_Id; N : Node_Id) return Node_Id;
-- If the unit is a child unit, build fully qualified name for use in -- If the unit is a child unit, build fully qualified name for use in
...@@ -206,7 +205,12 @@ package body Rtsfind is ...@@ -206,7 +205,12 @@ package body Rtsfind is
begin begin
if No (Eid) then if No (Eid) then
Entity_Not_Defined (E); if RTE_Available_Call then
RTE_Is_Available := False;
else
Entity_Not_Defined (E);
end if;
raise RE_Not_Available; raise RE_Not_Available;
-- Entity is available -- Entity is available
...@@ -541,12 +545,30 @@ package body Rtsfind is ...@@ -541,12 +545,30 @@ package body Rtsfind is
Output_Entity_Name (Id, "not available"); Output_Entity_Name (Id, "not available");
end if; end if;
-- In configurable run time mode, we raise RE_Not_Available, and we hope -- In configurable run time mode, we raise RE_Not_Available, and the
-- the caller deals gracefully with this. If we are in normal full run -- caller is expected to deal gracefully with this. In the case of a
-- time mode, a load failure is considered fatal and unrecoverable. -- call to RTE_Available, this exception will be caught in Rtsfind,
-- and result in a returned value of False for the call.
if Configurable_Run_Time_Mode then if Configurable_Run_Time_Mode then
raise RE_Not_Available; raise RE_Not_Available;
-- Here we have a load failure in normal full run time mode. See if we
-- are in the context of an RTE_Available call. If so, we just raise
-- RE_Not_Available. This can happen if a unit is unavailable, which
-- happens for example in the VM case, where the run-time is not
-- complete, but we do not regard it as a configurable run-time.
-- If the caller has done an explicit call to RTE_Available, then
-- clearly the caller is prepared to deal with a result of False.
elsif RTE_Available_Call then
RTE_Is_Available := False;
raise RE_Not_Available;
-- If we are not in the context of an RTE_Available call, we are really
-- trying to load an entity that is not there, and that should never
-- happen, so in this case we signal a fatal error.
else else
raise Unrecoverable_Error; raise Unrecoverable_Error;
end if; end if;
...@@ -864,7 +886,7 @@ package body Rtsfind is ...@@ -864,7 +886,7 @@ package body Rtsfind is
-- and it prevents spurious visibility conflicts between use-visible -- and it prevents spurious visibility conflicts between use-visible
-- user entities, and entities in run-time packages. -- user entities, and entities in run-time packages.
-- In configurable run-time mode, subprograms marked Inlined_Always must -- In configurable run-time mode, subprograms marked Inline_Always must
-- be inlined, so in the case we retain the Front_End_Inlining mode. -- be inlined, so in the case we retain the Front_End_Inlining mode.
Save_Front_End_Inlining : Boolean; Save_Front_End_Inlining : Boolean;
...@@ -1137,7 +1159,7 @@ package body Rtsfind is ...@@ -1137,7 +1159,7 @@ package body Rtsfind is
-- is both efficient, and it prevents spurious visibility conflicts -- is both efficient, and it prevents spurious visibility conflicts
-- between use-visible user entities, and entities in run-time packages. -- between use-visible user entities, and entities in run-time packages.
-- In configurable run-time mode, subprograms marked Inlined_Always must -- In configurable run-time mode, subprograms marked Inline_Always must
-- be inlined, so in the case we retain the Front_End_Inlining mode. -- be inlined, so in the case we retain the Front_End_Inlining mode.
Save_Front_End_Inlining : Boolean; Save_Front_End_Inlining : Boolean;
......
...@@ -227,6 +227,7 @@ package Rtsfind is ...@@ -227,6 +227,7 @@ package Rtsfind is
System_Img_Char, System_Img_Char,
System_Img_Dec, System_Img_Dec,
System_Img_Enum, System_Img_Enum,
System_Img_Enum_New,
System_Img_Int, System_Img_Int,
System_Img_LLD, System_Img_LLD,
System_Img_LLI, System_Img_LLI,
...@@ -542,6 +543,7 @@ package Rtsfind is ...@@ -542,6 +543,7 @@ package Rtsfind is
RE_Register_Tag, -- Ada.Tags RE_Register_Tag, -- Ada.Tags
RE_Transportable, -- Ada.Tags RE_Transportable, -- Ada.Tags
RE_Secondary_DT, -- Ada.Tags RE_Secondary_DT, -- Ada.Tags
RE_Secondary_Tag, -- Ada.Tags
RE_Select_Specific_Data, -- Ada.Tags RE_Select_Specific_Data, -- Ada.Tags
RE_Set_Entry_Index, -- Ada.Tags RE_Set_Entry_Index, -- Ada.Tags
RE_Set_Offset_To_Top, -- Ada.Tags RE_Set_Offset_To_Top, -- Ada.Tags
...@@ -723,9 +725,9 @@ package Rtsfind is ...@@ -723,9 +725,9 @@ package Rtsfind is
RE_Image_Decimal, -- System.Img_Dec RE_Image_Decimal, -- System.Img_Dec
RE_Image_Enumeration_8, -- System.Img_Enum RE_Image_Enumeration_8, -- System.Img_Enum_New
RE_Image_Enumeration_16, -- System.Img_Enum RE_Image_Enumeration_16, -- System.Img_Enum_New
RE_Image_Enumeration_32, -- System.Img_Enum RE_Image_Enumeration_32, -- System.Img_Enum_New
RE_Image_Integer, -- System.Img_Int RE_Image_Integer, -- System.Img_Int
...@@ -1464,6 +1466,7 @@ package Rtsfind is ...@@ -1464,6 +1466,7 @@ package Rtsfind is
RE_Protected_Entry_Body_Array, -- Tasking.Protected_Objects.Entries RE_Protected_Entry_Body_Array, -- Tasking.Protected_Objects.Entries
RE_Protection_Entries, -- Tasking.Protected_Objects.Entries RE_Protection_Entries, -- Tasking.Protected_Objects.Entries
RE_Protection_Entries_Access, -- Tasking.Protected_Objects.Entries
RE_Initialize_Protection_Entries, -- Tasking.Protected_Objects.Entries RE_Initialize_Protection_Entries, -- Tasking.Protected_Objects.Entries
RE_Lock_Entries, -- Tasking.Protected_Objects.Entries RE_Lock_Entries, -- Tasking.Protected_Objects.Entries
RO_PE_Get_Ceiling, -- Tasking.Protected_Objects.Entries RO_PE_Get_Ceiling, -- Tasking.Protected_Objects.Entries
...@@ -1644,6 +1647,7 @@ package Rtsfind is ...@@ -1644,6 +1647,7 @@ package Rtsfind is
RE_Register_Tag => Ada_Tags, RE_Register_Tag => Ada_Tags,
RE_Transportable => Ada_Tags, RE_Transportable => Ada_Tags,
RE_Secondary_DT => Ada_Tags, RE_Secondary_DT => Ada_Tags,
RE_Secondary_Tag => Ada_Tags,
RE_Select_Specific_Data => Ada_Tags, RE_Select_Specific_Data => Ada_Tags,
RE_Set_Entry_Index => Ada_Tags, RE_Set_Entry_Index => Ada_Tags,
RE_Set_Offset_To_Top => Ada_Tags, RE_Set_Offset_To_Top => Ada_Tags,
...@@ -1823,9 +1827,9 @@ package Rtsfind is ...@@ -1823,9 +1827,9 @@ package Rtsfind is
RE_Image_Decimal => System_Img_Dec, RE_Image_Decimal => System_Img_Dec,
RE_Image_Enumeration_8 => System_Img_Enum, RE_Image_Enumeration_8 => System_Img_Enum_New,
RE_Image_Enumeration_16 => System_Img_Enum, RE_Image_Enumeration_16 => System_Img_Enum_New,
RE_Image_Enumeration_32 => System_Img_Enum, RE_Image_Enumeration_32 => System_Img_Enum_New,
RE_Image_Integer => System_Img_Int, RE_Image_Integer => System_Img_Int,
...@@ -2567,6 +2571,8 @@ package Rtsfind is ...@@ -2567,6 +2571,8 @@ package Rtsfind is
System_Tasking_Protected_Objects_Entries, System_Tasking_Protected_Objects_Entries,
RE_Protection_Entries => RE_Protection_Entries =>
System_Tasking_Protected_Objects_Entries, System_Tasking_Protected_Objects_Entries,
RE_Protection_Entries_Access =>
System_Tasking_Protected_Objects_Entries,
RE_Initialize_Protection_Entries => RE_Initialize_Protection_Entries =>
System_Tasking_Protected_Objects_Entries, System_Tasking_Protected_Objects_Entries,
RE_Lock_Entries => RE_Lock_Entries =>
......
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