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>
PR ada/64349
......
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;
-----------------
......
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
......
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);
......
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;
......
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
......
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
......
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);
......
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