From d24ef4e60998f7f9f4fde52896af3afa42ec246c Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Thu, 14 Jan 2021 17:28:31 +0100 Subject: [PATCH] [Ada] Fix expansion of attributes Input/Output for unchecked union types gcc/ada/ * exp_attr.adb (Expand_N_Attribute_Reference): Fix expansion of attributes Input and Output for unchecked unions. * sem_case.ads: Fix typo "disriminant" and refill comment. --- gcc/ada/exp_attr.adb | 14 ++++++++------ gcc/ada/sem_case.ads | 4 ++-- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 6c8abed..1775904 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -4237,12 +4237,13 @@ package body Exp_Attr is -- type if the type lacks default discriminant values. if Is_Unchecked_Union (Base_Type (U_Type)) - and then No (Discriminant_Constraint (U_Type)) + and then + No (Discriminant_Default_Value (First_Discriminant (U_Type))) then - Insert_Action (N, + Rewrite (N, Make_Raise_Program_Error (Loc, Reason => PE_Unchecked_Union_Restriction)); - + Set_Etype (N, B_Type); return; end if; @@ -5332,12 +5333,13 @@ package body Exp_Attr is -- values. if Is_Unchecked_Union (Base_Type (U_Type)) - and then No (Discriminant_Constraint (U_Type)) + and then + No (Discriminant_Default_Value (First_Discriminant (U_Type))) then - Insert_Action (N, + Rewrite (N, Make_Raise_Program_Error (Loc, Reason => PE_Unchecked_Union_Restriction)); - + Set_Etype (N, Standard_Void_Type); return; end if; diff --git a/gcc/ada/sem_case.ads b/gcc/ada/sem_case.ads index f939eb2..00b7dd3 100644 --- a/gcc/ada/sem_case.ads +++ b/gcc/ada/sem_case.ads @@ -44,8 +44,8 @@ -- till the freeze point in this case. -- 3. Set the Others_Discrete_Choices list for an others choice. This is --- used in various ways, e.g. to construct the disriminant checking function --- for the case of a variant with an others choice. +-- used in various ways, e.g. to construct the discriminant checking +-- function for the case of a variant with an others choice. -- 4. In the case of static predicates, we need to expand out choices that -- correspond to the predicate for the back end. This expansion destroys -- 2.7.4