OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Resolve_Allocator): Implement Ada2012-B052. Detect cases
	where an anonymous access discriminant of a limited designated type
	appears in a non-immutably limited discriminated type and issue an
	error message. Add local variable Desig_T and replace all occurrences
	of Designated_Type.

2011-08-29  Jose Ruiz  <ruiz@adacore.com>

	* a-rttiev.adb (Set_Handler): Update comment to indicate that our
	implementation is compliant to RM D.15(15/2) after the modification
	imposed by AI05-0094-1 (binding interpretation).

From-SVN: r178196
This commit is contained in:
Arnaud Charlet 2011-08-29 12:40:08 +02:00
parent cb25faf861
commit 949a18ccb2
3 changed files with 47 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/ChangeLog
View File

@ -1,3 +1,17 @@
2011-08-29 Hristian Kirtchev <kirtchev@adacore.com>
* sem_res.adb (Resolve_Allocator): Implement Ada2012-B052. Detect cases
where an anonymous access discriminant of a limited designated type
appears in a non-immutably limited discriminated type and issue an
error message. Add local variable Desig_T and replace all occurrences
of Designated_Type.
2011-08-29 Jose Ruiz <ruiz@adacore.com>
* a-rttiev.adb (Set_Handler): Update comment to indicate that our
implementation is compliant to RM D.15(15/2) after the modification
imposed by AI05-0094-1 (binding interpretation).
2011-08-29 Robert Dewar <dewar@adacore.com>
* exp_ch9.adb, s-tasren.adb, exp_sel.adb, exp_sel.ads, exp_ch11.adb,

11
gcc/ada/a-rttiev.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2005-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2005-2011, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
@ -281,12 +281,15 @@ package body Ada.Real_Time.Timing_Events is
Remove_From_Queue (Event'Unchecked_Access);
Event.Handler := null;
-- RM D.15(15/2) requires that at this point, we check whether the time
-- RM D.15(15/2) required that at this point, we check whether the time
-- has already passed, and if so, call Handler.all directly from here
-- instead of doing the enqueuing below. However, this causes a nasty
-- instead of doing the enqueuing below. However, this caused a nasty
-- race condition and potential deadlock. If the current task has
-- already locked the protected object of Handler.all, and the time has
-- passed, deadlock would occur. Therefore, we ignore the requirement.
-- passed, deadlock would occur. It has been fixed by AI05-0094-1, which
-- says that the handler should be executed as soon as possible, meaning
-- that the timing event will be executed after the protected action
-- finishes (Handler.all should not be called directly from here).
-- The same comment applies to the other Set_Handler below.
if Handler /= null then

31
gcc/ada/sem_res.adb
View File

@ -4058,6 +4058,7 @@ package body Sem_Res is
-----------------------
procedure Resolve_Allocator (N : Node_Id; Typ : Entity_Id) is
Desig_T : constant Entity_Id := Designated_Type (Typ);
E : constant Node_Id := Expression (N);
Subtyp : Entity_Id;
Discrim : Entity_Id;
@ -4160,7 +4161,7 @@ package body Sem_Res is
if Nkind (E) = N_Qualified_Expression then
if Is_Class_Wide_Type (Etype (E))
and then not Is_Class_Wide_Type (Designated_Type (Typ))
and then not Is_Class_Wide_Type (Desig_T)
and then not In_Dispatching_Context
then
Error_Msg_N
@ -4304,7 +4305,7 @@ package body Sem_Res is
-- Expand_Allocator_Expression).
if Ada_Version >= Ada_2005
and then Is_Class_Wide_Type (Designated_Type (Typ))
and then Is_Class_Wide_Type (Desig_T)
then
declare
Exp_Typ : Entity_Id;
@ -4366,7 +4367,7 @@ package body Sem_Res is
-- type when restriction No_Task_Hierarchy applies.
if not Is_Library_Level_Entity (Base_Type (Typ))
and then Has_Task (Base_Type (Designated_Type (Typ)))
and then Has_Task (Base_Type (Desig_T))
then
Check_Restriction (No_Task_Hierarchy, N);
end if;
@ -4383,6 +4384,26 @@ package body Sem_Res is
and then Nkind (Associated_Node_For_Itype (Typ)) =
N_Discriminant_Specification
then
declare
Discr : constant Entity_Id :=
Defining_Identifier (Associated_Node_For_Itype (Typ));
begin
-- Ada2012-B052: If the designated type of the allocator is
-- limited, then the allocator shall not be used to define the
-- value of an access discriminant, unless the discriminated
-- type is immutably limited.
if Ada_Version >= Ada_2012
and then Is_Limited_Type (Desig_T)
and then not Is_Immutably_Limited_Type (Scope (Discr))
then
Error_Msg_N
("only immutably limited types can have anonymous ", N);
Error_Msg_N
("\discriminants of limited designated type", N);
end if;
end;
-- Avoid marking an allocator as a dynamic coextension if it is
-- within a static construct.
@ -4402,8 +4423,8 @@ package body Sem_Res is
-- its body has not been seen yet, and its activation will fail
-- an elaboration check.
if Is_Task_Type (Designated_Type (Typ))
and then Scope (Base_Type (Designated_Type (Typ))) = Current_Scope
if Is_Task_Type (Desig_T)
and then Scope (Base_Type (Desig_T)) = Current_Scope
and then Is_Compilation_Unit (Current_Scope)
and then Ekind (Current_Scope) = E_Package
and then not In_Package_Body (Current_Scope)