+2015-10-20 Bob Duff <duff@adacore.com>
+
+ * a-cbdlli.ads, a-cbhase.ads, a-cbmutr.ads, a-cborse.ads,
+ * a-cdlili.ads, a-cidlli.ads, a-cihase.ads, a-cimutr.ads,
+ * a-ciorse.ads, a-cobove.ads, a-cohase.ads, a-coinve.ads,
+ * a-comutr.ads, a-convec.ads, a-coorse.ads: Use non-private with clause.
+
+2015-10-20 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_util.adb (Requires_Cleanup_Actions): A loop parameter does not
+ require finalization actions.
+
+2015-10-20 Ed Schonberg <schonberg@adacore.com>
+
+ * par-ch3.adb (P_Declarative_Items): In case of misplaced
+ aspect specifications, ensure that flag Done is properly set to
+ continue parse.
+
+2015-10-20 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * rtsfind.ads Remove the entries for Ada.Synchronous_Task_Control
+ and Suspension_Object from tables RE_Id, RE_Unit_Table and RTU_Id.
+ * sem_util.adb (Is_Descendant_Of_Suspension_Object): Update
+ the comment on usage. Use routine Is_Suspension_Object to detect
+ whether a type matches Suspension_Object.
+ (Is_Suspension_Object): New routine.
+ * snames.ads-tmpl: Add predefined names for Suspension_Object
+ and Synchronous_Task_Control.
+
2015-10-20 Ed Schonberg <schonberg@adacore.com>
* sem_smem.adb (Check_Shared_Var): Clean up code that handles
with Ada.Iterator_Interfaces;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Streams;
private with Ada.Finalization;
with Ada.Iterator_Interfaces;
private with Ada.Containers.Hash_Tables;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Streams;
private with Ada.Finalization; use Ada.Finalization;
with Ada.Iterator_Interfaces;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Streams;
generic
with Ada.Iterator_Interfaces;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Containers.Red_Black_Trees;
private with Ada.Streams;
private with Ada.Finalization;
with Ada.Iterator_Interfaces;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
with Ada.Iterator_Interfaces;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
with Ada.Iterator_Interfaces;
private with Ada.Containers.Hash_Tables;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Streams;
private with Ada.Finalization;
with Ada.Iterator_Interfaces;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
with Ada.Iterator_Interfaces;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
with Ada.Iterator_Interfaces;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Streams;
private with Ada.Finalization;
with Ada.Iterator_Interfaces;
private with Ada.Containers.Hash_Tables;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
with Ada.Iterator_Interfaces;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
with Ada.Iterator_Interfaces;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
with Ada.Iterator_Interfaces;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Finalization;
private with Ada.Streams;
with Ada.Iterator_Interfaces;
-private with Ada.Containers.Helpers;
+with Ada.Containers.Helpers;
private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization;
private with Ada.Streams;
elsif Is_Ignored_Ghost_Entity (Obj_Id) then
null;
+ -- The expansion of iterator loops generates an object declaration
+ -- where the Ekind is explicitly set to loop parameter. This is to
+ -- ensure that the loop parameter behaves as a constant from user
+ -- code point of view. Such object are never controlled and do not
+ -- require cleanup actions. An iterator loop over a container of
+ -- controlled objects does not produce such object declarations.
+
+ elsif Ekind (Obj_Id) = E_Loop_Parameter then
+ return False;
+
-- The object is of the form:
-- Obj : Typ [:= Expr];
--
else
Error_Msg_SC ("aspect specifications not allowed here");
+
+ -- Assume that this is a misplaced aspect specification
+ -- within a declarative list. After discarding the
+ -- misplaced aspects we can continue the scan.
+
+ Done := False;
end if;
declare
Ada_Real_Time,
Ada_Streams,
Ada_Strings,
- Ada_Synchronous_Task_Control,
Ada_Tags,
Ada_Task_Identification,
Ada_Task_Termination,
RE_Unbounded_String, -- Ada.Strings.Unbounded
- RE_Suspension_Object, -- Ada.Synchronous_Task_Control
-
RE_Access_Level, -- Ada.Tags
RE_Alignment, -- Ada.Tags
RE_Address_Array, -- Ada.Tags
RE_Unbounded_String => Ada_Strings_Unbounded,
- RE_Suspension_Object => Ada_Synchronous_Task_Control,
-
RE_Access_Level => Ada_Tags,
RE_Alignment => Ada_Tags,
RE_Address_Array => Ada_Tags,
function Is_Descendant_Of_Suspension_Object
(Typ : Entity_Id) return Boolean;
-- Determine whether type Typ is a descendant of type Suspension_Object
- -- defined in Ada.Synchronous_Task_Control. This routine is similar to
- -- Sem_Util.Is_Descendent_Of, however this version does not load unit
- -- Ada.Synchronous_Task_Control.
+ -- defined in Ada.Synchronous_Task_Control.
----------------------------------------
-- Is_Descendant_Of_Suspension_Object --
function Is_Descendant_Of_Suspension_Object
(Typ : Entity_Id) return Boolean
is
- Cur_Typ : Entity_Id;
- Par_Typ : Entity_Id;
+ function Is_Suspension_Object (Id : Entity_Id) return Boolean;
+ -- Determine whether arbitrary entity Id denotes Suspension_Object
+ -- defined in Ada.Synchronous_Task_Control.
- begin
- -- Do not attempt to load Ada.Synchronous_Task_Control in No_Run_Time
- -- mode. The unit contains tagged types and those are not allowed in
- -- this mode.
+ --------------------------
+ -- Is_Suspension_Object --
+ --------------------------
- if No_Run_Time_Mode then
- return False;
+ function Is_Suspension_Object (Id : Entity_Id) return Boolean is
+ begin
+ -- This approach does an exact name match rather than to rely on
+ -- RTSfind. Routine Is_Effectively_Volatile is used by clients of
+ -- the front end at point where all auxiliary tables are locked
+ -- and any modifications to them are treated as violations. Do not
+ -- tamper with the tables, instead examine the Chars fields of all
+ -- the scopes of Id.
- -- Unit Ada.Synchronous_Task_Control is not available, the type
- -- cannot possibly be a descendant of Suspension_Object.
+ return
+ Chars (Id) = Name_Suspension_Object
+ and then Present (Scope (Id))
+ and then Chars (Scope (Id)) = Name_Synchronous_Task_Control
+ and then Present (Scope (Scope (Id)))
+ and then Chars (Scope (Scope (Id))) = Name_Ada;
+ end Is_Suspension_Object;
- elsif not RTE_Available (RE_Suspension_Object) then
- return False;
- end if;
+ -- Local variables
+ Cur_Typ : Entity_Id;
+ Par_Typ : Entity_Id;
+
+ -- Start of processing for Is_Descendant_Of_Suspension_Object
+
+ begin
-- Climb the type derivation chain checking each parent type against
-- Suspension_Object.
-- The current type is a match
- if Is_RTE (Cur_Typ, RE_Suspension_Object) then
+ if Is_Suspension_Object (Cur_Typ) then
return True;
-- Stop the traversal once the root of the derivation chain has
-- Other miscellaneous names used in front end
Name_Unaligned_Valid : constant Name_Id := N + $;
+ Name_Suspension_Object : constant Name_Id := N + $;
+ Name_Synchronous_Task_Control : constant Name_Id := N + $;
-- Names used to implement iterators over predefined containers
projects / gcc.git / commitdiff