+2012-05-15 Yannick Moy <moy@adacore.com>
+
+ * aspects.ads: Minor addition of comments to provide info on
+ how to add new aspects.
+
+2012-05-15 Thomas Quinot <quinot@adacore.com>
+
+ * osint.ads: Minor reformatting.
+
+2012-05-15 Thomas Quinot <quinot@adacore.com>
+
+ * exp_ch5.adb, exp_pakd.adb, sem_util.adb, sem_util.ads
+ (Expand_Assign_Array): Handle the case of a packed bit array within a
+ record with reverse storage order (assign element by element in that
+ case).
+ (In_Reverse_Storage_Order_Record): New subprogram,
+ code extracted from Exp_Pakd.
+
+2012-05-15 Yannick Moy <moy@adacore.com>
+
+ * a-ngelfu.ads: Add postconditions using Ada 2012
+ aspect syntax, reflecting some of the RM requirements for these
+ functions, from Annex A.5.1 or G.2.4.
+
+2012-05-15 Thomas Quinot <quinot@adacore.com>
+
+ * adaint.c: Minor fix: move misplaced comment.
+
+2012-05-15 Doug Rupp <rupp@adacore.com>
+
+ * vms_data.ads: Enhance help for /IMMEDIATE_ERRORS to discourage
+ use by customers.
+
2012-05-15 Tristan Gingold <gingold@adacore.com>
* a-exextr.adb: Add comment.
-- --
-- S p e c --
-- --
+-- Copyright (C) 2012, Free Software Foundation, Inc. --
+-- --
-- This specification is derived from the Ada Reference Manual for use with --
--- GNAT. In accordance with the copyright of that document, you can freely --
--- copy and modify this specification, provided that if you redistribute a --
--- modified version, any changes that you have made are clearly indicated. --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the Post aspects that have been added to the spec. --
+-- Except for these parts of the document, in accordance with the copyright --
+-- of that document, you can freely copy and modify this specification, --
+-- provided that if you redistribute a modified version, any changes that --
+-- you have made are clearly indicated. --
+-- --
+-- 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
+-- --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
+-- --
+-- GNAT was originally developed by the GNAT team at New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
package Ada.Numerics.Generic_Elementary_Functions is
pragma Pure;
- function Sqrt (X : Float_Type'Base) return Float_Type'Base;
- function Log (X : Float_Type'Base) return Float_Type'Base;
- function Log (X, Base : Float_Type'Base) return Float_Type'Base;
- function Exp (X : Float_Type'Base) return Float_Type'Base;
- function "**" (Left, Right : Float_Type'Base) return Float_Type'Base;
-
- function Sin (X : Float_Type'Base) return Float_Type'Base;
- function Sin (X, Cycle : Float_Type'Base) return Float_Type'Base;
- function Cos (X : Float_Type'Base) return Float_Type'Base;
- function Cos (X, Cycle : Float_Type'Base) return Float_Type'Base;
- function Tan (X : Float_Type'Base) return Float_Type'Base;
- function Tan (X, Cycle : Float_Type'Base) return Float_Type'Base;
- function Cot (X : Float_Type'Base) return Float_Type'Base;
- function Cot (X, Cycle : Float_Type'Base) return Float_Type'Base;
-
- function Arcsin (X : Float_Type'Base) return Float_Type'Base;
- function Arcsin (X, Cycle : Float_Type'Base) return Float_Type'Base;
- function Arccos (X : Float_Type'Base) return Float_Type'Base;
- function Arccos (X, Cycle : Float_Type'Base) return Float_Type'Base;
+ function Sqrt (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => Sqrt'Result >= 0.0
+ and then (if X = 0.0 then Sqrt'Result = 0.0)
+ and then (if X = 1.0 then Sqrt'Result = 1.0);
+
+ function Log (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => (if X = 1.0 then Log'Result = 0.0);
+
+ function Log (X, Base : Float_Type'Base) return Float_Type'Base
+ with
+ Post => (if X = 1.0 then Log'Result = 0.0);
+
+ function Exp (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => (if X = 0.0 then Exp'Result = 1.0);
+
+ function "**" (Left, Right : Float_Type'Base) return Float_Type'Base
+ with
+ Post => "**"'Result >= 0.0
+ and then (if Right = 0.0 then "**"'Result = 1.0)
+ and then (if Right = 1.0 then "**"'Result = Left)
+ and then (if Left = 1.0 then "**"'Result = 1.0)
+ and then (if Left = 0.0 then "**"'Result = 0.0);
+
+ function Sin (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => Sin'Result in -1.0 .. 1.0
+ and then (if X = 0.0 then Sin'Result = 0.0);
+
+ function Sin (X, Cycle : Float_Type'Base) return Float_Type'Base
+ with
+ Post => Sin'Result in -1.0 .. 1.0
+ and then (if X = 0.0 then Sin'Result = 0.0);
+
+ function Cos (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => Cos'Result in -1.0 .. 1.0
+ and then (if X = 0.0 then Cos'Result = 1.0);
+
+ function Cos (X, Cycle : Float_Type'Base) return Float_Type'Base
+ with
+ Post => Cos'Result in -1.0 .. 1.0
+ and then (if X = 0.0 then Cos'Result = 1.0);
+
+ function Tan (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => (if X = 0.0 then Tan'Result = 0.0);
+
+ function Tan (X, Cycle : Float_Type'Base) return Float_Type'Base
+ with
+ Post => (if X = 0.0 then Tan'Result = 0.0);
+
+ function Cot (X : Float_Type'Base) return Float_Type'Base;
+
+ function Cot (X, Cycle : Float_Type'Base) return Float_Type'Base;
+
+ function Arcsin (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => (if X = 0.0 then Arcsin'Result = 0.0);
+
+ function Arcsin (X, Cycle : Float_Type'Base) return Float_Type'Base
+ with
+ Post => (if X = 0.0 then Arcsin'Result = 0.0);
+
+ function Arccos (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => (if X = 1.0 then Arccos'Result = 0.0);
+
+ function Arccos (X, Cycle : Float_Type'Base) return Float_Type'Base
+ with
+ Post => (if X = 1.0 then Arccos'Result = 0.0);
function Arctan
(Y : Float_Type'Base;
X : Float_Type'Base := 1.0)
- return Float_Type'Base;
+ return Float_Type'Base
+ with
+ Post => (if X > 0.0 and Y = 0.0 then Arctan'Result = 0.0);
function Arctan
(Y : Float_Type'Base;
X : Float_Type'Base := 1.0;
Cycle : Float_Type'Base)
- return Float_Type'Base;
+ return Float_Type'Base
+ with
+ Post => (if X > 0.0 and Y = 0.0 then Arctan'Result = 0.0);
function Arccot
(X : Float_Type'Base;
Y : Float_Type'Base := 1.0)
- return Float_Type'Base;
+ return Float_Type'Base
+ with
+ Post => (if X > 0.0 and Y = 0.0 then Arccot'Result = 0.0);
function Arccot
(X : Float_Type'Base;
Y : Float_Type'Base := 1.0;
Cycle : Float_Type'Base)
- return Float_Type'Base;
-
- function Sinh (X : Float_Type'Base) return Float_Type'Base;
- function Cosh (X : Float_Type'Base) return Float_Type'Base;
- function Tanh (X : Float_Type'Base) return Float_Type'Base;
- function Coth (X : Float_Type'Base) return Float_Type'Base;
- function Arcsinh (X : Float_Type'Base) return Float_Type'Base;
- function Arccosh (X : Float_Type'Base) return Float_Type'Base;
- function Arctanh (X : Float_Type'Base) return Float_Type'Base;
+ return Float_Type'Base
+ with
+ Post => (if X > 0.0 and Y = 0.0 then Arccot'Result = 0.0);
+
+ function Sinh (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => (if X = 0.0 then Sinh'Result = 0.0);
+
+ function Cosh (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => Cosh'Result >= 1.0
+ and then (if X = 0.0 then Cosh'Result = 1.0);
+
+ function Tanh (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => Tanh'Result in -1.0 .. 1.0
+ and then (if X = 0.0 then Tanh'Result = 0.0);
+
+ function Coth (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => abs Coth'Result >= 1.0;
+
+ function Arcsinh (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => (if X = 0.0 then Arcsinh'Result = 0.0);
+
+ function Arccosh (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => Arccosh'Result >= 0.0
+ and then (if X = 1.0 then Arccosh'Result = 0.0);
+
+ function Arctanh (X : Float_Type'Base) return Float_Type'Base
+ with
+ Post => (if X = 0.0 then Arctanh'Result = 0.0);
+
function Arccoth (X : Float_Type'Base) return Float_Type'Base;
end Ada.Numerics.Generic_Elementary_Functions;
/* Used for Ada bindings */
int __gnat_size_of_file_attributes = sizeof (struct file_attributes);
-/* Reset the file attributes as if no system call had been performed */
void __gnat_stat_to_attr (int fd, char* name, struct file_attributes* attr);
/* The __gnat_max_path_len variable is used to export the maximum
static const char ATTR_UNSET = 127;
+/* Reset the file attributes as if no system call had been performed */
+
void
__gnat_reset_attributes
(struct file_attributes* attr)
-- aspect specifications from the tree. The semantic processing for aspect
-- specifications is found in Sem_Ch13.Analyze_Aspect_Specifications.
+-- In general, each aspect should have a corresponding pragma, so that the
+-- newly developed functionality is available for Ada versions < Ada 2012.
+-- When both are defined, it is convenient to first transform the aspect into
+-- an equivalent pragma in Sem_Ch13.Analyze_Aspect_Specifications, and then
+-- analyze the pragma in Sem_Prag.Analyze_Pragma.
+
+-- To add a new aspect:
+-- * create a name in snames.ads-tmpl
+-- * create a value in type Aspect_Id in this unit
+-- * add a value for the aspect in the global arrays defined in this unit
+-- * add code for analyzing the aspect in
+-- Sem_Ch13.Analyze_Aspect_Specifications. This may involve adding some
+-- nodes to the tree to perform additional treatments later.
+-- * if the semantic analysis of expressions/names in the aspect should not
+-- occur at the point the aspect is defined, add code in the adequate
+-- semantic analysis procedure for the aspect. For example, this is the case
+-- for aspects Pre and Post on subprograms, which are pre-analyzed at the
+-- end of the list of declarations to which the subprogram belongs, and
+-- fully analyzed (possibly with expansion) during the semantic analysis of
+-- subprogram bodies.
+
+-- Additionally, to add a corresponding pragma for a new aspect:
+-- * create a name for the pragma in snames.ads-tmpl
+-- * add code for analyzing the pragma in Sem_Prag.Analyze_Pragma
+
with Namet; use Namet;
with Snames; use Snames;
with Types; use Types;
elsif Has_Controlled_Component (L_Type) then
Loop_Required := True;
- -- If object is atomic, we cannot tolerate a loop
+ -- If changing scalar storage order and assigning a bit packed arrau,
+ -- force loop expansion.
+
+ elsif Is_Bit_Packed_Array (L_Type)
+ and then
+ (In_Reverse_Storage_Order_Record (Rhs)
+ /=
+ In_Reverse_Storage_Order_Record (Lhs))
+ then
+ Loop_Required := True;
+
+ -- If object is atomic, we cannot tolerate a loop
elsif Is_Atomic_Object (Act_Lhs)
or else
Loc : constant Source_Ptr := Sloc (N);
PAT : Entity_Id;
Otyp : Entity_Id;
- Pref : Node_Id;
Csiz : Uint;
Osiz : Uint;
- In_Reverse_Storage_Order_Record : Boolean;
- -- Set True if Obj is a [sub]component of a record that has reversed
- -- scalar storage order.
-
begin
Csiz := Component_Size (Atyp);
-- We also have to adjust if the storage order is reversed
- Pref := Obj;
- loop
- case Nkind (Pref) is
- when N_Selected_Component =>
- Pref := Prefix (Pref);
- exit;
-
- when N_Indexed_Component =>
- Pref := Prefix (Pref);
-
- when others =>
- Pref := Empty;
- exit;
- end case;
- end loop;
-
- In_Reverse_Storage_Order_Record :=
- Present (Pref)
- and then Is_Record_Type (Etype (Pref))
- and then Reverse_Storage_Order (Etype (Pref));
-
- if Bytes_Big_Endian xor In_Reverse_Storage_Order_Record then
+ if Bytes_Big_Endian xor In_Reverse_Storage_Order_Record (Obj) then
Shift :=
Make_Op_Subtract (Loc,
Left_Opnd => Make_Integer_Literal (Loc, Osiz - Csiz),
-- the need for either mapping the struct exactly or importing the sizeof
-- from C, which would result in dynamic code). However, it does waste
-- space (e.g. when a component of this type appears in a record, if it is
- -- unnecessarily large.
+ -- unnecessarily large).
type File_Attributes is
array (1 .. File_Attributes_Size)
-- Enclosing_Lib_Unit_Entity --
-------------------------------
- function Enclosing_Lib_Unit_Entity return Entity_Id is
- Unit_Entity : Entity_Id;
+ function Enclosing_Lib_Unit_Entity
+ (E : Entity_Id := Current_Scope) return Entity_Id
+ is
+ Unit_Entity : Entity_Id := E;
begin
-- Look for enclosing library unit entity by following scope links.
-- Equivalent to, but faster than indexing through the scope stack.
- Unit_Entity := Current_Scope;
while (Present (Scope (Unit_Entity))
and then Scope (Unit_Entity) /= Standard_Standard)
and not Is_Child_Unit (Unit_Entity)
return False;
end In_Parameter_Specification;
+ -------------------------------------
+ -- In_Reverse_Storage_Order_Record --
+ -------------------------------------
+
+ function In_Reverse_Storage_Order_Record (N : Node_Id) return Boolean is
+ Pref : Node_Id;
+ begin
+ Pref := N;
+
+ -- Climb up indexed components
+
+ loop
+ case Nkind (Pref) is
+ when N_Selected_Component =>
+ Pref := Prefix (Pref);
+ exit;
+
+ when N_Indexed_Component =>
+ Pref := Prefix (Pref);
+
+ when others =>
+ Pref := Empty;
+ exit;
+ end case;
+ end loop;
+
+ return Present (Pref)
+ and then Is_Record_Type (Etype (Pref))
+ and then Reverse_Storage_Order (Etype (Pref));
+ end In_Reverse_Storage_Order_Record;
+
--------------------------------------
-- In_Subprogram_Or_Concurrent_Unit --
--------------------------------------
-- Returns the Node_Id associated with the innermost enclosing generic
-- unit, if any. If none, then returns Empty.
- function Enclosing_Lib_Unit_Entity return Entity_Id;
- -- Returns the entity of enclosing N_Compilation_Unit Node which is the
+ function Enclosing_Lib_Unit_Entity
+ (E : Entity_Id := Current_Scope) return Entity_Id;
+ -- Returns the entity of enclosing library unit node which is the
-- root of the current scope (which must not be Standard_Standard, and the
- -- caller is responsible for ensuring this condition).
+ -- caller is responsible for ensuring this condition) or other specified
+ -- entity.
function Enclosing_Package (E : Entity_Id) return Entity_Id;
-- Utility function to return the Ada entity of the package enclosing
function In_Parameter_Specification (N : Node_Id) return Boolean;
-- Returns True if node N belongs to a parameter specification
+ function In_Reverse_Storage_Order_Record (N : Node_Id) return Boolean;
+ -- Returns True if N denotes a component or subcomponent in a record object
+ -- that has Reverse_Storage_Order.
+
function In_Subprogram_Or_Concurrent_Unit return Boolean;
-- Determines if the current scope is within a subprogram compilation unit
-- (inside a subprogram declaration, subprogram body, or generic
-- Causes errors to be displayed as soon as they are encountered, rather
-- than after compilation is terminated. If GNAT terminates prematurely
-- or goes into an infinite loop, the last error message displayed may
- -- help to pinpoint the culprit.
+ -- help to pinpoint the culprit. Use with caution: This qualifier is
+ -- intended for use in debugging the compiler proper, and may cause
+ -- output of warnings suppressed by pragma.
S_GCC_Inline : aliased constant S := "/INLINE=" &
"PRAGMA " &
projects / platform / upstream / linaro-gcc.git / commitdiff