From: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri, 27 Jan 2023 14:13:07 +0000 (+0100)
Subject: ada: Fix internal error on chain of predicated record types
X-Git-Tag: basepoints/gcc-15~9240
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=5f8a29bd3487a60cf513c4976769b7dc0113f227;p=thirdparty%2Fgcc.git

ada: Fix internal error on chain of predicated record types

The preanalysis of a predicate set on one of the record types was causing
premature freezing of another record type.

gcc/ada/

	* sem_ch13.adb: Add with and use clauses for Expander.
	(Resolve_Aspect_Expressions) <Aspect_Predicate>: Emulate a
	bona-fide preanalysis setup before calling
	Resolve_Aspect_Expression.
---

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 1c7572282419..a4a5084793e0 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -38,6 +38,7 @@ with Exp_Ch3;          use Exp_Ch3;
 with Exp_Disp;         use Exp_Disp;
 with Exp_Tss;          use Exp_Tss;
 with Exp_Util;         use Exp_Util;
+with Expander;         use Expander;
 with Freeze;           use Freeze;
 with Ghost;            use Ghost;
 with Lib;              use Lib;
@@ -15625,15 +15626,29 @@ package body Sem_Ch13 is
                      --  Preanalyze expression after type replacement to catch
                      --  name resolution errors if the predicate function has
                      --  not been built yet.
+
                      --  Note that we cannot use Preanalyze_Spec_Expression
-                     --  because of the special handling required for
-                     --  quantifiers, see comments on Resolve_Aspect_Expression
-                     --  above.
+                     --  directly because of the special handling required for
+                     --  quantifiers (see comments on Resolve_Aspect_Expression
+                     --  above) but we need to emulate it properly.
 
                      if No (Predicate_Function (E)) then
-                        Push_Type (E);
-                        Resolve_Aspect_Expression (Expr);
-                        Pop_Type (E);
+                        declare
+                           Save_In_Spec_Expression : constant Boolean :=
+                                                       In_Spec_Expression;
+                           Save_Full_Analysis : constant Boolean :=
+                                                  Full_Analysis;
+                        begin
+                           In_Spec_Expression := True;
+                           Full_Analysis := False;
+                           Expander_Mode_Save_And_Set (False);
+                           Push_Type (E);
+                           Resolve_Aspect_Expression (Expr);
+                           Pop_Type (E);
+                           Expander_Mode_Restore;
+                           Full_Analysis := Save_Full_Analysis;
+                           In_Spec_Expression := Save_In_Spec_Expression;
+                        end;
                      end if;
 
                   when Pre_Post_Aspects =>