[Ada] Improve error messages for dot notation when -gnatX not used
Commit Message
With extensions allowed (whether switch -gnatX or pragma
Extensions_Allowed is used), dot notation is allowed on untagged types
for primitives of the type. Improve the error messages issued when
extensions are not allowed, in particular when allowing extensions would
make the code legal.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
@@ -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. 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;