From 1e3ed0fc933a9c77ddc14f7097dd601d824c2b35 Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Fri, 10 Oct 2014 12:18:17 +0000 Subject: [PATCH] exp_util.ads, [...]: Minor code reorganization. 2014-10-10 Robert Dewar * exp_util.ads, sem_ch12.adb, exp_util.adb, i-fortra.ads: Minor code reorganization. From-SVN: r216073 --- gcc/ada/ChangeLog | 5 ++ gcc/ada/exp_util.adb | 147 +++++++++++++++++++++---------------------- gcc/ada/exp_util.ads | 10 +-- gcc/ada/i-fortra.ads | 36 +++-------- gcc/ada/sem_ch12.adb | 2 +- 5 files changed, 94 insertions(+), 106 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 447068ea242..5d50356a7f4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2014-10-10 Robert Dewar + + * exp_util.ads, sem_ch12.adb, exp_util.adb, i-fortra.ads: Minor code + reorganization. + 2014-09-22 Eric Botcazou * gcc-interface/decl.c (gnat_to_gnu_entity): Adjust comment. diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index d5d269c28ca..d7f200f3b07 100644 --- a/gcc/ada/exp_util.adb +++ b/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 -- --------------------- diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index cdc2a24adbd..871a5ba5744 100644 --- a/gcc/ada/exp_util.ads +++ b/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 diff --git a/gcc/ada/i-fortra.ads b/gcc/ada/i-fortra.ads index 0946e49a7e3..5ac91133e62 100644 --- a/gcc/ada/i-fortra.ads +++ b/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; diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index dd8badb1065..ed96e8929f4 100644 --- a/gcc/ada/sem_ch12.adb +++ b/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 -- 2.30.2