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

[multiple changes] 

2011-12-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch11.adb (Find_Local_Handler): Guard the
	search over individual exception choices in case the list of
	handlers contains other (possibly illegal) constructs.

2011-12-20  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch8.adb (Find_Type): Test taggedness
	of the Available_Type when checking for an illegal use of an
	incomplete type, when the incomplete view is a limited view of
	a type. Remove redundant Is_Tagged test.

2011-12-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb: Add with and use clause for Aspects.
	(Is_Finalizable_Transient): Objects which denote Ada containers
	in the context of iterators are not considered transients. Such
	object must live for as long as the loop is around.
	(Is_Iterated_Container): New routine.

2011-12-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_imgv.adb (Expand_Width_Attribute): Add a
	type conversion from the enumeration subtype to its base subtype.

From-SVN: r182539
This commit is contained in:
Arnaud Charlet 2011-12-20 15:00:46 +01:00
parent b26f70a095
commit 2f7b74678b
5 changed files with 181 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
gcc/ada/ChangeLog
View File

@ -1,3 +1,29 @@
2011-12-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch11.adb (Find_Local_Handler): Guard the
search over individual exception choices in case the list of
handlers contains other (possibly illegal) constructs.
2011-12-20 Gary Dismukes <dismukes@adacore.com>
* sem_ch8.adb (Find_Type): Test taggedness
of the Available_Type when checking for an illegal use of an
incomplete type, when the incomplete view is a limited view of
a type. Remove redundant Is_Tagged test.
2011-12-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb: Add with and use clause for Aspects.
(Is_Finalizable_Transient): Objects which denote Ada containers
in the context of iterators are not considered transients. Such
object must live for as long as the loop is around.
(Is_Iterated_Container): New routine.
2011-12-20 Hristian Kirtchev <kirtchev@adacore.com>
* exp_imgv.adb (Expand_Width_Attribute): Add a
type conversion from the enumeration subtype to its base subtype.
2011-12-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch4.adb (Operator_Check): Update the call to

68
gcc/ada/exp_ch11.adb
View File

@ -1913,49 +1913,57 @@ package body Exp_Ch11 is
H := First (Exception_Handlers (P));
while Present (H) loop
-- Loop through choices in one handler
-- Guard against other constructs appearing in the list of
-- exception handlers.
C := First (Exception_Choices (H));
while Present (C) loop
if Nkind (H) = N_Exception_Handler then
-- Deal with others case
-- Loop through choices in one handler
if Nkind (C) = N_Others_Choice then
C := First (Exception_Choices (H));
while Present (C) loop
-- Matching others handler, but we need to ensure
-- there is no choice parameter. If there is, then we
-- don't have a local handler after all (since we do
-- not allow choice parameters for local handlers).
-- Deal with others case
if No (Choice_Parameter (H)) then
return H;
else
return Empty;
end if;
if Nkind (C) = N_Others_Choice then
-- If not others must be entity name
-- Matching others handler, but we need to ensure
-- there is no choice parameter. If there is, then
-- we don't have a local handler after all (since
-- we do not allow choice parameters for local
-- handlers).
elsif Nkind (C) /= N_Others_Choice then
pragma Assert (Is_Entity_Name (C));
pragma Assert (Present (Entity (C)));
-- Get exception being handled, dealing with renaming
EHandle := Get_Renamed_Entity (Entity (C));
-- If match, then check choice parameter
if ERaise = EHandle then
if No (Choice_Parameter (H)) then
return H;
else
return Empty;
end if;
end if;
end if;
Next (C);
end loop;
-- If not others must be entity name
elsif Nkind (C) /= N_Others_Choice then
pragma Assert (Is_Entity_Name (C));
pragma Assert (Present (Entity (C)));
-- Get exception being handled, dealing with
-- renaming.
EHandle := Get_Renamed_Entity (Entity (C));
-- If match, then check choice parameter
if ERaise = EHandle then
if No (Choice_Parameter (H)) then
return H;
else
return Empty;
end if;
end if;
end if;
Next (C);
end loop;
end if;
Next (H);
end loop;

15
gcc/ada/exp_imgv.adb
View File

@ -1177,7 +1177,7 @@ package body Exp_Imgv is
-- ...
-- else n)))...
-- where n is equal to Rtyp'Pos (Rtyp'Last) + 1
-- where n is equal to Rtyp'Pos (Ptyp'Last) + 1
-- Note: The above processing is in accordance with the intent of
-- the RM, which is that Width should be related to the impl-defined
@ -1206,12 +1206,13 @@ package body Exp_Imgv is
New_Occurrence_Of (Standard_Integer, Loc),
Expression =>
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Rtyp, Loc),
Attribute_Name => Name_Pos,
Expressions => New_List (
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Ptyp, Loc),
Attribute_Name => Name_Last)))));
Prefix => New_Occurrence_Of (Rtyp, Loc),
Attribute_Name => Name_Pos,
Expressions => New_List (
Convert_To (Rtyp,
Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Ptyp, Loc),
Attribute_Name => Name_Last))))));
-- OK, now we need to build the conditional expression. First
-- get the value of M, the largest possible value needed.

100
gcc/ada/exp_util.adb
View File

@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
with Aspects; use Aspects;
with Atree; use Atree;
with Casing; use Casing;
with Checks; use Checks;
@ -3966,6 +3967,13 @@ package body Exp_Util is
function Is_Allocated (Trans_Id : Entity_Id) return Boolean;
-- Determine whether transient object Trans_Id is allocated on the heap
function Is_Iterated_Container
(Trans_Id : Entity_Id;
First_Stmt : Node_Id) return Boolean;
-- Determine whether transient object Trans_Id denotes a container which
-- is in the process of being iterated in the statement list starting
-- from First_Stmt.
---------------------------
-- Initialized_By_Access --
---------------------------
@ -4180,6 +4188,90 @@ package body Exp_Util is
and then Nkind (Expr) = N_Allocator;
end Is_Allocated;
---------------------------
-- Is_Iterated_Container --
---------------------------
function Is_Iterated_Container
(Trans_Id : Entity_Id;
First_Stmt : Node_Id) return Boolean
is
Aspect : Node_Id;
Call : Node_Id;
Iter : Entity_Id;
Param : Node_Id;
Stmt : Node_Id;
Typ : Entity_Id;
begin
-- It is not possible to iterate over containers in non-Ada 2012 code
if Ada_Version < Ada_2012 then
return False;
end if;
Typ := Etype (Trans_Id);
-- Handle access type created for secondary stack use
if Is_Access_Type (Typ) then
Typ := Designated_Type (Typ);
end if;
-- Look for aspect Default_Iterator
if Has_Aspects (Parent (Typ)) then
Aspect := Find_Aspect (Typ, Aspect_Default_Iterator);
if Present (Aspect) then
Iter := Entity (Aspect);
-- Examine the statements following the container object and
-- look for a call to the default iterate routine where the
-- first parameter is the transient. Such a call appears as:
-- It : Access_To_CW_Iterator :=
-- Iterate (Tran_Id.all, ...)'reference;
Stmt := First_Stmt;
while Present (Stmt) loop
-- Detect an object declaration which is initialized by a
-- secondary stack function call.
if Nkind (Stmt) = N_Object_Declaration
and then Present (Expression (Stmt))
and then Nkind (Expression (Stmt)) = N_Reference
and then Nkind (Prefix (Expression (Stmt))) =
N_Function_Call
then
Call := Prefix (Expression (Stmt));
-- The call must invoke the default iterate routine of
-- the container and the transient object must appear as
-- the first actual parameter.
if Entity (Name (Call)) = Iter
and then Present (Parameter_Associations (Call))
then
Param := First (Parameter_Associations (Call));
if Nkind (Param) = N_Explicit_Dereference
and then Entity (Prefix (Param)) = Trans_Id
then
return True;
end if;
end if;
end if;
Next (Stmt);
end loop;
end if;
end if;
return False;
end Is_Iterated_Container;
-- Start of processing for Is_Finalizable_Transient
begin
@ -4220,7 +4312,13 @@ package body Exp_Util is
-- Do not consider conversions of tags to class-wide types
and then not Is_Tag_To_CW_Conversion (Obj_Id);
and then not Is_Tag_To_CW_Conversion (Obj_Id)
-- Do not consider containers in the context of iterator loops. Such
-- transient objects must exist for as long as the loop is around,
-- otherwise any operation carried out by the iterator will fail.
and then not Is_Iterated_Container (Obj_Id, Decl);
end Is_Finalizable_Transient;
---------------------------------

14
gcc/ada/sem_ch8.adb
View File

@ -6119,10 +6119,16 @@ package body Sem_Ch8 is
-- is completed in the current scope, and not for a limited
-- view of a type.
if not Is_Tagged_Type (T)
and then Ada_Version >= Ada_2005
then
if From_With_Type (T) then
if Ada_Version >= Ada_2005 then
-- Test whether the Available_View of a limited type view
-- is tagged, since the limited view may not be marked as
-- tagged if the type itself has an untagged incomplete
-- type view in its package.
if From_With_Type (T)
and then not Is_Tagged_Type (Available_View (T))
then
Error_Msg_N
("prefix of Class attribute must be tagged", N);
Set_Etype (N, Any_Type);