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 --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;