Commit 82893775 by Arnaud Charlet

[multiple changes]

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.

From-SVN: r203369
parent 5a8a6763
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
......
......@@ -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 ???
......
......@@ -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.}
......@@ -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
......
......@@ -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;
......
......@@ -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;
......
......@@ -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;
----------------------------------------
......
......@@ -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 --
------------------------
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment