From 150bbaff610db5c17dd906a39a2f0453d78ab6b8 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 13 Dec 2007 11:29:02 +0100 Subject: [PATCH] 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 --- gcc/ada/rtsfind.adb | 106 ++++++++++++++++++++++++++------------------ gcc/ada/rtsfind.ads | 18 +++++--- 2 files changed, 76 insertions(+), 48 deletions(-) diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index fb5d1c3bd21..b26693106ad 100644 --- a/gcc/ada/rtsfind.adb +++ b/gcc/ada/rtsfind.adb @@ -110,47 +110,46 @@ package body Rtsfind is -- Generation of WITH's -- -------------------------- - -- When a unit is implicitly loaded as a result of a call to RTE, it - -- is necessary to create an implicit WITH to ensure that the object - -- is correctly loaded by the binder. Such WITH statements are only - -- required when the request is from the extended main unit (if a - -- client needs a WITH, that will be taken care of when the client - -- is compiled). + -- When a unit is implicitly loaded as a result of a call to RTE, it is + -- necessary to create an implicit WITH to ensure that the object is + -- correctly loaded by the binder. Such WITH statements are only required + -- when the request is from the extended main unit (if a client needs a + -- WITH, that will be taken care of when the client is compiled). -- We always attach the WITH to the main unit. This is not perfectly - -- accurate in terms of elaboration requirements, but it is close - -- enough, since the units that are accessed using rtsfind do not - -- have delicate elaboration requirements. + -- accurate in terms of elaboration requirements, but it is close enough, + -- since the units that are accessed using rtsfind do not have delicate + -- elaboration requirements. - -- The flag Withed in the unit table record is initially set to False. - -- It is set True if a WITH has been generated for the main unit for - -- the corresponding unit. + -- The flag Withed in the unit table record is initially set to False. It + -- is set True if a WITH has been generated for the main unit for the + -- corresponding unit. ----------------------- -- Local Subprograms -- ----------------------- function Check_CRT (E : RE_Id; Eid : Entity_Id) return Entity_Id; - -- Check entity Eid to ensure that configurable run-time restrictions - -- are met. May generate an error message and raise RE_Not_Available - -- if the entity E does not exist (i.e. Eid is Empty) + -- Check entity Eid to ensure that configurable run-time restrictions are + -- met. May generate an error message (if RTE_Available_Call is false) and + -- 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); - -- Outputs error messages for an entity that is not defined in the - -- run-time library (the form of the error message is tailored for - -- no run time/configurable run time mode as required). + -- Outputs error messages for an entity that is not defined in the run-time + -- library (the form of the error message is tailored for no run time or + -- configurable run time mode as required). function Get_Unit_Name (U_Id : RTU_Id) return Unit_Name_Type; - -- Retrieves the Unit Name given a unit id represented by its - -- enumeration value in RTU_Id. + -- Retrieves the Unit Name given a unit id represented by its enumeration + -- value in RTU_Id. procedure Load_Fail (S : String; U_Id : RTU_Id; Id : RE_Id); - -- Internal procedure called if we can't sucessfully locate or - -- process a run-time unit. The parameters give information about - -- the error message to be given. S is a reason for failing to - -- compile the file and U_Id is the unit id. RE_Id is the RE_Id - -- originally passed to RTE. The message in S is one of the - -- following: + -- Internal procedure called if we can't sucessfully locate or process a + -- run-time unit. The parameters give information about the error message + -- to be given. S is a reason for failing to compile the file and U_Id is + -- the unit id. RE_Id is the RE_Id originally passed to RTE. The message in + -- S is one of the following: -- -- "not found" -- "had parser errors" @@ -166,16 +165,16 @@ package body Rtsfind is Use_Setting : Boolean := False); -- 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 - -- RT_Unit_Table is updated to reflect the load. Use_Setting is used - -- to indicate the initial setting for the Is_Potentially_Use_Visible - -- flag of the entity for the loaded unit (if it is indeed loaded). - -- A value of False means nothing special need be done. A value of - -- True indicates that this flag must be set to True. It is needed - -- only in the Text_IO_Kludge procedure, which may materialize an - -- entity of Text_IO (or [Wide_]Wide_Text_IO) that was previously unknown. - -- Id is the RE_Id value of the entity which was originally requested. - -- Id is used only for error message detail, and if it is RE_Null, then - -- the attempt to output the entity name is ignored. + -- RT_Unit_Table is updated to reflect the load. Use_Setting is used to + -- indicate the initial setting for the Is_Potentially_Use_Visible flag of + -- the entity for the loaded unit (if it is indeed loaded). A value of + -- False means nothing special need be done. A value of True indicates that + -- this flag must be set to True. It is needed only in the Text_IO_Kludge + -- procedure, which may materialize an entity of Text_IO (or + -- [Wide_]Wide_Text_IO) that was previously unknown. Id is the RE_Id value + -- of the entity which was originally requested. Id is used only for error + -- message detail, and if it is RE_Null, then the attempt to output the + -- entity name is ignored. 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 @@ -206,7 +205,12 @@ package body Rtsfind is begin 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; -- Entity is available @@ -541,12 +545,30 @@ package body Rtsfind is Output_Entity_Name (Id, "not available"); end if; - -- In configurable run time mode, we raise RE_Not_Available, and we hope - -- the caller deals gracefully with this. If we are in normal full run - -- time mode, a load failure is considered fatal and unrecoverable. + -- In configurable run time mode, we raise RE_Not_Available, and the + -- caller is expected to deal gracefully with this. In the case of a + -- 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 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 raise Unrecoverable_Error; end if; @@ -864,7 +886,7 @@ package body Rtsfind is -- and it prevents spurious visibility conflicts 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. Save_Front_End_Inlining : Boolean; @@ -1137,7 +1159,7 @@ package body Rtsfind is -- is both efficient, and it prevents spurious visibility conflicts -- 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. Save_Front_End_Inlining : Boolean; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index eed72a07e51..2388ed09870 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -227,6 +227,7 @@ package Rtsfind is System_Img_Char, System_Img_Dec, System_Img_Enum, + System_Img_Enum_New, System_Img_Int, System_Img_LLD, System_Img_LLI, @@ -542,6 +543,7 @@ package Rtsfind is RE_Register_Tag, -- Ada.Tags RE_Transportable, -- Ada.Tags RE_Secondary_DT, -- Ada.Tags + RE_Secondary_Tag, -- Ada.Tags RE_Select_Specific_Data, -- Ada.Tags RE_Set_Entry_Index, -- Ada.Tags RE_Set_Offset_To_Top, -- Ada.Tags @@ -723,9 +725,9 @@ package Rtsfind is RE_Image_Decimal, -- System.Img_Dec - RE_Image_Enumeration_8, -- System.Img_Enum - RE_Image_Enumeration_16, -- System.Img_Enum - RE_Image_Enumeration_32, -- System.Img_Enum + RE_Image_Enumeration_8, -- System.Img_Enum_New + RE_Image_Enumeration_16, -- System.Img_Enum_New + RE_Image_Enumeration_32, -- System.Img_Enum_New RE_Image_Integer, -- System.Img_Int @@ -1464,6 +1466,7 @@ package Rtsfind is RE_Protected_Entry_Body_Array, -- 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_Lock_Entries, -- Tasking.Protected_Objects.Entries RO_PE_Get_Ceiling, -- Tasking.Protected_Objects.Entries @@ -1644,6 +1647,7 @@ package Rtsfind is RE_Register_Tag => Ada_Tags, RE_Transportable => Ada_Tags, RE_Secondary_DT => Ada_Tags, + RE_Secondary_Tag => Ada_Tags, RE_Select_Specific_Data => Ada_Tags, RE_Set_Entry_Index => Ada_Tags, RE_Set_Offset_To_Top => Ada_Tags, @@ -1823,9 +1827,9 @@ package Rtsfind is RE_Image_Decimal => System_Img_Dec, - RE_Image_Enumeration_8 => System_Img_Enum, - RE_Image_Enumeration_16 => System_Img_Enum, - RE_Image_Enumeration_32 => System_Img_Enum, + RE_Image_Enumeration_8 => System_Img_Enum_New, + RE_Image_Enumeration_16 => System_Img_Enum_New, + RE_Image_Enumeration_32 => System_Img_Enum_New, RE_Image_Integer => System_Img_Int, @@ -2567,6 +2571,8 @@ package Rtsfind is System_Tasking_Protected_Objects_Entries, RE_Protection_Entries => System_Tasking_Protected_Objects_Entries, + RE_Protection_Entries_Access => + System_Tasking_Protected_Objects_Entries, RE_Initialize_Protection_Entries => System_Tasking_Protected_Objects_Entries, RE_Lock_Entries => -- 2.30.2