2011-11-21 Robert Dewar <dewar@adacore.com>

	* sinput.ads: Minor comment fix.

2011-11-21  Robert Dewar  <dewar@adacore.com>

	* exp_attr.adb (Expand_N_Attribute_Reference, case First_Bit,
	Last_Bit, Position): Handle 2005 case.

2011-11-21  Robert Dewar  <dewar@adacore.com>

	* s-atocou-builtin.adb (Decrement): Use Unrestricted_Access
	to deal with fact that we properly detect the error if Access
	is used.
	(Increment): Same fix.
	* s-taprop-linux.adb (Create_Task): Use Unrestricted_Access
	to deal with fact that we properly detect the error if Access
	is used.
	* sem_util.adb (Is_Volatile_Object): Properly record that A.B is
	volatile if the B component is volatile. This affects the check
	for passing such a by reference volatile actual to a non-volatile
	formal (which should be illegal)

2011-11-21  Robert Dewar  <dewar@adacore.com>

	* freeze.adb (Freeze_Enumeration_Type): Make sure to set both
	size and alignment for foreign convention enumeration types.
	* layout.adb (Set_Elem_Alignment): Redo setting of alignment
	when size is set.

2011-11-21  Yannick Moy  <moy@adacore.com>

	* checks.adb (Apply_Access_Check, Apply_Arithmetic_Overflow_Check,
	Apply_Discriminant_Check, Apply_Divide_Check,
	Apply_Selected_Length_Checks, Apply_Selected_Range_Checks,
	Build_Discriminant_Checks, Insert_Range_Checks, Selected_Length_Checks,
	Selected_Range_Checks): Replace reference to Expander_Active
	with reference to Full_Expander_Active, so that expansion of
	checks is not performed in Alfa mode

2011-11-21  Tristan Gingold  <gingold@adacore.com>

	* s-taprop-vms.adb (Create_Task): Use Unrestricted_Access to deal with
	fact that we properly detect the error if Access is used.

2011-11-21  Hristian Kirtchev  <kirtchev@adacore.com>

	* par-ch4.adb (P_Quantified_Expression): Add an Ada 2012 check.

2011-11-21  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_imgv.adb: Add with and use clause for Errout.
	(Expand_Width_Attribute): Emit a warning when in
	configurable run-time mode to provide a better diagnostic message.

2011-11-21  Hristian Kirtchev  <kirtchev@adacore.com>

	* s-finmas.adb (Finalize): Add comment concerning double finalization.

2011-11-21  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Access_Definition): If the access definition
	is itself the return type of an access to function definition
	which is ultimately the return type of an access to subprogram
	declaration, its scope is the enclosing scope of the ultimate
	access to subprogram.

2011-11-21  Steve Baird  <baird@adacore.com>

	* sem_res.adb (Valid_Conversion): If a conversion was legal
	in the body of a generic, then the corresponding conversion is
	legal in the expanded body of an instance of the generic.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@181568 138bc75d-0d04-0410-961f-82ee72b054a4

15 files changed, 337 insertions, 59 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b98c7db1e75..d1aad1ded0a 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,78 @@
 2011-11-21  Robert Dewar  <dewar@adacore.com>
 
+	* sinput.ads: Minor comment fix.
+
+2011-11-21  Robert Dewar  <dewar@adacore.com>
+
+	* exp_attr.adb (Expand_N_Attribute_Reference, case First_Bit,
+	Last_Bit, Position): Handle 2005 case.
+
+2011-11-21  Robert Dewar  <dewar@adacore.com>
+
+	* s-atocou-builtin.adb (Decrement): Use Unrestricted_Access
+	to deal with fact that we properly detect the error if Access
+	is used.
+	(Increment): Same fix.
+	* s-taprop-linux.adb (Create_Task): Use Unrestricted_Access
+	to deal with fact that we properly detect the error if Access
+	is used.
+	* sem_util.adb (Is_Volatile_Object): Properly record that A.B is
+	volatile if the B component is volatile. This affects the check
+	for passing such a by reference volatile actual to a non-volatile
+	formal (which should be illegal)
+
+2011-11-21  Robert Dewar  <dewar@adacore.com>
+
+	* freeze.adb (Freeze_Enumeration_Type): Make sure to set both
+	size and alignment for foreign convention enumeration types.
+	* layout.adb (Set_Elem_Alignment): Redo setting of alignment
+	when size is set.
+
+2011-11-21  Yannick Moy  <moy@adacore.com>
+
+	* checks.adb (Apply_Access_Check, Apply_Arithmetic_Overflow_Check,
+	Apply_Discriminant_Check, Apply_Divide_Check,
+	Apply_Selected_Length_Checks, Apply_Selected_Range_Checks,
+	Build_Discriminant_Checks, Insert_Range_Checks, Selected_Length_Checks,
+	Selected_Range_Checks): Replace reference to Expander_Active
+	with reference to Full_Expander_Active, so that expansion of
+	checks is not performed in Alfa mode
+
+2011-11-21  Tristan Gingold  <gingold@adacore.com>
+
+	* s-taprop-vms.adb (Create_Task): Use Unrestricted_Access to deal with
+	fact that we properly detect the error if Access is used.
+
+2011-11-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* par-ch4.adb (P_Quantified_Expression): Add an Ada 2012 check.
+
+2011-11-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_imgv.adb: Add with and use clause for Errout.
+	(Expand_Width_Attribute): Emit a warning when in
+	configurable run-time mode to provide a better diagnostic message.
+
+2011-11-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* s-finmas.adb (Finalize): Add comment concerning double finalization.
+
+2011-11-21  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Access_Definition): If the access definition
+	is itself the return type of an access to function definition
+	which is ultimately the return type of an access to subprogram
+	declaration, its scope is the enclosing scope of the ultimate
+	access to subprogram.
+
+2011-11-21  Steve Baird  <baird@adacore.com>
+
+	* sem_res.adb (Valid_Conversion): If a conversion was legal
+	in the body of a generic, then the corresponding conversion is
+	legal in the expanded body of an instance of the generic.
+
+2011-11-21  Robert Dewar  <dewar@adacore.com>
+
 	* sem_ch3.adb: Minor reformatting.
 
 2011-11-21  Robert Dewar  <dewar@adacore.com>
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index e6d8bf996ef..01f240fc034 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -442,7 +442,7 @@ package body Checks is
       --  are cases (e.g. with pragma Debug) where generating the checks
       --  can cause real trouble).
 
-      if not Expander_Active then
+      if not Full_Expander_Active then
          return;
       end if;
 
@@ -878,7 +878,7 @@ package body Checks is
 
          if Backend_Overflow_Checks_On_Target
            or else not Do_Overflow_Check (N)
-           or else not Expander_Active
+           or else not Full_Expander_Active
            or else (Present (Parent (N))
                      and then Nkind (Parent (N)) = N_Type_Conversion
                      and then Integer_Promotion_Possible (Parent (N)))
@@ -1178,7 +1178,7 @@ package body Checks is
       --  Nothing to do if discriminant checks are suppressed or else no code
       --  is to be generated
 
-      if not Expander_Active
+      if not Full_Expander_Active
         or else Discriminant_Checks_Suppressed (T_Typ)
       then
          return;
@@ -1462,7 +1462,7 @@ package body Checks is
       --  Don't actually use this value
 
    begin
-      if Expander_Active
+      if Full_Expander_Active
         and then not Backend_Divide_Checks_On_Target
         and then Check_Needed (Right, Division_Check)
       then
@@ -2118,7 +2118,7 @@ package body Checks is
                       (not Length_Checks_Suppressed (Target_Typ));
 
    begin
-      if not Expander_Active then
+      if not Full_Expander_Active then
          return;
       end if;
 
@@ -2226,7 +2226,7 @@ package body Checks is
                     (not Range_Checks_Suppressed (Target_Typ));
 
    begin
-      if not Expander_Active or else not Checks_On then
+      if not Full_Expander_Active or else not Checks_On then
          return;
       end if;
 
@@ -5309,7 +5309,7 @@ package body Checks is
       --  enhanced to check for an always True value in the condition and to
       --  generate a compilation warning???
 
-      if not Expander_Active or else not Checks_On then
+      if not Full_Expander_Active or else not Checks_On then
          return;
       end if;
 
@@ -6236,7 +6236,7 @@ package body Checks is
    --  Start of processing for Selected_Length_Checks
 
    begin
-      if not Expander_Active then
+      if not Full_Expander_Active then
          return Ret_Result;
       end if;
 
@@ -6810,7 +6810,7 @@ package body Checks is
    --  Start of processing for Selected_Range_Checks
 
    begin
-      if not Expander_Active then
+      if not Full_Expander_Active then
          return Ret_Result;
       end if;
 
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 57e94d29840..1883d362803 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2117,21 +2117,38 @@ package body Exp_Attr is
       --  computation to be completed in the back-end, since we don't know what
       --  layout will be chosen.
 
-      when Attribute_First_Bit => First_Bit : declare
+      when Attribute_First_Bit => First_Bit_Attr : declare
          CE : constant Entity_Id := Entity (Selector_Name (Pref));
 
       begin
-         if Known_Static_Component_Bit_Offset (CE) then
+         --  In Ada 2005 (or later) if we have the standard nondefault
+         --  bit order, then we return the original value as given in
+         --  the component clause (RM 2005 13.5.2(3/2)).
+
+         if Present (Component_Clause (CE))
+           and then Ada_Version >= Ada_2005
+           and then not Reverse_Bit_Order (Scope (CE))
+         then
             Rewrite (N,
               Make_Integer_Literal (Loc,
-                Component_Bit_Offset (CE) mod System_Storage_Unit));
+                Intval => Expr_Value (First_Bit (Component_Clause (CE)))));
+            Analyze_And_Resolve (N, Typ);
 
+         --  Otherwise (Ada 83/95 or Ada 2005 or later with reverse bit order),
+         --  rewrite with normalized value if we know it statically.
+
+         elsif Known_Static_Component_Bit_Offset (CE) then
+            Rewrite (N,
+              Make_Integer_Literal (Loc,
+                Component_Bit_Offset (CE) mod System_Storage_Unit));
             Analyze_And_Resolve (N, Typ);
 
+         --  Otherwise left to back end, just do universal integer checks
+
          else
             Apply_Universal_Integer_Attribute_Checks (N);
          end if;
-      end First_Bit;
+      end First_Bit_Attr;
 
       -----------------
       -- Fixed_Value --
@@ -2680,24 +2697,41 @@ package body Exp_Attr is
       --  the computation up to the back end, since we don't know what layout
       --  will be chosen.
 
-      when Attribute_Last_Bit => Last_Bit : declare
+      when Attribute_Last_Bit => Last_Bit_Attr : declare
          CE : constant Entity_Id := Entity (Selector_Name (Pref));
 
       begin
-         if Known_Static_Component_Bit_Offset (CE)
+         --  In Ada 2005 (or later) if we have the standard nondefault
+         --  bit order, then we return the original value as given in
+         --  the component clause (RM 2005 13.5.2(4/2)).
+
+         if Present (Component_Clause (CE))
+           and then Ada_Version >= Ada_2005
+           and then not Reverse_Bit_Order (Scope (CE))
+         then
+            Rewrite (N,
+              Make_Integer_Literal (Loc,
+                Intval => Expr_Value (Last_Bit (Component_Clause (CE)))));
+            Analyze_And_Resolve (N, Typ);
+
+         --  Otherwise (Ada 83/95 or Ada 2005 or later with reverse bit order),
+         --  rewrite with normalized value if we know it statically.
+
+         elsif Known_Static_Component_Bit_Offset (CE)
            and then Known_Static_Esize (CE)
          then
             Rewrite (N,
               Make_Integer_Literal (Loc,
                Intval => (Component_Bit_Offset (CE) mod System_Storage_Unit)
                                 + Esize (CE) - 1));
-
             Analyze_And_Resolve (N, Typ);
 
+         --  Otherwise leave to back end, just apply universal integer checks
+
          else
             Apply_Universal_Integer_Attribute_Checks (N);
          end if;
-      end Last_Bit;
+      end Last_Bit_Attr;
 
       ------------------
       -- Leading_Part --
@@ -3495,21 +3529,41 @@ package body Exp_Attr is
       --  the computation up to the back end, since we don't know what layout
       --  will be chosen.
 
-      when Attribute_Position => Position :
+      when Attribute_Position => Position_Attr :
       declare
          CE : constant Entity_Id := Entity (Selector_Name (Pref));
 
       begin
          if Present (Component_Clause (CE)) then
-            Rewrite (N,
-              Make_Integer_Literal (Loc,
-                Intval => Component_Bit_Offset (CE) / System_Storage_Unit));
+
+            --  In Ada 2005 (or later) if we have the standard nondefault
+            --  bit order, then we return the original value as given in
+            --  the component clause (RM 2005 13.5.2(2/2)).
+
+            if Ada_Version >= Ada_2005
+              and then not Reverse_Bit_Order (Scope (CE))
+            then
+               Rewrite (N,
+                  Make_Integer_Literal (Loc,
+                    Intval => Expr_Value (Position (Component_Clause (CE)))));
+
+            --  Otherwise (Ada 83 or 95, or reverse bit order specified in
+            --  later Ada version), return the normalized value.
+
+            else
+               Rewrite (N,
+                 Make_Integer_Literal (Loc,
+                   Intval => Component_Bit_Offset (CE) / System_Storage_Unit));
+            end if;
+
             Analyze_And_Resolve (N, Typ);
 
+         --  If back end is doing things, just apply universal integer checks
+
          else
             Apply_Universal_Integer_Attribute_Checks (N);
          end if;
-      end Position;
+      end Position_Attr;
 
       ----------
       -- Pred --
diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index 78d9b006abc..d66824bc35f 100644
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2001-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2001-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- --
@@ -27,6 +27,7 @@ with Atree;    use Atree;
 with Casing;   use Casing;
 with Checks;   use Checks;
 with Einfo;    use Einfo;
+with Errout;   use Errout;
 with Exp_Util; use Exp_Util;
 with Lib;      use Lib;
 with Namet;    use Namet;
@@ -1065,10 +1066,10 @@ package body Exp_Imgv is
       Pref    : constant Node_Id    := Prefix (N);
       Ptyp    : constant Entity_Id  := Etype (Pref);
       Rtyp    : constant Entity_Id  := Root_Type (Ptyp);
-      XX      : RE_Id;
-      YY      : Entity_Id;
       Arglist : List_Id;
       Ttyp    : Entity_Id;
+      XX      : RE_Id;
+      YY      : Entity_Id;
 
    begin
       --  Types derived from Standard.Boolean
@@ -1157,6 +1158,18 @@ package body Exp_Imgv is
 
          if Discard_Names (Rtyp) then
 
+            --  Emit a detailed warning in configurable run-time mode because
+            --  loading RE_Null does not give a precise indication of the real
+            --  issue.
+
+            if Configurable_Run_Time_Mode
+              and then not Has_Warnings_Off (Rtyp)
+            then
+               Error_Msg_Name_1 := Attribute_Name (N);
+               Error_Msg_N ("?attribute % not supported in configurable " &
+                            "run-time mode", N);
+            end if;
+
             --  This is a configurable run-time, or else a restriction is in
             --  effect. In either case the attribute cannot be supported. Force
             --  a load error from Rtsfind to generate an appropriate message,
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index b1a33d58da1..d9759843b72 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -4239,7 +4239,8 @@ package body Freeze is
       --  By default, if no size clause is present, an enumeration type with
       --  Convention C is assumed to interface to a C enum, and has integer
       --  size. This applies to types. For subtypes, verify that its base
-      --  type has no size clause either.
+      --  type has no size clause either. Treat other foreign conventions
+      --  in the same way, and also make sure alignment is set right.
 
       if Has_Foreign_Convention (Typ)
         and then not Has_Size_Clause (Typ)
@@ -4247,6 +4248,7 @@ package body Freeze is
         and then Esize (Typ) < Standard_Integer_Size
       then
          Init_Esize (Typ, Standard_Integer_Size);
+         Set_Alignment (Typ, Alignment (Standard_Integer));
 
       else
          --  If the enumeration type interfaces to C, and it has a size clause
diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb
index bb8aa113211..519fad0f357 100644
--- a/gcc/ada/layout.adb
+++ b/gcc/ada/layout.adb
@@ -3088,7 +3088,7 @@ package body Layout is
       end if;
 
       --  Here we calculate the alignment as the largest power of two multiple
-      --  of System.Storage_Unit that does not exceed either the actual size of
+      --  of System.Storage_Unit that does not exceed either the object size of
       --  the type, or the maximum allowed alignment.
 
       declare
@@ -3126,21 +3126,101 @@ package body Layout is
             A := 2 * A;
          end loop;
 
-         --  Now we think we should set the alignment to A, but we skip this if
-         --  an alignment is already set to a value greater than A (happens for
-         --  derived types).
+         --  If alignment is currently not set, then we can safetly set it to
+         --  this new calculated value.
 
-         --  However, if the alignment is known and too small it must be
-         --  increased, this happens in a case like:
+         if Unknown_Alignment (E) then
+            Init_Alignment (E, A);
+
+         --  Cases where we have inherited an alignment
+
+         --  For constructed types, always reset the alignment, these are
+         --  Generally invisible to the user anyway, and that way we are
+         --  sure that no constructed types have weird alignments.
+
+         elsif not Comes_From_Source (E) then
+            Init_Alignment (E, A);
+
+         --  If this inherited alignment is the same as the one we computed,
+         --  then obviously everything is fine, and we do not need to reset it.
 
-         --     type R is new Character;
-         --     for R'Size use 16;
+         elsif Alignment (E) = A then
+            null;
 
-         --  Here the alignment inherited from Character is 1, but it must be
-         --  increased to 2 to reflect the increased size.
+         --  Now we come to the difficult cases where we have inherited an
+         --  alignment and size, but overridden the size but not the alignment.
+
+         elsif Has_Size_Clause (E) or else Has_Object_Size_Clause (E) then
+
+            --  This is tricky, it might be thought that we should try to
+            --  inherit the alignment, since that's what the RM implies, but
+            --  that leads to complex rules and oddities. Consider for example:
+
+            --    type R is new Character;
+            --    for R'Size use 16;
+
+            --  It seems quite bogus in this case to inherit an alignment of 1
+            --  from the parent type Character. Furthermore, if that's what the
+            --  programmer really wanted for some odd reason, then they could
+            --  specify the alignment they wanted.
+
+            --  Furthermore we really don't want to inherit the alignment in
+            --  the case of a specified Object_Size for a subtype, since then
+            --  there would be no way of overriding to give a reasonable value
+            --  (we don't have an Object_Subtype attribute). Consider:
+
+            --    subtype R is new Character;
+            --    for R'Object_Size use 16;
+
+            --  If we inherit the alignment of 1, then we have an odd
+            --  inefficient alignment for the subtype, which cannot be fixed.
+
+            --  So we make the decision that if Size (or Object_Size) is given
+            --  (and, in the case of a first subtype, the alignment is not set
+            --  with a specific alignment clause). We reset the alignment to
+            --  the appropriate value for the specified size. This is a nice
+            --  simple rule to implement and document.
+
+            --  There is one slight glitch, which is that a confirming size
+            --  clause can now change the alignment, which, if we really think
+            --  that confirming rep clauses should have no effect, is a no-no.
+
+            --    type R is new Character;
+            --    for R'Alignment use 2;
+            --    type S is new R;
+            --    for S'Size use Character'Size;
+
+            --  Now the alignment of S is 1 instead of 2, as a result of
+            --  applying the above rule to the confirming rep clause for S. Not
+            --  clear this is worth worrying about. If we recorded whether a
+            --  size clause was confirming we could avoid this, but right now
+            --  we have no way of doing that or easily figuring it out, so we
+            --  don't bother.
+
+            --  Historical note. In versions of GNAT prior to Nov 6th, 2010, an
+            --  odd distinction was made between inherited alignments greater
+            --  than the computed alignment (where the larger alignment was
+            --  inherited) and inherited alignments smaller than the computed
+            --  alignment (where the smaller alignment was overridden). This
+            --  was a dubious fix to get around an ACATS problem which seems
+            --  to have disappeared anyway, and in any case, this peculiarity
+            --  was never documented.
 
-         if Unknown_Alignment (E) or else Alignment (E) < A then
             Init_Alignment (E, A);
+
+         --  If no Size (or Object_Size) was specified, then we inherited the
+         --  object size, so we should inherit the alignment as well and not
+         --  modify it. This takes care of cases like:
+
+         --    type R is new Integer;
+         --    for R'Alignment use 1;
+         --    subtype S is R;
+
+         --  Here we have R has a default Object_Size of 32, and a specified
+         --  alignment of 1, and it seeems right for S to inherit both values.
+
+         else
+            null;
          end if;
       end;
    end Set_Elem_Alignment;
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 85b4024df8c..59884d24c73 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -2553,6 +2553,11 @@ package body Ch4 is
       Node1  : Node_Id;
 
    begin
+      if Ada_Version < Ada_2012 then
+         Error_Msg_SC ("quantified expression is an Ada 2012 feature");
+         Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
+      end if;
+
       Scan;  --  past FOR
 
       Node1 := New_Node (N_Quantified_Expression, Prev_Token_Ptr);
diff --git a/gcc/ada/s-atocou-builtin.adb b/gcc/ada/s-atocou-builtin.adb
index 8ec851e8f20..f230721af00 100644
--- a/gcc/ada/s-atocou-builtin.adb
+++ b/gcc/ada/s-atocou-builtin.adb
@@ -50,7 +50,12 @@ package body System.Atomic_Counters is
 
    function Decrement (Item : in out Atomic_Counter) return Boolean is
    begin
-      return Sync_Sub_And_Fetch (Item.Value'Access, 1) = 0;
+      --  Note: the use of Unrestricted_Access here is required because we
+      --  are obtaining an access-to-volatile pointer to a non-volatile object.
+      --  This is not allowed for [Unchecked_]Access, but is safe in this case
+      --  because we know that no aliases are being created.
+
+      return Sync_Sub_And_Fetch (Item.Value'Unrestricted_Access, 1) = 0;
    end Decrement;
 
    ---------------
@@ -59,7 +64,12 @@ package body System.Atomic_Counters is
 
    procedure Increment (Item : in out Atomic_Counter) is
    begin
-      Sync_Add_And_Fetch (Item.Value'Access, 1);
+      --  Note: the use of Unrestricted_Access here is required because we
+      --  are obtaining an access-to-volatile pointer to a non-volatile object.
+      --  This is not allowed for [Unchecked_]Access, but is safe in this case
+      --  because we know that no aliases are being created.
+
+      Sync_Add_And_Fetch (Item.Value'Unrestricted_Access, 1);
    end Increment;
 
    ------------
diff --git a/gcc/ada/s-finmas.adb b/gcc/ada/s-finmas.adb
index 8474ff4a8f3..918519b6781 100644
--- a/gcc/ada/s-finmas.adb
+++ b/gcc/ada/s-finmas.adb
@@ -181,6 +181,12 @@ package body System.Finalization_Masters is
 
       if Master.Finalization_Started then
          Unlock_Task.all;
+
+         --  Double finalization may occur during the handling of stand alone
+         --  libraries or the finalization of a pool with subpools. Due to the
+         --  potential aliasing of masters in these two cases, do not process
+         --  the same master twice.
+
          return;
       end if;
 
diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index 6773aaa1a54..4e69ea4b321 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -990,11 +990,18 @@ package body System.Task_Primitives.Operations is
       --  do not need to manipulate caller's signal mask at this point.
       --  All tasks in RTS will have All_Tasks_Mask initially.
 
-      Result := pthread_create
-        (T.Common.LL.Thread'Access,
-         Attributes'Access,
-         Thread_Body_Access (Wrapper),
-         To_Address (T));
+      --  Note: the use of Unrestricted_Access in the following call is needed
+      --  because otherwise we have an error of getting a access-to-volatile
+      --  value which points to a non-volatile object. But in this case it is
+      --  safe to do this, since we know we have no problems with aliasing and
+      --  Unrestricted_Access bypasses this check.
+
+      Result :=
+        pthread_create
+          (T.Common.LL.Thread'Unrestricted_Access,
+           Attributes'Access,
+           Thread_Body_Access (Wrapper),
+           To_Address (T));
 
       pragma Assert
         (Result = 0 or else Result = EAGAIN or else Result = ENOMEM);
diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb
index 92b6023bdff..e3134a5772d 100644
--- a/gcc/ada/s-taprop-vms.adb
+++ b/gcc/ada/s-taprop-vms.adb
@@ -811,7 +811,7 @@ package body System.Task_Primitives.Operations is
 
       Result :=
         pthread_create
-          (T.Common.LL.Thread'Access,
+          (T.Common.LL.Thread'Unrestricted_Access,
            Attributes'Access,
            Thread_Body_Access (Wrapper),
            To_Address (T));
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 8aa644aea64..87edd0e3218 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -726,13 +726,33 @@ package body Sem_Ch3 is
 
       --  If the access definition is the return type of another access to
       --  function, scope is the current one, because it is the one of the
-      --  current type declaration.
+      --  current type declaration, except for the pathological case below.
 
       if Nkind_In (Related_Nod, N_Object_Declaration,
                                 N_Access_Function_Definition)
       then
          Anon_Scope := Current_Scope;
 
+         --  A pathological case: function returning access functions that
+         --  return access functions, etc.  Each anonymous access type created
+         --  is in the enclosing scope of the outermost function.
+
+         declare
+            Par : Node_Id;
+         begin
+            Par := Related_Nod;
+            while Nkind_In (Par,
+                             N_Access_Function_Definition,
+                             N_Access_Definition)
+            loop
+               Par := Parent (Par);
+            end loop;
+
+            if Nkind (Par) = N_Function_Specification then
+               Anon_Scope := Scope (Defining_Entity (Par));
+            end if;
+         end;
+
       --  For the anonymous function result case, retrieve the scope of the
       --  function specification's associated entity rather than using the
       --  current scope. The current scope will be the function itself if the
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index ad59f952252..5798ae0fbef 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -11069,6 +11069,11 @@ package body Sem_Res is
               N);
          return True;
 
+      --  If it was legal in the generic, it's legal in the instance
+
+      elsif In_Instance_Body then
+         return True;
+
       --  If both are tagged types, check legality of view conversions
 
       elsif Is_Tagged_Type (Target_Type)
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index e1c2b1afe07..c073d20a056 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -8727,10 +8727,15 @@ package body Sem_Util is
       then
          return True;
 
-      elsif Nkind (N) = N_Indexed_Component
-        or else Nkind (N) = N_Selected_Component
+      elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component)
+        and then Is_Volatile_Prefix (Prefix (N))
       then
-         return Is_Volatile_Prefix (Prefix (N));
+         return True;
+
+      elsif Nkind (N) = N_Selected_Component
+        and then Is_Volatile (Entity (Selector_Name (N)))
+      then
+         return True;
 
       else
          return False;
@@ -10833,9 +10838,7 @@ package body Sem_Util is
                --  source. This excludes, for example, calls to a dispatching
                --  assignment operation when the left-hand side is tagged.
 
-               if Modification_Comes_From_Source
-                 or else Alfa_Mode
-               then
+               if Modification_Comes_From_Source or else Alfa_Mode then
                   Generate_Reference (Ent, Exp, 'm');
 
                   --  If the target of the assignment is the bound variable
diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads
index 1bf84af3955..1d13f6e60be 100644
--- a/gcc/ada/sinput.ads
+++ b/gcc/ada/sinput.ads
@@ -477,13 +477,13 @@ package Sinput is
 
    --  In addition to the set of characters defined by the type in Types, in
    --  wide character encoding, then the codes returning True for a call to
-   --  System.UTF_32.Is_UTF_32_Line_Terminator are also recognized as ending
-   --  a physical source line. This includes the standard codes defined above
-   --  in addition to NEL (NEXT LINE), LINE SEPARATOR and PARAGRAPH SEPARATOR.
-   --  Again, as in the case of VT and FF, the standard requires we recognize
-   --  these as line terminators, but we consider them to be logical line
-   --  terminators. The only physical line terminators recognized are the
-   --  standard ones (CR, LF, or CR/LF).
+   --  System.UTF_32.Is_UTF_32_Line_Terminator are also recognized as ending a
+   --  source line. This includes the standard codes defined above in addition
+   --  to NEL (NEXT LINE), LINE SEPARATOR and PARAGRAPH SEPARATOR. Again, as in
+   --  the case of VT and FF, the standard requires we recognize these as line
+   --  terminators, but we consider them to be logical line terminators. The
+   --  only physical line terminators recognized are the standard ones (CR,
+   --  LF, or CR/LF).
 
    --  However, we do not recognize the NEL (16#85#) character as having the
    --  significance of an end of line character when operating in normal 8-bit