From: charlet Date: Thu, 7 Oct 2010 10:59:32 +0000 (+0000) Subject: 2010-10-07 Robert Dewar X-Git-Tag: upstream/4.9.2~26052 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=c6a30f2489b134cf27f871e24d29bf6c1199e079;p=platform%2Fupstream%2Flinaro-gcc.git 2010-10-07 Robert Dewar * exp_disp.adb, exp_dist.adb, exp_util.ads, exp_util.adb, exp_ch11.adb: Rename Full_Qualified_Name to Fully_Qualified_Name_String * sem_util.adb, sem_util.ads (Full_Qualified_Name): Moved to Exp_Util.Fully_Qualified_Name_String. 2010-10-07 Robert Dewar * rtsfind.ads: Add entry for Ada.Real_Time.Timing_Events.Set_Handler * sem_res.adb (Resolve_Call): A call to Ada.Real_Time.Timing_Events.Set_Handler violates restriction No_Relative_Delay (AI-0211). 2010-10-07 Ed Schonberg * sem_ch10.adb: Small change in error message. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165092 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3b64198..a46fb54 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,23 @@ 2010-10-07 Robert Dewar + * exp_disp.adb, exp_dist.adb, exp_util.ads, exp_util.adb, + exp_ch11.adb: Rename Full_Qualified_Name to Fully_Qualified_Name_String + * sem_util.adb, sem_util.ads (Full_Qualified_Name): Moved to + Exp_Util.Fully_Qualified_Name_String. + +2010-10-07 Robert Dewar + + * rtsfind.ads: Add entry for Ada.Real_Time.Timing_Events.Set_Handler + * sem_res.adb (Resolve_Call): A call to + Ada.Real_Time.Timing_Events.Set_Handler violates restriction + No_Relative_Delay (AI-0211). + +2010-10-07 Ed Schonberg + + * sem_ch10.adb: Small change in error message. + +2010-10-07 Robert Dewar + * tbuild.ads: Minor reformatting. 2010-10-07 Robert Dewar diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index a5d92a1..80d1d8d 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1265,7 +1265,7 @@ package body Exp_Ch11 is Object_Definition => New_Occurrence_Of (Standard_String, Loc), Expression => Make_String_Literal (Loc, - Strval => Full_Qualified_Name (Id)))); + Strval => Fully_Qualified_Name_String (Id)))); Set_Is_Statically_Allocated (Exname); diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 7e0cba5..c38bbe8 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -4483,8 +4483,7 @@ package body Exp_Disp is end loop; end if; - -- Get the _tag entity and the number of primitives of its dispatch - -- table. + -- Get the _tag entity and number of primitives of its dispatch table DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ))); Nb_Prim := UI_To_Int (DT_Entry_Count (First_Tag_Component (Typ))); @@ -4654,7 +4653,7 @@ package body Exp_Disp is Object_Definition => New_Reference_To (Standard_String, Loc), Expression => Make_String_Literal (Loc, - Full_Qualified_Name (First_Subtype (Typ))))); + Fully_Qualified_Name_String (First_Subtype (Typ))))); Set_Is_Statically_Allocated (Exname); Set_Is_True_Constant (Exname); @@ -4768,7 +4767,7 @@ package body Exp_Disp is New_External_Name (Tname, 'A')); Full_Name : constant String_Id := - Full_Qualified_Name (First_Subtype (Typ)); + Fully_Qualified_Name_String (First_Subtype (Typ)); Str1_Id : String_Id; Str2_Id : String_Id; diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 36b8c2d..06f32d9 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -5541,7 +5541,7 @@ package body Exp_Dist is -- Name Make_String_Literal (Loc, - Full_Qualified_Name (Desig)), + Fully_Qualified_Name_String (Desig)), -- Handler @@ -5887,7 +5887,7 @@ package body Exp_Dist is Unchecked_Convert_To (RTE (RE_Address), New_Occurrence_Of (RACW_Parameter, Loc)), Make_String_Literal (Loc, - Strval => Full_Qualified_Name + Strval => Fully_Qualified_Name_String (Etype (Designated_Type (RACW_Type)))), Build_Stub_Tag (Loc, RACW_Type), New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc), @@ -6083,7 +6083,7 @@ package body Exp_Dist is Parameter_Associations => New_List ( Unchecked_Convert_To (RTE (RE_Address), Object), Make_String_Literal (Loc, - Strval => Full_Qualified_Name + Strval => Fully_Qualified_Name_String (Etype (Designated_Type (RACW_Type)))), Build_Stub_Tag (Loc, RACW_Type), New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc), diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index b1f96e9..ae8a8e6 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ with Atree; use Atree; +with Casing; use Casing; with Checks; use Checks; with Debug; use Debug; with Einfo; use Einfo; @@ -1753,6 +1754,62 @@ package body Exp_Util is Remove_Side_Effects (Exp, Name_Req, Variable_Ref => True); end Force_Evaluation; + --------------------------------- + -- Fully_Qualified_Name_String -- + --------------------------------- + + function Fully_Qualified_Name_String (E : Entity_Id) return String_Id is + procedure Internal_Full_Qualified_Name (E : Entity_Id); + -- Compute recursively the qualified name without NUL at the end, adding + -- it to the currently started string being generated + + ---------------------------------- + -- Internal_Full_Qualified_Name -- + ---------------------------------- + + procedure Internal_Full_Qualified_Name (E : Entity_Id) is + Ent : Entity_Id; + + begin + -- Deal properly with child units + + if Nkind (E) = N_Defining_Program_Unit_Name then + Ent := Defining_Identifier (E); + else + Ent := E; + end if; + + -- Compute qualification recursively (only "Standard" has no scope) + + if Present (Scope (Scope (Ent))) then + Internal_Full_Qualified_Name (Scope (Ent)); + Store_String_Char (Get_Char_Code ('.')); + end if; + + -- Every entity should have a name except some expanded blocks + -- don't bother about those. + + if Chars (Ent) = No_Name then + return; + end if; + + -- Generates the entity name in upper case + + Get_Decoded_Name_String (Chars (Ent)); + Set_All_Upper_Case; + Store_String_Chars (Name_Buffer (1 .. Name_Len)); + return; + end Internal_Full_Qualified_Name; + + -- Start of processing for Full_Qualified_Name + + begin + Start_String; + Internal_Full_Qualified_Name (E); + Store_String_Char (Get_Char_Code (ASCII.NUL)); + return End_String; + end Fully_Qualified_Name_String; + ------------------------ -- Generate_Poll_Call -- ------------------------ diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 4a11f93..520e0da 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -403,6 +403,10 @@ package Exp_Util is -- Force_Evaluation further guarantees that all evaluations will yield -- the same result. + function Fully_Qualified_Name_String (E : Entity_Id) return String_Id; + -- Generates the string literal corresponding to the fully qualified name + -- of entity E with an ASCII.NUL appended at the end of the name. + procedure Generate_Poll_Call (N : Node_Id); -- If polling is active, then a call to the Poll routine is built, -- and then inserted before the given node N and analyzed. diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 94d76be..177f1fe 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -536,7 +536,8 @@ package Rtsfind is RO_RT_Delay_Until, -- Ada.Real_Time.Delays RO_RT_To_Duration, -- Ada.Real_Time.Delays - RE_Timing_Event, -- Ada_Real_Time_Timing_Events + RE_Set_Handler, -- Ada_Real_Time.Timing_Events + RE_Timing_Event, -- Ada_Real_Time.Timing_Events RE_Root_Stream_Type, -- Ada.Streams RE_Stream_Element, -- Ada.Streams @@ -1707,6 +1708,7 @@ package Rtsfind is RO_RT_Delay_Until => Ada_Real_Time_Delays, RO_RT_To_Duration => Ada_Real_Time_Delays, + RE_Set_Handler => Ada_Real_Time_Timing_Events, RE_Timing_Event => Ada_Real_Time_Timing_Events, RE_Root_Stream_Type => Ada_Streams, diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 272cabf..50bbcc5 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -1419,8 +1419,8 @@ package body Sem_Ch10 is P := Parent_Spec (Unit (N)); loop if Unit (P) = Lib_U then - Error_Msg_N ("limited with_clause of immediate " - & "ancestor not allowed", Item); + Error_Msg_N ("limited with_clause cannot " + & "name ancestor", Item); exit; end if; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 8457677..9dafd64 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5554,6 +5554,13 @@ package body Sem_Res is Check_Potentially_Blocking_Operation (N); end if; + -- A call to Ada.Real_Time.Timing_Events.Set_Handler violates + -- restriction No_Relative_Delay (AI-0211). + + if Is_RTE (Nam, RE_Set_Handler) then + Check_Restriction (No_Relative_Delay, N); + end if; + -- Issue an error for a call to an eliminated subprogram. We skip this -- in a spec expression, e.g. a call in a default parameter value, since -- we are not really doing a call at this time. That's important because diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 83fee32..917104c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3468,71 +3468,6 @@ package body Sem_Util is end if; end First_Actual; - ------------------------- - -- Full_Qualified_Name -- - ------------------------- - - function Full_Qualified_Name (E : Entity_Id) return String_Id is - Res : String_Id; - pragma Warnings (Off, Res); - - function Internal_Full_Qualified_Name (E : Entity_Id) return String_Id; - -- Compute recursively the qualified name without NUL at the end - - ---------------------------------- - -- Internal_Full_Qualified_Name -- - ---------------------------------- - - function Internal_Full_Qualified_Name (E : Entity_Id) return String_Id is - Ent : Entity_Id := E; - Parent_Name : String_Id := No_String; - - begin - -- Deals properly with child units - - if Nkind (Ent) = N_Defining_Program_Unit_Name then - Ent := Defining_Identifier (Ent); - end if; - - -- Compute qualification recursively (only "Standard" has no scope) - - if Present (Scope (Scope (Ent))) then - Parent_Name := Internal_Full_Qualified_Name (Scope (Ent)); - end if; - - -- Every entity should have a name except some expanded blocks - -- don't bother about those. - - if Chars (Ent) = No_Name then - return Parent_Name; - end if; - - -- Add a period between Name and qualification - - if Parent_Name /= No_String then - Start_String (Parent_Name); - Store_String_Char (Get_Char_Code ('.')); - - else - Start_String; - end if; - - -- Generates the entity name in upper case - - Get_Decoded_Name_String (Chars (Ent)); - Set_All_Upper_Case; - Store_String_Chars (Name_Buffer (1 .. Name_Len)); - return End_String; - end Internal_Full_Qualified_Name; - - -- Start of processing for Full_Qualified_Name - - begin - Res := Internal_Full_Qualified_Name (E); - Store_String_Char (Get_Char_Code (ASCII.NUL)); - return End_String; - end Full_Qualified_Name; - ----------------------- -- Gather_Components -- ----------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 80eaf9c..439748b 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -379,11 +379,6 @@ package Sem_Util is -- is always the expression (not the N_Parameter_Association nodes, -- even if named association is used). - function Full_Qualified_Name (E : Entity_Id) return String_Id; - -- Generates the string literal corresponding to the E's full qualified - -- name in upper case. An ASCII.NUL is appended as the last character. - -- The names in the string are generated by Namet.Get_Decoded_Name_String. - procedure Gather_Components (Typ : Entity_Id; Comp_List : Node_Id;