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

	* freeze.adb (Freeze_Record_Type): Improve error msg for bad size
	clause.

2009-05-06  Thomas Quinot  <quinot@adacore.com>

	* g-socthi-vms.adb (C_Recvmsg, C_Sendmsg): Convert Msg to appropriate
	packed type, since on OpenVMS, struct msghdr is packed.

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. Perform this transformation regarless of whether
	call comes from source.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@147159 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 29 insertions, 31 deletions

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 9b9f841679d..42bbd25a710 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -866,42 +866,43 @@ package body Sem_Ch8 is
          end if;
       end if;
 
-      --  Special processing for renaming function return object
+      --  Special processing for renaming function return object. Some errors
+      --  and warnings are produced only for calls that come from source.
 
-      if Nkind (Nam) = N_Function_Call
-        and then Comes_From_Source (Nam)
-      then
+      if Nkind (Nam) = N_Function_Call then
          case Ada_Version is
 
             --  Usage is illegal in Ada 83
 
             when Ada_83 =>
-               Error_Msg_N
-                 ("(Ada 83) cannot rename function return object", Nam);
+               if Comes_From_Source (Nam) then
+                  Error_Msg_N
+                    ("(Ada 83) cannot rename function return object", Nam);
+               end if;
 
             --  In Ada 95, warn for odd case of renaming parameterless function
-            --  call if this is not a limited type (where this is useful)
+            --  call if this is not a limited type (where this is useful).
 
             when others =>
                if Warn_On_Object_Renames_Function
                  and then No (Parameter_Associations (Nam))
                  and then not Is_Limited_Type (Etype (Nam))
+                 and then Comes_From_Source (Nam)
                then
                   Error_Msg_N
-                    ("?renaming function result object is suspicious",
-                     Nam);
+                    ("?renaming function result object is suspicious", Nam);
                   Error_Msg_NE
-                    ("\?function & will be called only once",
-                     Nam, Entity (Name (Nam)));
+                    ("\?function & will be called only once", Nam,
+                     Entity (Name (Nam)));
                   Error_Msg_N
                     ("\?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 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))
@@ -945,6 +946,7 @@ package body Sem_Ch8 is
       then
          Error_Msg_NE ("invalid use of incomplete type&", Id, T2);
          return;
+
       elsif Ekind (Etype (T)) = E_Incomplete_Type then
          Error_Msg_NE ("invalid use of incomplete type&", Id, T);
          return;
@@ -962,8 +964,8 @@ package body Sem_Ch8 is
         and then Nkind (Nam) in N_Has_Entity
       then
          declare
-            Nam_Decl    : Node_Id;
-            Nam_Ent     : Entity_Id;
+            Nam_Decl : Node_Id;
+            Nam_Ent  : Entity_Id;
 
          begin
             if Nkind (Nam) = N_Attribute_Reference then
@@ -972,7 +974,7 @@ package body Sem_Ch8 is
                Nam_Ent := Entity (Nam);
             end if;
 
-            Nam_Decl    := Parent (Nam_Ent);
+            Nam_Decl := Parent (Nam_Ent);
 
             if Has_Null_Exclusion (N)
               and then not Has_Null_Exclusion (Nam_Decl)
@@ -985,7 +987,7 @@ package body Sem_Ch8 is
                --  have a null exclusion or a null-excluding subtype.
 
                if Is_Formal_Object (Nam_Ent)
-                 and then In_Generic_Scope (Id)
+                    and then In_Generic_Scope (Id)
                then
                   if not Can_Never_Be_Null (Etype (Nam_Ent)) then
                      Error_Msg_N
@@ -1012,11 +1014,11 @@ package body Sem_Ch8 is
                --  of the renamed actual in the instance will raise
                --  constraint_error.
 
-               elsif Nkind (Parent (Nam_Ent)) = N_Object_Declaration
+               elsif Nkind (Nam_Decl) = N_Object_Declaration
                  and then In_Instance
                  and then Present
-                   (Corresponding_Generic_Association (Parent (Nam_Ent)))
-                 and then Nkind (Expression (Parent (Nam_Ent)))
+                   (Corresponding_Generic_Association (Nam_Decl))
+                 and then Nkind (Expression (Nam_Decl))
                    = N_Raise_Constraint_Error
                then
                   Error_Msg_N
@@ -1027,7 +1029,7 @@ package body Sem_Ch8 is
                --  must not be null-excluding.
 
                elsif No (Access_Definition (N))
-                 and then  Can_Never_Be_Null (T)
+                 and then Can_Never_Be_Null (T)
                then
                   Error_Msg_NE
                     ("`NOT NULL` not allowed (& already excludes null)",
@@ -1067,8 +1069,6 @@ package body Sem_Ch8 is
          then
             Error_Msg_N
               ("illegal renaming of discriminant-dependent component", Nam);
-         else
-            null;
          end if;
 
       --  A static function call may have been folded into a literal
@@ -1143,8 +1143,7 @@ package body Sem_Ch8 is
          return;
       end if;
 
-      --  Apply Text_IO kludge here, since we may be renaming one of the
-      --  children of Text_IO.
+      --  Apply Text_IO kludge here since we may be renaming a child of Text_IO
 
       Text_IO_Kludge (Name (N));
 
@@ -1162,8 +1161,7 @@ package body Sem_Ch8 is
       end if;
 
       if Etype (Old_P) = Any_Type then
-         Error_Msg_N
-           ("expect package name in renaming", Name (N));
+         Error_Msg_N ("expect package name in renaming", Name (N));
 
       elsif Ekind (Old_P) /= E_Package
         and then not (Ekind (Old_P) = E_Generic_Package
@@ -1400,8 +1398,8 @@ package body Sem_Ch8 is
 
          Inherit_Renamed_Profile (New_S, Old_S);
 
-         --  The prefix can be an arbitrary expression that yields a task
-         --  type, so it must be resolved.
+         --  The prefix can be an arbitrary expression that yields a task type,
+         --  so it must be resolved.
 
          Resolve (Prefix (Nam), Scope (Old_S));
       end if;