einfo.ads: Comment fix.

gcc/ada/

2017-12-15  Bob Duff  <duff@adacore.com>

	* einfo.ads: Comment fix.

2017-12-15  Piotr Trojanek  <trojanek@adacore.com>

	* s-vercon.adb: Minor style fixes.

2017-12-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Freeze_Expr_Types): Do not emit a freeze node for an
	itype that is the type of a discriminant-dependent component.

2017-12-15  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Analyze_Part_Of): The context-specific portion of the
	analysis is now directed to several specialized routines.
	(Check_Part_Of_Abstract_State): New routine.
	(Check_Part_Of_Concurrent_Type): New routine. Reimplement the checks
	involving the item, the single concurrent type, and their respective
	contexts.
	* sem_res.adb (Resolve_Entity_Name): Potential constituents of a single
	concurrent type are now recorded regardless of the SPARK mode.
	* sem_util.adb (Check_Part_Of_Reference): Split some of the tests in
	individual predicates.  A Part_Of reference is legal when it appears
	within the statement list of the object's immediately enclosing
	package.
	(Is_Enclosing_Package_Body): New routine.
	(Is_Internal_Declaration_Or_Body): New routine.
	(Is_Single_Declaration_Or_Body): New routine.
	(Is_Single_Task_Pragma): New routine.

gcc/testsuite/

2017-12-15  Ed Schonberg  <schonberg@adacore.com>

	* gnat.dg/expr_func2.ads, gnat.dg/expr_func2.adb: New testcase.

From-SVN: r255690

11 files changed, 493 insertions, 199 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a25f0ae..e07fc18 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,35 @@
+2017-12-15  Bob Duff  <duff@adacore.com>
+
+	* einfo.ads: Comment fix.
+
+2017-12-15  Piotr Trojanek  <trojanek@adacore.com>
+
+	* s-vercon.adb: Minor style fixes.
+
+2017-12-15  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch6.adb (Freeze_Expr_Types): Do not emit a freeze node for an
+	itype that is the type of a discriminant-dependent component.
+
+2017-12-15  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* sem_prag.adb (Analyze_Part_Of): The context-specific portion of the
+	analysis is now directed to several specialized routines.
+	(Check_Part_Of_Abstract_State): New routine.
+	(Check_Part_Of_Concurrent_Type): New routine. Reimplement the checks
+	involving the item, the single concurrent type, and their respective
+	contexts.
+	* sem_res.adb (Resolve_Entity_Name): Potential constituents of a single
+	concurrent type are now recorded regardless of the SPARK mode.
+	* sem_util.adb (Check_Part_Of_Reference): Split some of the tests in
+	individual predicates.  A Part_Of reference is legal when it appears
+	within the statement list of the object's immediately enclosing
+	package.
+	(Is_Enclosing_Package_Body): New routine.
+	(Is_Internal_Declaration_Or_Body): New routine.
+	(Is_Single_Declaration_Or_Body): New routine.
+	(Is_Single_Task_Pragma): New routine.
+
 2017-12-15  Patrick Bernardi  <bernardi@adacore.com>
 
 	* gnat_ugn.texi: Regenerate.
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 7a8dd80..bb5b5e9 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -649,7 +649,7 @@ package Einfo is
 --       Defined in E_Record_Subtype and E_Class_Wide_Subtype entities.
 --       Each such entity can either have a Discriminant_Constraint, in
 --       which case it represents a distinct type from the base type (and
---       will have a list of components and discrimants in the list headed by
+--       will have a list of components and discriminants in the list headed by
 --       First_Entity) or else no such constraint, in which case it will be a
 --       copy of the base type.
 --
diff --git a/gcc/ada/libgnat/s-vercon.adb b/gcc/ada/libgnat/s-vercon.adb
index ddecc16c..d54a743 100644
--- a/gcc/ada/libgnat/s-vercon.adb
+++ b/gcc/ada/libgnat/s-vercon.adb
@@ -38,7 +38,7 @@ package body System.Version_Control is
    ------------------------
 
    function Get_Version_String
-     (V    : System.Unsigned_Types.Unsigned)
+     (V : System.Unsigned_Types.Unsigned)
       return Version_String
    is
       S : Version_String;
diff --git a/gcc/ada/libgnat/s-vercon.ads b/gcc/ada/libgnat/s-vercon.ads
index 903c4a6..352f503 100644
--- a/gcc/ada/libgnat/s-vercon.ads
+++ b/gcc/ada/libgnat/s-vercon.ads
@@ -39,10 +39,10 @@ package System.Version_Control is
    pragma Pure;
 
    subtype Version_String is String (1 .. 8);
-   --  Eight character string returned by Get_version_String;
+   --  Eight character string returned by Get_version_String
 
    function Get_Version_String
-     (V    : System.Unsigned_Types.Unsigned)
+     (V : System.Unsigned_Types.Unsigned)
       return Version_String;
    --  The version information in the executable file is stored as unsigned
    --  integers. This routine converts the unsigned integer into an eight
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 9477c28..163952b 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -366,10 +366,13 @@ package body Sem_Ch6 is
 
             procedure Check_And_Freeze_Type (Typ : Entity_Id) is
             begin
-               --  Skip Itypes created by the preanalysis
+               --  Skip Itypes created by the preanalysis, and itypes
+               --  whose scope is another type (i.e. component subtypes
+               --  that depend on a discriminant),
 
                if Is_Itype (Typ)
-                 and then Scope_Within_Or_Same (Scope (Typ), Def_Id)
+                 and then (Scope_Within_Or_Same (Scope (Typ), Def_Id)
+                   or else Is_Type (Scope (Typ)))
                then
                   return;
                end if;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 16113e1..d342906 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3168,71 +3168,26 @@ package body Sem_Prag is
       Encap_Id : out Entity_Id;
       Legal    : out Boolean)
    is
-      Encap_Typ   : Entity_Id;
-      Item_Decl   : Node_Id;
-      Pack_Id     : Entity_Id;
-      Placement   : State_Space_Kind;
-      Parent_Unit : Entity_Id;
+      procedure Check_Part_Of_Abstract_State;
+      pragma Inline (Check_Part_Of_Abstract_State);
+      --  Verify the legality of indicator Part_Of when the encapsulator is an
+      --  abstract state.
 
-   begin
-      --  Assume that the indicator is illegal
-
-      Encap_Id := Empty;
-      Legal    := False;
-
-      if Nkind_In (Encap, N_Expanded_Name,
-                          N_Identifier,
-                          N_Selected_Component)
-      then
-         Analyze       (Encap);
-         Resolve_State (Encap);
-
-         Encap_Id := Entity (Encap);
-
-         --  The encapsulator is an abstract state
-
-         if Ekind (Encap_Id) = E_Abstract_State then
-            null;
-
-         --  The encapsulator is a single concurrent type (SPARK RM 9.3)
-
-         elsif Is_Single_Concurrent_Object (Encap_Id) then
-            null;
-
-         --  Otherwise the encapsulator is not a legal choice
-
-         else
-            SPARK_Msg_N
-              ("indicator Part_Of must denote abstract state, single "
-               & "protected type or single task type", Encap);
-            return;
-         end if;
-
-      --  This is a syntax error, always report
-
-      else
-         Error_Msg_N
-           ("indicator Part_Of must denote abstract state, single protected "
-            & "type or single task type", Encap);
-         return;
-      end if;
-
-      --  Catch a case where indicator Part_Of denotes the abstract view of a
-      --  variable which appears as an abstract state (SPARK RM 10.1.2 2).
-
-      if From_Limited_With (Encap_Id)
-        and then Present (Non_Limited_View (Encap_Id))
-        and then Ekind (Non_Limited_View (Encap_Id)) = E_Variable
-      then
-         SPARK_Msg_N ("indicator Part_Of must denote abstract state", Encap);
-         SPARK_Msg_N ("\& denotes abstract view of object", Encap);
-         return;
-      end if;
+      procedure Check_Part_Of_Concurrent_Type;
+      pragma Inline (Check_Part_Of_Concurrent_Type);
+      --  Verify the legality of indicator Part_Of when the encapsulator is a
+      --  single concurrent type.
 
-      --  The encapsulator is an abstract state
+      ----------------------------------
+      -- Check_Part_Of_Abstract_State --
+      ----------------------------------
 
-      if Ekind (Encap_Id) = E_Abstract_State then
+      procedure Check_Part_Of_Abstract_State is
+         Pack_Id     : Entity_Id;
+         Placement   : State_Space_Kind;
+         Parent_Unit : Entity_Id;
 
+      begin
          --  Determine where the object, package instantiation or state lives
          --  with respect to the enclosing packages or package bodies.
 
@@ -3250,6 +3205,7 @@ package body Sem_Prag is
             SPARK_Msg_N
               ("indicator Part_Of cannot appear in this context "
                & "(SPARK RM 7.2.6(5))", Indic);
+
             Error_Msg_Name_1 := Chars (Scope (Encap_Id));
             SPARK_Msg_NE
               ("\& is not part of the hidden state of package %",
@@ -3267,14 +3223,14 @@ package body Sem_Prag is
               and then Is_Private_Descendant (Pack_Id)
             then
                --  A variable or state abstraction which is part of the visible
-               --  state of a private child unit (or one of its public
-               --  descendants) must have its Part_Of indicator specified. The
-               --  Part_Of indicator must denote a state abstraction declared
-               --  by either the parent unit of the private unit or by a public
-               --  descendant of that parent unit.
+               --  state of a private child unit or its public descendants must
+               --  have its Part_Of indicator specified. The Part_Of indicator
+               --  must denote a state declared by either the parent unit of
+               --  the private unit or by a public descendant of that parent
+               --  unit.
 
-               --  Find nearest private ancestor (which can be the current unit
-               --  itself).
+               --  Find the nearest private ancestor (which can be the current
+               --  unit itself).
 
                Parent_Unit := Pack_Id;
                while Present (Parent_Unit) loop
@@ -3288,8 +3244,8 @@ package body Sem_Prag is
 
                if not Is_Child_Or_Sibling (Pack_Id, Scope (Encap_Id)) then
                   SPARK_Msg_NE
-                    ("indicator Part_Of must denote abstract state of & "
-                     & "or of its public descendant (SPARK RM 7.2.6(3))",
+                    ("indicator Part_Of must denote abstract state of & or of "
+                     & "its public descendant (SPARK RM 7.2.6(3))",
                      Indic, Parent_Unit);
                   return;
 
@@ -3302,8 +3258,8 @@ package body Sem_Prag is
 
                else
                   SPARK_Msg_NE
-                    ("indicator Part_Of must denote abstract state of & "
-                     & "or of its public descendant (SPARK RM 7.2.6(3))",
+                    ("indicator Part_Of must denote abstract state of & or of "
+                     & "its public descendant (SPARK RM 7.2.6(3))",
                      Indic, Parent_Unit);
                   return;
                end if;
@@ -3315,6 +3271,7 @@ package body Sem_Prag is
                SPARK_Msg_N
                  ("indicator Part_Of cannot appear in this context "
                   & "(SPARK RM 7.2.6(5))", Indic);
+
                Error_Msg_Name_1 := Chars (Pack_Id);
                SPARK_Msg_NE
                  ("\& is declared in the visible part of package %",
@@ -3330,6 +3287,7 @@ package body Sem_Prag is
                SPARK_Msg_NE
                  ("indicator Part_Of must denote an abstract state of "
                   & "package & (SPARK RM 7.2.6(2))", Indic, Pack_Id);
+
                Error_Msg_Name_1 := Chars (Pack_Id);
                SPARK_Msg_NE
                  ("\& is declared in the private part of package %",
@@ -3354,11 +3312,77 @@ package body Sem_Prag is
             return;
          end if;
 
-      --  The encapsulator is a single concurrent type
+         --  At this point it is known that the Part_Of indicator is legal
 
-      else
-         Encap_Typ := Etype (Encap_Id);
+         Legal := True;
+      end Check_Part_Of_Abstract_State;
+
+      -----------------------------------
+      -- Check_Part_Of_Concurrent_Type --
+      -----------------------------------
 
+      procedure Check_Part_Of_Concurrent_Type is
+         function In_Proper_Order
+           (First  : Node_Id;
+            Second : Node_Id) return Boolean;
+         pragma Inline (In_Proper_Order);
+         --  Determine whether node First precedes node Second
+
+         procedure Placement_Error;
+         pragma Inline (Placement_Error);
+         --  Emit an error concerning the illegal placement of the item with
+         --  respect to the single concurrent type.
+
+         ---------------------
+         -- In_Proper_Order --
+         ---------------------
+
+         function In_Proper_Order
+           (First  : Node_Id;
+            Second : Node_Id) return Boolean
+         is
+            N : Node_Id;
+
+         begin
+            if List_Containing (First) = List_Containing (Second) then
+               N := First;
+               while Present (N) loop
+                  if N = Second then
+                     return True;
+                  end if;
+
+                  Next (N);
+               end loop;
+            end if;
+
+            return False;
+         end In_Proper_Order;
+
+         ---------------------
+         -- Placement_Error --
+         ---------------------
+
+         procedure Placement_Error is
+         begin
+            SPARK_Msg_N
+              ("indicator Part_Of must denote a previously declared single "
+               & "protected type or single task type", Encap);
+         end Placement_Error;
+
+         --  Local variables
+
+         Conc_Typ      : constant Entity_Id := Etype (Encap_Id);
+         Encap_Decl    : constant Node_Id   := Declaration_Node (Encap_Id);
+         Encap_Context : constant Node_Id   := Parent (Encap_Decl);
+
+         Item_Context : Node_Id;
+         Item_Decl    : Node_Id;
+         Prv_Decls    : List_Id;
+         Vis_Decls    : List_Id;
+
+      --  Start of processing for Check_Part_Of_Concurrent_Type
+
+      begin
          --  Only abstract states and variables can act as constituents of an
          --  encapsulating single concurrent type.
 
@@ -3370,7 +3394,7 @@ package body Sem_Prag is
          elsif Ekind (Item_Id) = E_Constant then
             Error_Msg_Name_1 := Chars (Encap_Id);
             SPARK_Msg_NE
-              (Fix_Msg (Encap_Typ, "constant & cannot act as constituent of "
+              (Fix_Msg (Conc_Typ, "constant & cannot act as constituent of "
                & "single protected type %"), Indic, Item_Id);
             return;
 
@@ -3379,7 +3403,7 @@ package body Sem_Prag is
          else
             Error_Msg_Name_1 := Chars (Encap_Id);
             SPARK_Msg_NE
-              (Fix_Msg (Encap_Typ, "package instantiation & cannot act as "
+              (Fix_Msg (Conc_Typ, "package instantiation & cannot act as "
                & "constituent of single protected type %"), Indic, Item_Id);
             return;
          end if;
@@ -3398,64 +3422,159 @@ package body Sem_Prag is
             Item_Decl := Declaration_Node (Item_Id);
          end if;
 
-         --  Both the item and its encapsulating single concurrent type must
-         --  appear in the same declarative region (SPARK RM 9.3). Note that
-         --  privacy is ignored.
+         Item_Context := Parent (Item_Decl);
+
+         --  The item and the single concurrent type must appear in the same
+         --  declarative region, with the item following the declaration of
+         --  the single concurrent type (SPARK RM 9(3)).
+
+         if Item_Context = Encap_Context then
+            if Nkind_In (Item_Context, N_Package_Specification,
+                                       N_Protected_Definition,
+                                       N_Task_Definition)
+            then
+               Prv_Decls := Private_Declarations (Item_Context);
+               Vis_Decls := Visible_Declarations (Item_Context);
+
+               --  The placement is OK when the single concurrent type appears
+               --  within the visible declarations and the item in the private
+               --  declarations.
+               --
+               --    package Pack is
+               --       protected PO ...
+               --    private
+               --       Constit : ... with Part_Of => PO;
+               --    end Pack;
+
+               if List_Containing (Encap_Decl) = Vis_Decls
+                 and then List_Containing (Item_Decl) = Prv_Decls
+               then
+                  null;
+
+               --  The placement is illegal when the item appears within the
+               --  visible declarations and the single concurrent type is in
+               --  the private declarations.
+               --
+               --    package Pack is
+               --       Constit : ... with Part_Of => PO;
+               --    private
+               --       protected PO ...
+               --    end Pack;
+
+               elsif List_Containing (Item_Decl) = Vis_Decls
+                 and then List_Containing (Encap_Decl) = Prv_Decls
+               then
+                  Placement_Error;
+                  return;
+
+               --  Otherwise both the item and the single concurrent type are
+               --  in the same list. Ensure that the declaration of the single
+               --  concurrent type precedes that of the item.
+
+               elsif not In_Proper_Order
+                           (First  => Encap_Decl,
+                            Second => Item_Decl)
+               then
+                  Placement_Error;
+                  return;
+               end if;
+
+            --  Otherwise both the item and the single concurrent type are
+            --  in the same list. Ensure that the declaration of the single
+            --  concurrent type precedes that of the item.
+
+            elsif not In_Proper_Order
+                        (First  => Encap_Decl,
+                         Second => Item_Decl)
+            then
+               Placement_Error;
+               return;
+            end if;
+
+         --  Otherwise the item and the single concurrent type reside within
+         --  unrelated regions.
 
-         if Parent (Item_Decl) /= Parent (Declaration_Node (Encap_Id)) then
+         else
             Error_Msg_Name_1 := Chars (Encap_Id);
             SPARK_Msg_NE
-              (Fix_Msg (Encap_Typ, "constituent & must be declared "
+              (Fix_Msg (Conc_Typ, "constituent & must be declared "
                & "immediately within the same region as single protected "
                & "type %"), Indic, Item_Id);
             return;
          end if;
 
-         --  The declaration of the item should follow the declaration of its
-         --  encapsulating single concurrent type and must appear in the same
-         --  declarative region (SPARK RM 9.3).
+         --  At this point it is known that the Part_Of indicator is legal
 
-         declare
-            N : Node_Id;
+         Legal := True;
+      end Check_Part_Of_Concurrent_Type;
 
-         begin
-            N := Next (Declaration_Node (Encap_Id));
-            while Present (N) loop
-               exit when N = Item_Decl;
-               Next (N);
-            end loop;
+   --  Start of processing for Analyze_Part_Of
 
-            --  The single concurrent type might be in the visible part of a
-            --  package, and the declaration of the item in the private part
-            --  of the same package.
+   begin
+      --  Assume that the indicator is illegal
 
-            if No (N) then
-               declare
-                  Pack : constant Node_Id :=
-                           Parent (Declaration_Node (Encap_Id));
-               begin
-                  if Nkind (Pack) = N_Package_Specification
-                    and then not In_Private_Part (Encap_Id)
-                  then
-                     N := First (Private_Declarations (Pack));
-                     while Present (N) loop
-                        exit when N = Item_Decl;
-                        Next (N);
-                     end loop;
-                  end if;
-               end;
-            end if;
+      Encap_Id := Empty;
+      Legal    := False;
 
-            if No (N) then
-               SPARK_Msg_N
-                 ("indicator Part_Of must denote a previously declared "
-                  & "single protected type or single task type", Encap);
-               return;
-            end if;
-         end;
+      if Nkind_In (Encap, N_Expanded_Name,
+                          N_Identifier,
+                          N_Selected_Component)
+      then
+         Analyze       (Encap);
+         Resolve_State (Encap);
+
+         Encap_Id := Entity (Encap);
+
+         --  The encapsulator is an abstract state
+
+         if Ekind (Encap_Id) = E_Abstract_State then
+            null;
+
+         --  The encapsulator is a single concurrent type (SPARK RM 9.3)
+
+         elsif Is_Single_Concurrent_Object (Encap_Id) then
+            null;
+
+         --  Otherwise the encapsulator is not a legal choice
+
+         else
+            SPARK_Msg_N
+              ("indicator Part_Of must denote abstract state, single "
+               & "protected type or single task type", Encap);
+            return;
+         end if;
+
+      --  This is a syntax error, always report
+
+      else
+         Error_Msg_N
+           ("indicator Part_Of must denote abstract state, single protected "
+            & "type or single task type", Encap);
+         return;
       end if;
 
-      Legal := True;
+      --  Catch a case where indicator Part_Of denotes the abstract view of a
+      --  variable which appears as an abstract state (SPARK RM 10.1.2 2).
+
+      if From_Limited_With (Encap_Id)
+        and then Present (Non_Limited_View (Encap_Id))
+        and then Ekind (Non_Limited_View (Encap_Id)) = E_Variable
+      then
+         SPARK_Msg_N ("indicator Part_Of must denote abstract state", Encap);
+         SPARK_Msg_N ("\& denotes abstract view of object", Encap);
+         return;
+      end if;
+
+      --  The encapsulator is an abstract state
+
+      if Ekind (Encap_Id) = E_Abstract_State then
+         Check_Part_Of_Abstract_State;
+
+      --  The encapsulator is a single concurrent type
+
+      else
+         Check_Part_Of_Concurrent_Type;
+      end if;
    end Analyze_Part_Of;
 
    ----------------------------------
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 5c87fa1..e48d5e9 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -7380,15 +7380,15 @@ package body Sem_Res is
             then
                Check_Elab_Call (N);
             end if;
+         end if;
 
-            --  The variable may eventually become a constituent of a single
-            --  protected/task type. Record the reference now and verify its
-            --  legality when analyzing the contract of the variable
-            --  (SPARK RM 9.3).
+         --  The variable may eventually become a constituent of a single
+         --  protected/task type. Record the reference now and verify its
+         --  legality when analyzing the contract of the variable
+         --  (SPARK RM 9.3).
 
-            if Ekind (E) = E_Variable then
-               Record_Possible_Part_Of_Reference (E, N);
-            end if;
+         if Ekind (E) = E_Variable then
+            Record_Possible_Part_Of_Reference (E, N);
          end if;
 
          --  A Ghost entity must appear in a specific context
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 688ad7b..248a9b7 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -3281,72 +3281,200 @@ package body Sem_Util is
    -----------------------------
 
    procedure Check_Part_Of_Reference (Var_Id : Entity_Id; Ref : Node_Id) is
+      function Is_Enclosing_Package_Body
+        (Body_Decl : Node_Id;
+         Obj_Id    : Entity_Id) return Boolean;
+      pragma Inline (Is_Enclosing_Package_Body);
+      --  Determine whether package body Body_Decl or its corresponding spec
+      --  immediately encloses the declaration of object Obj_Id.
+
+      function Is_Internal_Declaration_Or_Body
+        (Decl : Node_Id) return Boolean;
+      pragma Inline (Is_Internal_Declaration_Or_Body);
+      --  Determine whether declaration or body denoted by Decl is internal
+
+      function Is_Single_Declaration_Or_Body
+        (Decl     : Node_Id;
+         Conc_Typ : Entity_Id) return Boolean;
+      pragma Inline (Is_Single_Declaration_Or_Body);
+      --  Determine whether protected/task declaration or body denoted by Decl
+      --  belongs to single concurrent type Conc_Typ.
+
+      function Is_Single_Task_Pragma
+        (Prag     : Node_Id;
+         Task_Typ : Entity_Id) return Boolean;
+      pragma Inline (Is_Single_Task_Pragma);
+      --  Determine whether pragma Prag belongs to single task type Task_Typ
+
+      -------------------------------
+      -- Is_Enclosing_Package_Body --
+      -------------------------------
+
+      function Is_Enclosing_Package_Body
+        (Body_Decl : Node_Id;
+         Obj_Id    : Entity_Id) return Boolean
+      is
+         Obj_Context : Node_Id;
+
+      begin
+         --  Find the context of the object declaration
+
+         Obj_Context := Parent (Declaration_Node (Obj_Id));
+
+         if Nkind (Obj_Context) = N_Package_Specification then
+            Obj_Context := Parent (Obj_Context);
+         end if;
+
+         --  The object appears immediately within the package body
+
+         if Obj_Context = Body_Decl then
+            return True;
+
+         --  The object appears immediately within the corresponding spec
+
+         elsif Nkind (Obj_Context) = N_Package_Declaration
+           and then Unit_Declaration_Node (Corresponding_Spec (Body_Decl)) =
+                      Obj_Context
+         then
+            return True;
+         end if;
+
+         return False;
+      end Is_Enclosing_Package_Body;
+
+      -------------------------------------
+      -- Is_Internal_Declaration_Or_Body --
+      -------------------------------------
+
+      function Is_Internal_Declaration_Or_Body
+        (Decl : Node_Id) return Boolean
+      is
+      begin
+         if Comes_From_Source (Decl) then
+            return False;
+
+         --  A body generated for an expression function which has not been
+         --  inserted into the tree yet (In_Spec_Expression is True) is not
+         --  considered internal.
+
+         elsif Nkind (Decl) = N_Subprogram_Body
+           and then Was_Expression_Function (Decl)
+           and then not In_Spec_Expression
+         then
+            return False;
+         end if;
+
+         return True;
+      end Is_Internal_Declaration_Or_Body;
+
+      -----------------------------------
+      -- Is_Single_Declaration_Or_Body --
+      -----------------------------------
+
+      function Is_Single_Declaration_Or_Body
+        (Decl     : Node_Id;
+         Conc_Typ : Entity_Id) return Boolean
+      is
+         Spec_Id : constant Entity_Id := Unique_Defining_Entity (Decl);
+
+      begin
+         return
+           Present (Anonymous_Object (Spec_Id))
+             and then Anonymous_Object (Spec_Id) = Conc_Typ;
+      end Is_Single_Declaration_Or_Body;
+
+      ---------------------------
+      -- Is_Single_Task_Pragma --
+      ---------------------------
+
+      function Is_Single_Task_Pragma
+        (Prag     : Node_Id;
+         Task_Typ : Entity_Id) return Boolean
+      is
+         Decl : constant Node_Id := Find_Related_Declaration_Or_Body (Prag);
+
+      begin
+         --  To qualify, the pragma must be associated with single task type
+         --  Task_Typ.
+
+         return
+           Is_Single_Task_Object (Task_Typ)
+             and then Nkind (Decl) = N_Object_Declaration
+             and then Defining_Entity (Decl) = Task_Typ;
+      end Is_Single_Task_Pragma;
+
+      --  Local variables
+
       Conc_Obj : constant Entity_Id := Encapsulating_State (Var_Id);
-      Decl     : Node_Id;
-      OK_Use   : Boolean := False;
       Par      : Node_Id;
       Prag_Nam : Name_Id;
-      Spec_Id  : Entity_Id;
+      Prev     : Node_Id;
+
+   --  Start of processing for Check_Part_Of_Reference
 
    begin
+      --  Nothing to do when the variable was recorded, but did not become a
+      --  constituent of a single concurrent type.
+
+      if No (Conc_Obj) then
+         return;
+      end if;
+
       --  Traverse the parent chain looking for a suitable context for the
       --  reference to the concurrent constituent.
 
-      Par := Parent (Ref);
+      Prev := Ref;
+      Par  := Parent (Prev);
       while Present (Par) loop
          if Nkind (Par) = N_Pragma then
             Prag_Nam := Pragma_Name (Par);
 
             --  A concurrent constituent is allowed to appear in pragmas
             --  Initial_Condition and Initializes as this is part of the
-            --  elaboration checks for the constituent (SPARK RM 9.3).
+            --  elaboration checks for the constituent (SPARK RM 9(3)).
 
             if Nam_In (Prag_Nam, Name_Initial_Condition, Name_Initializes) then
-               OK_Use := True;
-               exit;
+               return;
 
             --  When the reference appears within pragma Depends or Global,
             --  check whether the pragma applies to a single task type. Note
-            --  that the pragma is not encapsulated by the type definition,
+            --  that the pragma may not encapsulated by the type definition,
             --  but this is still a valid context.
 
-            elsif Nam_In (Prag_Nam, Name_Depends, Name_Global) then
-               Decl := Find_Related_Declaration_Or_Body (Par);
-
-               if Nkind (Decl) = N_Object_Declaration
-                 and then Defining_Entity (Decl) = Conc_Obj
-               then
-                  OK_Use := True;
-                  exit;
-               end if;
+            elsif Nam_In (Prag_Nam, Name_Depends, Name_Global)
+              and then Is_Single_Task_Pragma (Par, Conc_Obj)
+            then
+               return;
             end if;
 
-         --  The reference appears somewhere in the definition of the single
-         --  protected/task type (SPARK RM 9.3).
+         --  The reference appears somewhere in the definition of a single
+         --  concurrent type (SPARK RM 9(3)).
 
          elsif Nkind_In (Par, N_Single_Protected_Declaration,
                               N_Single_Task_Declaration)
            and then Defining_Entity (Par) = Conc_Obj
          then
-            OK_Use := True;
-            exit;
+            return;
 
-         --  The reference appears within the expanded declaration or the body
-         --  of the single protected/task type (SPARK RM 9.3).
+         --  The reference appears within the declaration or body of a single
+         --  concurrent type (SPARK RM 9(3)).
 
          elsif Nkind_In (Par, N_Protected_Body,
                               N_Protected_Type_Declaration,
                               N_Task_Body,
                               N_Task_Type_Declaration)
+           and then Is_Single_Declaration_Or_Body (Par, Conc_Obj)
          then
-            Spec_Id := Unique_Defining_Entity (Par);
+            return;
 
-            if Present (Anonymous_Object (Spec_Id))
-              and then Anonymous_Object (Spec_Id) = Conc_Obj
-            then
-               OK_Use := True;
-               exit;
-            end if;
+         --  The reference appears within the statement list of the object's
+         --  immediately enclosing package (SPARK RM 9(3)).
+
+         elsif Nkind (Par) = N_Package_Body
+           and then Nkind (Prev) = N_Handled_Sequence_Of_Statements
+           and then Is_Enclosing_Package_Body (Par, Var_Id)
+         then
+            return;
 
          --  The reference has been relocated within an internally generated
          --  package or subprogram. Assume that the reference is legal as the
@@ -3357,25 +3485,9 @@ package body Sem_Util is
                               N_Package_Declaration,
                               N_Subprogram_Body,
                               N_Subprogram_Declaration)
-           and then not Comes_From_Source (Par)
+           and then Is_Internal_Declaration_Or_Body (Par)
          then
-            --  Continue to examine the context if the reference appears in a
-            --  subprogram body which was previously an expression function,
-            --  unless this is during preanalysis (when In_Spec_Expression is
-            --  True), as the body may not yet be inserted in the tree.
-
-            if Nkind (Par) = N_Subprogram_Body
-              and then Was_Expression_Function (Par)
-              and then not In_Spec_Expression
-            then
-               null;
-
-            --  Otherwise the reference is legal
-
-            else
-               OK_Use := True;
-               exit;
-            end if;
+            return;
 
          --  The reference has been relocated to an inlined body for GNATprove.
          --  Assume that the reference is legal as the real check was already
@@ -3385,30 +3497,27 @@ package body Sem_Util is
            and then Nkind (Par) = N_Subprogram_Body
            and then Chars (Defining_Entity (Par)) = Name_uParent
          then
-            OK_Use := True;
-            exit;
+            return;
          end if;
 
-         Par := Parent (Par);
+         Prev := Par;
+         Par  := Parent (Prev);
       end loop;
 
-      --  The reference is illegal as it appears outside the definition or
-      --  body of the single protected/task type.
+      --  At this point it is known that the reference does not appear within a
+      --  legal context.
 
-      if not OK_Use then
-         Error_Msg_NE
-           ("reference to variable & cannot appear in this context",
-            Ref, Var_Id);
-         Error_Msg_Name_1 := Chars (Var_Id);
+      Error_Msg_NE
+        ("reference to variable & cannot appear in this context", Ref, Var_Id);
+      Error_Msg_Name_1 := Chars (Var_Id);
 
-         if Is_Single_Protected_Object (Conc_Obj) then
-            Error_Msg_NE
-              ("\% is constituent of single protected type &", Ref, Conc_Obj);
+      if Is_Single_Protected_Object (Conc_Obj) then
+         Error_Msg_NE
+           ("\% is constituent of single protected type &", Ref, Conc_Obj);
 
-         else
-            Error_Msg_NE
-              ("\% is constituent of single task type &", Ref, Conc_Obj);
-         end if;
+      else
+         Error_Msg_NE
+           ("\% is constituent of single task type &", Ref, Conc_Obj);
       end if;
    end Check_Part_Of_Reference;
 
@@ -22127,7 +22236,7 @@ package body Sem_Util is
    begin
       --  The variable is a constituent of a single protected/task type. Such
       --  a variable acts as a component of the type and must appear within a
-      --  specific region (SPARK RM 9.3). Instead of recording the reference,
+      --  specific region (SPARK RM 9(3)). Instead of recording the reference,
       --  verify its legality now.
 
       if Present (Encap) and then Is_Single_Concurrent_Object (Encap) then
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e8d45ac..8f2075b 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2017-12-15  Ed Schonberg  <schonberg@adacore.com>
+
+	* gnat.dg/expr_func2.ads, gnat.dg/expr_func2.adb: New testcase.
+
 2017-12-15  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* gnat.dg/dflt_init_cond.adb, gnat.dg/dflt_init_cond_pkg.ads: New
diff --git a/gcc/testsuite/gnat.dg/expr_func2.adb b/gcc/testsuite/gnat.dg/expr_func2.adb
new file mode 100644
index 0000000..ef366c6
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/expr_func2.adb
@@ -0,0 +1,5 @@
+--  { dg-do compile }
+
+package body Expr_Func2 is
+   procedure Foo is null;
+end Expr_Func2;
diff --git a/gcc/testsuite/gnat.dg/expr_func2.ads b/gcc/testsuite/gnat.dg/expr_func2.ads
new file mode 100644
index 0000000..bd68f86
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/expr_func2.ads
@@ -0,0 +1,22 @@
+package Expr_Func2 is
+
+   type T_Index is range 1 .. 255;
+
+   type T_Table is array (T_Index range <>) of Boolean;
+
+   type T_Variable_Table (N : T_Index := T_Index'First) is record
+      Table : T_Table (1 .. N);
+   end record;
+
+   type T_A_Variable_Table is access T_Variable_Table;
+
+   function Element (A_Variable_Table : T_A_Variable_Table) return Boolean;
+
+private
+
+   function Element (A_Variable_Table : T_A_Variable_Table) return Boolean is
+     (A_Variable_Table.all.Table (1));
+
+   procedure Foo;
+
+end Expr_Func2;