From 5073ad7a647c3f8075429d7b69ac810cc53f118d Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 20 Nov 2014 12:52:08 +0100 Subject: [PATCH] [multiple changes] 2014-11-20 Robert Dewar * gnatcmd.adb, sem_ch6.adb, exp_dist.adb: Minor reformatting. * sem_util.adb (Bad_Unordered_Enumeration_Reference): Suppress warning (return False) for generic type. 2014-11-20 Hristian Kirtchev * sem_res.adb (Appears_In_Check): Removed. (Is_OK_Volatile_Context): Rewrite the checks which verify that an effectively volatile object subject to enabled properties Async_Writers or Effective_Reads appears in a suitable context to properly recognize a procedure call. (Within_Check): New routine. (Within_Procedure_Call): New routine. From-SVN: r217848 --- gcc/ada/ChangeLog | 16 +++++++ gcc/ada/exp_dist.adb | 23 ++++----- gcc/ada/gnatcmd.adb | 14 +++--- gcc/ada/sem_ch6.adb | 4 +- gcc/ada/sem_res.adb | 109 ++++++++++++++++++++++++++++--------------- gcc/ada/sem_util.adb | 3 +- 6 files changed, 110 insertions(+), 59 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a86d9ef99f4..83156e02012 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2014-11-20 Robert Dewar + + * gnatcmd.adb, sem_ch6.adb, exp_dist.adb: Minor reformatting. + * sem_util.adb (Bad_Unordered_Enumeration_Reference): Suppress + warning (return False) for generic type. + +2014-11-20 Hristian Kirtchev + + * sem_res.adb (Appears_In_Check): Removed. + (Is_OK_Volatile_Context): Rewrite the checks which verify that + an effectively volatile object subject to enabled properties + Async_Writers or Effective_Reads appears in a suitable context to + properly recognize a procedure call. + (Within_Check): New routine. + (Within_Procedure_Call): New routine. + 2014-11-20 Ed Schonberg * sem_ch6.adb: Improve better error message. diff --git a/gcc/ada/exp_dist.adb b/gcc/ada/exp_dist.adb index 0972e83f81e..310943bf042 100644 --- a/gcc/ada/exp_dist.adb +++ b/gcc/ada/exp_dist.adb @@ -9801,15 +9801,11 @@ package body Exp_Dist is while Present (Disc) loop declare Discriminant : constant Entity_Id := - Make_Selected_Component (Loc, - Prefix => - Expr_Formal, - Selector_Name => - Chars (Disc)); - + Make_Selected_Component (Loc, + Prefix => Expr_Formal, + Selector_Name => Chars (Disc)); begin Set_Etype (Discriminant, Etype (Disc)); - Append_To (Elements, Make_Component_Association (Loc, Choices => New_List ( @@ -10031,7 +10027,8 @@ package body Exp_Dist is if Is_Limited_Type (Typ) then Append_To (Stms, Make_Implicit_If_Statement (Typ, - Condition => New_Occurrence_Of (Cstr_Formal, Loc), + Condition => + New_Occurrence_Of (Cstr_Formal, Loc), Then_Statements => New_List ( Stream_Call (Name_Write)), Else_Statements => New_List ( @@ -10039,6 +10036,7 @@ package body Exp_Dist is elsif Transmit_As_Unconstrained (Typ) then Append_To (Stms, Stream_Call (Name_Output)); + else Append_To (Stms, Stream_Call (Name_Write)); end if; @@ -10049,7 +10047,8 @@ package body Exp_Dist is Append_To (Stms, Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (RE_BS_To_Any), Loc), + Name => + New_Occurrence_Of (RTE (RE_BS_To_Any), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Strm, Loc), New_Occurrence_Of (Any, Loc)))); @@ -10059,7 +10058,8 @@ package body Exp_Dist is Append_To (Stms, Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (RE_Release_Buffer), Loc), + Name => + New_Occurrence_Of (RTE (RE_Release_Buffer), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Strm, Loc)))); end; @@ -10070,7 +10070,8 @@ package body Exp_Dist is if Present (Result_TC) then Append_To (Stms, Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (RE_Set_TC), Loc), + Name => + New_Occurrence_Of (RTE (RE_Set_TC), Loc), Parameter_Associations => New_List ( New_Occurrence_Of (Any, Loc), Result_TC))); diff --git a/gcc/ada/gnatcmd.adb b/gcc/ada/gnatcmd.adb index 3306aa64464..7f9ca1857f0 100644 --- a/gcc/ada/gnatcmd.adb +++ b/gcc/ada/gnatcmd.adb @@ -489,9 +489,8 @@ procedure GNATCmd is for Index in 1 .. Last_Switches.Last loop if Last_Switches.Table (Index) (1) /= '-' - or else - (Last_Switches.Table (Index).all'Length > 7 - and then Last_Switches.Table (Index) (1 .. 7) = "-files=") + or else (Last_Switches.Table (Index).all'Length > 7 + and then Last_Switches.Table (Index) (1 .. 7) = "-files=") then Add_Sources := False; exit; @@ -507,9 +506,7 @@ procedure GNATCmd is -- put the list of sources in it. For gnatstack create a temporary -- file with the list of .ci files. - if The_Command = List or else - The_Command = Stack - then + if The_Command = List or else The_Command = Stack then Tempdir.Create_Temp_File (FD, Temp_File_Name); Last_Switches.Increment_Last; Last_Switches.Table (Last_Switches.Last) := @@ -1937,6 +1934,7 @@ begin -- a configuration pragmas file, if necessary. if The_Command = Sync then + -- If there are switches in package Compiler, put them in the -- Carg_Switches table. @@ -2155,8 +2153,8 @@ begin -- on the command line, call tool with all the sources of the main -- project. - if The_Command = Sync or else - The_Command = List or else + if The_Command = Sync or else + The_Command = List or else The_Command = Stack then Check_Files; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 1fcde26714a..8c6b0d2233c 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -331,8 +331,8 @@ package body Sem_Ch6 is -- which case the redeclaration is illegal. if Present (Prev) - and then Nkind (Original_Node (Unit_Declaration_Node (Prev))) - = N_Expression_Function + and then Nkind (Original_Node (Unit_Declaration_Node (Prev))) = + N_Expression_Function then Error_Msg_Sloc := Sloc (Prev); Error_Msg_N ("& conflicts with declaration#", Def_Id); diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 90311caf969..e0b1b0e20d4 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6897,9 +6897,6 @@ package body Sem_Res is -- Used to resolve identifiers and expanded names procedure Resolve_Entity_Name (N : Node_Id; Typ : Entity_Id) is - function Appears_In_Check (Nod : Node_Id) return Boolean; - -- Denote whether an arbitrary node Nod appears in a check node - function Is_OK_Volatile_Context (Context : Node_Id; Obj_Ref : Node_Id) return Boolean; @@ -6907,41 +6904,76 @@ package body Sem_Res is -- (as defined in SPARK RM 7.1.3(13)) where volatile reference Obj_Ref -- can safely reside. - ---------------------- - -- Appears_In_Check -- - ---------------------- + ---------------------------- + -- Is_OK_Volatile_Context -- + ---------------------------- - function Appears_In_Check (Nod : Node_Id) return Boolean is - Par : Node_Id; + function Is_OK_Volatile_Context + (Context : Node_Id; + Obj_Ref : Node_Id) return Boolean + is + function Within_Check (Nod : Node_Id) return Boolean; + -- Determine whether an arbitrary node appears in a check node - begin - -- Climb the parent chain looking for a check node + function Within_Procedure_Call (Nod : Node_Id) return Boolean; + -- Determine whether an arbitrary node appears in a procedure call - Par := Nod; - while Present (Par) loop - if Nkind (Par) in N_Raise_xxx_Error then - return True; + ------------------ + -- Within_Check -- + ------------------ - -- Prevent the search from going too far + function Within_Check (Nod : Node_Id) return Boolean is + Par : Node_Id; - elsif Is_Body_Or_Package_Declaration (Par) then - exit; - end if; + begin + -- Climb the parent chain looking for a check node - Par := Parent (Par); - end loop; + Par := Nod; + while Present (Par) loop + if Nkind (Par) in N_Raise_xxx_Error then + return True; - return False; - end Appears_In_Check; + -- Prevent the search from going too far - ---------------------------- - -- Is_OK_Volatile_Context -- - ---------------------------- + elsif Is_Body_Or_Package_Declaration (Par) then + exit; + end if; + + Par := Parent (Par); + end loop; + + return False; + end Within_Check; + + --------------------------- + -- Within_Procedure_Call -- + --------------------------- + + function Within_Procedure_Call (Nod : Node_Id) return Boolean is + Par : Node_Id; + + begin + -- Climb the parent chain looking for a procedure call + + Par := Nod; + while Present (Par) loop + if Nkind (Par) = N_Procedure_Call_Statement then + return True; + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (Par) then + exit; + end if; + + Par := Parent (Par); + end loop; + + return False; + end Within_Procedure_Call; + + -- Start of processing for Is_OK_Volatile_Context - function Is_OK_Volatile_Context - (Context : Node_Id; - Obj_Ref : Node_Id) return Boolean - is begin -- The volatile object appears on either side of an assignment @@ -6996,9 +7028,19 @@ package body Sem_Res is -- Allow references to volatile objects in various checks. This is -- not a direct SPARK 2014 requirement. - elsif Appears_In_Check (Context) then + elsif Within_Check (Context) then + return True; + + -- Assume that references to effectively volatile objects that appear + -- as actual parameters in a procedure call are always legal. A full + -- legality check is done when the actuals are resolved. + + elsif Within_Procedure_Call (Context) then return True; + -- Otherwise the context is not suitable for an effectively volatile + -- object. + else return False; end if; @@ -7140,13 +7182,6 @@ package body Sem_Res is if Is_OK_Volatile_Context (Par, N) then null; - -- Assume that references to effectively volatile objects that appear - -- as actual parameters in a procedure call are always legal. A full - -- legality check is done when the actuals are resolved. - - elsif Nkind (Par) = N_Procedure_Call_Statement then - null; - -- Otherwise the context causes a side effect with respect to the -- effectively volatile object. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 45d306600ad..cc8679cab16 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -897,8 +897,9 @@ package body Sem_Util is is begin return Is_Enumeration_Type (T) - and then Comes_From_Source (N) and then Warn_On_Unordered_Enumeration_Type + and then not Is_Generic_Type (T) + and then Comes_From_Source (N) and then not Has_Pragma_Ordered (T) and then not In_Same_Extended_Unit (N, T); end Bad_Unordered_Enumeration_Reference; -- 2.30.2