[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
Pierre-Marie de Rodat
parent
be8de8e127
commit
790b875210
5 changed files with 59 additions and 40 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue