[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.
This commit is contained in:
Yannick Moy 2021-10-08 16:19:50 +02:00 committed by Pierre-Marie de Rodat
parent be8de8e127
commit 790b875210
5 changed files with 59 additions and 40 deletions

View File

@ -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

View File

@ -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))

View File

@ -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;

View File

@ -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;

View File

@ -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;