diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 22 | ||||
| -rw-r--r-- | gcc/ada/exp_dist.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/exp_dist.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/g-comlin.ads | 1 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.ads | 19 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/xoscons.adb | 2 |
8 files changed, 79 insertions, 17 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index eeedef345c6..cb672611b3d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +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 diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 04a2187c8ce..75b400d2644 100644 --- a/gcc/ada/exp_dist.adb +++ b/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; diff --git a/gcc/ada/exp_dist.ads b/gcc/ada/exp_dist.ads index 26995a8b9f9..d6fc1bb8ead 100644 --- a/gcc/ada/exp_dist.ads +++ b/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 diff --git a/gcc/ada/g-comlin.ads b/gcc/ada/g-comlin.ads index 526624244eb..57a68c2ab2f 100644 --- a/gcc/ada/g-comlin.ads +++ b/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. diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb index d05aef01162..41dae0f59c9 100644 --- a/gcc/ada/rtsfind.adb +++ b/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) := '.'; diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 5439f4e0e17..59c9835088c 100644 --- a/gcc/ada/rtsfind.ads +++ b/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, diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index d50942b024a..974e01fe051 100644 --- a/gcc/ada/sem_aggr.adb +++ b/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); diff --git a/gcc/ada/xoscons.adb b/gcc/ada/xoscons.adb index 08aac903c33..83b726b6b9b 100644 --- a/gcc/ada/xoscons.adb +++ b/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; |