1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, 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: ", (1 => Switch
));
40 procedure Bad_Switch
(Switch
: String) is
42 Osint
.Fail
("invalid switch: ", Switch
);
45 ----------------------------
46 -- Check_Version_And_Help --
47 ----------------------------
49 procedure Check_Version_And_Help
51 Initial_Year
: String;
52 Usage
: Procedure_Ptr
;
53 Version_String
: String := Gnatvsn
.Gnat_Version_String
)
55 Version_Switch_Present
: Boolean := False;
56 Help_Switch_Present
: Boolean := False;
60 -- First check for --version or --help
63 while Next_Arg
< Arg_Count
loop
65 Next_Argv
: String (1 .. Len_Arg
(Next_Arg
));
67 Fill_Arg
(Next_Argv
'Address, Next_Arg
);
69 if Next_Argv
= Version_Switch
then
70 Version_Switch_Present
:= True;
72 elsif Next_Argv
= Help_Switch
then
73 Help_Switch_Present
:= True;
76 Next_Arg
:= Next_Arg
+ 1;
80 -- If --version was used, display version and exit
82 if Version_Switch_Present
then
84 Display_Version
(Tool_Name
, Initial_Year
, Version_String
);
85 Write_Str
(Gnatvsn
.Gnat_Free_Software
);
88 Exit_Program
(E_Success
);
91 -- If --help was used, display help and exit
93 if Help_Switch_Present
then
97 Write_Line
("Report bugs to report@adacore.com");
98 Exit_Program
(E_Success
);
100 end Check_Version_And_Help
;
102 ---------------------
103 -- Display_Version --
104 ---------------------
106 procedure Display_Version
108 Initial_Year
: String;
109 Version_String
: String := Gnatvsn
.Gnat_Version_String
)
112 Write_Str
(Tool_Name
);
114 Write_Str
(Version_String
);
117 Write_Str
("Copyright (C) ");
118 Write_Str
(Initial_Year
);
120 Write_Str
(Gnatvsn
.Current_Year
);
122 Write_Str
(Gnatvsn
.Copyright_Holder
);
126 -------------------------
127 -- Is_Front_End_Switch --
128 -------------------------
130 function Is_Front_End_Switch
(Switch_Chars
: String) return Boolean is
131 Ptr
: constant Positive := Switch_Chars
'First;
133 return Is_Switch
(Switch_Chars
)
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
;
146 function Is_Switch
(Switch_Chars
: String) return Boolean is
148 return Switch_Chars
'Length > 1
149 and then Switch_Chars
(Switch_Chars
'First) = '-';
157 (Switch_Chars
: String;
159 Ptr
: in out Integer;
166 if Ptr
> Max
or else Switch_Chars
(Ptr
) not in '0' .. '9' then
167 Osint
.Fail
("missing numeric value for switch: ", (1 => Switch
));
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');
175 if Result
> Switch_Max_Value
then
177 ("numeric value out of range for switch: ", (1 => Switch
));
188 (Switch_Chars
: String;
190 Ptr
: in out Integer;
197 Scan_Nat
(Switch_Chars
, Max
, Ptr
, Temp
, Switch
);
200 Osint
.Fail
("numeric value out of range for switch: ", (1 => Switch
));