Commit 668a19bc by Ed Schonberg Committed by Arnaud Charlet

inline.adb: proper handling of init_procs.

2011-08-03  Ed Schonberg  <schonberg@adacore.com>

	* inline.adb: proper handling of init_procs.
	* sem_res.adb (Resolve_Op_Concat_Arg): if the argument is an aggregate
	and the component type is composite, this is ambiguous for predefined
	concatenation, but if the node is not overloaded and the entity is a use
	-defined function its profile can be used to resolve that aggregate.

From-SVN: r177254
parent 170b2989
2011-08-03 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Op_Concat_Arg): if the argument is an aggregate
and the component type is composite, this is ambiguous for predefined
concatenation, but if the node is not overloaded and the entity is a use
-defined function its profile can be used to resolve that aggregate.
2011-08-03 Robert Dewar <dewar@adacore.com> 2011-08-03 Robert Dewar <dewar@adacore.com>
* exp_ch4.adb: Minor code cleanup. * exp_ch4.adb: Minor code cleanup.
......
...@@ -344,12 +344,17 @@ package body Inline is ...@@ -344,12 +344,17 @@ package body Inline is
elsif not Is_Inlined (Pack) elsif not Is_Inlined (Pack)
and then and then
(not Has_Completion (E) (not Has_Completion (E)
or else Is_Init_Proc (E)
or else Is_Expression_Function (E)) or else Is_Expression_Function (E))
then then
Set_Is_Inlined (Pack); Set_Is_Inlined (Pack);
Inlined_Bodies.Increment_Last; Inlined_Bodies.Increment_Last;
Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack; Inlined_Bodies.Table (Inlined_Bodies.Last) := Pack;
-- an initialization procedure should be inlined, but it does
-- not require the body of the package.
elsif Is_Init_Proc (E) then
Set_Is_Inlined (Pack);
end if; end if;
end if; end if;
end; end;
......
...@@ -7662,25 +7662,46 @@ package body Sem_Res is ...@@ -7662,25 +7662,46 @@ package body Sem_Res is
Is_Comp : Boolean) Is_Comp : Boolean)
is is
Btyp : constant Entity_Id := Base_Type (Typ); Btyp : constant Entity_Id := Base_Type (Typ);
Ctyp : constant Entity_Id := Component_Type (Typ);
begin begin
if In_Instance then if In_Instance then
if Is_Comp if Is_Comp
or else (not Is_Overloaded (Arg) or else (not Is_Overloaded (Arg)
and then Etype (Arg) /= Any_Composite and then Etype (Arg) /= Any_Composite
and then Covers (Component_Type (Typ), Etype (Arg))) and then Covers (Ctyp, Etype (Arg)))
then then
Resolve (Arg, Component_Type (Typ)); Resolve (Arg, Ctyp);
else else
Resolve (Arg, Btyp); Resolve (Arg, Btyp);
end if; end if;
elsif Has_Compatible_Type (Arg, Component_Type (Typ)) then -- If both Array & Array and Array & Component are visible, there is a
-- potential ambiguity that must be reported.
elsif Has_Compatible_Type (Arg, Ctyp) then
if Nkind (Arg) = N_Aggregate if Nkind (Arg) = N_Aggregate
and then Is_Composite_Type (Component_Type (Typ)) and then Is_Composite_Type (Ctyp)
then then
if Is_Private_Type (Component_Type (Typ)) then if Is_Private_Type (Ctyp) then
Resolve (Arg, Btyp); Resolve (Arg, Btyp);
-- If the operation is user-defined and not overloaded use its
-- profile. The operation may be a renaming, in which case it has
-- been rewritten, and we want the original profile.
elsif not Is_Overloaded (N)
and then Comes_From_Source (Entity (Original_Node (N)))
and then Ekind (Entity (Original_Node (N))) = E_Function
then
Resolve (Arg,
Etype
(Next_Formal (First_Formal (Entity (Original_Node (N))))));
return;
-- Otherwise an aggregate may match both the array type and the
-- component type.
else else
Error_Msg_N ("ambiguous aggregate must be qualified", Arg); Error_Msg_N ("ambiguous aggregate must be qualified", Arg);
Set_Etype (Arg, Any_Type); Set_Etype (Arg, Any_Type);
...@@ -7715,16 +7736,15 @@ package body Sem_Res is ...@@ -7715,16 +7736,15 @@ package body Sem_Res is
Arg, Component_Type (Typ)); Arg, Component_Type (Typ));
else else
Error_Msg_N Error_Msg_N ("ambiguous operand for concatenation!", Arg);
("ambiguous operand for concatenation!", Arg);
Get_First_Interp (Arg, I, It); Get_First_Interp (Arg, I, It);
while Present (It.Nam) loop while Present (It.Nam) loop
Error_Msg_Sloc := Sloc (It.Nam); Error_Msg_Sloc := Sloc (It.Nam);
if Base_Type (It.Typ) = Base_Type (Typ) if Base_Type (It.Typ) = Btyp
or else Base_Type (It.Typ) = or else
Base_Type (Component_Type (Typ)) Base_Type (It.Typ) = Base_Type (Ctyp)
then then
Error_Msg_N -- CODEFIX Error_Msg_N -- CODEFIX
("\\possible interpretation#", Arg); ("\\possible interpretation#", Arg);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment