rtsfind.ads: Add support for finding Super_String types.

2012-03-07  Bob Duff  <duff@adacore.com>

	* rtsfind.ads: Add support for finding Super_String types.
	* sem_util.ads, sem_util.adb (Is_Bounded_String): New function
	to determine whether a given type is a bounded string type.
	(Is_Fully_Initialized_Type): Return True for bounded
	string types, to suppress bogus warnings.
	* exp_ch4.adb (Expand_Composite_Equality): Special case for bounded
	strings: equality composes. This allows us to remove default values in
	super strings.
	* a-strsup.ads, a-stwisu.ads, a-stzsup.ads: Update comments.
	* exp_ch3.adb (Expand_Freeze_Record_Type): Comment.

From-SVN: r185066

gcc/ada/ChangeLog

+2012-03-07  Bob Duff  <duff@adacore.com>
+
+	* rtsfind.ads: Add support for finding Super_String types.
+	* sem_util.ads, sem_util.adb (Is_Bounded_String): New function
+	to determine whether a given type is a bounded string type.
+	(Is_Fully_Initialized_Type): Return True for bounded
+	string types, to suppress bogus warnings.
+	* exp_ch4.adb (Expand_Composite_Equality): Special case for bounded
+	strings: equality composes. This allows us to remove default values in
+	super strings.
+	* a-strsup.ads, a-stwisu.ads, a-stzsup.ads: Update comments.
+	* exp_ch3.adb (Expand_Freeze_Record_Type): Comment.
+
 2012-03-07  Robert Dewar  <dewar@adacore.com>
 
 	* sem_util.adb, exp_ch4.adb, exp_ch6.adb, sem_ch6.adb: Minor

gcc/ada/a-strsup.ads

@@ -45,8 +45,9 @@ package Ada.Strings.Superbounded is
       Current_Length : Natural := 0;
       Data           : String (1 .. Max_Length);
       --  A previous version had a default initial value for Data, which is no
-      --  longer necessary, because "=" now composes properly for untagged
-      --  records. Leaving it out is more efficient.
+      --  longer necessary, because we now special-case this type in the
+      --  compiler, so "=" composes properly for descendants of this
+      --  type. Leaving it out is more efficient.
    end record;
    --  Type Bounded_String in Ada.Strings.Bounded.Generic_Bounded_Length is
    --  derived from this type, with the constraint of the maximum length.

gcc/ada/a-stwisu.ads

@@ -48,8 +48,9 @@ package Ada.Strings.Wide_Superbounded is
       Current_Length : Natural := 0;
       Data           : Wide_String (1 .. Max_Length);
       --  A previous version had a default initial value for Data, which is no
-      --  longer necessary, because "=" now composes properly for untagged
-      --  records. Leaving it out is more efficient.
+      --  longer necessary, because we now special-case this type in the
+      --  compiler, so "=" composes properly for descendants of this
+      --  type. Leaving it out is more efficient.
    end record;
    --  Ada.Strings.Wide_Bounded.Generic_Bounded_Length.Wide_Bounded_String is
    --  derived from this type, with the constraint of the maximum length.

gcc/ada/a-stzsup.ads

@@ -49,8 +49,9 @@ package Ada.Strings.Wide_Wide_Superbounded is
       Current_Length : Natural := 0;
       Data           : Wide_Wide_String (1 .. Max_Length);
       --  A previous version had a default initial value for Data, which is no
-      --  longer necessary, because "=" now composes properly for untagged
-      --  records. Leaving it out is more efficient.
+      --  longer necessary, because we now special-case this type in the
+      --  compiler, so "=" composes properly for descendants of this
+      --  type. Leaving it out is more efficient.
    end record;
    --  Wide_Wide_Bounded.Generic_Bounded_Length.Wide_Wide_Bounded_String is
    --  derived from this type, with the constraint of the maximum length.

gcc/ada/exp_ch3.adb

@@ -6115,9 +6115,9 @@ package body Exp_Ch3 is
 
       --  This is done unconditionally to ensure that tools can be linked
       --  properly with user programs compiled with older language versions.
-      --  It might be worth including a switch to revert to a non-composable
-      --  equality for untagged records, even though no program depending on
-      --  non-composability has surfaced ???
+      --  In addition, this is needed because "=" composes for bounded strings
+      --  in all language versions (see also
+      --  Exp_Ch4.Expand_Composite_Equality).
 
       elsif Comes_From_Source (Def_Id)
         and then Convention (Def_Id) = Convention_Ada

gcc/ada/exp_ch4.adb

@@ -149,10 +149,10 @@ package body Exp_Ch4 is
    --  Local recursive function used to expand equality for nested composite
    --  types. Used by Expand_Record/Array_Equality, Bodies is a list on which
    --  to attach bodies of local functions that are created in the process.
-   --  This is the responsibility of the caller to insert those bodies at the
+   --  It is the responsibility of the caller to insert those bodies at the
    --  right place. Nod provides the Sloc value for generated code. Lhs and Rhs
    --  are the left and right sides for the comparison, and Typ is the type of
-   --  the arrays to compare.
+   --  the objects to compare.
 
    procedure Expand_Concatenate (Cnode : Node_Id; Opnds : List_Id);
    --  Routine to expand concatenation of a sequence of two or more operands
@@ -2488,17 +2488,24 @@ package body Exp_Ch4 is
                end if;
             end if;
 
-         elsif Ada_Version >= Ada_2012 then
+         --  Equality composes in Ada 2012 for untagged record types. It also
+         --  composes for bounded strings, because they are part of the
+         --  predefined environment. We could make it compose for bounded
+         --  strings by making them tagged, or by making sure all subcomponents
+         --  are set to the same value, even when not used. Instead, we have
+         --  this special case in the compiler, because it's more efficient.
+
+         elsif Ada_Version >= Ada_2012 or else Is_Bounded_String (Typ) then
 
             --  if no TSS has been created for the type, check whether there is
             --  a primitive equality declared for it.
 
             declare
-               Ada_2012_Op : constant Node_Id := Find_Primitive_Eq;
+               Op : constant Node_Id := Find_Primitive_Eq;
 
             begin
-               if Present (Ada_2012_Op) then
-                  return Ada_2012_Op;
+               if Present (Op) then
+                  return Op;
                else
 
                --  Use predefined equality if no user-defined primitive exists

gcc/ada/rtsfind.ads

@@ -160,6 +160,9 @@ package Rtsfind is
 
       --  Children of Ada.Strings
 
+      Ada_Strings_Superbounded,
+      Ada_Strings_Wide_Superbounded,
+      Ada_Strings_Wide_Wide_Superbounded,
       Ada_Strings_Unbounded,
 
       --  Children of Ada.Text_IO (for Text_IO_Kludge)
@@ -438,7 +441,7 @@ package Rtsfind is
    --  Range of values for children of Ada.Streams
 
    subtype Ada_Strings_Child is Ada_Child
-     range Ada_Strings_Unbounded .. Ada_Strings_Unbounded;
+     range Ada_Strings_Superbounded .. Ada_Strings_Unbounded;
    --  Range of values for children of Ada.Strings
 
    subtype Ada_Text_IO_Child is Ada_Child
@@ -588,6 +591,12 @@ package Rtsfind is
 
      RE_Stream_Access,                   -- Ada.Streams.Stream_IO
 
+     RO_SU_Super_String,                 -- Ada.Strings.Superbounded
+
+     RO_WI_Super_String,                 -- Ada.Strings.Wide_Superbounded
+
+     RO_WW_Super_String,                 -- Ada.Strings.Wide_Wide_Superbounded
+
      RE_Unbounded_String,                -- Ada.Strings.Unbounded
 
      RE_Access_Level,                    -- Ada.Tags
@@ -1790,6 +1799,12 @@ package Rtsfind is
 
      RE_Stream_Access                    => Ada_Streams_Stream_IO,
 
+     RO_SU_Super_String                  => Ada_Strings_Superbounded,
+
+     RO_WI_Super_String                  => Ada_Strings_Wide_Superbounded,
+
+     RO_WW_Super_String                  => Ada_Strings_Wide_Wide_Superbounded,
+
      RE_Unbounded_String                 => Ada_Strings_Unbounded,
 
      RE_Access_Level                     => Ada_Tags,

gcc/ada/sem_util.adb

@@ -6746,6 +6746,25 @@ package body Sem_Util is
       end if;
    end Is_Atomic_Object;
 
+   -----------------------
+   -- Is_Bounded_String --
+   -----------------------
+
+   function Is_Bounded_String (T : Entity_Id) return Boolean is
+      --  Check whether T is ultimately derived from Ada.Strings.-
+      --  Superbounded.Super_String, or one of the [Wide_]Wide_
+      --  versions. This will be True for all the Bounded_String types in
+      --  instances of the Generic_Bounded_Length generics, and for types
+      --  derived from those.
+
+      Under : constant Entity_Id := Underlying_Type (Root_Type (T));
+   begin
+      return Present (Under) and then
+        (Is_RTE (Root_Type (Under), RO_SU_Super_String)
+           or else Is_RTE (Root_Type (Under), RO_WI_Super_String)
+           or else Is_RTE (Root_Type (Under), RO_WW_Super_String));
+   end Is_Bounded_String;
+
    -----------------------------
    -- Is_Concurrent_Interface --
    -----------------------------
@@ -7215,6 +7234,14 @@ package body Sem_Util is
             return True;
          end if;
 
+         --  We consider bounded string types to be fully initialized, because
+         --  otherwise we get false alarms when the Data component is not
+         --  default-initialized.
+
+         if Is_Bounded_String (Typ) then
+            return True;
+         end if;
+
          --  Controlled records are considered to be fully initialized if
          --  there is a user defined Initialize routine. This may not be
          --  entirely correct, but as the spec notes, we are guessing here

gcc/ada/sem_util.ads

@@ -793,6 +793,10 @@ package Sem_Util is
    --  Determines if the given node denotes an atomic object in the sense of
    --  the legality checks described in RM C.6(12).
 
+   function Is_Bounded_String (T : Entity_Id) return Boolean;
+   --  True if T is a bounded string type. Used to make sure "=" composes
+   --  properly for bounded string types.
+
    function Is_Controlling_Limited_Procedure
      (Proc_Nam : Entity_Id) return Boolean;
    --  Ada 2005 (AI-345): Determine whether Proc_Nam is a primitive procedure