[Ada] Crash on illegal selected component in synchronized body.

[Ada] Crash on illegal selected component in synchronized body.

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 2037 bytes --]

The prefix of a selected component in a synchronized body cannot denote
a component of the synchronized type unless the prefix is an entity name.
This was not properly rejected before.

Compiling bakery.adb must yield:

bakery.adb:44:35: invalid reference to internal operation of some object
   of type "Bakery_Instance_Task"

---
procedure Bakery is

   N        : Natural := 10; -- Number of Processes [Customers]

   type Integer_Array is array (1 .. N) of Integer;

   type Ticket_And_Queue_Number is record
      R : Natural; -- Ticket Number [Lamport 'Number']
      A : Natural; -- Queue Number  [Lamport 'Choosing']
   end record;

   task type Bakery_Instance_Task is
      entry Initialize(ID : Natural);
   end Bakery_Instance_Task;

   Bakery_Array : array (1 .. N) of Bakery_Instance_Task;

   task body Bakery_Instance_Task is

      R   : Natural; -- This task's current ticket number [Lamport 'Number']
      A   : Integer_Array := (1 .. N => 0);
      ID0 : Natural;

      TQN : Ticket_And_Queue_Number;

      function Read_TQN(J : in     Natural) return Ticket_And_Queue_Number is
         TQN : Ticket_And_Queue_Number;
      begin
         TQN := (R => R,
                 A => A(J));
         return TQN;
      end Read_TQN;
   begin
      accept Initialize(ID : Natural) do
         R := 0;
         A := (1 .. N => 0);
         ID0 := ID;
      end Initialize;
      -- Start
      R := 1;
      A(ID0) := 1;
      for J in 1 .. N loop
         if J /= ID0 then
            TQN := Bakery_Array(J).Read_TQN(J => J);
         end if;
      end loop;
   end Bakery_Instance_Task;

begin
   for I in 1 .. N loop
      Bakery_Array(I).Initialize(ID => I);
   end loop;
end Bakery;

Tested on x86_64-pc-linux-gnu, committed on trunk

2015-11-12  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_Selected_Component): Diagnose an attempt
	to reference an internal entity from a synchronized type from
	within the body of that type, when the prefix of the selected
	component is not the current instance.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 1228 bytes --]

Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb	(revision 230241)
+++ sem_ch4.adb	(working copy)
@@ -4655,6 +4655,23 @@
                    Comp = First_Private_Entity (Base_Type (Prefix_Type));
          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).
+         --  This is legal if prefix is an access to such type and there is
+         --  a dereference.
+
+         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;
+         end if;
+
          --  If there is no visible entity with the given name or none of the
          --  visible entities are plausible interpretations, check whether
          --  there is some other primitive operation with that name.