+2017-09-06 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sem_ch7.adb (Has_Referencer): Move up and expand comment
+ explaining the test used to detect inlining. Use same test
+ in second occurrence.
+ (Analyze_Package_Body_Helper): Minor formatting fixes.
+
+2017-09-06 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch4.adb (Handle_Changed_Representation): For an untagged
+ derived type with a mixture of renamed and constrained parent
+ discriminants, the constraint for the target must obtain the
+ discriminant values from both the operand and from the stored
+ constraint for it, given that the constrained discriminants are
+ not visible in the object.
+ * exp_ch5.adb (Make_Field_Assign): The type of the right-hand
+ side may be derived from that of the left-hand side (as in the
+ case of an assignment with a change of representation) so the
+ discriminant to be used in the retrieval of the value of the
+ component must be the entity in the type of the right-hand side.
+
2017-09-06 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch3.adb, sem_ch7.adb, sem_util.adb, g-debpoo.adb, sem_ch4.adb,
* sem_prag.adb: Update description of Eliminate.
-
2017-09-06 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Analyze_Attribute, case 'Loop_Entry): Handle
* fe.h (Eliminate_Error_Msg): Remove.
-
2017-09-05 Richard Sandiford <richard.sandiford@linaro.org>
* gcc-interface/utils.c (make_packable_type): Update call to
Temp : Entity_Id;
Decl : Node_Id;
Odef : Node_Id;
- Disc : Node_Id;
N_Ix : Node_Id;
Cons : List_Id;
if not Is_Constrained (Target_Type) then
if Has_Discriminants (Operand_Type) then
- Disc := First_Discriminant (Operand_Type);
- if Disc /= First_Stored_Discriminant (Operand_Type) then
- Disc := First_Stored_Discriminant (Operand_Type);
- end if;
+ -- A change of representation can only apply to untagged
+ -- types. We need to build the constraint that applies to
+ -- the target type, using the constraints of the operand.
+ -- The analysis is complicated if there are both inherited
+ -- discriminants and constrained discriminants.
+ -- We iterate over the discriminants of the target, and
+ -- find the discriminant of the same name:
- Cons := New_List;
- while Present (Disc) loop
- Append_To (Cons,
- Make_Selected_Component (Loc,
- Prefix =>
- Duplicate_Subexpr_Move_Checks (Operand),
- Selector_Name =>
- Make_Identifier (Loc, Chars (Disc))));
- Next_Discriminant (Disc);
- end loop;
+ -- a) If there is a corresponding discriminant in the object
+ -- then the value is a selected component of the operand.
+
+ -- b) Otherwise the value of a constrained discriminant is
+ -- found in the stored constraint of the operand.
+
+ declare
+ Stored : constant Elist_Id :=
+ Stored_Constraint (Operand_Type);
+
+ Elmt : Elmt_Id;
+
+ Disc_O : Entity_Id;
+ -- Discriminant of the operand type. Its value in the
+ -- the object is captured in a selected component.
+
+ Disc_S : Entity_Id;
+ -- Stored discriminant of the operand. If present, it
+ -- corresponds to a constrained discriminant of the
+ -- parent type.
+
+ Disc_T : Entity_Id;
+ -- Discriminant of the target type
+
+ begin
+ Disc_T := First_Discriminant (Target_Type);
+ Disc_O := First_Discriminant (Operand_Type);
+ Disc_S := First_Stored_Discriminant (Operand_Type);
+
+ if Present (Stored) then
+ Elmt := First_Elmt (Stored);
+ end if;
+
+ Cons := New_List;
+ while Present (Disc_T) loop
+ if Present (Disc_O)
+ and then Chars (Disc_T) = Chars (Disc_O)
+ then
+ Append_To (Cons,
+ Make_Selected_Component (Loc,
+ Prefix =>
+ Duplicate_Subexpr_Move_Checks (Operand),
+ Selector_Name =>
+ Make_Identifier (Loc, Chars (Disc_O))));
+ Next_Discriminant (Disc_O);
+
+ elsif Present (Disc_S) then
+ Append_To (Cons, New_Copy_Tree (Node (Elmt)));
+ Next_Elmt (Elmt);
+ end if;
+
+ Next_Discriminant (Disc_T);
+ end loop;
+ end;
elsif Is_Array_Type (Operand_Type) then
N_Ix := First_Index (Target_Type);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2017, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
U_U : Boolean := False) return Node_Id
is
A : Node_Id;
+ Disc : Entity_Id;
Expr : Node_Id;
begin
+
+ -- The discriminant entity to be used in the retrieval below must
+ -- be one in the corresponding type, given that the assignment
+ -- may be between derived and parent types.
+
+ if Is_Derived_Type (Etype (Rhs)) then
+ Disc := Find_Component (R_Typ, C);
+ else
+ Disc := C;
+ end if;
+
-- In the case of an Unchecked_Union, use the discriminant
-- constraint value as on the right-hand side of the assignment.
Expr :=
Make_Selected_Component (Loc,
Prefix => Duplicate_Subexpr (Rhs),
- Selector_Name => New_Occurrence_Of (C, Loc));
+ Selector_Name => New_Occurrence_Of (Disc, Loc));
end if;
A :=
-- An inlined subprogram body acts as a referencer
+ -- Note that we test Has_Pragma_Inline here in addition
+ -- to Is_Inlined. We are doing this for a client, since
+ -- we are computing which entities should be public, and
+ -- it is the client who will decide if actual inlining
+ -- should occur, so we need to catch all cases where the
+ -- subprogram may be inlined by the client.
+
if Is_Inlined (Decl_Id)
or else Has_Pragma_Inline (Decl_Id)
then
else
Decl_Id := Defining_Entity (Decl);
- -- An inlined body acts as a referencer. Note that an
- -- inlined subprogram remains Is_Public as gigi requires
- -- the flag to be set.
-
- -- Note that we test Has_Pragma_Inline here rather than
- -- Is_Inlined. We are compiling this for a client, and
- -- it is the client who will decide if actual inlining
- -- should occur, so we need to assume that the procedure
- -- could be inlined for the purpose of accessing global
- -- entities.
+ -- An inlined body acts as a referencer, see above. Note
+ -- that an inlined subprogram remains Is_Public as gigi
+ -- requires the flag to be set.
- if Has_Pragma_Inline (Decl_Id) then
+ if Is_Inlined (Decl_Id)
+ or else Has_Pragma_Inline (Decl_Id)
+ then
if Top_Level
and then not Contains_Subprograms_Refs (Decl)
then
-- down the number of global symbols that do not neet public visibility
-- as this has two beneficial effects:
-- (1) It makes the compilation process more efficient.
- -- (2) It gives the code generatormore freedom to optimize within each
+ -- (2) It gives the code generator more leeway to optimize within each
-- unit, especially subprograms.
- -- This is done only for top level library packages or child units as
- -- the algorithm does a top down traversal of the package body.
+ -- This is done only for top-level library packages or child units as
+ -- the algorithm does a top-down traversal of the package body.
if (Scope (Spec_Id) = Standard_Standard or else Is_Child_Unit (Spec_Id))
and then not Is_Generic_Unit (Spec_Id)
projects / gcc.git / commitdiff