public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r12-5666] [Ada] Improve error messages for dot notation when -gnatX not used
@ 2021-12-01 10:26 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-12-01 10:26 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:790b8752100e699d98140f0b094cbf5b893aa7dd
commit r12-5666-g790b8752100e699d98140f0b094cbf5b893aa7dd
Author: Yannick Moy <moy@adacore.com>
Date: Fri Oct 8 16:19:50 2021 +0200
[Ada] Improve error messages for dot notation when -gnatX not used
gcc/ada/
* einfo.ads (Direct_Primitive_Operations): Update the doc to
indicate that this field is used for all types now.
* sem_ch4.adb (Try_Object_Operation): Add parameter
Allow_Extensions set to True to pretend that extensions are
allowed.
* sem_ch4.ads: Same.
* sem_ch6.adb: Do not require Extensions_Allowed.
* sem_ch8.adb (Find_Selected_Component): Remove duplicate
"where" in comment. Improve the error messages regarding use of
prefixed calls.
Diff:
---
gcc/ada/einfo.ads | 21 +++++++++++----------
gcc/ada/sem_ch4.adb | 8 +++++---
gcc/ada/sem_ch4.ads | 23 +++++++++++++----------
gcc/ada/sem_ch6.adb | 26 +++++++++++++-------------
gcc/ada/sem_ch8.adb | 21 +++++++++++++++++----
5 files changed, 59 insertions(+), 40 deletions(-)
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 51cb0144ebf..4f748703209 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -946,16 +946,17 @@ package Einfo is
-- Direct_Primitive_Operations
-- Defined in tagged types and subtypes (including synchronized types),
--- in tagged private types, and in tagged incomplete types. However, when
--- Extensions_Allowed is True (-gnatX), also defined for untagged types
--- (for support of the extension feature of prefixed calls for untagged
--- types). This field is an element list of entities for primitive
--- operations of the type. For incomplete types the list is always empty.
--- In order to follow the C++ ABI, entities of primitives that come from
--- source must be stored in this list in the order of their occurrence in
--- the sources. When expansion is disabled, the corresponding record type
--- of a synchronized type is not constructed. In that case, such types
--- carry this attribute directly.
+-- in tagged private types, and in tagged incomplete types. Moreover, it
+-- is also defined for untagged types, both when Extensions_Allowed is
+-- True (-gnatX) to support the extension feature of prefixed calls for
+-- untagged types, and when Extensions_Allowed is False to get better
+-- error messages. This field is an element list of entities for
+-- primitive operations of the type. For incomplete types the list is
+-- always empty. In order to follow the C++ ABI, entities of primitives
+-- that come from source must be stored in this list in the order of
+-- their occurrence in the sources. When expansion is disabled, the
+-- corresponding record type of a synchronized type is not constructed.
+-- In that case, such types carry this attribute directly.
-- Directly_Designated_Type
-- Defined in access types. This field points to the type that is
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 77c1b97068c..3ffe7219320 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -9032,7 +9032,9 @@ package body Sem_Ch4 is
--------------------------
function Try_Object_Operation
- (N : Node_Id; CW_Test_Only : Boolean := False) return Boolean
+ (N : Node_Id;
+ CW_Test_Only : Boolean := False;
+ Allow_Extensions : Boolean := False) return Boolean
is
K : constant Node_Kind := Nkind (Parent (N));
Is_Subprg_Call : constant Boolean := K in N_Subprogram_Call;
@@ -9719,7 +9721,7 @@ package body Sem_Ch4 is
if (not Is_Tagged_Type (Obj_Type)
and then
- (not Extensions_Allowed
+ (not (Extensions_Allowed or Allow_Extensions)
or else not Present (Primitive_Operations (Obj_Type))))
or else Is_Incomplete_Type (Obj_Type)
then
@@ -9748,7 +9750,7 @@ package body Sem_Ch4 is
-- have homographic prefixed-view operations that could result
-- in an ambiguity, but handling properly may be tricky. ???)
- if Extensions_Allowed
+ if (Extensions_Allowed or Allow_Extensions)
and then not Prim_Result
and then Is_Named_Access_Type (Prev_Obj_Type)
and then Present (Direct_Primitive_Operations (Prev_Obj_Type))
diff --git a/gcc/ada/sem_ch4.ads b/gcc/ada/sem_ch4.ads
index 73796268930..395b81e9ce8 100644
--- a/gcc/ada/sem_ch4.ads
+++ b/gcc/ada/sem_ch4.ads
@@ -65,15 +65,18 @@ package Sem_Ch4 is
-- on the prefix and the indexes.
function Try_Object_Operation
- (N : Node_Id;
- CW_Test_Only : Boolean := False) return Boolean;
- -- Ada 2005 (AI-252): Support the object.operation notation. If node N
- -- is a call in this notation, it is transformed into a normal subprogram
- -- call where the prefix is a parameter, and True is returned. If node
- -- N is not of this form, it is unchanged, and False is returned. If
- -- CW_Test_Only is true then N is an N_Selected_Component node which
- -- is part of a call to an entry or procedure of a tagged concurrent
- -- type and this routine is invoked to search for class-wide subprograms
- -- conflicting with the target entity.
+ (N : Node_Id;
+ CW_Test_Only : Boolean := False;
+ Allow_Extensions : Boolean := False) return Boolean;
+ -- Ada 2005 (AI-252): Support the object.operation notation. If node N is
+ -- a call in this notation, it is transformed into a normal subprogram call
+ -- where the prefix is a parameter, and True is returned. If node N is not
+ -- of this form, it is unchanged, and False is returned. If CW_Test_Only is
+ -- true then N is an N_Selected_Component node which is part of a call to
+ -- an entry or procedure of a tagged concurrent type and this routine is
+ -- invoked to search for class-wide subprograms conflicting with the target
+ -- entity. If Allow_Extensions is True, then a prefixed call of a primitive
+ -- of a non-tagged type is allowed as if Extensions_Allowed returned True.
+ -- This is used to issue better error messages.
end Sem_Ch4;
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index af8756b2cca..9c21732e5f9 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -11380,11 +11380,11 @@ package body Sem_Ch6 is
if not Comes_From_Source (S) then
-- Add an inherited primitive for an untagged derived type to
- -- Derived_Type's list of primitives. Tagged primitives are dealt
- -- with in Check_Dispatching_Operation.
+ -- Derived_Type's list of primitives. Tagged primitives are
+ -- dealt with in Check_Dispatching_Operation. Do this even when
+ -- Extensions_Allowed is False to issue better error messages.
if Present (Derived_Type)
- and then Extensions_Allowed
and then not Is_Tagged_Type (Derived_Type)
then
Append_Unique_Elmt (S, Primitive_Operations (Derived_Type));
@@ -11418,13 +11418,13 @@ package body Sem_Ch6 is
Set_Has_Primitive_Operations (B_Typ);
Set_Is_Primitive (S);
- -- Add a primitive for an untagged type to B_Typ's list
- -- of primitives. Tagged primitives are dealt with in
- -- Check_Dispatching_Operation.
+ -- Add a primitive for an untagged type to B_Typ's
+ -- list of primitives. Tagged primitives are dealt with
+ -- in Check_Dispatching_Operation. Do this even when
+ -- Extensions_Allowed is False to issue better error
+ -- messages.
- if Extensions_Allowed
- and then not Is_Tagged_Type (B_Typ)
- then
+ if not Is_Tagged_Type (B_Typ) then
Add_Or_Replace_Untagged_Primitive (B_Typ);
end if;
@@ -11463,11 +11463,11 @@ package body Sem_Ch6 is
-- Add a primitive for an untagged type to B_Typ's list
-- of primitives. Tagged primitives are dealt with in
- -- Check_Dispatching_Operation.
+ -- Check_Dispatching_Operation. Do this even when
+ -- Extensions_Allowed is False to issue better error
+ -- messages.
- if Extensions_Allowed
- and then not Is_Tagged_Type (B_Typ)
- then
+ if not Is_Tagged_Type (B_Typ) then
Add_Or_Replace_Untagged_Primitive (B_Typ);
end if;
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 686d4378f8c..e3a4881cf6c 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -7805,9 +7805,9 @@ package body Sem_Ch8 is
-- First check for components of a record object (not the result of
-- a call, which is handled below). This also covers the case where
- -- where the extension feature that supports the prefixed form of
- -- calls for primitives of untagged types is enabled (excluding
- -- concurrent cases, which are handled further below).
+ -- the extension feature that supports the prefixed form of calls
+ -- for primitives of untagged types is enabled (excluding concurrent
+ -- cases, which are handled further below).
if Is_Type (P_Type)
and then (Has_Components (P_Type)
@@ -8043,6 +8043,10 @@ package body Sem_Ch8 is
elsif Ekind (P_Name) = E_Void then
Premature_Usage (P);
+ elsif Ekind (P_Name) = E_Generic_Package then
+ Error_Msg_N ("prefix must not be a generic package", N);
+ Error_Msg_N ("\use package instantiation as prefix instead", N);
+
elsif Nkind (P) /= N_Attribute_Reference then
-- This may have been meant as a prefixed call to a primitive
@@ -8060,7 +8064,16 @@ package body Sem_Ch8 is
then
Error_Msg_N
("prefixed call is only allowed for objects of a "
- & "tagged type", N);
+ & "tagged type unless -gnatX is used", N);
+
+ if not Extensions_Allowed
+ and then
+ Try_Object_Operation (N, Allow_Extensions => True)
+ then
+ Error_Msg_N
+ ("\using -gnatX would make the prefixed call legal",
+ N);
+ end if;
end if;
end;
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-12-01 10:26 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-12-01 10:26 [gcc r12-5666] [Ada] Improve error messages for dot notation when -gnatX not used Pierre-Marie de Rodat
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).