[multiple changes]

2014-07-29  Olivier Hainque  <hainque@adacore.com>

	* g-debpoo.adb
	(Default_Alignment): Rename as Storage_Alignment. This is not
	a "default" that can be overriden. Augment comment to clarify
	intent and document why we need to manage alignment padding.
	(Header_Offset): Set to Header'Object_Size instead of 'Size
	rounded up to Storage_Alignment. Storage_Alignment on the
	allocation header is not required by our internals so was
	overkill. 'Object_Size is enough to ensure proper alignment
	of the header address when substracted from a storage address
	aligned on Storage_Alignment.
	(Minimum_Allocation): Rename as Extra_Allocation, conveying that
	this is always added on top of the incoming allocation requests.
	(Align): New function, to perform alignment rounding operations.
	(Allocate): Add comments on the Storage_Address computation
	scheme and adjust so that the alignment padding applies to that
	(Storage_Address) only.

2014-07-29  Robert Dewar  <dewar@adacore.com>

	* exp_ch3.adb (Default_Initialize_Object): Remove incorrect
	pragma Unreferenced.
	* cstand.adb (Create_Standard): Use E_Array_Type for standard
	string types. Make sure index of Any_String/Any_Array is in a list.
	* errout.adb: Minor reformatting.

From-SVN: r213169

gcc/ada/ChangeLog

+2014-07-29  Olivier Hainque  <hainque@adacore.com>
+
+	* g-debpoo.adb
+	(Default_Alignment): Rename as Storage_Alignment. This is not
+	a "default" that can be overriden. Augment comment to clarify
+	intent and document why we need to manage alignment padding.
+	(Header_Offset): Set to Header'Object_Size instead of 'Size
+	rounded up to Storage_Alignment. Storage_Alignment on the
+	allocation header is not required by our internals so was
+	overkill. 'Object_Size is enough to ensure proper alignment
+	of the header address when substracted from a storage address
+	aligned on Storage_Alignment.
+	(Minimum_Allocation): Rename as Extra_Allocation, conveying that
+	this is always added on top of the incoming allocation requests.
+	(Align): New function, to perform alignment rounding operations.
+	(Allocate): Add comments on the Storage_Address computation
+	scheme and adjust so that the alignment padding applies to that
+	(Storage_Address) only.
+
+2014-07-29  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch3.adb (Default_Initialize_Object): Remove incorrect
+	pragma Unreferenced.
+	* cstand.adb (Create_Standard): Use E_Array_Type for standard
+	string types. Make sure index of Any_String/Any_Array is in a list.
+	* errout.adb: Minor reformatting.
+
 2014-07-29  Robert Dewar  <dewar@adacore.com>
 
 	* gnat_ugn.texi: Clean up and correct documentation of warnings.

gcc/ada/cstand.adb

@@ -450,6 +450,9 @@ package body CStand is
       --  Creates entities for all predefined floating point types, and
       --  adds these to the Predefined_Float_Types list in package Standard.
 
+      procedure Make_Dummy_Index (E : Entity_Id);
+      --  Called to provide a dummy index field value for Any_Array/Any_String
+
       procedure Pack_String_Type (String_Type : Entity_Id);
       --  Generate proper tree for pragma Pack that applies to given type, and
       --  mark type as having the pragma.
@@ -554,6 +557,27 @@ package body CStand is
       end Create_Float_Types;
 
       ----------------------
+      -- Make_Dummy_Index --
+      ----------------------
+
+      procedure Make_Dummy_Index (E : Entity_Id) is
+         Index : Node_Id;
+         Dummy : List_Id;
+
+      begin
+         Index :=
+           Make_Range (Sloc (E),
+             Low_Bound  => Make_Integer (Uint_0),
+             High_Bound => Make_Integer (Uint_2 ** Standard_Integer_Size));
+         Set_Etype (Index, Standard_Integer);
+         Set_First_Index (E, Index);
+
+         --  Make sure Index is a list as required, so Next_Index is Empty
+
+         Dummy := New_List (Index);
+      end Make_Dummy_Index;
+
+      ----------------------
       -- Pack_String_Type --
       ----------------------
 
@@ -907,7 +931,7 @@ package body CStand is
       Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
       Set_Type_Definition (Parent (Standard_String), Tdef_Node);
 
-      Set_Ekind           (Standard_String, E_String_Type);
+      Set_Ekind           (Standard_String, E_Array_Type);
       Set_Etype           (Standard_String, Standard_String);
       Set_Component_Type  (Standard_String, Standard_Character);
       Set_Component_Size  (Standard_String, Uint_8);
@@ -926,8 +950,8 @@ package body CStand is
 
       --  Set index type of String
 
-      E_Id := First
-        (Subtype_Marks (Type_Definition (Parent (Standard_String))));
+      E_Id :=
+        First (Subtype_Marks (Type_Definition (Parent (Standard_String))));
       Set_First_Index (Standard_String, E_Id);
       Set_Entity (E_Id, Standard_Positive);
       Set_Etype (E_Id, Standard_Positive);
@@ -951,7 +975,7 @@ package body CStand is
       Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
       Set_Type_Definition (Parent (Standard_Wide_String), Tdef_Node);
 
-      Set_Ekind           (Standard_Wide_String, E_String_Type);
+      Set_Ekind           (Standard_Wide_String, E_Array_Type);
       Set_Etype           (Standard_Wide_String, Standard_Wide_String);
       Set_Component_Type  (Standard_Wide_String, Standard_Wide_Character);
       Set_Component_Size  (Standard_Wide_String, Uint_16);
@@ -960,8 +984,9 @@ package body CStand is
 
       --  Set index type of Wide_String
 
-      E_Id := First
-        (Subtype_Marks (Type_Definition (Parent (Standard_Wide_String))));
+      E_Id :=
+        First
+          (Subtype_Marks (Type_Definition (Parent (Standard_Wide_String))));
       Set_First_Index (Standard_Wide_String, E_Id);
       Set_Entity (E_Id, Standard_Positive);
       Set_Etype (E_Id, Standard_Positive);
@@ -985,7 +1010,7 @@ package body CStand is
       Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
       Set_Type_Definition (Parent (Standard_Wide_Wide_String), Tdef_Node);
 
-      Set_Ekind            (Standard_Wide_Wide_String, E_String_Type);
+      Set_Ekind            (Standard_Wide_Wide_String, E_Array_Type);
       Set_Etype            (Standard_Wide_Wide_String,
                             Standard_Wide_Wide_String);
       Set_Component_Type   (Standard_Wide_Wide_String,
@@ -997,8 +1022,10 @@ package body CStand is
 
       --  Set index type of Wide_Wide_String
 
-      E_Id := First
-        (Subtype_Marks (Type_Definition (Parent (Standard_Wide_Wide_String))));
+      E_Id :=
+        First
+         (Subtype_Marks
+            (Type_Definition (Parent (Standard_Wide_Wide_String))));
       Set_First_Index (Standard_Wide_Wide_String, E_Id);
       Set_Entity (E_Id, Standard_Positive);
       Set_Etype (E_Id, Standard_Positive);
@@ -1213,12 +1240,13 @@ package body CStand is
       Make_Name             (Any_Character, "a character type");
 
       Any_Array := New_Standard_Entity;
-      Set_Ekind             (Any_Array, E_String_Type);
+      Set_Ekind             (Any_Array, E_Array_Type);
       Set_Scope             (Any_Array, Standard_Standard);
       Set_Etype             (Any_Array, Any_Array);
       Set_Component_Type    (Any_Array, Any_Character);
       Init_Size_Align       (Any_Array);
       Make_Name             (Any_Array, "an array type");
+      Make_Dummy_Index      (Any_Array);
 
       Any_Boolean := New_Standard_Entity;
       Set_Ekind             (Any_Boolean, E_Enumeration_Type);
@@ -1305,24 +1333,13 @@ package body CStand is
       Make_Name             (Any_Scalar, "a scalar type");
 
       Any_String := New_Standard_Entity;
-      Set_Ekind             (Any_String, E_String_Type);
+      Set_Ekind             (Any_String, E_Array_Type);
       Set_Scope             (Any_String, Standard_Standard);
       Set_Etype             (Any_String, Any_String);
       Set_Component_Type    (Any_String, Any_Character);
       Init_Size_Align       (Any_String);
       Make_Name             (Any_String, "a string type");
-
-      declare
-         Index   : Node_Id;
-
-      begin
-         Index :=
-           Make_Range (Stloc,
-             Low_Bound  => Make_Integer (Uint_0),
-             High_Bound => Make_Integer (Uint_2 ** Standard_Integer_Size));
-         Set_Etype (Index, Standard_Integer);
-         Set_First_Index (Any_String, Index);
-      end;
+      Make_Dummy_Index      (Any_String);
 
       Raise_Type := New_Standard_Entity;
       Decl := New_Node (N_Full_Type_Declaration, Stloc);

gcc/ada/einfo.adb

@@ -7185,11 +7185,10 @@ package body Einfo is
 
    function Is_String_Type (Id : E) return B is
    begin
-      return Ekind (Id) in String_Kind
-        or else (Is_Array_Type (Id)
-                  and then Id /= Any_Composite
-                  and then Number_Dimensions (Id) = 1
-                  and then Is_Character_Type (Component_Type (Id)));
+      return Is_Array_Type (Id)
+        and then Id /= Any_Composite
+        and then Number_Dimensions (Id) = 1
+        and then Is_Character_Type (Component_Type (Id));
    end Is_String_Type;
 
    -------------------------------
@@ -7555,7 +7554,7 @@ package body Einfo is
       T : Node_Id;
 
    begin
-      if Ekind (Id) in String_Kind then
+      if Ekind (Id) = E_String_Literal_Subtype then
          return 1;
 
       else
@@ -7563,7 +7562,7 @@ package body Einfo is
          T := First_Index (Id);
          while Present (T) loop
             N := N + 1;
-            T := Next (T);
+            Next_Index (T);
          end loop;
 
          return N;
@@ -8050,10 +8049,6 @@ package body Einfo is
               E_Record_Subtype               =>
             Kind := E_Record_Subtype;
 
-         when E_String_Type                  |
-              E_String_Subtype               =>
-            Kind := E_String_Subtype;
-
          when Enumeration_Kind               =>
             Kind := E_Enumeration_Subtype;
 

gcc/ada/einfo.ads

@@ -1245,14 +1245,14 @@ package Einfo is
 --       all the extra formals (see description of Extra_Formals field).
 
 --    First_Index (Node17)
---       Defined in array types and subtypes and in string types and subtypes.
---       By introducing implicit subtypes for the index constraints, we have
---       the same structure for constrained and unconstrained arrays, subtype
---       marks and discrete ranges are both represented by a subtype. This
---       function returns the tree node corresponding to an occurrence of the
---       first index (NOT the entity for the type). Subsequent indices are
---       obtained using Next_Index. Note that this field is defined for the
---       case of string literal subtypes, but is always Empty.
+--       Defined in array types and subtypes. By introducing implicit subtypes
+--       for the index constraints, we have the same structure for constrained
+--       and unconstrained arrays, subtype marks and discrete ranges are
+--       both represented by a subtype. This function returns the tree node
+--       corresponding to an occurrence of the first index (NOT the entity for
+--       the type). Subsequent indices are obtained using Next_Index. Note that
+--       this field is defined for the case of string literal subtypes, but is
+--       always Empty.
 
 --    First_Literal (Node17)
 --       Defined in all enumeration types, including character and boolean
@@ -4519,12 +4519,9 @@ package Einfo is
       --  or the use of an anonymous array subtype.
 
       E_String_Type,
-      --  A string type, i.e. an array type whose component type is a character
-      --  type, and for which string literals can thus be written.
-
       E_String_Subtype,
-      --  A string subtype, created by an explicit subtype declaration for a
-      --  string type, or the use of an anonymous subtype of a string type,
+      --  These are obsolete and not used any more, they are retained to ease
+      --  transition in getting rid of these obsolete entries.
 
       E_String_Literal_Subtype,
       --  A special string subtype, used only to describe the type of a string
@@ -4758,8 +4755,6 @@ package Einfo is
    subtype Aggregate_Kind              is Entity_Kind range
        E_Array_Type ..
    --  E_Array_Subtype
-   --  E_String_Type
-   --  E_String_Subtype
    --  E_String_Literal_Subtype
    --  E_Class_Wide_Type
    --  E_Class_Wide_Subtype
@@ -4769,8 +4764,6 @@ package Einfo is
    subtype Array_Kind                  is Entity_Kind range
        E_Array_Type ..
    --  E_Array_Subtype
-   --  E_String_Type
-   --  E_String_Subtype
        E_String_Literal_Subtype;
 
    subtype Assignable_Kind             is Entity_Kind range
@@ -4785,8 +4778,6 @@ package Einfo is
    subtype Composite_Kind              is Entity_Kind range
        E_Array_Type ..
    --  E_Array_Subtype
-   --  E_String_Type
-   --  E_String_Subtype
    --  E_String_Literal_Subtype
    --  E_Class_Wide_Type
    --  E_Class_Wide_Subtype
@@ -5011,11 +5002,6 @@ package Einfo is
    --  E_Floating_Point_Type
        E_Floating_Point_Subtype;
 
-   subtype String_Kind                 is Entity_Kind range
-       E_String_Type ..
-   --  E_String_Subtype
-       E_String_Literal_Subtype;
-
    subtype Subprogram_Kind             is Entity_Kind range
        E_Function ..
    --  E_Operator
@@ -5054,8 +5040,6 @@ package Einfo is
    --  E_Anonymous_Access_Type
    --  E_Array_Type
    --  E_Array_Subtype
-   --  E_String_Type
-   --  E_String_Subtype
    --  E_String_Literal_Subtype
    --  E_Class_Wide_Subtype
    --  E_Class_Wide_Type
@@ -6085,18 +6069,6 @@ package Einfo is
    --    Type_High_Bound                     (synth)
    --    (plus type attributes)
 
-   --  E_String_Type
-   --  E_String_Subtype
-   --    First_Index                         (Node17)
-   --    Component_Type                      (Node20)   (base type only)
-   --    Static_Real_Or_String_Predicate     (Node25)
-   --    Is_Constrained                      (Flag12)
-   --    SSO_Set_High_By_Default             (Flag273)  (base type only)
-   --    SSO_Set_Low_By_Default              (Flag272)  (base type only)
-   --    Next_Index                          (synth)
-   --    Number_Dimensions                   (synth)
-   --    (plus type attributes)
-
    --  E_String_Literal_Subtype
    --    String_Literal_Low_Bound            (Node15)
    --    String_Literal_Length               (Uint16)

gcc/ada/errout.adb

@@ -1945,8 +1945,8 @@ package body Errout is
 
                         Err_Flag :=
                           E /= No_Error_Msg
-                          and then Errors.Table (E).Line = N
-                          and then Errors.Table (E).Sfile = Sfile;
+                            and then Errors.Table (E).Line = N
+                            and then Errors.Table (E).Sfile = Sfile;
 
                         Output_Source_Line (N, Sfile, Err_Flag);
 

gcc/ada/exp_ch3.adb

@@ -5043,9 +5043,8 @@ package body Exp_Ch3 is
          Obj_Ref    : Node_Id;
 
          Dummy : Entity_Id;
-         pragma Unreferenced (Dummy);
-         --  This variable captures an unused dummy internal entity, see the
-         --  comment associated with its use.
+         --  This variable captures a dummy internal entity, see the comment
+         --  associated with its use.
 
       --  Start of processing for Default_Initialize_Object
 

gcc/ada/freeze.adb

@@ -2082,7 +2082,7 @@ package body Freeze is
 
          --  Processing that is done only for base types
 
-         if Ekind (Arr) = E_Array_Type then  -- what about E_String_Type ???
+         if Ekind (Arr) = E_Array_Type then
 
             --  Deal with default setting of reverse storage order
 
@@ -2231,8 +2231,7 @@ package body Freeze is
 
                      if Has_Pragma_Pack (Arr)
                        and then not Present (Comp_Size_C)
-                       and then
-                         (Csiz = 7 or else Csiz = 15 or else Csiz = 31)
+                       and then (Csiz = 7 or else Csiz = 15 or else Csiz = 31)
                        and then Esize (Base_Type (Ctyp)) = Csiz + 1
                      then
                         Error_Msg_Uint_1 := Csiz;
@@ -2274,8 +2273,7 @@ package body Freeze is
                         if Known_Static_Esize (Component_Type (Arr))
                           and then Esize (Component_Type (Arr)) = Csiz
                         then
-                           Set_Has_Non_Standard_Rep
-                             (Base_Type (Arr), False);
+                           Set_Has_Non_Standard_Rep (Base_Type (Arr), False);
                         end if;
 
                         --  In all other cases, packing is indeed needed

gcc/ada/lib-xref.ads

@@ -502,14 +502,18 @@ package Lib.Xref is
       E_Signed_Integer_Subtype                     => 'I',
       E_Signed_Integer_Type                        => 'I',
       E_String_Literal_Subtype                     => ' ',
-      E_String_Subtype                             => 'S',
-      E_String_Type                                => 'S',
       E_Subprogram_Type                            => ' ',
       E_Task_Subtype                               => 'T',
       E_Task_Type                                  => 'T',
       E_Variable                                   => '*',
       E_Void                                       => ' ',
 
+      --  These are dummy entries which can be removed when we finally get
+      --  rid of these obsolete entries once and for all.
+
+      E_String_Type                               => ' ',
+      E_String_Subtype                            => ' ',
+
       --  The following entities are not ones to which we gather the cross-
       --  references, since it does not make sense to do so (e.g. references to
       --  a package are to the spec, not the body) Indeed the occurrence of the

gcc/ada/prj-dect.adb

@@ -1558,7 +1558,6 @@ package body Prj.Dect is
       if Token = Tok_Right_Paren then
          Scan (In_Tree);
       end if;
-
    end Parse_String_Type_Declaration;
 
    --------------------------------

gcc/ada/sprint.adb

@@ -4083,7 +4083,7 @@ package body Sprint is
 
                   --  Array types and string types
 
-                  when E_Array_Type | E_String_Type =>
+                  when E_Array_Type =>
                      Write_Header;
                      Write_Str ("array (");