gcc/ada/switch.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                               S W I T C H                                --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Osint;  use Osint;
  27 with Output; use Output;
  28
  29 package body Switch is
  30
  31    ----------------
  32    -- Bad_Switch --
  33    ----------------
  34
  35    procedure Bad_Switch (Switch : Character) is
  36    begin
  37       Osint.Fail ("invalid switch: ", (1 => Switch));
  38    end Bad_Switch;
  39
  40    procedure Bad_Switch (Switch : String) is
  41    begin
  42       Osint.Fail ("invalid switch: ", Switch);
  43    end Bad_Switch;
  44
  45    ----------------------------
  46    -- Check_Version_And_Help --
  47    ----------------------------
  48
  49    procedure Check_Version_And_Help
  50      (Tool_Name      : String;
  51       Initial_Year   : String;
  52       Usage          : Procedure_Ptr;
  53       Version_String : String := Gnatvsn.Gnat_Version_String)
  54    is
  55       Version_Switch_Present : Boolean := False;
  56       Help_Switch_Present    : Boolean := False;
  57       Next_Arg               : Natural;
  58
  59    begin
  60       --  First check for --version or --help
  61
  62       Next_Arg := 1;
  63       while Next_Arg < Arg_Count loop
  64          declare
  65             Next_Argv : String (1 .. Len_Arg (Next_Arg));
  66          begin
  67             Fill_Arg (Next_Argv'Address, Next_Arg);
  68
  69             if Next_Argv = Version_Switch then
  70                Version_Switch_Present := True;
  71
  72             elsif Next_Argv = Help_Switch then
  73                Help_Switch_Present := True;
  74             end if;
  75
  76             Next_Arg := Next_Arg + 1;
  77          end;
  78       end loop;
  79
  80       --  If --version was used, display version and exit
  81
  82       if Version_Switch_Present then
  83          Set_Standard_Output;
  84          Display_Version (Tool_Name, Initial_Year, Version_String);
  85          Write_Str (Gnatvsn.Gnat_Free_Software);
  86          Write_Eol;
  87          Write_Eol;
  88          Exit_Program (E_Success);
  89       end if;
  90
  91       --  If --help was used, display help and exit
  92
  93       if Help_Switch_Present then
  94          Set_Standard_Output;
  95          Usage.all;
  96          Write_Eol;
  97          Write_Line ("Report bugs to report@adacore.com");
  98          Exit_Program (E_Success);
  99       end if;
 100    end Check_Version_And_Help;
 101
 102    ---------------------
 103    -- Display_Version --
 104    ---------------------
 105
 106    procedure Display_Version
 107      (Tool_Name      : String;
 108       Initial_Year   : String;
 109       Version_String : String := Gnatvsn.Gnat_Version_String)
 110    is
 111    begin
 112       Write_Str (Tool_Name);
 113       Write_Char (' ');
 114       Write_Str (Version_String);
 115       Write_Eol;
 116
 117       Write_Str ("Copyright (C) ");
 118       Write_Str (Initial_Year);
 119       Write_Char ('-');
 120       Write_Str (Gnatvsn.Current_Year);
 121       Write_Str (", ");
 122       Write_Str (Gnatvsn.Copyright_Holder);
 123       Write_Eol;
 124    end Display_Version;
 125
 126    -------------------------
 127    -- Is_Front_End_Switch --
 128    -------------------------
 129
 130    function Is_Front_End_Switch (Switch_Chars : String) return Boolean is
 131       Ptr : constant Positive := Switch_Chars'First;
 132    begin
 133       return Is_Switch (Switch_Chars)
 134         and then
 135           (Switch_Chars (Ptr + 1) = 'I'
 136             or else (Switch_Chars'Length >= 5
 137                       and then Switch_Chars (Ptr + 1 .. Ptr + 4) = "gnat")
 138             or else (Switch_Chars'Length >= 5
 139                       and then Switch_Chars (Ptr + 2 .. Ptr + 4) = "RTS"));
 140    end Is_Front_End_Switch;
 141
 142    ---------------
 143    -- Is_Switch --
 144    ---------------
 145
 146    function Is_Switch (Switch_Chars : String) return Boolean is
 147    begin
 148       return Switch_Chars'Length > 1
 149         and then Switch_Chars (Switch_Chars'First) = '-';
 150    end Is_Switch;
 151
 152    --------------
 153    -- Scan_Nat --
 154    --------------
 155
 156    procedure Scan_Nat
 157      (Switch_Chars : String;
 158       Max          : Integer;
 159       Ptr          : in out Integer;
 160       Result       : out Nat;
 161       Switch       : Character)
 162    is
 163    begin
 164       Result := 0;
 165
 166       if Ptr > Max or else Switch_Chars (Ptr) not in '0' .. '9' then
 167          Osint.Fail ("missing numeric value for switch: ", (1 => Switch));
 168
 169       else
 170          while Ptr <= Max and then Switch_Chars (Ptr) in '0' .. '9' loop
 171             Result := Result * 10 +
 172               Character'Pos (Switch_Chars (Ptr)) - Character'Pos ('0');
 173             Ptr := Ptr + 1;
 174
 175             if Result > Switch_Max_Value then
 176                Osint.Fail
 177                  ("numeric value out of range for switch: ", (1 => Switch));
 178             end if;
 179          end loop;
 180       end if;
 181    end Scan_Nat;
 182
 183    --------------
 184    -- Scan_Pos --
 185    --------------
 186
 187    procedure Scan_Pos
 188      (Switch_Chars : String;
 189       Max          : Integer;
 190       Ptr          : in out Integer;
 191       Result       : out Pos;
 192       Switch       : Character)
 193    is
 194       Temp : Nat;
 195
 196    begin
 197       Scan_Nat (Switch_Chars, Max, Ptr, Temp, Switch);
 198
 199       if Temp = 0 then
 200          Osint.Fail ("numeric value out of range for switch: ", (1 => Switch));
 201       end if;
 202
 203       Result := Temp;
 204    end Scan_Pos;
 205
 206 end Switch;