From: Arnaud Charlet <charlet@adacore.com>
Date: Mon, 8 Jun 2020 18:28:52 +0000 (-0400)
Subject: [Ada] AI12-0373 Additional check on Integer_Literal function
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c6801105e167376e8839007a1539a8167fb09306;p=gcc.git

[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.
---

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;