diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 18 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 50 | ||||
| -rw-r--r-- | gcc/ada/rtsfind.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/s-os_lib.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/s-os_lib.ads | 7 | ||||
| -rw-r--r-- | gcc/ada/s-tposen.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/s-tposen.ads | 6 |
8 files changed, 67 insertions, 53 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8641cd2..c6e1573 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2014-01-29 Tristan Gingold <gingold@adacore.com> + + * exp_ch9.adb (Build_Protected_Entry): Do not call + Complete_Entry_Body anymore. + * rtsfind.ads (RE_Complete_Single_Entry_Body): Remove. + * s-tposen.ads, s-tposen.adb (Complete_Single_Entry_Body): Remove. + +2014-01-29 Pierre-Marie Derodat <derodat@adacore.com> + + * s-os_lib.adb, s-os_lib.ads (Normalize_Pathname): Return an empty + string when the Name input bigger than allowed. Adapt the function + specification. + +2014-01-29 Ed Schonberg <schonberg@adacore.com> + + * checks.adb (Install_Null_Excluding_Check): Do not emit warning + if expression is within a case_expression of if_expression. + 2014-01-29 Robert Dewar <dewar@adacore.com> * exp_ch9.adb, inline.ads: Minor reformatting. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 51acd29..826c09b 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -6672,7 +6672,7 @@ package body Checks is begin pragma Assert (Is_Access_Type (Typ)); - -- No check inside a generic (why not???) + -- No check inside a generic, check will be emitted in instance if Inside_A_Generic then return; @@ -6690,11 +6690,20 @@ package body Checks is -- Avoid generating warning message inside init procs. In SPARK mode -- we can go ahead and call Apply_Compile_Time_Constraint_Error - -- since it will be truned into an error in any case. + -- since it will be turned into an error in any case. - if not Inside_Init_Proc or else SPARK_Mode = On then + if (not Inside_Init_Proc or else SPARK_Mode = On) + + -- Do not emit the warning within a conditional expression + -- Why not ??? + + and then not Within_Case_Or_If_Expression (N) + then Apply_Compile_Time_Constraint_Error (N, "null value not allowed here??", CE_Access_Check_Failed); + + -- Remaining cases, where we silently insert the raise + else Insert_Action (N, Make_Raise_Constraint_Error (Loc, diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index c9ee46c..7c570a8 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -3847,9 +3847,10 @@ package body Exp_Ch9 is Build_Protected_Entry_Specification (Loc, Edef, Empty); -- Add the following declarations: + -- type poVP is access poV; -- _object : poVP := poVP (_O); - -- + -- where _O is the formal parameter associated with the concurrent -- object. These declarations are needed for Complete_Entry_Body. @@ -3861,35 +3862,42 @@ package body Exp_Ch9 is Add_Formal_Renamings (Espec, Op_Decls, Ent, Loc); Debug_Private_Data_Declarations (Decls); + -- Put the declarations and the statements from the entry + + Op_Stats := + New_List ( + Make_Block_Statement (Loc, + Declarations => Decls, + Handled_Statement_Sequence => + Handled_Statement_Sequence (N))); + case Corresponding_Runtime_Package (Pid) is when System_Tasking_Protected_Objects_Entries => - Complete := - New_Reference_To (RTE (RE_Complete_Entry_Body), Loc); + Append_To (Op_Stats, + Make_Procedure_Call_Statement (End_Loc, + Name => + New_Reference_To (RTE (RE_Complete_Entry_Body), Loc), + Parameter_Associations => New_List ( + Make_Attribute_Reference (End_Loc, + Prefix => + Make_Selected_Component (End_Loc, + Prefix => + Make_Identifier (End_Loc, Name_uObject), + Selector_Name => + Make_Identifier (End_Loc, Name_uObject)), + Attribute_Name => Name_Unchecked_Access)))); when System_Tasking_Protected_Objects_Single_Entry => - Complete := - New_Reference_To (RTE (RE_Complete_Single_Entry_Body), Loc); + + -- Historically, a call to Complete_Single_Entry_Body was + -- inserted, but it was a null procedure. + + null; when others => raise Program_Error; end case; - Op_Stats := New_List ( - Make_Block_Statement (Loc, - Declarations => Decls, - Handled_Statement_Sequence => - Handled_Statement_Sequence (N)), - - Make_Procedure_Call_Statement (End_Loc, - Name => Complete, - Parameter_Associations => New_List ( - Make_Attribute_Reference (End_Loc, - Prefix => - Make_Selected_Component (End_Loc, - Prefix => Make_Identifier (End_Loc, Name_uObject), - Selector_Name => Make_Identifier (End_Loc, Name_uObject)), - Attribute_Name => Name_Unchecked_Access)))); - -- When exceptions can not be propagated, we never need to call -- Exception_Complete_Entry_Body diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 5ae85f3..8325bcf 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -1747,7 +1747,6 @@ package Rtsfind is RE_Unlock_Entry, -- Protected_Objects.Single_Entry RE_Protected_Single_Entry_Call, -- Protected_Objects.Single_Entry RE_Service_Entry, -- Protected_Objects.Single_Entry - RE_Complete_Single_Entry_Body, -- Protected_Objects.Single_Entry RE_Exceptional_Complete_Single_Entry_Body, RE_Protected_Count_Entry, -- Protected_Objects.Single_Entry RE_Protected_Single_Entry_Caller, -- Protected_Objects.Single_Entry @@ -3057,8 +3056,6 @@ package Rtsfind is System_Tasking_Protected_Objects_Single_Entry, RE_Service_Entry => System_Tasking_Protected_Objects_Single_Entry, - RE_Complete_Single_Entry_Body => - System_Tasking_Protected_Objects_Single_Entry, RE_Exceptional_Complete_Single_Entry_Body => System_Tasking_Protected_Objects_Single_Entry, RE_Protected_Count_Entry => diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index 268e541..8b4db7b 100644 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -1927,9 +1927,10 @@ package body System.OS_Lib is -- Start of processing for Normalize_Pathname begin - -- Special case, if name is null, then return null + -- Special case, return null if name is null, or if it is bigger than + -- the biggest name allowed. - if Name'Length = 0 then + if Name'Length = 0 or else Name'Length > Max_Path then return ""; end if; diff --git a/gcc/ada/s-os_lib.ads b/gcc/ada/s-os_lib.ads index 4e11fb1..cd64496 100644 --- a/gcc/ada/s-os_lib.ads +++ b/gcc/ada/s-os_lib.ads @@ -445,9 +445,10 @@ package System.OS_Lib is -- directory pointed to. This is slightly less efficient, since it -- requires system calls. -- - -- If Name cannot be resolved or is null on entry (for example if there is - -- symbolic link circularity, e.g. A is a symbolic link for B, and B is a - -- symbolic link for A), then Normalize_Pathname returns an empty string. + -- If Name cannot be resolved, is invalid (for example if it is too big) or + -- is null on entry (for example if there is symbolic link circularity, + -- e.g. A is a symbolic link for B, and B is a symbolic link for A), then + -- Normalize_Pathname returns an empty string. -- -- In VMS, if Name follows the VMS syntax file specification, it is first -- converted into Unix syntax. If the conversion fails, Normalize_Pathname diff --git a/gcc/ada/s-tposen.adb b/gcc/ada/s-tposen.adb index 10cfca2..356da5a 100644 --- a/gcc/ada/s-tposen.adb +++ b/gcc/ada/s-tposen.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1998-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1998-2013, Free Software Foundation, Inc. -- -- -- -- GNARL 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- -- @@ -278,20 +278,6 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- Restricted GNARLI -- ----------------------- - -------------------------------- - -- Complete_Single_Entry_Body -- - -------------------------------- - - procedure Complete_Single_Entry_Body (Object : Protection_Entry_Access) is - pragma Warnings (Off, Object); - - begin - -- Nothing needs to do (Object.Call_In_Progress.Exception_To_Raise - -- has already been set to Null_Id). - - null; - end Complete_Single_Entry_Body; - -------------------------------------------- -- Exceptional_Complete_Single_Entry_Body -- -------------------------------------------- diff --git a/gcc/ada/s-tposen.ads b/gcc/ada/s-tposen.ads index c5b832c..6cfd3de 100644 --- a/gcc/ada/s-tposen.ads +++ b/gcc/ada/s-tposen.ads @@ -250,12 +250,6 @@ package System.Tasking.Protected_Objects.Single_Entry is -- Same as the Protected_Entry_Call but with time-out specified. -- This routine is used to implement timed entry calls. - procedure Complete_Single_Entry_Body - (Object : Protection_Entry_Access); - pragma Inline (Complete_Single_Entry_Body); - -- Called from within an entry body procedure, indicates that the - -- corresponding entry call has been serviced. - procedure Exceptional_Complete_Single_Entry_Body (Object : Protection_Entry_Access; Ex : Ada.Exceptions.Exception_Id); |