-----------------
procedure Error_Msg_F (Msg : String; N : Node_Id) is
- SI : constant Source_File_Index := Source_Index (Get_Source_Unit (N));
- SF : constant Source_Ptr := Source_First (SI);
- F : Node_Id;
- S : Source_Ptr;
-
begin
- F := First_Node (N);
- S := Sloc (F);
-
- -- The following circuit is a bit subtle. When we have parenthesized
- -- expressions, then the Sloc will not record the location of the
- -- paren, but we would like to post the flag on the paren. So what
- -- we do is to crawl up the tree from the First_Node, adjusting the
- -- Sloc value for any parentheses we know are present. Yes, we know
- -- this circuit is not 100% reliable (e.g. because we don't record
- -- all possible paren level valoues), but this is only for an error
- -- message so it is good enough.
-
- Node_Loop : loop
- Paren_Loop : for J in 1 .. Paren_Count (F) loop
-
- -- We don't look more than 12 characters behind the current
- -- location, and in any case not past the front of the source.
-
- Search_Loop : for K in 1 .. 12 loop
- exit Search_Loop when S = SF;
-
- if Source_Text (SI) (S - 1) = '(' then
- S := S - 1;
- exit Search_Loop;
-
- elsif Source_Text (SI) (S - 1) <= ' ' then
- S := S - 1;
-
- else
- exit Search_Loop;
- end if;
- end loop Search_Loop;
- end loop Paren_Loop;
-
- exit Node_Loop when F = N;
- F := Parent (F);
- exit Node_Loop when Nkind (F) not in N_Subexpr;
- end loop Node_Loop;
-
- Error_Msg_NEL (Msg, N, N, S);
+ Error_Msg_NEL (Msg, N, N, First_Sloc (N));
end Error_Msg_F;
------------------
return Earliest;
end First_Node;
+ ----------------
+ -- First_Sloc --
+ ----------------
+
+ function First_Sloc (N : Node_Id) return Source_Ptr is
+ SI : constant Source_File_Index := Source_Index (Get_Source_Unit (N));
+ SF : constant Source_Ptr := Source_First (SI);
+ F : Node_Id;
+ S : Source_Ptr;
+
+ begin
+ F := First_Node (N);
+ S := Sloc (F);
+
+ -- The following circuit is a bit subtle. When we have parenthesized
+ -- expressions, then the Sloc will not record the location of the
+ -- paren, but we would like to post the flag on the paren. So what
+ -- we do is to crawl up the tree from the First_Node, adjusting the
+ -- Sloc value for any parentheses we know are present. Yes, we know
+ -- this circuit is not 100% reliable (e.g. because we don't record
+ -- all possible paren level valoues), but this is only for an error
+ -- message so it is good enough.
+
+ Node_Loop : loop
+ Paren_Loop : for J in 1 .. Paren_Count (F) loop
+
+ -- We don't look more than 12 characters behind the current
+ -- location, and in any case not past the front of the source.
+
+ Search_Loop : for K in 1 .. 12 loop
+ exit Search_Loop when S = SF;
+
+ if Source_Text (SI) (S - 1) = '(' then
+ S := S - 1;
+ exit Search_Loop;
+
+ elsif Source_Text (SI) (S - 1) <= ' ' then
+ S := S - 1;
+
+ else
+ exit Search_Loop;
+ end if;
+ end loop Search_Loop;
+ end loop Paren_Loop;
+
+ exit Node_Loop when F = N;
+ F := Parent (F);
+ exit Node_Loop when Nkind (F) not in N_Subexpr;
+ end loop Node_Loop;
+
+ return S;
+ end First_Sloc;
----------------
-- Initialize --
-- Given a construct C, finds the first node in the construct, i.e. the
-- one with the lowest Sloc value. This is useful in placing error msgs.
+ function First_Sloc (N : Node_Id) return Source_Ptr;
+ -- Given the node for an expression, return a source pointer value that
+ -- points to the start of the first token in the expression. In the case
+ -- where the expression is parenthesized, an attempt is made to include
+ -- the parentheses (i.e. to return the location of the initial paren).
+
procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr)
renames Erroutc.Purge_Messages;
-- All error messages whose location is in the range From .. To (not
-- Otherwise check for redundant parens
else
- if Warn_On_Redundant_Constructs
+ if Style_Check
and then Paren_Count (Cond) > 0
then
- Error_Msg_F ("redundant parentheses?", Cond);
+ Style.Check_Xtra_Parens (First_Sloc (Cond));
end if;
-- And return the result
-- Check body in alpha order if this is option
if Style_Check
- and then Style_Check_Subprogram_Order
+ and then Style_Check_Order_Subprograms
and then Nkind (N) = N_Subprogram_Body
and then Comes_From_Source (N)
and then In_Extended_Main_Source_Unit (N)
renames Style_Inst.Check_Vertical_Bar;
-- Called after scanning a vertical bar to check spacing
+ procedure Check_Xtra_Parens (Loc : Source_Ptr)
+ renames Style_Inst.Check_Xtra_Parens;
+ -- Called after scanning a conditional expression that has at least one
+ -- level of parentheses around the entire expression.
+
procedure No_End_Name (Name : Node_Id)
renames Style_Inst.No_End_Name;
-- Called if an END is encountered where a name is allowed but not present.
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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 Subprogram_Not_In_Alpha_Order (Name : Node_Id) is
begin
- if Style_Check_Subprogram_Order then
+ if Style_Check_Order_Subprograms then
Error_Msg_N
("(style) subprogram body& not in alphabetical order", Name);
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
-- checking rules. For documentation of these rules, see comments on the
-- individual procedures.
-with Casing; use Casing;
+with Casing; use Casing;
with Csets; use Csets;
with Err_Vars; use Err_Vars;
with Opt; use Opt;
end if;
end Check_Vertical_Bar;
+ -----------------------
+ -- Check_Xtra_Parens --
+ -----------------------
+
+ procedure Check_Xtra_Parens (Loc : Source_Ptr) is
+ begin
+ if Style_Check_Xtra_Parens then
+ Error_Msg ("redundant parentheses?", Loc);
+ end if;
+ end Check_Xtra_Parens;
+
----------------------------
-- Determine_Token_Casing --
----------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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_Vertical_Bar;
-- Called after scanning a vertical bar to check spacing
+ procedure Check_Xtra_Parens (Loc : Source_Ptr);
+ -- Called after scanning a conditional expression that has at least one
+ -- level of parentheses around the entire expression.
+
procedure No_End_Name (Name : Node_Id);
-- Called if an END is encountered where a name is allowed but not present.
-- The parameter is the node whose name is the name that is permitted in
-- zero (a value of zero resets it to False). If True, it activates
-- checking the maximum nesting level against Style_Max_Nesting_Level.
+ Style_Check_Order_Subprograms : Boolean := False;
+ -- This can be set True by using the -gnatg or -gnatyo switch. If it
+ -- is True, then names of subprogram bodies must be in alphabetical
+ -- order (not taking casing into account).
+
Style_Check_Pragma_Casing : Boolean := False;
-- This can be set True by using the -gnatg or -gnatyp switches. If
-- it is True, then pragma names must use mixed case.
-- where horizontal tabs are permitted, a horizontal tab is acceptable
-- for meeting the requirement for a space.
- Style_Check_Subprogram_Order : Boolean := False;
- -- This can be set True by using the -gnatg or -gnatyo switch. If it
- -- is True, then names of subprogram bodies must be in alphabetical
- -- order (not taking casing into account).
+ Style_Check_Xtra_Parens : Boolean := False;
+ -- This can be set True by using the -gnatg or -gnatyx switch. If true,
+ -- then it is not allowed to enclose entire conditional expressions
+ -- in parentheses (C style).
Style_Max_Line_Length : Int := 0;
-- Value used to check maximum line length. Gets reset as a result of
Write_Line (" r check casing for identifier references");
Write_Line (" s check separate subprogram specs present");
Write_Line (" t check token separation rules");
+ Write_Line (" x check extra parens around conditionals");
-- Lines for -gnatyN switch
"SPECS " &
"-gnatys " &
"TOKEN " &
- "-gnatyt ";
+ "-gnatyt " &
+ "XTRA_PARENS " &
+ "-gnatyx ";
-- /NOSTYLE_CHECKS (D)
-- /STYLE_CHECKS[=(keyword,[...])]
--
projects / gcc.git / commitdiff