diff options
| author | Arnaud Charlet <charlet@adacore.com> | 2020-07-07 09:09:32 -0400 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-10-19 05:53:38 -0400 |
| commit | b6bcca6dc18a778b84b1d9ab8d03b257f2340efc (patch) | |
| tree | 57cec11d3f5c04d0271f9966cce361d8508fb974 | |
| parent | be8d605f16ed6ab090b411a7810911f4b7b7719a (diff) | |
| download | gcc-b6bcca6dc18a778b84b1d9ab8d03b257f2340efc.zip gcc-b6bcca6dc18a778b84b1d9ab8d03b257f2340efc.tar.gz gcc-b6bcca6dc18a778b84b1d9ab8d03b257f2340efc.tar.bz2 | |
[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.
| -rw-r--r-- | gcc/ada/freeze.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 24 |
2 files changed, 19 insertions, 7 deletions
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 67cda8f..f090b3e 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 e5b18d2..1ada4f6 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 |