[multiple changes]

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.

From-SVN: r147159

gcc/ada/ChangeLog

 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.
+
+2009-05-06  Robert Dewar  <dewar@adacore.com>
+
 	* freeze.adb (Freeze_Record_Type): Implement Implicit_Packing for
 	records
 

gcc/ada/freeze.adb

@@ -1864,9 +1864,8 @@ package body Freeze is
                end;
             end if;
 
-            --  Processing for possible Implicit_Packing later
+            --  Gather data for possible Implicit_Packing later
 
-            if Implicit_Packing then
             if not Is_Scalar_Type (Etype (Comp)) then
                All_Scalar_Components := False;
             else
@@ -1875,7 +1874,6 @@ package body Freeze is
                Scalar_Component_Total_Esize :=
                  Scalar_Component_Total_Esize + Esize (Etype (Comp));
             end if;
-            end if;
 
             --  If the component is an Itype with Delayed_Freeze and is either
             --  a record or array subtype and its base type has not yet been
@@ -2186,16 +2184,34 @@ package body Freeze is
             end;
          end if;
 
-         --  Apply implicit packing if all conditions are met
+         --  See if Implicit_Packing would work
 
-         if Implicit_Packing
+         if not Is_Packed (Rec)
+           and then not Placed_Component
            and then Has_Size_Clause (Rec)
            and then All_Scalar_Components
            and then not Has_Discriminants (Rec)
            and then Esize (Rec) < Scalar_Component_Total_Esize
            and then Esize (Rec) >= Scalar_Component_Total_RM_Size
          then
+            --  If implicit packing enabled, do it
+
+            if Implicit_Packing then
                Set_Is_Packed (Rec);
+
+               --  Otherwise flag the size clause
+
+            else
+               declare
+                  Sz : constant Node_Id := Size_Clause (Rec);
+               begin
+                  Error_Msg_NE
+                    ("size given for& too small", Sz, Rec);
+                  Error_Msg_N
+                    ("\use explicit pragma Pack "
+                     & "or use pragma Implicit_Packing", Sz);
+               end;
+            end if;
          end if;
       end Freeze_Record_Type;
 

gcc/ada/g-socthi-vms.adb

@@ -40,6 +40,11 @@ with Interfaces.C; use Interfaces.C;
 
 package body GNAT.Sockets.Thin is
 
+   type VMS_Msghdr is new Msghdr;
+   pragma Pack (VMS_Msghdr);
+   --  On VMS (unlike other platforms), struct msghdr is packed, so a specific
+   --  derived type is required.
+
    Non_Blocking_Sockets : aliased Fd_Set;
    --  When this package is initialized with Process_Blocking_IO set to True,
    --  sockets are set in non-blocking mode to avoid blocking the whole process
@@ -300,15 +305,21 @@ package body GNAT.Sockets.Thin is
    is
       Res : C.int;
 
+      GNAT_Msg : Msghdr;
+      for GNAT_Msg'Address use Msg;
+      pragma Import (Ada, GNAT_Msg);
+
+      VMS_Msg : aliased VMS_Msghdr := VMS_Msghdr (GNAT_Msg);
    begin
       loop
-         Res := Syscall_Recvmsg (S, Msg, Flags);
+         Res := Syscall_Recvmsg (S, VMS_Msg'Address, Flags);
          exit when SOSC.Thread_Blocking_IO
            or else Res /= Failure
            or else Non_Blocking_Socket (S)
            or else Errno /= SOSC.EWOULDBLOCK;
          delay Quantum;
       end loop;
+      GNAT_Msg := Msghdr (VMS_Msg);
 
       return ssize_t (Res);
    end C_Recvmsg;
@@ -324,15 +335,22 @@ package body GNAT.Sockets.Thin is
    is
       Res : C.int;
 
+      GNAT_Msg : Msghdr;
+      for GNAT_Msg'Address use Msg;
+      pragma Import (Ada, GNAT_Msg);
+
+      VMS_Msg : aliased VMS_Msghdr := VMS_Msghdr (GNAT_Msg);
+
    begin
       loop
-         Res := Syscall_Sendmsg (S, Msg, Flags);
+         Res := Syscall_Sendmsg (S, VMS_Msg'Address, Flags);
          exit when SOSC.Thread_Blocking_IO
            or else Res /= Failure
            or else Non_Blocking_Socket (S)
            or else Errno /= SOSC.EWOULDBLOCK;
          delay Quantum;
       end loop;
+      GNAT_Msg := Msghdr (VMS_Msg);
 
       return ssize_t (Res);
    end C_Sendmsg;

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 =>
+               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;
@@ -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
@@ -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;