[multiple changes]
2015-05-12 Robert Dewar <dewar@adacore.com> * sem_type.adb, sem_ch10.adb, freeze.adb, sem_ch6.adb, exp_disp.adb: Minor reformatting. 2015-05-12 Bob Duff <duff@adacore.com> * exp_attr.adb (Size): Remove unnecessary check for types with unknown discriminants. That was causing the compiler to build a function call _size(T), where T is a type, not an object. 2015-05-12 Ed Schonberg <schonberg@adacore.com> * sem_ch4.adb (Extended_Primitive_Ops): Exclude overriding primitive operations of a type extension declared in the package body, to prevent duplicates in extended list. 2015-05-12 Ed Schonberg <schonberg@adacore.com> * sem_ch3.adb (Analyze_Component_Declaration): If the component is an unconstrained synchronized type with discriminants, create a constrained default subtype for it, so that the enclosing record can be given the proper size. * sem_util.adb (Build_Default_Subtype): If the subtype is created for a record discriminant, do not analyze the declarztion at once because it is added to the freezing actions of the enclosing record type. From-SVN: r223039
This commit is contained in:
Arnaud Charlet
parent
473469230a
commit
e23e04db7b
|
|
@ -1,3 +1,31 @@
|
|||
2015-05-12 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_type.adb, sem_ch10.adb, freeze.adb, sem_ch6.adb, exp_disp.adb:
|
||||
Minor reformatting.
|
||||
|
||||
2015-05-12 Bob Duff <duff@adacore.com>
|
||||
|
||||
* exp_attr.adb (Size): Remove unnecessary check for types with
|
||||
unknown discriminants. That was causing the compiler to build
|
||||
a function call _size(T), where T is a type, not an object.
|
||||
|
||||
2015-05-12 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch4.adb (Extended_Primitive_Ops): Exclude overriding
|
||||
primitive operations of a type extension declared in the package
|
||||
body, to prevent duplicates in extended list.
|
||||
|
||||
2015-05-12 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Analyze_Component_Declaration): If the component is
|
||||
an unconstrained synchronized type with discriminants, create a
|
||||
constrained default subtype for it, so that the enclosing record
|
||||
can be given the proper size.
|
||||
* sem_util.adb (Build_Default_Subtype): If the subtype is created
|
||||
for a record discriminant, do not analyze the declarztion at
|
||||
once because it is added to the freezing actions of the enclosing
|
||||
record type.
|
||||
|
||||
2015-05-12 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* exp_prag.adb (Expand_N_Pragma): Rewrite ignored pragma as
|
||||
|
|
|
|||
|
|
@ -5538,14 +5538,11 @@ package body Exp_Attr is
|
|||
-- For X'Size applied to an object of a class-wide type, transform
|
||||
-- X'Size into a call to the primitive operation _Size applied to X.
|
||||
|
||||
elsif Is_Class_Wide_Type (Ptyp)
|
||||
or else (Id = Attribute_Size
|
||||
and then Is_Tagged_Type (Ptyp)
|
||||
and then Has_Unknown_Discriminants (Ptyp))
|
||||
then
|
||||
elsif Is_Class_Wide_Type (Ptyp) then
|
||||
|
||||
-- No need to do anything else compiling under restriction
|
||||
-- No_Dispatching_Calls. During the semantic analysis we
|
||||
-- already notified such violation.
|
||||
-- already noted this restriction violation.
|
||||
|
||||
if Restriction_Active (No_Dispatching_Calls) then
|
||||
return;
|
||||
|
|
|
|||
|
|
@ -1612,8 +1612,8 @@ package body Exp_Disp is
|
|||
Set_Scope (Anon, Current_Scope);
|
||||
end if;
|
||||
|
||||
Set_Directly_Designated_Type (Anon,
|
||||
Non_Limited_View (Actual_DDT));
|
||||
Set_Directly_Designated_Type
|
||||
(Anon, Non_Limited_View (Actual_DDT));
|
||||
Set_Etype (Actual_Dup, Anon);
|
||||
end if;
|
||||
end if;
|
||||
|
|
|
|||
|
|
@ -425,8 +425,8 @@ package body Freeze is
|
|||
Ret_Type : constant Entity_Id := Etype (Result_Definition (Spec));
|
||||
begin
|
||||
if Has_Non_Limited_View (Ret_Type) then
|
||||
Set_Result_Definition (Spec,
|
||||
New_Occurrence_Of (Non_Limited_View (Ret_Type), Loc));
|
||||
Set_Result_Definition
|
||||
(Spec, New_Occurrence_Of (Non_Limited_View (Ret_Type), Loc));
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
|
|
@ -456,10 +456,11 @@ package body Freeze is
|
|||
elsif Is_Access_Type (Form_Type)
|
||||
and then not Is_Access_Type (Pref)
|
||||
then
|
||||
Actuals := New_List
|
||||
(Make_Attribute_Reference (Loc,
|
||||
Attribute_Name => Name_Access,
|
||||
Prefix => Relocate_Node (Pref)));
|
||||
Actuals :=
|
||||
New_List (
|
||||
Make_Attribute_Reference (Loc,
|
||||
Attribute_Name => Name_Access,
|
||||
Prefix => Relocate_Node (Pref)));
|
||||
else
|
||||
Actuals := New_List (Pref);
|
||||
end if;
|
||||
|
|
@ -530,7 +531,7 @@ package body Freeze is
|
|||
Make_Simple_Return_Statement (Loc,
|
||||
Expression =>
|
||||
Make_Function_Call (Loc,
|
||||
Name => Call_Name,
|
||||
Name => Call_Name,
|
||||
Parameter_Associations => Actuals));
|
||||
|
||||
elsif Ekind (Old_S) = E_Enumeration_Literal then
|
||||
|
|
@ -540,13 +541,12 @@ package body Freeze is
|
|||
|
||||
elsif Nkind (Nam) = N_Character_Literal then
|
||||
Call_Node :=
|
||||
Make_Simple_Return_Statement (Loc,
|
||||
Expression => Call_Name);
|
||||
Make_Simple_Return_Statement (Loc, Expression => Call_Name);
|
||||
|
||||
else
|
||||
Call_Node :=
|
||||
Make_Procedure_Call_Statement (Loc,
|
||||
Name => Call_Name,
|
||||
Name => Call_Name,
|
||||
Parameter_Associations => Actuals);
|
||||
end if;
|
||||
|
||||
|
|
|
|||
|
|
@ -5605,8 +5605,8 @@ package body Sem_Ch10 is
|
|||
Set_Non_Limited_View (Shadow, Ent);
|
||||
|
||||
if Is_Tagged then
|
||||
Set_Non_Limited_View (Class_Wide_Type (Shadow),
|
||||
Class_Wide_Type (Ent));
|
||||
Set_Non_Limited_View
|
||||
(Class_Wide_Type (Shadow), Class_Wide_Type (Ent));
|
||||
end if;
|
||||
|
||||
if Is_Incomplete_Or_Private_Type (Ent) then
|
||||
|
|
|
|||
|
|
@ -1794,9 +1794,10 @@ package body Sem_Ch3 is
|
|||
-----------------------------------
|
||||
|
||||
procedure Analyze_Component_Declaration (N : Node_Id) is
|
||||
Id : constant Entity_Id := Defining_Identifier (N);
|
||||
E : constant Node_Id := Expression (N);
|
||||
Typ : constant Node_Id :=
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Id : constant Entity_Id := Defining_Identifier (N);
|
||||
E : constant Node_Id := Expression (N);
|
||||
Typ : constant Node_Id :=
|
||||
Subtype_Indication (Component_Definition (N));
|
||||
T : Entity_Id;
|
||||
P : Entity_Id;
|
||||
|
|
@ -2123,6 +2124,27 @@ package body Sem_Ch3 is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- If the component is an unconstrained task or protected type with
|
||||
-- discriminants, the component and the enclosing record are limited
|
||||
-- and the component is constrained by its default values. Compute
|
||||
-- its actual subtype, else it may be allocated the maximum size by
|
||||
-- the backend, and possibly overflow.
|
||||
|
||||
if Is_Concurrent_Type (T)
|
||||
and then not Is_Constrained (T)
|
||||
and then Has_Discriminants (T)
|
||||
and then not Has_Discriminants (Current_Scope)
|
||||
then
|
||||
declare
|
||||
Act_T : constant Entity_Id := Build_Default_Subtype (T, N);
|
||||
begin
|
||||
Set_Etype (Id, Act_T);
|
||||
Set_Component_Definition (N,
|
||||
Make_Component_Definition (Loc,
|
||||
Subtype_Indication => New_Occurrence_Of (Act_T, Loc)));
|
||||
end;
|
||||
end if;
|
||||
|
||||
Set_Original_Record_Component (Id, Id);
|
||||
|
||||
if Has_Aspects (N) then
|
||||
|
|
|
|||
|
|
@ -8196,6 +8196,12 @@ package body Sem_Ch4 is
|
|||
while Present (Op) loop
|
||||
if Comes_From_Source (Op)
|
||||
and then Is_Overloadable (Op)
|
||||
|
||||
-- Exclude overriding primitive operations of a type
|
||||
-- extension declared in the package body, to prevent
|
||||
-- duplicates in extended list.
|
||||
|
||||
and then not Is_Primitive (Op)
|
||||
and then Is_List_Member (Unit_Declaration_Node (Op))
|
||||
and then List_Containing (Unit_Declaration_Node (Op)) =
|
||||
Body_Decls
|
||||
|
|
|
|||
|
|
@ -2921,11 +2921,8 @@ package body Sem_Ch6 is
|
|||
|
||||
procedure Detect_And_Exchange (Id : Entity_Id) is
|
||||
Typ : constant Entity_Id := Etype (Id);
|
||||
|
||||
begin
|
||||
if From_Limited_With (Typ)
|
||||
and then Has_Non_Limited_View (Typ)
|
||||
then
|
||||
if From_Limited_With (Typ) and then Has_Non_Limited_View (Typ) then
|
||||
Set_Etype (Id, Non_Limited_View (Typ));
|
||||
end if;
|
||||
end Detect_And_Exchange;
|
||||
|
|
|
|||
|
|
@ -1228,7 +1228,7 @@ package body Sem_Type is
|
|||
-- incomplete, get full view if available.
|
||||
|
||||
return Has_Non_Limited_View (T1)
|
||||
and then Covers (Get_Full_View (Non_Limited_View (T1)), T2);
|
||||
and then Covers (Get_Full_View (Non_Limited_View (T1)), T2);
|
||||
|
||||
elsif From_Limited_With (T2) then
|
||||
|
||||
|
|
@ -1237,7 +1237,7 @@ package body Sem_Type is
|
|||
-- verify that the context type is the nonlimited view.
|
||||
|
||||
return Has_Non_Limited_View (T2)
|
||||
and then Covers (T1, Get_Full_View (Non_Limited_View (T2)));
|
||||
and then Covers (T1, Get_Full_View (Non_Limited_View (T2)));
|
||||
|
||||
-- Ada 2005 (AI-412): Coverage for regular incomplete subtypes
|
||||
|
||||
|
|
|
|||
|
|
@ -1546,7 +1546,15 @@ package body Sem_Util is
|
|||
Constraints => Constraints)));
|
||||
|
||||
Insert_Action (N, Decl);
|
||||
Analyze (Decl);
|
||||
|
||||
-- If the context is a component declaration the subtype
|
||||
-- declaration will be analyzed when the enclosing type is
|
||||
-- frozen, otherwise do it now.
|
||||
|
||||
if Ekind (Current_Scope) /= E_Record_Type then
|
||||
Analyze (Decl);
|
||||
end if;
|
||||
|
||||
return Act;
|
||||
end;
|
||||
end Build_Default_Subtype;
|
||||
|
|
|
|||
Loading…
Reference in New Issue