* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213345
138bc75d-0d04-0410-961f-
82ee72b054a4
+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):
-- 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;
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);
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));
-- 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
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 --
--------------------------
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,
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))));
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 --
-----------------------------
-- 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
projects / platform / upstream / linaro-gcc.git / commitdiff