+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.
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 --
-----------------------------------
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 --
-----------------------------------
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 --
---------------------
-- 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.
-- 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
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;
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
projects / gcc.git / commitdiff