Commit 8334176a by Ed Schonberg Committed by Pierre-Marie de Rodat

[Ada] Spurious error on dynamic predicate in a generic context

This patch fixes a spurious error on the conformance checking between
the expression for an aspect analyzed at the freeze point of the type,
and the analysis of a copy of the expression performed at the end of the
enclosing list of declarationss. In a generic context the first may not
have been analyzed yet and this must be done before the conformance
check.

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

gcc/ada/

	* sem_ch13.adb (Analyze_Attribute_Definition_Clause): No error
	message on attribute applied to a renaming when the renamed
	object is an aggregate (from code reading).
	(Check_Aspect_At_End_Of_Declarations): In a generic context
	where freeze nodes are not generated, the original expression
	for an aspect may need to be analyzed to precent spurious
	conformance errors when compared with the expression that is
	anakyzed at the end of the current declarative list.

gcc/testsuite/

	* gnat.dg/predicate5.adb, gnat.dg/predicate5.ads: New testcase.

From-SVN: r272969
parent 09c9ed5b
2019-07-03 Ed Schonberg <schonberg@adacore.com>
* sem_ch13.adb (Analyze_Attribute_Definition_Clause): No error
message on attribute applied to a renaming when the renamed
object is an aggregate (from code reading).
(Check_Aspect_At_End_Of_Declarations): In a generic context
where freeze nodes are not generated, the original expression
for an aspect may need to be analyzed to precent spurious
conformance errors when compared with the expression that is
anakyzed at the end of the current declarative list.
2019-07-03 Eric Botcazou <ebotcazou@adacore.com> 2019-07-03 Eric Botcazou <ebotcazou@adacore.com>
* layout.adb (Layout_Type): Do not set the component size of an * layout.adb (Layout_Type): Do not set the component size of an
......
...@@ -4934,8 +4934,12 @@ package body Sem_Ch13 is ...@@ -4934,8 +4934,12 @@ package body Sem_Ch13 is
and then Present (Renamed_Object (Ent)) and then Present (Renamed_Object (Ent))
then then
-- Case of renamed object from source, this is an error -- Case of renamed object from source, this is an error
-- unless the pbject is an aggregate and the renaming is
-- created for an object declaration.
if Comes_From_Source (Renamed_Object (Ent)) then if Comes_From_Source (Renamed_Object (Ent))
and then Nkind (Renamed_Object (Ent)) /= N_Aggregate
then
Get_Name_String (Chars (N)); Get_Name_String (Chars (N));
Error_Msg_Strlen := Name_Len; Error_Msg_Strlen := Name_Len;
Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len); Error_Msg_String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
...@@ -9336,6 +9340,16 @@ package body Sem_Ch13 is ...@@ -9336,6 +9340,16 @@ package body Sem_Ch13 is
-- All other cases -- All other cases
else else
-- In a generic context freeze nodes are not always generated,
-- so analyze the expression now.
if not Analyzed (Freeze_Expr)
and then Inside_A_Generic
then
Preanalyze (Freeze_Expr);
end if;
-- Indicate that the expression comes from an aspect specification, -- Indicate that the expression comes from an aspect specification,
-- which is used in subsequent analysis even if expansion is off. -- which is used in subsequent analysis even if expansion is off.
......
2019-07-03 Ed Schonberg <schonberg@adacore.com>
* gnat.dg/predicate5.adb, gnat.dg/predicate5.ads: New testcase.
2019-07-03 Eric Botcazou <ebotcazou@adacore.com> 2019-07-03 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/alignment14.adb: New testcase. * gnat.dg/alignment14.adb: New testcase.
......
-- { dg-do compile }
package body Predicate5 is
procedure Foo is null;
end Predicate5;
generic
type Value_Type is private;
package Predicate5 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));
procedure Foo;
end;
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