2013-07-08 Ed Schonberg <schonberg@adacore.com>

	* sem_ch8.adb (Attribute_Renaming): Treat 'Img as an attribute
	that can be renamed as a function.

2013-07-08  Thomas Quinot  <quinot@adacore.com>

	* g-socket.ads: Document target dependency: FIONBIO may or may not
	be inherited from listening socket by accepted socket.

2013-07-08  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Apply_Accessibility_Check): Do not deallocate the object
	on targets that can't deallocate.

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4924539..9f72a45 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,18 @@
+2013-07-08  Ed Schonberg  <schonberg@adacore.com>
+
+       * sem_ch8.adb (Attribute_Renaming): Treat 'Img as an attribute
+       that can be renamed as a function.
+
+2013-07-08  Thomas Quinot  <quinot@adacore.com>
+
+       * g-socket.ads: Document target dependency: FIONBIO may or may not
+       be inherited from listening socket by accepted socket.
+
+2013-07-08  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_ch4.adb (Apply_Accessibility_Check): Do not deallocate the object
+       on targets that can't deallocate.
+
 2013-07-08  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * exp_ch3.adb (Freeze_Type): Generate a

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 9b0fc02..f9c6fd8 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -751,47 +751,66 @@ package body Exp_Ch4 is
 
             Stmts := New_List;
 
-            --  Create an explicit free statement to clean up the allocated
-            --  object in case the accessibility check fails. Generate:
-
-            --    Free (Obj_Ref);
-
-            Free_Stmt := Make_Free_Statement (Loc, New_Copy (Obj_Ref));
-            Set_Storage_Pool (Free_Stmt, Pool_Id);
-
-            Append_To (Stmts, Free_Stmt);
-
-            --  Finalize the object (if applicable), but wrap the call inside
-            --  a block to ensure that the object would still be deallocated in
-            --  case the finalization fails. Generate:
-
-            --    begin
-            --       [Deep_]Finalize (Obj_Ref.all);
-            --    exception
-            --       when others =>
-            --          Free (Obj_Ref);
-            --          raise;
-            --    end;
-
-            if Needs_Finalization (DesigT) then
-               Prepend_To (Stmts,
-                 Make_Block_Statement (Loc,
-                   Handled_Statement_Sequence =>
-                     Make_Handled_Sequence_Of_Statements (Loc,
-                       Statements => New_List (
-                         Make_Final_Call (
-                           Obj_Ref =>
-                             Make_Explicit_Dereference (Loc,
-                               Prefix => New_Copy (Obj_Ref)),
-                           Typ     => DesigT)),
-
-                     Exception_Handlers => New_List (
-                       Make_Exception_Handler (Loc,
-                         Exception_Choices => New_List (
-                           Make_Others_Choice (Loc)),
-                         Statements        => New_List (
-                           New_Copy_Tree (Free_Stmt),
-                           Make_Raise_Statement (Loc)))))));
+            --  If the target does not support allocation/deallocation, simply
+            --  finalize the object (if applicable). Generate:
+
+            --    [Deep_]Finalize (Obj_Ref.all);
+
+            if Restriction_Active (No_Implicit_Heap_Allocations) then
+               if Needs_Finalization (DesigT) then
+                  Append_To (Stmts,
+                    Make_Final_Call (
+                      Obj_Ref =>
+                        Make_Explicit_Dereference (Loc, New_Copy (Obj_Ref)),
+                      Typ     => DesigT));
+               end if;
+
+            --  Finalize (if applicable) and deallocate the object in case the
+            --  accessibility check fails.
+
+            else
+               --  Create an explicit free statement to clean up the allocated
+               --  object in case the accessibility check fails. Generate:
+
+               --    Free (Obj_Ref);
+
+               Free_Stmt := Make_Free_Statement (Loc, New_Copy (Obj_Ref));
+               Set_Storage_Pool (Free_Stmt, Pool_Id);
+
+               Append_To (Stmts, Free_Stmt);
+
+               --  Finalize the object (if applicable), but wrap the call
+               --  inside a block to ensure that the object would still be
+               --  deallocated in case the finalization fails. Generate:
+
+               --    begin
+               --       [Deep_]Finalize (Obj_Ref.all);
+               --    exception
+               --       when others =>
+               --          Free (Obj_Ref);
+               --          raise;
+               --    end;
+
+               if Needs_Finalization (DesigT) then
+                  Prepend_To (Stmts,
+                    Make_Block_Statement (Loc,
+                      Handled_Statement_Sequence =>
+                        Make_Handled_Sequence_Of_Statements (Loc,
+                          Statements => New_List (
+                            Make_Final_Call (
+                              Obj_Ref =>
+                                Make_Explicit_Dereference (Loc,
+                                  Prefix => New_Copy (Obj_Ref)),
+                              Typ     => DesigT)),
+
+                        Exception_Handlers => New_List (
+                          Make_Exception_Handler (Loc,
+                            Exception_Choices => New_List (
+                              Make_Others_Choice (Loc)),
+                            Statements        => New_List (
+                              New_Copy_Tree (Free_Stmt),
+                              Make_Raise_Statement (Loc)))))));
+               end if;
             end if;
 
             --  Signal the accessibility failure through a Program_Error

diff --git a/gcc/ada/g-socket.ads b/gcc/ada/g-socket.ads
index c543707..06add2c 100644 (file)
--- a/gcc/ada/g-socket.ads
+++ b/gcc/ada/g-socket.ads
@@ -816,7 +816,8 @@ package GNAT.Sockets is
    --  connections, creates a new connected socket with mostly the same
    --  properties as Server, and allocates a new socket. The returned Address
    --  is filled in with the address of the connection. Raises Socket_Error on
-   --  error.
+   --  error. Note: if Server is a non-blocking socket, whether or not this
+   --  aspect is inherited by Socket is platform-dependent.
 
    procedure Accept_Socket
      (Server   : Socket_Type;

diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 3ceba77..ef9da82 100644 (file)
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -3318,12 +3318,14 @@ package body Sem_Ch8 is
 
       --  This procedure is called in the context of subprogram renaming, and
       --  thus the attribute must be one that is a subprogram. All of those
-      --  have at least one formal parameter, with the singular exception of
-      --  AST_Entry (which is a real oddity, it is odd that this can be renamed
-      --  at all!)
+      --  have at least one formal parameter, with the exceptions of AST_Entry
+      --  (which is a real oddity, it is odd that this can be renamed at all!)
+      --  and the GNAT attribute 'Img, which GNAT treats as renameable.
 
       if not Is_Non_Empty_List (Parameter_Specifications (Spec)) then
-         if Aname /= Name_AST_Entry then
+         if Aname /= Name_AST_Entry
+           and then Aname /= Name_Img
+         then
             Error_Msg_N
               ("subprogram renaming an attribute must have formals", N);
             return;
@@ -3493,10 +3495,20 @@ package body Sem_Ch8 is
         and then Etype (Nam) /= RTE (RE_AST_Handler)
       then
          declare
-            P : constant Entity_Id := Prefix (Nam);
+            P : constant Node_Id := Prefix (Nam);
 
          begin
-            Find_Type (P);
+            --  The prefix of 'Img is an object that is evaluated for
+            --  each call of the function that renames it.
+
+            if Aname = Name_Img then
+               Preanalyze_And_Resolve (P);
+
+            --  For all other attribute renamings, the prefix is a subtype.
+
+            else
+               Find_Type (P);
+            end if;
 
             if Is_Tagged_Type (Etype (P)) then
                Ensure_Freeze_Node (Etype (P));