diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 17 | ||||
| -rw-r--r-- | gcc/ada/adaint.c | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 37 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 10 |
4 files changed, 64 insertions, 2 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 27f16af..c904bde 100644 --- 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 4820677..cd3f11a3 100644 --- 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 832a3ea..723d459 100644 --- 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 6e02a25..24628bc 100644 --- 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. |