Skip to content

R
riscv-gcc-1
Commit 1e3ed0fc by Robert Dewar Committed by Arnaud Charlet
Options

exp_util.ads, [...]: Minor code reorganization. 

2014-10-10  Robert Dewar  <dewar@adacore.com>

	* exp_util.ads, sem_ch12.adb, exp_util.adb, i-fortra.ads: Minor code
	reorganization.

From-SVN: r216073
parent aa79a1e1
Showing with 94 additions and 106 deletions
gcc/ada/ChangeLog
2014-10-10 Robert Dewar <dewar@adacore.com>
* exp_util.ads, sem_ch12.adb, exp_util.adb, i-fortra.ads: Minor code
reorganization.
2014-09-22 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Adjust comment.
......
gcc/ada/exp_util.adb
......@@ -1742,6 +1742,79 @@ package body Exp_Util is
end if;
end Component_May_Be_Bit_Aligned;
----------------------------------------
-- Containing_Package_With_Ext_Axioms --
----------------------------------------
function Containing_Package_With_Ext_Axioms
(E : Entity_Id) return Entity_Id
is
Decl : Node_Id;
begin
if Ekind (E) = E_Package then
if Nkind (Parent (E)) = N_Defining_Program_Unit_Name then
Decl := Parent (Parent (E));
else
Decl := Parent (E);
end if;
end if;
-- E is the package or generic package which is externally axiomatized
if Ekind_In (E, E_Package, E_Generic_Package)
and then Has_Annotate_Pragma_For_External_Axiomatization (E)
then
return E;
end if;
-- If E's scope is axiomatized, E is axiomatized.
declare
First_Ax_Parent_Scope : Entity_Id := Empty;
begin
if Present (Scope (E)) then
First_Ax_Parent_Scope :=
Containing_Package_With_Ext_Axioms (Scope (E));
end if;
if Present (First_Ax_Parent_Scope) then
return First_Ax_Parent_Scope;
end if;
-- otherwise, if E is a package instance, it is axiomatized if the
-- corresponding generic package is axiomatized.
if Ekind (E) = E_Package
and then Present (Generic_Parent (Decl))
then
return
Containing_Package_With_Ext_Axioms (Generic_Parent (Decl));
else
return Empty;
end if;
end;
end Containing_Package_With_Ext_Axioms;
-------------------------------
-- Convert_To_Actual_Subtype --
-------------------------------
procedure Convert_To_Actual_Subtype (Exp : Entity_Id) is
Act_ST : Entity_Id;
begin
Act_ST := Get_Actual_Subtype (Exp);
if Act_ST = Etype (Exp) then
return;
else
Rewrite (Exp, Convert_To (Act_ST, Relocate_Node (Exp)));
Analyze_And_Resolve (Exp, Act_ST);
end if;
end Convert_To_Actual_Subtype;
-----------------------------------
-- Corresponding_Runtime_Package --
-----------------------------------
......@@ -1793,24 +1866,6 @@ package body Exp_Util is
return Pkg_Id;
end Corresponding_Runtime_Package;
-------------------------------
-- Convert_To_Actual_Subtype --
-------------------------------
procedure Convert_To_Actual_Subtype (Exp : Entity_Id) is
Act_ST : Entity_Id;
begin
Act_ST := Get_Actual_Subtype (Exp);
if Act_ST = Etype (Exp) then
return;
else
Rewrite (Exp, Convert_To (Act_ST, Relocate_Node (Exp)));
Analyze_And_Resolve (Exp, Act_ST);
end if;
end Convert_To_Actual_Subtype;
-----------------------------------
-- Current_Sem_Unit_Declarations --
-----------------------------------
......@@ -3295,62 +3350,6 @@ package body Exp_Util is
end;
end Get_Current_Value_Condition;
-------------------------------------------------
-- Get_First_Parent_With_Ext_Axioms_For_Entity --
-------------------------------------------------
function Get_First_Parent_With_Ext_Axioms_For_Entity
(E : Entity_Id) return Entity_Id
is
Decl : Node_Id;
begin
if Ekind (E) = E_Package then
if Nkind (Parent (E)) = N_Defining_Program_Unit_Name then
Decl := Parent (Parent (E));
else
Decl := Parent (E);
end if;
end if;
-- E is the package or generic package which is externally axiomatized
if Ekind_In (E, E_Package, E_Generic_Package)
and then Has_Annotate_Pragma_For_External_Axiomatization (E)
then
return E;
end if;
-- If E's scope is axiomatized, E is axiomatized.
declare
First_Ax_Parent_Scope : Entity_Id := Empty;
begin
if Present (Scope (E)) then
First_Ax_Parent_Scope :=
Get_First_Parent_With_Ext_Axioms_For_Entity (Scope (E));
end if;
if Present (First_Ax_Parent_Scope) then
return First_Ax_Parent_Scope;
end if;
-- otherwise, if E is a package instance, it is axiomatized if the
-- corresponding generic package is axiomatized.
if Ekind (E) = E_Package
and then Present (Generic_Parent (Decl))
then
return
Get_First_Parent_With_Ext_Axioms_For_Entity
(Generic_Parent (Decl));
else
return Empty;
end if;
end;
end Get_First_Parent_With_Ext_Axioms_For_Entity;
---------------------
-- Get_Stream_Size --
---------------------
......
gcc/ada/exp_util.ads
......@@ -311,6 +311,11 @@ package Exp_Util is
-- it is harmless, so it is easier to do it in all cases, rather than
-- conditionalize it in GNAT 5 or beyond.
function Containing_Package_With_Ext_Axioms
(E : Entity_Id) return Entity_Id;
-- Returns the package entity with an external axiomatization containing E,
-- if any, or Empty if none.
procedure Convert_To_Actual_Subtype (Exp : Node_Id);
-- The Etype of an expression is the nominal type of the expression,
-- not the actual subtype. Often these are the same, but not always.
......@@ -542,11 +547,6 @@ package Exp_Util is
-- N_Op_Eq), or to determine the result of some other test in other cases
-- (e.g. no access check required if N_Op_Ne Null).
function Get_First_Parent_With_Ext_Axioms_For_Entity
(E : Entity_Id) return Entity_Id;
-- Returns the package entity with an external axiomatization containing E,
-- if any, or Empty if none.
function Get_Stream_Size (E : Entity_Id) return Uint;
-- Return the stream size value of the subtype E
......
gcc/ada/i-fortra.ads
......@@ -65,42 +65,26 @@ package Interfaces.Fortran is
type Integer_Star_8 is new Integer_64;
type Integer_Kind_8 is new Integer_64;
type Logical_Star_1 is new Boolean;
type Logical_Star_2 is new Boolean;
type Logical_Star_4 is new Boolean;
type Logical_Star_8 is new Boolean;
type Logical_Kind_1 is new Boolean;
type Logical_Kind_2 is new Boolean;
type Logical_Kind_4 is new Boolean;
type Logical_Kind_8 is new Boolean;
for Logical_Star_1'Size use Integer_8'Size;
for Logical_Star_2'Size use Integer_16'Size;
for Logical_Star_4'Size use Integer_32'Size;
for Logical_Star_8'Size use Integer_64'Size;
for Logical_Kind_1'Size use Integer_8'Size;
for Logical_Kind_2'Size use Integer_16'Size;
for Logical_Kind_4'Size use Integer_32'Size;
for Logical_Kind_8'Size use Integer_64'Size;
pragma Convention (Fortran, Logical_Star_1);
pragma Convention (Fortran, Logical_Star_2);
pragma Convention (Fortran, Logical_Star_4);
pragma Convention (Fortran, Logical_Star_8);
pragma Convention (Fortran, Logical_Kind_1);
pragma Convention (Fortran, Logical_Kind_2);
pragma Convention (Fortran, Logical_Kind_4);
pragma Convention (Fortran, Logical_Kind_8);
type Logical_Star_1 is new Boolean with Convention => Fortran, Size => 8;
type Logical_Star_2 is new Boolean with Convention => Fortran, Size => 16;
type Logical_Star_4 is new Boolean with Convention => Fortran, Size => 32;
type Logical_Star_8 is new Boolean with Convention => Fortran, Size => 64;
type Logical_Kind_1 is new Boolean with Convention => Fortran, Size => 8;
type Logical_Kind_2 is new Boolean with Convention => Fortran, Size => 16;
type Logical_Kind_4 is new Boolean with Convention => Fortran, Size => 32;
type Logical_Kind_8 is new Boolean with Convention => Fortran, Size => 64;
type Real_Star_4 is new Float;
type Real_Kind_4 is new Float;
type Real_Star_8 is new Long_Float;
type Real_Kind_8 is new Long_Float;
-- In the kind syntax, n is the same as the associated real kind
-- In the kind syntax, n is the same as the associated real kind.
-- In the star syntax, n is twice as large (real+imaginary size)
type Complex_Star_8 is new Complex;
type Complex_Kind_4 is new Complex;
type Complex_Star_16 is new Double_Complex;
type Complex_Kind_8 is new Double_Complex;
-- In the star syntax, n is twice as large (real+imaginary size)
type Character_Kind_n is new Fortran_Character;
......
gcc/ada/sem_ch12.adb
......@@ -1672,7 +1672,7 @@ package body Sem_Ch12 is
if GNATprove_Mode
and then
Present
(Get_First_Parent_With_Ext_Axioms_For_Entity
(Containing_Package_With_Ext_Axioms
(Defining_Entity (Analyzed_Formal)))
and then Ekind (Defining_Entity (Analyzed_Formal)) =
E_Function
......
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