[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Mon, 23 Jan 2012 08:33:32 +0000 (09:33 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Mon, 23 Jan 2012 08:33:32 +0000 (09:33 +0100)
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

gcc/ada/ChangeLog
gcc/ada/a-textio.adb
gcc/ada/errout.adb
gcc/ada/exp_util.adb

index 2e90cfb..0682c64 100644 (file)
@@ -1,3 +1,20 @@
+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
index 721deca..28e5541 100644 (file)
@@ -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;
 
    ---------
index c40179a..5e3bb4a 100644 (file)
@@ -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.
index dd5fc98..41bfa38 100644 (file)
@@ -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));