+2009-05-06 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_aggr.adb (Resolve_Record_Aggregate): If a defaulted component of
+ an aggregate with box default is of a discriminated private type, do
+ not build a subaggregate for it.
+ A proper call to the initialization procedure is generated for it.
+
+2009-05-06 Thomas Quinot <quinot@adacore.com>
+
+ * rtsfind.adb, rtsfind.ads, exp_dist.adb, exp_dist.ads
+ (Exp_Dist.Build_TC_Call, Build_From_Any_Call, Build_To_Any_Call):
+ Use PolyORB strings to represent Ada.Strings.Unbounded_String value;
+ use standard array code for Standard.String.
+ (Exp_Dist): Bump PolyORB s-parint API version to 3.
+ (Rtsfind): New entities TA_Std_String, Unbounded_String.
+
+2009-05-06 Robert Dewar <dewar@adacore.com>
+
+ * g-comlin.ads: Minor reformatting
+
+ * xoscons.adb: Minor reformatting
+
2009-05-06 Gary Dismukes <dismukes@adacore.com>
* sem_aggr.adb (Resolve_Record_Aggregate): In step 5, get the
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of
- (RTE (RE_TA_String), Loc),
+ (RTE (RE_TA_Std_String), Loc),
Parameter_Associations => New_List (
Make_String_Literal (Loc, Name_String))),
Make_Function_Call (Loc,
Name =>
New_Occurrence_Of
- (RTE (RE_TA_String), Loc),
+ (RTE (RE_TA_Std_String), Loc),
Parameter_Associations => New_List (
Make_String_Literal (Loc,
Strval => Repo_Id_String))))))))))));
elsif U_Type = RTE (RE_Long_Long_Unsigned) then
Lib_RE := RE_FA_LLU;
- elsif U_Type = Standard_String then
+ elsif Is_RTE (U_Type, RE_Unbounded_String) then
Lib_RE := RE_FA_String;
-- Special DSA types
for J in 1 .. Ndim loop
Lnam := New_External_Name ('L', J);
Hnam := New_External_Name ('H', J);
- Indt := Etype (Indx);
+
+ -- Note, for empty arrays bounds may be out of
+ -- the range of Etype (Indx).
+
+ Indt := Base_Type (Etype (Indx));
Append_To (Decls,
Make_Object_Declaration (Loc,
Typ : Entity_Id := Etype (N);
U_Type : Entity_Id;
+ C_Type : Entity_Id;
Fnam : Entity_Id := Empty;
Lib_RE : RE_Id := RE_Null;
elsif U_Type = RTE (RE_Long_Long_Unsigned) then
Lib_RE := RE_TA_LLU;
- elsif U_Type = Standard_String then
+ elsif Is_RTE (U_Type, RE_Unbounded_String) then
Lib_RE := RE_TA_String;
-- Special DSA types
Fnam := RTE (Lib_RE);
end if;
+ -- If Fnam is already analyzed, find the proper expected type,
+ -- else we have a newly constructed To_Any function and we know
+ -- that the expected type of its parameter is U_Type.
+
+ if Ekind (Fnam) = E_Function
+ and then Present (First_Formal (Fnam))
+ then
+ C_Type := Etype (First_Formal (Fnam));
+ else
+ C_Type := U_Type;
+ end if;
+
return
Make_Function_Call (Loc,
Name => New_Occurrence_Of (Fnam, Loc),
Parameter_Associations =>
- New_List (Unchecked_Convert_To (U_Type, N)));
+ New_List (OK_Convert_To (C_Type, N)));
end Build_To_Any_Call;
---------------------------
elsif U_Type = RTE (RE_Long_Long_Unsigned) then
Lib_RE := RE_TC_LLU;
- elsif U_Type = Standard_String then
+ elsif Is_RTE (U_Type, RE_Unbounded_String) then
Lib_RE := RE_TC_String;
-- Special DSA types
begin
Append_To (Parameter_List,
Make_Function_Call (Loc,
- Name => New_Occurrence_Of (RTE (RE_TA_String), Loc),
+ Name => New_Occurrence_Of (RTE (RE_TA_Std_String), Loc),
Parameter_Associations => New_List (
Make_String_Literal (Loc, S))));
end Add_String_Parameter;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
PCS_Version_Number : constant array (PCS_Names) of Int :=
(Name_No_DSA => 1,
Name_GARLIC_DSA => 1,
- Name_PolyORB_DSA => 2);
+ Name_PolyORB_DSA => 3);
-- PCS interface version. This is used to check for consistency between the
-- compiler used to generate distribution stubs and the PCS implementation.
-- It must be incremented whenever a change is made to the generated code
-- contexts, either because your system does not support Ada.Command_Line, or
-- because you are manipulating other tools and creating their command line by
-- hand, or for any other reason.
+
-- To create the list of strings, it is recommended to use
-- GNAT.OS_Lib.Argument_String_To_List.
elsif U_Id in Ada_Streams_Child then
Name_Buffer (12) := '.';
+ elsif U_Id in Ada_Strings_Child then
+ Name_Buffer (12) := '.';
+
elsif U_Id in Ada_Text_IO_Child then
Name_Buffer (12) := '.';
-- Names of the form Ada_Streams_xxx are second level children
-- of Ada.Streams.
+ -- Names of the form Ada_Strings_xxx are second level children
+ -- of Ada.Strings.
+
-- Names of the form Ada_Text_IO_xxx are second level children of
-- Ada.Text_IO.
Ada_Interrupts,
Ada_Real_Time,
Ada_Streams,
+ Ada_Strings,
Ada_Tags,
Ada_Task_Identification,
Ada_Task_Termination,
Ada_Streams_Stream_IO,
+ -- Children of Ada.Strings
+
+ Ada_Strings_Unbounded,
+
-- Children of Ada.Text_IO (for Text_IO_Kludge)
Ada_Text_IO_Decimal_IO,
subtype Ada_Streams_Child is Ada_Child
range Ada_Streams_Stream_IO .. Ada_Streams_Stream_IO;
+ -- Range of values for children of Ada.Streams
+
+ subtype Ada_Strings_Child is Ada_Child
+ range Ada_Strings_Unbounded .. Ada_Strings_Unbounded;
+ -- Range of values for children of Ada.Strings
subtype Ada_Text_IO_Child is Ada_Child
range Ada_Text_IO_Decimal_IO .. Ada_Text_IO_Modular_IO;
RE_Stream_Access, -- Ada.Streams.Stream_IO
+ RE_Unbounded_String, -- Ada.Strings.Unbounded
+
RE_Access_Level, -- Ada.Tags
RE_Address_Array, -- Ada.Tags
RE_Addr_Ptr, -- Ada.Tags
RE_TA_WWC, -- System.Partition_Interface
RE_TA_String, -- System.Partition_Interface
RE_TA_ObjRef, -- System.Partition_Interface
+ RE_TA_Std_String, -- System.Partition_Interface
RE_TA_TC, -- System.Partition_Interface
RE_TC_Alias, -- System.Partition_Interface
RE_Stream_Access => Ada_Streams_Stream_IO,
+ RE_Unbounded_String => Ada_Strings_Unbounded,
+
RE_Access_Level => Ada_Tags,
RE_Address_Array => Ada_Tags,
RE_Addr_Ptr => Ada_Tags,
RE_TA_WWC => System_Partition_Interface,
RE_TA_String => System_Partition_Interface,
RE_TA_ObjRef => System_Partition_Interface,
+ RE_TA_Std_String => System_Partition_Interface,
RE_TA_TC => System_Partition_Interface,
RE_TC_Alias => System_Partition_Interface,
end loop;
else
- -- We take the underlying type to account for private types when
- -- the original association had a box default.
-
- Record_Def :=
- Type_Definition (Parent (Underlying_Type (Base_Type (Typ))));
+ Record_Def := Type_Definition (Parent (Base_Type (Typ)));
if Null_Present (Record_Def) then
null;
then
if Is_Record_Type (Ctyp)
and then Has_Discriminants (Ctyp)
+ and then not Is_Private_Type (Ctyp)
then
-- We build a partially initialized aggregate with the
-- values of the discriminants and box initialization
-- the component. The capture of discriminants must
-- be recursive because subcomponents may be contrained
-- (transitively) by discriminants of enclosing types.
+ -- For a private type with discriminants, a call to the
+ -- initialization procedure will be generated, and no
+ -- subaggregate is needed.
Capture_Discriminants : declare
Loc : constant Source_Ptr := Sloc (N);
-- - the preprocessed C file: s-oscons-tmplt.i
-- - the generated assembly file: s-oscons-tmplt.s
--- The contents of s-oscons.ads is written on standard output.
+-- The contents of s-oscons.ads is written on standard output
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Exceptions; use Ada.Exceptions;
projects / platform / upstream / gcc.git / commitdiff