[multiple changes]

2009-05-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Analyze_Object_Renaming): If the object is a function
	call returning an unconstrained composite value, create the proper
	subtype for it, as is done for object dclarations with unconstrained
	nominal subtypes

2009-05-06  Robert Dewar  <dewar@adacore.com>

	* sem_ch13.adb (Check_Constant_Address_Clause): Minor error message
	improvements

	* freeze.adb: Minor reformatting

From-SVN: r147156

4 files changed, 54 insertions, 17 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index fa0b625..6970c2c 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2009-05-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch8.adb (Analyze_Object_Renaming): If the object is a function
+	call returning an unconstrained composite value, create the proper
+	subtype for it, as is done for object dclarations with unconstrained
+	nominal subtypes
+
+2009-05-06  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch13.adb (Check_Constant_Address_Clause): Minor error message
+	improvements
+
+	* freeze.adb: Minor reformatting
+
 2009-05-06  Thomas Quinot  <quinot@adacore.com>
 
 	* sem_ch3.adb (Access_Type_Declaration): An access type whose
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index fdacb09..7d6491b 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -2849,7 +2849,7 @@ package body Freeze is
                              and then Rsiz mod System_Storage_Unit /= 0
                            then
                               --  For implicit packing mode, just set the
-                              --  component size silently
+                              --  component size silently.
 
                               if Implicit_Packing then
                                  Set_Component_Size       (Btyp, Rsiz);
@@ -3245,7 +3245,7 @@ package body Freeze is
          --  later when the full type is frozen).
 
          elsif Ekind (E) = E_Record_Type
-           or else  Ekind (E) = E_Record_Subtype
+           or else Ekind (E) = E_Record_Subtype
          then
             Freeze_Record_Type (E);
 
@@ -3263,7 +3263,6 @@ package body Freeze is
             end if;
 
             Comp := First_Entity (E);
-
             while Present (Comp) loop
                if Is_Type (Comp) then
                   Freeze_And_Append (Comp, Loc, Result);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index aa69a58..89cfbb6 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2986,11 +2986,10 @@ package body Sem_Ch13 is
                Error_Msg_NE
                  ("invalid address clause for initialized object &!",
                   Nod, U_Ent);
-               Error_Msg_Name_1 := Chars (Entity (Nod));
-               Error_Msg_Name_2 := Chars (U_Ent);
-               Error_Msg_N
-                 ("\% must be defined before % (RM 13.1(22))!",
-                  Nod);
+               Error_Msg_Node_2 := U_Ent;
+               Error_Msg_NE
+                 ("\& must be defined before & (RM 13.1(22))!",
+                  Nod, Entity (Nod));
             end if;
 
          elsif Nkind (Nod) = N_Selected_Component then
@@ -3120,11 +3119,10 @@ package body Sem_Ch13 is
                      Error_Msg_NE
                        ("invalid address clause for initialized object &!",
                         Nod, U_Ent);
-                     Error_Msg_Name_1 := Chars (Ent);
-                     Error_Msg_Name_2 := Chars (U_Ent);
-                     Error_Msg_N
-                       ("\% must be defined before % (RM 13.1(22))!",
-                        Nod);
+                     Error_Msg_Node_2 := U_Ent;
+                     Error_Msg_NE
+                       ("\& must be defined before & (RM 13.1(22))!",
+                        Nod, Ent);
                   end if;
 
                elsif Nkind (Original_Node (Nod)) = N_Function_Call then
@@ -3136,10 +3134,9 @@ package body Sem_Ch13 is
                      Nod, U_Ent);
 
                   if Comes_From_Source (Ent) then
-                     Error_Msg_Name_1 := Chars (Ent);
-                     Error_Msg_N
-                       ("\reference to variable% not allowed"
-                          & " (RM 13.1(22))!", Nod);
+                     Error_Msg_NE
+                       ("\reference to variable& not allowed"
+                          & " (RM 13.1(22))!", Nod, Ent);
                   else
                      Error_Msg_N
                        ("non-static expression not allowed"
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 7b41282..9b9f841 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -897,6 +897,33 @@ package body Sem_Ch8 is
                     ("\?suggest using an initialized constant object instead",
                      Nam);
                end if;
+
+               --  If the function call returns an unconstrained type, we
+               --  must build a constrained subtype for the new entity, in
+               --  a way similar to what is done for an object declaration
+               --  with an unconstrained nominal type.
+
+               if Is_Composite_Type (Etype (Nam))
+                 and then not Is_Constrained (Etype (Nam))
+                 and then not Has_Unknown_Discriminants (Etype (Nam))
+                 and then Expander_Active
+               then
+                  declare
+                     Loc  : constant Source_Ptr := Sloc (N);
+                     Subt : constant Entity_Id :=
+                              Make_Defining_Identifier (Loc,
+                                Chars => New_Internal_Name ('T'));
+                  begin
+                     Remove_Side_Effects (Nam);
+                     Insert_Action (N,
+                       Make_Subtype_Declaration (Loc,
+                         Defining_Identifier => Subt,
+                         Subtype_Indication  =>
+                           Make_Subtype_From_Expr (Nam, Etype (Nam))));
+                     Rewrite (Subtype_Mark (N), New_Occurrence_Of (Subt, Loc));
+                     Set_Etype (Nam, Subt);
+                  end;
+               end if;
          end case;
       end if;