diff mbox series

[Ada] AI12-0373 Additional check on Integer_Literal function

Message ID 20200716092051.GA146518@adacore.com
State New
Headers show
Series [Ada] AI12-0373 Additional check on Integer_Literal function | expand

Commit Message

Pierre-Marie de Rodat July 16, 2020, 9:20 a.m. UTC 
Part (1) clarifies that we anticipated in Statically_Names_Object,
update comment accordingly.

Part 4 (4) clarifies: 4.2.1(3/5) says that the only parameter of a
user-defined Integer_Literal function is of type String. But it doesn't
specify a mode.

Since the parameter is passed a string literal, a call to a function
with a mode other than "in" would be illegal. Thus, defining the
function with an "in out" parameter would be useless. Similarly, if the
parameter was explicitly aliased, any call would be illegal as the
actual is not aliased.  So that would also be useless as well.

We were doing it right except for checking the 'explicitly aliased'
part.

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

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 mbox series

Patch

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