[Ada] Style check for mixed-case identifiers

--- gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -4690,6 +4690,16 @@  checks to be performed. The following checks are defined:
   allowed).
 
 
+.. index:: -gnatyD (gcc)
+
+:switch:`-gnatyD`
+  *Check declared identifiers in mixed case.*
+
+  Declared identifiers must be in mixed case, as in
+  This_Is_An_Identifier. Use -gnatyr in addition to ensure
+  that references match declarations.
+
+
 .. index:: -gnatye (gcc)
 
 :switch:`-gnatye`

--- gcc/ada/gnat_ugn.texi
+++ gcc/ada/gnat_ugn.texi
@@ -13515,6 +13515,20 @@  character (in particular the DOS line terminator sequence CR/LF is not
 allowed).
 @end table
 
+@geindex -gnatyD (gcc)
+
+
+@table @asis
+
+@item @code{-gnatyD}
+
+@emph{Check declared identifiers in mixed case.}
+
+Declared identifiers must be in mixed case, as in
+This_Is_An_Identifier. Use -gnatyr in addition to ensure
+that references match declarations.
+@end table
+
 @geindex -gnatye (gcc)
 
 

--- gcc/ada/par-ch3.adb
+++ gcc/ada/par-ch3.adb
@@ -228,8 +228,12 @@  package body Ch3 is
          raise Error_Resync;
       end if;
 
+      if Style_Check then
+         Style.Check_Defining_Identifier_Casing;
+      end if;
+
       Ident_Node := Token_Node;
-      Scan; -- past the reserved identifier
+      Scan; -- past the identifier
 
       --  If we already have a defining identifier, clean it out and make
       --  a new clean identifier. This situation arises in some error cases

--- gcc/ada/style.ads
+++ gcc/ada/style.ads
@@ -125,6 +125,9 @@  package Style is
    --  Called with Scan_Ptr pointing to the first minus sign of a comment.
    --  Intended for checking any specific rules for comment placement/format.
 
+   procedure Check_Defining_Identifier_Casing
+     renames Style_Inst.Check_Defining_Identifier_Casing;
+
    procedure Check_Dot_Dot
      renames Style_Inst.Check_Dot_Dot;
    --  Called after scanning out dot dot to check spacing
@@ -219,4 +222,5 @@  package Style is
    --  lower case letters. On entry Token_Ptr points to the keyword token.
    --  This is not used for keywords appearing as attribute designators,
    --  where instead Check_Attribute_Name (True) is called.
+
 end Style;

--- gcc/ada/styleg.adb
+++ gcc/ada/styleg.adb
@@ -610,6 +610,27 @@  package body Styleg is
       end if;
    end Check_Comment;
 
+   --------------------------------------
+   -- Check_Defining_Identifier_Casing --
+   --------------------------------------
+
+   procedure Check_Defining_Identifier_Casing is
+   begin
+      if Style_Check_Mixed_Case_Decls then
+         case Determine_Token_Casing is
+            when All_Upper_Case | All_Lower_Case =>
+               Error_Msg_SC -- CODEFIX
+                 ("(style) bad capitalization, mixed case required");
+
+            --  The Unknown case is something like A_B_C, which is both all
+            --  caps and mixed case.
+
+            when Mixed_Case | Unknown =>
+               null; -- OK
+         end case;
+      end if;
+   end Check_Defining_Identifier_Casing;
+
    -------------------
    -- Check_Dot_Dot --
    -------------------

--- gcc/ada/styleg.ads
+++ gcc/ada/styleg.ads
@@ -91,6 +91,11 @@  package Styleg is
    --  Called with Scan_Ptr pointing to the first minus sign of a comment.
    --  Intended for checking any specific rules for comment placement/format.
 
+   procedure Check_Defining_Identifier_Casing;
+   --  The current token is an identifier that will be a defining
+   --  identifier. Check that it is mixed case, if the appropriate
+   --  switch is set.
+
    procedure Check_Dot_Dot;
    --  Called after scanning out dot dot to check spacing
 

--- gcc/ada/stylesw.adb
+++ gcc/ada/stylesw.adb
@@ -79,6 +79,7 @@  package body Stylesw is
       Style_Check_Boolean_And_Or        := False;
       Style_Check_Comments              := False;
       Style_Check_DOS_Line_Terminator   := False;
+      Style_Check_Mixed_Case_Decls      := False;
       Style_Check_End_Labels            := False;
       Style_Check_Form_Feeds            := False;
       Style_Check_Horizontal_Tabs       := False;
@@ -168,6 +169,7 @@  package body Stylesw is
       end if;
 
       Add ('d', Style_Check_DOS_Line_Terminator);
+      Add ('D', Style_Check_Mixed_Case_Decls);
       Add ('e', Style_Check_End_Labels);
       Add ('f', Style_Check_Form_Feeds);
       Add ('h', Style_Check_Horizontal_Tabs);
@@ -336,6 +338,9 @@  package body Stylesw is
             when 'd' =>
                Style_Check_DOS_Line_Terminator   := True;
 
+            when 'D' =>
+               Style_Check_Mixed_Case_Decls      := True;
+
             when 'e' =>
                Style_Check_End_Labels            := True;
 
@@ -503,6 +508,9 @@  package body Stylesw is
             when 'd' =>
                Style_Check_DOS_Line_Terminator   := False;
 
+            when 'D' =>
+               Style_Check_Mixed_Case_Decls      := False;
+
             when 'e' =>
                Style_Check_End_Labels            := False;
 

--- gcc/ada/stylesw.ads
+++ gcc/ada/stylesw.ads
@@ -113,6 +113,10 @@  package Stylesw is
    --  the line terminator must be a single LF, without an associated CR (e.g.
    --  DOS line terminator sequence CR/LF not allowed).
 
+   Style_Check_Mixed_Case_Decls : Boolean := False;
+   --  This can be set True by using the -gnatyD switch. If it is True, then
+   --  declared identifiers must be in Mixed_Case.
+
    Style_Check_End_Labels : Boolean := False;
    --  This can be set True by using the -gnatye switch. If it is True, then
    --  optional END labels must always be present.