1------------------------------------------------------------------------------ 2-- -- 3-- GNAT2XML COMPONENTS -- 4-- -- 5-- G N A T 2 X M L . P R O J E C T S -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 2013-2014, AdaCore -- 10-- -- 11-- Gnat2xml is free software; you can redistribute it and/or modify it -- 12-- under terms of the GNU General Public License as published by the Free -- 13-- Software Foundation; either version 2, or (at your option) any later -- 14-- version. Gnat2xml is distributed in the hope that it will be useful, -- 15-- but WITHOUT ANY WARRANTY; without even the implied warranty of MER- -- 16-- CHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General -- 17-- Public License for more details. You should have received a copy of the -- 18-- GNU General Public License distributed with GNAT; see file COPYING. If -- 19-- not, write to the Free Software Foundation, 59 Temple Place Suite 330, -- 20-- Boston, MA 02111-1307, USA. -- 21-- The gnat2xml tool was derived from the Avatox sources. -- 22------------------------------------------------------------------------------ 23 24pragma Ada_2012; 25 26with Ada.Directories; use Ada.Directories; 27with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; 28 29with GNAT.OS_Lib; 30 31with GNATCOLL.Projects; use GNATCOLL.Projects; 32 33with ASIS_UL.Common; use ASIS_UL.Common; 34with ASIS_UL.Compiler_Options; use ASIS_UL.Compiler_Options; 35with ASIS_UL.Debug; use ASIS_UL.Debug; 36with ASIS_UL.Environment; use ASIS_UL.Environment; 37with ASIS_UL.Formatted_Output; use ASIS_UL.Formatted_Output; 38with ASIS_UL.Options; use ASIS_UL.Options; 39with ASIS_UL.Output; use ASIS_UL.Output; 40 41with Gnat2xml.Command_Line; use Gnat2xml.Command_Line; 42 43package body Gnat2xml.Projects is 44 45 ---------------------- 46 -- Print_Tool_Usage -- 47 ---------------------- 48 49 overriding procedure Print_Tool_Usage 50 (My_Project : Gnat2xml_Project_Type) 51 is 52 pragma Unreferenced (My_Project); 53 begin 54 Gnat2xml_Usage; 55 end Print_Tool_Usage; 56 57 ------------------------------ 58 -- Register_Tool_Attributes -- 59 ------------------------------ 60 61 procedure Register_Tool_Attributes (My_Project : Gnat2xml_Project_Type) is 62 Pkg : constant String := 63 Tool_Package_Name (Arg_Project_Type'Class (My_Project)); 64 Dummy : String_Access; 65 begin 66 Dummy := new String' 67 (Register_New_Attribute 68 (Name => "Default_Switches", 69 Pkg => Pkg, 70 Is_List => True, 71 Indexed => True)); 72 73 if Dummy.all /= "" then 74 Error ("cannot parse project file: " & Dummy.all); 75 raise Fatal_Error; 76 end if; 77 Free (Dummy); 78 79 Dummy := new String' 80 (Register_New_Attribute 81 (Name => "Switches", 82 Pkg => Pkg, 83 Is_List => True, 84 Indexed => True)); 85 86 if Dummy.all /= "" then 87 Error ("cannot parse project file: " & Dummy.all); 88 raise Fatal_Error; 89 end if; 90 Free (Dummy); 91 92 end Register_Tool_Attributes; 93 94 -------------------- 95 -- Scan_Arguments -- 96 -------------------- 97 98 overriding procedure Scan_Arguments 99 (My_Project : in out Gnat2xml_Project_Type; 100 First_Pass : Boolean := False; 101 Parser : Opt_Parser := Command_Line_Parser; 102 In_Switches : Boolean := False) 103 is 104 In_Project_File : constant Boolean := Parser /= Command_Line_Parser; 105 Initial_Char : Character; 106 Common_Arg : Common_Arg_Status; 107 begin 108 if First_Pass then 109 Warning_Mode := Quiet; 110 -- Otherwise an average run would generate too much diagnoses 111 -- about problems in reformatting 112 113 Process_RTL_Units := True; 114 -- We don't care about this 115 116 end if; 117 118 loop 119 Initial_Char := 120 GNAT.Command_Line.Getopt 121 ("P: U X! eL " & -- project-specific options 122 "-subdirs= " & 123 "-no_objects_dir " & 124 Incremental_Switches & 125 "j! " & 126 "-rep-clauses " & 127 "o= " & -- See Scan_Common_Arg 128 "I: -RTS= v q d? " & 129 "-compact " & 130 "files= " & 131 "h -help -version " & 132 "m: -output-dir=", 133 Parser => Parser); 134 135 -- Print command-line options for debugging 136 137 if False -- disable for now 138 and then ASIS_UL.Debug.Debug_Flag_1 139 and then (not First_Pass) 140 and then Initial_Char /= ASCII.NUL 141 then 142 declare 143 Param : constant String := 144 Strip_Prefix (Parameter (Parser => Parser), "="); 145 begin 146 Put 147 ("\1 \2: ""\3"" = ""\4""\n", 148 (if First_Pass then "1" else "2"), 149 (1 => Initial_Char), 150 Full_Switch (Parser => Parser), 151 Param); 152 153 -- If the parameter refers to an existing file, print out the 154 -- contents of that file. 155 156 if Param /= "" 157 and then Exists (Param) 158 and then Kind (Param) = Ordinary_File 159 then 160 declare 161 File_Content : GNAT.OS_Lib.String_Access := 162 Read_File (Param); 163 begin 164 Put ("----------------\n\1----------------\n", 165 File_Content.all); 166 GNAT.OS_Lib.Free (File_Content); 167 end; 168 end if; 169 end; 170 end if; 171 172 Common_Arg := Scan_Common_Arg 173 (My_Project, First_Pass, Parser, In_Switches, 174 In_Project_File, Initial_Char); 175 case Common_Arg is 176 when Arg_Processed => goto Continue; -- Dealt with above 177 when Arg_Not_Processed => null; -- Deal with it in 'case' below 178 when Quit => return; -- Ignore all other args 179 end case; 180 181 case Initial_Char is 182 when ASCII.NUL => 183 exit when not 184 More_Arguments 185 (Store_Arguments => In_Project_File or else First_Pass, 186 In_Switches => In_Switches); 187 188 when 'e' => 189 190 if Full_Switch (Parser => Parser) = "eL" then 191 if First_Pass then 192 ASIS_UL.Projects.Follow_Symbolic_Links := True; 193 elsif In_Project_File then 194 Error ("-eL option cannot be set in a project file"); 195 raise Parameter_Error; 196 end if; 197 end if; 198 199 when 'h' => 200 if Full_Switch (Parser => Parser) = "h" then 201 if In_Project_File then 202 Error ("project file should not contain '-h' option"); 203 raise Parameter_Error; 204 end if; 205 206 Print_Usage := True; 207 return; 208 else 209 pragma Assert (False); 210 end if; 211 212 when 'm' => -- Obsolete alternative to --output-dir 213 if not First_Pass then 214 if Full_Switch (Parser => Parser) = "m" then 215 -- In Incremental_Mode, -m won't work, because gnatmake 216 -- and gprbuild process it with a different meaning. In 217 -- non-Incremental_Mode, we continue to allow -m for 218 -- compatibility. 219 220 if Incremental_Mode then 221 Error ("-m is obsolete; use --output-dir=" 222 & Parameter (Parser => Parser) & " instead"); 223 raise Parameter_Error; 224 end if; 225 226 Out_Dir := new String' 227 (Full_Name (Parameter (Parser => Parser))); 228 else 229 pragma Assert (False); 230 end if; 231 end if; 232 233 when 'P' => 234 if Full_Switch (Parser => Parser) = "P" then 235 if First_Pass then 236 My_Project.Store_Project_Source (Parameter); 237 elsif In_Project_File then 238 Error ("project file should not be specified inside " & 239 "another project file"); 240 raise Parameter_Error; 241 end if; 242 end if; 243 244 when 'q' => 245 if not First_Pass then 246 if Full_Switch (Parser => Parser) = "q" then 247 Quiet_Mode := True; 248 else 249 pragma Assert (False); 250 end if; 251 end if; 252 253 when 'U' => 254 if Full_Switch (Parser => Parser) = "U" then 255 if First_Pass then 256 if ASIS_UL.Projects.U_Option_Set then 257 Error ("-U can be specified only once"); 258 raise Parameter_Error; 259 end if; 260 261 ASIS_UL.Projects.U_Option_Set := True; 262 elsif In_Project_File then 263 Error ("-U option is not allowed in a project file"); 264 raise Parameter_Error; 265 end if; 266 end if; 267 268 when 'x' => 269 if not First_Pass then 270 if Full_Switch (Parser => Parser) = "x" then 271 null; -- ignore 272 else 273 pragma Assert (False); 274 end if; 275 end if; 276 277 when 'X' => 278 if Full_Switch (Parser => Parser) = "X" then 279 if First_Pass then 280 ASIS_UL.Projects.Store_External_Variable 281 (Var => Parameter); 282 elsif In_Project_File then 283 Error ("external references cannot be set in " & 284 "a project file"); 285 raise Parameter_Error; 286 end if; 287 end if; 288 289 when '-' => 290 if not First_Pass then 291 if Full_Switch (Parser => Parser) = "-RTS" then 292 Store_Option ("--RTS=" & Parameter (Parser => Parser)); 293 elsif Full_Switch (Parser => Parser) = "-subdirs" then 294 Set_Subdir_Name (Parameter (Parser => Parser)); 295 elsif Full_Switch (Parser => Parser) = "-no_objects_dir" then 296 No_Object_Dir := True; 297 elsif Full_Switch (Parser => Parser) = "-compact" then 298 Gnat2xml.Command_Line.Options.Compact_XML := True; 299 else 300 pragma Assert (False); 301 end if; 302 else 303 if Full_Switch (Parser => Parser) = "-RTS" then 304 Store_RTS_Path (Parameter (Parser => Parser)); 305 end if; 306 end if; 307 308 when others => 309 if not Mimic_gcc then 310 -- Ignore unrecognized switches in the inner invocation 311 Error 312 ("unrecognized switch: " & Full_Switch (Parser => Parser)); 313 raise Program_Error; 314 end if; 315 end case; 316 317 <<Continue>> 318 -- Go here to skip the above case statement in the case when 319 -- Scan_Common_Arg already dealt with an argument. 320 end loop; 321 322 -- If there is an -asis-tool-args section (which only happens in the 323 -- inner invocations of incremental mode), we treat those args like 324 -- normal args. We do so by going to that section, and recursively 325 -- calling Scan_Arguments. See also ASIS_UL.Projects.Section_Delimiters. 326 327 if Current_Section (Parser => Parser) = "" then 328 Goto_Section ("asis-tool-args", Parser => Parser); 329 if Current_Section (Parser => Parser) = "-asis-tool-args" then 330 Scan_Arguments (My_Project, First_Pass, Parser, In_Switches); 331 Goto_Section ("", Parser => Parser); 332 else 333 pragma Assert (Current_Section (Parser => Parser) = ""); 334 end if; 335 336 if not First_Pass or else In_Project_File then 337 ASIS_UL.Compiler_Options.Process_cargs_Section 338 (Parser, No_Preprocessing => True); 339 end if; 340 341 if Incremental_Mode_By_Default 342 and then My_Project.Is_Specified 343 then 344 pragma Assert (not Mimic_gcc); 345 Incremental_Mode := True; 346 end if; 347 else 348 -- We're in the recursive call; do nothing 349 pragma Assert 350 (Current_Section (Parser => Parser) = "-asis-tool-args"); 351 end if; 352 353 -- Set_Gnat2xml_Options (Options); 354 -- Moved to Check_Parameters when the direct project support is added. 355 356 exception 357 when GNAT.Command_Line.Invalid_Switch => 358 Error ("invalid switch : " & Full_Switch (Parser => Parser)); 359 raise Parameter_Error; 360 361 when GNAT.Command_Line.Invalid_Parameter => 362 Error ("parameter missed for : -" & Full_Switch (Parser => Parser)); 363 raise Parameter_Error; 364 365 end Scan_Arguments; 366 367end Gnat2xml.Projects; 368