From c6801105e167376e8839007a1539a8167fb09306 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 8 Jun 2020 14:28:52 -0400 Subject: [PATCH] [Ada] AI12-0373 Additional check on Integer_Literal function gcc/ada/ * sem_ch13.adb (Validate_Literal_Aspect): Ensure that the parameter is not aliased. Minor reformatting. * sem_util.adb (Statically_Names_Object): Update comment. --- gcc/ada/sem_ch13.adb | 14 ++++++++++++-- gcc/ada/sem_util.adb | 25 +++++++------------------ 2 files changed, 19 insertions(+), 20 deletions(-) diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9b7f64e84af..9a2f1d05c2c 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -16016,10 +16016,12 @@ package body Sem_Ch13 is Match_Found : Boolean := False; Is_Match : Boolean; Match : Interp; + begin if not Is_Type (Typ) then Error_Msg_N ("aspect can only be specified for a type", ASN); return; + elsif not Is_First_Subtype (Typ) then Error_Msg_N ("aspect cannot be specified for a subtype", ASN); return; @@ -16030,12 +16032,15 @@ package body Sem_Ch13 is Error_Msg_N ("aspect cannot be specified for a string type", ASN); return; end if; + Param_Type := Standard_Wide_Wide_String; + else if Is_Numeric_Type (Typ) then Error_Msg_N ("aspect cannot be specified for a numeric type", ASN); return; end if; + Param_Type := Standard_String; end if; @@ -16059,17 +16064,21 @@ package body Sem_Ch13 is and then Base_Type (Etype (It.Nam)) = Typ then declare - Params : constant List_Id := + Params : constant List_Id := Parameter_Specifications (Parent (It.Nam)); Param_Spec : Node_Id; Param_Id : Entity_Id; + begin if List_Length (Params) = 1 then Param_Spec := First (Params); + if not More_Ids (Param_Spec) then Param_Id := Defining_Identifier (Param_Spec); + if Base_Type (Etype (Param_Id)) = Param_Type - and then Ekind (Param_Id) = E_In_Parameter + and then Ekind (Param_Id) = E_In_Parameter + and then not Is_Aliased (Param_Id) then Is_Match := True; end if; @@ -16083,6 +16092,7 @@ package body Sem_Ch13 is Error_Msg_N ("aspect specification is ambiguous", ASN); return; end if; + Match_Found := True; Match := It; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 2ce22e988fb..b2f41de1689 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -27054,6 +27054,7 @@ package body Sem_Util is ----------------------------- -- Statically_Names_Object -- ----------------------------- + function Statically_Names_Object (N : Node_Id) return Boolean is begin if Statically_Denotes_Object (N) then @@ -27126,28 +27127,16 @@ package body Sem_Util is then return False; end if; + declare Comp : constant Entity_Id := Original_Record_Component (Entity (Selector_Name (N))); begin - -- In not calling Has_Discriminant_Dependent_Constraint here, - -- we are anticipating a language definition fixup. The - -- current definition of "statically names" includes the - -- wording "the selector_name names a component that does - -- not depend on a discriminant", which suggests that this - -- call should not be commented out. But it appears likely - -- that this wording will be updated to only apply to a - -- component declared in a variant part. There is no need - -- to disallow something like - -- with Post => ... and then - -- Some_Record.Some_Discrim_Dep_Array_Component'Old (I) - -- since the evaluation of the 'Old prefix cannot raise an - -- exception. If the language is not updated, then the call - -- below to H_D_C_C will need to be uncommented. - - if Is_Declared_Within_Variant (Comp) - -- or else Has_Discriminant_Dependent_Constraint (Comp) - then + -- AI12-0373 confirms that we should not call + -- Has_Discriminant_Dependent_Constraint here which would be + -- too strong. + + if Is_Declared_Within_Variant (Comp) then return False; end if; end; -- 2.30.2