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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-07-03 Ed Schonberg <schonb...@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.--- gcc/ada/sem_ch8.adb
+++ gcc/ada/sem_ch8.adb
@@ -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);
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/predicate4.adb
@@ -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;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/predicate4_pkg.ads
@@ -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;
