diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/ada/exp_ch3.adb | 11 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 25 | ||||
| -rw-r--r-- | gcc/ada/sem_ch8.adb | 28 |
4 files changed, 52 insertions, 22 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8d8c993..67275fe 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ + 2013-07-08 Robert Dewar <dewar@adacore.com> + + * sem_ch8.adb, exp_ch3.adb: Minor reformatting. + +2013-07-08 Hristian Kirtchev <kirtchev@adacore.com> + + * exp_ch4.adb (Expand_N_Op_Eq): When comparing two + Bounded_Strings, use the predefined equality function of the + root Super_String type. + 2013-07-08 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch4.adb (Create_Alternative): Removed. diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index df1935c..102cb65 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -7283,16 +7283,17 @@ package body Exp_Ch3 is -- When compiling in Ada 2012 mode, ensure that the accessibility -- level of the subpool access type is not deeper than that of the - -- pool_with_subpools. This check is not performed on .NET/JVM - -- since these targets do not support pools. The check is omitted - -- on profiles that lack package System.Storage_Pools.Subpools. + -- pool_with_subpools. elsif Ada_Version >= Ada_2012 and then Present (Associated_Storage_Pool (Def_Id)) + + -- Omit this check on .NET/JVM where pools are not supported + and then VM_Target = No_VM - -- ??? Temporary workaround until restriction No_Storage_Pools - -- is implemented. + -- Omit this check for the case of a configurable run-time that + -- does not provide package System.Storage_Pools.Subpools. and then RTE_Available (RE_Root_Storage_Pool_With_Subpools) then diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 26c5176..f351b67 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7242,6 +7242,27 @@ package body Exp_Ch4 is Build_Equality_Call (TSS (Root_Type (Typl), TSS_Composite_Equality)); + -- When comparing two Bounded_Strings, use the primitive equality of + -- the root Super_String type. + + elsif Is_Bounded_String (Typl) then + Prim := + First_Elmt (Collect_Primitive_Operations (Root_Type (Typl))); + + while Present (Prim) loop + exit when Chars (Node (Prim)) = Name_Op_Eq + and then Etype (First_Formal (Node (Prim))) = + Etype (Next_Formal (First_Formal (Node (Prim)))) + and then Base_Type (Etype (Node (Prim))) = Standard_Boolean; + + Next_Elmt (Prim); + end loop; + + -- A Super_String type should always have a primitive equality + + pragma Assert (Present (Prim)); + Build_Equality_Call (Node (Prim)); + -- Otherwise expand the component by component equality. Note that -- we never use block-bit comparisons for records, because of the -- problems with gaps. The backend will often be able to recombine @@ -10718,11 +10739,11 @@ package body Exp_Ch4 is Expand_Composite_Equality (Nod, Etype (C), Lhs => Make_Selected_Component (Loc, - Prefix => New_Lhs, + Prefix => New_Lhs, Selector_Name => New_Reference_To (C, Loc)), Rhs => Make_Selected_Component (Loc, - Prefix => New_Rhs, + Prefix => New_Rhs, Selector_Name => New_Reference_To (C, Loc)), Bodies => Bodies); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index ef9da82..e9505d6 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3300,14 +3300,14 @@ package body Sem_Ch8 is ------------------------ procedure Attribute_Renaming (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Nam : constant Node_Id := Name (N); - Spec : constant Node_Id := Specification (N); - New_S : constant Entity_Id := Defining_Unit_Name (Spec); - Aname : constant Name_Id := Attribute_Name (Nam); + Loc : constant Source_Ptr := Sloc (N); + Nam : constant Node_Id := Name (N); + Spec : constant Node_Id := Specification (N); + New_S : constant Entity_Id := Defining_Unit_Name (Spec); + Aname : constant Name_Id := Attribute_Name (Nam); - Form_Num : Nat := 0; - Expr_List : List_Id := No_List; + Form_Num : Nat := 0; + Expr_List : List_Id := No_List; Attr_Node : Node_Id; Body_Node : Node_Id; @@ -3323,9 +3323,7 @@ package body Sem_Ch8 is -- and the GNAT attribute 'Img, which GNAT treats as renameable. if not Is_Non_Empty_List (Parameter_Specifications (Spec)) then - if Aname /= Name_AST_Entry - and then Aname /= Name_Img - then + if Aname /= Name_AST_Entry and then Aname /= Name_Img then Error_Msg_N ("subprogram renaming an attribute must have formals", N); return; @@ -3344,8 +3342,8 @@ package body Sem_Ch8 is -- there are no subtypes involved. Rewrite (Parameter_Type (Param_Spec), - New_Reference_To - (Base_Type (Entity (Parameter_Type (Param_Spec))), Loc)); + New_Reference_To + (Base_Type (Entity (Parameter_Type (Param_Spec))), Loc)); end if; if No (Expr_List) then @@ -3498,13 +3496,13 @@ package body Sem_Ch8 is P : constant Node_Id := Prefix (Nam); begin - -- The prefix of 'Img is an object that is evaluated for - -- each call of the function that renames it. + -- The prefix of 'Img is an object that is evaluated for each call + -- of the function that renames it. if Aname = Name_Img then Preanalyze_And_Resolve (P); - -- For all other attribute renamings, the prefix is a subtype. + -- For all other attribute renamings, the prefix is a subtype else Find_Type (P); |