+2014-07-31 Robert Dewar <dewar@adacore.com>
+
+ * checks.ads, checks.adb (Activate_Overflow_Check): Do not set flag for
+ unconstrained fpt ops.
+
+2014-07-31 Pascal Obry <obry@adacore.com>
+
+ * s-fileio.adb (Open): Make sure a shared file gets inserted into
+ the global list atomically. This ensures that the file descriptor
+ won't be freed because another tasks is closing the file.
+
2014-07-31 Vincent Celier <celier@adacore.com>
* projects.texi: Minor spelling error fix.
procedure Activate_Overflow_Check (N : Node_Id) is
begin
- if not Nkind_In (N, N_Op_Rem, N_Op_Mod, N_Op_Plus) then
- Set_Do_Overflow_Check (N, True);
- Possible_Local_Raise (N, Standard_Constraint_Error);
+ -- Nothing to do for unconstrained floating-point types (the test for
+ -- Etype (N) being present seems necessary in some cases, should be
+ -- tracked down, but for now just ignore the check in this case ???)
+
+ if Present (Etype (N))
+ and then Is_Floating_Point_Type (Etype (N))
+ and then not Is_Constrained (Etype (N))
+
+ -- But do the check after all if float overflow checking enforced
+
+ and then not Check_Float_Overflow
+ then
+ return;
+ end if;
+
+ -- Nothing to do for Rem/Mod/Plus (overflow not possible)
+
+ if Nkind_In (N, N_Op_Rem, N_Op_Mod, N_Op_Plus) then
+ return;
end if;
+
+ -- Otherwise set the flag
+
+ Set_Do_Overflow_Check (N, True);
+ Possible_Local_Raise (N, Standard_Constraint_Error);
end Activate_Overflow_Check;
--------------------------
-- Always call this routine rather than calling Set_Do_Overflow_Check to
-- set an explicit value of True, to ensure handling the local raise case.
-- Note that this call has no effect for MOD, REM, and unary "+" for which
- -- overflow is never possible in any case.
+ -- overflow is never possible in any case. In addition, we do not set the
+ -- flag for unconstrained floating-point type operations, since we want to
+ -- allow for the generation of IEEE infinities in such cases.
procedure Activate_Range_Check (N : Node_Id);
pragma Inline (Activate_Range_Check);
-- --
------------------------------------------------------------------------------
-with Ada.Finalization; use Ada.Finalization;
-with Ada.IO_Exceptions; use Ada.IO_Exceptions;
+with Ada.Finalization; use Ada.Finalization;
+with Ada.IO_Exceptions; use Ada.IO_Exceptions;
+with Ada.Unchecked_Deallocation;
with Interfaces.C;
with Interfaces.C_Streams; use Interfaces.C_Streams;
-with System.CRTL;
-
with System.Case_Util; use System.Case_Util;
+with System.CRTL;
with System.OS_Lib;
with System.Soft_Links;
-with Ada.Unchecked_Deallocation;
-
package body System.File_IO is
use System.File_Control_Block;
package SSL renames System.Soft_Links;
- use type Interfaces.C.int;
use type CRTL.size_t;
+ use type Interfaces.C.int;
subtype String_Access is System.OS_Lib.String_Access;
procedure Free (X : in out String_Access) renames System.OS_Lib.Free;
To_Lower (Fullname (1 .. Full_Name_Len));
end if;
+ -- We need to lock all tasks from this point. This is needed as in
+ -- the case of a shared file we want to ensure that the file is
+ -- inserted into the chain with the shared status. We must be sure
+ -- that this file won't be closed (and then the runtime file
+ -- descriptor removed from the chain and released) before we leave
+ -- this routine.
+
+ -- Take a task lock to protect Open_Files
+
+ SSL.Lock_Task.all;
+
-- If Shared=None or Shared=Yes, then check for the existence of
-- another file with exactly the same full name.
P : AFCB_Ptr;
begin
- -- Take a task lock to protect Open_Files
-
- SSL.Lock_Task.all;
-
-- Search list of open files
P := Open_Files;
P := P.Next;
end loop;
-
- SSL.Unlock_Task.all;
-
- exception
- when others =>
- SSL.Unlock_Task.all;
- raise;
end;
end if;
Chain_File (File_Ptr);
Append_Set (File_Ptr);
+
+ -- We can now safely release the global lock, as the File_Ptr is
+ -- inserted into the global file list.
+
+ SSL.Unlock_Task.all;
+
+ exception
+ when others =>
+ SSL.Unlock_Task.all;
+ raise;
end Open;
------------------------
projects / gcc.git / commitdiff