From: Arnaud Charlet <charlet@adacore.com>
Date: Tue, 7 Jul 2020 13:09:32 +0000 (-0400)
Subject: [Ada] ACATS 4.1R - Exception missed
X-Git-Tag: basepoints/gcc-12~4205
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=b6bcca6dc18a778b84b1d9ab8d03b257f2340efc;p=thirdparty%2Fgcc.git

[Ada] ACATS 4.1R - Exception missed

gcc/ada/

	* sem_aggr.adb (Resolve_Record_Aggregate): Properly apply
	subtype constraints when using a Default_Value.
	* freeze.adb: Fix typo.
---

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 67cda8f768a7..f090b3efbb3c 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -6830,7 +6830,7 @@ package body Freeze is
          end if;
 
          --  If the type has a Defaut_Value/Default_Component_Value aspect,
-         --  this is where we analye the expression (after the type is frozen,
+         --  this is where we analyze the expression (after the type is frozen,
          --  since in the case of Default_Value, we are analyzing with the
          --  type itself, and we treat Default_Component_Value similarly for
          --  the sake of uniformity).
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index e5b18d2e5e74..1ada4f6696cf 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -5033,16 +5033,28 @@ package body Sem_Aggr is
                   end if;
 
                --  Ada 2012: If component is scalar with default value, use it
+               --  by converting it to Ctyp, so that subtype constraints are
+               --  checked.
 
                elsif Is_Scalar_Type (Ctyp)
                  and then Has_Default_Aspect (Ctyp)
                then
-                  Add_Association
-                    (Component  => Component,
-                     Expr       =>
-                       Default_Aspect_Value
-                         (First_Subtype (Underlying_Type (Ctyp))),
-                     Assoc_List => New_Assoc_List);
+                  declare
+                     Conv : constant Node_Id :=
+                       Convert_To
+                         (Typ  => Ctyp,
+                          Expr =>
+                            New_Copy_Tree
+                              (Default_Aspect_Value
+                                 (First_Subtype (Underlying_Type (Ctyp)))));
+
+                  begin
+                     Analyze_And_Resolve (Conv, Ctyp);
+                     Add_Association
+                       (Component  => Component,
+                        Expr       => Conv,
+                        Assoc_List => New_Assoc_List);
+                  end;
 
                elsif Has_Non_Null_Base_Init_Proc (Ctyp)
                  or else not Expander_Active