mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 10:40:50 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
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

From-SVN: r207893
This commit is contained in:
Arnaud Charlet 2014-02-19 12:12:05 +01:00
parent e7cff5af6f
commit 0b7f0f0e87
26 changed files with 333 additions and 84 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
gcc/ada/ChangeLog
View File

@ -1,3 +1,37 @@
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.

21
gcc/ada/a-cfhama.adb
View File

@ -459,12 +459,13 @@ package body Ada.Containers.Formal_Hashed_Maps is
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;
---------------
@ -858,12 +859,12 @@ package body Ada.Containers.Formal_Hashed_Maps is
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;

5
gcc/ada/a-cfhase.adb
View File

@ -474,8 +474,9 @@ package body Ada.Containers.Formal_Hashed_Sets is
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;

3
gcc/ada/a-cforse.adb
View File

@ -1454,8 +1454,7 @@ package body Ada.Containers.Formal_Ordered_Sets is
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;

10
gcc/ada/a-cofove.adb
View File

@ -1281,8 +1281,9 @@ package body Ada.Containers.Formal_Vectors is
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;
@ -1295,8 +1296,9 @@ package body Ada.Containers.Formal_Vectors is
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;

8
gcc/ada/a-ngcefu.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -541,8 +541,10 @@ package body Ada.Numerics.Generic_Complex_Elementary_Functions is
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;

10
gcc/ada/a-teioed.adb
View File

@ -629,8 +629,9 @@ package body Ada.Text_IO.Editing is
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;
@ -705,8 +706,9 @@ package body Ada.Text_IO.Editing is
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;

10
gcc/ada/a-wtedit.adb
View File

@ -792,8 +792,9 @@ package body Ada.Wide_Text_IO.Editing is
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;
@ -860,8 +861,9 @@ package body Ada.Wide_Text_IO.Editing is
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;

10
gcc/ada/a-ztedit.adb
View File

@ -793,8 +793,9 @@ package body Ada.Wide_Wide_Text_IO.Editing is
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;
@ -861,8 +862,9 @@ package body Ada.Wide_Wide_Text_IO.Editing is
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;

6
gcc/ada/debug.adb
View File

@ -141,7 +141,7 @@ package body Debug is
-- 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
@ -664,6 +664,10 @@ package body Debug is
-- 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

3
gcc/ada/exp_ch5.adb
View File

@ -1933,7 +1933,8 @@ package body Exp_Ch5 is
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.

18
gcc/ada/gnat_rm.texi
View File

@ -4348,11 +4348,17 @@ except that in an @code{Assertion_Policy} pragma, the identifier
(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}
@ -4420,8 +4426,10 @@ CHANGE_DIRECTION ::= Increases | Decreases
@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.
@ -4446,6 +4454,10 @@ to ignore the check (in which case the pragma has no effect on the program),
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.

3
gcc/ada/gnat_ugn.texi
View File

@ -6353,8 +6353,7 @@ source tokens.
@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.}

5
gcc/ada/inline.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -1160,7 +1160,8 @@ package body Inline is
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;

5
gcc/ada/par-ch5.adb
View File

@ -1103,8 +1103,7 @@ package body Ch5 is
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
@ -1142,7 +1141,7 @@ package body Ch5 is
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

29
gcc/ada/par-ch6.adb
View File

@ -1828,9 +1828,9 @@ package body Ch6 is
-- 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 --
@ -1855,8 +1855,9 @@ package body Ch6 is
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
@ -1868,7 +1869,7 @@ package body Ch6 is
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
@ -1880,10 +1881,10 @@ package body Ch6 is
-- 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):
@ -1895,19 +1896,19 @@ package body Ch6 is
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???
@ -1917,7 +1918,7 @@ package body Ch6 is
TF_Semicolon;
end if;
return Return_Node;
return Ret_Node;
end P_Return_Statement;
end Ch6;

2
gcc/ada/par.adb
View File

@ -467,7 +467,7 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is
-- 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

5
gcc/ada/prj-pp.adb
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -280,7 +280,8 @@ package body Prj.PP is
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;

4
gcc/ada/prj-tree.adb
View File

@ -1679,13 +1679,15 @@ package body Prj.Tree is
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,

3
gcc/ada/sem_ch12.adb
View File

@ -10638,8 +10638,7 @@ package body Sem_Ch12 is
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);

3
gcc/ada/sem_ch8.adb
View File

@ -4587,7 +4587,8 @@ package body Sem_Ch8 is
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);

179
gcc/ada/sem_prag.adb
View File

@ -3104,7 +3104,9 @@ package body Sem_Prag is
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
@ -4580,6 +4582,11 @@ package body Sem_Prag is
-- 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 --
---------------------
@ -4605,14 +4612,111 @@ package body Sem_Prag is
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
@ -4649,7 +4753,7 @@ package body Sem_Prag is
-- 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
@ -4666,6 +4770,73 @@ package body Sem_Prag is
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;
-------------------------------------------

23
gcc/ada/styleg.adb
View File

@ -30,6 +30,7 @@
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;
@ -1005,17 +1006,25 @@ package body Styleg is
-- 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;

5
gcc/ada/styleg.ads
View File

@ -6,7 +6,7 @@
-- --
-- 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- --
@ -134,8 +134,7 @@ package Styleg is
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);

9
gcc/ada/stylesw.ads
View File

@ -127,8 +127,8 @@ package Stylesw is
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,
@ -141,10 +141,13 @@ package Stylesw is
-- 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.

4
gcc/ada/vms_conv.adb
View File

@ -1784,7 +1784,9 @@ package body VMS_Conv is
-- 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),