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
This commit is contained in:
parent
aa79a1e1c8
commit
1e3ed0fc93
|
@ -1,3 +1,8 @@
|
|||
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.
|
||||
|
|
|
@ -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 --
|
||||
---------------------
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue