From 1e3689bd20d682d6f10373abccea6445d901c499 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 4 Aug 2014 12:10:23 +0200 Subject: [PATCH] [multiple changes] 2014-08-04 Arnaud Charlet * sem_scil.ads: Improve comments. * sem_ch4.adb (Analyze_Equality_Op): Add support for Allow_Integer_Address (equality between Address and Integer). 2014-08-04 Yannick Moy * a-cfhama.adb, a-cforse.adb: Minor fixes to avoid using prefix notation on untagged objects. * sem.ads: Update comment. * inline.adb (Can_Be_Inlined_In_GNATprove_Mode): Do not inline subprograms declared in the visible part of a package. From-SVN: r213560 --- gcc/ada/ChangeLog | 14 +++++++++ gcc/ada/a-cfhama.adb | 4 +-- gcc/ada/a-cforse.adb | 6 ++-- gcc/ada/inline.adb | 67 +++++++++++++++----------------------------- gcc/ada/sem.ads | 15 +++++----- gcc/ada/sem_ch4.adb | 30 ++++++++++++++++++-- 6 files changed, 77 insertions(+), 59 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d18302471d3..441e2a0fb5c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2014-08-04 Arnaud Charlet + + * sem_scil.ads: Improve comments. + * sem_ch4.adb (Analyze_Equality_Op): Add support for + Allow_Integer_Address (equality between Address and Integer). + +2014-08-04 Yannick Moy + + * a-cfhama.adb, a-cforse.adb: Minor fixes to avoid using prefix + notation on untagged objects. + * sem.ads: Update comment. + * inline.adb (Can_Be_Inlined_In_GNATprove_Mode): Do + not inline subprograms declared in the visible part of a package. + 2014-08-04 Ed Schonberg * exp_ch5.adb: minor reformatting. diff --git a/gcc/ada/a-cfhama.adb b/gcc/ada/a-cfhama.adb index ea506d8ddc4..858216f62ea 100644 --- a/gcc/ada/a-cfhama.adb +++ b/gcc/ada/a-cfhama.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2010-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2010-2014, 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- -- @@ -144,7 +144,7 @@ package body Ada.Containers.Formal_Hashed_Maps is procedure Insert_Element (Source_Node : Count_Type) is N : Node_Type renames Source.Nodes (Source_Node); begin - Target.Insert (N.Key, N.Element); + Insert (Target, N.Key, N.Element); end Insert_Element; -- Start of processing for Assign diff --git a/gcc/ada/a-cforse.adb b/gcc/ada/a-cforse.adb index bc8ffbaac88..d1e6b8cd206 100644 --- a/gcc/ada/a-cforse.adb +++ b/gcc/ada/a-cforse.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2010-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2010-2014, 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- -- @@ -1534,8 +1534,8 @@ package body Ada.Containers.Formal_Ordered_Sets is end if; return S : Set (Length (Left) + Length (Right)) do - S.Assign (Source => Left); - S.Union (Right); + Assign (S, Source => Left); + Union (S, Right); end return; end Union; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 380fa25939f..7a3b2a706b6 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -1382,11 +1382,9 @@ package body Inline is -- Returns True if subprogram Id has any contract (Pre, Post, Global, -- Depends, etc.) - function In_Some_Private_Part (N : Node_Id) return Boolean; - -- Returns True if node N is defined in the private part of a package - - function In_Unit_Body (N : Node_Id) return Boolean; - -- Returns True if node N is defined in the body of a unit + function In_Package_Visible_Spec (Id : Node_Id) return Boolean; + -- Returns True if subprogram Id is defined in the visible part of a + -- package specification. function Is_Expression_Function (Id : Entity_Id) return Boolean; -- Returns True if subprogram Id was defined originally as an expression @@ -1405,51 +1403,36 @@ package body Inline is Present (Classifications (Items))); end Has_Some_Contract; - -------------------------- - -- In_Some_Private_Part -- - -------------------------- + ----------------------------- + -- In_Package_Visible_Spec -- + ----------------------------- - function In_Some_Private_Part (N : Node_Id) return Boolean is - P : Node_Id; - PP : Node_Id; + function In_Package_Visible_Spec (Id : Node_Id) return Boolean is + Decl : Node_Id := Parent (Parent (Id)); + P : Node_Id; begin - P := N; - while Present (P) and then Present (Parent (P)) loop - PP := Parent (P); - - if Nkind (PP) = N_Package_Specification - and then List_Containing (P) = Private_Declarations (PP) - then - return True; - end if; - - P := PP; - end loop; - - return False; - end In_Some_Private_Part; + if Nkind (Parent (Id)) = N_Defining_Program_Unit_Name then + Decl := Parent (Decl); + end if; - ------------------ - -- In_Unit_Body -- - ------------------ + P := Parent (Decl); - function In_Unit_Body (N : Node_Id) return Boolean is - CU : constant Node_Id := Enclosing_Comp_Unit_Node (N); - begin - return Present (CU) - and then Nkind_In (Unit (CU), N_Package_Body, - N_Subprogram_Body, - N_Subunit); - end In_Unit_Body; + return Nkind (P) = N_Package_Specification + and then List_Containing (Decl) = Visible_Declarations (P); + end In_Package_Visible_Spec; ---------------------------- -- Is_Expression_Function -- ---------------------------- function Is_Expression_Function (Id : Entity_Id) return Boolean is - Decl : constant Node_Id := Parent (Parent (Id)); + Decl : Node_Id := Parent (Parent (Id)); begin + if Nkind (Parent (Id)) = N_Defining_Program_Unit_Name then + Decl := Parent (Decl); + end if; + return Nkind (Original_Node (Decl)) = N_Expression_Function; end Is_Expression_Function; @@ -1482,13 +1465,9 @@ package body Inline is if Nkind (Parent (Id)) = N_Defining_Program_Unit_Name then return False; - -- Do not inline subprograms declared in the visible part of a library - -- package. + -- Do not inline subprograms declared in the visible part of a package - elsif Is_Library_Level_Entity (Id) - and then not In_Unit_Body (Id) - and then not In_Some_Private_Part (Id) - then + elsif In_Package_Visible_Spec (Id) then return False; -- Do not inline subprograms that have a contract on the spec or the diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index 26c760d2883..e82905ea974 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -683,13 +683,14 @@ package Sem is generic with procedure Action (Item : Node_Id); procedure Walk_Library_Items; - -- Primarily for use by CodePeer. Must be called after semantic analysis - -- (and expansion) are complete. Walks each relevant library item, calling - -- Action for each, in an order such that one will not run across forward - -- references. Each Item passed to Action is the declaration or body of - -- a library unit, including generics and renamings. The first item is - -- the N_Package_Declaration node for package Standard. Bodies are not - -- included, except for the main unit itself, which always comes last. + -- Primarily for use by CodePeer and GNATprove. Must be called after + -- semantic analysis (and expansion in the case of CodePeer) are complete. + -- Walks each relevant library item, calling Action for each, in an order + -- such that one will not run across forward references. Each Item passed + -- to Action is the declaration or body of a library unit, including + -- generics and renamings. The first item is the N_Package_Declaration node + -- for package Standard. Bodies are not included, except for the main unit + -- itself, which always comes last. -- -- Item is never a subunit -- diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 2e1722e1039..c675f056ccf 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6446,6 +6446,14 @@ package body Sem_Ch4 is return; end if; + elsif Nkind_In (N, N_Op_Eq, N_Op_Ne) then + if Address_Integer_Convert_OK (Etype (R), Etype (L)) then + Rewrite (R, + Unchecked_Convert_To (Etype (L), Relocate_Node (R))); + Analyze_Equality_Op (N); + return; + end if; + -- For an arithmetic operator or comparison operator, if one -- of the operands is numeric, then we know the other operand -- is not the same numeric type. If it is a non-numeric type, @@ -6472,11 +6480,16 @@ package body Sem_Ch4 is if Address_Integer_Convert_OK (Etype (R), Etype (L)) then Rewrite (R, Unchecked_Convert_To (Etype (L), Relocate_Node (R))); - Analyze_Arithmetic_Op (N); + if Nkind_In (N, N_Op_Ge, N_Op_Gt, N_Op_Le, N_Op_Lt) then + Analyze_Comparison_Op (N); + else + Analyze_Arithmetic_Op (N); + end if; else Resolve (R, Etype (L)); end if; + return; elsif Is_Numeric_Type (Etype (R)) @@ -6485,7 +6498,13 @@ package body Sem_Ch4 is if Address_Integer_Convert_OK (Etype (L), Etype (R)) then Rewrite (L, Unchecked_Convert_To (Etype (R), Relocate_Node (L))); - Analyze_Arithmetic_Op (N); + + if Nkind_In (N, N_Op_Ge, N_Op_Gt, N_Op_Le, N_Op_Lt) then + Analyze_Comparison_Op (N); + else + Analyze_Arithmetic_Op (N); + end if; + return; else @@ -6509,7 +6528,12 @@ package body Sem_Ch4 is Rewrite (R, Unchecked_Convert_To ( Standard_Integer, Relocate_Node (R))); - Analyze_Arithmetic_Op (N); + + if Nkind_In (N, N_Op_Ge, N_Op_Gt, N_Op_Le, N_Op_Lt) then + Analyze_Comparison_Op (N); + else + Analyze_Arithmetic_Op (N); + end if; -- If this is an operand in an enclosing arithmetic -- operation, Convert the result as an address so that -- 2.30.2