Skip to content

R
riscv-gcc-1
Commit 1f8f3e6e by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r229049
parent cbc61965
Showing with 92 additions and 37 deletions
gcc/ada/ChangeLog
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
......
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;
......
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;
......
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
......
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;
......
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;
......
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;
......
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;
......
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;
......
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;
......
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;
......
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;
......
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;
......
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;
......
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;
......
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;
......
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];
--
......
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
......
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,
......
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
......
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment