From 950d217a1ce57c2d8cdc4b54f73515409a0dbf18 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 24 Jun 2009 11:15:17 +0200 Subject: [PATCH] [multiple changes] 2009-06-24 Javier Miranda * exp_ch4.adb (Expand_N_Type_Conversion): return immediately from processing the type conversion when the node is replaced by an N_Raise_Program_Error node. 2009-06-24 Hristian Kirtchev * sem_ch6.adb (Designates_From_With_Type): New routine. (Process_Formals): Since anonymous access types are no longer flagged as from with types, traverse the designated type to determine whether it is coming from a limited view. * sem_res.adb: Remove with and use clauses for Sem_Ch10. (Full_Designated_Type): Use Available_View to extract the non-limited / full view of a type. From-SVN: r148899 --- gcc/ada/ChangeLog | 17 +++++++++++++++++ gcc/ada/exp_ch4.adb | 2 ++ gcc/ada/sem_ch6.adb | 27 ++++++++++++++++++++++++++- gcc/ada/sem_res.adb | 19 ++++++------------- 4 files changed, 51 insertions(+), 14 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4905f7f6a57..8a097f4436a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2009-06-24 Javier Miranda + + * exp_ch4.adb (Expand_N_Type_Conversion): return immediately + from processing the type conversion when the node is + replaced by an N_Raise_Program_Error node. + +2009-06-24 Hristian Kirtchev + + * sem_ch6.adb (Designates_From_With_Type): New routine. + (Process_Formals): Since anonymous access types are no longer flagged + as from with types, traverse the designated type to determine whether + it is coming from a limited view. + + * sem_res.adb: Remove with and use clauses for Sem_Ch10. + (Full_Designated_Type): Use Available_View to extract the non-limited / + full view of a type. + 2009-06-24 Robert Dewar * exp_ch6.adb: Minor reformatting diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 507ccad5005..1862cb5d9aa 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7860,6 +7860,8 @@ package body Exp_Ch4 is Make_Raise_Program_Error (Sloc (N), Reason => PE_Accessibility_Check_Failed)); Set_Etype (N, Target_Type); + + return; end if; end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index bb0da6d7538..dfd0cd424d0 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -7837,11 +7837,36 @@ package body Sem_Ch6 is First_Out_Param : Entity_Id := Empty; -- Used for setting Is_Only_Out_Parameter + function Designates_From_With_Type (Typ : Entity_Id) return Boolean; + -- Determine whether an access type designates a type coming from a + -- limited view. + function Is_Class_Wide_Default (D : Node_Id) return Boolean; -- Check whether the default has a class-wide type. After analysis the -- default has the type of the formal, so we must also check explicitly -- for an access attribute. + ------------------------------- + -- Designates_From_With_Type -- + ------------------------------- + + function Designates_From_With_Type (Typ : Entity_Id) return Boolean is + Desig : Entity_Id := Typ; + + begin + if Is_Access_Type (Desig) then + Desig := Directly_Designated_Type (Desig); + end if; + + if Is_Class_Wide_Type (Desig) then + Desig := Root_Type (Desig); + end if; + + return + Ekind (Desig) = E_Incomplete_Type + and then From_With_Type (Desig); + end Designates_From_With_Type; + --------------------------- -- Is_Class_Wide_Default -- --------------------------- @@ -8031,7 +8056,7 @@ package body Sem_Ch6 is -- is also class-wide. if Ekind (Formal_Type) = E_Anonymous_Access_Type - and then not From_With_Type (Formal_Type) + and then not Designates_From_With_Type (Formal_Type) and then Is_Class_Wide_Default (Default) and then not Is_Class_Wide_Type (Designated_Type (Formal_Type)) then diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index a662d5bf46a..c797d8caef1 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -9620,26 +9620,19 @@ package body Sem_Res is -------------------------- function Full_Designated_Type (T : Entity_Id) return Entity_Id is - Desig : Entity_Id := Designated_Type (T); + Desig : constant Entity_Id := Designated_Type (T); begin + -- Handle the limited view of a type + if Is_Incomplete_Type (Desig) and then From_With_Type (Desig) and then Present (Non_Limited_View (Desig)) then - Desig := Non_Limited_View (Desig); - - -- The shadow entity's non-limited view may designate an - -- incomplete type. - - if Is_Incomplete_Type (Desig) - and then Present (Full_View (Desig)) - then - Desig := Full_View (Desig); - end if; + return Available_View (Desig); + else + return Desig; end if; - - return Desig; end Full_Designated_Type; -- Local Declarations -- 2.30.2