2014-11-20 Javier Miranda <miranda@adacore.com>

	* sem_ch6.adb (Analyze_Function_Return): For functions returning
	an access to an interface add an implicit conversion to the target
	type to force the displacement of the pointer to the object to
	reference the secondary dispatch table.
	(Check_Anonymous_Return): Skip internally built functions which handle
	the case of null access when locating the master of a task.
	* sem_res.adb (Valid_Conversion): Return true for internally
	generated conversions of access to interface types added to force
	the displacement of the pointer to reference the corresponding
	dispatch table.

2014-11-20  Pascal Obry  <obry@adacore.com>

	* adaint.c (add_handle): realloc with a size of +100.

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 27f16af46f3dd05756a37fbe31cb4e91c1bc4c5e..c904bde40c6933c2cab63142dee61e9a48eba7a5 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,20 @@
+2014-11-20  Javier Miranda  <miranda@adacore.com>
+
+       * sem_ch6.adb (Analyze_Function_Return): For functions returning
+       an access to an interface add an implicit conversion to the target
+       type to force the displacement of the pointer to the object to
+       reference the secondary dispatch table.
+       (Check_Anonymous_Return): Skip internally built functions which handle
+       the case of null access when locating the master of a task.
+       * sem_res.adb (Valid_Conversion): Return true for internally
+       generated conversions of access to interface types added to force
+       the displacement of the pointer to reference the corresponding
+       dispatch table.
+
+2014-11-20  Pascal Obry  <obry@adacore.com>
+
+       * adaint.c (add_handle): realloc with a size of +100.
+
 2014-11-20  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_res.adb (Make_Call_Into_Operator): In ASIS mode, propagate

diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 4820677d40dd435992812e210ba4a842024ecb8d..cd3f11a3469d4a24dcc1a0d88e7b1ba6345b8eb7 100644 (file)
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -2339,7 +2339,7 @@ add_handle (HANDLE h, int pid)
 
   if (plist_length == plist_max_length)
     {
-      plist_max_length += 1000;
+      plist_max_length += 100;
       HANDLES_LIST =
         (HANDLE *) xrealloc (HANDLES_LIST, sizeof (HANDLE) * plist_max_length);
       PID_LIST =

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 832a3ea7ab0d63106cbe1b22696223b327bf4899..723d4593cddd9dcb3d31e874e972d70681e33637 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -901,7 +901,35 @@ package body Sem_Ch6 is
                return;
             end if;
 
-            Analyze_And_Resolve (Expr, R_Type);
+            Analyze (Expr);
+
+            --  Ada 2005 (AI-251): If the type of the returned object is
+            --  an access to an interface type then we add an implicit type
+            --  conversion to force the displacement of the "this" pointer to
+            --  reference the secondary dispatch table. We cannot delay the
+            --  generation of this implicit conversion until the expansion
+            --  because in this case the type resolution changes the decoration
+            --  of the expression node to match R_Type; by contrast, if the
+            --  returned object is a class-wide interface type then it is too
+            --  early to generate here the implicit conversion since the return
+            --  statement may be rewritten by the expander into an extended
+            --  return statement whose expansion takes care of adding the
+            --  implicit type conversion to displace the pointer to the object.
+
+            if Expander_Active
+              and then Serious_Errors_Detected = 0
+              and then Is_Access_Type (R_Type)
+              and then Nkind (Expr) /= N_Null
+              and then Is_Interface (Designated_Type (R_Type))
+              and then Is_Progenitor (Designated_Type (R_Type),
+                                      Designated_Type (Etype (Expr)))
+            then
+               Rewrite (Expr,
+                 Convert_To (R_Type, Relocate_Node (Expr)));
+               Analyze (Expr);
+            end if;
+
+            Resolve (Expr, R_Type);
             Check_Limited_Return (Expr);
          end if;
 
@@ -2512,6 +2540,13 @@ package body Sem_Ch6 is
          if Ekind (Scop) = E_Function
            and then Ekind (Etype (Scop)) = E_Anonymous_Access_Type
            and then not Is_Thunk (Scop)
+
+            --  Skip internally built functions which handle the case of
+            --  a null access (see Expand_Interface_Conversion)
+
+           and then not (Is_Interface (Designated_Type (Etype (Scop)))
+                           and then not Comes_From_Source (Parent (Scop)))
+
            and then (Has_Task (Designated_Type (Etype (Scop)))
                       or else
                        (Is_Class_Wide_Type (Designated_Type (Etype (Scop)))

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 6e02a2583f01fd93c94a74a5dc52ae3dd66cd453..24628bc2edfa8347459f2bbc21a3688e77265b45 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -12047,6 +12047,16 @@ package body Sem_Res is
             return Valid_Array_Conversion;
          end if;
 
+      --  Ada 2005 (AI-251): Internally generated conversions of access to
+      --  interface types added to force the displacement of the pointer to
+      --  reference the corresponding dispatch table.
+
+      elsif not Comes_From_Source (N)
+         and then Is_Access_Type (Target_Type)
+         and then Is_Interface (Designated_Type (Target_Type))
+      then
+         return True;
+
       --  Ada 2005 (AI-251): Anonymous access types where target references an
       --  interface type.