From b63b3ba91b07d45e4f78cfed264c6845efe1af01 Mon Sep 17 00:00:00 2001 From: charlet Date: Thu, 21 Apr 2016 08:20:59 +0000 Subject: [PATCH] 2016-04-21 Javier Miranda * sem_ch6.adb (Build_Subprogram_Declaration): Propagate the attribute Rewritten_For_C to the body since since the expander may generate calls using that entity. * exp_ch6.adb (Expand_Call): For internally generated calls ensure that they reference the entity of the spec of the called function. (Rewritten_For_C_Func_Id): New subprogram. (Rewritten_For_C_Proc_Id): New subprogram. (Rewrite_Function_Call_For_C): Invoke the new subprogram to ensure that we skip freezing entities. * exp_util.adb (Build_Procedure_Form): No action needed if the procedure was already built. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@235305 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 15 +++++++++ gcc/ada/exp_ch6.adb | 91 ++++++++++++++++++++++++++++++++++++++++++++++++++-- gcc/ada/exp_util.adb | 6 ++++ gcc/ada/sem_ch6.adb | 12 ++++++- 4 files changed, 121 insertions(+), 3 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8ba447ef9d5..d725805d646 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2016-04-21 Javier Miranda + + * sem_ch6.adb (Build_Subprogram_Declaration): Propagate the + attribute Rewritten_For_C to the body since since the expander + may generate calls using that entity. + * exp_ch6.adb (Expand_Call): For internally generated + calls ensure that they reference the entity of the spec + of the called function. + (Rewritten_For_C_Func_Id): New subprogram. + (Rewritten_For_C_Proc_Id): New subprogram. + (Rewrite_Function_Call_For_C): Invoke the new subprogram to + ensure that we skip freezing entities. + * exp_util.adb (Build_Procedure_Form): No action needed if the + procedure was already built. + 2016-04-21 Hristian Kirtchev * sem_ch3.adb, exp_util.adb, sem_ch13.adb, exp_unst.adb: Minor diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index d2cded58a27..d1232543492 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2459,6 +2459,44 @@ package body Exp_Ch6 is end if; end New_Value; + function Rewritten_For_C_Func_Id (Proc_Id : Entity_Id) return Entity_Id; + -- Given the Id of the procedure with an extra out parameter internally + -- built to handle functions that return a constrained array type return + -- the Id of the corresponding function. + + ----------------------------- + -- Rewritten_For_C_Func_Id -- + ----------------------------- + + function Rewritten_For_C_Func_Id (Proc_Id : Entity_Id) return Entity_Id + is + Decl : constant Node_Id := Unit_Declaration_Node (Proc_Id); + Func_Decl : Node_Id; + Func_Id : Entity_Id; + + begin + pragma Assert (Rewritten_For_C (Proc_Id)); + pragma Assert (Nkind (Decl) = N_Subprogram_Body); + + Func_Decl := Nlists.Prev (Decl); + + while Present (Func_Decl) + and then + (Nkind (Func_Decl) = N_Freeze_Entity + or else + Nkind (Func_Decl) /= N_Subprogram_Declaration + or else + Nkind (Specification (Func_Decl)) /= N_Function_Specification) + loop + Func_Decl := Nlists.Prev (Func_Decl); + end loop; + + pragma Assert (Present (Func_Decl)); + Func_Id := Defining_Entity (Specification (Func_Decl)); + pragma Assert (Chars (Proc_Id) = Chars (Func_Id)); + return Func_Id; + end Rewritten_For_C_Func_Id; + -- Local variables Remote : constant Boolean := Is_Remote_Call (Call_Node); @@ -2614,6 +2652,19 @@ package body Exp_Ch6 is and then Is_Entity_Name (Name (Call_Node)) and then Rewritten_For_C (Entity (Name (Call_Node))) then + -- For internally generated calls ensure that they reference the + -- entity of the spec of the called function (needed since the + -- expander may generate calls using the entity of their body). + -- See for example Expand_Boolean_Operator(). + + if not (Comes_From_Source (Call_Node)) + and then Nkind (Unit_Declaration_Node (Entity (Name (Call_Node)))) + = N_Subprogram_Body + then + Set_Entity (Name (Call_Node), + Rewritten_For_C_Func_Id (Entity (Name (Call_Node)))); + end if; + Rewrite_Function_Call_For_C (Call_Node); return; end if; @@ -8301,14 +8352,50 @@ package body Exp_Ch6 is --------------------------------- procedure Rewrite_Function_Call_For_C (N : Node_Id) is + function Rewritten_For_C_Proc_Id (Func_Id : Entity_Id) return Entity_Id; + -- Given the Id of the function that returns a constrained array type + -- return the Id of its internally built procedure with an extra out + -- parameter. + + ----------------------------- + -- Rewritten_For_C_Proc_Id -- + ----------------------------- + + function Rewritten_For_C_Proc_Id (Func_Id : Entity_Id) return Entity_Id + is + Func_Decl : constant Node_Id := Unit_Declaration_Node (Func_Id); + Proc_Decl : Node_Id; + Proc_Id : Entity_Id; + + begin + Proc_Decl := Next (Func_Decl); + + while Present (Proc_Decl) + and then + (Nkind (Proc_Decl) = N_Freeze_Entity + or else + Nkind (Proc_Decl) /= N_Subprogram_Declaration) + loop + Proc_Decl := Next (Proc_Decl); + end loop; + + pragma Assert (Present (Proc_Decl)); + Proc_Id := Defining_Entity (Proc_Decl); + pragma Assert (Chars (Proc_Id) = Chars (Func_Id)); + return Proc_Id; + end Rewritten_For_C_Proc_Id; + + -- Local variables + Func_Id : constant Entity_Id := Entity (Name (N)); - Func_Decl : constant Node_Id := Unit_Declaration_Node (Func_Id); Par : constant Node_Id := Parent (N); - Proc_Id : constant Entity_Id := Defining_Entity (Next (Func_Decl)); + Proc_Id : constant Entity_Id := Rewritten_For_C_Proc_Id (Func_Id); Loc : constant Source_Ptr := Sloc (Par); Actuals : List_Id; Last_Formal : Entity_Id; + -- Start of processing for Rewrite_Function_Call_For_C + begin -- The actuals may be given by named associations, so the added actual -- that is the target of the return value of the call must be a named diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 52f5157e40c..dfc8e883dbd 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -931,6 +931,12 @@ package body Exp_Util is Proc_Formals : List_Id; begin + -- No action needed if this transformation was already done + + if Nkind (Specification (N)) = N_Procedure_Specification then + return; + end if; + Proc_Formals := New_List; -- Create a list of formal parameters with the same types as the diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index c2705170ca1..19a65489bf9 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2016, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -2405,6 +2405,16 @@ package body Sem_Ch6 is Analyze (Subp_Decl); + -- Propagate the attribute Rewritten_For_C to the body since the + -- expander may generate calls using that entity. Required to ensure + -- that Expand_Call rewrites calls to this function by calls to the + -- built procedure. + + if Nkind (Body_Spec) = N_Function_Specification then + Set_Rewritten_For_C (Defining_Entity (Body_Spec), + Rewritten_For_C (Defining_Entity (Specification (Subp_Decl)))); + end if; + -- Analyze any relocated source pragmas or pragmas created for aspect -- specifications. -- 2.11.4.GIT