errout.ads, errout.adb: (First_Sloc): New function

	* 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

From-SVN: r90905

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

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

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

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)

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.

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;

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

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

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

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
 

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,[...])]
    --