einfo.adb (Component_Type): Add missing assertion.

2009-07-23  Javier Miranda  <miranda@adacore.com>

	* einfo.adb (Component_Type): Add missing assertion.
	* sem_res.adb (Resolve_Call): Ensure proper kind of entity before
	reading attribute Component_Size.
	* exp_ch4.adb (Is_Safe_In_Place_Array_Op): Ensure proper kind of entity
	before reading attributes Component_Size and Component_Type.
	* exp_ch3.adb (Build_Initialization_Call): Ensure proper kind of entity
	before reading attribute Component_Type.

From-SVN: r149981
This commit is contained in:
Javier Miranda 2009-07-23 09:21:31 +00:00 committed by Arnaud Charlet
parent 57aed6d6f8
commit 7205254be8
5 changed files with 26 additions and 4 deletions

View File

@ -1,3 +1,13 @@
2009-07-23 Javier Miranda <miranda@adacore.com>
* einfo.adb (Component_Type): Add missing assertion.
* sem_res.adb (Resolve_Call): Ensure proper kind of entity before
reading attribute Component_Size.
* exp_ch4.adb (Is_Safe_In_Place_Array_Op): Ensure proper kind of entity
before reading attributes Component_Size and Component_Type.
* exp_ch3.adb (Build_Initialization_Call): Ensure proper kind of entity
before reading attribute Component_Type.
2009-07-23 Olivier Hainque <hainque@adacore.com>
* gnat_rm.texi: Document the GNAT.SSE units.

View File

@ -691,6 +691,7 @@ package body Einfo is
function Component_Type (Id : E) return E is
begin
pragma Assert (Is_Array_Type (Id) or else Is_String_Type (Id));
return Node20 (Implementation_Base_Type (Id));
end Component_Type;

View File

@ -1409,7 +1409,8 @@ package body Exp_Ch3 is
if (Is_Null_Init_Proc (Proc) and then not Init_Or_Norm_Scalars)
or else Is_Value_Type (Typ)
or else Is_Value_Type (Component_Type (Typ))
or else ((Is_Array_Type (Typ) or else Is_String_Type (Typ))
and then Is_Value_Type (Component_Type (Typ)))
then
return Empty_List;
end if;

View File

@ -9596,7 +9596,9 @@ package body Exp_Ch4 is
-- Skip this processing if the component size is different from system
-- storage unit (since at least for NOT this would cause problems).
if Component_Size (Etype (Lhs)) /= System_Storage_Unit then
if Is_Array_Type (Etype (Lhs))
and then Component_Size (Etype (Lhs)) /= System_Storage_Unit
then
return False;
-- Cannot do in place stuff on VM_Target since cannot pass addresses
@ -9606,7 +9608,9 @@ package body Exp_Ch4 is
-- Cannot do in place stuff if non-standard Boolean representation
elsif Has_Non_Standard_Rep (Component_Type (Etype (Lhs))) then
elsif (Is_Array_Type (Etype (Lhs)) or else Is_String_Type (Etype (Lhs)))
and then Has_Non_Standard_Rep (Component_Type (Etype (Lhs)))
then
return False;
elsif not Is_Unaliased (Lhs) then

View File

@ -4958,7 +4958,13 @@ package body Sem_Res is
New_Subp := Relocate_Node (Subp);
Set_Entity (Subp, Nam);
if Component_Type (Ret_Type) /= Any_Type then
if (Is_Array_Type (Ret_Type)
and then Component_Type (Ret_Type) /= Any_Type)
or else
(Is_Access_Type (Ret_Type)
and then Component_Type (Designated_Type (Ret_Type))
/= Any_Type)
then
if Needs_No_Actuals (Nam) then
-- Indexed call to a parameterless function