2016-04-18 Eric Botcazou <ebotcazou@adacore.com>

	* layout.adb (Set_Elem_Alignment): Extend setting of alignment
	to subtypes that are not first subtypes.

2016-04-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.ads (Collect_Inherited_Class_Wide_Conditions):
	Simplify interface.
	* sem_prag.adb (Collect_Inherited_Class_Wide_Conditions): Insert
	generated pragmas after subprogram declaration, rather than in
	the corresponding subprogram body.
	* sem_ch6.adb (New_Overloaded_Entity): In GNATProve
	mode, if the operation is overridding, call
	Collect_Inherited_Class_Wide_Conditions to generate the
	corresponding pragmas immediately after the corresponding
	subprogram declaration.

2016-04-18  Arnaud Charlet  <charlet@adacore.com>

	* spark_xrefs.ads (Xref_Index, Scope_Index, File_Index): restrict
	type to natural numbers.
	(Stype): document code characters for concurrent entities.

2016-04-18  Olivier Hainque  <hainque@adacore.com>

	* targparm.ads: Update the Frontend_Exceptions default internal
	value.
	(Frontend_Exceptions_On_Target): Change default value to True.

2016-04-18  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_Selected_Component): Refine error
	detection when a selected component in the body of a synchronized
	type is a reference to an object of the same type declared
	elsewhere. The construct is legal if the prefix of the selected
	component includes an explicit dereference at any point.



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

1 files changed, 36 insertions, 13 deletions

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index bdcf0e112e1..04b9dbd9f4c 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -4657,21 +4657,44 @@ package body Sem_Ch4 is
          end loop;
 
          --  If the scope is a current instance, the prefix cannot be an
-         --  expression of the same type (that would represent an attempt
-         --  to reach an internal operation of another synchronized object).
+         --  expression of the same type, unless the selector designates a
+         --  public operation (otherwise that would represent an attempt to
+         --  reach an internal entity of another synchronized object).
          --  This is legal if prefix is an access to such type and there is
-         --  a dereference.
+         --  a dereference, or is a component with a dereferenced prefix.
 
-         if In_Scope
-           and then not Is_Entity_Name (Name)
-           and then Nkind (Name) /= N_Explicit_Dereference
-         then
-            Error_Msg_NE
-              ("invalid reference to internal operation of some object of "
-               & "type &", N, Type_To_Use);
-            Set_Entity (Sel, Any_Id);
-            Set_Etype  (Sel, Any_Type);
-            return;
+         if In_Scope and then not Is_Entity_Name (Name) then
+            declare
+
+               function Has_Dereference (N : Node_Id) return Boolean;
+               --  Check whether prefix includes a dereference at any level.
+
+               ---------------------
+               -- Has_Dereference --
+               ---------------------
+
+               function Has_Dereference (N : Node_Id) return Boolean is
+               begin
+                  if Nkind (N) = N_Explicit_Dereference then
+                     return True;
+                  elsif
+                    Nkind_In (N, N_Selected_Component, N_Indexed_Component)
+                  then
+                     return Has_Dereference (Prefix (N));
+                  else
+                     return False;
+                  end if;
+               end Has_Dereference;
+
+            begin
+               if not Has_Dereference (Name) then
+                  Error_Msg_NE ("invalid reference to internal operation "
+                     & "of some object of type &", N, Type_To_Use);
+                  Set_Entity (Sel, Any_Id);
+                  Set_Etype  (Sel, Any_Type);
+                  return;
+               end if;
+            end;
          end if;
 
          --  If there is no visible entity with the given name or none of the