[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:
parent
07ec36eed9
commit
f51e316c7c
|
@ -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):
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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;
|
|
@ -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;
|
Loading…
Reference in New Issue