From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1914) id EEAA93858406; Wed, 1 Dec 2021 10:26:09 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org EEAA93858406 MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Pierre-Marie de Rodat To: gcc-cvs@gcc.gnu.org Subject: [gcc r12-5666] [Ada] Improve error messages for dot notation when -gnatX not used X-Act-Checkin: gcc X-Git-Author: Yannick Moy X-Git-Refname: refs/heads/master X-Git-Oldrev: be8de8e127b06017f2c3602c81de99ad5937ef9d X-Git-Newrev: 790b8752100e699d98140f0b094cbf5b893aa7dd Message-Id: <20211201102609.EEAA93858406@sourceware.org> Date: Wed, 1 Dec 2021 10:26:09 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Wed, 01 Dec 2021 10:26:10 -0000 https://gcc.gnu.org/g:790b8752100e699d98140f0b094cbf5b893aa7dd commit r12-5666-g790b8752100e699d98140f0b094cbf5b893aa7dd Author: Yannick Moy 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;