when N_Derived_Type_Definition =>
Derived_Type_Declaration (T, N, T /= Def_Id);
- -- Inherit predicates from parent, and protect against
- -- illegal derivations.
+ -- Inherit predicates from parent, and protect against illegal
+ -- derivations.
if Is_Type (T) and then Has_Predicates (T) then
Set_Has_Predicates (Def_Id);
-- Any other relevant delayed aspects on object declarations ???
+ --------------------------
+ -- Check_Dynamic_Object --
+ --------------------------
+
procedure Check_Dynamic_Object (Typ : Entity_Id) is
Comp : Entity_Id;
Obj_Type : Entity_Id;
begin
Obj_Type := Typ;
+
if Is_Private_Type (Obj_Type)
and then Present (Full_View (Obj_Type))
then
elsif not Discriminated_Size (Comp)
and then Comes_From_Source (Comp)
then
- Error_Msg_NE ("component& of non-static size will violate "
- & "restriction No_Implicit_Heap_Allocation?", N, Comp);
+ Error_Msg_NE
+ ("component& of non-static size will violate restriction "
+ & "No_Implicit_Heap_Allocation?", N, Comp);
elsif Is_Record_Type (Etype (Comp)) then
Check_Dynamic_Object (Etype (Comp));
end if;
+
Next_Component (Comp);
end loop;
end if;
and then Can_Never_Be_Null (T)
then
if Comp_Decl = Obj_Decl then
- Null_Exclusion_Static_Checks (Obj_Decl, Empty, Array_Comp);
+ Null_Exclusion_Static_Checks
+ (N => Obj_Decl,
+ Comp => Empty,
+ Array_Comp => Array_Comp);
+
else
Null_Exclusion_Static_Checks
- (Obj_Decl, Comp_Decl, Array_Comp);
+ (N => Obj_Decl,
+ Comp => Comp_Decl,
+ Array_Comp => Array_Comp);
end if;
-- Check array components
Set_Ekind (T, E_Record_Type_With_Private);
Init_Size_Align (T);
Set_Default_SSO (T);
+ Set_No_Reordering (T, No_Component_Reordering);
Set_Etype (T, Parent_Base);
Propagate_Concurrent_Flags (T, Parent_Base);
Conditional_Delay (Id, T);
end if;
+ -- If we have a subtype of an incomplete type whose full type is a
+ -- derived numeric type, we need to have a freeze node for the subtype.
+ -- Otherwise gigi will complain while computing the (static) bounds of
+ -- the subtype.
+
+ if Is_Itype (T)
+ and then Is_Elementary_Type (Id)
+ and then Etype (Id) /= Id
+ then
+ declare
+ Partial : constant Entity_Id :=
+ Incomplete_Or_Partial_View (First_Subtype (Id));
+ begin
+ if Present (Partial)
+ and then Ekind (Partial) = E_Incomplete_Type
+ then
+ Set_Has_Delayed_Freeze (Id);
+ end if;
+ end;
+ end if;
+
-- Check that Constraint_Error is raised for a scalar subtype indication
-- when the lower or upper bound of a non-null range lies outside the
-- range of the type mark.
Analyze (Decl);
Set_Etype (Index, New_E);
- -- If the index is a range the Entity attribute is not
- -- available. Example:
+ -- If the index is a range or a subtype indication it carries
+ -- no entity. Example:
-- package Pkg is
-- type T is private;
-- Table : array (T(1) .. T(10)) of Boolean;
-- end Pkg;
- if Nkind (Index) /= N_Range then
+ -- Otherwise the type of the reference is its entity.
+
+ if Is_Entity_Name (Index) then
Set_Entity (Index, New_E);
end if;
end;
Set_Ekind (Full_Der, E_Record_Type);
Set_Is_Underlying_Record_View (Full_Der);
Set_Default_SSO (Full_Der);
+ Set_No_Reordering (Full_Der, No_Component_Reordering);
Analyze (Decl);
Set_Last_Entity (Der_Base, Last_Discr);
Set_First_Entity (Derived_Type, First_Entity (Der_Base));
Set_Last_Entity (Derived_Type, Last_Entity (Der_Base));
-
- Set_Stored_Constraint
- (Full_Der, Stored_Constraint (Derived_Type));
end;
end if;
-- 3. DISCRIMINANTS IN DERIVED UNTAGGED RECORD TYPES
-- We have spoken about stored discriminants in point 1 (introduction)
- -- above. There are two sort of stored discriminants: implicit and
+ -- above. There are two sorts of stored discriminants: implicit and
-- explicit. As long as the derived type inherits the same discriminants as
-- the root record type, stored discriminants are the same as regular
-- discriminants, and are said to be implicit. However, if any discriminant
-- type T4 (Y : Int) is new T3 (Y, 99);
-- The following table summarizes the discriminants and stored
- -- discriminants in R and T1 through T4.
+ -- discriminants in R and T1 through T4:
-- Type Discrim Stored Discrim Comment
-- R (D1, D2, D3) (D1, D2, D3) Girder discrims implicit in R
-- Field Corresponding_Discriminant (abbreviated CD below) allows us to
-- find the corresponding discriminant in the parent type, while
- -- Original_Record_Component (abbreviated ORC below), the actual physical
+ -- Original_Record_Component (abbreviated ORC below) the actual physical
-- component that is renamed. Finally the field Is_Completely_Hidden
-- (abbreviated ICH below) is set for all explicit stored discriminants
-- (see einfo.ads for more info). For the above example this gives:
-- D2 in T3 empty itself yes
-- D3 in T3 empty itself yes
- -- Y in T4 X1 in T3 D3 in T3 no
- -- D1 in T3 empty itself yes
- -- D2 in T3 empty itself yes
- -- D3 in T3 empty itself yes
+ -- Y in T4 X1 in T3 D3 in T4 no
+ -- D1 in T4 empty itself yes
+ -- D2 in T4 empty itself yes
+ -- D3 in T4 empty itself yes
-- 4. DISCRIMINANTS IN DERIVED TAGGED RECORD TYPES
Type_Def := N;
Set_Ekind (Derived_Type, E_Record_Type_With_Private);
Set_Default_SSO (Derived_Type);
+ Set_No_Reordering (Derived_Type, No_Component_Reordering);
else
Type_Def := Type_Definition (N);
if Present (Record_Extension_Part (Type_Def)) then
Set_Ekind (Derived_Type, E_Record_Type);
Set_Default_SSO (Derived_Type);
+ Set_No_Reordering (Derived_Type, No_Component_Reordering);
-- Create internal access types for components with anonymous
-- access types.
Set_Has_Primitive_Operations
(Derived_Type, Has_Primitive_Operations (Parent_Base));
- -- Fields inherited from the Parent_Base in the non-private case
+ -- Set fields for private derived types
- if Ekind (Derived_Type) = E_Record_Type then
- Set_Has_Complex_Representation
- (Derived_Type, Has_Complex_Representation (Parent_Base));
+ if Is_Private_Type (Derived_Type) then
+ Set_Depends_On_Private (Derived_Type, True);
+ Set_Private_Dependents (Derived_Type, New_Elmt_List);
end if;
- -- Fields inherited from the Parent_Base for record types
+ -- Inherit fields for non-private types. If this is the completion of a
+ -- derivation from a private type, the parent itself is private and the
+ -- attributes come from its full view, which must be present.
if Is_Record_Type (Derived_Type) then
declare
Parent_Full : Entity_Id;
begin
- -- Ekind (Parent_Base) is not necessarily E_Record_Type since
- -- Parent_Base can be a private type or private extension. Go
- -- to the full view here to get the E_Record_Type specific flags.
-
- if Present (Full_View (Parent_Base)) then
+ if Is_Private_Type (Parent_Base)
+ and then not Is_Record_Type (Parent_Base)
+ then
Parent_Full := Full_View (Parent_Base);
else
Parent_Full := Parent_Base;
end if;
- Set_OK_To_Reorder_Components
- (Derived_Type, OK_To_Reorder_Components (Parent_Full));
- end;
- end if;
-
- -- Set fields for private derived types
-
- if Is_Private_Type (Derived_Type) then
- Set_Depends_On_Private (Derived_Type, True);
- Set_Private_Dependents (Derived_Type, New_Elmt_List);
-
- -- Inherit fields from non private record types. If this is the
- -- completion of a derivation from a private type, the parent itself
- -- is private, and the attributes come from its full view, which must
- -- be present.
-
- else
- if Is_Private_Type (Parent_Base)
- and then not Is_Record_Type (Parent_Base)
- then
- Set_Component_Alignment
- (Derived_Type, Component_Alignment (Full_View (Parent_Base)));
- Set_C_Pass_By_Copy
- (Derived_Type, C_Pass_By_Copy (Full_View (Parent_Base)));
- else
Set_Component_Alignment
- (Derived_Type, Component_Alignment (Parent_Base));
+ (Derived_Type, Component_Alignment (Parent_Full));
Set_C_Pass_By_Copy
- (Derived_Type, C_Pass_By_Copy (Parent_Base));
- end if;
+ (Derived_Type, C_Pass_By_Copy (Parent_Full));
+ Set_Has_Complex_Representation
+ (Derived_Type, Has_Complex_Representation (Parent_Full));
+
+ -- For untagged types, inherit the layout by default to avoid
+ -- costly changes of representation for type conversions.
+
+ if not Is_Tagged then
+ Set_Is_Packed (Derived_Type, Is_Packed (Parent_Full));
+ Set_No_Reordering (Derived_Type, No_Reordering (Parent_Full));
+ end if;
+ end;
end if;
-- Set fields for tagged types
end if;
end;
end if;
-
- else
- Set_Is_Packed (Derived_Type, Is_Packed (Parent_Base));
- Set_Has_Non_Standard_Rep
- (Derived_Type, Has_Non_Standard_Rep (Parent_Base));
end if;
-- STEP 4: Inherit components from the parent base and constrain them.
-- elaboration, because only the access type is needed in the
-- initialization procedure.
- Set_Ekind (Def_Id, Ekind (T));
+ if Ekind (T) = E_Incomplete_Type then
+ Set_Ekind (Def_Id, E_Incomplete_Subtype);
+ else
+ Set_Ekind (Def_Id, Ekind (T));
+ end if;
if For_Access and then Within_Init_Proc then
null;
procedure Fixup_Bad_Constraint is
begin
- -- Set a reasonable Ekind for the entity. For an incomplete type,
- -- we can't do much, but for other types, we can set the proper
- -- corresponding subtype kind.
+ -- Set a reasonable Ekind for the entity, including incomplete types.
- if Ekind (T) = E_Incomplete_Type then
- Set_Ekind (Def_Id, Ekind (T));
- else
- Set_Ekind (Def_Id, Subtype_Kind (Ekind (T)));
- end if;
+ Set_Ekind (Def_Id, Subtype_Kind (Ekind (T)));
-- Set Etype to the known type, to reduce chances of cascaded errors
begin
Parent_Type := Find_Type_Of_Subtype_Indic (Indic);
+ if SPARK_Mode = On
+ and then Is_Tagged_Type (Parent_Type)
+ then
+ declare
+ Partial_View : constant Entity_Id :=
+ Incomplete_Or_Partial_View (Parent_Type);
+
+ begin
+ -- If the partial view was not found then the parent type is not
+ -- a private type. Otherwise check if the partial view is a tagged
+ -- private type.
+
+ if Present (Partial_View)
+ and then Is_Private_Type (Partial_View)
+ and then not Is_Tagged_Type (Partial_View)
+ then
+ Error_Msg_NE
+ ("cannot derive from & declared as untagged private "
+ & "(SPARK RM 3.4(1))", N, Partial_View);
+ end if;
+ end;
+ end if;
+
-- Ada 2005 (AI-251): In case of interface derivation check that the
-- parent is also an interface.
begin
-- Look for the associated private type declaration
- Partial_View := First_Entity (Current_Scope);
- loop
- exit when No (Partial_View)
- or else (Has_Private_Declaration (Partial_View)
- and then Full_View (Partial_View) = T);
-
- Next_Entity (Partial_View);
- end loop;
+ Partial_View := Incomplete_Or_Partial_View (T);
-- If the partial view was not found then the source code has
-- errors and the transformation is not needed.
if not Is_Tagged then
Set_Original_Record_Component (New_C, New_C);
+ Set_Corresponding_Record_Component (New_C, Old_C);
end if;
-- Set the proper type of an access discriminant
and then Original_Record_Component (Corr_Discrim) = Old_C
then
Set_Original_Record_Component (Discrim, New_C);
+ Set_Corresponding_Record_Component (Discrim, Empty);
end if;
Next_Discriminant (Discrim);
-- Ada 2005 (AI-412): Transform a regular incomplete subtype into a
-- corresponding subtype of the full view.
- elsif Ekind (Priv_Dep) = E_Incomplete_Subtype then
+ elsif Ekind (Priv_Dep) = E_Incomplete_Subtype
+ and then Comes_From_Source (Priv_Dep)
+ then
Set_Subtype_Indication
(Parent (Priv_Dep), New_Occurrence_Of (Full_T, Sloc (Priv_Dep)));
Set_Etype (Priv_Dep, Full_T);
Set_Ekind (Priv_Dep, Subtype_Kind (Ekind (Full_T)));
Set_Analyzed (Parent (Priv_Dep), False);
- -- Reanalyze the declaration, suppressing the call to
- -- Enter_Name to avoid duplicate names.
+ -- Reanalyze the declaration, suppressing the call to Enter_Name
+ -- to avoid duplicate names.
Analyze_Subtype_Declaration
(N => Parent (Priv_Dep),
Set_Interfaces (T, No_Elist);
Set_Stored_Constraint (T, No_Elist);
Set_Default_SSO (T);
+ Set_No_Reordering (T, No_Component_Reordering);
-- Normal case
projects / gcc.git / blobdiff