Commit 1e3689bd by Arnaud Charlet

[multiple changes]

2014-08-04  Arnaud Charlet  <charlet@adacore.com>

	* 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  <moy@adacore.com>

	* 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
parent aa499784
2014-08-04 Arnaud Charlet <charlet@adacore.com>
* 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 <moy@adacore.com>
* 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 <schonberg@adacore.com> 2014-08-04 Ed Schonberg <schonberg@adacore.com>
* exp_ch5.adb: minor reformatting. * exp_ch5.adb: minor reformatting.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 ...@@ -144,7 +144,7 @@ package body Ada.Containers.Formal_Hashed_Maps is
procedure Insert_Element (Source_Node : Count_Type) is procedure Insert_Element (Source_Node : Count_Type) is
N : Node_Type renames Source.Nodes (Source_Node); N : Node_Type renames Source.Nodes (Source_Node);
begin begin
Target.Insert (N.Key, N.Element); Insert (Target, N.Key, N.Element);
end Insert_Element; end Insert_Element;
-- Start of processing for Assign -- Start of processing for Assign
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- 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 ...@@ -1534,8 +1534,8 @@ package body Ada.Containers.Formal_Ordered_Sets is
end if; end if;
return S : Set (Length (Left) + Length (Right)) do return S : Set (Length (Left) + Length (Right)) do
S.Assign (Source => Left); Assign (S, Source => Left);
S.Union (Right); Union (S, Right);
end return; end return;
end Union; end Union;
......
...@@ -1382,11 +1382,9 @@ package body Inline is ...@@ -1382,11 +1382,9 @@ package body Inline is
-- Returns True if subprogram Id has any contract (Pre, Post, Global, -- Returns True if subprogram Id has any contract (Pre, Post, Global,
-- Depends, etc.) -- Depends, etc.)
function In_Some_Private_Part (N : Node_Id) return Boolean; function In_Package_Visible_Spec (Id : Node_Id) return Boolean;
-- Returns True if node N is defined in the private part of a package -- Returns True if subprogram Id is defined in the visible part of a
-- package specification.
function In_Unit_Body (N : Node_Id) return Boolean;
-- Returns True if node N is defined in the body of a unit
function Is_Expression_Function (Id : Entity_Id) return Boolean; function Is_Expression_Function (Id : Entity_Id) return Boolean;
-- Returns True if subprogram Id was defined originally as an expression -- Returns True if subprogram Id was defined originally as an expression
...@@ -1405,51 +1403,36 @@ package body Inline is ...@@ -1405,51 +1403,36 @@ package body Inline is
Present (Classifications (Items))); Present (Classifications (Items)));
end Has_Some_Contract; end Has_Some_Contract;
-------------------------- -----------------------------
-- In_Some_Private_Part -- -- In_Package_Visible_Spec --
-------------------------- -----------------------------
function In_Some_Private_Part (N : Node_Id) return Boolean is function In_Package_Visible_Spec (Id : Node_Id) return Boolean is
P : Node_Id; Decl : Node_Id := Parent (Parent (Id));
PP : Node_Id; P : Node_Id;
begin begin
P := N; if Nkind (Parent (Id)) = N_Defining_Program_Unit_Name then
while Present (P) and then Present (Parent (P)) loop Decl := Parent (Decl);
PP := Parent (P); end if;
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;
------------------ P := Parent (Decl);
-- In_Unit_Body --
------------------
function In_Unit_Body (N : Node_Id) return Boolean is return Nkind (P) = N_Package_Specification
CU : constant Node_Id := Enclosing_Comp_Unit_Node (N); and then List_Containing (Decl) = Visible_Declarations (P);
begin end In_Package_Visible_Spec;
return Present (CU)
and then Nkind_In (Unit (CU), N_Package_Body,
N_Subprogram_Body,
N_Subunit);
end In_Unit_Body;
---------------------------- ----------------------------
-- Is_Expression_Function -- -- Is_Expression_Function --
---------------------------- ----------------------------
function Is_Expression_Function (Id : Entity_Id) return Boolean is function Is_Expression_Function (Id : Entity_Id) return Boolean is
Decl : constant Node_Id := Parent (Parent (Id)); Decl : Node_Id := Parent (Parent (Id));
begin begin
if Nkind (Parent (Id)) = N_Defining_Program_Unit_Name then
Decl := Parent (Decl);
end if;
return Nkind (Original_Node (Decl)) = N_Expression_Function; return Nkind (Original_Node (Decl)) = N_Expression_Function;
end Is_Expression_Function; end Is_Expression_Function;
...@@ -1482,13 +1465,9 @@ package body Inline is ...@@ -1482,13 +1465,9 @@ package body Inline is
if Nkind (Parent (Id)) = N_Defining_Program_Unit_Name then if Nkind (Parent (Id)) = N_Defining_Program_Unit_Name then
return False; return False;
-- Do not inline subprograms declared in the visible part of a library -- Do not inline subprograms declared in the visible part of a package
-- package.
elsif Is_Library_Level_Entity (Id) elsif In_Package_Visible_Spec (Id) then
and then not In_Unit_Body (Id)
and then not In_Some_Private_Part (Id)
then
return False; return False;
-- Do not inline subprograms that have a contract on the spec or the -- Do not inline subprograms that have a contract on the spec or the
......
...@@ -683,13 +683,14 @@ package Sem is ...@@ -683,13 +683,14 @@ package Sem is
generic generic
with procedure Action (Item : Node_Id); with procedure Action (Item : Node_Id);
procedure Walk_Library_Items; procedure Walk_Library_Items;
-- Primarily for use by CodePeer. Must be called after semantic analysis -- Primarily for use by CodePeer and GNATprove. Must be called after
-- (and expansion) are complete. Walks each relevant library item, calling -- semantic analysis (and expansion in the case of CodePeer) are complete.
-- Action for each, in an order such that one will not run across forward -- Walks each relevant library item, calling Action for each, in an order
-- references. Each Item passed to Action is the declaration or body of -- such that one will not run across forward references. Each Item passed
-- a library unit, including generics and renamings. The first item is -- to Action is the declaration or body of a library unit, including
-- the N_Package_Declaration node for package Standard. Bodies are not -- generics and renamings. The first item is the N_Package_Declaration node
-- included, except for the main unit itself, which always comes last. -- for package Standard. Bodies are not included, except for the main unit
-- itself, which always comes last.
-- --
-- Item is never a subunit -- Item is never a subunit
-- --
......
...@@ -6446,6 +6446,14 @@ package body Sem_Ch4 is ...@@ -6446,6 +6446,14 @@ package body Sem_Ch4 is
return; return;
end if; 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 -- For an arithmetic operator or comparison operator, if one
-- of the operands is numeric, then we know the other operand -- of the operands is numeric, then we know the other operand
-- is not the same numeric type. If it is a non-numeric type, -- is not the same numeric type. If it is a non-numeric type,
...@@ -6472,11 +6480,16 @@ package body Sem_Ch4 is ...@@ -6472,11 +6480,16 @@ package body Sem_Ch4 is
if Address_Integer_Convert_OK (Etype (R), Etype (L)) then if Address_Integer_Convert_OK (Etype (R), Etype (L)) then
Rewrite (R, Rewrite (R,
Unchecked_Convert_To (Etype (L), Relocate_Node (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 else
Resolve (R, Etype (L)); Resolve (R, Etype (L));
end if; end if;
return; return;
elsif Is_Numeric_Type (Etype (R)) elsif Is_Numeric_Type (Etype (R))
...@@ -6485,7 +6498,13 @@ package body Sem_Ch4 is ...@@ -6485,7 +6498,13 @@ package body Sem_Ch4 is
if Address_Integer_Convert_OK (Etype (L), Etype (R)) then if Address_Integer_Convert_OK (Etype (L), Etype (R)) then
Rewrite (L, Rewrite (L,
Unchecked_Convert_To (Etype (R), Relocate_Node (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; return;
else else
...@@ -6509,7 +6528,12 @@ package body Sem_Ch4 is ...@@ -6509,7 +6528,12 @@ package body Sem_Ch4 is
Rewrite (R, Rewrite (R,
Unchecked_Convert_To ( Unchecked_Convert_To (
Standard_Integer, Relocate_Node (R))); 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 -- If this is an operand in an enclosing arithmetic
-- operation, Convert the result as an address so that -- operation, Convert the result as an address so that
......
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