diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 30 | ||||
| -rw-r--r-- | gcc/ada/exp_ch9.adb | 128 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 20 | ||||
| -rw-r--r-- | gcc/ada/lib-writ.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/mlib-prj.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/sem_aggr.adb | 211 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 1 | ||||
| -rw-r--r-- | gcc/ada/sem_ch5.adb | 31 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 39 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 11 |
10 files changed, 301 insertions, 177 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 179607d..7407457 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,35 @@ 2013-10-10 Robert Dewar <dewar@adacore.com> + * sem_aggr.adb (Resolve_Array_Aggregate): Redo duplicate/missing + choice circuit. Was not quite right in some cases, which showed + up in ACATS test B43201C. + * sem_attr.adb (Address_Checks): Make sure name is set right + for some messages issued. + * mlib-prj.adb: Minor code reorganization. + * gnat_ugn.texi: Remove special VMS doc for tagging of warning msgs. + * exp_ch9.adb: Minor reformatting. + +2013-10-10 Tristan Gingold <gingold@adacore.com> + + * lib-writ.adb (Write_Unit_Information): Adjust previous patch. + +2013-10-10 Robert Dewar <dewar@adacore.com> + + * sem_ch5.adb (Analyze_If_Statement): Warn on redundant if + statement. + * sem_util.ads, sem_util.adb (Has_No_Obvious_Side_Effects): New + function. + +2013-10-10 Ed Schonberg <schonberg@adacore.com> + + * exp_ch9.adb (Expand_N_Timed_Entry_Call): Simplify expansion + for the case of a dispatching trigger: there is no need to + duplicate the code or create a subprogram to encapsulate the + triggering statements. This allows exit statements in the + triggering statements, that refer to enclosing loops. + +2013-10-10 Robert Dewar <dewar@adacore.com> + * freeze.adb: Minor reformatting. * sem_ch13.adb (Freeze_Entity_Checks): New procedure (Analyze_Freeze_Entity): Call Freeze_Entity_Checks diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 738564c..8db80bd 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -11948,7 +11948,10 @@ package body Exp_Ch9 is -- end if; -- end; - -- 3) Ada 2005 (AI-345): When T.E is a dispatching procedure call; + -- 3) Ada 2005 (AI-345): When T.E is a dispatching procedure call, there + -- is no delay and the triggering statements are executed. We first + -- determine the kind of of the triggering call and then execute a + -- synchronized operation or a direct call. -- declare -- B : Boolean := False; @@ -11965,7 +11968,7 @@ package body Exp_Ch9 is -- or else K = Ada.Tags.TK_Tagged -- then -- <dispatching-call>; - -- <triggering-statements> + -- B := True; -- else -- S := @@ -11989,20 +11992,19 @@ package body Exp_Ch9 is -- then -- <dispatching-call>; -- end if; - - -- <triggering-statements> - -- else - -- <timed-statements> - -- end if; + -- end if; -- end if; + + -- if B then + -- <triggering-statements> + -- else + -- <timed-statements> + -- end if; -- end; -- The triggering statement and the sequence of timed statements have not -- been analyzed yet (see Analyzed_Timed_Entry_Call), but they may contain - -- global references if within an instantiation. To prevent duplication - -- between various uses of those statements, they are encapsulated into a - -- local procedure which is invoked multiple time when the trigger is a - -- dispatching call. + -- global references if within an instantiation. procedure Expand_N_Timed_Entry_Call (N : Node_Id) is Loc : constant Source_Ptr := Sloc (N); @@ -12045,63 +12047,6 @@ package body Exp_Ch9 is P : Entity_Id; -- Parameter block S : Entity_Id; -- Primitive operation slot - procedure Rewrite_Triggering_Statements; - -- If the trigger is a dispatching call, the expansion inserts multiple - -- copies of the abortable part. This is both inefficient, and may lead - -- to duplicate definitions that the back-end will reject, when the - -- abortable part includes loops. This procedure rewrites the abortable - -- part into a call to a generated procedure. - - ----------------------------------- - -- Rewrite_Triggering_Statements -- - ----------------------------------- - - procedure Rewrite_Triggering_Statements is - Proc : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uA); - Decl : Node_Id; - Stat : Node_Id; - - begin - Decl := - Make_Subprogram_Body (Loc, - Specification => - Make_Procedure_Specification (Loc, Defining_Unit_Name => Proc), - Declarations => New_List, - Handled_Statement_Sequence => - Make_Handled_Sequence_Of_Statements (Loc, E_Stats)); - - Append_To (Decls, Decl); - - -- Adjust the scope of blocks in the procedure. Needed because blocks - -- generate declarations that are processed before other analysis - -- takes place, and their scope is already set. The backend depends - -- on the scope chain to determine the legality of some anonymous - -- types, and thus we must indicate that the block is within the new - -- procedure. - - Stat := First (E_Stats); - while Present (Stat) loop - if Nkind (Stat) = N_Block_Statement then - Insert_Before (Stat, - Make_Implicit_Label_Declaration (Sloc (Stat), - Defining_Identifier => - Make_Defining_Identifier ( - Sloc (Stat), Chars (Identifier (Stat))))); - end if; - - Next (Stat); - end loop; - - -- Analyze (Decl); - - -- Rewrite abortable part into a call to this procedure. - - E_Stats := - New_List - (Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (Proc, Loc))); - end Rewrite_Triggering_Statements; - -- Start of processing for Expand_N_Timed_Entry_Call begin @@ -12144,7 +12089,6 @@ package body Exp_Ch9 is if Is_Disp_Select then Extract_Dispatching_Call (E_Call, Call_Ent, Obj, Actuals, Formals); Decls := New_List; - Rewrite_Triggering_Statements; Stmts := New_List; @@ -12349,20 +12293,10 @@ package body Exp_Ch9 is -- then -- <dispatching-call> -- end if; - -- <triggering-statements> - -- else - -- <timed-statements> -- end if; - -- Note: we used to do Copy_Separate_List here, but this was changed - -- to New_Copy_List_Tree with no explanation or RH note??? We should - -- explain the need for the change ??? - - N_Stats := New_Copy_List_Tree (E_Stats); - - Prepend_To (N_Stats, + N_Stats := New_List ( Make_Implicit_If_Statement (N, - Condition => Make_Or_Else (Loc, Left_Opnd => @@ -12391,19 +12325,17 @@ package body Exp_Ch9 is Append_To (Conc_Typ_Stmts, Make_Implicit_If_Statement (N, Condition => New_Reference_To (B, Loc), - Then_Statements => N_Stats, - Else_Statements => D_Stats)); + Then_Statements => N_Stats)); -- Generate: -- <dispatching-call>; - -- <triggering-statements> - - -- Note: the following was Copy_Separate_List but it was changed to - -- New_Copy_List_Tree without comments or RH documentation ??? We - -- should explain the need for the change ??? + -- B := True; - Lim_Typ_Stmts := New_Copy_List_Tree (E_Stats); - Prepend_To (Lim_Typ_Stmts, New_Copy_Tree (E_Call)); + Lim_Typ_Stmts := + New_List (New_Copy_Tree (E_Call), + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (B, Loc), + Expression => New_Occurrence_Of (Standard_True, Loc))); -- Generate: -- if K = Ada.Tags.TK_Limited_Tagged @@ -12420,8 +12352,24 @@ package body Exp_Ch9 is Then_Statements => Lim_Typ_Stmts, Else_Statements => Conc_Typ_Stmts)); + -- Generate: + + -- if B then + -- <triggering-statements> + -- else + -- <timed-statements> + -- end if; + + Append_To (Stmts, + Make_Implicit_If_Statement (N, + Condition => New_Occurrence_Of (B, Loc), + Then_Statements => E_Stats, + Else_Statements => D_Stats)); + else - -- Skip assignments to temporaries created for in-out parameters. + -- Simple case of a non-dispatching trigger. Skip assignments to + -- temporaries created for in-out parameters. + -- This makes unwarranted assumptions about the shape of the expanded -- tree for the call, and should be cleaned up ??? diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index b15aacd..c82dab7 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -4931,7 +4931,6 @@ this warning option. This switch suppresses warnings for implicit dereferences in indexed components, slices, and selected components. -@ifclear vms @item -gnatw.d @emph{Activate tagging of warning messages.} @cindex @option{-gnatw.d} (@command{gcc}) @@ -4947,25 +4946,6 @@ affected by the use of @code{-gnatwa}. If this switch is set, then warning messages return to the default mode in which warnings are not tagged as described above for @code{-gnatw.d}. -@end ifclear - -@ifset vms -@item -gnatw.d -@emph{Activate tagging of warning messages.} -@cindex @option{-gnatw.d} (@command{gcc}) -If this switch is set, then warning messages are tagged, either with -the appropriate WARNINGS qualifier string (e.g. [SUSPICIOUS_MODULUS] -or with ``[enabled by default]'' if the warning is not under control of a -specific WARNING qualifier switch. This mode is off by default, and is not -affected by the use of @code{-gnatwa}. - -@item -gnatw.D -@emph{Deactivate tagging of warning messages.} -@cindex @option{-gnatw.d} (@command{gcc}) -If this switch is set, then warning messages return to the default -mode in which warnings are not tagged as described above for -@code{-gnatw.d}. -@end ifset @item -gnatwe @emph{Treat warnings and style checks as errors.} diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb index afc83d9..c4b5e50 100644 --- a/gcc/ada/lib-writ.adb +++ b/gcc/ada/lib-writ.adb @@ -628,6 +628,7 @@ package body Lib.Writ is if Is_Generic_Unit (Cunit_Entity (Main_Unit)) and then Is_Predefined_File_Name (Unit_File_Name (Current_Sem_Unit)) + and then Linker_Option_Lines.Table (J).Unit = Unit_Num then Set_Standard_Error; Write_Line diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 4105901..945f913 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -1185,9 +1185,9 @@ package body MLib.Prj is Delete_File (Get_Name_String (Path), Succ); - if not Succ then - null; - end if; + -- We ignore a failure in this Delete_File operation. + -- Is that OK??? If so, worth a comment as to why we + -- are OK with the operation failing end; end if; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 96f1a40..5aec38a 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -65,23 +65,35 @@ with Uintp; use Uintp; package body Sem_Aggr is type Case_Bounds is record - Choice_Lo : Node_Id; - Choice_Hi : Node_Id; - Choice_Node : Node_Id; + Lo : Node_Id; + -- Low bound of choice. Once we sort the Case_Table, then entries + -- will be in order of ascending Choice_Lo values. + + Hi : Node_Id; + -- High Bound of choice. The sort does not pay any attention to the + -- high bound, so choices 1 .. 4 and 1 .. 5 could be in either order. + + Highest : Uint; + -- If there are duplicates or missing entries, then in the sorted + -- table, this records the highest value among Choice_Hi values + -- seen so far, including this entry. + + Choice : Node_Id; + -- The node of the choice end record; type Case_Table_Type is array (Nat range <>) of Case_Bounds; - -- Table type used by Check_Case_Choices procedure + -- Table type used by Check_Case_Choices procedure. Entry zero is not + -- used (reserved for the sort). Real entries start at one. ----------------------- -- Local Subprograms -- ----------------------- procedure Sort_Case_Table (Case_Table : in out Case_Table_Type); - -- Sort the Case Table using the Lower Bound of each Choice as the key. - -- A simple insertion sort is used since the number of choices in a case - -- statement of variant part will usually be small and probably in near - -- sorted order. + -- Sort the Case Table using the Lower Bound of each Choice as the key. A + -- simple insertion sort is used since the choices in a case statement will + -- usually be in near sorted order. procedure Check_Can_Never_Be_Null (Typ : Entity_Id; Expr : Node_Id); -- Ada 2005 (AI-231): Check bad usage of null for a component for which @@ -1905,8 +1917,9 @@ package body Sem_Aggr is -- if a choice in an aggregate is a subtype indication these -- denote the lowest and highest values of the subtype - Table : Case_Table_Type (1 .. Case_Table_Size); - -- Used to sort all the different choice values + Table : Case_Table_Type (0 .. Case_Table_Size); + -- Used to sort all the different choice values. Entry zero is + -- reserved for sorting purposes. Single_Choice : Boolean; -- Set to true every time there is a single discrete choice in a @@ -2018,9 +2031,9 @@ package body Sem_Aggr is end if; Nb_Discrete_Choices := Nb_Discrete_Choices + 1; - Table (Nb_Discrete_Choices).Choice_Lo := Low; - Table (Nb_Discrete_Choices).Choice_Hi := High; - Table (Nb_Discrete_Choices).Choice_Node := Choice; + Table (Nb_Discrete_Choices).Lo := Low; + Table (Nb_Discrete_Choices).Hi := High; + Table (Nb_Discrete_Choices).Choice := Choice; Next (Choice); @@ -2142,6 +2155,10 @@ package body Sem_Aggr is -- High end of one range and Low end of the next. Should be -- contiguous if there is no hole in the list of values. + Lo_Dup : Uint; + Hi_Dup : Uint; + -- End points of duplicated range + Missing_Or_Duplicates : Boolean := False; -- Set True if missing or duplicate choices found @@ -2189,62 +2206,129 @@ package body Sem_Aggr is begin Sort_Case_Table (Table); - -- Loop through entries in table to find duplicate indexes + -- First we do a quick linear loop to find out if we have + -- any duplicates or missing entries (usually we have a + -- legal aggregate, so this will get us out quickly). for J in 1 .. Nb_Discrete_Choices - 1 loop - Hi_Val := Expr_Value (Table (J).Choice_Hi); - Lo_Val := Expr_Value (Table (J + 1).Choice_Lo); - - if Hi_Val >= Lo_Val then - Choice := Table (J + 1).Choice_Lo; - Error_Msg_Sloc := Sloc (Table (J).Choice_Hi); - - if Hi_Val = Lo_Val then - Error_Msg_N - ("index value in array aggregate duplicates " - & "the one given#", - Choice); - else - Error_Msg_N - ("index values in array aggregate duplicate " - & "those given#", Choice); - end if; + Hi_Val := Expr_Value (Table (J).Hi); + Lo_Val := Expr_Value (Table (J + 1).Lo); + if Lo_Val <= Hi_Val + or else (Lo_Val > Hi_Val + 1 + and then not Others_Present) + then Missing_Or_Duplicates := True; - Output_Bad_Choices (Lo_Val, Hi_Val, Choice); + exit; end if; end loop; - -- Loop through entries in table to find missing indexes. - -- Not needed if others present, since missing impossible. + -- If we have missing or duplicate entries, first fill in + -- the Highest entries to make life easier in the following + -- loops to detect bad entries. - if not Others_Present then - for J in 1 .. Nb_Discrete_Choices - 1 loop - Hi_Val := Expr_Value (Table (J).Choice_Hi); - Lo_Val := Expr_Value (Table (J + 1).Choice_Lo); + if Missing_Or_Duplicates then + Table (1).Highest := Expr_Value (Table (1).Hi); - if Hi_Val < Lo_Val - 1 then - Choice := Table (J + 1).Choice_Lo; + for J in 2 .. Nb_Discrete_Choices loop + Table (J).Highest := + UI_Max + (Table (J - 1).Highest, Expr_Value (Table (J).Hi)); + end loop; - if Hi_Val + 1 = Lo_Val - 1 then - Error_Msg_N - ("missing index value in array aggregate!", - Choice); - else - Error_Msg_N - ("missing index values in array aggregate!", - Choice); - end if; + -- Loop through table entries to find duplicate indexes + + for J in 2 .. Nb_Discrete_Choices loop + Lo_Val := Expr_Value (Table (J).Lo); + Hi_Val := Expr_Value (Table (J).Hi); + + -- Case where we have duplicates (the lower bound of + -- this choice is less than or equal to the highest + -- high bound found so far). + + if Lo_Val <= Table (J - 1).Highest then + + -- We move backwards looking for duplicates. We can + -- abandon this loop as soon as we reach a choice + -- highest value that is less than Lo_Val. + + for K in reverse 1 .. J - 1 loop + exit when Table (K).Highest < Lo_Val; + + -- Here we may have duplicates between entries + -- for K and J. Get range of duplicates. + + Lo_Dup := + UI_Max (Lo_Val, Expr_Value (Table (K).Lo)); + Hi_Dup := + UI_Min (Hi_Val, Expr_Value (Table (K).Hi)); + + -- Nothing to do if duplicate range is null - Missing_Or_Duplicates := True; - Output_Bad_Choices (Hi_Val + 1, Lo_Val - 1, Choice); + if Lo_Dup > Hi_Dup then + null; + + -- Otherwise place proper message + + else + -- We place message on later choice, with a + -- line reference to the earlier choice. + + if Sloc (Table (J).Choice) < + Sloc (Table (K).Choice) + then + Choice := Table (K).Choice; + Error_Msg_Sloc := Sloc (Table (J).Choice); + else + Choice := Table (J).Choice; + Error_Msg_Sloc := Sloc (Table (K).Choice); + end if; + + if Lo_Dup = Hi_Dup then + Error_Msg_N + ("index value in array aggregate " + & "duplicates the one given#!", Choice); + else + Error_Msg_N + ("index values in array aggregate " + & "duplicate those given#!", Choice); + end if; + + Output_Bad_Choices (Lo_Dup, Hi_Dup, Choice); + end if; + end loop; end if; end loop; - end if; - -- If either missing or duplicate values, return failure + -- Loop through entries in table to find missing indexes. + -- Not needed if others, since missing impossible. + + if not Others_Present then + for J in 2 .. Nb_Discrete_Choices loop + Lo_Val := Expr_Value (Table (J).Lo); + Hi_Val := Table (J - 1).Highest; + + if Lo_Val > Hi_Val + 1 then + Choice := Table (J).Lo; + + if Hi_Val + 1 = Lo_Val - 1 then + Error_Msg_N + ("missing index value in array aggregate!", + Choice); + else + Error_Msg_N + ("missing index values in array aggregate!", + Choice); + end if; + + Output_Bad_Choices + (Hi_Val + 1, Lo_Val - 1, Choice); + end if; + end loop; + end if; + + -- If either missing or duplicate values, return failure - if Missing_Or_Duplicates then Set_Etype (N, Any_Composite); return Failure; end if; @@ -2254,8 +2338,8 @@ package body Sem_Aggr is -- STEP 2 (B): Compute aggregate bounds and min/max choices values if Nb_Discrete_Choices > 0 then - Choices_Low := Table (1).Choice_Lo; - Choices_High := Table (Nb_Discrete_Choices).Choice_Hi; + Choices_Low := Table (1).Lo; + Choices_High := Table (Nb_Discrete_Choices).Hi; end if; -- If Others is present, then bounds of aggregate come from the @@ -2566,8 +2650,9 @@ package body Sem_Aggr is Check_Unset_Reference (Aggregate_Bounds (N)); if not Others_Present and then Nb_Discrete_Choices = 0 then - Set_High_Bound (Aggregate_Bounds (N), - Duplicate_Subexpr (High_Bound (Aggregate_Bounds (N)))); + Set_High_Bound + (Aggregate_Bounds (N), + Duplicate_Subexpr (High_Bound (Aggregate_Bounds (N)))); end if; -- Check the dimensions of each component in the array aggregate @@ -4636,21 +4721,19 @@ package body Sem_Aggr is --------------------- procedure Sort_Case_Table (Case_Table : in out Case_Table_Type) is - L : constant Int := Case_Table'First; U : constant Int := Case_Table'Last; K : Int; J : Int; T : Case_Bounds; begin - K := L; - while K /= U loop + K := 1; + while K < U loop T := Case_Table (K + 1); J := K + 1; - while J /= L - and then Expr_Value (Case_Table (J - 1).Choice_Lo) > - Expr_Value (T.Choice_Lo) + while J > 1 + and then Expr_Value (Case_Table (J - 1).Lo) > Expr_Value (T.Lo) loop Case_Table (J) := Case_Table (J - 1); J := J - 1; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index dec94a3..44692e0 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -455,6 +455,7 @@ package body Sem_Attr is Reason => PE_Address_Of_Intrinsic)); else + Error_Msg_Name_1 := Aname; Error_Msg_N ("cannot take % of intrinsic subprogram", N); end if; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 9e282fd..e7f464e 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -1577,6 +1577,37 @@ package body Sem_Ch5 is Remove_Warning_Messages (Then_Statements (N)); end if; end if; + + -- Warn on redundant if statement that has no effect + + if Warn_On_Redundant_Constructs + + -- Condition must not have obvious side effect + + and then Has_No_Obvious_Side_Effects (Condition (N)) + + -- No elsif parts of else part + + and then No (Elsif_Parts (N)) + and then No (Else_Statements (N)) + + -- Then must be a single null statement + + and then List_Length (Then_Statements (N)) = 1 + then + -- Go to original node, since we may have rewritten something as + -- a null statement (e.g. a case we could figure the outcome of). + + declare + T : constant Node_Id := First (Then_Statements (N)); + S : constant Node_Id := Original_Node (T); + + begin + if Comes_From_Source (S) and then Nkind (S) = N_Null_Statement then + Error_Msg_N ("if statement has no effect?r?", N); + end if; + end; + end if; end Analyze_If_Statement; ---------------------------------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 6913c26..935b727 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6456,6 +6456,45 @@ package body Sem_Util is return False; end Has_Interfaces; + --------------------------------- + -- Has_No_Obvious_Side_Effects -- + --------------------------------- + + function Has_No_Obvious_Side_Effects (N : Node_Id) return Boolean is + begin + -- For now, just handle literals, constants, and non-volatile + -- variables and expressions combining these with operators or + -- short circuit forms. + + if Nkind (N) in N_Numeric_Or_String_Literal then + return True; + + elsif Nkind (N) = N_Character_Literal then + return True; + + elsif Nkind (N) in N_Unary_Op then + return Has_No_Obvious_Side_Effects (Right_Opnd (N)); + + elsif Nkind (N) in N_Binary_Op or else Nkind (N) in N_Short_Circuit then + return Has_No_Obvious_Side_Effects (Left_Opnd (N)) + and then + Has_No_Obvious_Side_Effects (Right_Opnd (N)); + + elsif Nkind (N) in N_Has_Entity then + return Present (Entity (N)) + and then Ekind_In (Entity (N), E_Variable, + E_Constant, + E_Enumeration_Literal, + E_In_Parameter, + E_Out_Parameter, + E_In_Out_Parameter) + and then not Is_Volatile (Entity (N)); + + else + return False; + end if; + end Has_No_Obvious_Side_Effects; + ------------------------ -- Has_Null_Exclusion -- ------------------------ diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 3053bee..d8d7db1 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -742,6 +742,17 @@ package Sem_Util is -- Use_Full_View controls if the check is done using its full view (if -- available). + function Has_No_Obvious_Side_Effects (N : Node_Id) return Boolean; + -- This is a simple minded function for determining whether an expression + -- has no obvious side effects. It is used only for determining whether + -- warnings are needed in certain situations, and is not guaranteed to + -- be accurate in either direction. Exceptions may mean an expression + -- does in fact have side effects, but this may be ignored and True is + -- returned, or a complex expression may in fact be side effect free + -- but we don't recognize it here and return False. The Side_Effect_Free + -- routine in Remove_Side_Effects is much more extensive and perhaps could + -- be shared, so that this routine would be more accurate. + function Has_Null_Exclusion (N : Node_Id) return Boolean; -- Determine whether node N has a null exclusion |