+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>
* exp_ch5.adb: minor reformatting.
-- --
-- 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- --
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
-- --
-- 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- --
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;
-- 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
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;
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
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
--
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,
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))
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
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
projects / gcc.git / commitdiff