Skip to content

R
riscv-gcc-1
Commit 7c15c6dd by Arnaud Charlet
Options

[multiple changes] 

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.

From-SVN: r251763
parent c23c86bb
Showing with 112 additions and 33 deletions
gcc/ada/ChangeLog
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,
......@@ -11,7 +32,6 @@
* sem_prag.adb: Update description of Eliminate.
2017-09-06 Ed Schonberg <schonberg@adacore.com>
* sem_attr.adb (Analyze_Attribute, case 'Loop_Entry): Handle
......@@ -179,7 +199,6 @@
* 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
......
gcc/ada/exp_ch4.adb
......@@ -10627,7 +10627,6 @@ package body Exp_Ch4 is
Temp : Entity_Id;
Decl : Node_Id;
Odef : Node_Id;
Disc : Node_Id;
N_Ix : Node_Id;
Cons : List_Id;
......@@ -10657,22 +10656,69 @@ package body Exp_Ch4 is
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);
......
gcc/ada/exp_ch5.adb
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -1448,9 +1448,21 @@ package body Exp_Ch5 is
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.
......@@ -1463,7 +1475,7 @@ package body Exp_Ch5 is
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 :=
......
gcc/ada/sem_ch7.adb
......@@ -392,6 +392,13 @@ package body Sem_Ch7 is
-- 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
......@@ -413,18 +420,13 @@ package body Sem_Ch7 is
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
......@@ -915,11 +917,11 @@ package body Sem_Ch7 is
-- 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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment