diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2017-04-25 14:33:25 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2017-04-25 14:33:25 +0200 |
commit | 3e3bc136d4c43f8741ece96b7ab992ef08b574f0 (patch) | |
tree | 7fc4d793c27b5ee4b189cacf44036d4349abe36b | |
parent | bed3fd4637d24e27b61fbd7f366e98a211080a0b (diff) | |
download | gcc-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/ChangeLog | 26 | ||||
-rw-r--r-- | gcc/ada/sem_dim.adb | 31 | ||||
-rw-r--r-- | gcc/ada/sem_prag.adb | 8 | ||||
-rw-r--r-- | gcc/ada/sem_util.adb | 16 | ||||
-rw-r--r-- | gcc/ada/sem_warn.adb | 49 |
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 |