| ------------------------------------------------------------------------------ |
| -- -- |
| -- GNAT COMPILER COMPONENTS -- |
| -- -- |
| -- S W I T C H -- |
| -- -- |
| -- B o d y -- |
| -- -- |
| -- Copyright (C) 1992-2007, 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- -- |
| -- ware Foundation; either version 3, or (at your option) any later ver- -- |
| -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
| -- OUT 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 COPYING3. If not, go to -- |
| -- http://www.gnu.org/licenses for a complete copy of the license. -- |
| -- -- |
| -- GNAT was originally developed by the GNAT team at New York University. -- |
| -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
| -- -- |
| ------------------------------------------------------------------------------ |
| |
| with Osint; use Osint; |
| with Output; use Output; |
| |
| package body Switch is |
| |
| ---------------- |
| -- Bad_Switch -- |
| ---------------- |
| |
| procedure Bad_Switch (Switch : Character) is |
| begin |
| Osint.Fail ("invalid switch: ", (1 => Switch)); |
| end Bad_Switch; |
| |
| procedure Bad_Switch (Switch : String) is |
| begin |
| Osint.Fail ("invalid switch: ", Switch); |
| end Bad_Switch; |
| |
| ------------------------------ |
| -- Check_Version_And_Help_G -- |
| ------------------------------ |
| |
| procedure Check_Version_And_Help_G |
| (Tool_Name : String; |
| Initial_Year : String; |
| Version_String : String := Gnatvsn.Gnat_Version_String) |
| is |
| Version_Switch_Present : Boolean := False; |
| Help_Switch_Present : Boolean := False; |
| Next_Arg : Natural; |
| |
| begin |
| -- First check for --version or --help |
| |
| Next_Arg := 1; |
| while Next_Arg < Arg_Count loop |
| declare |
| Next_Argv : String (1 .. Len_Arg (Next_Arg)); |
| begin |
| Fill_Arg (Next_Argv'Address, Next_Arg); |
| |
| if Next_Argv = Version_Switch then |
| Version_Switch_Present := True; |
| |
| elsif Next_Argv = Help_Switch then |
| Help_Switch_Present := True; |
| end if; |
| |
| Next_Arg := Next_Arg + 1; |
| end; |
| end loop; |
| |
| -- If --version was used, display version and exit |
| |
| if Version_Switch_Present then |
| Set_Standard_Output; |
| Display_Version (Tool_Name, Initial_Year, Version_String); |
| Write_Str (Gnatvsn.Gnat_Free_Software); |
| Write_Eol; |
| Write_Eol; |
| Exit_Program (E_Success); |
| end if; |
| |
| -- If --help was used, display help and exit |
| |
| if Help_Switch_Present then |
| Set_Standard_Output; |
| Usage; |
| Write_Eol; |
| Write_Line ("Report bugs to report@adacore.com"); |
| Exit_Program (E_Success); |
| end if; |
| end Check_Version_And_Help_G; |
| |
| --------------------- |
| -- Display_Version -- |
| --------------------- |
| |
| procedure Display_Version |
| (Tool_Name : String; |
| Initial_Year : String; |
| Version_String : String := Gnatvsn.Gnat_Version_String) |
| is |
| begin |
| Write_Str (Tool_Name); |
| Write_Char (' '); |
| Write_Str (Version_String); |
| Write_Eol; |
| |
| Write_Str ("Copyright (C) "); |
| Write_Str (Initial_Year); |
| Write_Char ('-'); |
| Write_Str (Gnatvsn.Current_Year); |
| Write_Str (", "); |
| Write_Str (Gnatvsn.Copyright_Holder); |
| Write_Eol; |
| end Display_Version; |
| |
| ------------------------- |
| -- Is_Front_End_Switch -- |
| ------------------------- |
| |
| function Is_Front_End_Switch (Switch_Chars : String) return Boolean is |
| Ptr : constant Positive := Switch_Chars'First; |
| begin |
| return Is_Switch (Switch_Chars) |
| and then |
| (Switch_Chars (Ptr + 1) = 'I' |
| or else (Switch_Chars'Length >= 5 |
| and then Switch_Chars (Ptr + 1 .. Ptr + 4) = "gnat") |
| or else (Switch_Chars'Length >= 5 |
| and then Switch_Chars (Ptr + 2 .. Ptr + 4) = "RTS")); |
| end Is_Front_End_Switch; |
| |
| --------------- |
| -- Is_Switch -- |
| --------------- |
| |
| function Is_Switch (Switch_Chars : String) return Boolean is |
| begin |
| return Switch_Chars'Length > 1 |
| and then Switch_Chars (Switch_Chars'First) = '-'; |
| end Is_Switch; |
| |
| -------------- |
| -- Scan_Nat -- |
| -------------- |
| |
| procedure Scan_Nat |
| (Switch_Chars : String; |
| Max : Integer; |
| Ptr : in out Integer; |
| Result : out Nat; |
| Switch : Character) |
| is |
| begin |
| Result := 0; |
| |
| if Ptr > Max or else Switch_Chars (Ptr) not in '0' .. '9' then |
| Osint.Fail ("missing numeric value for switch: ", (1 => Switch)); |
| |
| else |
| while Ptr <= Max and then Switch_Chars (Ptr) in '0' .. '9' loop |
| Result := Result * 10 + |
| Character'Pos (Switch_Chars (Ptr)) - Character'Pos ('0'); |
| Ptr := Ptr + 1; |
| |
| if Result > Switch_Max_Value then |
| Osint.Fail |
| ("numeric value out of range for switch: ", (1 => Switch)); |
| end if; |
| end loop; |
| end if; |
| end Scan_Nat; |
| |
| -------------- |
| -- Scan_Pos -- |
| -------------- |
| |
| procedure Scan_Pos |
| (Switch_Chars : String; |
| Max : Integer; |
| Ptr : in out Integer; |
| Result : out Pos; |
| Switch : Character) |
| is |
| Temp : Nat; |
| |
| begin |
| Scan_Nat (Switch_Chars, Max, Ptr, Temp, Switch); |
| |
| if Temp = 0 then |
| Osint.Fail ("numeric value out of range for switch: ", (1 => Switch)); |
| end if; |
| |
| Result := Temp; |
| end Scan_Pos; |
| |
| end Switch; |