Commit c7d22ee7 by Arnaud Charlet

[multiple changes]

2015-02-05  Robert Dewar  <dewar@adacore.com>

	* prj-proc.adb, sem_aux.adb, exp_ch9.adb, errout.adb, prj-dect.adb,
	prj-nmsc.adb: Minor reformatting.

2015-02-05  Ed Schonberg  <schonberg@adacore.com>

	* sem_type.adb (Covers): In ASIS_Mode the Corresponding_Record
	of a protected type may not be available, so to check conformance
	with an interface type, examine the interface list in the type
	declaration directly.
	(Write_Overloads): Improve information for indirect calls,
	for debugger use.

2015-02-05  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch3.adb (Make_Tag_Assignment): Do not perform this
	expansion activity in ASIS mode.

From-SVN: r220452
parent 273123a4
2015-02-05 Robert Dewar <dewar@adacore.com>
* prj-proc.adb, sem_aux.adb, exp_ch9.adb, errout.adb, prj-dect.adb,
prj-nmsc.adb: Minor reformatting.
2015-02-05 Ed Schonberg <schonberg@adacore.com>
* sem_type.adb (Covers): In ASIS_Mode the Corresponding_Record
of a protected type may not be available, so to check conformance
with an interface type, examine the interface list in the type
declaration directly.
(Write_Overloads): Improve information for indirect calls,
for debugger use.
2015-02-05 Ed Schonberg <schonberg@adacore.com>
* exp_ch3.adb (Make_Tag_Assignment): Do not perform this
expansion activity in ASIS mode.
2015-02-05 Javier Miranda <miranda@adacore.com>
* errout.adb (Error_Msg_PT): Add missing error.
......
......@@ -689,12 +689,12 @@ package body Errout is
if Ekind (E) = E_Function then
Error_Msg_N
("\first formal of & declared # must be of mode `IN` " &
"or access-to-constant", E);
("\first formal of & declared # must be of mode `IN` "
& "or access-to-constant", E);
else
Error_Msg_N
("\first formal of & declared # must be of mode `OUT`, `IN OUT` " &
"or access-to-variable", E);
("\first formal of & declared # must be of mode `OUT`, `IN OUT` "
& "or access-to-variable", E);
end if;
end Error_Msg_PT;
......
......@@ -9889,11 +9889,15 @@ package body Exp_Ch3 is
New_Ref : Node_Id;
begin
-- This expansion activity is called during analysis, but cannot
-- be applied in ASIS mode when other expansion is disabled.
if Is_Tagged_Type (Typ)
and then not Is_Class_Wide_Type (Typ)
and then not Is_CPP_Class (Typ)
and then Tagged_Type_Expansion
and then Nkind (Expr) /= N_Aggregate
and then not ASIS_Mode
and then (Nkind (Expr) /= N_Qualified_Expression
or else Nkind (Expression (Expr)) /= N_Aggregate)
then
......
......@@ -627,8 +627,7 @@ package body Prj.Dect is
-- Look for the package node
while Present (The_Package)
and then
Name_Of (The_Package, In_Tree) /=
and then Name_Of (The_Package, In_Tree) /=
Token_Name
loop
The_Package :=
......
......@@ -1803,9 +1803,9 @@ package body Prj.Nmsc is
Lang_Index := Get_Language_From_Name
(Project, Get_Name_String (Element.Index));
if Lang_Index /= No_Language_Index and then
Element.Value.Kind = Single and then
Element.Value.Value /= No_Name
if Lang_Index /= No_Language_Index
and then Element.Value.Kind = Single
and then Element.Value.Value /= No_Name
then
case Current_Array.Name is
when Name_Spec_Suffix | Name_Specification_Suffix =>
......@@ -4290,8 +4290,8 @@ package body Prj.Nmsc is
Shared => Shared);
end if;
if Suffix /= Nil_Variable_Value and then
Suffix.Value /= No_Name
if Suffix /= Nil_Variable_Value
and then Suffix.Value /= No_Name
then
Lang_Id.Config.Naming_Data.Spec_Suffix :=
File_Name_Type (Suffix.Value);
......@@ -4325,8 +4325,8 @@ package body Prj.Nmsc is
Shared => Shared);
end if;
if Suffix /= Nil_Variable_Value and then
Suffix.Value /= No_Name
if Suffix /= Nil_Variable_Value
and then Suffix.Value /= No_Name
then
Lang_Id.Config.Naming_Data.Body_Suffix :=
File_Name_Type (Suffix.Value);
......
......@@ -547,9 +547,7 @@ package body Prj.Proc is
case Current_Term_Kind is
when N_Literal_String =>
case Kind is
when Undefined =>
-- Should never happen
......@@ -602,7 +600,6 @@ package body Prj.Proc is
end case;
when N_Literal_String_List =>
declare
String_Node : Project_Node_Id :=
First_Expression_In_List
......@@ -697,7 +694,6 @@ package body Prj.Proc is
end;
when N_Variable_Reference | N_Attribute_Reference =>
declare
The_Project : Project_Id := Project;
The_Package : Package_Id := Pkg;
......
......@@ -981,6 +981,11 @@ package body Sem_Aux is
if Is_Type (Ent)
and then Base_Type (Ent) /= Root_Type (Ent)
and then not Is_Class_Wide_Type (Ent)
-- An access_to_subprogram whose result type is a limited view can
-- appear in a return statement, without the full view of the result
-- type being available. Do not interpret this as a derived type.
and then Ekind (Ent) /= E_Subprogram_Type
then
if not Is_Numeric_Type (Root_Type (Ent)) then
......
......@@ -954,16 +954,43 @@ package body Sem_Type is
-- Note: test for presence of E is defense against previous error.
if No (E) then
-- If expansion is disabled the Corresponding_Record_Type may
-- not be available yet, so use the interface list in the
-- declaration directly.
if ASIS_Mode
and then Nkind (Parent (BT2)) = N_Protected_Type_Declaration
and then Present (Interface_List (Parent (BT2)))
then
declare
Intf : Node_Id := First (Interface_List (Parent (BT2)));
begin
while Present (Intf) loop
if Is_Ancestor (Etype (T1), Entity (Intf)) then
return True;
else
Next (Intf);
end if;
end loop;
end;
return False;
else
Check_Error_Detected;
end if;
-- Here we have a corresponding record type
elsif Present (Interfaces (E)) then
Elmt := First_Elmt (Interfaces (E));
while Present (Elmt) loop
if Is_Ancestor (Etype (T1), Node (Elmt)) then
return True;
end if;
else
Next_Elmt (Elmt);
end if;
end loop;
end if;
......@@ -3499,23 +3526,25 @@ package body Sem_Type is
Write_Str ("Overloads: ");
Print_Node_Briefly (N);
if Nkind (N) not in N_Has_Entity then
return;
end if;
if not Is_Overloaded (N) then
Write_Str ("Non-overloaded entity ");
Write_Eol;
Write_Line ("Non-overloaded entity ");
Write_Entity_Info (Entity (N), " ");
else
elsif Nkind (N) not in N_Has_Entity then
Get_First_Interp (N, I, It);
Write_Str ("Overloaded entity ");
Write_Eol;
Write_Str (" Name Type Abstract Op");
Write_Eol;
Write_Str ("===============================================");
while Present (It.Nam) loop
Write_Int (Int (It.Typ));
Write_Str (" ");
Write_Name (Chars (It.Typ));
Write_Eol;
Get_Next_Interp (I, It);
end loop;
else
Get_First_Interp (N, I, It);
Write_Line ("Overloaded entity ");
Write_Line (" Name Type Abstract Op");
Write_Line ("===============================================");
Nam := It.Nam;
while Present (Nam) loop
......
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