[multiple changes]

2017-09-08  Arnaud Charlet  <charlet@adacore.com>

	* sem_util.ads, sem_util.adb (Is_CCT_Instance): Only expect
	entities of named concurrent types as Ref_Id and not of anonymous
	concurrent objects (because callers already know when a conversion
	is necessary and can easily do it); also, do not expect protected
	types or protected objects as Context_Id (because no flow-related
	SPARK pragmas are attached there); reflect these changes in a
	more precise comment.

2017-09-08  Olivier Hainque  <hainque@adacore.com>

	* g-altive.ads: Add documentation.

2017-09-08  Bob Duff  <duff@adacore.com>

	* sem_util.ads, debug.adb: Minor comment fix.
	* erroutc.ads: Comment fix.

2017-09-08  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Validate_Array_Type_Instance): Suppress check
	for compatibility of component types of formal and actual in an
	instantiation of a child unit,	when the component type of the
	formal is itself a formal of an enclosing generic.

From-SVN: r251872

8 files changed, 413 insertions, 62 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 8f5ef1b..471a5da 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,31 @@
 2017-09-08  Arnaud Charlet  <charlet@adacore.com>
 
+	* sem_util.ads, sem_util.adb (Is_CCT_Instance): Only expect
+	entities of named concurrent types as Ref_Id and not of anonymous
+	concurrent objects (because callers already know when a conversion
+	is necessary and can easily do it); also, do not expect protected
+	types or protected objects as Context_Id (because no flow-related
+	SPARK pragmas are attached there); reflect these changes in a
+	more precise comment.
+
+2017-09-08  Olivier Hainque  <hainque@adacore.com>
+
+	* g-altive.ads: Add documentation.
+
+2017-09-08  Bob Duff  <duff@adacore.com>
+
+	* sem_util.ads, debug.adb: Minor comment fix.
+	* erroutc.ads: Comment fix.
+
+2017-09-08  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch12.adb (Validate_Array_Type_Instance): Suppress check
+	for compatibility of component types of formal and actual in an
+	instantiation of a child unit,	when the component type of the
+	formal is itself a formal of an enclosing generic.
+
+2017-09-08  Arnaud Charlet  <charlet@adacore.com>
+
 	* sem_util.ads, sem_util.adb (Is_CCT_Instance): moved from
 	sem_prag.adb to make it available for GNATprove; for concurrent
 	types replace custom scope climbing with Scope_Same_Or_Within; for
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index 46a5d0e..03820fd 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -548,7 +548,7 @@ package body Debug is
 
    --  d.l  Use Ada 95 semantics for limited function returns. This may be
    --       used to work around the incompatibility introduced by AI-318-2.
-   --       It is useful only in -gnat05 mode.
+   --       It is useful only in Ada 2005 and later.
 
    --  d.m  When -gnatl is used, the normal output includes full listings of
    --       all files in the extended main source (body/spec/subunits). If this
diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 0fcc51b..9aa44e9 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2017, 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- --
@@ -192,13 +192,13 @@ package Erroutc is
       --  have Sptr pointing to the instantiation point.
 
       Optr : Source_Ptr;
-      --  Flag location used in the call to post the error. This is normally
-      --  the same as Sptr, except when an error is posted on a particular
-      --  instantiation of a generic. In such a case, Sptr will point to
-      --  the original source location of the instantiation itself, but
-      --  Optr will point to the template location (more accurately to the
-      --  template copy in the instantiation copy corresponding to the
-      --  instantiation referenced by Sptr).
+      --  Flag location used in the call to post the error. This is the same as
+      --  Sptr, except when an error is posted on a particular instantiation of
+      --  a generic. In such a case, Sptr will point to the original source
+      --  location of the instantiation itself, but Optr will point to the
+      --  template location (more accurately to the template copy in the
+      --  instantiation copy corresponding to the instantiation referenced by
+      --  Sptr).
 
       Line : Physical_Line_Number;
       --  Line number for error message
diff --git a/gcc/ada/g-altive.ads b/gcc/ada/g-altive.ads
index 27b9915..1e247b3 100644
--- a/gcc/ada/g-altive.ads
+++ b/gcc/ada/g-altive.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2017, 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- --
@@ -86,22 +86,22 @@
 --          |                |                |             |
 --    Vector_Types   Vector_Operations   Vector_Views   Conversions
 
---  The user can manipulate vectors through two families of types: Vector
+--  Users can manipulate vectors through two families of types: Vector
 --  types and View types.
 
---  Vector types are defined in the GNAT.Altivec.Vector_Types package
+--  Vector types are available through the Vector_Types and Vector_Operations
+--  packages, which implement the core binding to the AltiVec API, as
+--  described in [PIM-2.1 data types] and [PIM-4 AltiVec operations and
+--  predicates].
 
---  On these types, users can apply the Altivec operations defined in
---  GNAT.Altivec.Vector_Operations. Their layout is opaque and may vary across
---  configurations, for it is typically target-endianness dependant.
+--  The layout of Vector objects is dependant on the target machine
+--  endianness, and View types were devised to offer a higher level user
+--  interface. With Views, a vector of 4 uints (1, 2, 3, 4) is always declared
+--  with a VUI_View := (Values => (1, 2, 3, 4)), element 1 first, natural
+--  notation to denote the element values, and indexed notation is available
+--  to access individual elements.
 
---  Vector_Types and Vector_Operations implement the core binding to the
---  AltiVec API, as described in [PIM-2.1 data types] and [PIM-4 AltiVec
---  operations and predicates].
-
---  View types are defined in the GNAT.Altivec.Vector_Views package
-
---  These types do not represent Altivec vectors per se, in the sense that the
+--  View types do not represent Altivec vectors per se, in the sense that the
 --  Altivec_Operations are not available for them. They are intended to allow
 --  Vector initializations as well as access to the Vector component values.
 
@@ -123,6 +123,9 @@
 --  The "hard" version would map to real AltiVec instructions via GCC builtins
 --  and inlining.
 
+--  See the "Design Notes" section below for additional details on the
+--  internals.
+
 -------------------
 -- Example usage --
 -------------------
@@ -425,3 +428,339 @@ private
    CR6_LT_REV : constant := 3;
 
 end GNAT.Altivec;
+
+--------------------
+--  Design Notes  --
+--------------------
+
+------------------------
+-- General principles --
+------------------------
+
+--  The internal organization has been devised from a number of driving ideas:
+
+--  o From the clients standpoint, the two versions of the binding should be
+--    as easily exchangable as possible,
+
+--  o From the maintenance standpoint, we want to avoid as much code
+--    duplication as possible.
+
+--  o From both standpoints above, we want to maintain a clear interface
+--    separation between the base bindings to the Motorola API and the
+--    additional facilities.
+
+--  The identification of the low level interface is directly inspired by the
+--  the base API organization, basically consisting of a rich set of functions
+--  around a core of low level primitives mapping to AltiVec instructions.
+
+--  See for instance "vec_add" in [PIM-4.4 Generic and Specific AltiVec
+--  operations]: no less than six result/arguments combinations of byte vector
+--  types map to "vaddubm".
+
+--  The "hard" version of the low level primitives map to real AltiVec
+--  instructions via the corresponding GCC builtins. The "soft" version is
+--  a software emulation of those.
+
+---------------------------------------
+-- The Low_Level_Vectors abstraction --
+---------------------------------------
+
+--  The AltiVec C interface spirit is to map a large set of C functions down
+--  to a much smaller set of AltiVec instructions, most of them operating on a
+--  set of vector data types in a transparent manner. See for instance the
+--  case of vec_add, which maps six combinations of result/argument types to
+--  vaddubm for signed/unsigned/bool variants of 'char' components.
+
+--  The GCC implementation of this idiom for C/C++ is to setup builtins
+--  corresponding to the instructions and to expose the C user function as
+--  wrappers around those builtins with no-op type conversions as required.
+--  Typically, for the vec_add case mentioned above, we have (altivec.h):
+--
+--    inline __vector signed char
+--    vec_add (__vector signed char a1, __vector signed char a2)
+--    {
+--      return (__vector signed char)
+--        __builtin_altivec_vaddubm ((__vector signed char) a1,
+--                                   (__vector signed char) a2);
+--    }
+
+--    inline __vector unsigned char
+--    vec_add (__vector __bool char a1, __vector unsigned char a2)
+--    {
+--      return (__vector unsigned char)
+--        __builtin_altivec_vaddubm ((__vector signed char) a1,
+--                                   (__vector signed char) a2);
+--    }
+
+--  The central idea for the Ada bindings is to leverage on the existing GCC
+--  architecture, with the introduction of a Low_Level_Vectors abstraction.
+--  This abstaction acts as a representative of the vector-types and builtins
+--  compiler interface for either the Hard or the Soft case.
+
+--  For the Hard binding, Low_Level_Vectors exposes data types with a GCC
+--  internal translation identical to the "vector ..." C types, and a set of
+--  subprograms mapping straight to the internal GCC builtins.
+
+--  For the Soft binding, Low_Level_Vectors exposes the same set of types
+--  and subprograms, with bodies simulating the instructions behavior.
+
+--  Vector_Types/Operations "simply" bind the user types and operations to
+--  some Low_Level_Vectors implementation, selected in accordance with the
+--  target
+
+--  To achieve a complete Hard/Soft independence in the Vector_Types and
+--  Vector_Operations implementations, both versions of the low level support
+--  are expected to expose a number of facilities:
+
+--  o Private data type declarations for base vector representations embedded
+--    in the user visible vector types, that is:
+
+--      LL_VBC, LL_VUC and LL_VSC
+--        for vector_bool_char, vector_unsigned_char and vector_signed_char
+
+--      LL_VBS, LL_VUS and LL_VSS
+--        for vector_bool_short, vector_unsigned_short and vector_signed_short
+
+--      LL_VBI, LL_VUI and LL_VSI
+--        for vector_bool_int, vector_unsigned_int and vector_signed_int
+
+--    as well as:
+
+--      LL_VP for vector_pixel and LL_VF for vector_float
+
+--  o Primitive operations corresponding to the AltiVec hardware instruction
+--    names, like "vaddubm". The whole set is not described here. The actual
+--    sets are inspired from the GCC builtins which are invoked from GCC's
+--    "altivec.h".
+
+--  o An LL_Altivec convention identifier, specifying the calling convention
+--    to be used to access the aforementioned primitive operations.
+
+--  Besides:
+
+--  o Unchecked_Conversion are expected to be allowed between any pair of
+--    exposed data types, and are expected to have no effect on the value
+--    bit patterns.
+
+-------------------------
+-- Vector views layout --
+-------------------------
+
+--  Vector Views combine intuitive user level ordering for both elements
+--  within a vector and bytes within each element. They basically map to an
+--  array representation where array(i) always represents element (i), in the
+--  natural target representation. This way, a user vector (1, 2, 3, 4) is
+--  represented as:
+
+--                                                       Increasing Addresses
+--  ------------------------------------------------------------------------->
+
+--  | 0x0 0x0 0x0 0x1 | 0x0 0x0 0x0 0x2 | 0x0 0x0 0x0 0x3 | 0x0 0x0 0x0 0x4 |
+--  | V (0), BE       | V (1), BE       | V (2), BE       | V (3), BE       |
+
+--  on a big endian target, and as:
+
+--  | 0x1 0x0 0x0 0x0 | 0x2 0x0 0x0 0x0 | 0x3 0x0 0x0 0x0 | 0x4 0x0 0x0 0x0 |
+--  | V (0), LE       | V (1), LE       | V (2), LE       | V (3), LE       |
+
+--  on a little-endian target
+
+-------------------------
+-- Vector types layout --
+-------------------------
+
+--  In the case of the hard binding, the layout of the vector type in
+--  memory is documented by the Altivec documentation. In the case of the
+--  soft binding, the simplest solution is to represent a vector as an
+--  array of components. This representation can depend on the endianness.
+--  We can consider three possibilities:
+
+--  * First component at the lowest address, components in big endian format.
+--  It is the natural way to represent an array in big endian, and it would
+--  also be the natural way to represent a quad-word integer in big endian.
+
+--  Example:
+
+--  Let V be a vector of unsigned int which value is (1, 2, 3, 4). It is
+--  represented as:
+
+--                                                           Addresses growing
+--  ------------------------------------------------------------------------->
+--  | 0x0 0x0 0x0 0x1 | 0x0 0x0 0x0 0x2 | 0x0 0x0 0x0 0x3 | 0x0 0x0 0x0 0x4 |
+--  | V (0), BE       | V (1), BE       | V (2), BE       | V (3), BE       |
+
+--  * First component at the lowest address, components in little endian
+--  format. It is the natural way to represent an array in little endian.
+
+--  Example:
+
+--  Let V be a vector of unsigned int which value is (1, 2, 3, 4). It is
+--  represented as:
+
+--                                                           Addresses growing
+--  ------------------------------------------------------------------------->
+--  | 0x1 0x0 0x0 0x0 | 0x2 0x0 0x0 0x0 | 0x3 0x0 0x0 0x0 | 0x4 0x0 0x0 0x0 |
+--  | V (0), LE       | V (1), LE       | V (2), LE       | V (3), LE       |
+
+--  * Last component at the lowest address, components in little endian format.
+--  It is the natural way to represent a quad-word integer in little endian.
+
+--  Example:
+
+--  Let V be a vector of unsigned int which value is (1, 2, 3, 4). It is
+--  represented as:
+
+--                                                           Addresses growing
+--  ------------------------------------------------------------------------->
+--  | 0x4 0x0 0x0 0x0 | 0x3 0x0 0x0 0x0 | 0x2 0x0 0x0 0x0 | 0x1 0x0 0x0 0x0 |
+--  | V (3), LE       | V (2), LE       | V (1), LE       | V (0), LE       |
+
+--  There is actually a fourth case (components in big endian, first
+--  component at the lowest address), but it does not have any interesting
+--  properties: it is neither the natural way to represent a quad-word on any
+--  machine, nor the natural way to represent an array on any machine.
+
+--  Example:
+
+--  Let V be a vector of unsigned int which value is (1, 2, 3, 4). It is
+--  represented as:
+
+--                                                           Addresses growing
+--  ------------------------------------------------------------------------->
+--  | 0x0 0x0 0x0 0x4 | 0x0 0x0 0x0 0x3 | 0x0 0x0 0x0 0x2 | 0x0 0x0 0x0 0x1 |
+--  | V (3), BE       | V (2), BE       | V (1), BE       | V (0), BE       |
+
+--  Most of the Altivec operations are specific to a component size, and
+--  can be implemented with any of these three formats. But some operations
+--  are defined by the same Altivec primitive operation for different type
+--  sizes:
+
+--  * operations doing arithmetics on a complete vector, seen as a quad-word;
+--  * operations dealing with memory.
+
+--  Operations on a complete vector:
+--  --------------------------------
+
+--  Examples:
+
+--  vec_sll/vsl : shift left on the entire vector.
+--  vec_slo/vslo: shift left on the entire vector, by octet.
+
+--  Those operations works on vectors seens as a quad-word.
+--  Let us suppose that we have a conversion operation named To_Quad_Word
+--  for converting vector types to a quad-word.
+
+--  Let A be a Altivec vector of 16 components:
+--  A = (A(0), A(1), A(2), A(3), ... , A(14), A(15))
+--  Let B be a Altivec vector of 8 components verifying:
+--  B = (A(0) |8| A(1), A(2) |8| A(3), ... , A(14) |8| A(15))
+--  Let C be a Altivec vector of 4 components verifying:
+--  C = (A(0)  |8| A(1)  |8| A(2)  |8| A(3), ... ,
+--       A(12) |8| A(13) |8| A(14) |8| A(15))
+
+--  (definition: |8| is the concatenation operation between two bytes;
+--  i.e. 0x1 |8| 0x2 = 0x0102)
+
+--  According to [PIM - 4.2 byte ordering], we have the following property:
+--  To_Quad_Word (A) = To_Quad_Word (B) = To_Quad_Word (C)
+
+--  Let To_Type_Of_A be a conversion operation from the type of B to the
+--  type of A.  The quad-word operations are only implemented by one
+--  Altivec primitive operation.  That means that, if QW_Operation is a
+--  quad-word operation, we should have:
+--  QW_Operation (To_Type_of_A (B)) = QW_Operation (A)
+
+--  That is true iff:
+--  To_Quad_Word (To_Type_of_A (B)) = To_Quad_Word (A)
+
+--  As To_Quad_Word is a bijection. we have:
+--  To_Type_of_A (B) = A
+
+--  resp. any combination of A, B, C:
+--  To_Type_of_A (C) = A
+--  To_Type_of_B (A) = B
+--  To_Type_of_C (B) = C
+--  ...
+
+--  Making sure that the properties described above are verified by the
+--  conversion operations between vector types has different implications
+--  depending on the layout of the vector types:
+--  * with format 1 and 3: only a unchecked conversion is needed;
+--  * with format 2 and 4: some reorganisation is needed for conversions
+--  between vector types with different component sizes; that has a cost on the
+--  efficiency, plus the complexity of having different memory pattern for
+--  the same quad-word value, depending on the type.
+
+--  Operation dealing with memory:
+--  ------------------------------
+
+--  These operations are either load operation (vec_ld and the
+--  corresponding primitive operation: vlx) or store operation (vec_st
+--  and the corresponding primitive operation: vstx).
+
+--  According to [PIM 4.4 - vec_ld], those operations take in input
+--  either an access to a vector (e.g. a const_vector_unsigned_int_ptr)
+--  or an access to a flow of components (e.g. a const_unsigned_int_ptr),
+--  relying on the same Altivec primitive operations. That means that both
+--  should have the same representation in memory.
+
+--  For the stream, it is easier to adopt the format of the target. That
+--  means that, in memory, the components of the vector should also have the
+--  format of the target. meaning that we will prefer:
+--  * On a big endian target: format 1 or 4
+--  * On a little endian target: format 2 or 3
+
+--  Conclusion:
+--  -----------
+
+--  To take into consideration the constraint brought about by the routines
+--  operating on quad-words and the routines operating on memory, the best
+--  choice seems to be:
+
+--  * On a big endian target: format 1;
+--  * On a little endian target: format 3.
+
+--  Those layout choices are enforced by GNAT.Altivec.Low_Level_Conversions,
+--  which is the endianness-dependant unit providing conversions between
+--  vector views and vector types.
+
+----------------------
+--  Layouts summary --
+----------------------
+
+--  For a user abstract vector of 4 uints (1, 2, 3, 4), increasing
+--  addresses from left to right:
+
+--  =========================================================================
+--                 BIG ENDIAN TARGET MEMORY LAYOUT for (1, 2, 3, 4)
+--  =========================================================================
+
+--                                    View
+--  -------------------------------------------------------------------------
+--  | 0x0 0x0 0x0 0x1 | 0x0 0x0 0x0 0x2 | 0x0 0x0 0x0 0x3 | 0x0 0x0 0x0 0x4 |
+--  | V (0), BE       | V (1), BE       | V (2), BE       | V (3), BE       |
+--  -------------------------------------------------------------------------
+
+--                                   Vector
+--  -------------------------------------------------------------------------
+--  | 0x0 0x0 0x0 0x1 | 0x0 0x0 0x0 0x2 | 0x0 0x0 0x0 0x3 | 0x0 0x0 0x0 0x4 |
+--  | V (0), BE       | V (1), BE       | V (2), BE       | V (3), BE       |
+--  -------------------------------------------------------------------------
+
+--  =========================================================================
+--              LITTLE ENDIAN TARGET MEMORY LAYOUT for (1, 2, 3, 4)
+--  =========================================================================
+
+--                                    View
+--  -------------------------------------------------------------------------
+--  | 0x1 0x0 0x0 0x0 | 0x2 0x0 0x0 0x0 | 0x3 0x0 0x0 0x0 | 0x4 0x0 0x0 0x0 |
+--  | V (0), LE       | V (1), LE       | V (2), LE       | V (3), LE       |
+
+--                                    Vector
+--  -------------------------------------------------------------------------
+--  | 0x4 0x0 0x0 0x0 | 0x3 0x0 0x0 0x0 | 0x2 0x0 0x0 0x0 | 0x1 0x0 0x0 0x0 |
+--  | V (3), LE       | V (2), LE       | V (1), LE       | V (0), LE       |
+--  -------------------------------------------------------------------------
+
+--  These layouts are common to both the soft and hard implementations on
+--  Altivec capable targets.
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 6e4a4f9..69f5818 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -12080,7 +12080,10 @@ package body Sem_Ch12 is
          --  for static matching has failed. The case where both the component
          --  type and the array type are separate formals, and the component
          --  type is a private view may also require special checking in
-         --  Subtypes_Match.
+         --  Subtypes_Match. Finally, we assume that a child instance where
+         --  the component type comes from a formal of a parent instance is
+         --  correct because the generic was correct. A more precise check
+         --  seems too complex to install???
 
          if Subtypes_Match
            (Component_Type (A_Gen_T), Component_Type (Act_T))
@@ -12088,6 +12091,9 @@ package body Sem_Ch12 is
                Subtypes_Match
                  (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T),
                   Component_Type (Act_T))
+            or else
+              (not Inside_A_Generic
+                 and then Is_Child_Unit (Scope (Component_Type (A_Gen_T))))
          then
             null;
          else
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index ed4622e..c9a0243 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -971,7 +971,7 @@ package body Sem_Prag is
                      --  (SPARK RM 6.1.4).
 
                      elsif Is_Single_Task_Object (Item_Id)
-                       and then Is_CCT_Instance (Item_Id, Spec_Id)
+                       and then Is_CCT_Instance (Etype (Item_Id), Spec_Id)
                      then
                         Current_Task_Instance_Seen;
                      end if;
@@ -2218,7 +2218,7 @@ package body Sem_Prag is
                --  is the same single type (SPARK RM 6.1.4).
 
                elsif Is_Single_Concurrent_Object (Item_Id)
-                 and then Is_CCT_Instance (Item_Id, Spec_Id)
+                 and then Is_CCT_Instance (Etype (Item_Id), Spec_Id)
                then
                   --  Pragma [Refined_]Global associated with a protected
                   --  subprogram cannot mention the current instance of a
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 8fe3e1a..465d141 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -12391,38 +12391,17 @@ package body Sem_Util is
       Context_Id : Entity_Id) return Boolean
    is
    begin
-      pragma Assert
-        (Is_Entry (Context_Id)
-           or else
-         Ekind_In (Context_Id, E_Function,
-                               E_Procedure,
-                               E_Protected_Type,
-                               E_Task_Type)
-           or else
-         Is_Single_Concurrent_Object (Context_Id));
-
-      --  When the reference denotes a single protected type, the context is
-      --  either a protected subprogram or its body.
-
-      if Is_Single_Protected_Object (Ref_Id) then
-         return Scope_Within (Context_Id, Etype (Ref_Id));
-
-      --  When the reference denotes a single task type, the context is either
-      --  the same type or if inside the body, the anonymous task object.
-
-      elsif Is_Single_Task_Object (Ref_Id) then
-         if Is_Single_Task_Object (Context_Id) then
-            return Context_Id = Ref_Id;
-
-         elsif Ekind (Context_Id) = E_Task_Type then
-            return Context_Id = Etype (Ref_Id);
-
-         else
-            return Scope_Within_Or_Same (Context_Id, Etype (Ref_Id));
-         end if;
+      pragma Assert (Ekind_In (Ref_Id, E_Protected_Type, E_Task_Type));
 
+      if Is_Single_Task_Object (Context_Id) then
+         return Scope_Within_Or_Same (Etype (Context_Id), Ref_Id);
       else
-         pragma Assert (Ekind_In (Ref_Id, E_Protected_Type, E_Task_Type));
+         pragma Assert
+           (Is_Entry (Context_Id)
+              or else
+            Ekind_In (Context_Id, E_Function,
+                                  E_Procedure,
+                                  E_Task_Type));
 
          return Scope_Within_Or_Same (Context_Id, Ref_Id);
       end if;
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 1477dcd..a17179f 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -1297,11 +1297,11 @@ package Sem_Util is
    --  Returns true if the last character of E is Suffix. Used in Assertions.
 
    function Has_Tagged_Component (Typ : Entity_Id) return Boolean;
-   --  Returns True if Typ is a composite type (array or record) which is
-   --  either itself a tagged type, or has a component (recursively) which is
-   --  a tagged type. Returns False for non-composite type, or if no tagged
-   --  component is present. This function is used to check if "=" has to be
-   --  expanded into a bunch component comparisons.
+   --  Returns True if Typ is a composite type (array or record) that is either
+   --  a tagged type or has a subcomponent that is tagged. Returns False for a
+   --  noncomposite type, or if no tagged subcomponents are present. This
+   --  function is used to check if "=" has to be expanded into a bunch
+   --  component comparisons.
 
    function Has_Undefined_Reference (Expr : Node_Id) return Boolean;
    --  Given arbitrary expression Expr, determine whether it contains at
@@ -1480,8 +1480,9 @@ package Sem_Util is
      (Ref_Id     : Entity_Id;
       Context_Id : Entity_Id) return Boolean;
    --  Subsidiary to the analysis of pragmas [Refined_]Depends and [Refined_]
-   --  Global. Determine whether entity Ref_Id denotes the current instance of
-   --  a concurrent type. Context_Id denotes the associated context where the
+   --  Global. Determine whether entity Ref_Id (which must represent either
+   --  a protected type or a task type) denotes the current instance of a
+   --  concurrent type. Context_Id denotes the associated context where the
    --  pragma appears.
 
    function Is_Child_Or_Sibling