Commit 27de857e by Gary Dismukes Committed by Pierre-Marie de Rodat

[Ada] Illegal selection of first object in a task type's body not detected

The compiler was improperly allowing selection of an object declared
within a task body when the prefix was of the task type, specifically in
the case where the object was the very first declared in the body
(selections of later body declarations were being flagged).  The flag
Is_Private_Op was only set at the point of the first "private"
declaration of the type in cases where the first declaration's name
didn't match the selector.

2019-08-14  Gary Dismukes  <dismukes@adacore.com>

gcc/ada/

	* sem_ch4.adb (Analyze_Selected_Component): In the case where
	the prefix is of a concurrent type, and the selected entity
	matching the selector is the first private declaration of the
	type (such as the first local variable in a task's body), set
	Is_Private_Op.

gcc/testsuite/

	* gnat.dg/task5.adb: New testcase.

From-SVN: r274446
parent bc1f44ef
2019-08-14 Gary Dismukes <dismukes@adacore.com>
* sem_ch4.adb (Analyze_Selected_Component): In the case where
the prefix is of a concurrent type, and the selected entity
matching the selector is the first private declaration of the
type (such as the first local variable in a task's body), set
Is_Private_Op.
2019-08-14 Piotr Trojanek <trojanek@adacore.com> 2019-08-14 Piotr Trojanek <trojanek@adacore.com>
* einfo.adb (Is_Generic_Actual_Subprogram): Replace repeated * einfo.adb (Is_Generic_Actual_Subprogram): Replace repeated
......
...@@ -4994,7 +4994,15 @@ package body Sem_Ch4 is ...@@ -4994,7 +4994,15 @@ package body Sem_Ch4 is
if Comp = First_Private_Entity (Type_To_Use) then if Comp = First_Private_Entity (Type_To_Use) then
if Etype (Sel) /= Any_Type then if Etype (Sel) /= Any_Type then
-- We have a candiate -- If the first private entity's name matches, then treat
-- it as a private op: needed for the error check for
-- illegal selection of private entities further below.
if Chars (Comp) = Chars (Sel) then
Is_Private_Op := True;
end if;
-- We have a candidate, so exit the loop
exit; exit;
......
2019-08-14 Gary Dismukes <dismukes@adacore.com>
* gnat.dg/task5.adb: New testcase.
2019-08-14 Richard Biener <rguenther@suse.de> 2019-08-14 Richard Biener <rguenther@suse.de>
PR testsuite/91419 PR testsuite/91419
......
procedure Task5 is
task type T is
entry E (V1, V2 : Integer);
end T;
T_Obj : T;
task body T is
V1 : Integer;
V2 : Integer;
V3 : Integer;
begin
accept E (V1, V2 : Integer) do
T.V1 := V1;
T.V2 := V2;
T_Obj.V1 := V1; -- { dg-error "invalid reference to private operation of some object of type \"T\"" }
T_Obj.V2 := V2; -- { dg-error "invalid reference to private operation of some object of type \"T\"" }
T_Obj.V3 := V3; -- { dg-error "invalid reference to private operation of some object of type \"T\"" }
end E;
end T;
begin
null;
end Task5;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment