From 1f8f3e6e07accbcb641a73bc7545677d172503bd Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 20 Oct 2015 12:56:25 +0200 Subject: [multiple changes] 2015-10-20 Bob Duff * 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 * exp_util.adb (Requires_Cleanup_Actions): A loop parameter does not require finalization actions. 2015-10-20 Ed Schonberg * 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 * 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. From-SVN: r229049 --- gcc/ada/ChangeLog | 29 +++++++++++++++++++++++++++++ gcc/ada/a-cbdlli.ads | 2 +- gcc/ada/a-cbhase.ads | 2 +- gcc/ada/a-cbmutr.ads | 2 +- gcc/ada/a-cborse.ads | 2 +- gcc/ada/a-cdlili.ads | 2 +- gcc/ada/a-cidlli.ads | 2 +- gcc/ada/a-cihase.ads | 2 +- gcc/ada/a-cimutr.ads | 2 +- gcc/ada/a-ciorse.ads | 2 +- gcc/ada/a-cobove.ads | 2 +- gcc/ada/a-cohase.ads | 2 +- gcc/ada/a-coinve.ads | 2 +- gcc/ada/a-comutr.ads | 2 +- gcc/ada/a-convec.ads | 2 +- gcc/ada/a-coorse.ads | 2 +- gcc/ada/exp_util.adb | 10 ++++++++++ gcc/ada/par-ch3.adb | 6 ++++++ gcc/ada/rtsfind.ads | 5 ----- gcc/ada/sem_util.adb | 47 ++++++++++++++++++++++++++++++----------------- gcc/ada/snames.ads-tmpl | 2 ++ 21 files changed, 92 insertions(+), 37 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5e189a1..63ad655 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2015-10-20 Bob Duff + + * 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 + + * exp_util.adb (Requires_Cleanup_Actions): A loop parameter does not + require finalization actions. + +2015-10-20 Ed Schonberg + + * 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 + + * 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 * sem_smem.adb (Check_Shared_Var): Clean up code that handles diff --git a/gcc/ada/a-cbdlli.ads b/gcc/ada/a-cbdlli.ads index ba063c1..f09c3ed 100644 --- a/gcc/ada/a-cbdlli.ads +++ b/gcc/ada/a-cbdlli.ads @@ -33,7 +33,7 @@ with Ada.Iterator_Interfaces; -private with Ada.Containers.Helpers; +with Ada.Containers.Helpers; private with Ada.Streams; private with Ada.Finalization; diff --git a/gcc/ada/a-cbhase.ads b/gcc/ada/a-cbhase.ads index 7f55d8d..87e35ca 100644 --- a/gcc/ada/a-cbhase.ads +++ b/gcc/ada/a-cbhase.ads @@ -34,7 +34,7 @@ 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; diff --git a/gcc/ada/a-cbmutr.ads b/gcc/ada/a-cbmutr.ads index 93b5e27..fd8c206 100644 --- a/gcc/ada/a-cbmutr.ads +++ b/gcc/ada/a-cbmutr.ads @@ -33,7 +33,7 @@ with Ada.Iterator_Interfaces; -private with Ada.Containers.Helpers; +with Ada.Containers.Helpers; private with Ada.Streams; generic diff --git a/gcc/ada/a-cborse.ads b/gcc/ada/a-cborse.ads index a12a798..7d76f78 100644 --- a/gcc/ada/a-cborse.ads +++ b/gcc/ada/a-cborse.ads @@ -33,7 +33,7 @@ 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; diff --git a/gcc/ada/a-cdlili.ads b/gcc/ada/a-cdlili.ads index 45abeb1..abc6de7 100644 --- a/gcc/ada/a-cdlili.ads +++ b/gcc/ada/a-cdlili.ads @@ -33,7 +33,7 @@ with Ada.Iterator_Interfaces; -private with Ada.Containers.Helpers; +with Ada.Containers.Helpers; private with Ada.Finalization; private with Ada.Streams; diff --git a/gcc/ada/a-cidlli.ads b/gcc/ada/a-cidlli.ads index 46354af..5b18110 100644 --- a/gcc/ada/a-cidlli.ads +++ b/gcc/ada/a-cidlli.ads @@ -33,7 +33,7 @@ with Ada.Iterator_Interfaces; -private with Ada.Containers.Helpers; +with Ada.Containers.Helpers; private with Ada.Finalization; private with Ada.Streams; diff --git a/gcc/ada/a-cihase.ads b/gcc/ada/a-cihase.ads index db4d8bd..d908d7f 100644 --- a/gcc/ada/a-cihase.ads +++ b/gcc/ada/a-cihase.ads @@ -34,7 +34,7 @@ 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; diff --git a/gcc/ada/a-cimutr.ads b/gcc/ada/a-cimutr.ads index dd63651..ad7e34c 100644 --- a/gcc/ada/a-cimutr.ads +++ b/gcc/ada/a-cimutr.ads @@ -33,7 +33,7 @@ with Ada.Iterator_Interfaces; -private with Ada.Containers.Helpers; +with Ada.Containers.Helpers; private with Ada.Finalization; private with Ada.Streams; diff --git a/gcc/ada/a-ciorse.ads b/gcc/ada/a-ciorse.ads index e0e95ed..15589b8 100644 --- a/gcc/ada/a-ciorse.ads +++ b/gcc/ada/a-ciorse.ads @@ -33,7 +33,7 @@ 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; diff --git a/gcc/ada/a-cobove.ads b/gcc/ada/a-cobove.ads index 1fb346c..869f2bb 100644 --- a/gcc/ada/a-cobove.ads +++ b/gcc/ada/a-cobove.ads @@ -33,7 +33,7 @@ with Ada.Iterator_Interfaces; -private with Ada.Containers.Helpers; +with Ada.Containers.Helpers; private with Ada.Streams; private with Ada.Finalization; diff --git a/gcc/ada/a-cohase.ads b/gcc/ada/a-cohase.ads index 91f1345..97cd5f1 100644 --- a/gcc/ada/a-cohase.ads +++ b/gcc/ada/a-cohase.ads @@ -34,7 +34,7 @@ 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; diff --git a/gcc/ada/a-coinve.ads b/gcc/ada/a-coinve.ads index 5cb97d5..1a0ce99 100644 --- a/gcc/ada/a-coinve.ads +++ b/gcc/ada/a-coinve.ads @@ -33,7 +33,7 @@ with Ada.Iterator_Interfaces; -private with Ada.Containers.Helpers; +with Ada.Containers.Helpers; private with Ada.Finalization; private with Ada.Streams; diff --git a/gcc/ada/a-comutr.ads b/gcc/ada/a-comutr.ads index 918edfd..25fadf1 100644 --- a/gcc/ada/a-comutr.ads +++ b/gcc/ada/a-comutr.ads @@ -33,7 +33,7 @@ with Ada.Iterator_Interfaces; -private with Ada.Containers.Helpers; +with Ada.Containers.Helpers; private with Ada.Finalization; private with Ada.Streams; diff --git a/gcc/ada/a-convec.ads b/gcc/ada/a-convec.ads index bf52329..413403d 100644 --- a/gcc/ada/a-convec.ads +++ b/gcc/ada/a-convec.ads @@ -33,7 +33,7 @@ with Ada.Iterator_Interfaces; -private with Ada.Containers.Helpers; +with Ada.Containers.Helpers; private with Ada.Finalization; private with Ada.Streams; diff --git a/gcc/ada/a-coorse.ads b/gcc/ada/a-coorse.ads index d2e882a..d127a52 100644 --- a/gcc/ada/a-coorse.ads +++ b/gcc/ada/a-coorse.ads @@ -33,7 +33,7 @@ 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; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 2ff6d5c..fa8d17f 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -8022,6 +8022,16 @@ package body Exp_Util is 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]; -- diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 0be1217..86b2a6d 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -4425,6 +4425,12 @@ package body Ch3 is 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 diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 22f9390..d320639 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -131,7 +131,6 @@ package Rtsfind is Ada_Real_Time, Ada_Streams, Ada_Strings, - Ada_Synchronous_Task_Control, Ada_Tags, Ada_Task_Identification, Ada_Task_Termination, @@ -607,8 +606,6 @@ package Rtsfind is 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 @@ -1840,8 +1837,6 @@ package Rtsfind is 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, diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 27b8f9e..6875f3a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -11397,9 +11397,7 @@ package body Sem_Util is 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 -- @@ -11408,24 +11406,39 @@ package body Sem_Util is 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. @@ -11435,7 +11448,7 @@ package body Sem_Util is -- 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 diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index d5b06a8..7f25287 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -1398,6 +1398,8 @@ package Snames is -- 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 -- cgit v1.1