Commit d7bab7e6 by Arnaud Charlet

[multiple changes]

2010-10-08  Thomas Quinot  <quinot@adacore.com>

	* sem_ch12.adb (Instantiate_Object): Rename Formal_Id to Gen_Obj, for
	consistency with Gen_T in Instantiate_Type.
	Introduce constant A_Gen_Obj to avoid repeated queries for
	Defining_Identifier (Analyzed_Formal).

2010-10-08  Vincent Celier  <celier@adacore.com>

	* prj-nmsc.adb: Minor comment fix.

From-SVN: r165152
parent 135a0d0a
2010-10-08 Thomas Quinot <quinot@adacore.com>
* sem_ch12.adb (Instantiate_Object): Rename Formal_Id to Gen_Obj, for
consistency with Gen_T in Instantiate_Type.
Introduce constant A_Gen_Obj to avoid repeated queries for
Defining_Identifier (Analyzed_Formal).
2010-10-08 Vincent Celier <celier@adacore.com>
* prj-nmsc.adb: Minor comment fix.
2010-10-07 Robert Dewar <dewar@adacore.com> 2010-10-07 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, sem_ch13.adb: Implement AI05-0012-1/02. * sem_prag.adb, sem_ch13.adb: Implement AI05-0012-1/02.
......
...@@ -3287,7 +3287,7 @@ package body Prj.Nmsc is ...@@ -3287,7 +3287,7 @@ package body Prj.Nmsc is
-- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix, -- Spec_Suffix cannot be equal to Body_Suffix or Separate_Suffix,
-- since that would cause a clear ambiguity. Note that we do allow -- since that would cause a clear ambiguity. Note that we do allow
-- a Spec_Suffix to have the same termination as one of these, -- a Spec_Suffix to have the same termination as one of these,
-- which causes a potential ambiguity, but we resolve that my -- which causes a potential ambiguity, but we resolve that by
-- matching the longest possible suffix. -- matching the longest possible suffix.
if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File if Lang_Id.Config.Naming_Data.Spec_Suffix /= No_File
......
...@@ -8225,17 +8225,18 @@ package body Sem_Ch12 is ...@@ -8225,17 +8225,18 @@ package body Sem_Ch12 is
Actual : Node_Id; Actual : Node_Id;
Analyzed_Formal : Node_Id) return List_Id Analyzed_Formal : Node_Id) return List_Id
is is
Gen_Obj : constant Entity_Id := Defining_Identifier (Formal);
A_Gen_Obj : constant Entity_Id :=
Defining_Identifier (Analyzed_Formal);
Acc_Def : Node_Id := Empty; Acc_Def : Node_Id := Empty;
Act_Assoc : constant Node_Id := Parent (Actual); Act_Assoc : constant Node_Id := Parent (Actual);
Actual_Decl : Node_Id := Empty; Actual_Decl : Node_Id := Empty;
Formal_Id : constant Entity_Id := Defining_Identifier (Formal);
Decl_Node : Node_Id; Decl_Node : Node_Id;
Def : Node_Id; Def : Node_Id;
Ftyp : Entity_Id; Ftyp : Entity_Id;
List : constant List_Id := New_List; List : constant List_Id := New_List;
Loc : constant Source_Ptr := Sloc (Actual); Loc : constant Source_Ptr := Sloc (Actual);
Orig_Ftyp : constant Entity_Id := Orig_Ftyp : constant Entity_Id := Etype (A_Gen_Obj);
Etype (Defining_Identifier (Analyzed_Formal));
Subt_Decl : Node_Id := Empty; Subt_Decl : Node_Id := Empty;
Subt_Mark : Node_Id := Empty; Subt_Mark : Node_Id := Empty;
...@@ -8249,9 +8250,9 @@ package body Sem_Ch12 is ...@@ -8249,9 +8250,9 @@ package body Sem_Ch12 is
-- Sloc for error message on missing actual -- Sloc for error message on missing actual
Error_Msg_Sloc := Sloc (Scope (Defining_Identifier (Analyzed_Formal))); Error_Msg_Sloc := Sloc (Scope (A_Gen_Obj));
if Get_Instance_Of (Formal_Id) /= Formal_Id then if Get_Instance_Of (Gen_Obj) /= Gen_Obj then
Error_Msg_N ("duplicate instantiation of generic parameter", Actual); Error_Msg_N ("duplicate instantiation of generic parameter", Actual);
end if; end if;
...@@ -8272,25 +8273,24 @@ package body Sem_Ch12 is ...@@ -8272,25 +8273,24 @@ package body Sem_Ch12 is
if No (Actual) then if No (Actual) then
Error_Msg_NE Error_Msg_NE
("missing actual&", ("missing actual&",
Instantiation_Node, Formal_Id); Instantiation_Node, Gen_Obj);
Error_Msg_NE Error_Msg_NE
("\in instantiation of & declared#", ("\in instantiation of & declared#",
Instantiation_Node, Instantiation_Node, Scope (A_Gen_Obj));
Scope (Defining_Identifier (Analyzed_Formal)));
Abandon_Instantiation (Instantiation_Node); Abandon_Instantiation (Instantiation_Node);
end if; end if;
if Present (Subt_Mark) then if Present (Subt_Mark) then
Decl_Node := Decl_Node :=
Make_Object_Renaming_Declaration (Loc, Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => New_Copy (Formal_Id), Defining_Identifier => New_Copy (Gen_Obj),
Subtype_Mark => New_Copy_Tree (Subt_Mark), Subtype_Mark => New_Copy_Tree (Subt_Mark),
Name => Actual); Name => Actual);
else pragma Assert (Present (Acc_Def)); else pragma Assert (Present (Acc_Def));
Decl_Node := Decl_Node :=
Make_Object_Renaming_Declaration (Loc, Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => New_Copy (Formal_Id), Defining_Identifier => New_Copy (Gen_Obj),
Access_Definition => New_Copy_Tree (Acc_Def), Access_Definition => New_Copy_Tree (Acc_Def),
Name => Actual); Name => Actual);
end if; end if;
...@@ -8323,11 +8323,10 @@ package body Sem_Ch12 is ...@@ -8323,11 +8323,10 @@ package body Sem_Ch12 is
end if; end if;
-- The actual has to be resolved in order to check that it is a -- The actual has to be resolved in order to check that it is a
-- variable (due to cases such as F(1), where F returns -- variable (due to cases such as F (1), where F returns access to an
-- access to an array, and for overloaded prefixes). -- array, and for overloaded prefixes).
Ftyp := Ftyp := Get_Instance_Of (Etype (A_Gen_Obj));
Get_Instance_Of (Etype (Defining_Identifier (Analyzed_Formal)));
-- If the type of the formal is not itself a formal, and the -- If the type of the formal is not itself a formal, and the
-- current unit is a child unit, the formal type must be declared -- current unit is a child unit, the formal type must be declared
...@@ -8335,12 +8334,11 @@ package body Sem_Ch12 is ...@@ -8335,12 +8334,11 @@ package body Sem_Ch12 is
if Ftyp = Orig_Ftyp if Ftyp = Orig_Ftyp
and then Is_Generic_Unit (Scope (Ftyp)) and then Is_Generic_Unit (Scope (Ftyp))
and then and then Is_Child_Unit (Scope (A_Gen_Obj))
Is_Child_Unit (Scope (Defining_Identifier (Analyzed_Formal)))
then then
declare declare
Temp : constant Node_Id := Temp : constant Node_Id :=
New_Copy_Tree (Subtype_Mark (Analyzed_Formal)); New_Copy_Tree (Subtype_Mark (Analyzed_Formal));
begin begin
Set_Entity (Temp, Empty); Set_Entity (Temp, Empty);
Find_Type (Temp); Find_Type (Temp);
...@@ -8374,7 +8372,7 @@ package body Sem_Ch12 is ...@@ -8374,7 +8372,7 @@ package body Sem_Ch12 is
if not Denotes_Variable (Actual) then if not Denotes_Variable (Actual) then
Error_Msg_NE Error_Msg_NE
("actual for& must be a variable", Actual, Formal_Id); ("actual for& must be a variable", Actual, Gen_Obj);
elsif Base_Type (Ftyp) /= Base_Type (Etype (Actual)) then elsif Base_Type (Ftyp) /= Base_Type (Etype (Actual)) then
...@@ -8391,7 +8389,7 @@ package body Sem_Ch12 is ...@@ -8391,7 +8389,7 @@ package body Sem_Ch12 is
E_Anonymous_Access_Type E_Anonymous_Access_Type
then then
Error_Msg_NE ("type of actual does not match type of&", Error_Msg_NE ("type of actual does not match type of&",
Actual, Formal_Id); Actual, Gen_Obj);
end if; end if;
end if; end if;
...@@ -8430,7 +8428,7 @@ package body Sem_Ch12 is ...@@ -8430,7 +8428,7 @@ package body Sem_Ch12 is
Decl_Node := Decl_Node :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => New_Copy (Formal_Id), Defining_Identifier => New_Copy (Gen_Obj),
Constant_Present => True, Constant_Present => True,
Null_Exclusion_Present => Null_Exclusion_Present (Formal), Null_Exclusion_Present => Null_Exclusion_Present (Formal),
Object_Definition => New_Copy_Tree (Def), Object_Definition => New_Copy_Tree (Def),
...@@ -8441,9 +8439,7 @@ package body Sem_Ch12 is ...@@ -8441,9 +8439,7 @@ package body Sem_Ch12 is
-- A generic formal object of a tagged type is defined to be -- A generic formal object of a tagged type is defined to be
-- aliased so the new constant must also be treated as aliased. -- aliased so the new constant must also be treated as aliased.
if Is_Tagged_Type if Is_Tagged_Type (Etype (A_Gen_Obj)) then
(Etype (Defining_Identifier (Analyzed_Formal)))
then
Set_Aliased_Present (Decl_Node); Set_Aliased_Present (Decl_Node);
end if; end if;
...@@ -8463,11 +8459,8 @@ package body Sem_Ch12 is ...@@ -8463,11 +8459,8 @@ package body Sem_Ch12 is
end if; end if;
declare declare
Formal_Object : constant Entity_Id := Formal_Type : constant Entity_Id := Etype (A_Gen_Obj);
Defining_Identifier (Analyzed_Formal); Typ : Entity_Id;
Formal_Type : constant Entity_Id := Etype (Formal_Object);
Typ : Entity_Id;
begin begin
Typ := Get_Instance_Of (Formal_Type); Typ := Get_Instance_Of (Formal_Type);
...@@ -8504,7 +8497,7 @@ package body Sem_Ch12 is ...@@ -8504,7 +8497,7 @@ package body Sem_Ch12 is
Decl_Node := Decl_Node :=
Make_Object_Declaration (Sloc (Formal), Make_Object_Declaration (Sloc (Formal),
Defining_Identifier => New_Copy (Formal_Id), Defining_Identifier => New_Copy (Gen_Obj),
Constant_Present => True, Constant_Present => True,
Null_Exclusion_Present => Null_Exclusion_Present (Formal), Null_Exclusion_Present => Null_Exclusion_Present (Formal),
Object_Definition => New_Copy (Def), Object_Definition => New_Copy (Def),
...@@ -8517,14 +8510,12 @@ package body Sem_Ch12 is ...@@ -8517,14 +8510,12 @@ package body Sem_Ch12 is
else else
Error_Msg_NE Error_Msg_NE
("missing actual&", ("missing actual&",
Instantiation_Node, Formal_Id); Instantiation_Node, Gen_Obj);
Error_Msg_NE ("\in instantiation of & declared#", Error_Msg_NE ("\in instantiation of & declared#",
Instantiation_Node, Instantiation_Node, Scope (A_Gen_Obj));
Scope (Defining_Identifier (Analyzed_Formal)));
if Is_Scalar_Type (Etype (A_Gen_Obj)) then
if Is_Scalar_Type
(Etype (Defining_Identifier (Analyzed_Formal)))
then
-- Create dummy constant declaration so that instance can be -- Create dummy constant declaration so that instance can be
-- analyzed, to minimize cascaded visibility errors. -- analyzed, to minimize cascaded visibility errors.
...@@ -8536,12 +8527,12 @@ package body Sem_Ch12 is ...@@ -8536,12 +8527,12 @@ package body Sem_Ch12 is
Decl_Node := Decl_Node :=
Make_Object_Declaration (Loc, Make_Object_Declaration (Loc,
Defining_Identifier => New_Copy (Formal_Id), Defining_Identifier => New_Copy (Gen_Obj),
Constant_Present => True, Constant_Present => True,
Null_Exclusion_Present => Null_Exclusion_Present (Formal), Null_Exclusion_Present => Null_Exclusion_Present (Formal),
Object_Definition => New_Copy (Def), Object_Definition => New_Copy (Def),
Expression => Expression =>
Make_Attribute_Reference (Sloc (Formal_Id), Make_Attribute_Reference (Sloc (Gen_Obj),
Attribute_Name => Name_First, Attribute_Name => Name_First,
Prefix => New_Copy (Def))); Prefix => New_Copy (Def)));
......
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