Tested on x86_64-pc-linux-gnu, committed on trunk 2016-10-12 Tristan Gingold <ging...@adacore.com>
* exp_ch9.adb (Expand_N_Delay_Relative_Statement): Add support for a secondary procedure in case of missing Ada.Calendar.Delays * rtsfind.ads (RTU_Id): Add System_Relative_Delays. (RE_Id): Add RO_RD_Delay_For. * rtsfind.adb (Output_Entity_Name): Handle correctly units RO_XX. * s-rident.ads: Remove No_Relative_Delays restriction for GNAT_Extended_Ravenscar.
Index: exp_ch9.adb =================================================================== --- exp_ch9.adb (revision 241029) +++ exp_ch9.adb (working copy) @@ -8388,11 +8388,23 @@ -- simple delays imposed by the use of Protected Objects. procedure Expand_N_Delay_Relative_Statement (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); + Loc : constant Source_Ptr := Sloc (N); + Proc : Entity_Id; begin + if RTE_Available (RO_RD_Delay_For) then + -- Try to use System.Relative_Delays.Delay_For only if available. + -- This is the implementation used on restricted platforms when + -- Ada.Calendar is not available. + Proc := RTE (RO_RD_Delay_For); + else + -- Otherwise, use Ada.Calendar.Delays.Delay_For and emit an error + -- message if not available. + Proc := RTE (RO_CA_Delay_For); + end if; + Rewrite (N, Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (RO_CA_Delay_For), Loc), + Name => New_Occurrence_Of (Proc, Loc), Parameter_Associations => New_List (Expression (N)))); Analyze (N); end Expand_N_Delay_Relative_Statement; Index: rtsfind.adb =================================================================== --- rtsfind.adb (revision 241024) +++ rtsfind.adb (working copy) @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -1144,6 +1144,9 @@ -- M (1 .. P) is current message to be output RE_Image : constant String := RE_Id'Image (Id); + S : Natural; + -- RE_Image (S .. RE_Image'Last) is the name of the entity without the + -- "RE_" or "RO_XX_" prefix. begin if Id = RE_Null then @@ -1168,8 +1171,15 @@ -- Add entity name and closing quote to message - Name_Len := RE_Image'Length - 3; - Name_Buffer (1 .. Name_Len) := RE_Image (4 .. RE_Image'Length); + if RE_Image (2) = 'E' then + -- Strip "RE" + S := 4; + else + -- Strip "RO_XX" + S := 7; + end if; + Name_Len := RE_Image'Length - S + 1; + Name_Buffer (1 .. Name_Len) := RE_Image (S .. RE_Image'Last); Set_Casing (Mixed_Case); M (P + 1 .. P + Name_Len) := Name_Buffer (1 .. Name_Len); P := P + Name_Len; Index: rtsfind.ads =================================================================== --- rtsfind.ads (revision 241024) +++ rtsfind.ads (working copy) @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -349,6 +349,7 @@ System_Pool_Empty, System_Pool_Local, System_Pool_Size, + System_Relative_Delays, System_RPC, System_Scalar_Values, System_Secondary_Stack, @@ -1403,6 +1404,8 @@ RE_Tk_Objref, -- System.Partition_Interface RE_Tk_Union, -- System.Partition_Interface + RO_RD_Delay_For, -- System.Relative_Delays + RE_IS_Is1, -- System.Scalar_Values RE_IS_Is2, -- System.Scalar_Values RE_IS_Is4, -- System.Scalar_Values @@ -2635,6 +2638,8 @@ RE_Stack_Bounded_Pool => System_Pool_Size, + RO_RD_Delay_For => System_Relative_Delays, + RE_Do_Apc => System_RPC, RE_Do_Rpc => System_RPC, RE_Params_Stream_Type => System_RPC, Index: s-rident.ads =================================================================== --- s-rident.ads (revision 241026) +++ s-rident.ads (working copy) @@ -574,7 +574,6 @@ No_Implicit_Protected_Object_Allocations => True, No_Local_Timing_Events => True, - No_Relative_Delay => True, No_Select_Statements => True, No_Specific_Termination_Handlers => True, No_Task_Termination => True,