[multiple changes]

2011-09-19  Robert Dewar  <dewar@adacore.com>

	* err_vars.ads, errout.ads: Minor reformatting.

2011-09-19  Robert Dewar  <dewar@adacore.com>

	* aspects.ads (Impl_Defined_Aspects): New array
	* lib-writ.adb (No_Dependences): New name for No_Dependence
	* restrict.adb (No_Dependences): New name for No_Dependence
	(Check_Restriction_No_Specification_Of_Aspect): New
	procedure.
	(Set_Restriction_No_Specification_Of_Aspect): New procedure
	(Restricted_Profile_Result): New variable
	(No_Specification_Of_Aspects): New variable
	(No_Specification_Of_Aspect_Warning): New variable
	* restrict.ads (No_Dependences): New name for No_Dependence
	(Check_Restriction_No_Specification_Of_Aspect): New procedure
	(Set_Restriction_No_Specification_Of_Aspect): New procedure
	* s-rident.ads: Add restriction
	No_Implementation_Aspect_Specifications, this is also added to
	the No_Implementation_Extensions profile.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Check
	No_Implementation_Defined_Aspects
	(Analyze_Aspect_Specifications): Check No_Specification_Of_Aspect
	* sem_prag.adb (Analyze_Aspect_Specifications): Check
	No_Implementation_Aspects
	(Analyze_Aspect_Specifications): Check No_Specification_Of_Aspect
	* snames.ads-tmpl (Name_No_Specification_Of_Aspect): New name

2011-09-19  Yannick Moy  <moy@adacore.com>

	* lib-xref.adb (Generate_Reference): Take into account multiple
	renamings for Alfa refs.

2011-09-19  Thomas Quinot  <quinot@adacore.com>

	* g-socthi-mingw.adb: Minor reformatting.

2011-09-19  Yannick Moy  <moy@adacore.com>

	* gnat1drv.adb (Adjust_Global_Switches): Set tagged type
	expansion to False in mode Alfa

2011-09-19  Pascal Obry  <obry@adacore.com>

	* mingw32.h: Remove obsolete code needed for old versions
	of MingW.

From-SVN: r178959

gcc/ada/ChangeLog

 2011-09-19  Robert Dewar  <dewar@adacore.com>
 
+	* err_vars.ads, errout.ads: Minor reformatting.
+
+2011-09-19  Robert Dewar  <dewar@adacore.com>
+
+	* aspects.ads (Impl_Defined_Aspects): New array
+	* lib-writ.adb (No_Dependences): New name for No_Dependence
+	* restrict.adb (No_Dependences): New name for No_Dependence
+	(Check_Restriction_No_Specification_Of_Aspect): New
+	procedure.
+	(Set_Restriction_No_Specification_Of_Aspect): New procedure
+	(Restricted_Profile_Result): New variable
+	(No_Specification_Of_Aspects): New variable
+	(No_Specification_Of_Aspect_Warning): New variable
+	* restrict.ads (No_Dependences): New name for No_Dependence
+	(Check_Restriction_No_Specification_Of_Aspect): New procedure
+	(Set_Restriction_No_Specification_Of_Aspect): New procedure
+	* s-rident.ads: Add restriction
+	No_Implementation_Aspect_Specifications, this is also added to
+	the No_Implementation_Extensions profile.
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Check
+	No_Implementation_Defined_Aspects
+	(Analyze_Aspect_Specifications): Check No_Specification_Of_Aspect
+	* sem_prag.adb (Analyze_Aspect_Specifications): Check
+	No_Implementation_Aspects
+	(Analyze_Aspect_Specifications): Check No_Specification_Of_Aspect
+	* snames.ads-tmpl (Name_No_Specification_Of_Aspect): New name
+
+2011-09-19  Yannick Moy  <moy@adacore.com>
+
+	* lib-xref.adb (Generate_Reference): Take into account multiple
+	renamings for Alfa refs.
+
+2011-09-19  Thomas Quinot  <quinot@adacore.com>
+
+	* g-socthi-mingw.adb: Minor reformatting.
+
+2011-09-19  Yannick Moy  <moy@adacore.com>
+
+	* gnat1drv.adb (Adjust_Global_Switches): Set tagged type
+	expansion to False in mode Alfa
+
+2011-09-19  Pascal Obry  <obry@adacore.com>
+
+	* mingw32.h: Remove obsolete code needed for old versions
+	of MingW.
+
+2011-09-19  Robert Dewar  <dewar@adacore.com>
+
 	* errout.ads: Minor reformatting.
 
 2011-09-19  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/aspects.ads

@@ -144,6 +144,31 @@ package Aspects is
                         Aspect_Post          => True,
                         others               => False);
 
+   --  The following array identifies all implementation defined aspects
+
+   Impl_Defined_Aspects : constant array (Aspect_Id) of Boolean :=
+                            (Aspect_Object_Size          => True,
+                             Aspect_Predicate            => True,
+                             Aspect_Test_Case            => True,
+                             Aspect_Value_Size           => True,
+                             Aspect_Compiler_Unit        => True,
+                             Aspect_Preelaborate_05      => True,
+                             Aspect_Pure_05              => True,
+                             Aspect_Universal_Data       => True,
+                             Aspect_Ada_2005             => True,
+                             Aspect_Ada_2012             => True,
+                             Aspect_Favor_Top_Level      => True,
+                             Aspect_Inline_Always        => True,
+                             Aspect_Persistent_BSS       => True,
+                             Aspect_Pure_Function        => True,
+                             Aspect_Shared               => True,
+                             Aspect_Suppress_Debug_Info  => True,
+                             Aspect_Universal_Aliasing   => True,
+                             Aspect_Unmodified           => True,
+                             Aspect_Unreferenced         => True,
+                             Aspect_Unreferenced_Objects => True,
+                             others                      => False);
+
    --  The following array indicates aspects for which multiple occurrences of
    --  the same aspect attached to the same declaration are allowed.
 

gcc/ada/err_vars.ads

@@ -143,7 +143,9 @@ package Err_Vars is
 
    Error_Msg_Warn : Boolean;
    --  Used if current message contains a < insertion character to indicate
-   --  if the current message is a warning message.
+   --  if the current message is a warning message. Must be set appropriately
+   --  before any call to Error_Msg_xxx with a < insertion character present.
+   --  Setting is irrelevant if no < insertion character is present.
 
    Error_Msg_String : String (1 .. 4096);
    Error_Msg_Strlen : Natural;

gcc/ada/errout.ads

@@ -451,7 +451,9 @@ package Errout is
 
    Error_Msg_Warn : Boolean renames Err_Vars.Error_Msg_Warn;
    --  Used if current message contains a < insertion character to indicate
-   --  if the current message is a warning message. ??? who turns this off???
+   --  if the current message is a warning message. Must be set appropriately
+   --  before any call to Error_Msg_xxx with a < insertion character present.
+   --  Setting is irrelevant if no < insertion character is present.
 
    Error_Msg_String : String  renames Err_Vars.Error_Msg_String;
    Error_Msg_Strlen : Natural renames Err_Vars.Error_Msg_Strlen;

gcc/ada/g-socthi-mingw.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                    Copyright (C) 2001-2010, AdaCore                      --
+--                    Copyright (C) 2001-2011, 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- --
@@ -275,8 +275,8 @@ package body GNAT.Sockets.Thin is
       use type C.size_t;
 
       Fill  : constant Boolean :=
-        SOSC.MSG_WAITALL /= -1
-          and then (C.unsigned (Flags) and SOSC.MSG_WAITALL) /= 0;
+                SOSC.MSG_WAITALL /= -1
+                  and then (C.unsigned (Flags) and SOSC.MSG_WAITALL) /= 0;
       --  Is the MSG_WAITALL flag set? If so we need to fully fill all vectors
 
       Res   : C.int;

gcc/ada/gnat1drv.adb

@@ -477,12 +477,9 @@ procedure Gnat1drv is
 
          Global_Discard_Names := True;
 
-         --  We would prefer to suppress the expansion of tagged types and
-         --  dispatching calls, so that one day GNATprove can handle them
-         --  directly. Unfortunately, this is causing problems in some cases,
-         --  so keep this expansion for the time being. To be investigated ???
+         --  Suppress the expansion of tagged types and dispatching calls
 
-         Tagged_Type_Expansion := True;
+         Tagged_Type_Expansion := False;
       end if;
    end Adjust_Global_Switches;
 

gcc/ada/lib-writ.adb

@@ -1161,13 +1161,13 @@ package body Lib.Writ is
 
       --  Output R lines for No_Dependence entries
 
-      for J in No_Dependence.First .. No_Dependence.Last loop
-         if In_Extended_Main_Source_Unit (No_Dependence.Table (J).Unit)
-           and then not No_Dependence.Table (J).Warn
+      for J in No_Dependences.First .. No_Dependences.Last loop
+         if In_Extended_Main_Source_Unit (No_Dependences.Table (J).Unit)
+           and then not No_Dependences.Table (J).Warn
          then
             Write_Info_Initiate ('R');
             Write_Info_Char (' ');
-            Write_Unit_Name (No_Dependence.Table (J).Unit);
+            Write_Unit_Name (No_Dependences.Table (J).Unit);
             Write_Info_EOL;
          end if;
       end loop;

gcc/ada/lib-xref.adb

@@ -391,6 +391,10 @@ package body Lib.Xref is
       Kind : Entity_Kind;
       --  If Formal is non-Empty, then its Ekind, otherwise E_Void
 
+      function Get_Through_Renamings (E : Entity_Id) return Entity_Id;
+      --  Get the enclosing entity through renamings, which may come from
+      --  source or from the translation of generic instantiations.
+
       function Is_On_LHS (Node : Node_Id) return Boolean;
       --  Used to check if a node is on the left hand side of an assignment.
       --  The following cases are handled:
@@ -412,6 +416,22 @@ package body Lib.Xref is
       --  exceptions where we do not want to set this flag, see body for
       --  details of these exceptional cases.
 
+      ---------------------------
+      -- Get_Through_Renamings --
+      ---------------------------
+
+      function Get_Through_Renamings (E : Entity_Id) return Entity_Id is
+         Result : Entity_Id := E;
+      begin
+         while Present (Result)
+           and then Is_Object (Result)
+           and then Present (Renamed_Object (Result))
+         loop
+            Result := Get_Enclosing_Object (Renamed_Object (Result));
+         end loop;
+         return Result;
+      end Get_Through_Renamings;
+
       ---------------
       -- Is_On_LHS --
       ---------------
@@ -955,11 +975,8 @@ package body Lib.Xref is
          --  the renaming, which is needed to compute a valid set of effects
          --  (reads, writes) for the enclosing subprogram.
 
-         if Alfa_Mode
-           and then Is_Object (Ent)
-           and then Present (Renamed_Object (Ent))
-         then
-            Ent := Get_Enclosing_Object (Renamed_Object (Ent));
+         if Alfa_Mode then
+            Ent := Get_Through_Renamings (Ent);
 
             --  If no enclosing object, then it could be a reference to any
             --  location not tracked individually, like heap-allocated data.

gcc/ada/mingw32.h

@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *          Copyright (C) 2002-2009, Free Software Foundation, Inc.         *
+ *          Copyright (C) 2002-2011, 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- *
@@ -38,28 +38,8 @@
 
 #include <_mingw.h>
 
-/* The unicode support is activated by default starting with the 3.9 MingW
-   version. It is not possible to use it with previous version due to a bug
-   in the MingW runtime.  */
-
-#if (((__MINGW32_MAJOR_VERSION == 3 \
-		   && __MINGW32_MINOR_VERSION >= 9) \
-     || (__MINGW32_MAJOR_VERSION >= 4) \
-     || defined (__MINGW64))	       \
-     && !defined (RTX))
+#ifndef RTX
 #define GNAT_UNICODE_SUPPORT
-
-#else
-
-/*  Older MingW versions have no definition for _tfreopen, add it here to have a
-    proper build without unicode support.  */
-#ifndef _tfreopen
-#define _tfreopen   freopen
-#endif
-
-#endif
-
-#ifdef GNAT_UNICODE_SUPPORT
 #define _UNICODE /* For C runtime */
 #define UNICODE  /* For Win32 API */
 #endif

gcc/ada/restrict.adb

@@ -23,6 +23,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Casing;   use Casing;
 with Einfo;    use Einfo;
@@ -41,14 +42,28 @@ with Uname;    use Uname;
 package body Restrict is
 
    Restricted_Profile_Result : Boolean := False;
-   --  This switch memoizes the result of Restricted_Profile function
-   --  calls for improved efficiency. Its setting is valid only if
-   --  Restricted_Profile_Cached is True. Note that if this switch
-   --  is ever set True, it need never be turned off again.
+   --  This switch memoizes the result of Restricted_Profile function calls for
+   --  improved efficiency. Valid only if Restricted_Profile_Cached is True.
+   --  Note: if this switch is ever set True, it is never turned off again.
 
    Restricted_Profile_Cached : Boolean := False;
-   --  This flag is set to True if the Restricted_Profile_Result
-   --  contains the correct cached result of Restricted_Profile calls.
+   --  This flag is set to True if the Restricted_Profile_Result contains the
+   --  correct cached result of Restricted_Profile calls.
+
+   No_Specification_Of_Aspects : array (Aspect_Id) of Source_Ptr :=
+                                   (others => No_Location);
+   --  Entries in this array are set to point to a previously occuring pragma
+   --  that activates a No_Specification_Of_Aspect check.
+
+   No_Specification_Of_Aspect_Warning : array (Aspect_Id) of Boolean :=
+                                          (others => True);
+   --  An entry in this array is set False in reponse to a previous call to
+   --  Set_No_Speficiation_Of_Aspect for pragmas in the main unit that
+   --  specify Warning as False. Once set False, an entry is never reset.
+
+   No_Specification_Of_Aspect_Set : Boolean := False;
+   --  Set True if any entry of No_Specifcation_Of_Aspects has been set True.
+   --  Once set True, this is never turned off again.
 
    -----------------------
    -- Local Subprograms --
@@ -461,14 +476,14 @@ package body Restrict is
 
       --  Loop through entries in No_Dependence table to check each one in turn
 
-      for J in No_Dependence.First .. No_Dependence.Last loop
-         DU := No_Dependence.Table (J).Unit;
+      for J in No_Dependences.First .. No_Dependences.Last loop
+         DU := No_Dependences.Table (J).Unit;
 
          if Same_Unit (U, DU) then
             Error_Msg_Sloc := Sloc (DU);
             Error_Msg_Node_1 := DU;
 
-            if No_Dependence.Table (J).Warn then
+            if No_Dependences.Table (J).Warn then
                Error_Msg
                  ("?violation of restriction `No_Dependence '='> &`#",
                   Sloc (Err));
@@ -483,6 +498,44 @@ package body Restrict is
       end loop;
    end Check_Restriction_No_Dependence;
 
+   --------------------------------------------------
+   -- Check_Restriction_No_Specification_Of_Aspect --
+   --------------------------------------------------
+
+   procedure Check_Restriction_No_Specification_Of_Aspect (N : Node_Id) is
+      A_Id : Aspect_Id;
+      Id   : Node_Id;
+
+   begin
+      --  Ignore call if no instances of this restriction set
+
+      if not No_Specification_Of_Aspect_Set then
+         return;
+      end if;
+
+      --  Ignore call if node N is not in the main source unit, since we only
+      --  give messages for . This avoids giving messages for aspects that are
+      --  specified in withed units.
+
+      if not In_Extended_Main_Source_Unit (N) then
+         return;
+      end if;
+
+      Id := Identifier (N);
+      A_Id := Get_Aspect_Id (Chars (Id));
+      pragma Assert (A_Id /= No_Aspect);
+
+      Error_Msg_Sloc := No_Specification_Of_Aspects (A_Id);
+
+      if Error_Msg_Sloc /= No_Location then
+         Error_Msg_Node_1 := Id;
+         Error_Msg_Warn := No_Specification_Of_Aspect_Warning (A_Id);
+         Error_Msg_N
+           ("<violation of restriction `No_Specification_Of_Aspect '='> &`#",
+            Id);
+      end if;
+   end Check_Restriction_No_Specification_Of_Aspect;
+
    --------------------------------------
    -- Check_Wide_Character_Restriction --
    --------------------------------------
@@ -1059,16 +1112,16 @@ package body Restrict is
    begin
       --  Loop to check for duplicate entry
 
-      for J in No_Dependence.First .. No_Dependence.Last loop
+      for J in No_Dependences.First .. No_Dependences.Last loop
 
          --  Case of entry already in table
 
-         if Same_Unit (Unit, No_Dependence.Table (J).Unit) then
+         if Same_Unit (Unit, No_Dependences.Table (J).Unit) then
 
             --  Error has precedence over warning
 
             if not Warn then
-               No_Dependence.Table (J).Warn := False;
+               No_Dependences.Table (J).Warn := False;
             end if;
 
             return;
@@ -1077,9 +1130,30 @@ package body Restrict is
 
       --  Entry is not currently in table
 
-      No_Dependence.Append ((Unit, Warn, Profile));
+      No_Dependences.Append ((Unit, Warn, Profile));
    end Set_Restriction_No_Dependence;
 
+   ------------------------------------------------
+   -- Set_Restriction_No_Specification_Of_Aspect --
+   ------------------------------------------------
+
+   procedure Set_Restriction_No_Specification_Of_Aspect
+     (N       : Node_Id;
+      Warning : Boolean)
+   is
+      A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (N));
+      pragma Assert (A_Id /= No_Aspect);
+
+   begin
+      No_Specification_Of_Aspects (A_Id) := Sloc (N);
+
+      if Warning = False then
+         No_Specification_Of_Aspect_Warning (A_Id) := False;
+      end if;
+
+      No_Specification_Of_Aspect_Set := True;
+   end Set_Restriction_No_Specification_Of_Aspect;
+
    ----------------------------------
    -- Suppress_Restriction_Message --
    ----------------------------------

gcc/ada/restrict.ads

@@ -166,13 +166,13 @@ package Restrict is
       --  No_Profile if a pragma Restriction set the No_Dependence entry.
    end record;
 
-   package No_Dependence is new Table.Table (
+   package No_Dependences is new Table.Table (
      Table_Component_Type => ND_Entry,
      Table_Index_Type     => Int,
      Table_Low_Bound      => 0,
      Table_Initial        => 200,
      Table_Increment      => 200,
-     Table_Name           => "Name_No_Dependence");
+     Table_Name           => "Name_No_Dependences");
 
    -------------------------------
    -- SPARK Restriction Control --
@@ -255,6 +255,11 @@ package Restrict is
    --  an explicit WITH clause). U is a node for the unit involved, and Err is
    --  the node to which an error will be attached if necessary.
 
+   procedure Check_Restriction_No_Specification_Of_Aspect (N : Node_Id);
+   --  N is the node id for an N_Aspect_Specification. An error message
+   --  (warning) will be issued if a restriction (warning) was previous set
+   --  for this aspect using Set_No_Specification_Of_Aspect.
+
    procedure Check_Elaboration_Code_Allowed (N : Node_Id);
    --  Tests to see if elaboration code is allowed by the current restrictions
    --  settings. This function is called by Gigi when it needs to define an
@@ -409,6 +414,15 @@ package Restrict is
    --  this flag is not set. Profile is set to a non-default value if the
    --  No_Dependence restriction comes from a Profile pragma.
 
+   procedure Set_Restriction_No_Specification_Of_Aspect
+     (N       : Node_Id;
+      Warning : Boolean);
+   --  N is the node id for an identifier from a pragma Restrictions for the
+   --  No_Specification_Of_Aspect pragma. An error message will be issued if
+   --  the identifier is not a valid aspect name. Warning is set True for the
+   --  case of a Restriction_Warnings pragma specifying this restriction and
+   --  False for a Restrictions pragma specifying this restriction.
+
    function Tasking_Allowed return Boolean;
    pragma Inline (Tasking_Allowed);
    --  Tests if tasking operations are allowed by the current restrictions

gcc/ada/s-rident.ads

@@ -125,6 +125,7 @@ package System.Rident is
       --  The following cases do not require consistency checking
 
       Immediate_Reclamation,                   -- (RM H.4(10))
+      No_Implementation_Aspect_Specifications, -- Ada 2012 AI-241
       No_Implementation_Attributes,            -- Ada 2005 AI-257
       No_Implementation_Identifiers,           -- Ada 2012 AI-246
       No_Implementation_Pragmas,               -- Ada 2005 AI-257
@@ -349,11 +350,12 @@ package System.Rident is
                         --  Restrictions for Restricted profile
 
                        (Set   =>
-                          (No_Implementation_Attributes    => True,
-                           No_Implementation_Identifiers   => True,
-                           No_Implementation_Pragmas       => True,
-                           No_Implementation_Units         => True,
-                           others                          => False),
+                          (No_Implementation_Aspect_Specifications => True,
+                           No_Implementation_Attributes            => True,
+                           No_Implementation_Identifiers           => True,
+                           No_Implementation_Pragmas               => True,
+                           No_Implementation_Units                 => True,
+                           others                                  => False),
 
                         --  Value settings for Restricted profile (none
 

gcc/ada/sem_ch13.adb

@@ -804,6 +804,19 @@ package body Sem_Ch13 is
                goto Continue;
             end if;
 
+            --  Check restriction No_Implementation_Aspect_Specifications
+
+            if Impl_Defined_Aspects (A_Id) then
+               Check_Restriction
+                 (No_Implementation_Aspect_Specifications, Aspect);
+            end if;
+
+            --  Check restriction No_Specification_Of_Aspect
+
+            Check_Restriction_No_Specification_Of_Aspect (Aspect);
+
+            --  Analyze this aspect
+
             Set_Analyzed (Aspect);
             Set_Entity (Aspect, E);
             Ent := New_Occurrence_Of (E, Sloc (Id));

gcc/ada/sem_prag.adb

@@ -29,6 +29,7 @@
 --  to complete the syntax checks. Certain pragmas are handled partially or
 --  completely by the parser (see Par.Prag for further details).
 
+with Aspects;  use Aspects;
 with Atree;    use Atree;
 with Casing;   use Casing;
 with Checks;   use Checks;
@@ -5314,6 +5315,26 @@ package body Sem_Prag is
             elsif Id = Name_No_Dependence then
                Check_Unit_Name (Expr);
 
+            --  Case of No_Specification_Of_Aspect => Identifier.
+
+            elsif Id = Name_No_Specification_Of_Aspect then
+               declare
+                  A_Id : Aspect_Id;
+
+               begin
+                  if Nkind (Expr) /= N_Identifier then
+                     A_Id := No_Aspect;
+                  else
+                     A_Id := Get_Aspect_Id (Chars (Expr));
+                  end if;
+
+                  if A_Id = No_Aspect then
+                     Error_Pragma_Arg ("invalid restriction name", Arg);
+                  else
+                     Set_Restriction_No_Specification_Of_Aspect (Expr, Warn);
+                  end if;
+               end;
+
             --  All other cases of restriction identifier present
 
             else

gcc/ada/snames.ads-tmpl

@@ -663,6 +663,7 @@ package Snames is
    Name_No_Implementation_Extensions   : constant Name_Id := N + $;
    Name_No_Requeue                     : constant Name_Id := N + $;
    Name_No_Requeue_Statements          : constant Name_Id := N + $;
+   Name_No_Specification_Of_Aspect     : constant Name_Id := N + $;
    Name_No_Task_Attributes             : constant Name_Id := N + $;
    Name_No_Task_Attributes_Package     : constant Name_Id := N + $;
    Name_Nominal                        : constant Name_Id := N + $;