Commit 3e3bc136 by Arnaud Charlet

[multiple changes]

2017-04-25  Claire Dross  <dross@adacore.com>

	* sem_prag.adb (Collect_Inherited_Class_Wide_Conditions): Go to
	ultimate alias when accessing overridden operation. Indeed, if the
	overridden operation is itself inherited, it won't have any explicit
	contract.

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

	* sem_warn.adb (Warn_On_Overlapping_Actuals): There can be no
	overlap if the two formals have different types, because formally
	the corresponding actuals cannot designate the same objects.

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

	* sem_dim.adb (Dimensions_Of_Operand): minot cleanups: a) If
	dimensions are present from context, use them.	b) If operand is
	a static constant rewritten as a literal, obtain the dimensions
	from the original declaration, otherwise use dimensions of type
	established from context.

2017-04-25  Yannick Moy  <moy@adacore.com>

	* sem_util.adb (Is_Effectively_Volatile): Protect against base type
	of array that is private.

From-SVN: r247209
parent bed3fd46
2017-04-25 Claire Dross <dross@adacore.com>
* sem_prag.adb (Collect_Inherited_Class_Wide_Conditions): Go to
ultimate alias when accessing overridden operation. Indeed, if the
overridden operation is itself inherited, it won't have any explicit
contract.
2017-04-25 Ed Schonberg <schonberg@adacore.com>
* sem_warn.adb (Warn_On_Overlapping_Actuals): There can be no
overlap if the two formals have different types, because formally
the corresponding actuals cannot designate the same objects.
2017-04-25 Ed Schonberg <schonberg@adacore.com>
* sem_dim.adb (Dimensions_Of_Operand): minot cleanups: a) If
dimensions are present from context, use them. b) If operand is
a static constant rewritten as a literal, obtain the dimensions
from the original declaration, otherwise use dimensions of type
established from context.
2017-04-25 Yannick Moy <moy@adacore.com>
* sem_util.adb (Is_Effectively_Volatile): Protect against base type
of array that is private.
2017-04-25 Gary Dismukes <dismukes@adacore.com>
* sem_ch3.adb, exp_util.adb, sem_prag.adb, exp_ch4.adb: Minor
......
......@@ -1343,7 +1343,11 @@ package body Sem_Dim is
function Dimensions_Of_Operand (N : Node_Id) return Dimension_Type;
-- If the operand is a numeric literal that comes from a declared
-- constant, use the dimensions of the constant which were computed
-- from the expression of the constant declaration.
-- from the expression of the constant declaration. Otherwise the
-- dimensions are those of the operand, or the type of the operand.
-- This takes care of node rewritings from validity checks, where the
-- dimensions of the operand itself may not be preserved, while the
-- type comes from context and must have dimension information.
procedure Error_Dim_Msg_For_Binary_Op (N, L, R : Node_Id);
-- Error using Error_Msg_NE and Error_Msg_N at node N. Output the
......@@ -1354,13 +1358,28 @@ package body Sem_Dim is
---------------------------
function Dimensions_Of_Operand (N : Node_Id) return Dimension_Type is
Dims : constant Dimension_Type := Dimensions_Of (N);
begin
if Nkind (N) = N_Real_Literal
and then Present (Original_Entity (N))
then
return Dimensions_Of (Original_Entity (N));
if Exists (Dims) then
return Dims;
elsif Is_Entity_Name (N) then
return Dimensions_Of (Etype (Entity (N)));
elsif Nkind (N) = N_Real_Literal then
if Present (Original_Entity (N)) then
return Dimensions_Of (Original_Entity (N));
else
return Dimensions_Of (Etype (N));
end if;
-- Otherwise return the default dimensions
else
return Dimensions_Of (N);
return Dims;
end if;
end Dimensions_Of_Operand;
......
......@@ -27915,8 +27915,12 @@ package body Sem_Prag is
---------------------------------------------
procedure Collect_Inherited_Class_Wide_Conditions (Subp : Entity_Id) is
Parent_Subp : constant Entity_Id := Overridden_Operation (Subp);
Prags : constant Node_Id := Contract (Parent_Subp);
Parent_Subp : constant Entity_Id :=
Ultimate_Alias (Overridden_Operation (Subp));
-- The Overridden_Operation may itself be inherited and as such have no
-- explicit contract.
Prags : constant Node_Id := Contract (Parent_Subp);
In_Spec_Expr : Boolean;
Installed : Boolean;
Prag : Node_Id;
......@@ -12805,10 +12805,18 @@ package body Sem_Util is
-- effectively volatile.
elsif Is_Array_Type (Id) then
return
Has_Volatile_Components (Id)
or else
Is_Effectively_Volatile (Component_Type (Base_Type (Id)));
declare
Anc : Entity_Id := Base_Type (Id);
begin
if Ekind (Anc) in Private_Kind then
Anc := Full_View (Anc);
end if;
return
Has_Volatile_Components (Id)
or else
Is_Effectively_Volatile (Component_Type (Anc));
end;
-- A protected type is always volatile
......
......@@ -3487,13 +3487,12 @@ package body Sem_Warn is
---------------------------------
procedure Warn_On_Overlapping_Actuals (Subp : Entity_Id; N : Node_Id) is
Act1, Act2 : Node_Id;
Form1, Form2 : Entity_Id;
function Is_Covered_Formal (Formal : Node_Id) return Boolean;
-- Return True if Formal is covered by the rule
function Refer_Same_Object (Act1, Act2 : Node_Id) return Boolean;
function Refer_Same_Object
(Act1 : Node_Id;
Act2 : Node_Id) return Boolean;
-- Two names are known to refer to the same object if the two names
-- are known to denote the same object; or one of the names is a
-- selected_component, indexed_component, or slice and its prefix is
......@@ -3503,16 +3502,6 @@ package body Sem_Warn is
-- (RM 6.4.1(6.11/3))
-----------------------
-- Refer_Same_Object --
-----------------------
function Refer_Same_Object (Act1, Act2 : Node_Id) return Boolean is
begin
return Denotes_Same_Object (Act1, Act2)
or else Denotes_Same_Prefix (Act1, Act2);
end Refer_Same_Object;
-----------------------
-- Is_Covered_Formal --
-----------------------
......@@ -3525,7 +3514,31 @@ package body Sem_Warn is
or else Is_Array_Type (Etype (Formal)));
end Is_Covered_Formal;
-----------------------
-- Refer_Same_Object --
-----------------------
function Refer_Same_Object
(Act1 : Node_Id;
Act2 : Node_Id) return Boolean
is
begin
return
Denotes_Same_Object (Act1, Act2)
or else Denotes_Same_Prefix (Act1, Act2);
end Refer_Same_Object;
-- Local variables
Act1 : Node_Id;
Act2 : Node_Id;
Form1 : Entity_Id;
Form2 : Entity_Id;
-- Start of processing for Warn_On_Overlapping_Actuals
begin
if Ada_Version < Ada_2012 and then not Warn_On_Overlap then
return;
end if;
......@@ -3593,6 +3606,14 @@ package body Sem_Warn is
then
null;
-- If the types of the formals are different there can
-- be no aliasing (even though there might be overlap
-- through address clauses, which must be intentional).
elsif Base_Type (Etype (Form1)) /= Base_Type (Etype (Form2))
then
null;
-- Here we may need to issue overlap message
else
......
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