+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.
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;
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
New_Ref :=
Make_Selected_Component (Loc,
- Prefix => New_Occurrence_Of (Def_If, Loc),
+ Prefix => New_Occurrence_Of (Def_If, Loc),
Selector_Name =>
New_Occurrence_Of (First_Tag_Component (Full_Typ), Loc));
Set_Assignment_OK (New_Ref);
if Nkind (Parameter_Type (First_Param)) = N_Access_Definition then
Obj_Param_Typ :=
Make_Access_Definition (Loc,
- Subtype_Mark =>
+ Subtype_Mark =>
New_Occurrence_Of (Obj_Typ, Loc),
Null_Exclusion_Present =>
Null_Exclusion_Present (Parameter_Type (First_Param)),
- Constant_Present =>
+ Constant_Present =>
Constant_Present (Parameter_Type (First_Param)));
else
Obj_Param_Typ := New_Occurrence_Of (Obj_Typ, Loc);
-- Look for the package node
while Present (The_Package)
- and then
- Name_Of (The_Package, In_Tree) /=
- Token_Name
+ and then Name_Of (The_Package, In_Tree) /=
+ Token_Name
loop
The_Package :=
Next_Package_In_Project
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 =>
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);
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);
case Current_Term_Kind is
when N_Literal_String =>
-
case Kind is
-
when Undefined =>
-- Should never happen
end case;
when N_Literal_String_List =>
-
declare
String_Node : Project_Node_Id :=
First_Expression_In_List
end;
when N_Variable_Reference | N_Attribute_Reference =>
-
declare
The_Project : Project_Id := Project;
The_Package : Package_Id := Pkg;
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
-- Note: test for presence of E is defense against previous error.
if No (E) then
- Check_Error_Detected;
+
+ -- 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;
+ else
+ Next_Elmt (Elmt);
end if;
-
- Next_Elmt (Elmt);
end loop;
end if;
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), " ");
+ elsif Nkind (N) not in N_Has_Entity then
+ Get_First_Interp (N, I, It);
+ 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_Str ("Overloaded entity ");
- Write_Eol;
- Write_Str (" Name Type Abstract Op");
- Write_Eol;
- Write_Str ("===============================================");
- Write_Eol;
+ Write_Line ("Overloaded entity ");
+ Write_Line (" Name Type Abstract Op");
+ Write_Line ("===============================================");
Nam := It.Nam;
while Present (Nam) loop
projects / gcc.git / commitdiff