[multiple changes]

 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.

From-SVN: r200760

gcc/ada/ChangeLog

+ 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.

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

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);
 

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);