sem_util.ads (Find_Specific_Type): Moved here from exp_disp.adb.
2014-07-31 Ed Schonberg <schonberg@adacore.com> * sem_util.ads (Find_Specific_Type): Moved here from exp_disp.adb. * sem_util.adb (Find_Specific_Type): If type is untagged private, retrieve full view so that primitive operations can be located. * exp_disp.adb Move Find_Specific_Type to sem_util. * exp_ch4.adb (Expand_N_Op_Eq): If operands are class-wide, use Find_Specific_Type to locate primitive equality. * exp_util.adb (Make_CW_Equivalent_Type): A class_wide equivalent type does not require initialization. * exp_attr.adb (Compile_Stream_Body_In_Scope): Within an instance body all visibility is established, and the enclosing package declarations must not be installed. From-SVN: r213345
This commit is contained in:
Ed Schonberg
Arnaud Charlet
parent
9420f51f05
commit
3dddb11ea4
|
|
@ -1,3 +1,17 @@
|
|||
2014-07-31 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_util.ads (Find_Specific_Type): Moved here from exp_disp.adb.
|
||||
* sem_util.adb (Find_Specific_Type): If type is untagged private,
|
||||
retrieve full view so that primitive operations can be located.
|
||||
* exp_disp.adb Move Find_Specific_Type to sem_util.
|
||||
* exp_ch4.adb (Expand_N_Op_Eq): If operands are class-wide, use
|
||||
Find_Specific_Type to locate primitive equality.
|
||||
* exp_util.adb (Make_CW_Equivalent_Type): A class_wide equivalent
|
||||
type does not require initialization.
|
||||
* exp_attr.adb (Compile_Stream_Body_In_Scope): Within an instance
|
||||
body all visibility is established, and the enclosing package
|
||||
declarations must not be installed.
|
||||
|
||||
2014-07-31 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* sem_parg.adb, sem_prag.ads (Collect_Subprogram_Inputs_Outputs):
|
||||
|
|
|
|||
|
|
@ -106,6 +106,8 @@ package body Exp_Attr is
|
|||
-- We suppress checks for array/record reads, since the rule is that these
|
||||
-- are like assignments, out of range values due to uninitialized storage,
|
||||
-- or other invalid values do NOT cause a Constraint_Error to be raised.
|
||||
-- If we are within an instance body all visibility has been established
|
||||
-- already and there is no need to install the package.
|
||||
|
||||
procedure Expand_Access_To_Protected_Op
|
||||
(N : Node_Id;
|
||||
|
|
@ -630,6 +632,11 @@ package body Exp_Attr is
|
|||
if Is_Hidden (Arr)
|
||||
and then not In_Open_Scopes (Scop)
|
||||
and then Ekind (Scop) = E_Package
|
||||
|
||||
-- If we are within an instance body, then all visibility has been
|
||||
-- established already and there is no need to install the package.
|
||||
|
||||
and then not In_Instance_Body
|
||||
then
|
||||
Push_Scope (Scop);
|
||||
Install_Visible_Declarations (Scop);
|
||||
|
|
|
|||
|
|
@ -7300,15 +7300,15 @@ package body Exp_Ch4 is
|
|||
Op_Name := Node (Prim);
|
||||
|
||||
-- Find the type's predefined equality or an overriding
|
||||
-- user- defined equality. The reason for not simply calling
|
||||
-- user-defined equality. The reason for not simply calling
|
||||
-- Find_Prim_Op here is that there may be a user-defined
|
||||
-- overloaded equality op that precedes the equality that we want,
|
||||
-- so we have to explicitly search (e.g., there could be an
|
||||
-- equality with two different parameter types).
|
||||
-- overloaded equality op that precedes the equality that we
|
||||
-- want, so we have to explicitly search (e.g., there could be
|
||||
-- an equality with two different parameter types).
|
||||
|
||||
else
|
||||
if Is_Class_Wide_Type (Typl) then
|
||||
Typl := Root_Type (Typl);
|
||||
Typl := Find_Specific_Type (Typl);
|
||||
end if;
|
||||
|
||||
Prim := First_Elmt (Primitive_Operations (Typl));
|
||||
|
|
|
|||
|
|
@ -75,12 +75,6 @@ package body Exp_Disp is
|
|||
-- Ada 2005 (AI-251): Returns the fixed position in the dispatch table
|
||||
-- of the default primitive operations.
|
||||
|
||||
function Find_Specific_Type (CW : Entity_Id) return Entity_Id;
|
||||
-- Find specific type of a class-wide type, and handle the case of an
|
||||
-- incomplete type coming either from a limited_with clause or from an
|
||||
-- incomplete type declaration. Shouldn't this be in Sem_Util? It seems
|
||||
-- like a general purpose semantic routine ???
|
||||
|
||||
function Has_DT (Typ : Entity_Id) return Boolean;
|
||||
pragma Inline (Has_DT);
|
||||
-- Returns true if we generate a dispatch table for tagged type Typ
|
||||
|
|
@ -1987,25 +1981,6 @@ package body Exp_Disp is
|
|||
end if;
|
||||
end Expand_Interface_Thunk;
|
||||
|
||||
------------------------
|
||||
-- Find_Specific_Type --
|
||||
------------------------
|
||||
|
||||
function Find_Specific_Type (CW : Entity_Id) return Entity_Id is
|
||||
Typ : Entity_Id := Root_Type (CW);
|
||||
|
||||
begin
|
||||
if Ekind (Typ) = E_Incomplete_Type then
|
||||
if From_Limited_With (Typ) then
|
||||
Typ := Non_Limited_View (Typ);
|
||||
else
|
||||
Typ := Full_View (Typ);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
return Typ;
|
||||
end Find_Specific_Type;
|
||||
|
||||
--------------------------
|
||||
-- Has_CPP_Constructors --
|
||||
--------------------------
|
||||
|
|
|
|||
|
|
@ -5860,10 +5860,14 @@ package body Exp_Util is
|
|||
|
||||
Set_Is_Class_Wide_Equivalent_Type (Equiv_Type);
|
||||
|
||||
-- A class_wide equivalent type does not require initialization
|
||||
|
||||
Set_Suppress_Initialization (Equiv_Type);
|
||||
|
||||
if not Is_Interface (Root_Typ) then
|
||||
Append_To (Comp_List,
|
||||
Make_Component_Declaration (Loc,
|
||||
Defining_Identifier =>
|
||||
Defining_Identifier =>
|
||||
Make_Defining_Identifier (Loc, Name_uParent),
|
||||
Component_Definition =>
|
||||
Make_Component_Definition (Loc,
|
||||
|
|
@ -5882,9 +5886,9 @@ package body Exp_Util is
|
|||
Append_To (List_Def,
|
||||
Make_Full_Type_Declaration (Loc,
|
||||
Defining_Identifier => Equiv_Type,
|
||||
Type_Definition =>
|
||||
Type_Definition =>
|
||||
Make_Record_Definition (Loc,
|
||||
Component_List =>
|
||||
Component_List =>
|
||||
Make_Component_List (Loc,
|
||||
Component_Items => Comp_List,
|
||||
Variant_Part => Empty))));
|
||||
|
|
|
|||
|
|
@ -5932,6 +5932,32 @@ package body Sem_Util is
|
|||
end loop;
|
||||
end Find_Placement_In_State_Space;
|
||||
|
||||
------------------------
|
||||
-- Find_Specific_Type --
|
||||
------------------------
|
||||
|
||||
function Find_Specific_Type (CW : Entity_Id) return Entity_Id is
|
||||
Typ : Entity_Id := Root_Type (CW);
|
||||
|
||||
begin
|
||||
if Ekind (Typ) = E_Incomplete_Type then
|
||||
if From_Limited_With (Typ) then
|
||||
Typ := Non_Limited_View (Typ);
|
||||
else
|
||||
Typ := Full_View (Typ);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
if Is_Private_Type (Typ)
|
||||
and then not Is_Tagged_Type (Typ)
|
||||
and then Present (Full_View (Typ))
|
||||
then
|
||||
return Full_View (Typ);
|
||||
else
|
||||
return Typ;
|
||||
end if;
|
||||
end Find_Specific_Type;
|
||||
|
||||
-----------------------------
|
||||
-- Find_Static_Alternative --
|
||||
-----------------------------
|
||||
|
|
|
|||
|
|
@ -568,6 +568,12 @@ package Sem_Util is
|
|||
-- Call is set to the node for the corresponding call. If the node N is not
|
||||
-- an actual parameter then Formal and Call are set to Empty.
|
||||
|
||||
function Find_Specific_Type (CW : Entity_Id) return Entity_Id;
|
||||
-- Find specific type of a class-wide type, and handle the case of an
|
||||
-- incomplete type coming either from a limited_with clause or from an
|
||||
-- incomplete type declaration. If resulting type is private return its
|
||||
-- full view.
|
||||
|
||||
function Find_Body_Discriminal
|
||||
(Spec_Discriminant : Entity_Id) return Entity_Id;
|
||||
-- Given a discriminant of the record type that implements a task or
|
||||
|
|
|
|||
Loading…
Reference in New Issue