From 1db700c32b598f2b8cead592036713cbc69c8058 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 30 Jan 2015 16:15:45 +0100 Subject: [PATCH] [multiple changes] 2015-01-30 Gary Dismukes * errout.ads: Minor reformatting. 2015-01-30 Yannick Moy * inline.adb (Process_Formals): Use the sloc of the inlined node instead of the sloc of the actual parameter, when replacing formal parameters by the actual one. 2015-01-30 Arnaud Charlet * g-expect.adb (Get_Command_Output): Use infinite timeout when calling Expect. 2015-01-30 Ed Schonberg * sem_ch12.adb (Analyze_Associations): If an in-parameter is defaulted in an instantiation, add an entry in the list of actuals to indicate the default value of the formal (as is already done for defaulted subprograms). 2015-01-30 Javier Miranda * errout.adb (Error_Msg_PT): Minor error phrasing update. 2015-01-30 Robert Dewar * sem_warn.adb (Warn_On_Known_Condition): Improve error message for object case. 2015-01-30 Pierre-Marie de Rodat * exp_dbug.adb (Get_Encoded_Name): When -fgnat-encodings=minimal, do not generate names for biased types. From-SVN: r220286 --- gcc/ada/ChangeLog | 36 ++++++++++++++++ gcc/ada/errout.adb | 3 +- gcc/ada/errout.ads | 2 +- gcc/ada/exp_dbug.adb | 15 +++---- gcc/ada/g-expect.adb | 4 +- gcc/ada/inline.adb | 6 +-- gcc/ada/sem_ch12.adb | 100 ++++++++++++++++++++++++++----------------- gcc/ada/sem_warn.adb | 4 +- 8 files changed, 112 insertions(+), 58 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2f1b5322e93..8829a1f707b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,39 @@ +2015-01-30 Gary Dismukes + + * errout.ads: Minor reformatting. + +2015-01-30 Yannick Moy + + * inline.adb (Process_Formals): Use the sloc of + the inlined node instead of the sloc of the actual parameter, + when replacing formal parameters by the actual one. + +2015-01-30 Arnaud Charlet + + * g-expect.adb (Get_Command_Output): Use infinite timeout when + calling Expect. + +2015-01-30 Ed Schonberg + + * sem_ch12.adb (Analyze_Associations): If an in-parameter is + defaulted in an instantiation, add an entry in the list of actuals + to indicate the default value of the formal (as is already done + for defaulted subprograms). + +2015-01-30 Javier Miranda + + * errout.adb (Error_Msg_PT): Minor error phrasing update. + +2015-01-30 Robert Dewar + + * sem_warn.adb (Warn_On_Known_Condition): Improve error message + for object case. + +2015-01-30 Pierre-Marie de Rodat + + * exp_dbug.adb (Get_Encoded_Name): When + -fgnat-encodings=minimal, do not generate names for biased types. + 2015-01-30 Tristan Gingold PR ada/64349 diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index d04d132636e..e48956b4218 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -687,7 +687,8 @@ package body Errout is Error_Msg_Sloc := Sloc (Iface_Prim); Error_Msg_N - ("\first formal of & declared # has wrong mode (RM 9.4(11.9))", E); + ("\first formal of & declared # must be of mode `OUT`, `IN OUT` " & + "or access-to-variable", E); end Error_Msg_PT; ----------------- diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 610588048d0..d1892403540 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -851,7 +851,7 @@ package Errout is procedure Error_Msg_PT (E : Entity_Id; Iface_Prim : Entity_Id); -- Posts an error on protected type entry or subprogram E (referencing its -- overridden interface primitive Iface_Prim) indicating wrong mode of the - -- first formal (RM 9.4(11.9/3)) + -- first formal (RM 9.4(11.9/3)). procedure Error_Msg_Ada_2012_Feature (Feature : String; Loc : Source_Ptr); -- If not operating in Ada 2012 mode, posts errors complaining that Feature diff --git a/gcc/ada/exp_dbug.adb b/gcc/ada/exp_dbug.adb index 3ed470a4d91..1a05adb73c9 100644 --- a/gcc/ada/exp_dbug.adb +++ b/gcc/ada/exp_dbug.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -634,15 +634,12 @@ package body Exp_Dbug is Add_Real_To_Buffer (Small_Value (E)); end if; - -- Discrete case where bounds do not match size. Match only biased - -- types when asked to output as little encodings as possible. + -- Discrete case where bounds do not match size. Not necessary if we can + -- emit standard DWARF. - elsif ((GNAT_Encodings /= DWARF_GNAT_Encodings_Minimal - and then Is_Discrete_Type (E)) - or else - (GNAT_Encodings = DWARF_GNAT_Encodings_Minimal - and then Has_Biased_Representation (E))) - and then not Bounds_Match_Size (E) + elsif GNAT_Encodings /= DWARF_GNAT_Encodings_Minimal + and then Is_Discrete_Type (E) + and then not Bounds_Match_Size (E) then declare Lo : constant Node_Id := Type_Low_Bound (E); diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb index 94f80e92263..831d8232fb5 100644 --- a/gcc/ada/g-expect.adb +++ b/gcc/ada/g-expect.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2014, AdaCore -- +-- Copyright (C) 2000-2015, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -927,7 +927,7 @@ package body GNAT.Expect is -- This loop runs until the call to Expect raises Process_Died loop - Expect (Process, Result, ".+"); + Expect (Process, Result, ".+", Timeout => -1); declare NOutput : String_Access; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 438be773d7f..896a5e452a5 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -2248,11 +2248,11 @@ package body Inline is -- analyzed with the full view). if Is_Entity_Name (A) then - Rewrite (N, New_Occurrence_Of (Entity (A), Loc)); + Rewrite (N, New_Occurrence_Of (Entity (A), Sloc (N))); Check_Private_View (N); elsif Nkind (A) = N_Defining_Identifier then - Rewrite (N, New_Occurrence_Of (A, Loc)); + Rewrite (N, New_Occurrence_Of (A, Sloc (N))); Check_Private_View (N); -- Numeric literal diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index b7e9343af32..0d698cffec7 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2015, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -921,7 +921,7 @@ package body Sem_Ch12 is is Actuals_To_Freeze : constant Elist_Id := New_Elmt_List; Assoc : constant List_Id := New_List; - Default_Actuals : constant Elist_Id := New_Elmt_List; + Default_Actuals : constant List_Id := New_List; Gen_Unit : constant Entity_Id := Defining_Entity (Parent (F_Copy)); @@ -1385,16 +1385,34 @@ package body Sem_Ch12 is case Nkind (Formal) is when N_Formal_Object_Declaration => Match := - Matching_Actual ( - Defining_Identifier (Formal), - Defining_Identifier (Analyzed_Formal)); + Matching_Actual + (Defining_Identifier (Formal), + Defining_Identifier (Analyzed_Formal)); if No (Match) and then Partial_Parameterization then Process_Default (Formal); + else Append_List (Instantiate_Object (Formal, Match, Analyzed_Formal), Assoc); + + -- For a defaulted in_parameter, create an entry in the + -- the list of defaulted actuals, for GNATProve use. Do + -- not included these defaults for an instance nested + -- within a generic, because the defaults are also used + -- in the analysis of the enclosing generic, and only + -- defaulted subprograms are relevant there. + + if No (Match) and then not Inside_A_Generic then + Append_To (Default_Actuals, + Make_Generic_Association (Sloc (I_Node), + Selector_Name => + New_Occurrence_Of + (Defining_Identifier (Formal), Sloc (I_Node)), + Explicit_Generic_Actual_Parameter => + New_Copy_Tree (Default_Expression (Formal)))); + end if; end if; -- If the object is a call to an expression function, this @@ -1404,16 +1422,16 @@ package body Sem_Ch12 is and then Present (Entity (Match)) and then Nkind (Original_Node (Unit_Declaration_Node (Entity (Match)))) - = N_Expression_Function + = N_Expression_Function then Append_Elmt (Entity (Match), Actuals_To_Freeze); end if; when N_Formal_Type_Declaration => Match := - Matching_Actual ( - Defining_Identifier (Formal), - Defining_Identifier (Analyzed_Formal)); + Matching_Actual + (Defining_Identifier (Formal), + Defining_Identifier (Analyzed_Formal)); if No (Match) then if Partial_Parameterization then @@ -1474,10 +1492,10 @@ package body Sem_Ch12 is then declare Formal_Ent : constant Entity_Id := - Defining_Identifier (Analyzed_Formal); + Defining_Identifier (Analyzed_Formal); begin if Is_Remote_Access_To_Class_Wide_Type (Entity (Match)) - = Is_Remote_Types (Formal_Ent) + = Is_Remote_Types (Formal_Ent) then -- Remoteness of formal and actual match @@ -1567,12 +1585,22 @@ package body Sem_Ch12 is end if; -- If this is a nested generic, preserve default for later - -- instantiations. + -- instantiations. We do this as well for GNATProve use, + -- so that the list of generic associations is complete. if No (Match) and then Box_Present (Formal) then - Append_Elmt - (Defining_Unit_Name (Specification (Last (Assoc))), - Default_Actuals); + declare + Subp : constant Entity_Id := + Defining_Unit_Name (Specification (Last (Assoc))); + + begin + Append_To (Default_Actuals, + Make_Generic_Association (Sloc (I_Node), + Selector_Name => + New_Occurrence_Of (Subp, Sloc (I_Node)), + Explicit_Generic_Actual_Parameter => + New_Occurrence_Of (Subp, Sloc (I_Node)))); + end; end if; when N_Formal_Package_Declaration => @@ -1667,31 +1695,24 @@ package body Sem_Ch12 is -- explicit associations for them. This is required if the instance -- appears within a generic. - declare - Elmt : Elmt_Id; - Subp : Entity_Id; - New_D : Node_Id; + if not Is_Empty_List (Default_Actuals) then + declare + Default : Node_Id; + + begin + Default := First (Default_Actuals); + while Present (Default) loop + Mark_Rewrite_Insertion (Default); + Next (Default); + end loop; - begin - Elmt := First_Elmt (Default_Actuals); - while Present (Elmt) loop if No (Actuals) then - Actuals := New_List; - Set_Generic_Associations (I_Node, Actuals); - end if; - - Subp := Node (Elmt); - New_D := - Make_Generic_Association (Sloc (Subp), - Selector_Name => - New_Occurrence_Of (Subp, Sloc (Subp)), - Explicit_Generic_Actual_Parameter => - New_Occurrence_Of (Subp, Sloc (Subp))); - Mark_Rewrite_Insertion (New_D); - Append_To (Actuals, New_D); - Next_Elmt (Elmt); - end loop; - end; + Set_Generic_Associations (I_Node, Default_Actuals); + else + Append_List_To (Actuals, Default_Actuals); + end if; + end; + end if; -- If this is a formal package, normalize the parameter list by adding -- explicit box associations for the formals that are covered by an @@ -9455,8 +9476,7 @@ package body Sem_Ch12 is if Present (Formal_Ent) then Find_Matching_Actual (Formal_Node, Actual_Ent); - Match_Formal_Entity - (Formal_Node, Formal_Ent, Actual_Ent); + Match_Formal_Entity (Formal_Node, Formal_Ent, Actual_Ent); -- We iterate at the same time over the actuals of the -- local package created for the formal, to determine diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 355599b0957..56344279c9e 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -3404,7 +3404,7 @@ package body Sem_Warn is and then Nkind (Cond) /= N_Op_Not then Error_Msg_NE - ("object & is always True?c?", + ("object & is always True at this point?c?", Cond, Original_Node (C)); Track (Original_Node (C), Cond); @@ -3420,7 +3420,7 @@ package body Sem_Warn is and then Nkind (Cond) /= N_Op_Not then Error_Msg_NE - ("object & is always False?c?", + ("object & is always False at this point?c?", Cond, Original_Node (C)); Track (Original_Node (C), Cond); -- 2.30.2