From: Ed Schonberg Date: Wed, 20 Aug 2008 11:02:51 +0000 (+0000) Subject: sem_aggr.adb, [...] (Valid_Ancestor): Resolve confusion between partial and full... X-Git-Tag: releases/gcc-4.4.0~3065 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=2af92e28f0612424edab29a57a22f1b9609dad6e;p=thirdparty%2Fgcc.git sem_aggr.adb, [...] (Valid_Ancestor): Resolve confusion between partial and full views of an ancestor of the context... 2008-08-20 Ed Schonberg * sem_aggr.adb, sem_type.adb, exp_ch9.ads, einfo.ads, exp_ch6.adb, exp_aggr.adb (Valid_Ancestor): Resolve confusion between partial and full views of an ancestor of the context type when the parent is a private extension declared in a parent unit, and full views are available for the context type. From-SVN: r139269 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 21e3e269a40b..2161e87cde3a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2008-08-20 Ed Schonberg + + * sem_aggr.adb, sem_type.adb, exp_ch9.ads, einfo.ads, + exp_ch6.adb, exp_aggr.adb (Valid_Ancestor): Resolve + confusion between partial and full views of an ancestor of the context + type when the parent is a private extension declared in a parent unit, + and full views are available for the context type. + 2008-08-18 Samuel Tardieu Robert Dewar diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c7182dbe04f2..a70587471495 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -5016,6 +5016,7 @@ package Einfo is -- Generic_Renamings (Elist23) (for an instance) -- Inner_Instances (Elist23) (generic function only) -- Protection_Object (Node23) (for concurrent kind) + -- Spec_PPC_List (Node24) -- Interface_Alias (Node25) -- Overridden_Operation (Node26) -- Wrapped_Entity (Node27) (non-generic case only) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index bc3b954fb6c3..8a59879b0e07 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -2547,9 +2547,13 @@ package body Exp_Aggr is -- in the limited case, the ancestor part must be either a -- function call (possibly qualified, or wrapped in an unchecked -- conversion) or aggregate (definitely qualified). + -- The ancestor part can also be a function call (that may be + -- transformed into an explicit dereference) or a qualification + -- of one such. elsif Is_Limited_Type (Etype (A)) and then Nkind (Unqualify (A)) /= N_Function_Call -- aggregate? + and then Nkind (Unqualify (A)) /= N_Explicit_Dereference and then (Nkind (Unqualify (A)) /= N_Unchecked_Type_Conversion or else diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 4c3f3da63f94..faefb52c6f46 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -4394,6 +4394,14 @@ package body Exp_Ch6 is Prot_Id : Entity_Id; begin + -- If the subprogram is a function with an anonymous access + -- to protected subprogram, it must be expanded to create + -- its equivalent type. + + -- if Ekind (Typ) = E_Anonymous_Access_Protected_Subprogram_Type then + -- Expand_Access_Protected_Subprogram_Type (N, Typ); + -- end if; + -- Deal with case of protected subprogram. Do not generate protected -- operation if operation is flagged as eliminated. diff --git a/gcc/ada/exp_ch9.ads b/gcc/ada/exp_ch9.ads index 1cfa74d3635e..3ec61125a3fc 100644 --- a/gcc/ada/exp_ch9.ads +++ b/gcc/ada/exp_ch9.ads @@ -203,7 +203,9 @@ package Exp_Ch9 is -- routine to make sure Complete_Master is called on exit). procedure Expand_Access_Protected_Subprogram_Type (N : Node_Id); - -- Build Equivalent_Type for an Access_to_protected_Subprogram + -- Build Equivalent_Type for an Access_To_Protected_Subprogram. + -- Equivalent_Type is a record type with two components: a pointer + -- to the protected object, and a pointer to the operation itself. procedure Expand_Accept_Declarations (N : Node_Id; Ent : Entity_Id); -- Expand declarations required for accept statement. See bodies of diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index d16b7d6b8c46..13ab96c6c638 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -2155,20 +2155,31 @@ package body Sem_Aggr is begin Imm_Type := Base_Type (Typ); - while Is_Derived_Type (Imm_Type) - and then Etype (Imm_Type) /= Base_Type (A_Type) - loop - Imm_Type := Etype (Base_Type (Imm_Type)); + while Is_Derived_Type (Imm_Type) loop + if Etype (Imm_Type) = Base_Type (A_Type) then + return True; + + -- The base type of the parent type may appear as a private + -- extension if it is declared as such in a parent unit of + -- the current one. For consistency of the subsequent analysis + -- use the partial view for the ancestor part. + + elsif Is_Private_Type (Etype (Imm_Type)) + and then Present (Full_View (Etype (Imm_Type))) + and then Base_Type (A_Type) = Full_View (Etype (Imm_Type)) + then + A_Type := Etype (Imm_Type); + return True; + + else + Imm_Type := Etype (Base_Type (Imm_Type)); + end if; end loop; - if not Is_Derived_Type (Base_Type (Typ)) - or else Etype (Imm_Type) /= Base_Type (A_Type) - then - Error_Msg_NE ("expect ancestor type of &", A, Typ); - return False; - else - return True; - end if; + -- If previous loop did not find a proper ancestor, report error. + + Error_Msg_NE ("expect ancestor type of &", A, Typ); + return False; end Valid_Ancestor_Type; -- Start of processing for Resolve_Extension_Aggregate diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 3ca2e5354780..b8dca3bf9ff1 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -884,8 +884,6 @@ package body Sem_Type is then return True; - -- An aggregate is compatible with an array or record type - elsif T2 = Any_Composite and then Ekind (T1) in E_Array_Type .. E_Record_Subtype then