summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2004-11-19 10:56:53 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2004-11-19 10:56:53 +0000
commit25ba8eb38bbbc147d86796ff8db54c44252709f7 (patch)
treebd2bdeb5f19ff29203c41b2c8b4fd854bcaa43aa
parent5245b786fc5507b712ad9dd5fc461962d269f78d (diff)
downloadgcc-25ba8eb38bbbc147d86796ff8db54c44252709f7.tar.gz
* errout.ads, errout.adb: (First_Sloc): New function
* par-ch5.adb (P_Condition): Check for redundant parens is now a style check (-gnatyx) instead of being included as a redundant construct warning. * sem_ch6.adb: Change name Style_Check_Subprogram_Order to Style_Check_Order_Subprograms. * style.ads, styleg.ads, styleg.adb, styleg-c.adb, stylesw.ads, stylesw.adb: Add Style_Check_Xtra_Parens * usage.adb: Add line for -gnatyx (check extra parens) * vms_data.ads: Add entry for STYLE_CHECKS=XTRA_PARENS => -gnatyx git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@90905 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/ada/errout.adb98
-rw-r--r--gcc/ada/errout.ads6
-rw-r--r--gcc/ada/par-ch5.adb4
-rw-r--r--gcc/ada/sem_ch6.adb2
-rw-r--r--gcc/ada/style.ads5
-rw-r--r--gcc/ada/styleg-c.adb4
-rw-r--r--gcc/ada/styleg.adb15
-rw-r--r--gcc/ada/styleg.ads6
-rw-r--r--gcc/ada/stylesw.ads13
-rw-r--r--gcc/ada/usage.adb1
-rw-r--r--gcc/ada/vms_data.ads4
11 files changed, 100 insertions, 58 deletions
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index ed5ad56745e..9751d2a2ceb 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -601,52 +601,8 @@ package body Errout is
-----------------
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;
------------------
@@ -1390,6 +1346,58 @@ package body Errout is
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 --
diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads
index 5bf33115cdc..ffc44bd19b1 100644
--- a/gcc/ada/errout.ads
+++ b/gcc/ada/errout.ads
@@ -584,6 +584,12 @@ package Errout is
-- 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
diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb
index 71324884f77..6293ad6ba6b 100644
--- a/gcc/ada/par-ch5.adb
+++ b/gcc/ada/par-ch5.adb
@@ -1268,10 +1268,10 @@ package body Ch5 is
-- 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
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 4b5d95153b6..58d7e53cb22 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2978,7 +2978,7 @@ package body Sem_Ch6 is
-- 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)
diff --git a/gcc/ada/style.ads b/gcc/ada/style.ads
index ac2d6296938..c7a46ed3e3b 100644
--- a/gcc/ada/style.ads
+++ b/gcc/ada/style.ads
@@ -169,6 +169,11 @@ package Style is
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.
diff --git a/gcc/ada/styleg-c.adb b/gcc/ada/styleg-c.adb
index 99e3f09c7b9..bc1a13bc447 100644
--- a/gcc/ada/styleg-c.adb
+++ b/gcc/ada/styleg-c.adb
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -217,7 +217,7 @@ package body Styleg.C is
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;
diff --git a/gcc/ada/styleg.adb b/gcc/ada/styleg.adb
index e382daffd78..91c807b1a07 100644
--- a/gcc/ada/styleg.adb
+++ b/gcc/ada/styleg.adb
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -28,7 +28,7 @@
-- 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;
@@ -667,6 +667,17 @@ package body Styleg is
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 --
----------------------------
diff --git a/gcc/ada/styleg.ads b/gcc/ada/styleg.ads
index 7f4e22b8b2d..bf5b1e144cd 100644
--- a/gcc/ada/styleg.ads
+++ b/gcc/ada/styleg.ads
@@ -6,7 +6,7 @@
-- --
-- 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- --
@@ -132,6 +132,10 @@ package Styleg is
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
diff --git a/gcc/ada/stylesw.ads b/gcc/ada/stylesw.ads
index 435b31b038a..d3c46def539 100644
--- a/gcc/ada/stylesw.ads
+++ b/gcc/ada/stylesw.ads
@@ -145,6 +145,11 @@ package Stylesw is
-- 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.
@@ -216,10 +221,10 @@ package Stylesw is
-- 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
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index 3e5d0b818e9..44d8df730e7 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -445,6 +445,7 @@ begin
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
diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads
index 256aadcd96b..12b6734f573 100644
--- a/gcc/ada/vms_data.ads
+++ b/gcc/ada/vms_data.ads
@@ -1815,7 +1815,9 @@ package VMS_Data is
"SPECS " &
"-gnatys " &
"TOKEN " &
- "-gnatyt ";
+ "-gnatyt " &
+ "XTRA_PARENS " &
+ "-gnatyx ";
-- /NOSTYLE_CHECKS (D)
-- /STYLE_CHECKS[=(keyword,[...])]
--