* [Ada] Fix PR ada/113979
@ 2024-03-07 14:27 Eric Botcazou
0 siblings, 0 replies; only message in thread
From: Eric Botcazou @ 2024-03-07 14:27 UTC (permalink / raw)
To: gcc-patches
[-- Attachment #1: Type: text/plain, Size: 763 bytes --]
This is a regression present on all active branches: the compiler gives a
bogus error on an allocator for an unconstrained array type declared with a
Dynamic_Predicate because Apply_Predicate_Check is invoked directly on a
subtype reference, which it cannot handle.
This moves the check to the resulting access value (after dereference) like in
Expand_Allocator_Expression.
Tested on x86-64/Linux, applied on all active branches.
2024-03-07 Eric Botcazou <ebotcazou@adacore.com>
PR ada/113979
* exp_ch4.adb (Expand_N_Allocator): In the subtype indication case,
call Apply_Predicate_Check on the resulting access value if needed.
2024-03-07 Eric Botcazou <ebotcazou@adacore.com>
* testsuite/gnat.dg/predicate15.adb: New test.
--
Eric Botcazou
[-- Attachment #2: p.diff --]
[-- Type: text/x-patch, Size: 1355 bytes --]
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 4f83cd4737a..e4a40414872 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4657,8 +4657,6 @@ package body Exp_Ch4 is
if Is_Array_Type (Dtyp) and then not No_Initialization (N) then
Apply_Constraint_Check (Expression (N), Dtyp, No_Sliding => True);
- Apply_Predicate_Check (Expression (N), Dtyp);
-
if Nkind (Expression (N)) = N_Raise_Constraint_Error then
Rewrite (N, New_Copy (Expression (N)));
Set_Etype (N, PtrT);
@@ -4752,6 +4750,8 @@ package body Exp_Ch4 is
Rewrite (N, New_Occurrence_Of (Temp, Loc));
Analyze_And_Resolve (N, PtrT);
+ Apply_Predicate_Check (N, Dtyp, Deref => True);
+
-- Case of no initialization procedure present
elsif not Has_Non_Null_Base_Init_Proc (T) then
@@ -5119,6 +5119,8 @@ package body Exp_Ch4 is
Rewrite (N, New_Occurrence_Of (Temp, Loc));
Analyze_And_Resolve (N, PtrT);
+ Apply_Predicate_Check (N, Dtyp, Deref => True);
+
-- When designated type has Default_Initial_Condition aspects,
-- make a call to the type's DIC procedure to perform the
-- checks. Theoretically this might also be needed for cases
[-- Attachment #3: predicate15.adb --]
[-- Type: text/x-adasrc, Size: 274 bytes --]
-- { dg-do compile }
-- { dg-options "-gnata" }
procedure Predicate15 is
type Grid is array (Positive range <>) of Integer with
Dynamic_Predicate => Grid'First = 1;
type Grid_Ptr is access Grid;
Data : Grid_Ptr := new Grid (1 .. 10);
begin
null;
end;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2024-03-07 14:27 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-03-07 14:27 [Ada] Fix PR ada/113979 Eric Botcazou
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).