From: Steve Baird <ba...@adacore.com>
The current instance of a type or subtype (see RM 8.6) is an object or
value, not a type or subtype. So a name denoting such a current instance is
illegal in any context that requires a name denoting a type or subtype.
In some cases this error was not detected.
gcc/ada/
* sem_ch8.adb (Find_Type): If Is_Current_Instance returns True for
N (and Comes_From_Source (N) is also True) then flag an error.
Call Is_Current_Instance (twice) instead of duplicating (twice)
N_Access_Definition-related code in Is_Current_Instance.
* sem_util.adb (Is_Current_Instance): Implement
access-type-related clauses of the RM 8.6 current instance rule.
For pragmas Predicate and Predicate_Failure, distinguish between
the first and subsequent pragma arguments.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch8.adb | 24 ++++++++++++++----------
gcc/ada/sem_util.adb | 31 ++++++++++++++++++++++++++++++-
2 files changed, 44 insertions(+), 11 deletions(-)
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index d2752af320e..c77a69e5118 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -8801,6 +8801,16 @@ package body Sem_Ch8 is
Error_Msg_NE ("\\found & declared#", N, T_Name);
Set_Entity (N, Any_Type);
+ elsif Is_Current_Instance (N) and then Comes_From_Source (N) then
+ if Nkind (Parent (T_Name)) = N_Subtype_Declaration then
+ Error_Msg_N ("reference to current instance of subtype" &
+ " does not denote a subtype (RM 8.6)", N);
+ else
+ Error_Msg_N ("reference to current instance of type" &
+ " does not denote a type (RM 8.6)", N);
+ end if;
+ Set_Entity (N, Any_Type);
+
else
-- If the type is an incomplete type created to handle
-- anonymous access components of a record type, then the
@@ -8831,12 +8841,9 @@ package body Sem_Ch8 is
if In_Open_Scopes (T_Name) then
if Ekind (Base_Type (T_Name)) = E_Task_Type then
- -- In Ada 2005, a task name can be used in an access
- -- definition within its own body.
+ -- OK if the "current instance" rule does not apply.
- if Ada_Version >= Ada_2005
- and then Nkind (Parent (N)) = N_Access_Definition
- then
+ if not Is_Current_Instance (N) then
Set_Entity (N, T_Name);
Set_Etype (N, T_Name);
return;
@@ -8849,12 +8856,9 @@ package body Sem_Ch8 is
elsif Ekind (Base_Type (T_Name)) = E_Protected_Type then
- -- In Ada 2005, a protected name can be used in an access
- -- definition within its own body.
+ -- OK if the "current instance" rule does not apply.
- if Ada_Version >= Ada_2005
- and then Nkind (Parent (N)) = N_Access_Definition
- then
+ if not Is_Current_Instance (N) then
Set_Entity (N, T_Name);
Set_Etype (N, T_Name);
return;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 032684f3ddb..7901eb8ee38 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -16080,6 +16080,29 @@ package body Sem_Util is
P : Node_Id;
begin
+ -- Since Ada 2005, the "current instance" rule does not apply
+ -- to a type_mark in an access_definition (RM 8.6),
+ -- although it does apply in an access_to_object definition.
+ -- So the rule does not apply in the definition of an anonymous
+ -- access type, but it does apply in the definition of a named
+ -- access-to-object type.
+ -- The rule also does not apply in a designated subprogram profile.
+
+ if Ada_Version >= Ada_2005 then
+ case Nkind (Parent (N)) is
+ when N_Access_Definition | N_Access_Function_Definition =>
+ return False;
+ when N_Parameter_Specification =>
+ if Nkind (Parent (Parent (N))) in
+ N_Access_To_Subprogram_Definition
+ then
+ return False;
+ end if;
+ when others =>
+ null;
+ end case;
+ end if;
+
-- Simplest case: entity is a concurrent type and we are currently
-- inside the body. This will eventually be expanded into a call to
-- Self (for tasks) or _object (for protected objects).
@@ -16129,6 +16152,12 @@ package body Sem_Util is
elsif Nkind (P) = N_Pragma
and then Get_Pragma_Id (P) in Pragma_Predicate
| Pragma_Predicate_Failure
+
+ -- For "pragma Predicate (T, Is_OK (T))", return False for the
+ -- first use of T and True for the second.
+
+ and then
+ N /= Expression (First (Pragma_Argument_Associations (P)))
then
declare
Arg : constant Entity_Id :=
@@ -16144,7 +16173,7 @@ package body Sem_Util is
end loop;
end if;
- -- In any other context this is not a current occurrence
+ -- In any other context this is not a current instance reference.
return False;
end Is_Current_Instance;
--
2.45.2
