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