Skip to content

R
riscv-gcc-1
Commit 6bde3eb5 by Arnaud Charlet
Options

[multiple changes] 

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

From-SVN: r147149
parent 3743d5bd
Showing with 79 additions and 17 deletions
gcc/ada/ChangeLog
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
......
gcc/ada/exp_dist.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -6630,13 +6630,13 @@ package body Exp_Dist is
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))))))))))));
......@@ -8465,7 +8465,7 @@ package body Exp_Dist is
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
......@@ -8970,7 +8970,11 @@ package body Exp_Dist is
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,
......@@ -9288,6 +9292,7 @@ package body Exp_Dist is
Typ : Entity_Id := Etype (N);
U_Type : Entity_Id;
C_Type : Entity_Id;
Fnam : Entity_Id := Empty;
Lib_RE : RE_Id := RE_Null;
......@@ -9383,7 +9388,7 @@ package body Exp_Dist is
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
......@@ -9416,11 +9421,23 @@ package body Exp_Dist is
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;
---------------------------
......@@ -10153,7 +10170,7 @@ package body Exp_Dist is
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
......@@ -10253,7 +10270,7 @@ package body Exp_Dist is
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;
......
gcc/ada/exp_dist.ads
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -35,7 +35,7 @@ package Exp_Dist is
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
......
gcc/ada/g-comlin.ads
......@@ -112,6 +112,7 @@
-- 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.
......
gcc/ada/rtsfind.adb
......@@ -305,6 +305,9 @@ package body Rtsfind is
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) := '.';
......
gcc/ada/rtsfind.ads
......@@ -61,6 +61,9 @@ package Rtsfind is
-- 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.
......@@ -120,6 +123,7 @@ package Rtsfind is
Ada_Interrupts,
Ada_Real_Time,
Ada_Streams,
Ada_Strings,
Ada_Tags,
Ada_Task_Identification,
Ada_Task_Termination,
......@@ -149,6 +153,10 @@ package Rtsfind is
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,
......@@ -404,6 +412,11 @@ package Rtsfind is
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;
......@@ -530,6 +543,8 @@ package Rtsfind is
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
......@@ -1226,6 +1241,7 @@ package Rtsfind is
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
......@@ -1693,6 +1709,8 @@ package Rtsfind is
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,
......@@ -2380,6 +2398,7 @@ package Rtsfind is
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,
......
gcc/ada/sem_aggr.adb
......@@ -3156,11 +3156,7 @@ package body Sem_Aggr is
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;
......@@ -3317,6 +3313,7 @@ package body Sem_Aggr is
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
......@@ -3325,6 +3322,9 @@ package body Sem_Aggr is
-- 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);
......
gcc/ada/xoscons.adb
......@@ -30,7 +30,7 @@
-- - 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;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment