+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
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.
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.
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.
-- 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
-- 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
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
-- 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)
-- 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
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
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,
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 --
-----------------------------
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
-- 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
projects / platform / upstream / linaro-gcc.git / commitdiff