[Ada] Spurious error on predicate of subtype in generic

This patch fixes a spurious error on a dynamic predicate of a record
subtype when the expression for the predicate includes a selected
component that denotes a component of the subtype.

2019-07-03  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch8.adb (Find_Selected_Component): If the prefix is the
	current instance of a type or subtype, complete the resolution
	of the name by finding the component of the type denoted by the
	selector name.

gcc/testsuite/

	* gnat.dg/predicate4.adb, gnat.dg/predicate4_pkg.ads: New
	testcase.

From-SVN: r272961
This commit is contained in:
Ed Schonberg 2019-07-03 08:13:41 +00:00 committed by Pierre-Marie de Rodat
parent 07ec36eed9
commit f51e316c7c
5 changed files with 67 additions and 2 deletions

View File

@ -1,3 +1,10 @@
2019-07-03 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb (Find_Selected_Component): If the prefix is the
current instance of a type or subtype, complete the resolution
of the name by finding the component of the type denoted by the
selector name.
2019-07-03 Eric Botcazou <ebotcazou@adacore.com>
* doc/gnat_rm/interfacing_to_other_languages.rst (Interfacing to C):

View File

@ -7418,10 +7418,28 @@ package body Sem_Ch8 is
-- It is not an error if the prefix is the current instance of
-- type name, e.g. the expression of a type aspect, when it is
-- analyzed for ASIS use.
-- analyzed for ASIS use, or within a generic unit. We still
-- have to verify that a component of that name exists, and
-- decorate the node accordingly.
elsif Is_Entity_Name (P) and then Is_Current_Instance (P) then
null;
declare
Comp : Entity_Id;
begin
Comp := First_Entity (Entity (P));
while Present (Comp) loop
if Chars (Comp) = Chars (Selector_Name (N)) then
Set_Entity (N, Comp);
Set_Etype (N, Etype (Comp));
Set_Entity (Selector_Name (N), Comp);
Set_Etype (Selector_Name (N), Etype (Comp));
return;
end if;
Next_Entity (Comp);
end loop;
end;
elsif Ekind (P_Name) = E_Void then
Premature_Usage (P);

View File

@ -1,3 +1,8 @@
2019-07-03 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/predicate4.adb, gnat.dg/predicate4_pkg.ads: New
testcase.
2019-07-03 Jakub Jelinek <jakub@redhat.com>
* c-c++-common/gomp/scan-3.c (f1): Don't expect a sorry message.

View File

@ -0,0 +1,19 @@
-- { dg-do compile }
-- { dg-options "-gnata" }
with System.Assertions; use System.Assertions;
with Predicate4_Pkg;
procedure Predicate4 is
type V is new Float;
package MXI2 is new Predicate4_Pkg (V);
use MXI2;
OK : Lt := (Has => False);
begin
declare
Wrong : Lt := (Has => True, MX => 3.14);
begin
raise Program_Error;
end;
exception
when Assert_Failure => null;
end;

View File

@ -0,0 +1,16 @@
generic
type Value_Type is private;
package Predicate4_Pkg is
type MT (Has : Boolean := False) is record
case Has is
when False =>
null;
when True =>
MX : Value_Type;
end case;
end record;
function Foo (M : MT) return Boolean is (not M.Has);
subtype LT is MT with Dynamic_Predicate => not LT.Has;
function Bar (M : MT) return Boolean is (Foo (M));
end;