aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorGary Dismukes <dismukes@adacore.com>2022-08-19 18:40:05 -0400
committerMarc Poulhiès <poulhies@adacore.com>2022-09-12 10:16:50 +0200
commit1d2bc28c41b6ddf0b11a7a3d7d312ff45cb2cb7d (patch)
treecc3b51e9e1b6ddc58126c78759306c3a423b6fd8 /gcc/ada
parent2fa4beae4482f4fac6556e1ef2e941787507073e (diff)
downloadgcc-1d2bc28c41b6ddf0b11a7a3d7d312ff45cb2cb7d.zip
gcc-1d2bc28c41b6ddf0b11a7a3d7d312ff45cb2cb7d.tar.gz
gcc-1d2bc28c41b6ddf0b11a7a3d7d312ff45cb2cb7d.tar.bz2
[Ada] Fix issues with compiling ACATS test for user-defined literals
The draft ACATS test (which we developed) for the Ada 2022 feature of user-defined literals has compile-time problems that are fixed with this set of changes. Two of these involve the resolution of named numbers in the context where an implicit literal conversion can occur, and for equality when a literal or named number is an operand. Furthermore, the compiler can hang in some cases when a numeric literal is used in a context where the expected type is a type derived two levels down from a tagged type that specifies a literal aspect. gcc/ada/ * sem_res.adb (Resolve_Equality_Op): Add handling for equality ops with user-defined literal operands. * sem_util.ads (Is_User_Defined_Literal): Update spec comment to indicate inclusion of named number cases. * sem_util.adb (Corresponding_Primitive_Op): Rather than following the chain of ancestor subprograms via Alias and Overridden_Operation links, we check for matching profiles between primitive subprograms of the descendant type and the ancestor subprogram (by calling a new nested function Profile_Matches_Ancestor). This prevents the compiler from hanging due to circular linkages via those fields that can occur between inherited and overriding subprograms (which might indicate a latent bug, but one that may be rather delicate to resolve). (Profile_Matches_Ancestor): New nested subprogram to compare the profile of a primitive subprogram with the profile of a candidate ancestor subprogram. (Is_User_Defined_Literal): Also return True in cases where the node N denotes a named number (E_Name_Integer and E_Named_Real).
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/sem_res.adb14
-rw-r--r--gcc/ada/sem_util.adb98
-rw-r--r--gcc/ada/sem_util.ads4
3 files changed, 87 insertions, 29 deletions
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index f618467..4b76595 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -8876,6 +8876,20 @@ package body Sem_Res is
end if;
else
+
+ -- For Ada 2022, check for user-defined literals when the type has
+ -- the appropriate aspect.
+
+ if Has_Applicable_User_Defined_Literal (L, Etype (R)) then
+ Resolve (L, Etype (R));
+ Set_Etype (N, Standard_Boolean);
+ end if;
+
+ if Has_Applicable_User_Defined_Literal (R, Etype (L)) then
+ Resolve (R, Etype (L));
+ Set_Etype (N, Standard_Boolean);
+ end if;
+
-- Deal with other error cases
if T = Any_String or else
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 5d83956..b708764 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -7182,7 +7182,51 @@ package body Sem_Util is
Typ : constant Entity_Id := Find_Dispatching_Type (Ancestor_Op);
Elmt : Elmt_Id;
Subp : Entity_Id;
- Prim : Entity_Id;
+
+ function Profile_Matches_Ancestor (S : Entity_Id) return Boolean;
+ -- Returns True if subprogram S has the proper profile for an
+ -- overriding of Ancestor_Op (that is, corresponding formals either
+ -- have the same type, or are corresponding controlling formals,
+ -- and similarly for result types).
+
+ ------------------------------
+ -- Profile_Matches_Ancestor --
+ ------------------------------
+
+ function Profile_Matches_Ancestor (S : Entity_Id) return Boolean is
+ F1 : Entity_Id := First_Formal (Ancestor_Op);
+ F2 : Entity_Id := First_Formal (S);
+
+ begin
+ if Ekind (Ancestor_Op) /= Ekind (S) then
+ return False;
+ end if;
+
+ -- ??? This should probably account for anonymous access formals,
+ -- but the parent function (Corresponding_Primitive_Op) is currently
+ -- only called for user-defined literal functions, which can't have
+ -- such formals. But if this is ever used in a more general context
+ -- it should be extended to handle such formals (and result types).
+
+ while Present (F1) and then Present (F2) loop
+ if Etype (F1) = Etype (F2)
+ or else Is_Ancestor (Typ, Etype (F2))
+ then
+ Next_Formal (F1);
+ Next_Formal (F2);
+ else
+ return False;
+ end if;
+ end loop;
+
+ return No (F1)
+ and then No (F2)
+ and then (Etype (Ancestor_Op) = Etype (S)
+ or else Is_Ancestor (Typ, Etype (S)));
+ end Profile_Matches_Ancestor;
+
+ -- Start of processing for Corresponding_Primitive_Op
+
begin
pragma Assert (Is_Dispatching_Operation (Ancestor_Op));
pragma Assert (Is_Ancestor (Typ, Descendant_Type)
@@ -7193,12 +7237,12 @@ package body Sem_Util is
while Present (Elmt) loop
Subp := Node (Elmt);
- -- For regular primitives we only need to traverse the chain of
- -- ancestors when the name matches the name of Ancestor_Op, but
- -- for predefined dispatching operations we cannot rely on the
- -- name of the primitive to identify a candidate since their name
- -- is internally built adding a suffix to the name of the tagged
- -- type.
+ -- For regular primitives we need to check the profile against
+ -- the ancestor when the name matches the name of Ancestor_Op,
+ -- but for predefined dispatching operations we cannot rely on
+ -- the name of the primitive to identify a candidate since their
+ -- name is internally built by adding a suffix to the name of the
+ -- tagged type.
if Chars (Subp) = Chars (Ancestor_Op)
or else Is_Predefined_Dispatching_Operation (Subp)
@@ -7214,26 +7258,10 @@ package body Sem_Util is
return Alias (Subp);
end if;
- -- Traverse the chain of ancestors searching for Ancestor_Op.
- -- Overridden primitives have attribute Overridden_Operation;
- -- inherited primitives have attribute Alias.
-
- else
- Prim := Subp;
-
- while Present (Overridden_Operation (Prim))
- or else Present (Alias (Prim))
- loop
- if Present (Overridden_Operation (Prim)) then
- Prim := Overridden_Operation (Prim);
- else
- Prim := Alias (Prim);
- end if;
+ -- Otherwise, return subprogram when profile matches its ancestor
- if Prim = Ancestor_Op then
- return Subp;
- end if;
- end loop;
+ elsif Profile_Matches_Ancestor (Subp) then
+ return Subp;
end if;
end if;
@@ -21620,8 +21648,22 @@ package body Sem_Util is
N_String_Literal => Aspect_String_Literal);
begin
- return Nkind (N) in N_Numeric_Or_String_Literal
- and then Present (Find_Aspect (Typ, Literal_Aspect_Map (Nkind (N))));
+ -- Return True when N is either a literal or a named number and the
+ -- type has the appropriate user-defined literal aspect.
+
+ return (Nkind (N) in N_Numeric_Or_String_Literal
+ and then Present (Find_Aspect (Typ, Literal_Aspect_Map (Nkind (N)))))
+ or else
+ (Is_Entity_Name (N)
+ and then Present (Entity (N))
+ and then
+ ((Ekind (Entity (N)) = E_Named_Integer
+ and then
+ Present (Find_Aspect (Typ, Aspect_Integer_Literal)))
+ or else
+ (Ekind (Entity (N)) = E_Named_Real
+ and then
+ Present (Find_Aspect (Typ, Aspect_Real_Literal)))));
end Is_User_Defined_Literal;
--------------------------------------
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 001e58f..132c2b8 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -2500,7 +2500,9 @@ package Sem_Util is
(N : Node_Id;
Typ : Entity_Id) return Boolean;
pragma Inline (Is_User_Defined_Literal);
- -- Determine whether N is a user-defined literal for Typ
+ -- Determine whether N is a user-defined literal for Typ, including
+ -- the case where N denotes a named number of the appropriate kind
+ -- when Typ has an Integer_Literal or Real_Literal aspect.
function Is_Validation_Variable_Reference (N : Node_Id) return Boolean;
-- Determine whether N denotes a reference to a variable which captures the