2010-10-07 Robert Dewar <dewar@adacore.com>
+ * 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 <dewar@adacore.com>
+
+ * 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 <schonberg@adacore.com>
+
+ * sem_ch10.adb: Small change in error message.
+
+2010-10-07 Robert Dewar <dewar@adacore.com>
+
* tbuild.ads: Minor reformatting.
2010-10-07 Robert Dewar <dewar@adacore.com>
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);
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)));
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);
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;
-- Name
Make_String_Literal (Loc,
- Full_Qualified_Name (Desig)),
+ Fully_Qualified_Name_String (Desig)),
-- Handler
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),
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),
------------------------------------------------------------------------------
with Atree; use Atree;
+with Casing; use Casing;
with Checks; use Checks;
with Debug; use Debug;
with Einfo; use Einfo;
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 --
------------------------
-- 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.
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
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,
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;
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
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 --
-----------------------
-- 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;
projects / platform / upstream / linaro-gcc.git / commitdiff