From 7205254be85f07852b41fa0a92f6667a4ecaca8c Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Thu, 23 Jul 2009 09:21:31 +0000 Subject: [PATCH] einfo.adb (Component_Type): Add missing assertion. 2009-07-23 Javier Miranda * 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 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/einfo.adb | 1 + gcc/ada/exp_ch3.adb | 3 ++- gcc/ada/exp_ch4.adb | 8 ++++++-- gcc/ada/sem_res.adb | 8 +++++++- 5 files changed, 26 insertions(+), 4 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2451727bb40..bbb9f649c58 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2009-07-23 Javier Miranda + + * 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 * gnat_rm.texi: Document the GNAT.SSE units. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 170f4f043ef..4d873da2396 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -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; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index c2b5595adf5..fe51d2f2b3b 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -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; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 8eabfc7e4e6..456f46f607c 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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 diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index b43ab51e66e..fcd11f4472c 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -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