public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc(refs/users/guojiufu/heads/personal-branch)] [Ada] Implement AI12-0275 (Make subtype_mark optional in object renamings)
@ 2020-06-10 3:34 Jiu Fu Guo
0 siblings, 0 replies; only message in thread
From: Jiu Fu Guo @ 2020-06-10 3:34 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:4f31d6dbb8deafd7ab54e70eddfd931b10b3309b
commit 4f31d6dbb8deafd7ab54e70eddfd931b10b3309b
Author: Gary Dismukes <dismukes@adacore.com>
Date: Fri Jan 24 14:11:47 2020 -0500
[Ada] Implement AI12-0275 (Make subtype_mark optional in object renamings)
2020-06-04 Gary Dismukes <dismukes@adacore.com>
gcc/ada/
* par-ch3.adb (P_Identifier_Declarations): Add parsing of object
renamings that have neither a subtype_mark nor an
access_definition. Issue an error if the version is earlier than
Ada_2020, and suggest using -gnatX.
* sem_ch8.adb (Analyze_Object_Renaming): Handle
object_renaming_declarations that don't have an explicit
subtype. Errors are issued when the name is inappropriate or
ambiguous, and otherwise the Etype of the renaming entity is set
from the Etype of the renamed object.
* sem_util.adb (Has_Null_Exclusion): Allow for the case of no
subtype given in an N_Object_Renaming_Declaration.
* sprint.adb (Sprint_Node_Actual): Handle printing of
N_Object_Renaming_Declarations that are specified without an
explicit subtype.
Diff:
---
gcc/ada/par-ch3.adb | 26 +++++++++++++
gcc/ada/sem_ch8.adb | 106 +++++++++++++++++++++++++++++++++++++++++++++++++--
gcc/ada/sem_util.adb | 10 ++++-
gcc/ada/sprint.adb | 10 ++++-
4 files changed, 145 insertions(+), 7 deletions(-)
diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb
index a54577e665e..9065f4bb75c 100644
--- a/gcc/ada/par-ch3.adb
+++ b/gcc/ada/par-ch3.adb
@@ -1480,6 +1480,32 @@ package body Ch3 is
Done := False;
return;
+ -- AI12-0275: Object renaming declaration without subtype_mark or
+ -- access_definition
+
+ elsif Token = Tok_Renames then
+ if Ada_Version < Ada_2020 then
+ Error_Msg_SC
+ ("object renaming without subtype is an Ada 202x feature");
+ Error_Msg_SC ("\compile with -gnatX");
+ end if;
+
+ Scan; -- past renames
+
+ Decl_Node :=
+ New_Node (N_Object_Renaming_Declaration, Ident_Sloc);
+ Set_Name (Decl_Node, P_Name);
+ Set_Defining_Identifier (Decl_Node, Idents (1));
+
+ P_Aspect_Specifications (Decl_Node, Semicolon => False);
+
+ T_Semicolon;
+
+ Append (Decl_Node, Decls);
+ Done := False;
+
+ return;
+
-- Otherwise we have an error situation
else
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 76f696b32ed..4a730fc8ae8 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -906,10 +906,108 @@ package body Sem_Ch8 is
Find_Type (Subtype_Mark (N));
end if;
- elsif Present (Subtype_Mark (N)) then
- Find_Type (Subtype_Mark (N));
- T := Entity (Subtype_Mark (N));
- Analyze (Nam);
+ elsif Present (Subtype_Mark (N))
+ or else not Present (Access_Definition (N))
+ then
+ if Present (Subtype_Mark (N)) then
+ Find_Type (Subtype_Mark (N));
+ T := Entity (Subtype_Mark (N));
+ Analyze (Nam);
+
+ -- AI12-0275: Case of object renaming without a subtype_mark
+
+ else
+ Analyze (Nam);
+
+ -- Normal case of no overloading in object name
+
+ if not Is_Overloaded (Nam) then
+
+ -- Catch error cases (such as attempting to rename a procedure
+ -- or package) using the shorthand form.
+
+ if No (Etype (Nam))
+ or else Etype (Nam) = Standard_Void_Type
+ then
+ Error_Msg_N ("object name expected in renaming", Nam);
+
+ Set_Ekind (Id, E_Variable);
+ Set_Etype (Id, Any_Type);
+
+ return;
+
+ else
+ T := Etype (Nam);
+ end if;
+
+ -- Case of overloaded name, which will be illegal if there's more
+ -- than one acceptable interpretation (such as overloaded function
+ -- calls).
+
+ else
+ declare
+ I : Interp_Index;
+ I1 : Interp_Index;
+ It : Interp;
+ It1 : Interp;
+ Nam1 : Entity_Id;
+
+ begin
+ -- More than one candidate interpretation is available
+
+ -- Remove procedure calls, which syntactically cannot appear
+ -- in this context, but which cannot be removed by type
+ -- checking, because the context does not impose a type.
+
+ Get_First_Interp (Nam, I, It);
+ while Present (It.Typ) loop
+ if It.Typ = Standard_Void_Type then
+ Remove_Interp (I);
+ end if;
+
+ Get_Next_Interp (I, It);
+ end loop;
+
+ Get_First_Interp (Nam, I, It);
+ I1 := I;
+ It1 := It;
+
+ -- If there's no type present, we have an error case (such
+ -- as overloaded procedures named in the object renaming).
+
+ if No (It.Typ) then
+ Error_Msg_N ("object name expected in renaming", Nam);
+
+ Set_Ekind (Id, E_Variable);
+ Set_Etype (Id, Any_Type);
+
+ return;
+ end if;
+
+ Get_Next_Interp (I, It);
+
+ if Present (It.Typ) then
+ Nam1 := It1.Nam;
+ It1 := Disambiguate (Nam, I1, I, Any_Type);
+
+ if It1 = No_Interp then
+ Error_Msg_N ("ambiguous name in object renaming", Nam);
+
+ Error_Msg_Sloc := Sloc (It.Nam);
+ Error_Msg_N ("\\possible interpretation#!", Nam);
+
+ Error_Msg_Sloc := Sloc (Nam1);
+ Error_Msg_N ("\\possible interpretation#!", Nam);
+
+ return;
+ end if;
+ end if;
+
+ Set_Etype (Nam, It1.Typ);
+ T := It1.Typ;
+ end;
+ end if;
+ end if;
-- The object renaming declaration may become Ghost if it renames a
-- Ghost entity.
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index dff9f81763c..49594e47aea 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -11726,7 +11726,6 @@ package body Sem_Util is
when N_Component_Definition
| N_Formal_Object_Declaration
- | N_Object_Renaming_Declaration
=>
if Present (Subtype_Mark (N)) then
return Null_Exclusion_Present (N);
@@ -11734,6 +11733,15 @@ package body Sem_Util is
return Null_Exclusion_Present (Access_Definition (N));
end if;
+ when N_Object_Renaming_Declaration =>
+ if Present (Subtype_Mark (N)) then
+ return Null_Exclusion_Present (N);
+ elsif Present (Access_Definition (N)) then
+ return Null_Exclusion_Present (Access_Definition (N));
+ else
+ return False; -- Case of no subtype in renaming (AI12-0275)
+ end if;
+
when N_Discriminant_Specification =>
if Nkind (Discriminant_Type (N)) = N_Access_Definition then
return Null_Exclusion_Present (Discriminant_Type (N));
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 51f0bf41022..f177981de70 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -2441,14 +2441,15 @@ package body Sprint is
Write_Indent;
Set_Debug_Sloc;
Sprint_Node (Defining_Identifier (Node));
- Write_Str (" : ");
-- Ada 2005 (AI-230): Access renamings
if Present (Access_Definition (Node)) then
+ Write_Str (" : ");
Sprint_Node (Access_Definition (Node));
elsif Present (Subtype_Mark (Node)) then
+ Write_Str (" : ");
-- Ada 2005 (AI-423): Object renaming with a null exclusion
@@ -2458,8 +2459,13 @@ package body Sprint is
Sprint_Node (Subtype_Mark (Node));
+ -- AI12-0275: Object_Renaming_Declaration without explicit subtype
+
+ elsif Ada_Version >= Ada_2020 then
+ null;
+
else
- Write_Str (" ??? ");
+ Write_Str (" : ??? ");
end if;
Write_Str_With_Col_Check (" renames ");
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-06-10 3:34 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-06-10 3:34 [gcc(refs/users/guojiufu/heads/personal-branch)] [Ada] Implement AI12-0275 (Make subtype_mark optional in object renamings) Jiu Fu Guo
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).