[multiple changes]

2014-02-24  Robert Dewar  <dewar@adacore.com>

	* a-tags.adb, s-os_lib.adb: Minor reformatting.

2014-02-24  Thomas Quinot  <quinot@adacore.com>

	* g-sercom-mingw.adb, g-sercom-linux.adb (Raise_Error): Include
	strerror message, not just numeric errno value.

2014-02-24  Doug Rupp  <rupp@adacore.com>

	* raise-gcc.c (exception_class_eq): Make endian neutral.

2014-02-24  Ed Schonberg  <schonberg@adacore.com>

	* atree.ads, atree,adb (Copy_Separate_Tree): Remove Syntax_Only
	flag, and reset Etype and Analyzed attributes unconditionally
	when copying a tree that may be partly analyzed.
	* freeze.adb: Change calls to Copy_Separate_Tree accordingly.
	* sem_ch6.adb (Check_Inline_Pragma): If the Inline pragma appears
	within a subprogram body and applies to it, remove it from the
	body before making a copy of it, to prevent spurious errors when
	analyzing the copied body.

From-SVN: r208086

10 files changed, 117 insertions, 110 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 26865cf..dabca59 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2014-02-24  Robert Dewar  <dewar@adacore.com>
+
+	* a-tags.adb, s-os_lib.adb: Minor reformatting.
+
+2014-02-24  Thomas Quinot  <quinot@adacore.com>
+
+	* g-sercom-mingw.adb, g-sercom-linux.adb (Raise_Error): Include
+	strerror message, not just numeric errno value.
+
+2014-02-24  Doug Rupp  <rupp@adacore.com>
+
+	* raise-gcc.c (exception_class_eq): Make endian neutral.
+
+2014-02-24  Ed Schonberg  <schonberg@adacore.com>
+
+	* atree.ads, atree,adb (Copy_Separate_Tree): Remove Syntax_Only
+	flag, and reset Etype and Analyzed attributes unconditionally
+	when copying a tree that may be partly analyzed.
+	* freeze.adb: Change calls to Copy_Separate_Tree accordingly.
+	* sem_ch6.adb (Check_Inline_Pragma): If the Inline pragma appears
+	within a subprogram body and applies to it, remove it from the
+	body before making a copy of it, to prevent spurious errors when
+	analyzing the copied body.
+
 2014-02-24  Thomas Quinot  <quinot@adacore.com>
 
 	* s-os_lib.adb (Errno_Message): Do not depend on Integer'Image.
diff --git a/gcc/ada/a-tags.adb b/gcc/ada/a-tags.adb
index 8e19d83..e60ef19 100644
--- a/gcc/ada/a-tags.adb
+++ b/gcc/ada/a-tags.adb
@@ -31,6 +31,7 @@
 
 with Ada.Exceptions;
 with Ada.Unchecked_Conversion;
+
 with System.HTable;
 with System.Storage_Elements; use System.Storage_Elements;
 with System.WCh_Con;          use System.WCh_Con;
@@ -58,7 +59,8 @@ package body Ada.Tags is
 
    function Length (Str : Cstring_Ptr) return Natural;
    --  Length of string represented by the given pointer (treating the string
-   --  as a C-style string, which is Nul terminated).
+   --  as a C-style string, which is Nul terminated). See comment in body
+   --  explaining why we cannot use the normal strlen built-in.
 
    function OSD (T : Tag) return Object_Specific_Data_Ptr;
    --  Ada 2005 (AI-251): Given a pointer T to a secondary dispatch table,
@@ -179,7 +181,7 @@ package body Ada.Tags is
 
    function OSD (T : Tag) return Object_Specific_Data_Ptr is
       OSD_Ptr : constant Addr_Ptr :=
-        To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+                  To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
    begin
       return To_Object_Specific_Data_Ptr (OSD_Ptr.all);
    end OSD;
@@ -190,9 +192,9 @@ package body Ada.Tags is
 
    function SSD (T : Tag) return Select_Specific_Data_Ptr is
       TSD_Ptr : constant Addr_Ptr :=
-        To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+                  To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
       TSD     : constant Type_Specific_Data_Ptr :=
-        To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+                  To_Type_Specific_Data_Ptr (TSD_Ptr.all);
    begin
       return TSD.SSD;
    end SSD;
@@ -241,8 +243,9 @@ package body Ada.Tags is
       function Equal (A, B : System.Address) return Boolean is
          Str1 : constant Cstring_Ptr := To_Cstring_Ptr (A);
          Str2 : constant Cstring_Ptr := To_Cstring_Ptr (B);
-         J    : Integer := 1;
+         J    : Integer;
       begin
+         J := 1;
          loop
             if Str1 (J) /= Str2 (J) then
                return False;
@@ -260,9 +263,9 @@ package body Ada.Tags is
 
       function Get_HT_Link (T : Tag) return Tag is
          TSD_Ptr : constant Addr_Ptr :=
-           To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+                     To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
          TSD     : constant Type_Specific_Data_Ptr :=
-           To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+                     To_Type_Specific_Data_Ptr (TSD_Ptr.all);
       begin
          return TSD.HT_Link.all;
       end Get_HT_Link;
@@ -285,9 +288,9 @@ package body Ada.Tags is
 
       procedure Set_HT_Link (T : Tag; Next : Tag) is
          TSD_Ptr : constant Addr_Ptr :=
-           To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+                     To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
          TSD     : constant Type_Specific_Data_Ptr :=
-           To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+                     To_Type_Specific_Data_Ptr (TSD_Ptr.all);
       begin
          TSD.HT_Link.all := Next;
       end Set_HT_Link;
@@ -357,10 +360,7 @@ package body Ada.Tags is
    -- Displace --
    --------------
 
-   function Displace
-     (This : System.Address;
-      T    : Tag) return System.Address
-   is
+   function Displace (This : System.Address; T : Tag) return System.Address is
       Iface_Table : Interface_Data_Ptr;
       Obj_Base    : System.Address;
       Obj_DT      : Dispatch_Table_Ptr;
@@ -418,7 +418,7 @@ package body Ada.Tags is
 
    function DT (T : Tag) return Dispatch_Table_Ptr is
       Offset : constant SSE.Storage_Offset :=
-        To_Dispatch_Table_Ptr (T).Prims_Ptr'Position;
+                 To_Dispatch_Table_Ptr (T).Prims_Ptr'Position;
    begin
       return To_Dispatch_Table_Ptr (To_Address (T) - Offset);
    end DT;
@@ -561,9 +561,9 @@ package body Ada.Tags is
 
    function Interface_Ancestor_Tags (T : Tag) return Tag_Array is
       TSD_Ptr     : constant Addr_Ptr :=
-        To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+                      To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
       TSD         : constant Type_Specific_Data_Ptr :=
-        To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+                      To_Type_Specific_Data_Ptr (TSD_Ptr.all);
       Iface_Table : constant Interface_Data_Ptr := TSD.Interfaces_Table;
 
    begin
@@ -573,6 +573,7 @@ package body Ada.Tags is
          begin
             return Table;
          end;
+
       else
          declare
             Table : Tag_Array (1 .. Iface_Table.Nb_Ifaces);
@@ -605,13 +606,13 @@ package body Ada.Tags is
 
       if External'Length > Internal_Tag_Header'Length
         and then
-         External (External'First ..
-                     External'First + Internal_Tag_Header'Length - 1)
-           = Internal_Tag_Header
+          External (External'First ..
+                      External'First + Internal_Tag_Header'Length - 1) =
+                                                        Internal_Tag_Header
       then
          declare
             Addr_First : constant Natural :=
-              External'First + Internal_Tag_Header'Length;
+                           External'First + Internal_Tag_Header'Length;
             Addr_Last  : Natural;
             Addr       : Integer_Address;
 
@@ -783,9 +784,9 @@ package body Ada.Tags is
 
    function Needs_Finalization (T : Tag) return Boolean is
       TSD_Ptr : constant Addr_Ptr :=
-        To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+                  To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
       TSD     : constant Type_Specific_Data_Ptr :=
-        To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+                  To_Type_Specific_Data_Ptr (TSD_Ptr.all);
    begin
       return TSD.Needs_Finalization;
    end Needs_Finalization;
@@ -803,9 +804,9 @@ package body Ada.Tags is
       --  ancestor tags.
 
       TSD_Ptr : constant Addr_Ptr :=
-        To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
+                  To_Addr_Ptr (To_Address (T) - DT_Typeinfo_Ptr_Size);
       TSD     : constant Type_Specific_Data_Ptr :=
-        To_Type_Specific_Data_Ptr (TSD_Ptr.all);
+                  To_Type_Specific_Data_Ptr (TSD_Ptr.all);
       --  Pointer to the TSD
 
       Parent_Tag     : constant Tag := TSD.Tags_Table (Parent_Slot);
@@ -961,6 +962,7 @@ package body Ada.Tags is
    is
       Sec_Base : System.Address;
       Sec_DT   : Dispatch_Table_Ptr;
+
    begin
       --  Save the offset to top field in the secondary dispatch table
 
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 8b0ef2b..1e4e251 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -772,9 +772,7 @@ package body Atree is
    -- Copy_Separate_Tree --
    ------------------------
 
-   function Copy_Separate_Tree
-     (Source      : Node_Id;
-      Syntax_Only : Boolean := False) return Node_Id
+   function Copy_Separate_Tree (Source : Node_Id) return Node_Id
    is
       New_Id  : Node_Id;
 
@@ -796,9 +794,7 @@ package body Atree is
          New_Ent : Entity_Id;
 
       begin
-         --  Build appropriate node. Note that in this case, we do not need to
-         --  do any special casing for Syntax_Only, since the new node has no
-         --  Etype set, and is always unanalyzed.
+         --  Build appropriate node.
 
          case N_Entity (Nkind (E)) is
             when N_Defining_Identifier =>
@@ -835,7 +831,7 @@ package body Atree is
                if Has_Extension (E) then
                   Append (Copy_Entity (E), NL);
                else
-                  Append (Copy_Separate_Tree (E, Syntax_Only), NL);
+                  Append (Copy_Separate_Tree (E), NL);
                end if;
 
                Next (E);
@@ -855,7 +851,7 @@ package body Atree is
       begin
          if Field in Node_Range then
             New_N :=
-              Union_Id (Copy_Separate_Tree (Node_Id (Field), Syntax_Only));
+              Union_Id (Copy_Separate_Tree (Node_Id (Field)));
 
             if Parent (Node_Id (Field)) = Source then
                Set_Parent (Node_Id (New_N), New_Id);
@@ -906,45 +902,40 @@ package body Atree is
             Set_Entity (New_Id, Empty);
          end if;
 
-         --  This is the point at which we do the special processing for
-         --  the Syntax_Only flag being set:
+         --  Reset all Etype fields and Analyzed flags, because tree may
+         --  have been partly analyzed.
 
-         if Syntax_Only then
-
-            --  Reset all Etype fields and Analyzed flags
-
-            if Nkind (New_Id) in N_Has_Etype then
-               Set_Etype (New_Id, Empty);
-            end if;
+         if Nkind (New_Id) in N_Has_Etype then
+            Set_Etype (New_Id, Empty);
+         end if;
 
-            Set_Analyzed (New_Id, False);
+         Set_Analyzed (New_Id, False);
 
-            --  Rather special case, if we have an expanded name, then change
-            --  it back into a selected component, so that the tree looks the
-            --  way it did coming out of the parser. This will change back
-            --  when we analyze the selected component node.
+         --  Rather special case, if we have an expanded name, then change
+         --  it back into a selected component, so that the tree looks the
+         --  way it did coming out of the parser. This will change back
+         --  when we analyze the selected component node.
 
-            if Nkind (New_Id) = N_Expanded_Name then
+         if Nkind (New_Id) = N_Expanded_Name then
 
-               --  The following code is a bit kludgy. It would be cleaner to
-               --  Add an entry Change_Expanded_Name_To_Selected_Component to
-               --  Sinfo.CN, but that's an earthquake, because it has the wrong
-               --  license, and Atree is used outside the compiler, e.g. in the
-               --  binder and in ASIS, so we don't want to add that dependency.
+            --  The following code is a bit kludgy. It would be cleaner to
+            --  Add an entry Change_Expanded_Name_To_Selected_Component to
+            --  Sinfo.CN, but that's an earthquake, because it has the wrong
+            --  license, and Atree is used outside the compiler, e.g. in the
+            --  binder and in ASIS, so we don't want to add that dependency.
 
-               --  Consequently we have no choice but to hold our noses and do
-               --  the change manually. At least we are Atree, so this odd use
-               --  of Atree.Unchecked_Access is at least all in the family.
+            --  Consequently we have no choice but to hold our noses and do
+            --  the change manually. At least we are Atree, so this odd use
+            --  of Atree.Unchecked_Access is at least all in the family.
 
-               --  Change the node type
+            --  Change the node type
 
-               Atree.Unchecked_Access.Set_Nkind (New_Id, N_Selected_Component);
+            Atree.Unchecked_Access.Set_Nkind (New_Id, N_Selected_Component);
 
-               --  Clear the Chars field which is not present in a selected
-               --  component node, so we don't want a junk value around.
+            --  Clear the Chars field which is not present in a selected
+            --  component node, so we don't want a junk value around.
 
-               Set_Node1 (New_Id, Empty);
-            end if;
+            Set_Node1 (New_Id, Empty);
          end if;
 
          --  All done, return copied node
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 1a36957..ee2ecde 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -494,9 +494,7 @@ package Atree is
    --  is thus still attached to the tree. It is valid for Source to be Empty,
    --  in which case Relocate_Node simply returns Empty as the result.
 
-   function Copy_Separate_Tree
-     (Source      : Node_Id;
-      Syntax_Only : Boolean := False) return Node_Id;
+   function Copy_Separate_Tree (Source : Node_Id) return Node_Id;
    --  Given a node that is the root of a subtree, Copy_Separate_Tree copies
    --  the entire syntactic subtree, including recursively any descendants
    --  whose parent field references a copied node (descendants not linked to
@@ -506,34 +504,11 @@ package Atree is
    --  but has new entities with the same name. Most of the time this routine
    --  is called on an unanalyzed tree, and no semantic information is copied.
    --  However, to ensure that no entities are shared between the two when the
-   --  source is already analyzed, entity fields in the copy are zeroed out.
-   --
-   --  In addition, if Syntax_Only is set True, then when Copy_Separate_Tree
-   --  is applied Identical to Copy_Separate_Tree except that in the case of
-   --  applying it to an already analyzed tree, all Etype fields are reset,
-   --  and all Analyzed flags are set False. In addition, Expanded_Name
-   --  nodes are converted back into the original parser form (where they are
-   --  Selected_Components), so that renalysis does the right thing.
-   --
-   --  Note: it really seems like Copy_Separate_Tree could do these identical
-   --  steps unconditionally, and that nearly works, except for this one known
-   --  test case that fails:
-   --
-   --    1. procedure III is
-   --    2.    procedure Proc2 is
-   --    3.       pragma Inline_Always (Proc2);
-   --                                   |
-   --       >>> argument of "INLINE_ALWAYS" must be entity in
-   --           current scope
-   --
-   --    4.    begin
-   --    5.       null;
-   --    6.    end Proc2;
-   --    7. begin
-   --    8.    null;
-   --    9. end III;
-   --
-   --  To be investigated ???
+   --  source is already analyzed, entity fields in the copy are zeroed out,
+   --  as well as Etype fields and the Analyzed flag.
+   --  In addition, Expanded_Name nodes are converted back into the original
+   --  parser form (where they are Selected_Components), so that renalysis does
+   --  the right thing.
 
    function Copy_Separate_List (Source : List_Id) return List_Id;
    --  Applies Copy_Separate_Tree to each element of the Source list, returning
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index a10290f..9fdc021 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3426,14 +3426,12 @@ package body Freeze is
             --  Note on calls to Copy_Separate_Tree. The trees we are copying
             --  here are fully analyzed, but we definitely want fully syntactic
             --  unanalyzed trees in the body we construct, so that the analysis
-            --  generates the right visibility. So this is a case in which we
-            --  set Syntax_Only. See spec of Copy_Separate_Tree for details on
-            --  the use of this flag.
+            --  generates the right visibility.
 
             --  Acquire copy of Inline pragma
 
             Iprag :=
-              Copy_Separate_Tree (Import_Pragma (E), Syntax_Only => True);
+              Copy_Separate_Tree (Import_Pragma (E));
 
             --  Fix up spec to be not imported any more
 
@@ -3477,11 +3475,11 @@ package body Freeze is
             Bod :=
               Make_Subprogram_Body (Loc,
                 Specification              =>
-                  Copy_Separate_Tree (Spec, Syntax_Only => True),
+                  Copy_Separate_Tree (Spec),
                 Declarations               => New_List (
                   Make_Subprogram_Declaration (Loc,
                     Specification =>
-                      Copy_Separate_Tree (Spec, Syntax_Only => True)),
+                      Copy_Separate_Tree (Spec)),
                     Iprag),
                 Handled_Statement_Sequence =>
                   Make_Handled_Sequence_Of_Statements (Loc,
diff --git a/gcc/ada/g-sercom-linux.adb b/gcc/ada/g-sercom-linux.adb
index d485c1b..a3d866a 100644
--- a/gcc/ada/g-sercom-linux.adb
+++ b/gcc/ada/g-sercom-linux.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                    Copyright (C) 2007-2012, AdaCore                      --
+--                    Copyright (C) 2007-2013, 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- --
@@ -132,7 +132,10 @@ package body GNAT.Serial_Communications is
 
    procedure Raise_Error (Message : String; Error : Integer := Errno) is
    begin
-      raise Serial_Error with Message & " (" & Integer'Image (Error) & ')';
+      raise Serial_Error with Message
+        & (if Error /= 0
+           then " (" & Errno_Message (Err => Error) & ')'
+           else "");
    end Raise_Error;
 
    ----------
diff --git a/gcc/ada/g-sercom-mingw.adb b/gcc/ada/g-sercom-mingw.adb
index 0a868c7..700665f 100644
--- a/gcc/ada/g-sercom-mingw.adb
+++ b/gcc/ada/g-sercom-mingw.adb
@@ -41,6 +41,8 @@ with System.OS_Constants;
 with System.Win32;         use System.Win32;
 with System.Win32.Ext;     use System.Win32.Ext;
 
+with GNAT.OS_Lib;
+
 package body GNAT.Serial_Communications is
 
    package OSC renames System.OS_Constants;
@@ -137,7 +139,10 @@ package body GNAT.Serial_Communications is
 
    procedure Raise_Error (Message : String; Error : DWORD := GetLastError) is
    begin
-      raise Serial_Error with Message & " (" & DWORD'Image (Error) & ')';
+      raise Serial_Error with Message
+        & (if Error /= 0
+           then " (" & GNAT.OS_Lib.Errno_Message (Err => Integer (Error)) & ')'
+           else "");
    end Raise_Error;
 
    ----------
diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c
index fda51cc..f33fd1f 100644
--- a/gcc/ada/raise-gcc.c
+++ b/gcc/ada/raise-gcc.c
@@ -84,8 +84,13 @@ extern void __gnat_unhandled_except_handler (_Unwind_Exception *);
 
 /* The known and handled exception classes.  */
 
+#ifdef __ARM_EABI_UNWINDER__
+#define CXX_EXCEPTION_CLASS "GNUCC++"
+#define GNAT_EXCEPTION_CLASS "GNU-Ada"
+#else
 #define CXX_EXCEPTION_CLASS 0x474e5543432b2b00ULL
 #define GNAT_EXCEPTION_CLASS 0x474e552d41646100ULL
+#endif
 
 /* Structure of a C++ exception, represented as a C structure...  See
    unwind-cxx.h for the full definition.  */
@@ -863,16 +868,10 @@ extern struct Exception_Data Non_Ada_Error;
 /* Return true iff the exception class of EXCEPT is EC.  */
 
 static int
-exception_class_eq (const _GNAT_Exception *except, unsigned long long ec)
+exception_class_eq (const _GNAT_Exception *except, _Unwind_Exception_Class ec)
 {
 #ifdef __ARM_EABI_UNWINDER__
-  union {
-    char exception_class[8];
-    unsigned long long ec;
-  } u;
-
-  u.ec = ec;
-  return memcmp (except->common.exception_class, u.exception_class, 8) == 0;
+  return memcmp (except->common.exception_class, ec, 8) == 0;
 #else
   return except->common.exception_class == ec;
 #endif
diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb
index 0d0fba7..550c1f5 100644
--- a/gcc/ada/s-os_lib.adb
+++ b/gcc/ada/s-os_lib.adb
@@ -932,7 +932,8 @@ package body System.OS_Lib is
             declare
                Val   : Integer;
                First : Integer;
-               Buf   : String (1 .. 20);
+
+               Buf : String (1 .. 20);
                --  Buffer large enough to hold image of largest Integer values
 
             begin
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 00fafc8..a6ad965 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2352,6 +2352,15 @@ package body Sem_Ch6 is
                      Set_Has_Pragma_Inline_Always (Subp);
                   end if;
 
+                  --  Prior to copying the subprogram body to create a template
+                  --  for it for subsequent inlining, remove the pragma from
+                  --  the current body so that the copy that will produce the
+                  --  new body will start from a completely unanalyzed tree.
+
+                  if Nkind (Parent (Prag)) = N_Subprogram_Body then
+                     Rewrite (Prag, Make_Null_Statement (Sloc (Prag)));
+                  end if;
+
                   Spec := Subp;
                end;
             end if;