diff mbox series

[Ada] ACATS 4.1R - Exception missed

Message ID 20201019095422.GA91134@adacore.com
State New
Headers show
Series [Ada] ACATS 4.1R - Exception missed | expand

Commit Message

Pierre-Marie de Rodat Oct. 19, 2020, 9:54 a.m. UTC 
This new ACATS test shows that we are not taking the subtype constraint
into account when a Default_Value (via a box notation) is used in an
aggregate, e.g: B_Rec : Bad_Rec := (Cnt => <>);

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

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

Patch

diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
--- 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
--- 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