mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-24 04:10:29 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2017-04-27  Yannick Moy  <moy@adacore.com>

	* exp_unst.ads: Fix typos in comments.

2017-04-27  Ed Schonberg  <schonberg@adacore.com>

	* sem_eval.adb (Choice_Matches): Handle properly a real literal
	whose type has a defined static predicate.

2017-04-27  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Insert_Dereference_Action):
	Do not adjust the address of a controlled object when the
	associated access type is subject to pragma No_Heap_Finalization.
	Code reformatting.

From-SVN: r247304
This commit is contained in:
Arnaud Charlet 2017-04-27 11:52:18 +02:00
parent ed8cbbaf7d
commit bb9e2aa275
4 changed files with 60 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2017-04-27 Yannick Moy <moy@adacore.com>
* exp_unst.ads: Fix typos in comments.
2017-04-27 Ed Schonberg <schonberg@adacore.com>
* sem_eval.adb (Choice_Matches): Handle properly a real literal
whose type has a defined static predicate.
2017-04-27 Hristian Kirtchev <kirtchev@adacore.com>
* exp_ch4.adb (Insert_Dereference_Action):
Do not adjust the address of a controlled object when the
associated access type is subject to pragma No_Heap_Finalization.
Code reformatting.
2017-04-27 Pierre-Marie de Rodat <derodat@adacore.com>
* gcc-interface/utils.c (gnat_type_for_size): Set

37
gcc/ada/exp_ch4.adb
View File

@ -12032,7 +12032,6 @@ package body Exp_Ch4 is
-------------------------------
procedure Insert_Dereference_Action (N : Node_Id) is
function Is_Checked_Storage_Pool (P : Entity_Id) return Boolean;
-- Return true if type of P is derived from Checked_Pool;
@ -12062,11 +12061,12 @@ package body Exp_Ch4 is
-- Local variables
Typ : constant Entity_Id := Etype (N);
Desig : constant Entity_Id := Available_View (Designated_Type (Typ));
Loc : constant Source_Ptr := Sloc (N);
Pool : constant Entity_Id := Associated_Storage_Pool (Typ);
Pnod : constant Node_Id := Parent (N);
Context : constant Node_Id := Parent (N);
Ptr_Typ : constant Entity_Id := Etype (N);
Desig_Typ : constant Entity_Id :=
Available_View (Designated_Type (Ptr_Typ));
Loc : constant Source_Ptr := Sloc (N);
Pool : constant Entity_Id := Associated_Storage_Pool (Ptr_Typ);
Addr : Entity_Id;
Alig : Entity_Id;
@ -12078,18 +12078,18 @@ package body Exp_Ch4 is
-- Start of processing for Insert_Dereference_Action
begin
pragma Assert (Nkind (Pnod) = N_Explicit_Dereference);
pragma Assert (Nkind (Context) = N_Explicit_Dereference);
-- Do not re-expand a dereference which has already been processed by
-- this routine.
if Has_Dereference_Action (Pnod) then
if Has_Dereference_Action (Context) then
return;
-- Do not perform this type of expansion for internally-generated
-- dereferences.
elsif not Comes_From_Source (Original_Node (Pnod)) then
elsif not Comes_From_Source (Original_Node (Context)) then
return;
-- A dereference action is only applicable to objects which have been
@ -12131,15 +12131,15 @@ package body Exp_Ch4 is
-- Special case of an unconstrained array: need to add descriptor size
if Is_Array_Type (Desig)
and then not Is_Constrained (First_Subtype (Desig))
if Is_Array_Type (Desig_Typ)
and then not Is_Constrained (First_Subtype (Desig_Typ))
then
Size_Bits :=
Make_Op_Add (Loc,
Left_Opnd =>
Make_Attribute_Reference (Loc,
Prefix =>
New_Occurrence_Of (First_Subtype (Desig), Loc),
New_Occurrence_Of (First_Subtype (Desig_Typ), Loc),
Attribute_Name => Name_Descriptor_Size),
Right_Opnd => Size_Bits);
end if;
@ -12181,7 +12181,14 @@ package body Exp_Ch4 is
-- knowledge of hidden pointers, we have to bring the two pointers back
-- in view in order to restore the original state of the object.
if Needs_Finalization (Desig) then
-- The address manipulation is not performed for access types that are
-- subject to pragma No_Heap_Finalization because the two pointers do
-- not exist in the first place.
if No_Heap_Finalization (Ptr_Typ) then
null;
elsif Needs_Finalization (Desig_Typ) then
-- Adjust the address and size of the dereferenced object. Generate:
-- Adjust_Controlled_Dereference (Addr, Size, Alig);
@ -12203,7 +12210,7 @@ package body Exp_Ch4 is
-- <Stmt>;
-- end if;
if Is_Class_Wide_Type (Desig) then
if Is_Class_Wide_Type (Desig_Typ) then
Deref :=
Make_Explicit_Dereference (Loc,
Prefix => Duplicate_Subexpr_Move_Checks (N));
@ -12242,7 +12249,7 @@ package body Exp_Ch4 is
-- Mark the explicit dereference as processed to avoid potential
-- infinite expansion.
Set_Has_Dereference_Action (Pnod);
Set_Has_Dereference_Action (Context);
exception
when RE_Not_Available =>

14
gcc/ada/exp_unst.ads
View File

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2014-2016, Free Software Foundation, Inc. --
-- Copyright (C) 2014-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- --
@ -294,13 +294,13 @@ package Exp_Unst is
-- What we do is to always generate a local constant for any dynamic
-- bound in a dynamic subtype xx with name xx_FIRST or xx_LAST. The one
-- case where we can skip this is where the bound is e.g. in the third
-- example above, subtype dynam is expanded as
-- case where we can skip this is where the bound is already a constant.
-- E.g. in the third example above, subtype dynam is expanded as
-- dynam_LAST : constant Integer := y + 3;
-- dynam_LAST : constant Integer := y + 3;
-- subtype dynam is integer range x .. dynam_LAST;
-- Now if type dynam is uplevel referenced (as it is this case), then
-- Now if type dynam is uplevel referenced (as it is in this case), then
-- the bounds x and dynam_LAST are marked as uplevel references
-- so that appropriate entries are made in the activation record. Any
-- explicit reference to such a bound in the front end generated code
@ -310,7 +310,7 @@ package Exp_Unst is
-- these bounds can be replaced by an appropriate reference to the entry
-- in the activation record for xx_FIRST or xx_LAST. Thus the back end
-- can eliminate the problematical uplevel reference without the need to
-- do the heavy tree modification to do that at the code expansion level
-- do the heavy tree modification to do that at the code expansion level.
-- Looking at case 3 again, here is the normal -gnatG expanded code
@ -347,7 +347,7 @@ package Exp_Unst is
-- we ignore that detail to clarify the examples.
-- Here we see that some of the bounds references are expanded by the
-- front end, so that we get explicit references to y or dynamLast. These
-- front end, so that we get explicit references to y or dynam_Last. These
-- cases are handled by the normal uplevel reference mechanism described
-- above for case 2. This is the case for the constraint check for the
-- initialization of xx, and the range check in function inner.

19
gcc/ada/sem_eval.adb
View File

@ -626,7 +626,8 @@ package body Sem_Eval is
return Non_Static;
-- When the choice denotes a subtype with a static predictate, check the
-- expression against the predicate values.
-- expression against the predicate values. Different procedures apply
-- to discrete and non-discrete types.
elsif (Nkind (Choice) = N_Subtype_Indication
or else (Is_Entity_Name (Choice)
@ -634,10 +635,20 @@ package body Sem_Eval is
and then Has_Predicates (Etype (Choice))
and then Has_Static_Predicate (Etype (Choice))
then
return
Choices_Match (Expr, Static_Discrete_Predicate (Etype (Choice)));
if Is_Discrete_Type (Etype (Choice)) then
return Choices_Match
(Expr, Static_Discrete_Predicate (Etype (Choice)));
-- Discrete type case
elsif
Real_Or_String_Static_Predicate_Matches (Expr, Etype (Choice))
then
return Match;
else
return No_Match;
end if;
-- Discrete type case only
elsif Is_Discrete_Type (Etyp) then
Val := Expr_Value (Expr);