+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
-- 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;
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;
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;
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;
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
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;
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
-----------------------------------
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;
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
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
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;
-- 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
-- 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
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;
projects / gcc.git / commitdiff