diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-08-29 14:23:16 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2011-08-29 14:23:16 +0000 |
commit | 15044392b374476c15645b61ce3802439e82d792 (patch) | |
tree | 95b6cce1c8fcea3d44303a5f582ed3dc1d627d71 | |
parent | 704880481a22c59657091bfb5b998efd989c9a5f (diff) | |
download | ppe42-gcc-15044392b374476c15645b61ce3802439e82d792.tar.gz ppe42-gcc-15044392b374476c15645b61ce3802439e82d792.zip |
2011-08-29 Robert Dewar <dewar@adacore.com>
* a-cbhama.adb, a-cbhama.ads: Minor reformatting.
2011-08-29 Javier Miranda <miranda@adacore.com>
* sem_ch8.adb (Analyze_Subprogram_Renaming): Complete support for
renamings of formal subprograms when the actual for a formal type is
class-wide.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@178244 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/ada/ChangeLog | 10 | ||||
-rw-r--r-- | gcc/ada/a-cbhama.adb | 9 | ||||
-rw-r--r-- | gcc/ada/a-cbhama.ads | 8 | ||||
-rw-r--r-- | gcc/ada/sem_ch8.adb | 73 |
4 files changed, 72 insertions, 28 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index ca82e7b1b85..508eb877461 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2011-08-29 Robert Dewar <dewar@adacore.com> + + * a-cbhama.adb, a-cbhama.ads: Minor reformatting. + +2011-08-29 Javier Miranda <miranda@adacore.com> + + * sem_ch8.adb (Analyze_Subprogram_Renaming): Complete support for + renamings of formal subprograms when the actual for a formal type is + class-wide. + 2011-08-29 Matthew Heaney <heaney@adacore.com> * a-cbhama.ads, a-cbhase.ads (Move): Clear Source following assignment diff --git a/gcc/ada/a-cbhama.adb b/gcc/ada/a-cbhama.adb index f71a9a552b0..629c1041ed9 100644 --- a/gcc/ada/a-cbhama.adb +++ b/gcc/ada/a-cbhama.adb @@ -424,15 +424,14 @@ package body Ada.Containers.Bounded_Hashed_Maps is end First; function First (Object : Iterator) return Cursor is - M : constant Map_Access := Object.Container; - N : constant Count_Type := HT_Ops.First (M.all); - + M : constant Map_Access := Object.Container; + N : constant Count_Type := HT_Ops.First (M.all); begin if N = 0 then return No_Element; + else + return Cursor'(Object.Container.all'Unchecked_Access, N); end if; - - return Cursor'(Object.Container.all'Unchecked_Access, N); end First; ----------------- diff --git a/gcc/ada/a-cbhama.ads b/gcc/ada/a-cbhama.ads index 94860f99cc0..003a919a6e3 100644 --- a/gcc/ada/a-cbhama.ads +++ b/gcc/ada/a-cbhama.ads @@ -32,7 +32,8 @@ ------------------------------------------------------------------------------ private with Ada.Containers.Hash_Tables; -with Ada.Streams; use Ada.Streams; + +with Ada.Streams; use Ada.Streams; with Ada.Iterator_Interfaces; generic @@ -47,8 +48,7 @@ package Ada.Containers.Bounded_Hashed_Maps is pragma Pure; pragma Remote_Types; - type Map (Capacity : Count_Type; Modulus : Hash_Type) is tagged private - with + type Map (Capacity : Count_Type; Modulus : Hash_Type) is tagged private with Constant_Indexing => Constant_Reference, Variable_Indexing => Reference, Default_Iterator => Iterate, @@ -328,7 +328,6 @@ package Ada.Containers.Bounded_Hashed_Maps is return Reference_Type; private - -- pragma Inline ("="); pragma Inline (Length); pragma Inline (Is_Empty); pragma Inline (Clear); @@ -339,7 +338,6 @@ private pragma Inline (Capacity); pragma Inline (Reserve_Capacity); pragma Inline (Has_Element); - -- pragma Inline (Equivalent_Keys); pragma Inline (Next); type Node_Type is record diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 5a782f3c20c..77f948f4f6a 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1634,11 +1634,6 @@ package body Sem_Ch8 is procedure Analyze_Subprogram_Renaming (N : Node_Id) is Formal_Spec : constant Node_Id := Corresponding_Formal_Spec (N); Is_Actual : constant Boolean := Present (Formal_Spec); - - CW_Actual : Boolean := False; - -- True if the renaming is for a defaulted formal subprogram when the - -- actual for a related formal type is class-wide. For AI05-0071. - Inst_Node : Node_Id := Empty; Nam : constant Node_Id := Name (N); New_S : Entity_Id; @@ -1691,6 +1686,11 @@ package body Sem_Ch8 is -- This rule only applies if there is no explicit visible class-wide -- operation at the point of the instantiation. + function Has_Class_Wide_Actual return Boolean; + -- Ada 2012 (AI05-071, AI05-0131): True if N is the renaming for a + -- defaulted formal subprogram when the actual for the controlling + -- formal type is class-wide. + ----------------------------- -- Check_Class_Wide_Actual -- ----------------------------- @@ -1729,7 +1729,7 @@ package body Sem_Ch8 is Next (F); end loop; - if Ekind (Prim_Op) = E_Function then + if Ekind_In (Prim_Op, E_Function, E_Operator) then return Make_Simple_Return_Statement (Loc, Expression => Make_Function_Call (Loc, @@ -1780,6 +1780,7 @@ package body Sem_Ch8 is F := First_Formal (Formal_Spec); while Present (F) loop if Has_Unknown_Discriminants (Etype (F)) + and then not Is_Class_Wide_Type (Etype (F)) and then Is_Class_Wide_Type (Get_Instance_Of (Etype (F))) then Formal_Type := Etype (F); @@ -1791,7 +1792,6 @@ package body Sem_Ch8 is end loop; if Present (Formal_Type) then - CW_Actual := True; -- Create declaration and body for class-wide operation @@ -1893,6 +1893,41 @@ package body Sem_Ch8 is end if; end Check_Null_Exclusion; + --------------------------- + -- Has_Class_Wide_Actual -- + --------------------------- + + function Has_Class_Wide_Actual return Boolean is + F_Nam : Entity_Id; + F_Spec : Entity_Id; + + begin + if Is_Actual + and then Nkind (Nam) in N_Has_Entity + and then Present (Entity (Nam)) + and then Is_Dispatching_Operation (Entity (Nam)) + then + F_Nam := First_Entity (Entity (Nam)); + F_Spec := First_Formal (Formal_Spec); + while Present (F_Nam) + and then Present (F_Spec) + loop + if Is_Controlling_Formal (F_Nam) + and then Has_Unknown_Discriminants (Etype (F_Spec)) + and then not Is_Class_Wide_Type (Etype (F_Spec)) + and then Is_Class_Wide_Type (Get_Instance_Of (Etype (F_Spec))) + then + return True; + end if; + + Next_Entity (F_Nam); + Next_Formal (F_Spec); + end loop; + end if; + + return False; + end Has_Class_Wide_Actual; + ------------------------- -- Original_Subprogram -- ------------------------- @@ -1938,6 +1973,11 @@ package body Sem_Ch8 is end if; end Original_Subprogram; + CW_Actual : constant Boolean := Has_Class_Wide_Actual; + -- Ada 2012 (AI05-071, AI05-0131): True if the renaming is for a + -- defaulted formal subprogram when the actual for a related formal + -- type is class-wide. + -- Start of processing for Analyze_Subprogram_Renaming begin @@ -2058,7 +2098,14 @@ package body Sem_Ch8 is if Is_Actual then Inst_Node := Unit_Declaration_Node (Formal_Spec); - if Is_Entity_Name (Nam) + -- Check whether the renaming is for a defaulted actual subprogram + -- with a class-wide actual. + + if CW_Actual then + New_S := Analyze_Subprogram_Specification (Spec); + Old_S := Check_Class_Wide_Actual; + + elsif Is_Entity_Name (Nam) and then Present (Entity (Nam)) and then not Comes_From_Source (Nam) and then not Is_Overloaded (Nam) @@ -2419,16 +2466,6 @@ package body Sem_Ch8 is end if; end if; - -- If no renamed entity was found, check whether the renaming is for - -- a defaulted actual subprogram with a class-wide actual. - - if Old_S = Any_Id - and then Is_Actual - and then From_Default (N) - then - Old_S := Check_Class_Wide_Actual; - end if; - if Old_S /= Any_Id then if Is_Actual and then From_Default (N) then |