------------------------------------------------------------------------------
--                                                                          --
--                          GNATCHECK COMPONENTS                            --
--                                                                          --
--                   G N A T C H E C K . C O M P I L E R                    --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2005-2007, AdaCore                     --
--                                                                          --
-- GNATCHECK  is  free  software;  you can redistribute it and/or modify it --
-- under terms of the  GNU  General Public License as published by the Free --
-- Software Foundation;  either version 2, or ( at your option)  any  later --
-- version.  GNATCHECK  is  distributed in the hope that it will be useful, --
-- but  WITHOUT  ANY  WARRANTY;   without  even  the  implied  warranty  of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General --
-- Public License for more details.  You should have received a copy of the --
-- GNU  General Public License distributed with GNAT; see file  COPYING. If --
-- not,  write to the  Free Software Foundation,  51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.                                       --
--                                                                          --
-- GNATCHECK is maintained by AdaCore (http://www.adacore.com).             --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Strings;             use Ada.Strings;
with Ada.Strings.Fixed;       use Ada.Strings.Fixed;
with Ada.Text_IO;             use Ada.Text_IO;

with System.Restrictions;     use System.Restrictions;

with ASIS_UL.Common;          use ASIS_UL.Common;
with ASIS_UL.Output;          use ASIS_UL.Output;
with ASIS_UL.Source_Table;    use ASIS_UL.Source_Table;
with ASIS_UL.Strings;         use ASIS_UL.Strings;

with Gnatcheck.Diagnoses;     use Gnatcheck.Diagnoses;
with Gnatcheck.Output;        use Gnatcheck.Output;

package body Gnatcheck.Compiler is

   subtype Option_Parameter is Natural;

   OFF : constant Option_Parameter := 0;
   ON  : constant Option_Parameter := 1;
   --  Flag indicating if the given option is ON or OFF. We can not use Boolean
   --  flags, because some style options and restrictions have additional
   --  numeric parameter

   ----------------------------------------------------
   -- Data structures and routines for style options --
   ----------------------------------------------------

   type Style_Option_Type is
     (Ident_Level, --  `'1-9'
      'a',
      'b',
      'c',
      'e',
      'f',
      'h',
      'i',
      'k',
      'l',
      'L',  --  `Lnnn'
      'm',
      'M',  -- `Mnnn'
      'n',
      'o',
      'p',
      'r',
      's',
      't',
      'x');

   type Style_Options_Array is array (Style_Option_Type) of Option_Parameter;

   Style_Options        : Style_Options_Array := (others => OFF);
   Style_Options_Backup : Style_Options_Array;

   Style_To_Character : constant array (Style_Option_Type) of Character :=
     (ASCII.NUL,
      'a',
      'b',
      'c',
      'e',
      'f',
      'h',
      'i',
      'k',
      'l',
      'L',  --  `Lnnn'
      'm',
      'M',  -- `Mnnn'
      'n',
      'o',
      'p',
      'r',
      's',
      't',
      'x');

   procedure Process_Style_Options (Opts : String; Success : out Boolean);
   --  Parses the parameter treating it as a parameter(s) of -gnatw option and
   --  fills Style_Options. Success is set OFF is any problem is detected
   --  during parameter parsing, in this case the setting of -gnaty options
   --  is not changed as a result of the call to this routine

   function To_Style_Option_Type (Ch : Character) return Style_Option_Type;
   --  Converts character literals into corresponding values of
   --  Style_Option_Type.

   ------------------------------------------------------
   -- Data structures and routines for warning options --
   ------------------------------------------------------

   type Warning_Option_Type is
     (Not_A_Warning_Option,  --  unknown option

      --  Individual checks that can be ON or OFF)
      'a',
      'c',
      'd',
      'f',
      'g',
      'h',
      'i',
      'j',
      'k',
      'l',
      'm',
      'o',
      'p',
      'r',
      'u',
      'v',
      'x',
      'z',
      --  General-purpose warning switches
      'e',
      'n',
      's');

   subtype Valid_Warning_Options     is Warning_Option_Type range 'a' .. 's';
   subtype Warning_Individual_Checks is Warning_Option_Type range 'a' .. 'z';
   subtype Warning_General_Options   is Warning_Option_Type range 'e' .. 's';

   type Warning_Options_Array is array (Valid_Warning_Options) of Boolean;
   --  For warning options we can use boolean array, because we do not
   --  have an additional numeric parameter for any warning control option

   Warning_Options : Warning_Options_Array :=
     (Warning_Individual_Checks => False,
     'e'                        => False,
     'n'                        => True,
     's'                        => False);
   --  That is, the initial state is that we turn warnings ON by -gnatwn,
   --  but we turn OFF all the specific kinds of warnings.

   Warning_Options_Backup : Warning_Options_Array;

   type Warning_Option_Value is record
      Opt : Warning_Option_Type;
      Val : Boolean;
   end record;
   --  This is a result of analyzing the parameter of -gnatw option

   function To_Warning_Option_Value
     (Ch :   Character)
      return Warning_Option_Value;
   --  Analyzes a character that is treated as a parameter of -gnatw option
   --  and returns the corresponding setting of the corresponding option.
   --  (for example, returns ('a', True) for 'a' and ('a', False) for 'A')
   --  If the argument can not be a parameter of -gnatw option, returns
   --  (Not_A_Warning_Option, ...)

   function To_Lower_Warning_Option
     (Opt  : Valid_Warning_Options)
      return Character;
   function To_Upper_Warning_Option
     (Opt  : Warning_Individual_Checks)
      return Character;
   --  These two functions convert the argument into the corresponding
   --  character value.

   procedure Process_Warning_Options (Opts : String; Success : out Boolean);
   --  Parses the parameter treating it as a parameter(s) of -gnatw option and
   --  fills Warning_Options array.

   procedure Set_All_Indivitual_Checks (Val : Boolean);
   --  Sets all the individual checks ON or OFF depending on Val

   ---------------------------------------------------------
   -- Data structures and routines for restriction checks --
   ---------------------------------------------------------

   use Rident;

   type Restriction_State is record
      Active : Boolean;
      Param  : Option_Parameter;
   end record;
   --  We can not use Option_Parameter here, because some restructions (e.g.
   --  Max_Task_Entries) may be active and may have zero parameter

   Restriction_Setting : array (All_Restrictions) of Restriction_State :=
     (others => (False, OFF));

   -------------------------------
   -- Analyze_Compiler_Warnings --
   -------------------------------

   procedure Analyze_Compiler_Warnings (Compiler_Out : Temp_File_Name) is
      Next_Line     : String (1 .. 1024);
      Line_Len      : Positive;
      Comp_Out_File : File_Type;

      procedure Analyze_Warning (Msg : String);
      --  Ananlyses one line containing the compiler warning. Inserts the
      --  warning messages into gnatcheck diagnoses table.

      procedure Analyze_Warning (Msg : String) is
         SF       : SF_Id;
         Line_Num : Natural;
         Col_Num  : Natural;
         --  Coordinates of the warning message

         Diag     : String_Loc;
         --  We store the whole warning message generated by the compiler as is
         --  This would result in some considerable duplications, but what
         --  would be better approach here ???

         Compiler_Message_Kind : Compiler_Message_Kinds :=
           Not_A_Compiler_Nessage;

         Idx      :          Positive := Msg'First;
         Last_Idx : constant Positive := Msg'Last;
         Word_End :          Positive;
      begin
         --  We assume the following compiler warning fromat:
         --
         --   file_name:line_num:column_num: message
         --
         --  What about instantiation chains????

         for J in Idx .. Last_Idx loop
            if Msg (J) = ':' then
               Word_End := J - 1;
               exit;
            end if;
         end loop;

         SF := File_Find (Msg (Idx .. Word_End), Use_Short_Name => True);

         if not Present (SF) then
            --  This source is not an argument of this check
            return;
         end if;

         Idx := Word_End + 2;
         Line_Num := 0;

         while Msg (Idx) /= ':' loop
            Line_Num :=
              Line_Num * 10 +
                (Character'Pos (Msg (Idx)) - Character'Pos ('0'));
            Idx := Idx + 1;
         end loop;

         Idx := Idx + 1;

         Col_Num := 0;

         while Msg (Idx) /= ':' loop
            Col_Num :=
              Col_Num * 10 + (Character'Pos (Msg (Idx)) - Character'Pos ('0'));
            Idx := Idx + 1;
         end loop;

         Idx := Idx + 2;
         --  Now Idx should point to the first character of the warning message

         case Msg (Idx) is
            when  '(' =>
               --  (style)
               Compiler_Message_Kind := Style;
            when  'w' =>
               --  warning, plain warning or restriction warning?
               Compiler_Message_Kind := General_Warning;

               if Idx + 9 < Last_Idx
                 and then
                  Msg (Idx + 7 .. Idx + 9) = ": v"
               then
                  Compiler_Message_Kind := Restriction;
               end if;

            when  others =>
               null;
               pragma Assert (False);
         end case;

         Diag := Enter_String (Msg (Idx .. Last_Idx));

         Store_Compiler_Message
           (In_SF        => SF,
            Line_Num     => Line_Num,
            Col_Num      => Col_Num,
            Message      => Diag,
            Message_Kind => Compiler_Message_Kind);

      end Analyze_Warning;

   begin
      Open (File => Comp_Out_File,
            Mode => In_File,
            Name => Compiler_Out);

      while not End_Of_File (Comp_Out_File) loop
         Get_Line (Comp_Out_File, Next_Line, Line_Len);
         Analyze_Warning (Next_Line (1 .. Line_Len));
      end loop;

      Close (Comp_Out_File);
   exception
      when Ex : others =>
         Error
           ("unknown bug detected when analyzing compiler warnings");
         Error_No_Tool_Name
           ("Please submit bug report to report@gnat.com");
         Report_Unhandled_Exception (Ex);
         raise Fatal_Error;
   end Analyze_Compiler_Warnings;

   function Compiler_Out_File_Name_String return String is
   begin

      if Analyze_Compiler_Output then
         return Compiler_Out_File_Name;
      else
         return "";
      end if;

   end Compiler_Out_File_Name_String;

   -------------------------------------
   -- Create_Restriction_Pragmas_File --
   -------------------------------------

   procedure Create_Restriction_Pragmas_File is
      RPF : File_Type;
   begin
      Create (File => RPF,
              Mode => Out_File,
              Name => Restriction_Config_File);

      for R in All_Restrictions loop

         if Restriction_Setting (R).Active then
            Put (RPF, "pragma Restriction_Warnings (");
            Put (RPF, R'Img);

            if R not in All_Boolean_Restrictions then
               Put (RPF, " =>"  & Restriction_Setting (R).Param'Img);
            end if;

            Put (RPF, ");");

            New_Line (RPF);

         end if;

      end loop;

      Close (RPF);
   end Create_Restriction_Pragmas_File;

   ----------------------
   -- Get_Style_Option --
   ----------------------

   function Get_Style_Option return String is
      Result     : String (1 .. Style_Options'Length + 12);
      Result_Len : Positive := 1;
      Val_Image  : String (1 .. 3);
      Val_Idx    : Positive;
      Tmp        : Option_Parameter;
   begin
      Result (1 .. 6) := "-gnaty";
      Result_Len := 6;

      for J in Style_Options'Range loop

         if Style_Options (J) /= OFF then

            case J is
               when Ident_Level =>
                  Result_Len := Result_Len + 1;
                  Result (Result_Len) :=
                    Character'Val (Character'Pos ('0') + Style_Options (J));

               when 'L' | 'M'  =>

                  Tmp     := Style_Options (J);
                  Val_Idx := Val_Image'Last + 1;

                  while Tmp /= 0 loop
                     Val_Idx := Val_Idx - 1;
                     Val_Image (Val_Idx) :=
                       Character'Val (Character'Pos ('0') +  Tmp rem 10);
                     Tmp := Tmp / 10;
                  end loop;

                  Result_Len := Result_Len + 1;
                  Result (Result_Len) := Style_To_Character (J);

                  Result_Len := Result_Len + (Val_Image'Last - Val_Idx + 1);
                  Result
                   (Result_Len - (Val_Image'Last - Val_Idx) .. Result_Len) :=
                    Val_Image (Val_Idx .. Val_Image'Last);

               when others =>
                  Result_Len := Result_Len + 1;
                  Result (Result_Len) := Style_To_Character (J);
            end case;

         end if;

      end loop;

      return Result (1 .. Result_Len);
   end Get_Style_Option;

   ------------------------
   -- Get_Warning_Option --
   ------------------------

   function Get_Warning_Option return String is
      Result     : String (1 .. Warning_Options'Length + 4);
      --  "+ 4" means "+ 6" for "-gnatw" and then "- 2" because only one
      --  of the 'e', 'n' or 's' parameters may be set.

      Idx : Positive := 6;
   begin
      Result (1 .. 6) := "-gnatw";

      for J in Warning_Individual_Checks loop
         Idx := Idx + 1;

         if Warning_Options (J) then
            Result (Idx) := To_Lower_Warning_Option (J);
         else
            Result (Idx) := To_Upper_Warning_Option (J);
         end if;

      end loop;

      for J in Warning_General_Options loop
         if Warning_Options (J) then
            Idx := Idx + 1;
            Result (Idx) := To_Lower_Warning_Option (J);
         end if;
      end loop;

      return Result;
   end Get_Warning_Option;

   -------------------------------
   -- Print_Active_Restrictions --
   -------------------------------

   procedure Print_Active_Restrictions (Ident_Level : Natural := 0) is
   begin

      for R in Restriction_Setting'Range loop

         if Restriction_Setting (R).Active then
            Report_No_EOL (R'Img, Ident_Level);

            if R not in All_Boolean_Restrictions then
               Report (" =>"  & Restriction_Setting (R).Param'Img);
            else
               Report_EOL;
            end if;

         end if;

      end loop;

   end Print_Active_Restrictions;

   -------------------------------
   -- Process_Restriction_Param --
   -------------------------------

   procedure Process_Restriction_Param
     (Param  : String;
      Enable : Boolean)
   is
      First_Idx          : Natural := Param'First;
      Last_Idx           : Natural := Param'Last;
      Expression_Present : Boolean := False;
      R_Id               : Restriction_Id;
      R_Val              : Option_Parameter;
   begin
      --  Param should have the format
      --
      --    restriction_parameter_identifier[ => expression]
      --
      --  Just in case, let's assume that it can be spaces around '=>'

      --  First, try to define the restriction name. We assume that the
      --  parameter. Skiping spaces, if any - just in case:

      for J in  First_Idx .. Last_Idx loop

         if Param (J) /= ' ' then
            First_Idx := J;
            exit;
         end if;

      end loop;

      for J in First_Idx + 1 .. Last_Idx loop

         if Param (J) = ' '
            or else Param (J) = '='
         then
            Last_Idx := J - 1;
            exit;
         end if;

      end loop;

      begin
         R_Id := Restriction_Id'Value (Param (First_Idx .. Last_Idx));
      exception
         when Constraint_Error =>
            R_Id := Not_A_Restriction_Id;
      end;

      if R_Id = Not_A_Restriction_Id then
         Error ("wrong restriction identifier : " &
                 Param (First_Idx .. Last_Idx) & ", ignored");
         return;
      end if;

      --  Check if we have an expression, and if we have, set First_Idx to the
      --  first character after '=>'

      for J in Last_Idx + 1 .. Param'Last - 3 loop

         if Param (J) = '=' then

            if J <= Param'Last - 2
               and then Param (J + 1) = '>'
            then
               Expression_Present := True;
               Last_Idx := J + 2;
               exit;
            else
               Error ("wrong structure of restriction rule parameter " &
                      Param & ", ignored");
               return;
            end if;

         end if;

      end loop;

      if R_Id in All_Boolean_Restrictions then

         if Expression_Present then
            Error ("RESTRICTIONS rule parameter: " & Param &
                   " can not contain expression ignored");
         else
            Restriction_Setting (R_Id).Active := Enable;
         end if;

      else

         if not Expression_Present
            and then Enable
         then
            Error ("RESTRICTIONS rule parameter: " & Param &
                    " should contain an expression,  ignored");
            return;

         else

            --  Now we have to get the expression, if it present (if Enable is
            --  OFF, we may turn off the non-boolean restriction without
            --  providing the expression)
            if Expression_Present then

               begin
                  R_Val :=
                    Option_Parameter'Value
                      (Trim (Param (First_Idx .. Param'Last), Both));
               exception
                  when Constraint_Error =>
                     Error ("wrong restriction parameter expression in " &
                             Param & ", ignored");
                  return;
               end;

            end if;

         end if;

         Restriction_Setting (R_Id).Active := Enable;

         if Enable then
            Restriction_Setting (R_Id).Param  := R_Val;
         end if;

      end if;

   end Process_Restriction_Param;

   -------------------------------
   -- Process_Style_Check_Param --
   -------------------------------

   procedure Process_Style_Check_Param
     (Param  : String;
      Enable : Boolean)
   is
      pragma Unreferenced (Enable);
      Success   : Boolean;
   begin

      if To_Lower (Param) = "all_checks" then
         Process_Style_Options
           ("",
--            Enable,
            Success);
      else

         Process_Style_Options
           (Param,
--            Enable,
            Success);
      end if;

      if not Success then
         Error ("wrong parameters of style_checks option - " & Param &
                 ", ignored");
      end if;

   end Process_Style_Check_Param;

   ---------------------------
   -- Process_Style_Options --
   ---------------------------

   procedure Process_Style_Options (Opts : String; Success : out Boolean) is
      Idx      :          Positive := Opts'First;
      Last_Idx : constant Natural  := Opts'Last;

      Val : Natural;
   begin
      if Opts = "" then
         --  -gnaty = -gnaty3abcefhiklmprst
         Process_Style_Options ("3abcefhiklmprst", Success);
         return;
      end if;

      Success := True;
      Style_Options_Backup := Style_Options;

      while Idx <= Last_Idx loop

         case Opts (Idx) is
            when '1' .. '9' =>
               Style_Options (Ident_Level) :=
                 Character'Pos (Opts (Idx)) - Character'Pos ('0');
               Idx := Idx + 1;

            when 'a' |
                 'b' |
                 'c' |
                 'e' |
                 'f' |
                 'h' |
                 'i' |
                 'k' |
                 'l' |
                 'm' |
                 'n' |
                 'o' |
                 'p' |
                 'r' |
                 's' |
                 't' |
                 'x' =>

               Style_Options (To_Style_Option_Type (Opts (Idx))) := ON;
               Idx := Idx + 1;

            when  'N' =>
               --  -gnatyN
               Style_Options := (others => OFF);
               Idx := Idx + 1;

            when 'L' | 'M' =>

               Idx := Idx + 1;

               if Idx > Last_Idx
                 or else
                  Opts (Idx) not in '0' .. '9'
               then
                  Success       := False;
                  Style_Options := Style_Options_Backup;
                  exit;
               end if;

               Val := 0;

               while Idx <= Last_Idx
                and then
                     Opts (Idx) in '0' .. '9'
               loop
                  Val := Val * 10 +
                         (Character'Pos (Opts (Idx)) - Character'Pos ('0'));

                  if Opts (Idx) = 'L' and then Val > 999 then
                     Success       := False;
                     Style_Options := Style_Options_Backup;
                     exit;
                  end if;
               end loop;

               Style_Options (To_Style_Option_Type (Opts (Idx))) := Val;

            when others =>
               Success       := False;
               Style_Options := Style_Options_Backup;
               exit;
         end case;

      end loop;

   end Process_Style_Options;

   -----------------------------
   -- Process_Warning_Options --
   -----------------------------

   procedure Process_Warning_Options (Opts : String; Success : out Boolean) is
      Idx      : Positive          := Opts'First;
      Last_Idx : constant Positive := Opts'Last;

      Warning_Opt : Warning_Option_Value;
   begin
      if Idx <= Last_Idx then
         Success := True;
         Warning_Options_Backup := Warning_Options;
      else
         Success := False;
         return;
      end if;

      while Idx <= Last_Idx loop

         Warning_Opt := To_Warning_Option_Value (Opts (Idx));

         case  Warning_Opt.Opt is
            when Warning_Individual_Checks =>
               Warning_Options (Warning_Opt.Opt) := Warning_Opt.Val;

               if Warning_Opt.Opt = 'a' then
                  Set_All_Indivitual_Checks (Warning_Opt.Val);
               end if;

            when Warning_General_Options =>
               Warning_Options (Warning_General_Options) := (others => False);
               Warning_Options (Warning_Opt.Opt)         := True;

            when Not_A_Warning_Option =>
               Success := False;
               exit;
         end case;

         Idx := Idx + 1;
      end loop;

      if Success then
         Use_gnatw_Option := True;
      else
         Warning_Options := Warning_Options_Backup;
      end if;
   end Process_Warning_Options;

   ---------------------------
   -- Process_Warning_Param --
   ---------------------------

   procedure Process_Warning_Param
     (Param  : String;
      Enable : Boolean)
   is
      pragma Unreferenced (Enable);
      Success   : Boolean;
   begin
      Process_Warning_Options
        (Param,
--            Enable,
         Success);

      if not Success then
         Error ("wrong parameters of warnings option - " & Param &
                 ", ignored");
      end if;

   end Process_Warning_Param;

   -------------------------------
   -- Set_All_Indivitual_Checks --
   -------------------------------

   procedure Set_All_Indivitual_Checks (Val : Boolean) is
   begin
      Warning_Options (Warning_Individual_Checks) := (others => Val);
   end Set_All_Indivitual_Checks;

   -------------------------
   -- Set_Compiler_Checks --
   -------------------------

   procedure Set_Compiler_Checks is
   begin
      --  Use_gnaty_Option

      for J in Style_Options'Range loop

         if Style_Options (J) /= OFF then
            Use_gnaty_Option := True;
            exit;
         end if;

      end loop;

      --  Use_gnatw_Option ???

      --  Check_Restrictions

      for J in Restriction_Setting'Range loop

         if Restriction_Setting (J).Active then
            Check_Restrictions := True;
            exit;
         end if;

      end loop;

   end Set_Compiler_Checks;

   -----------------------------
   -- To_Lower_Warning_Option --
   -----------------------------

   function To_Lower_Warning_Option
     (Opt  : Valid_Warning_Options)
      return Character
   is
   begin

      case Opt is
         when 'a' => return 'a';
         when 'c' => return 'c';
         when 'd' => return 'd';
         when 'f' => return 'f';
         when 'g' => return 'g';
         when 'h' => return 'h';
         when 'i' => return 'i';
         when 'j' => return 'j';
         when 'k' => return 'k';
         when 'l' => return 'l';
         when 'm' => return 'm';
         when 'o' => return 'o';
         when 'p' => return 'p';
         when 'r' => return 'r';
         when 'u' => return 'u';
         when 'v' => return 'v';
         when 'x' => return 'x';
         when 'z' => return 'z';
         when 'e' => return 'e';
         when 'n' => return 'n';
         when 's' => return 's';
      end case;

   end To_Lower_Warning_Option;

   --------------------------
   -- To_Style_Option_Type --
   --------------------------

   function To_Style_Option_Type
     (Ch :   Character)
      return Style_Option_Type
   is
      Result : Style_Option_Type;
   begin
      case Ch is
         when 'a' =>
            Result := 'a';
         when 'b' =>
            Result := 'b';
         when 'c' =>
            Result := 'c';
         when 'e' =>
            Result := 'e';
         when 'f' =>
            Result := 'f';
         when 'h' =>
            Result := 'h';
         when 'i' =>
            Result := 'i';
         when 'k' =>
            Result := 'k';
         when 'l' =>
            Result := 'l';
         when 'L' =>
            Result := 'L';
         when 'm' =>
            Result := 'm';
         when 'M' =>
            Result := 'M';
         when 'n' =>
            Result := 'n';
         when 'o' =>
            Result := 'o';
         when 'p' =>
            Result := 'p';
         when 'r' =>
            Result := 'r';
         when 's' =>
            Result := 's';
         when 't' =>
            Result := 't';
         when 'x' =>
            Result := 'x';

         when others =>
            raise Constraint_Error;
      end case;

      return Result;
   end To_Style_Option_Type;

   -----------------------------
   -- To_Upper_Warning_Option --
   -----------------------------

   function To_Upper_Warning_Option
     (Opt  : Warning_Individual_Checks)
      return Character
   is
   begin

      case Opt is
         when 'a' => return 'A';
         when 'c' => return 'C';
         when 'd' => return 'D';
         when 'f' => return 'F';
         when 'g' => return 'G';
         when 'h' => return 'H';
         when 'i' => return 'I';
         when 'j' => return 'J';
         when 'k' => return 'K';
         when 'l' => return 'L';
         when 'm' => return 'M';
         when 'o' => return 'O';
         when 'p' => return 'P';
         when 'r' => return 'R';
         when 'u' => return 'U';
         when 'v' => return 'V';
         when 'x' => return 'X';
         when 'z' => return 'Z';
      end case;

   end To_Upper_Warning_Option;

   -----------------------------
   -- To_Warning_Option_Value --
   -----------------------------

   function To_Warning_Option_Value
     (Ch :   Character)
      return Warning_Option_Value
   is
      Result : Warning_Option_Value;
   begin

      case Ch is
         when 'a' =>
            Result.Opt := 'a';
            Result.Val := True;
         when 'A' =>
            Result.Opt := 'a';
            Result.Val := False;

         when 'c' =>
            Result.Opt := 'c';
            Result.Val := True;
         when 'C' =>
            Result.Opt := 'c';
            Result.Val := False;

         when 'd' =>
            Result.Opt := 'd';
            Result.Val := True;
         when 'D' =>
            Result.Opt := 'd';
            Result.Val := False;

         when 'f' =>
            Result.Opt := 'f';
            Result.Val := True;
         when 'F' =>
            Result.Opt := 'f';
            Result.Val := False;

         when 'g' =>
            Result.Opt := 'g';
            Result.Val := True;
         when 'G' =>
            Result.Opt := 'g';
            Result.Val := False;

         when 'h' =>
            Result.Opt := 'h';
            Result.Val := True;
         when 'H' =>
            Result.Opt := 'h';
            Result.Val := False;

         when 'i' =>
            Result.Opt := 'i';
            Result.Val := True;
         when 'I' =>
            Result.Opt := 'i';
            Result.Val := False;

         when 'j' =>
            Result.Opt := 'j';
            Result.Val := True;
         when 'J' =>
            Result.Opt := 'j';
            Result.Val := False;

         when 'k' =>
            Result.Opt := 'k';
            Result.Val := True;
         when 'K' =>
            Result.Opt := 'k';
            Result.Val := False;

         when 'l' =>
            Result.Opt := 'l';
            Result.Val := True;
         when 'L' =>
            Result.Opt := 'l';
            Result.Val := False;

         when 'm' =>
            Result.Opt := 'm';
            Result.Val := True;
         when 'M' =>
            Result.Opt := 'm';
            Result.Val := False;

         when 'o' =>
            Result.Opt := 'o';
            Result.Val := True;
         when 'O' =>
            Result.Opt := 'o';
            Result.Val := False;

         when 'p' =>
            Result.Opt := 'p';
            Result.Val := True;
         when 'P' =>
            Result.Opt := 'p';
            Result.Val := False;

         when 'r' =>
            Result.Opt := 'r';
            Result.Val := True;
         when 'R' =>
            Result.Opt := 'r';
            Result.Val := False;

         when 'u' =>
            Result.Opt := 'u';
            Result.Val := True;
         when 'U' =>
            Result.Opt := 'u';
            Result.Val := False;

         when 'v' =>
            Result.Opt := 'v';
            Result.Val := True;
         when 'V' =>
            Result.Opt := 'v';
            Result.Val := False;

         when 'x' =>
            Result.Opt := 'x';
            Result.Val := True;
         when 'X' =>
            Result.Opt := 'x';
            Result.Val := False;

         when 'z' =>
            Result.Opt := 'z';
            Result.Val := True;
         when 'Z' =>
            Result.Opt := 'z';
            Result.Val := False;

         when 'e' =>
            Result.Opt := 'e';
         when 'n' =>
            Result.Opt := 'n';
         when 's' =>
            Result.Opt := 's';

         when others =>
            Result.Opt := Not_A_Warning_Option;
      end case;

      return Result;
   end To_Warning_Option_Value;

end Gnatcheck.Compiler;
