Skip to content

R
riscv-gcc-1
Commit 022d9ce8 by Arnaud Charlet
Options

[multiple changes] 

2012-01-23  Gary Dismukes  <dismukes@adacore.com>

	* exp_util.adb (Is_Iterated_Container): Test
	Is_Entity_Name when searching for calls to the default iterator,
	to avoid blowing up on indirect calls which have an explicit
	dereference as the call name.

2012-01-23  Thomas Quinot  <quinot@adacore.com>

	* errout.adb (Set_Msg_Node): For an N_Expanded_Name, output
	the complete expanded name, rather than just its Selector_Name.

2012-01-23  Thomas Quinot  <quinot@adacore.com>

	* a-textio.adb (Put): Rewrite one-parameter Character version to
	just call the two-parameter one with Current_Out.

From-SVN: r183408
parent e1308fa8
Showing with 48 additions and 46 deletions
gcc/ada/ChangeLog
2012-01-23 Gary Dismukes <dismukes@adacore.com>
* exp_util.adb (Is_Iterated_Container): Test
Is_Entity_Name when searching for calls to the default iterator,
to avoid blowing up on indirect calls which have an explicit
dereference as the call name.
2012-01-23 Thomas Quinot <quinot@adacore.com>
* errout.adb (Set_Msg_Node): For an N_Expanded_Name, output
the complete expanded name, rather than just its Selector_Name.
2012-01-23 Thomas Quinot <quinot@adacore.com>
* a-textio.adb (Put): Rewrite one-parameter Character version to
just call the two-parameter one with Current_Out.
2012-01-23 Hristian Kirtchev <kirtchev@adacore.com>
* freeze.adb (Check_Current_Instance): Issue an
......
gcc/ada/a-textio.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -1274,30 +1274,7 @@ package body Ada.Text_IO is
procedure Put (Item : Character) is
begin
FIO.Check_Write_Status (AP (Current_Out));
if Current_Out.Line_Length /= 0
and then Current_Out.Col > Current_Out.Line_Length
then
New_Line (Current_Out);
end if;
-- If lower half character, or brackets encoding, output directly
if Character'Pos (Item) < 16#80#
or else Default_WCEM = WCEM_Brackets
then
if fputc (Character'Pos (Item), Current_Out.Stream) = EOF then
raise Device_Error;
end if;
-- Case of upper half character with non-brackets encoding
else
Put_Encoded (Current_Out, Item);
end if;
Current_Out.Col := Current_Out.Col + 1;
Put (Current_Out, Item);
end Put;
---------
......
gcc/ada/errout.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -144,7 +144,9 @@ package body Errout is
procedure Set_Msg_Node (Node : Node_Id);
-- Add the sequence of characters for the name associated with the
-- given node to the current message.
-- given node to the current message. For N_Designator, N_Defining_Program_
-- Unit_Name, N_Selected_Component, and N_Expanded_Name, the Prefix is
-- included as well.
procedure Set_Msg_Text (Text : String; Flag : Source_Ptr);
-- Add a sequence of characters to the current message. The characters may
......@@ -2499,24 +2501,28 @@ package body Errout is
Nam : Name_Id;
begin
if Nkind (Node) = N_Designator then
Set_Msg_Node (Name (Node));
Set_Msg_Char ('.');
Set_Msg_Node (Identifier (Node));
return;
case Nkind (Node) is
when N_Designator =>
Set_Msg_Node (Name (Node));
Set_Msg_Char ('.');
Set_Msg_Node (Identifier (Node));
return;
elsif Nkind (Node) = N_Defining_Program_Unit_Name then
Set_Msg_Node (Name (Node));
Set_Msg_Char ('.');
Set_Msg_Node (Defining_Identifier (Node));
return;
when N_Defining_Program_Unit_Name =>
Set_Msg_Node (Name (Node));
Set_Msg_Char ('.');
Set_Msg_Node (Defining_Identifier (Node));
return;
elsif Nkind (Node) = N_Selected_Component then
Set_Msg_Node (Prefix (Node));
Set_Msg_Char ('.');
Set_Msg_Node (Selector_Name (Node));
return;
end if;
when N_Selected_Component | N_Expanded_Name =>
Set_Msg_Node (Prefix (Node));
Set_Msg_Char ('.');
Set_Msg_Node (Selector_Name (Node));
return;
when others =>
null;
end case;
-- The only remaining possibilities are identifiers, defining
-- identifiers, pragmas, and pragma argument associations.
......
gcc/ada/exp_util.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -4249,9 +4249,11 @@ package body Exp_Util is
-- The call must invoke the default iterate routine of
-- the container and the transient object must appear as
-- the first actual parameter.
-- the first actual parameter. Skip any calls whose names
-- are not entities.
if Entity (Name (Call)) = Iter
if Is_Entity_Name (Name (Call))
and then Entity (Name (Call)) = Iter
and then Present (Parameter_Associations (Call))
then
Param := First (Parameter_Associations (Call));
......
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