Skip to content

R
riscv-gcc-1
Commit 1db700c3 by Arnaud Charlet
Options

[multiple changes] 

2015-01-30  Gary Dismukes  <dismukes@adacore.com>

	* errout.ads: Minor reformatting.

2015-01-30  Yannick Moy  <moy@adacore.com>

	* 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  <charlet@adacore.com>

	* g-expect.adb (Get_Command_Output): Use infinite timeout when
	calling Expect.

2015-01-30  Ed Schonberg  <schonberg@adacore.com>

	* 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  <miranda@adacore.com>

	* errout.adb (Error_Msg_PT): Minor error phrasing update.

2015-01-30  Robert Dewar  <dewar@adacore.com>

	* sem_warn.adb (Warn_On_Known_Condition): Improve error message
	for object case.

2015-01-30  Pierre-Marie de Rodat  <derodat@adacore.com>

	* exp_dbug.adb (Get_Encoded_Name): When
	-fgnat-encodings=minimal, do not generate names for biased types.

From-SVN: r220286
parent 1de83011
Showing with 112 additions and 58 deletions
gcc/ada/ChangeLog
2015-01-30 Gary Dismukes <dismukes@adacore.com>
* errout.ads: Minor reformatting.
2015-01-30 Yannick Moy <moy@adacore.com>
* 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 <charlet@adacore.com>
* g-expect.adb (Get_Command_Output): Use infinite timeout when
calling Expect.
2015-01-30 Ed Schonberg <schonberg@adacore.com>
* 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 <miranda@adacore.com>
* errout.adb (Error_Msg_PT): Minor error phrasing update.
2015-01-30 Robert Dewar <dewar@adacore.com>
* sem_warn.adb (Warn_On_Known_Condition): Improve error message
for object case.
2015-01-30 Pierre-Marie de Rodat <derodat@adacore.com>
* exp_dbug.adb (Get_Encoded_Name): When
-fgnat-encodings=minimal, do not generate names for biased types.
2015-01-30 Tristan Gingold <gingold@adacore.com> 2015-01-30 Tristan Gingold <gingold@adacore.com>
PR ada/64349 PR ada/64349
......
gcc/ada/errout.adb
...@@ -687,7 +687,8 @@ package body Errout is ...@@ -687,7 +687,8 @@ package body Errout is
Error_Msg_Sloc := Sloc (Iface_Prim); Error_Msg_Sloc := Sloc (Iface_Prim);
Error_Msg_N 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; end Error_Msg_PT;
----------------- -----------------
......
gcc/ada/errout.ads
...@@ -851,7 +851,7 @@ package Errout is ...@@ -851,7 +851,7 @@ package Errout is
procedure Error_Msg_PT (E : Entity_Id; Iface_Prim : Entity_Id); procedure Error_Msg_PT (E : Entity_Id; Iface_Prim : Entity_Id);
-- Posts an error on protected type entry or subprogram E (referencing its -- Posts an error on protected type entry or subprogram E (referencing its
-- overridden interface primitive Iface_Prim) indicating wrong mode of the -- 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); procedure Error_Msg_Ada_2012_Feature (Feature : String; Loc : Source_Ptr);
-- If not operating in Ada 2012 mode, posts errors complaining that Feature -- If not operating in Ada 2012 mode, posts errors complaining that Feature
......
gcc/ada/exp_dbug.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -634,15 +634,12 @@ package body Exp_Dbug is ...@@ -634,15 +634,12 @@ package body Exp_Dbug is
Add_Real_To_Buffer (Small_Value (E)); Add_Real_To_Buffer (Small_Value (E));
end if; end if;
-- Discrete case where bounds do not match size. Match only biased -- Discrete case where bounds do not match size. Not necessary if we can
-- types when asked to output as little encodings as possible. -- emit standard DWARF.
elsif ((GNAT_Encodings /= DWARF_GNAT_Encodings_Minimal elsif GNAT_Encodings /= DWARF_GNAT_Encodings_Minimal
and then Is_Discrete_Type (E)) and then Is_Discrete_Type (E)
or else and then not Bounds_Match_Size (E)
(GNAT_Encodings = DWARF_GNAT_Encodings_Minimal
and then Has_Biased_Representation (E)))
and then not Bounds_Match_Size (E)
then then
declare declare
Lo : constant Node_Id := Type_Low_Bound (E); Lo : constant Node_Id := Type_Low_Bound (E);
......
gcc/ada/g-expect.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -927,7 +927,7 @@ package body GNAT.Expect is ...@@ -927,7 +927,7 @@ package body GNAT.Expect is
-- This loop runs until the call to Expect raises Process_Died -- This loop runs until the call to Expect raises Process_Died
loop loop
Expect (Process, Result, ".+"); Expect (Process, Result, ".+", Timeout => -1);
declare declare
NOutput : String_Access; NOutput : String_Access;
......
gcc/ada/inline.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -2248,11 +2248,11 @@ package body Inline is ...@@ -2248,11 +2248,11 @@ package body Inline is
-- analyzed with the full view). -- analyzed with the full view).
if Is_Entity_Name (A) then 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); Check_Private_View (N);
elsif Nkind (A) = N_Defining_Identifier then 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); Check_Private_View (N);
-- Numeric literal -- Numeric literal
......
gcc/ada/sem_ch12.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -921,7 +921,7 @@ package body Sem_Ch12 is ...@@ -921,7 +921,7 @@ package body Sem_Ch12 is
is is
Actuals_To_Freeze : constant Elist_Id := New_Elmt_List; Actuals_To_Freeze : constant Elist_Id := New_Elmt_List;
Assoc : constant List_Id := New_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 := Gen_Unit : constant Entity_Id :=
Defining_Entity (Parent (F_Copy)); Defining_Entity (Parent (F_Copy));
...@@ -1385,16 +1385,34 @@ package body Sem_Ch12 is ...@@ -1385,16 +1385,34 @@ package body Sem_Ch12 is
case Nkind (Formal) is case Nkind (Formal) is
when N_Formal_Object_Declaration => when N_Formal_Object_Declaration =>
Match := Match :=
Matching_Actual ( Matching_Actual
Defining_Identifier (Formal), (Defining_Identifier (Formal),
Defining_Identifier (Analyzed_Formal)); Defining_Identifier (Analyzed_Formal));
if No (Match) and then Partial_Parameterization then if No (Match) and then Partial_Parameterization then
Process_Default (Formal); Process_Default (Formal);
else else
Append_List Append_List
(Instantiate_Object (Formal, Match, Analyzed_Formal), (Instantiate_Object (Formal, Match, Analyzed_Formal),
Assoc); 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; end if;
-- If the object is a call to an expression function, this -- If the object is a call to an expression function, this
...@@ -1404,16 +1422,16 @@ package body Sem_Ch12 is ...@@ -1404,16 +1422,16 @@ package body Sem_Ch12 is
and then Present (Entity (Match)) and then Present (Entity (Match))
and then Nkind and then Nkind
(Original_Node (Unit_Declaration_Node (Entity (Match)))) (Original_Node (Unit_Declaration_Node (Entity (Match))))
= N_Expression_Function = N_Expression_Function
then then
Append_Elmt (Entity (Match), Actuals_To_Freeze); Append_Elmt (Entity (Match), Actuals_To_Freeze);
end if; end if;
when N_Formal_Type_Declaration => when N_Formal_Type_Declaration =>
Match := Match :=
Matching_Actual ( Matching_Actual
Defining_Identifier (Formal), (Defining_Identifier (Formal),
Defining_Identifier (Analyzed_Formal)); Defining_Identifier (Analyzed_Formal));
if No (Match) then if No (Match) then
if Partial_Parameterization then if Partial_Parameterization then
...@@ -1474,10 +1492,10 @@ package body Sem_Ch12 is ...@@ -1474,10 +1492,10 @@ package body Sem_Ch12 is
then then
declare declare
Formal_Ent : constant Entity_Id := Formal_Ent : constant Entity_Id :=
Defining_Identifier (Analyzed_Formal); Defining_Identifier (Analyzed_Formal);
begin begin
if Is_Remote_Access_To_Class_Wide_Type (Entity (Match)) if Is_Remote_Access_To_Class_Wide_Type (Entity (Match))
= Is_Remote_Types (Formal_Ent) = Is_Remote_Types (Formal_Ent)
then then
-- Remoteness of formal and actual match -- Remoteness of formal and actual match
...@@ -1567,12 +1585,22 @@ package body Sem_Ch12 is ...@@ -1567,12 +1585,22 @@ package body Sem_Ch12 is
end if; end if;
-- If this is a nested generic, preserve default for later -- 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 if No (Match) and then Box_Present (Formal) then
Append_Elmt declare
(Defining_Unit_Name (Specification (Last (Assoc))), Subp : constant Entity_Id :=
Default_Actuals); 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; end if;
when N_Formal_Package_Declaration => when N_Formal_Package_Declaration =>
...@@ -1667,31 +1695,24 @@ package body Sem_Ch12 is ...@@ -1667,31 +1695,24 @@ package body Sem_Ch12 is
-- explicit associations for them. This is required if the instance -- explicit associations for them. This is required if the instance
-- appears within a generic. -- appears within a generic.
declare if not Is_Empty_List (Default_Actuals) then
Elmt : Elmt_Id; declare
Subp : Entity_Id; Default : Node_Id;
New_D : 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 if No (Actuals) then
Actuals := New_List; Set_Generic_Associations (I_Node, Default_Actuals);
Set_Generic_Associations (I_Node, Actuals); else
end if; Append_List_To (Actuals, Default_Actuals);
end if;
Subp := Node (Elmt); end;
New_D := end if;
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;
-- If this is a formal package, normalize the parameter list by adding -- If this is a formal package, normalize the parameter list by adding
-- explicit box associations for the formals that are covered by an -- explicit box associations for the formals that are covered by an
...@@ -9455,8 +9476,7 @@ package body Sem_Ch12 is ...@@ -9455,8 +9476,7 @@ package body Sem_Ch12 is
if Present (Formal_Ent) then if Present (Formal_Ent) then
Find_Matching_Actual (Formal_Node, Actual_Ent); Find_Matching_Actual (Formal_Node, Actual_Ent);
Match_Formal_Entity Match_Formal_Entity (Formal_Node, Formal_Ent, Actual_Ent);
(Formal_Node, Formal_Ent, Actual_Ent);
-- We iterate at the same time over the actuals of the -- We iterate at the same time over the actuals of the
-- local package created for the formal, to determine -- local package created for the formal, to determine
......
gcc/ada/sem_warn.adb
...@@ -3404,7 +3404,7 @@ package body Sem_Warn is ...@@ -3404,7 +3404,7 @@ package body Sem_Warn is
and then Nkind (Cond) /= N_Op_Not and then Nkind (Cond) /= N_Op_Not
then then
Error_Msg_NE Error_Msg_NE
("object & is always True?c?", ("object & is always True at this point?c?",
Cond, Original_Node (C)); Cond, Original_Node (C));
Track (Original_Node (C), Cond); Track (Original_Node (C), Cond);
...@@ -3420,7 +3420,7 @@ package body Sem_Warn is ...@@ -3420,7 +3420,7 @@ package body Sem_Warn is
and then Nkind (Cond) /= N_Op_Not and then Nkind (Cond) /= N_Op_Not
then then
Error_Msg_NE Error_Msg_NE
("object & is always False?c?", ("object & is always False at this point?c?",
Cond, Original_Node (C)); Cond, Original_Node (C));
Track (Original_Node (C), Cond); Track (Original_Node (C), Cond);
......
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