+2017-11-16 Bob Duff <duff@adacore.com>
+
+ * 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 <msebor@redhat.com>
PR c/81117
-- 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;
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
-- 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;
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,
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));
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 --
----------------------------------
-- 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
projects / thirdparty / gcc.git / commitdiff
