diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/ada/einfo.ads | 1 | ||||
| -rw-r--r-- | gcc/ada/exp_aggr.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/sem_type.adb | 2 |
7 files changed, 47 insertions, 15 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 21e3e26..2161e87 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2008-08-20 Ed Schonberg <schonberg@adacore.com> + + * 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 <sam@rfc1149.net> Robert Dewar <dewar@adacore.com> diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c7182db..a705874 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 bc3b954..8a59879 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 4c3f3da..faefb52 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 1cfa74d..3ec6112 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 d16b7d6..13ab96c 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 3ca2e53..b8dca3b 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 |