diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 27 | ||||
| -rw-r--r-- | gcc/ada/checks.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/s-fileio.adb | 44 |
4 files changed, 64 insertions, 22 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0da286d..5f40546 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +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. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index f75f1c6..facf85b 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -389,10 +389,31 @@ package body Checks is 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; -------------------------- diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index d231e3d..9362550 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -146,7 +146,9 @@ package Checks is -- 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); diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index 72f7db8..d4d9a67 100644 --- a/gcc/ada/s-fileio.adb +++ b/gcc/ada/s-fileio.adb @@ -29,28 +29,26 @@ -- -- ------------------------------------------------------------------------------ -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; @@ -1162,6 +1160,17 @@ package body System.File_IO is 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. @@ -1170,10 +1179,6 @@ package body System.File_IO is P : AFCB_Ptr; begin - -- Take a task lock to protect Open_Files - - SSL.Lock_Task.all; - -- Search list of open files P := Open_Files; @@ -1213,13 +1218,6 @@ package body System.File_IO is P := P.Next; end loop; - - SSL.Unlock_Task.all; - - exception - when others => - SSL.Unlock_Task.all; - raise; end; end if; @@ -1314,6 +1312,16 @@ package body System.File_IO is 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; ------------------------ |