1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2020, Free Software Foundation, Inc. --
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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Osint; use Osint;
27 with Output; use Output;
29 package body Switch is
35 procedure Bad_Switch (Switch : Character) is
37 Osint.Fail ("invalid switch: " & Switch);
40 procedure Bad_Switch (Switch : String) is
42 Osint.Fail ("invalid switch: " & Switch);
45 ------------------------------
46 -- Check_Version_And_Help_G --
47 ------------------------------
49 procedure Check_Version_And_Help_G
51 Initial_Year : String;
52 Version_String : String := Gnatvsn.Gnat_Version_String)
54 Version_Switch_Present : Boolean := False;
55 Help_Switch_Present : Boolean := False;
59 -- First check for --version or --help
62 while Next_Arg < Arg_Count loop
64 Next_Argv : String (1 .. Len_Arg (Next_Arg));
66 Fill_Arg (Next_Argv'Address, Next_Arg);
68 if Next_Argv = Version_Switch then
69 Version_Switch_Present := True;
71 elsif Next_Argv = Help_Switch then
72 Help_Switch_Present := True;
75 Next_Arg := Next_Arg + 1;
79 -- If --version was used, display version and exit
81 if Version_Switch_Present then
83 Display_Version (Tool_Name, Initial_Year, Version_String);
84 Write_Str (Gnatvsn.Gnat_Free_Software);
87 Exit_Program (E_Success);
90 -- If --help was used, display help and exit
92 if Help_Switch_Present then
96 Write_Line ("Report bugs to report@adacore.com");
97 Exit_Program (E_Success);
99 end Check_Version_And_Help_G;
101 ------------------------------------
102 -- Display_Usage_Version_And_Help --
103 ------------------------------------
105 procedure Display_Usage_Version_And_Help is
107 Write_Str (" --version Display version and exit");
110 Write_Str (" --help Display usage and exit");
113 end Display_Usage_Version_And_Help;
115 ---------------------
116 -- Display_Version --
117 ---------------------
119 procedure Display_Version
121 Initial_Year : String;
122 Version_String : String := Gnatvsn.Gnat_Version_String)
125 Write_Str (Tool_Name);
127 Write_Str (Version_String);
130 Write_Str ("Copyright (C) ");
131 Write_Str (Initial_Year);
133 Write_Str (Gnatvsn.Current_Year);
135 Write_Str (Gnatvsn.Copyright_Holder);
139 -------------------------
140 -- Is_Front_End_Switch --
141 -------------------------
143 function Is_Front_End_Switch (Switch_Chars : String) return Boolean is
144 Ptr : constant Positive := Switch_Chars'First;
146 return Is_Switch (Switch_Chars)
148 (Switch_Chars (Ptr + 1) = 'I'
149 or else (Switch_Chars'Length >= 5
150 and then Switch_Chars (Ptr + 1 .. Ptr + 4) = "gnat")
151 or else (Switch_Chars'Length >= 5
152 and then Switch_Chars (Ptr + 2 .. Ptr + 4) = "RTS"));
153 end Is_Front_End_Switch;
155 ----------------------------
156 -- Is_Internal_GCC_Switch --
157 ----------------------------
159 function Is_Internal_GCC_Switch (Switch_Chars : String) return Boolean is
160 First : constant Natural := Switch_Chars'First + 1;
161 Last : constant Natural := Switch_Last (Switch_Chars);
163 return Is_Switch (Switch_Chars)
165 (Switch_Chars (First .. Last) = "-param" or else
166 Switch_Chars (First .. Last) = "dumpdir" or else
167 Switch_Chars (First .. Last) = "dumpbase" or else
168 Switch_Chars (First .. Last) = "dumpbase-ext");
169 end Is_Internal_GCC_Switch;
175 function Is_Switch (Switch_Chars : String) return Boolean is
177 return Switch_Chars'Length > 1
178 and then Switch_Chars (Switch_Chars'First) = '-';
185 function Switch_Last (Switch_Chars : String) return Natural is
186 Last : constant Natural := Switch_Chars'Last;
188 if Last >= Switch_Chars'First
189 and then Switch_Chars (Last) = ASCII.NUL
202 (Switch_Chars : String;
204 Ptr : Integer) return Boolean
208 and then Switch_Chars (Ptr) in '0' .. '9')
211 and then Switch_Chars (Ptr) = '='
212 and then Switch_Chars (Ptr + 1) in '0' .. '9');
220 (Switch_Chars : String;
222 Ptr : in out Integer;
229 if not Nat_Present (Switch_Chars, Max, Ptr) then
230 Osint.Fail ("missing numeric value for switch: " & Switch);
233 if Switch_Chars (Ptr) = '=' then
237 while Ptr <= Max and then Switch_Chars (Ptr) in '0' .. '9' loop
240 Character'Pos (Switch_Chars (Ptr)) - Character'Pos ('0');
243 if Result > Switch_Max_Value then
244 Osint.Fail ("numeric value out of range for switch: " & Switch);
254 (Switch_Chars : String;
256 Ptr : in out Integer;
263 Scan_Nat (Switch_Chars, Max, Ptr, Temp, Switch);
266 Osint.Fail ("numeric value out of range for switch: " & Switch);