aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2017-04-25 14:33:25 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2017-04-25 14:33:25 +0200
commit3e3bc136d4c43f8741ece96b7ab992ef08b574f0 (patch)
tree7fc4d793c27b5ee4b189cacf44036d4349abe36b
parentbed3fd4637d24e27b61fbd7f366e98a211080a0b (diff)
downloadgcc-3e3bc136d4c43f8741ece96b7ab992ef08b574f0.zip
gcc-3e3bc136d4c43f8741ece96b7ab992ef08b574f0.tar.gz
gcc-3e3bc136d4c43f8741ece96b7ab992ef08b574f0.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog26
-rw-r--r--gcc/ada/sem_dim.adb31
-rw-r--r--gcc/ada/sem_prag.adb8
-rw-r--r--gcc/ada/sem_util.adb16
-rw-r--r--gcc/ada/sem_warn.adb49
5 files changed, 104 insertions, 26 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a3a79cd..c13e016 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,29 @@
+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
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index d2edeeb..1e95601 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -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;
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index 53f6b42..acaacf8 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -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;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 753098c..1cae279 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -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
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 29bdfd4..6e8032c 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -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