From: Arnaud Charlet Date: Thu, 5 Feb 2015 14:35:53 +0000 (+0100) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c7d22ee76f9231727d5e8c38f4f363b6cc7382ff;p=gcc.git [multiple changes] 2015-02-05 Robert Dewar * prj-proc.adb, sem_aux.adb, exp_ch9.adb, errout.adb, prj-dect.adb, prj-nmsc.adb: Minor reformatting. 2015-02-05 Ed Schonberg * 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 * exp_ch3.adb (Make_Tag_Assignment): Do not perform this expansion activity in ASIS mode. From-SVN: r220452 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d9ef29a2ca7..e6402b33b9b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2015-02-05 Robert Dewar + + * prj-proc.adb, sem_aux.adb, exp_ch9.adb, errout.adb, prj-dect.adb, + prj-nmsc.adb: Minor reformatting. + +2015-02-05 Ed Schonberg + + * 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 + + * exp_ch3.adb (Make_Tag_Assignment): Do not perform this + expansion activity in ASIS mode. + 2015-02-05 Javier Miranda * errout.adb (Error_Msg_PT): Add missing error. diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index d79cafa0926..bb8fb0899f5 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -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; diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index f2fd707b282..a8e4137fbda 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -9889,17 +9889,21 @@ 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 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); diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 9d467c31e54..7f26a8cb1fe 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -2639,11 +2639,11 @@ package body Exp_Ch9 is 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); diff --git a/gcc/ada/prj-dect.adb b/gcc/ada/prj-dect.adb index e0f6dcb7944..461bd87f56b 100644 --- a/gcc/ada/prj-dect.adb +++ b/gcc/ada/prj-dect.adb @@ -627,9 +627,8 @@ package body Prj.Dect is -- 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 diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 9c7a8d0c687..7b3d3371c54 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -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); diff --git a/gcc/ada/prj-proc.adb b/gcc/ada/prj-proc.adb index 0107aa0a45e..3bad060b180 100644 --- a/gcc/ada/prj-proc.adb +++ b/gcc/ada/prj-proc.adb @@ -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; diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 09dcc6c6b44..f149cbaaba5 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -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 diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index a985008f51b..d9f4e53aa61 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -954,16 +954,43 @@ package body Sem_Type is -- 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; @@ -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), " "); + 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