From d00301ecf48e655c08ba2554155521c2f5b0e35e Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 16 Nov 2017 09:43:24 +0000 Subject: [PATCH] sem_ch6.adb (Create_Extra_Formals): The type of the BIP_Object_Access formal must not have a designated type that... 2017-11-16 Bob Duff * sem_ch6.adb (Create_Extra_Formals): The type of the BIP_Object_Access formal must not have a designated type that is the full view coming from a limited-with'ed package. * sem_util.adb,sem_util.ads (Incomplete_View_From_Limited_With): New function called from sem_ch6. * sem_ch5.adb (Analyze_Assignment): Treat user-defined concatenation specially for b-i-p cases. From-SVN: r254801 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/sem_ch5.adb | 39 +++++++++++++++++++++++++++++++++++++++ gcc/ada/sem_ch6.adb | 17 +++++++++++------ gcc/ada/sem_util.adb | 34 ++++++++++++++++++++++++++++++++++ gcc/ada/sem_util.ads | 6 ++++++ 5 files changed, 100 insertions(+), 6 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index edf87c37cdf..50b308412a2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2017-11-16 Bob Duff + + * sem_ch6.adb (Create_Extra_Formals): The type of the BIP_Object_Access + formal must not have a designated type that is the full view coming + from a limited-with'ed package. + * sem_util.adb,sem_util.ads (Incomplete_View_From_Limited_With): New + function called from sem_ch6. + * sem_ch5.adb (Analyze_Assignment): Treat user-defined concatenation + specially for b-i-p cases. + 2017-11-10 Martin Sebor PR c/81117 diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 14cf2e5a732..e7fc14983d6 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -552,6 +552,45 @@ package body Sem_Ch5 is -- in-place. if Should_Transform_BIP_Assignment (Typ => T1) then + -- In certain cases involving user-defined concatenation operators, + -- we need to resolve the right-hand side before transforming the + -- assignment. + + case Nkind (Unqual_Conv (Rhs)) is + when N_Function_Call => + declare + Actual : Node_Id := + First (Parameter_Associations (Unqual_Conv (Rhs))); + Actual_Exp : Node_Id; + + begin + while Present (Actual) loop + if Nkind (Actual) = N_Parameter_Association then + Actual_Exp := Explicit_Actual_Parameter (Actual); + else + Actual_Exp := Actual; + end if; + + if Nkind (Actual_Exp) = N_Op_Concat then + Resolve (Rhs, T1); + exit; + end if; + + Next (Actual); + end loop; + end; + + when N_Op + | N_Expanded_Name + | N_Identifier + | N_Attribute_Reference + => + null; + + when others => + raise Program_Error; + end case; + Transform_BIP_Assignment (Typ => T1); end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index a6d70e5b597..764a6f66c88 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -7840,7 +7840,7 @@ package body Sem_Ch6 is if No (First_Extra) then First_Extra := EF; - Set_Extra_Formals (Scope, First_Extra); + Set_Extra_Formals (Scope, EF); end if; if Present (Last_Extra) then @@ -7890,7 +7890,7 @@ package body Sem_Ch6 is -- If Extra_Formals were already created, don't do it again. This -- situation may arise for subprogram types created as part of - -- dispatching calls (see Expand_Dispatching_Call) + -- dispatching calls (see Expand_Dispatching_Call). if Present (Last_Extra) and then Present (Extra_Formal (Last_Extra)) then return; @@ -8028,9 +8028,7 @@ package body Sem_Ch6 is Full_Subt : constant Entity_Id := Available_View (Result_Subt); Formal_Typ : Entity_Id; Subp_Decl : Node_Id; - - Discard : Entity_Id; - pragma Warnings (Off, Discard); + Discard : Entity_Id; begin -- In the case of functions with unconstrained result subtypes, @@ -8094,7 +8092,14 @@ package body Sem_Ch6 is Formal_Typ := Create_Itype (E_Anonymous_Access_Type, E, Scope_Id => Scope (E)); - Set_Directly_Designated_Type (Formal_Typ, Result_Subt); + -- Incomplete_View_From_Limited_With is needed here because + -- gigi gets confused if the designated type is the full view + -- coming from a limited-with'ed package. In the normal case, + -- (no limited with) Incomplete_View_From_Limited_With + -- returns Result_Subt. + + Set_Directly_Designated_Type + (Formal_Typ, Incomplete_View_From_Limited_With (Result_Subt)); Set_Etype (Formal_Typ, Formal_Typ); Set_Depends_On_Private (Formal_Typ, Has_Private_Component (Formal_Typ)); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 102da89e9ca..2050286c96c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12213,6 +12213,40 @@ package body Sem_Util is return Empty; end Incomplete_Or_Partial_View; + --------------------------------------- + -- Incomplete_View_From_Limited_With -- + --------------------------------------- + + function Incomplete_View_From_Limited_With + (Typ : Entity_Id) return Entity_Id is + begin + -- It might make sense to make this an attribute in Einfo, and set it + -- in Sem_Ch10 in Build_Shadow_Entity. However, we're running short on + -- slots for new attributes, and it seems a bit simpler to just search + -- the Limited_View (if it exists) for an incomplete type whose + -- Non_Limited_View is Typ. + + if Ekind (Scope (Typ)) = E_Package + and then Present (Limited_View (Scope (Typ))) + then + declare + Ent : Entity_Id := First_Entity (Limited_View (Scope (Typ))); + begin + while Present (Ent) loop + if Ekind (Ent) in Incomplete_Kind + and then Non_Limited_View (Ent) = Typ + then + return Ent; + end if; + + Ent := Next_Entity (Ent); + end loop; + end; + end if; + + return Typ; + end Incomplete_View_From_Limited_With; + ---------------------------------- -- Indexed_Component_Bit_Offset -- ---------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 9aaa1160ed7..4c2cec59e07 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1425,6 +1425,12 @@ package Sem_Util is -- partial view of the same entity. Note that Id may not have a partial -- view in which case the function returns Empty. + function Incomplete_View_From_Limited_With + (Typ : Entity_Id) return Entity_Id; + -- Typ is a type entity. This normally returns Typ. However, if there is + -- an incomplete view of this entity that comes from a limited-with'ed + -- package, then this returns that incomplete view. + function Indexed_Component_Bit_Offset (N : Node_Id) return Uint; -- Given an N_Indexed_Component node, return the first bit position of the -- component if it is known at compile time. A value of No_Uint means that -- 2.30.2