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 <schonb...@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.
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.
