+2014-02-19 Robert Dewar <dewar@adacore.com>
+
+ * par-ch6.adb (P_Return): For extended return, end column lines
+ up with RETURN.
+ * par.adb: Minor documentation clarification.
+
+2014-02-19 Yannick Moy <moy@adacore.com>
+
+ * sem_prag.adb (Check_Loop_Pragma_Placement): Add check
+ that Loop_Invariant and Loop_Variant appear consecutively.
+ * gnat_rm.texi Update documentation of Loop_Invariant and
+ Loop_Variant pragmas.
+
+2014-02-19 Robert Dewar <dewar@adacore.com>
+
+ * debug.adb: Document -gnatd.X.
+ * par-ch5.adb (P_If_Statement): Always check THEN, even if not
+ first token
+ (Check_Then_Column): Ditto.
+ * styleg.adb (Check_Then): Allow THEN on line after IF.
+ (Check_Then): Check THEN placement under control of -gnatd.X
+ * styleg.ads (Check_Then): Now called even if THEN is not first
+ token on line.
+ * stylesw.ads (Style_Check_If_Then_Layout): Document new
+ relaxed rules.
+ * gnat_ugn.texi: For -gnatyi, THEN can now be on line after IF.
+
+2014-02-19 Robert Dewar <dewar@adacore.com>
+
+ * a-cfhama.adb, a-cfhase.adb, a-cforse.adb, a-cofove.adb, a-ngcefu.adb,
+ a-teioed.adb, a-wtedit.adb, a-ztedit.adb, exp_ch5.adb, inline.adb,
+ prj-pp.adb, prj-tree.adb, sem_ch12.adb, sem_ch8.adb,
+ vms_conv.adb: Fix bad layout of IF statements
+
2014-02-19 Robert Dewar <dewar@adacore.com>
* exp_util.adb (Side_Effect_Free): Scalar if expressions can be SEF.
function Has_Element (Container : Map; Position : Cursor) return Boolean is
begin
- if Position.Node = 0 or else
- not Container.Nodes (Position.Node).Has_Element then
+ if Position.Node = 0
+ or else not Container.Nodes (Position.Node).Has_Element
+ then
return False;
+ else
+ return True;
end if;
-
- return True;
end Has_Element;
---------------
return False;
end if;
- while CuL.Node /= 0 or CuR.Node /= 0 loop
- if CuL.Node /= CuR.Node or else
- (Left.Nodes (CuL.Node).Element /=
- Right.Nodes (CuR.Node).Element or
- Left.Nodes (CuL.Node).Key /=
- Right.Nodes (CuR.Node).Key) then
+ while CuL.Node /= 0 or else CuR.Node /= 0 loop
+ if CuL.Node /= CuR.Node
+ or else
+ Left.Nodes (CuL.Node).Element /= Right.Nodes (CuR.Node).Element
+ or else Left.Nodes (CuL.Node).Key /= Right.Nodes (CuR.Node).Key
+ then
return False;
end if;
return False;
end if;
- if Equivalent_Elements (L_Node.Element,
- RN (R_Node).Element) then
+ if Equivalent_Elements
+ (L_Node.Element, RN (R_Node).Element)
+ then
return True;
end if;
return True;
end if;
- if Left.Nodes (LNode).Element /=
- Right.Nodes (RNode).Element then
+ if Left.Nodes (LNode).Element /= Right.Nodes (RNode).Element then
exit;
end if;
return;
end if;
- if Position.Index > Index_Type'First and
- Position.Index <= Last_Index (Container) then
+ if Position.Index > Index_Type'First
+ and then Position.Index <= Last_Index (Container)
+ then
Position.Index := Position.Index - 1;
else
Position := No_Element;
return No_Element;
end if;
- if Position.Index > Index_Type'First and
- Position.Index <= Last_Index (Container) then
+ if Position.Index > Index_Type'First
+ and then Position.Index <= Last_Index (Container)
+ then
return (True, Position.Index - 1);
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
function Sin (X : Complex) return Complex is
begin
- if abs Re (X) < Square_Root_Epsilon and then
- abs Im (X) < Square_Root_Epsilon then
+ if abs Re (X) < Square_Root_Epsilon
+ and then
+ abs Im (X) < Square_Root_Epsilon
+ then
return X;
end if;
end if;
for J in Position .. Answer'Last loop
- if Pic.Start_Currency /= Invalid_Position and then
- Answer (Pic.Start_Currency) = '#' then
+ if Pic.Start_Currency /= Invalid_Position
+ and then Answer (Pic.Start_Currency) = '#'
+ then
Currency_Pos := 1;
end if;
Last := Last - 1 + Currency_Symbol'Length;
end if;
- if Pic.Radix_Position /= Invalid_Position and then
- Answer (Pic.Radix_Position) = 'V' then
+ if Pic.Radix_Position /= Invalid_Position
+ and then Answer (Pic.Radix_Position) = 'V'
+ then
Last := Last - 1;
end if;
end if;
for J in Position .. Answer'Last loop
- if Pic.Start_Currency /= Invalid_Position and then
- Answer (Pic.Start_Currency) = '#' then
+ if Pic.Start_Currency /= Invalid_Position
+ and then Answer (Pic.Start_Currency) = '#'
+ then
Currency_Pos := 1;
end if;
Last := Last - 1 + Currency_Symbol'Length;
end if;
- if Pic.Radix_Position /= Invalid_Position and then
- Answer (Pic.Radix_Position) = 'V' then
+ if Pic.Radix_Position /= Invalid_Position
+ and then Answer (Pic.Radix_Position) = 'V'
+ then
Last := Last - 1;
end if;
end if;
for J in Position .. Answer'Last loop
- if Pic.Start_Currency /= Invalid_Position and then
- Answer (Pic.Start_Currency) = '#' then
+ if Pic.Start_Currency /= Invalid_Position
+ and then Answer (Pic.Start_Currency) = '#'
+ then
Currency_Pos := 1;
end if;
Last := Last - 1 + Currency_Symbol'Length;
end if;
- if Pic.Radix_Position /= Invalid_Position and then
- Answer (Pic.Radix_Position) = 'V' then
+ if Pic.Radix_Position /= Invalid_Position
+ and then Answer (Pic.Radix_Position) = 'V'
+ then
Last := Last - 1;
end if;
-- d.U Ignore indirect calls for static elaboration
-- d.V
-- d.W Print out debugging information for Walk_Library_Items
- -- d.X
+ -- d.X Activate check on THEN appearing in wrong place
-- d.Y
-- d.Z
-- the order in which units are walked. This is primarily for use in
-- debugging CodePeer mode.
+ -- d.X Activates check for proper placement of THEN in -gnatyi mode. A
+ -- THEN keyword must appear on the same line as IF, or on a separate
+ -- line all on its own, lined up with the IF.
+
-- d1 Error messages have node numbers where possible. Normally error
-- messages have only source locations. This option is useful when
-- debugging errors caused by expanded code, where the source location
if Is_Access_Type (Typ)
and then Is_Entity_Name (Lhs)
- and then Present (Effective_Extra_Accessibility (Entity (Lhs))) then
+ and then Present (Effective_Extra_Accessibility (Entity (Lhs)))
+ then
declare
function Lhs_Entity return Entity_Id;
-- Look through renames to find the underlying entity.
(or disabled).
@code{Loop_Invariant} can only appear as one of the items in the sequence
-of statements of a loop body. The intention is that it be used to
+of statements of a loop body, or nested inside block statements that
+appear in the sequence of statements of a loop body.
+The intention is that it be used to
represent a "loop invariant" assertion, i.e. something that is true each
time through the loop, and which can be used to show that the loop is
achieving its purpose.
+Multiple @code{Loop_Invariant} and @code{Loop_Variant} pragmas that
+apply to the same loop should be grouped in the same sequence of
+statements, with only the same pragmas in between.
+
To aid in writing such invariants, the special attribute @code{Loop_Entry}
may be used to refer to the value of an expression on entry to the loop. This
attribute can only be used within the expression of a @code{Loop_Invariant}
@end smallexample
@noindent
-This pragma must appear immediately within the sequence of statements of a
-loop statement. It allows the specification of quantities which must always
+@code{Loop_Variant} can only appear as one of the items in the sequence
+of statements of a loop body, or nested inside block statements that
+appear in the sequence of statements of a loop body.
+It allows the specification of quantities which must always
decrease or increase in successive iterations of the loop. In its simplest
form, just one expression is specified, whose value must increase or decrease
on each iteration of the loop.
or @code{Disable} in which case the pragma is not even checked for correct
syntax.
+Multiple @code{Loop_Invariant} and @code{Loop_Variant} pragmas that
+apply to the same loop should be grouped in the same sequence of
+statements, with only the same pragmas in between.
+
The @code{Loop_Entry} attribute may be used within the expressions of the
@code{Loop_Variant} pragma to refer to values on entry to the loop.
@emph{Check if-then layout.}
The keyword @code{then} must appear either on the same
line as corresponding @code{if}, or on a line on its own, lined
-up under the @code{if} with at least one non-blank line in between
-containing all or part of the condition to be tested.
+up under the @code{if}.
@item ^I^IN_MODE^
@emph{check mode IN keywords.}
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
elsif Ekind (Scop) = E_Task_Type
or else Ekind (Scop) = E_Entry
- or else Ekind (Scop) = E_Entry_Family then
+ or else Ekind (Scop) = E_Entry_Family
+ then
return True;
end if;
procedure Check_Then_Column;
-- This procedure carries out the style checks for a THEN token
-- Note that the caller has set Loc to the Source_Ptr value for
- -- the previous IF or ELSIF token. These checks apply only to a
- -- THEN at the start of a line.
+ -- the previous IF or ELSIF token.
function Else_Should_Be_Elsif return Boolean;
-- An internal routine used to do a special error recovery check when
procedure Check_Then_Column is
begin
- if Token_Is_At_Start_Of_Line and then Token = Tok_Then then
+ if Token = Tok_Then then
Check_If_Column;
if Style_Check then
-- The caller has checked that the initial token is RETURN
function Is_Simple return Boolean;
- -- Scan state is just after RETURN (and is left that way).
- -- Determine whether this is a simple or extended return statement
- -- by looking ahead for "identifier :", which implies extended.
+ -- Scan state is just after RETURN (and is left that way). Determine
+ -- whether this is a simple or extended return statement by looking
+ -- ahead for "identifier :", which implies extended.
---------------
-- Is_Simple --
return Result;
end Is_Simple;
- Return_Sloc : constant Source_Ptr := Token_Ptr;
- Return_Node : Node_Id;
+ Ret_Sloc : constant Source_Ptr := Token_Ptr;
+ Ret_Strt : constant Column_Number := Start_Column;
+ Ret_Node : Node_Id;
-- Start of processing for P_Return_Statement
if Token = Tok_Semicolon then
Scan; -- past ;
- Return_Node := New_Node (N_Simple_Return_Statement, Return_Sloc);
+ Ret_Node := New_Node (N_Simple_Return_Statement, Ret_Sloc);
-- Non-trivial case
-- message is probably that we have a missing semicolon.
if Is_Simple then
- Return_Node := New_Node (N_Simple_Return_Statement, Return_Sloc);
+ Ret_Node := New_Node (N_Simple_Return_Statement, Ret_Sloc);
if Token not in Token_Class_Eterm then
- Set_Expression (Return_Node, P_Expression_No_Right_Paren);
+ Set_Expression (Ret_Node, P_Expression_No_Right_Paren);
end if;
-- Extended_return_statement (Ada 2005 only -- AI-318):
Error_Msg_SP ("\unit must be compiled with -gnat05 switch");
end if;
- Return_Node := New_Node (N_Extended_Return_Statement, Return_Sloc);
+ Ret_Node := New_Node (N_Extended_Return_Statement, Ret_Sloc);
Set_Return_Object_Declarations
- (Return_Node, New_List (P_Return_Object_Declaration));
+ (Ret_Node, New_List (P_Return_Object_Declaration));
if Token = Tok_Do then
Push_Scope_Stack;
Scope.Table (Scope.Last).Etyp := E_Return;
- Scope.Table (Scope.Last).Ecol := Start_Column;
- Scope.Table (Scope.Last).Sloc := Return_Sloc;
+ Scope.Table (Scope.Last).Ecol := Ret_Strt;
+ Scope.Table (Scope.Last).Sloc := Ret_Sloc;
Scan; -- past DO
Set_Handled_Statement_Sequence
- (Return_Node, P_Handled_Sequence_Of_Statements);
+ (Ret_Node, P_Handled_Sequence_Of_Statements);
End_Statements;
-- Do we need to handle Error_Resync here???
TF_Semicolon;
end if;
- return Return_Node;
+ return Ret_Node;
end P_Return_Statement;
end Ch6;
-- expected column of the end assuming normal Ada indentation usage. If
-- the RM_Column_Check mode is set, this value is used for generating
-- error messages about indentation. Otherwise it is used only to
- -- control heuristic error recovery actions.
+ -- control heuristic error recovery actions. This value is zero origin.
Labl : Node_Id;
-- This field is used to provide the name of the construct being parsed
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2013, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
procedure Write_Empty_Line (Always : Boolean := False) is
begin
if (Always or else not Minimize_Empty_Lines)
- and then not Last_Line_Is_Empty then
+ and then not Last_Line_Is_Empty
+ then
Write_Eol.all;
Column := 0;
Last_Line_Is_Empty := True;
Empty_Line := False;
when others =>
+
-- If there are comments, where the first comment is not
-- following an empty line, put the initial uninterrupted
-- comment zone with the node of the preceding line (either
-- a Previous_Line or a Previous_End node), if any.
if Comments.Last > 0 and then
- not Comments.Table (1).Follows_Empty_Line then
+ not Comments.Table (1).Follows_Empty_Line
+ then
if Present (Previous_Line_Node) then
Add_Comments
(To => Previous_Line_Node,
Desig_Act := Available_View (Desig_Act);
end if;
- if not Subtypes_Match
- (Desig_Type, Desig_Act) then
+ if not Subtypes_Match (Desig_Type, Desig_Act) then
Error_Msg_NE
("designated type of actual does not match that of formal &",
Actual, Gen_T);
Get_Name_String (Chars (Lit));
if Chars (Lit) /= Chars (N)
- and then Is_Bad_Spelling_Of (Chars (N), Chars (Lit)) then
+ and then Is_Bad_Spelling_Of (Chars (N), Chars (Lit))
+ then
Error_Msg_Node_2 := Lit;
Error_Msg_N -- CODEFIX
("& is undefined, assume misspelling of &", N);
procedure Check_Loop_Pragma_Placement;
-- Verify whether pragma Loop_Invariant or Loop_Optimize or Loop_Variant
- -- appear immediately within a construct restricted to loops.
+ -- appear immediately within a construct restricted to loops, and that
+ -- pragmas Loop_Invariant and Loop_Variant applying to the same loop all
+ -- appear grouped in the same sequence of statements.
procedure Check_Is_In_Decl_Part_Or_Package_Spec;
-- Check that pragma appears in a declarative part, or in a package
-- encountered an illegal relation between enclosing constructs. Emit
-- an error depending on what Constr was.
+ function Prev_In_Loop (Stmt : Node_Id) return Node_Id;
+ -- Returns the statement or declaration preceding Stmt in the
+ -- same loop, or Empty if the head of the loop is reached. Block
+ -- statements are entered during this traversal.
+
---------------------
-- Placement_Error --
---------------------
end if;
end Placement_Error;
+ ------------------
+ -- Prev_In_Loop --
+ ------------------
+
+ function Prev_In_Loop (Stmt : Node_Id) return Node_Id is
+ Prev : Node_Id;
+ Reach_Inside_Blocks : Boolean;
+
+ begin
+ Reach_Inside_Blocks := True;
+
+ -- Try the previous statement in the same list
+
+ Prev := Nlists.Prev (Stmt);
+
+ -- Otherwise reach to the previous statement through the parent
+
+ if No (Prev) then
+
+ -- If we're inside the statements of a block which contains
+ -- declarations, continue with the last declaration of the
+ -- block if any.
+
+ if Nkind (Parent (Stmt)) = N_Handled_Sequence_Of_Statements
+ and then Nkind (Parent (Parent (Stmt))) = N_Block_Statement
+ and then Present (Declarations (Parent (Parent (Stmt))))
+ then
+ Prev := Last (Declarations (Parent (Parent (Stmt))));
+
+ -- Ignore a handled statement sequence
+
+ elsif
+ Nkind (Parent (Stmt)) = N_Handled_Sequence_Of_Statements
+ then
+ Reach_Inside_Blocks := False;
+ Prev := Parent (Parent (Stmt));
+
+ -- Do not reach past the head of the current loop
+
+ elsif Nkind (Parent (Stmt)) = N_Loop_Statement then
+ null;
+
+ -- Otherwise use the parent statement
+
+ else
+ Reach_Inside_Blocks := False;
+ Prev := Parent (Stmt);
+ end if;
+ end if;
+
+ -- Skip block statements
+
+ while Nkind (Prev) = N_Block_Statement loop
+
+ -- If a block is reached from statements that follow it, then
+ -- we should reach inside the block to its last contained
+ -- statement.
+
+ if Reach_Inside_Blocks then
+ Prev :=
+ Last (Statements (Handled_Statement_Sequence (Prev)));
+
+ -- If a block is reached from statements and declarations
+ -- inside it, continue with the statements preceding the
+ -- block if any.
+
+ elsif Present (Nlists.Prev (Prev)) then
+ Reach_Inside_Blocks := True;
+ Prev := Nlists.Prev (Prev);
+
+ -- Ignore a handled statement sequence
+
+ elsif
+ Nkind (Parent (Prev)) = N_Handled_Sequence_Of_Statements
+ then
+ Prev := Parent (Parent (Prev));
+
+ -- Do not reach past the head of the current loop
+
+ elsif Nkind (Parent (Prev)) = N_Loop_Statement then
+ Prev := Empty;
+
+ -- Otherwise use the parent statement
+
+ else
+ Prev := Parent (Prev);
+ end if;
+ end loop;
+
+ return Prev;
+ end Prev_In_Loop;
+
-- Local declarations
- Prev : Node_Id;
- Stmt : Node_Id;
+ Prev : Node_Id;
+ Stmt : Node_Id;
+ Orig_Stmt : Node_Id;
+ Within_Same_Sequence : Boolean;
-- Start of processing for Check_Loop_Pragma_Placement
begin
+ -- Check that pragma appears immediately within a loop statement,
+ -- ignoring intervening block statements.
+
Prev := N;
Stmt := Parent (N);
while Present (Stmt) loop
-- Stop the traversal because we reached the innermost loop
-- regardless of whether we encountered an error or not.
- return;
+ exit;
-- Ignore a handled statement sequence. Note that this node may
-- be related to a subprogram body in which case we will emit an
return;
end if;
end loop;
+
+ -- For a Loop_Invariant or Loop_Variant pragma, check that previous
+ -- Loop_Invariant and Loop_Variant pragmas for the same loop appear
+ -- in the same sequence of statements, with only intervening similar
+ -- pragmas.
+
+ if Prag_Id = Pragma_Loop_Invariant
+ or else
+ Prag_Id = Pragma_Loop_Variant
+ then
+ Stmt := Prev_In_Loop (N);
+ Within_Same_Sequence := True;
+
+ while Present (Stmt) loop
+
+ -- The pragma may have been rewritten as a null statement if
+ -- assertions are not enabled, in which case the original node
+ -- should be used.
+
+ Orig_Stmt := Original_Node (Stmt);
+
+ -- Issue an error on a non-consecutive Loop_Invariant or
+ -- Loop_Variant pragma.
+
+ if Nkind (Orig_Stmt) = N_Pragma then
+ declare
+ Stmt_Prag_Id : constant Pragma_Id :=
+ Get_Pragma_Id (Pragma_Name (Orig_Stmt));
+
+ begin
+ if Stmt_Prag_Id = Pragma_Loop_Invariant
+ or else
+ Stmt_Prag_Id = Pragma_Loop_Variant
+ then
+ if List_Containing (Stmt) /= List_Containing (N)
+ or else not Within_Same_Sequence
+ then
+ Error_Msg_Sloc := Sloc (Orig_Stmt);
+ Error_Pragma
+ ("pragma% must appear immediately after pragma#");
+
+ -- Continue searching for previous Loop_Invariant and
+ -- Loop_Variant pragmas even after finding a previous
+ -- correct pragma, so that an error is also issued
+ -- for the current pragma in case there is a previous
+ -- non-consecutive pragma.
+
+ else
+ null;
+ end if;
+
+ -- Mark the end of the consecutive sequence of pragmas
+
+ else
+ Within_Same_Sequence := False;
+ end if;
+ end;
+
+ -- Mark the end of the consecutive sequence of pragmas
+
+ else
+ Within_Same_Sequence := False;
+ end if;
+
+ Stmt := Prev_In_Loop (Stmt);
+ end loop;
+ end if;
end Check_Loop_Pragma_Placement;
-------------------------------------------
with Atree; use Atree;
with Casing; use Casing;
with Csets; use Csets;
+with Debug; use Debug;
with Einfo; use Einfo;
with Err_Vars; use Err_Vars;
with Opt; use Opt;
-- In check if then layout mode (-gnatyi), we expect a THEN keyword
-- to appear either on the same line as the IF, or on a separate line
- -- after multiple conditions. In any case, it may not appear on the
- -- line immediately following the line with the IF.
+ -- if the IF statement extends for more than one line.
procedure Check_Then (If_Loc : Source_Ptr) is
begin
if Style_Check_If_Then_Layout then
- if Get_Physical_Line_Number (Token_Ptr) =
- Get_Physical_Line_Number (If_Loc) + 1
- then
- Error_Msg_SC ("(style) misplaced THEN");
- end if;
+ declare
+ If_Line : constant Physical_Line_Number :=
+ Get_Physical_Line_Number (If_Loc);
+ Then_Line : constant Physical_Line_Number :=
+ Get_Physical_Line_Number (Token_Ptr);
+ begin
+ if If_Line = Then_Line then
+ null;
+ elsif Debug_Flag_Dot_XX
+ and then Token_Ptr /= First_Non_Blank_Location
+ then
+ Error_Msg_SC ("(style) misplaced THEN");
+ end if;
+ end;
end if;
end Check_Then;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- --
-- GNAT 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- --
procedure Check_Then (If_Loc : Source_Ptr);
-- Called to check that THEN and IF keywords are appropriately positioned.
-- The parameters show the first characters of the two keywords. This
- -- procedure is called only if THEN appears at the start of a line with
- -- Token_Ptr pointing to the THEN keyword.
+ -- procedure is called with Token_Ptr pointing to the THEN keyword.
procedure Check_Separate_Stmt_Lines;
pragma Inline (Check_Separate_Stmt_Lines);
Style_Check_If_Then_Layout : Boolean := False;
-- This can be set True by using the -gnatyi switch. If it is True, then a
- -- THEN keyword may not appear on the line that immediately follows the
- -- line containing the corresponding IF.
+ -- THEN keyword must either appear on the same line as the IF, or on a line
+ -- all on its own.
--
-- This permits one of two styles for IF-THEN layout. Either the IF and
-- THEN keywords are on the same line, where the condition is short enough,
-- and then Y < Z
-- then
--
+ -- if X > Y and then Z > 0
+ -- then
+ --
-- are allowed, but
--
-- if X > Y
- -- then
+ -- and then B > C then
--
-- is not allowed.
-- so process the compiler switch.
elsif Command.Name.all = "MAKE"
- or else Command.Name.all = "CHOP" then
+ or else
+ Command.Name.all = "CHOP"
+ then
Sw :=
Matching_Name
(Arg (Arg'First .. SwP),
projects / thirdparty / gcc.git / commitdiff
