?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Merged revisions 195034,195219,195245,195357,195374,195428,195599,195673,195809 via...
[official-gcc.git] / main / gcc / ada / prj-conf.adb
blob766ce8e09c7c29fc082b5935f45b1285ec6b7816
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . C O N F --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2006-2012, 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 Hostparm;
27 with Makeutl; use Makeutl;
28 with MLib.Tgt;
29 with Opt; use Opt;
30 with Output; use Output;
31 with Prj.Env;
32 with Prj.Err;
33 with Prj.Part;
34 with Prj.PP;
35 with Prj.Proc; use Prj.Proc;
36 with Prj.Tree; use Prj.Tree;
37 with Prj.Util; use Prj.Util;
38 with Prj; use Prj;
39 with Snames; use Snames;
40
41 with Ada.Directories; use Ada.Directories;
42 with Ada.Exceptions; use Ada.Exceptions;
43
44 with GNAT.Case_Util; use GNAT.Case_Util;
45 with GNAT.HTable; use GNAT.HTable;
46
47 package body Prj.Conf is
48
49 Auto_Cgpr : constant String := "auto.cgpr";
50
51 Config_Project_Env_Var : constant String := "GPR_CONFIG";
52 -- Name of the environment variable that provides the name of the
53 -- configuration file to use.
54
55 Gprconfig_Name : constant String := "gprconfig";
56
57 package RTS_Languages is new GNAT.HTable.Simple_HTable
58 (Header_Num => Prj.Header_Num,
59 Element => Name_Id,
60 No_Element => No_Name,
61 Key => Name_Id,
62 Hash => Prj.Hash,
63 Equal => "=");
64 -- Stores the runtime names for the various languages. This is in general
65 -- set from a --RTS command line option.
66
67 -----------------------
68 -- Local_Subprograms --
69 -----------------------
70
71 procedure Add_Attributes
72 (Project_Tree : Project_Tree_Ref;
73 Conf_Decl : Declarations;
74 User_Decl : in out Declarations);
75 -- Process the attributes in the config declarations.
76 -- For single string values, if the attribute is not declared in the user
77 -- declarations, declare it with the value in the config declarations.
78 -- For string list values, prepend the value in the user declarations with
79 -- the value in the config declarations.
80
81 function Check_Target
82 (Config_File : Prj.Project_Id;
83 Autoconf_Specified : Boolean;
84 Project_Tree : Prj.Project_Tree_Ref;
85 Target : String := "") return Boolean;
86 -- Check that the config file's target matches Target.
87 -- Target should be set to the empty string when the user did not specify
88 -- a target. If the target in the configuration file is invalid, this
89 -- function will raise Invalid_Config with an appropriate message.
90 -- Autoconf_Specified should be set to True if the user has used
91 -- autoconf.
92
93 function Locate_Config_File (Name : String) return String_Access;
94 -- Search for Name in the config files directory. Return full path if
95 -- found, or null otherwise.
96
97 procedure Raise_Invalid_Config (Msg : String);
98 pragma No_Return (Raise_Invalid_Config);
99 -- Raises exception Invalid_Config with given message
100
101 procedure Apply_Config_File
102 (Config_File : Prj.Project_Id;
103 Project_Tree : Prj.Project_Tree_Ref);
104 -- Apply the configuration file settings to all the projects in the
105 -- project tree. The Project_Tree must have been parsed first, and
106 -- processed through the first phase so that all its projects are known.
107 --
108 -- Currently, this will add new attributes and packages in the various
109 -- projects, so that when the second phase of the processing is performed
110 -- these attributes are automatically taken into account.
111
112 --------------------
113 -- Add_Attributes --
114 --------------------
115
116 procedure Add_Attributes
117 (Project_Tree : Project_Tree_Ref;
118 Conf_Decl : Declarations;
119 User_Decl : in out Declarations)
120 is
121 Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
122 Conf_Attr_Id : Variable_Id;
123 Conf_Attr : Variable;
124 Conf_Array_Id : Array_Id;
125 Conf_Array : Array_Data;
126 Conf_Array_Elem_Id : Array_Element_Id;
127 Conf_Array_Elem : Array_Element;
128 Conf_List : String_List_Id;
129 Conf_List_Elem : String_Element;
130
131 User_Attr_Id : Variable_Id;
132 User_Attr : Variable;
133 User_Array_Id : Array_Id;
134 User_Array : Array_Data;
135 User_Array_Elem_Id : Array_Element_Id;
136 User_Array_Elem : Array_Element;
137
138 begin
139 Conf_Attr_Id := Conf_Decl.Attributes;
140 User_Attr_Id := User_Decl.Attributes;
141 while Conf_Attr_Id /= No_Variable loop
142 Conf_Attr := Shared.Variable_Elements.Table (Conf_Attr_Id);
143 User_Attr := Shared.Variable_Elements.Table (User_Attr_Id);
144
145 if not Conf_Attr.Value.Default then
146 if User_Attr.Value.Default then
147
148 -- No attribute declared in user project file: just copy the
149 -- value of the configuration attribute.
150
151 User_Attr.Value := Conf_Attr.Value;
152 Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
153
154 elsif User_Attr.Value.Kind = List
155 and then Conf_Attr.Value.Values /= Nil_String
156 then
157 -- List attribute declared in both the user project and the
158 -- configuration project: prepend the user list with the
159 -- configuration list.
160
161 declare
162 User_List : constant String_List_Id :=
163 User_Attr.Value.Values;
164 Conf_List : String_List_Id := Conf_Attr.Value.Values;
165 Conf_Elem : String_Element;
166 New_List : String_List_Id;
167 New_Elem : String_Element;
168
169 begin
170 -- Create new list
171
172 String_Element_Table.Increment_Last
173 (Shared.String_Elements);
174 New_List :=
175 String_Element_Table.Last (Shared.String_Elements);
176
177 -- Value of attribute is new list
178
179 User_Attr.Value.Values := New_List;
180 Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
181
182 loop
183 -- Get each element of configuration list
184
185 Conf_Elem := Shared.String_Elements.Table (Conf_List);
186 New_Elem := Conf_Elem;
187 Conf_List := Conf_Elem.Next;
188
189 if Conf_List = Nil_String then
190
191 -- If it is the last element in the list, connect to
192 -- first element of user list, and we are done.
193
194 New_Elem.Next := User_List;
195 Shared.String_Elements.Table (New_List) := New_Elem;
196 exit;
197
198 else
199 -- If it is not the last element in the list, add to
200 -- new list.
201
202 String_Element_Table.Increment_Last
203 (Shared.String_Elements);
204 New_Elem.Next :=
205 String_Element_Table.Last (Shared.String_Elements);
206 Shared.String_Elements.Table (New_List) := New_Elem;
207 New_List := New_Elem.Next;
208 end if;
209 end loop;
210 end;
211 end if;
212 end if;
213
214 Conf_Attr_Id := Conf_Attr.Next;
215 User_Attr_Id := User_Attr.Next;
216 end loop;
217
218 Conf_Array_Id := Conf_Decl.Arrays;
219 while Conf_Array_Id /= No_Array loop
220 Conf_Array := Shared.Arrays.Table (Conf_Array_Id);
221
222 User_Array_Id := User_Decl.Arrays;
223 while User_Array_Id /= No_Array loop
224 User_Array := Shared.Arrays.Table (User_Array_Id);
225 exit when User_Array.Name = Conf_Array.Name;
226 User_Array_Id := User_Array.Next;
227 end loop;
228
229 -- If this associative array does not exist in the user project file,
230 -- do a shallow copy of the full associative array.
231
232 if User_Array_Id = No_Array then
233 Array_Table.Increment_Last (Shared.Arrays);
234 User_Array := Conf_Array;
235 User_Array.Next := User_Decl.Arrays;
236 User_Decl.Arrays := Array_Table.Last (Shared.Arrays);
237 Shared.Arrays.Table (User_Decl.Arrays) := User_Array;
238
239 -- Otherwise, check each array element
240
241 else
242 Conf_Array_Elem_Id := Conf_Array.Value;
243 while Conf_Array_Elem_Id /= No_Array_Element loop
244 Conf_Array_Elem :=
245 Shared.Array_Elements.Table (Conf_Array_Elem_Id);
246
247 User_Array_Elem_Id := User_Array.Value;
248 while User_Array_Elem_Id /= No_Array_Element loop
249 User_Array_Elem :=
250 Shared.Array_Elements.Table (User_Array_Elem_Id);
251 exit when User_Array_Elem.Index = Conf_Array_Elem.Index;
252 User_Array_Elem_Id := User_Array_Elem.Next;
253 end loop;
254
255 -- If the array element doesn't exist in the user array, insert
256 -- a shallow copy of the conf array element in the user array.
257
258 if User_Array_Elem_Id = No_Array_Element then
259 Array_Element_Table.Increment_Last (Shared.Array_Elements);
260 User_Array_Elem := Conf_Array_Elem;
261 User_Array_Elem.Next := User_Array.Value;
262 User_Array.Value :=
263 Array_Element_Table.Last (Shared.Array_Elements);
264 Shared.Array_Elements.Table (User_Array.Value) :=
265 User_Array_Elem;
266 Shared.Arrays.Table (User_Array_Id) := User_Array;
267
268 -- Otherwise, if the value is a string list, prepend the conf
269 -- array element value to the array element.
270
271 elsif Conf_Array_Elem.Value.Kind = List then
272 Conf_List := Conf_Array_Elem.Value.Values;
273
274 if Conf_List /= Nil_String then
275 declare
276 Link : constant String_List_Id :=
277 User_Array_Elem.Value.Values;
278 Previous : String_List_Id := Nil_String;
279 Next : String_List_Id;
280
281 begin
282 loop
283 Conf_List_Elem :=
284 Shared.String_Elements.Table (Conf_List);
285 String_Element_Table.Increment_Last
286 (Shared.String_Elements);
287 Next :=
288 String_Element_Table.Last
289 (Shared.String_Elements);
290 Shared.String_Elements.Table (Next) :=
291 Conf_List_Elem;
292
293 if Previous = Nil_String then
294 User_Array_Elem.Value.Values := Next;
295 Shared.Array_Elements.Table
296 (User_Array_Elem_Id) := User_Array_Elem;
297
298 else
299 Shared.String_Elements.Table
300 (Previous).Next := Next;
301 end if;
302
303 Previous := Next;
304
305 Conf_List := Conf_List_Elem.Next;
306
307 if Conf_List = Nil_String then
308 Shared.String_Elements.Table (Previous).Next :=
309 Link;
310 exit;
311 end if;
312 end loop;
313 end;
314 end if;
315 end if;
316
317 Conf_Array_Elem_Id := Conf_Array_Elem.Next;
318 end loop;
319 end if;
320
321 Conf_Array_Id := Conf_Array.Next;
322 end loop;
323 end Add_Attributes;
324
325 ------------------------------------
326 -- Add_Default_GNAT_Naming_Scheme --
327 ------------------------------------
328
329 procedure Add_Default_GNAT_Naming_Scheme
330 (Config_File : in out Project_Node_Id;
331 Project_Tree : Project_Node_Tree_Ref)
332 is
333 procedure Create_Attribute
334 (Name : Name_Id;
335 Value : String;
336 Index : String := "";
337 Pkg : Project_Node_Id := Empty_Node);
338
339 ----------------------
340 -- Create_Attribute --
341 ----------------------
342
343 procedure Create_Attribute
344 (Name : Name_Id;
345 Value : String;
346 Index : String := "";
347 Pkg : Project_Node_Id := Empty_Node)
348 is
349 Attr : Project_Node_Id;
350 pragma Unreferenced (Attr);
351
352 Expr : Name_Id := No_Name;
353 Val : Name_Id := No_Name;
354 Parent : Project_Node_Id := Config_File;
355
356 begin
357 if Index /= "" then
358 Name_Len := Index'Length;
359 Name_Buffer (1 .. Name_Len) := Index;
360 Val := Name_Find;
361 end if;
362
363 if Pkg /= Empty_Node then
364 Parent := Pkg;
365 end if;
366
367 Name_Len := Value'Length;
368 Name_Buffer (1 .. Name_Len) := Value;
369 Expr := Name_Find;
370
371 Attr := Create_Attribute
372 (Tree => Project_Tree,
373 Prj_Or_Pkg => Parent,
374 Name => Name,
375 Index_Name => Val,
376 Kind => Prj.Single,
377 Value => Create_Literal_String (Expr, Project_Tree));
378 end Create_Attribute;
379
380 -- Local variables
381
382 Name : Name_Id;
383 Naming : Project_Node_Id;
384 Compiler : Project_Node_Id;
385
386 -- Start of processing for Add_Default_GNAT_Naming_Scheme
387
388 begin
389 if Config_File = Empty_Node then
390
391 -- Create a dummy config file is none was found
392
393 Name_Len := Auto_Cgpr'Length;
394 Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
395 Name := Name_Find;
396
397 -- An invalid project name to avoid conflicts with user-created ones
398
399 Name_Len := 5;
400 Name_Buffer (1 .. Name_Len) := "_auto";
401
402 Config_File :=
403 Create_Project
404 (In_Tree => Project_Tree,
405 Name => Name_Find,
406 Full_Path => Path_Name_Type (Name),
407 Is_Config_File => True);
408
409 -- Setup library support
410
411 case MLib.Tgt.Support_For_Libraries is
412 when None =>
413 null;
414
415 when Static_Only =>
416 Create_Attribute (Name_Library_Support, "static_only");
417
418 when Full =>
419 Create_Attribute (Name_Library_Support, "full");
420 end case;
421
422 if MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported then
423 Create_Attribute (Name_Library_Auto_Init_Supported, "true");
424 else
425 Create_Attribute (Name_Library_Auto_Init_Supported, "false");
426 end if;
427
428 -- Setup Ada support (Ada is the default language here, since this
429 -- is only called when no config file existed initially, ie for
430 -- gnatmake).
431
432 Create_Attribute (Name_Default_Language, "ada");
433
434 Compiler := Create_Package (Project_Tree, Config_File, "compiler");
435 Create_Attribute
436 (Name_Driver, "gcc", "ada", Pkg => Compiler);
437 Create_Attribute
438 (Name_Language_Kind, "unit_based", "ada", Pkg => Compiler);
439 Create_Attribute
440 (Name_Dependency_Kind, "ALI_File", "ada", Pkg => Compiler);
441
442 Naming := Create_Package (Project_Tree, Config_File, "naming");
443 Create_Attribute (Name_Spec_Suffix, ".ads", "ada", Pkg => Naming);
444 Create_Attribute (Name_Separate_Suffix, ".adb", "ada", Pkg => Naming);
445 Create_Attribute (Name_Body_Suffix, ".adb", "ada", Pkg => Naming);
446 Create_Attribute (Name_Dot_Replacement, "-", Pkg => Naming);
447 Create_Attribute (Name_Casing, "lowercase", Pkg => Naming);
448
449 if Current_Verbosity = High then
450 Write_Line ("Automatically generated (in-memory) config file");
451 Prj.PP.Pretty_Print
452 (Project => Config_File,
453 In_Tree => Project_Tree,
454 Backward_Compatibility => False);
455 end if;
456 end if;
457 end Add_Default_GNAT_Naming_Scheme;
458
459 -----------------------
460 -- Apply_Config_File --
461 -----------------------
462
463 procedure Apply_Config_File
464 (Config_File : Prj.Project_Id;
465 Project_Tree : Prj.Project_Tree_Ref)
466 is
467 Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
468
469 Conf_Decl : constant Declarations := Config_File.Decl;
470 Conf_Pack_Id : Package_Id;
471 Conf_Pack : Package_Element;
472
473 User_Decl : Declarations;
474 User_Pack_Id : Package_Id;
475 User_Pack : Package_Element;
476 Proj : Project_List;
477
478 begin
479 Debug_Output ("Applying config file to a project tree");
480
481 Proj := Project_Tree.Projects;
482 while Proj /= null loop
483 if Proj.Project /= Config_File then
484 User_Decl := Proj.Project.Decl;
485 Add_Attributes
486 (Project_Tree => Project_Tree,
487 Conf_Decl => Conf_Decl,
488 User_Decl => User_Decl);
489
490 Conf_Pack_Id := Conf_Decl.Packages;
491 while Conf_Pack_Id /= No_Package loop
492 Conf_Pack := Shared.Packages.Table (Conf_Pack_Id);
493
494 User_Pack_Id := User_Decl.Packages;
495 while User_Pack_Id /= No_Package loop
496 User_Pack := Shared.Packages.Table (User_Pack_Id);
497 exit when User_Pack.Name = Conf_Pack.Name;
498 User_Pack_Id := User_Pack.Next;
499 end loop;
500
501 if User_Pack_Id = No_Package then
502 Package_Table.Increment_Last (Shared.Packages);
503 User_Pack := Conf_Pack;
504 User_Pack.Next := User_Decl.Packages;
505 User_Decl.Packages := Package_Table.Last (Shared.Packages);
506 Shared.Packages.Table (User_Decl.Packages) := User_Pack;
507
508 else
509 Add_Attributes
510 (Project_Tree => Project_Tree,
511 Conf_Decl => Conf_Pack.Decl,
512 User_Decl => Shared.Packages.Table
513 (User_Pack_Id).Decl);
514 end if;
515
516 Conf_Pack_Id := Conf_Pack.Next;
517 end loop;
518
519 Proj.Project.Decl := User_Decl;
520
521 -- For aggregate projects, we need to apply the config to all
522 -- their aggregated trees as well.
523
524 if Proj.Project.Qualifier in Aggregate_Project then
525 declare
526 List : Aggregated_Project_List;
527 begin
528 List := Proj.Project.Aggregated_Projects;
529 while List /= null loop
530 Debug_Output
531 ("Recursively apply config to aggregated tree",
532 List.Project.Name);
533 Apply_Config_File
534 (Config_File, Project_Tree => List.Tree);
535 List := List.Next;
536 end loop;
537 end;
538 end if;
539 end if;
540
541 Proj := Proj.Next;
542 end loop;
543 end Apply_Config_File;
544
545 ------------------
546 -- Check_Target --
547 ------------------
548
549 function Check_Target
550 (Config_File : Project_Id;
551 Autoconf_Specified : Boolean;
552 Project_Tree : Prj.Project_Tree_Ref;
553 Target : String := "") return Boolean
554 is
555 Shared : constant Shared_Project_Tree_Data_Access :=
556 Project_Tree.Shared;
557 Variable : constant Variable_Value :=
558 Value_Of
559 (Name_Target, Config_File.Decl.Attributes, Shared);
560 Tgt_Name : Name_Id := No_Name;
561 OK : Boolean;
562
563 begin
564 if Variable /= Nil_Variable_Value and then not Variable.Default then
565 Tgt_Name := Variable.Value;
566 end if;
567
568 if Target = "" then
569 OK := Autoconf_Specified or else Tgt_Name = No_Name;
570 else
571 OK := Tgt_Name /= No_Name
572 and then Target = Get_Name_String (Tgt_Name);
573 end if;
574
575 if not OK then
576 if Autoconf_Specified then
577 if Verbose_Mode then
578 Write_Line ("inconsistent targets, performing autoconf");
579 end if;
580
581 return False;
582
583 else
584 if Tgt_Name /= No_Name then
585 Raise_Invalid_Config
586 ("invalid target name """
587 & Get_Name_String (Tgt_Name) & """ in configuration");
588 else
589 Raise_Invalid_Config
590 ("no target specified in configuration file");
591 end if;
592 end if;
593 end if;
594
595 return True;
596 end Check_Target;
597
598 --------------------------------------
599 -- Get_Or_Create_Configuration_File --
600 --------------------------------------
601
602 procedure Get_Or_Create_Configuration_File
603 (Project : Project_Id;
604 Project_Tree : Project_Tree_Ref;
605 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
606 Env : in out Prj.Tree.Environment;
607 Allow_Automatic_Generation : Boolean;
608 Config_File_Name : String := "";
609 Autoconf_Specified : Boolean;
610 Target_Name : String := "";
611 Normalized_Hostname : String;
612 Packages_To_Check : String_List_Access := null;
613 Config : out Prj.Project_Id;
614 Config_File_Path : out String_Access;
615 Automatically_Generated : out Boolean;
616 On_Load_Config : Config_File_Hook := null)
617 is
618 Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
619
620 At_Least_One_Compiler_Command : Boolean := False;
621 -- Set to True if at least one attribute Ide'Compiler_Command is
622 -- specified for one language of the system.
623
624 Conf_File_Name : String_Access := new String'(Config_File_Name);
625 -- The configuration project file name. May be modified if there are
626 -- switches --config= in the Builder package of the main project.
627
628 function Default_File_Name return String;
629 -- Return the name of the default config file that should be tested
630
631 procedure Do_Autoconf;
632 -- Generate a new config file through gprconfig. In case of error, this
633 -- raises the Invalid_Config exception with an appropriate message
634
635 procedure Check_Builder_Switches;
636 -- Check for switches --config and --RTS in package Builder
637
638 function Get_Config_Switches return Argument_List_Access;
639 -- Return the --config switches to use for gprconfig
640
641 function Get_Db_Switches return Argument_List_Access;
642 -- Return the --db switches to use for gprconfig
643
644 function Might_Have_Sources (Project : Project_Id) return Boolean;
645 -- True if the specified project might have sources (ie the user has not
646 -- explicitly specified it. We haven't checked the file system, nor do
647 -- we need to at this stage.
648
649 ----------------------------
650 -- Check_Builder_Switches --
651 ----------------------------
652
653 procedure Check_Builder_Switches is
654 Get_RTS_Switches : constant Boolean :=
655 RTS_Languages.Get_First = No_Name;
656 -- If no switch --RTS have been specified on the command line, look
657 -- for --RTS switches in the Builder switches.
658
659 Builder : constant Package_Id :=
660 Value_Of (Name_Builder, Project.Decl.Packages, Shared);
661
662 Switch_Array_Id : Array_Element_Id;
663 -- The Switches to be checked
664
665 procedure Check_Switches;
666 -- Check the switches in Switch_Array_Id
667
668 --------------------
669 -- Check_Switches --
670 --------------------
671
672 procedure Check_Switches is
673 Switch_Array : Array_Element;
674 Switch_List : String_List_Id := Nil_String;
675 Switch : String_Element;
676 Lang : Name_Id;
677 Lang_Last : Positive;
678
679 begin
680 while Switch_Array_Id /= No_Array_Element loop
681 Switch_Array :=
682 Shared.Array_Elements.Table (Switch_Array_Id);
683
684 Switch_List := Switch_Array.Value.Values;
685 List_Loop : while Switch_List /= Nil_String loop
686 Switch := Shared.String_Elements.Table (Switch_List);
687
688 if Switch.Value /= No_Name then
689 Get_Name_String (Switch.Value);
690
691 if Conf_File_Name'Length = 0
692 and then Name_Len > 9
693 and then Name_Buffer (1 .. 9) = "--config="
694 then
695 Conf_File_Name :=
696 new String'(Name_Buffer (10 .. Name_Len));
697
698 elsif Get_RTS_Switches
699 and then Name_Len >= 7
700 and then Name_Buffer (1 .. 5) = "--RTS"
701 then
702 if Name_Buffer (6) = '=' then
703 if not Runtime_Name_Set_For (Name_Ada) then
704 Set_Runtime_For
705 (Name_Ada,
706 Name_Buffer (7 .. Name_Len));
707 Locate_Runtime (Name_Ada, Project_Tree);
708 end if;
709
710 elsif Name_Len > 7
711 and then Name_Buffer (6) = ':'
712 and then Name_Buffer (7) /= '='
713 then
714 Lang_Last := 7;
715 while Lang_Last < Name_Len
716 and then Name_Buffer (Lang_Last + 1) /= '='
717 loop
718 Lang_Last := Lang_Last + 1;
719 end loop;
720
721 if Name_Buffer (Lang_Last + 1) = '=' then
722 declare
723 RTS : constant String :=
724 Name_Buffer (Lang_Last + 2 .. Name_Len);
725 begin
726 Name_Buffer (1 .. Lang_Last - 6) :=
727 Name_Buffer (7 .. Lang_Last);
728 Name_Len := Lang_Last - 6;
729 To_Lower (Name_Buffer (1 .. Name_Len));
730 Lang := Name_Find;
731
732 if not Runtime_Name_Set_For (Lang) then
733 Set_Runtime_For (Lang, RTS);
734 Locate_Runtime (Lang, Project_Tree);
735 end if;
736 end;
737 end if;
738 end if;
739 end if;
740 end if;
741
742 Switch_List := Switch.Next;
743 end loop List_Loop;
744
745 Switch_Array_Id := Switch_Array.Next;
746 end loop;
747 end Check_Switches;
748
749 -- Start of processing for Check_Builder_Switches
750
751 begin
752 if Builder /= No_Package then
753 Switch_Array_Id :=
754 Value_Of
755 (Name => Name_Switches,
756 In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
757 Shared => Shared);
758 Check_Switches;
759
760 Switch_Array_Id :=
761 Value_Of
762 (Name => Name_Default_Switches,
763 In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
764 Shared => Shared);
765 Check_Switches;
766 end if;
767 end Check_Builder_Switches;
768
769 -----------------------
770 -- Default_File_Name --
771 -----------------------
772
773 function Default_File_Name return String is
774 Ada_RTS : constant String := Runtime_Name_For (Name_Ada);
775 Tmp : String_Access;
776
777 begin
778 if Target_Name /= "" then
779 if Ada_RTS /= "" then
780 return
781 Target_Name & '-' & Ada_RTS & Config_Project_File_Extension;
782 else
783 return
784 Target_Name & Config_Project_File_Extension;
785 end if;
786
787 elsif Ada_RTS /= "" then
788 return Ada_RTS & Config_Project_File_Extension;
789
790 else
791 Tmp := Getenv (Config_Project_Env_Var);
792
793 declare
794 T : constant String := Tmp.all;
795
796 begin
797 Free (Tmp);
798
799 if T'Length = 0 then
800 return Default_Config_Name;
801 else
802 return T;
803 end if;
804 end;
805 end if;
806 end Default_File_Name;
807
808 -----------------
809 -- Do_Autoconf --
810 -----------------
811
812 procedure Do_Autoconf is
813 Obj_Dir : constant Variable_Value :=
814 Value_Of
815 (Name_Object_Dir,
816 Project.Decl.Attributes,
817 Shared);
818
819 Gprconfig_Path : String_Access;
820 Success : Boolean;
821
822 begin
823 Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
824
825 if Gprconfig_Path = null then
826 Raise_Invalid_Config
827 ("could not locate gprconfig for auto-configuration");
828 end if;
829
830 -- First, find the object directory of the user's project
831
832 if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
833 Get_Name_String (Project.Directory.Display_Name);
834
835 else
836 if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
837 Get_Name_String (Obj_Dir.Value);
838
839 else
840 Name_Len := 0;
841 Add_Str_To_Name_Buffer
842 (Get_Name_String (Project.Directory.Display_Name));
843 Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
844 end if;
845 end if;
846
847 if Subdirs /= null then
848 Add_Char_To_Name_Buffer (Directory_Separator);
849 Add_Str_To_Name_Buffer (Subdirs.all);
850 end if;
851
852 for J in 1 .. Name_Len loop
853 if Name_Buffer (J) = '/' then
854 Name_Buffer (J) := Directory_Separator;
855 end if;
856 end loop;
857
858 -- Make sure that Obj_Dir ends with a directory separator
859
860 if Name_Buffer (Name_Len) /= Directory_Separator then
861 Name_Len := Name_Len + 1;
862 Name_Buffer (Name_Len) := Directory_Separator;
863 end if;
864
865 declare
866 Obj_Dir : constant String := Name_Buffer (1 .. Name_Len);
867 Config_Switches : Argument_List_Access;
868 Db_Switches : Argument_List_Access;
869 Args : Argument_List (1 .. 5);
870 Arg_Last : Positive;
871 Obj_Dir_Exists : Boolean := True;
872
873 begin
874 -- Check if the object directory exists. If Setup_Projects is True
875 -- (-p) and directory does not exist, attempt to create it.
876 -- Otherwise, if directory does not exist, fail without calling
877 -- gprconfig.
878
879 if not Is_Directory (Obj_Dir)
880 and then (Setup_Projects or else Subdirs /= null)
881 then
882 begin
883 Create_Path (Obj_Dir);
884
885 if not Quiet_Output then
886 Write_Str ("object directory """);
887 Write_Str (Obj_Dir);
888 Write_Line (""" created");
889 end if;
890
891 exception
892 when others =>
893 Raise_Invalid_Config
894 ("could not create object directory " & Obj_Dir);
895 end;
896 end if;
897
898 if not Is_Directory (Obj_Dir) then
899 case Env.Flags.Require_Obj_Dirs is
900 when Error =>
901 Raise_Invalid_Config
902 ("object directory " & Obj_Dir & " does not exist");
903
904 when Warning =>
905 Prj.Err.Error_Msg
906 (Env.Flags,
907 "?object directory " & Obj_Dir & " does not exist");
908 Obj_Dir_Exists := False;
909
910 when Silent =>
911 null;
912 end case;
913 end if;
914
915 -- Get the config switches. This should be done only now, as some
916 -- runtimes may have been found if the Builder switches.
917
918 Config_Switches := Get_Config_Switches;
919
920 -- Get eventual --db switches
921
922 Db_Switches := Get_Db_Switches;
923
924 -- Invoke gprconfig
925
926 Args (1) := new String'("--batch");
927 Args (2) := new String'("-o");
928
929 -- If no config file was specified, set the auto.cgpr one
930
931 if Conf_File_Name'Length = 0 then
932 if Obj_Dir_Exists then
933 Args (3) := new String'(Obj_Dir & Auto_Cgpr);
934
935 else
936 declare
937 Path_FD : File_Descriptor;
938 Path_Name : Path_Name_Type;
939
940 begin
941 Prj.Env.Create_Temp_File
942 (Shared => Project_Tree.Shared,
943 Path_FD => Path_FD,
944 Path_Name => Path_Name,
945 File_Use => "configuration file");
946
947 if Path_FD /= Invalid_FD then
948 declare
949 Temp_Dir : constant String :=
950 Containing_Directory
951 (Get_Name_String (Path_Name));
952 begin
953 GNAT.OS_Lib.Close (Path_FD);
954 Args (3) :=
955 new String'(Temp_Dir &
956 Directory_Separator &
957 Auto_Cgpr);
958 Delete_File (Get_Name_String (Path_Name));
959 end;
960
961 else
962 -- We'll have an error message later on
963
964 Args (3) := new String'(Obj_Dir & Auto_Cgpr);
965 end if;
966 end;
967 end if;
968 else
969 Args (3) := Conf_File_Name;
970 end if;
971
972 if Normalized_Hostname = "" then
973 Arg_Last := 3;
974 else
975 if Target_Name = "" then
976
977 -- Check if attribute Target is specified in the main
978 -- project, or in a project it extends. If it is, use this
979 -- target to invoke gprconfig.
980
981 declare
982 Variable : Variable_Value;
983 Proj : Project_Id;
984 Tgt_Name : Name_Id := No_Name;
985
986 begin
987 Proj := Project;
988 Project_Loop :
989 while Proj /= No_Project loop
990 Variable :=
991 Value_Of (Name_Target, Proj.Decl.Attributes, Shared);
992
993 if Variable /= Nil_Variable_Value
994 and then not Variable.Default
995 and then Variable.Value /= No_Name
996 then
997 Tgt_Name := Variable.Value;
998 exit Project_Loop;
999 end if;
1000
1001 Proj := Proj.Extends;
1002 end loop Project_Loop;
1003
1004 if Tgt_Name /= No_Name then
1005 Args (4) :=
1006 new String'("--target=" &
1007 Get_Name_String (Tgt_Name));
1008
1009 elsif At_Least_One_Compiler_Command then
1010 Args (4) := new String'("--target=all");
1011
1012 else
1013 Args (4) :=
1014 new String'("--target=" & Normalized_Hostname);
1015 end if;
1016 end;
1017
1018 else
1019 Args (4) := new String'("--target=" & Target_Name);
1020 end if;
1021
1022 Arg_Last := 4;
1023 end if;
1024
1025 if not Verbose_Mode then
1026 Arg_Last := Arg_Last + 1;
1027 Args (Arg_Last) := new String'("-q");
1028 end if;
1029
1030 if Verbose_Mode then
1031 Write_Str (Gprconfig_Name);
1032
1033 for J in 1 .. Arg_Last loop
1034 Write_Char (' ');
1035 Write_Str (Args (J).all);
1036 end loop;
1037
1038 for J in Config_Switches'Range loop
1039 Write_Char (' ');
1040 Write_Str (Config_Switches (J).all);
1041 end loop;
1042
1043 for J in Db_Switches'Range loop
1044 Write_Char (' ');
1045 Write_Str (Db_Switches (J).all);
1046 end loop;
1047
1048 Write_Eol;
1049
1050 elsif not Quiet_Output then
1051 -- Display no message if we are creating auto.cgpr, unless in
1052 -- verbose mode
1053
1054 if Config_File_Name'Length > 0
1055 or else Verbose_Mode
1056 then
1057 Write_Str ("creating ");
1058 Write_Str (Simple_Name (Args (3).all));
1059 Write_Eol;
1060 end if;
1061 end if;
1062
1063 Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
1064 Config_Switches.all & Db_Switches.all,
1065 Success);
1066
1067 Free (Config_Switches);
1068
1069 Config_File_Path := Locate_Config_File (Args (3).all);
1070
1071 if Config_File_Path = null then
1072 Raise_Invalid_Config
1073 ("could not create " & Args (3).all);
1074 end if;
1075
1076 for F in Args'Range loop
1077 Free (Args (F));
1078 end loop;
1079 end;
1080 end Do_Autoconf;
1081
1082 ---------------------
1083 -- Get_Db_Switches --
1084 ---------------------
1085
1086 function Get_Db_Switches return Argument_List_Access is
1087 Result : Argument_List_Access;
1088 Nmb_Arg : Natural;
1089 begin
1090 Nmb_Arg :=
1091 (2 * Db_Switch_Args.Last) + Boolean'Pos (not Load_Standard_Base);
1092 Result := new Argument_List (1 .. Nmb_Arg);
1093
1094 if Nmb_Arg /= 0 then
1095 for J in 1 .. Db_Switch_Args.Last loop
1096 Result (2 * J - 1) :=
1097 new String'("--db");
1098 Result (2 * J) :=
1099 new String'(Get_Name_String (Db_Switch_Args.Table (J)));
1100 end loop;
1101
1102 if not Load_Standard_Base then
1103 Result (Result'Last) := new String'("--db-");
1104 end if;
1105 end if;
1106
1107 return Result;
1108 end Get_Db_Switches;
1109
1110 -------------------------
1111 -- Get_Config_Switches --
1112 -------------------------
1113
1114 function Get_Config_Switches return Argument_List_Access is
1115
1116 package Language_Htable is new GNAT.HTable.Simple_HTable
1117 (Header_Num => Prj.Header_Num,
1118 Element => Name_Id,
1119 No_Element => No_Name,
1120 Key => Name_Id,
1121 Hash => Prj.Hash,
1122 Equal => "=");
1123 -- Hash table to keep the languages used in the project tree
1124
1125 IDE : constant Package_Id :=
1126 Value_Of (Name_Ide, Project.Decl.Packages, Shared);
1127
1128 procedure Add_Config_Switches_For_Project
1129 (Project : Project_Id;
1130 Tree : Project_Tree_Ref;
1131 With_State : in out Integer);
1132 -- Add all --config switches for this project. This is also called
1133 -- for aggregate projects.
1134
1135 -------------------------------------
1136 -- Add_Config_Switches_For_Project --
1137 -------------------------------------
1138
1139 procedure Add_Config_Switches_For_Project
1140 (Project : Project_Id;
1141 Tree : Project_Tree_Ref;
1142 With_State : in out Integer)
1143 is
1144 pragma Unreferenced (With_State);
1145
1146 Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
1147
1148 Variable : Variable_Value;
1149 Check_Default : Boolean;
1150 Lang : Name_Id;
1151 List : String_List_Id;
1152 Elem : String_Element;
1153
1154 begin
1155 if Might_Have_Sources (Project) then
1156 Variable :=
1157 Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
1158
1159 if Variable = Nil_Variable_Value or else Variable.Default then
1160
1161 -- Languages is not declared. If it is not an extending
1162 -- project, or if it extends a project with no Languages,
1163 -- check for Default_Language.
1164
1165 Check_Default := Project.Extends = No_Project;
1166
1167 if not Check_Default then
1168 Variable :=
1169 Value_Of
1170 (Name_Languages,
1171 Project.Extends.Decl.Attributes,
1172 Shared);
1173 Check_Default :=
1174 Variable /= Nil_Variable_Value
1175 and then Variable.Values = Nil_String;
1176 end if;
1177
1178 if Check_Default then
1179 Variable :=
1180 Value_Of
1181 (Name_Default_Language,
1182 Project.Decl.Attributes,
1183 Shared);
1184
1185 if Variable /= Nil_Variable_Value
1186 and then not Variable.Default
1187 then
1188 Get_Name_String (Variable.Value);
1189 To_Lower (Name_Buffer (1 .. Name_Len));
1190 Lang := Name_Find;
1191 Language_Htable.Set (Lang, Lang);
1192
1193 -- If no default language is declared, default to Ada
1194
1195 else
1196 Language_Htable.Set (Name_Ada, Name_Ada);
1197 end if;
1198 end if;
1199
1200 elsif Variable.Values /= Nil_String then
1201
1202 -- Attribute Languages is declared with a non empty list:
1203 -- put all the languages in Language_HTable.
1204
1205 List := Variable.Values;
1206 while List /= Nil_String loop
1207 Elem := Shared.String_Elements.Table (List);
1208
1209 Get_Name_String (Elem.Value);
1210 To_Lower (Name_Buffer (1 .. Name_Len));
1211 Lang := Name_Find;
1212 Language_Htable.Set (Lang, Lang);
1213
1214 List := Elem.Next;
1215 end loop;
1216 end if;
1217 end if;
1218 end Add_Config_Switches_For_Project;
1219
1220 procedure For_Every_Imported_Project is new For_Every_Project_Imported
1221 (State => Integer, Action => Add_Config_Switches_For_Project);
1222 -- Document this procedure ???
1223
1224 -- Local variables
1225
1226 Name : Name_Id;
1227 Count : Natural;
1228 Result : Argument_List_Access;
1229 Variable : Variable_Value;
1230 Dummy : Integer := 0;
1231
1232 -- Start of processing for Get_Config_Switches
1233
1234 begin
1235 For_Every_Imported_Project
1236 (By => Project,
1237 Tree => Project_Tree,
1238 With_State => Dummy,
1239 Include_Aggregated => True);
1240
1241 Name := Language_Htable.Get_First;
1242 Count := 0;
1243 while Name /= No_Name loop
1244 Count := Count + 1;
1245 Name := Language_Htable.Get_Next;
1246 end loop;
1247
1248 Result := new String_List (1 .. Count);
1249
1250 Count := 1;
1251 Name := Language_Htable.Get_First;
1252 while Name /= No_Name loop
1253
1254 -- Check if IDE'Compiler_Command is declared for the language.
1255 -- If it is, use its value to invoke gprconfig.
1256
1257 Variable :=
1258 Value_Of
1259 (Name,
1260 Attribute_Or_Array_Name => Name_Compiler_Command,
1261 In_Package => IDE,
1262 Shared => Shared,
1263 Force_Lower_Case_Index => True);
1264
1265 declare
1266 Config_Command : constant String :=
1267 "--config=" & Get_Name_String (Name);
1268
1269 Runtime_Name : constant String :=
1270 Runtime_Name_For (Name);
1271
1272 begin
1273 if Variable = Nil_Variable_Value
1274 or else Length_Of_Name (Variable.Value) = 0
1275 then
1276 Result (Count) :=
1277 new String'(Config_Command & ",," & Runtime_Name);
1278
1279 else
1280 At_Least_One_Compiler_Command := True;
1281
1282 declare
1283 Compiler_Command : constant String :=
1284 Get_Name_String (Variable.Value);
1285
1286 begin
1287 if Is_Absolute_Path (Compiler_Command) then
1288 Result (Count) :=
1289 new String'
1290 (Config_Command & ",," & Runtime_Name & "," &
1291 Containing_Directory (Compiler_Command) & "," &
1292 Simple_Name (Compiler_Command));
1293 else
1294 Result (Count) :=
1295 new String'
1296 (Config_Command & ",," & Runtime_Name & ",," &
1297 Compiler_Command);
1298 end if;
1299 end;
1300 end if;
1301 end;
1302
1303 Count := Count + 1;
1304 Name := Language_Htable.Get_Next;
1305 end loop;
1306
1307 return Result;
1308 end Get_Config_Switches;
1309
1310 ------------------------
1311 -- Might_Have_Sources --
1312 ------------------------
1313
1314 function Might_Have_Sources (Project : Project_Id) return Boolean is
1315 Variable : Variable_Value;
1316
1317 begin
1318 Variable :=
1319 Value_Of
1320 (Name_Source_Dirs,
1321 Project.Decl.Attributes,
1322 Shared);
1323
1324 if Variable = Nil_Variable_Value
1325 or else Variable.Default
1326 or else Variable.Values /= Nil_String
1327 then
1328 Variable :=
1329 Value_Of
1330 (Name_Source_Files,
1331 Project.Decl.Attributes,
1332 Shared);
1333 return Variable = Nil_Variable_Value
1334 or else Variable.Default
1335 or else Variable.Values /= Nil_String;
1336
1337 else
1338 return False;
1339 end if;
1340 end Might_Have_Sources;
1341
1342 Success : Boolean;
1343 Config_Project_Node : Project_Node_Id := Empty_Node;
1344
1345 begin
1346 pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1347
1348 Free (Config_File_Path);
1349 Config := No_Project;
1350
1351 Check_Builder_Switches;
1352
1353 if Conf_File_Name'Length > 0 then
1354 Config_File_Path := Locate_Config_File (Conf_File_Name.all);
1355 else
1356 Config_File_Path := Locate_Config_File (Default_File_Name);
1357 end if;
1358
1359 if Config_File_Path = null then
1360 if not Allow_Automatic_Generation
1361 and then Conf_File_Name'Length > 0
1362 then
1363 Raise_Invalid_Config
1364 ("could not locate main configuration project "
1365 & Conf_File_Name.all);
1366 end if;
1367 end if;
1368
1369 Automatically_Generated :=
1370 Allow_Automatic_Generation and then Config_File_Path = null;
1371
1372 <<Process_Config_File>>
1373
1374 if Automatically_Generated then
1375 if Hostparm.OpenVMS then
1376
1377 -- There is no gprconfig on VMS
1378
1379 Raise_Invalid_Config
1380 ("could not locate any configuration project file");
1381
1382 else
1383 -- This might raise an Invalid_Config exception
1384
1385 Do_Autoconf;
1386 end if;
1387
1388 -- If the config file is not auto-generated, warn if there is any --RTS
1389 -- switch, but not when the config file is generated in memory.
1390
1391 elsif RTS_Languages.Get_First /= No_Name
1392 and then Opt.Warning_Mode /= Opt.Suppress
1393 and then On_Load_Config = null
1394 then
1395 Write_Line
1396 ("warning: --RTS is taken into account only in auto-configuration");
1397 end if;
1398
1399 -- Parse the configuration file
1400
1401 if Verbose_Mode and then Config_File_Path /= null then
1402 Write_Str ("Checking configuration ");
1403 Write_Line (Config_File_Path.all);
1404 end if;
1405
1406 if On_Load_Config /= null then
1407 On_Load_Config
1408 (Config_File => Config_Project_Node,
1409 Project_Node_Tree => Project_Node_Tree);
1410
1411 elsif Config_File_Path /= null then
1412 Prj.Part.Parse
1413 (In_Tree => Project_Node_Tree,
1414 Project => Config_Project_Node,
1415 Project_File_Name => Config_File_Path.all,
1416 Errout_Handling => Prj.Part.Finalize_If_Error,
1417 Packages_To_Check => Packages_To_Check,
1418 Current_Directory => Current_Directory,
1419 Is_Config_File => True,
1420 Env => Env);
1421 else
1422 Config_Project_Node := Empty_Node;
1423 end if;
1424
1425 if Config_Project_Node /= Empty_Node then
1426 Prj.Proc.Process_Project_Tree_Phase_1
1427 (In_Tree => Project_Tree,
1428 Project => Config,
1429 Packages_To_Check => Packages_To_Check,
1430 Success => Success,
1431 From_Project_Node => Config_Project_Node,
1432 From_Project_Node_Tree => Project_Node_Tree,
1433 Env => Env,
1434 Reset_Tree => False);
1435 end if;
1436
1437 if Config_Project_Node = Empty_Node
1438 or else Config = No_Project
1439 then
1440 Raise_Invalid_Config
1441 ("processing of configuration project """
1442 & Config_File_Path.all & """ failed");
1443 end if;
1444
1445 -- Check that the target of the configuration file is the one the user
1446 -- specified on the command line. We do not need to check that when in
1447 -- auto-conf mode, since the appropriate target was passed to gprconfig.
1448
1449 if not Automatically_Generated
1450 and then not
1451 Check_Target (Config, Autoconf_Specified, Project_Tree, Target_Name)
1452 then
1453 Automatically_Generated := True;
1454 goto Process_Config_File;
1455 end if;
1456 end Get_Or_Create_Configuration_File;
1457
1458 ------------------------
1459 -- Locate_Config_File --
1460 ------------------------
1461
1462 function Locate_Config_File (Name : String) return String_Access is
1463 Prefix_Path : constant String := Executable_Prefix_Path;
1464 begin
1465 if Prefix_Path'Length /= 0 then
1466 return Locate_Regular_File
1467 (Name,
1468 "." & Path_Separator &
1469 Prefix_Path & "share" & Directory_Separator & "gpr");
1470 else
1471 return Locate_Regular_File (Name, ".");
1472 end if;
1473 end Locate_Config_File;
1474
1475 --------------------
1476 -- Locate_Runtime --
1477 --------------------
1478
1479 procedure Locate_Runtime
1480 (Language : Name_Id;
1481 Project_Tree : Prj.Project_Tree_Ref)
1482 is
1483 function Is_Base_Name (Path : String) return Boolean;
1484 -- Returns True if Path has no directory separator
1485
1486 ------------------
1487 -- Is_Base_Name --
1488 ------------------
1489
1490 function Is_Base_Name (Path : String) return Boolean is
1491 begin
1492 for I in Path'Range loop
1493 if Path (I) = Directory_Separator or else Path (I) = '/' then
1494 return False;
1495 end if;
1496 end loop;
1497 return True;
1498 end Is_Base_Name;
1499
1500 -- Local declarations
1501
1502 function Find_Rts_In_Path is new Prj.Env.Find_Name_In_Path
1503 (Check_Filename => Is_Directory);
1504
1505 RTS_Name : constant String := Runtime_Name_For (Language);
1506
1507 Full_Path : String_Access;
1508
1509 -- Start of processing for Locate_Runtime
1510
1511 begin
1512 if not Is_Base_Name (RTS_Name) then
1513 Full_Path :=
1514 Find_Rts_In_Path (Root_Environment.Project_Path, RTS_Name);
1515
1516 if Full_Path = null then
1517 Fail_Program (Project_Tree, "cannot find RTS " & RTS_Name);
1518 end if;
1519
1520 Set_Runtime_For (Language, Normalize_Pathname (Full_Path.all));
1521 Free (Full_Path);
1522 end if;
1523 end Locate_Runtime;
1524
1525 ------------------------------------
1526 -- Parse_Project_And_Apply_Config --
1527 ------------------------------------
1528
1529 procedure Parse_Project_And_Apply_Config
1530 (Main_Project : out Prj.Project_Id;
1531 User_Project_Node : out Prj.Tree.Project_Node_Id;
1532 Config_File_Name : String := "";
1533 Autoconf_Specified : Boolean;
1534 Project_File_Name : String;
1535 Project_Tree : Prj.Project_Tree_Ref;
1536 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
1537 Env : in out Prj.Tree.Environment;
1538 Packages_To_Check : String_List_Access;
1539 Allow_Automatic_Generation : Boolean := True;
1540 Automatically_Generated : out Boolean;
1541 Config_File_Path : out String_Access;
1542 Target_Name : String := "";
1543 Normalized_Hostname : String;
1544 On_Load_Config : Config_File_Hook := null)
1545 is
1546 begin
1547 pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1548
1549 -- Parse the user project tree
1550
1551 Prj.Initialize (Project_Tree);
1552
1553 Main_Project := No_Project;
1554 Automatically_Generated := False;
1555
1556 Prj.Part.Parse
1557 (In_Tree => Project_Node_Tree,
1558 Project => User_Project_Node,
1559 Project_File_Name => Project_File_Name,
1560 Errout_Handling => Prj.Part.Finalize_If_Error,
1561 Packages_To_Check => Packages_To_Check,
1562 Current_Directory => Current_Directory,
1563 Is_Config_File => False,
1564 Env => Env);
1565
1566 if User_Project_Node = Empty_Node then
1567 User_Project_Node := Empty_Node;
1568 return;
1569 end if;
1570
1571 Process_Project_And_Apply_Config
1572 (Main_Project => Main_Project,
1573 User_Project_Node => User_Project_Node,
1574 Config_File_Name => Config_File_Name,
1575 Autoconf_Specified => Autoconf_Specified,
1576 Project_Tree => Project_Tree,
1577 Project_Node_Tree => Project_Node_Tree,
1578 Env => Env,
1579 Packages_To_Check => Packages_To_Check,
1580 Allow_Automatic_Generation => Allow_Automatic_Generation,
1581 Automatically_Generated => Automatically_Generated,
1582 Config_File_Path => Config_File_Path,
1583 Target_Name => Target_Name,
1584 Normalized_Hostname => Normalized_Hostname,
1585 On_Load_Config => On_Load_Config);
1586 end Parse_Project_And_Apply_Config;
1587
1588 --------------------------------------
1589 -- Process_Project_And_Apply_Config --
1590 --------------------------------------
1591
1592 procedure Process_Project_And_Apply_Config
1593 (Main_Project : out Prj.Project_Id;
1594 User_Project_Node : Prj.Tree.Project_Node_Id;
1595 Config_File_Name : String := "";
1596 Autoconf_Specified : Boolean;
1597 Project_Tree : Prj.Project_Tree_Ref;
1598 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
1599 Env : in out Prj.Tree.Environment;
1600 Packages_To_Check : String_List_Access;
1601 Allow_Automatic_Generation : Boolean := True;
1602 Automatically_Generated : out Boolean;
1603 Config_File_Path : out String_Access;
1604 Target_Name : String := "";
1605 Normalized_Hostname : String;
1606 On_Load_Config : Config_File_Hook := null;
1607 Reset_Tree : Boolean := True)
1608 is
1609 Shared : constant Shared_Project_Tree_Data_Access :=
1610 Project_Tree.Shared;
1611 Main_Config_Project : Project_Id;
1612 Success : Boolean;
1613
1614 begin
1615 Main_Project := No_Project;
1616 Automatically_Generated := False;
1617
1618 Process_Project_Tree_Phase_1
1619 (In_Tree => Project_Tree,
1620 Project => Main_Project,
1621 Packages_To_Check => Packages_To_Check,
1622 Success => Success,
1623 From_Project_Node => User_Project_Node,
1624 From_Project_Node_Tree => Project_Node_Tree,
1625 Env => Env,
1626 Reset_Tree => Reset_Tree);
1627
1628 if not Success then
1629 Main_Project := No_Project;
1630 return;
1631 end if;
1632
1633 if Project_Tree.Source_Info_File_Name /= null then
1634 if not Is_Absolute_Path (Project_Tree.Source_Info_File_Name.all) then
1635 declare
1636 Obj_Dir : constant Variable_Value :=
1637 Value_Of
1638 (Name_Object_Dir,
1639 Main_Project.Decl.Attributes,
1640 Shared);
1641
1642 begin
1643 if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
1644 Get_Name_String (Main_Project.Directory.Display_Name);
1645
1646 else
1647 if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
1648 Get_Name_String (Obj_Dir.Value);
1649
1650 else
1651 Name_Len := 0;
1652 Add_Str_To_Name_Buffer
1653 (Get_Name_String (Main_Project.Directory.Display_Name));
1654 Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
1655 end if;
1656 end if;
1657
1658 Add_Char_To_Name_Buffer (Directory_Separator);
1659 Add_Str_To_Name_Buffer (Project_Tree.Source_Info_File_Name.all);
1660 Free (Project_Tree.Source_Info_File_Name);
1661 Project_Tree.Source_Info_File_Name :=
1662 new String'(Name_Buffer (1 .. Name_Len));
1663 end;
1664 end if;
1665
1666 Read_Source_Info_File (Project_Tree);
1667 end if;
1668
1669 -- Find configuration file
1670
1671 Get_Or_Create_Configuration_File
1672 (Config => Main_Config_Project,
1673 Project => Main_Project,
1674 Project_Tree => Project_Tree,
1675 Project_Node_Tree => Project_Node_Tree,
1676 Env => Env,
1677 Allow_Automatic_Generation => Allow_Automatic_Generation,
1678 Config_File_Name => Config_File_Name,
1679 Autoconf_Specified => Autoconf_Specified,
1680 Target_Name => Target_Name,
1681 Normalized_Hostname => Normalized_Hostname,
1682 Packages_To_Check => Packages_To_Check,
1683 Config_File_Path => Config_File_Path,
1684 Automatically_Generated => Automatically_Generated,
1685 On_Load_Config => On_Load_Config);
1686
1687 Apply_Config_File (Main_Config_Project, Project_Tree);
1688
1689 -- Finish processing the user's project
1690
1691 Prj.Proc.Process_Project_Tree_Phase_2
1692 (In_Tree => Project_Tree,
1693 Project => Main_Project,
1694 Success => Success,
1695 From_Project_Node => User_Project_Node,
1696 From_Project_Node_Tree => Project_Node_Tree,
1697 Env => Env);
1698
1699 if Success then
1700 if Project_Tree.Source_Info_File_Name /= null
1701 and then not Project_Tree.Source_Info_File_Exists
1702 then
1703 Write_Source_Info_File (Project_Tree);
1704 end if;
1705
1706 else
1707 Main_Project := No_Project;
1708 end if;
1709 end Process_Project_And_Apply_Config;
1710
1711 --------------------------
1712 -- Raise_Invalid_Config --
1713 --------------------------
1714
1715 procedure Raise_Invalid_Config (Msg : String) is
1716 begin
1717 Raise_Exception (Invalid_Config'Identity, Msg);
1718 end Raise_Invalid_Config;
1719
1720 ----------------------
1721 -- Runtime_Name_For --
1722 ----------------------
1723
1724 function Runtime_Name_For (Language : Name_Id) return String is
1725 begin
1726 if RTS_Languages.Get (Language) /= No_Name then
1727 return Get_Name_String (RTS_Languages.Get (Language));
1728 else
1729 return "";
1730 end if;
1731 end Runtime_Name_For;
1732
1733 --------------------------
1734 -- Runtime_Name_Set_For --
1735 --------------------------
1736
1737 function Runtime_Name_Set_For (Language : Name_Id) return Boolean is
1738 begin
1739 return RTS_Languages.Get (Language) /= No_Name;
1740 end Runtime_Name_Set_For;
1741
1742 ---------------------
1743 -- Set_Runtime_For --
1744 ---------------------
1745
1746 procedure Set_Runtime_For (Language : Name_Id; RTS_Name : String) is
1747 begin
1748 Name_Len := RTS_Name'Length;
1749 Name_Buffer (1 .. Name_Len) := RTS_Name;
1750 RTS_Languages.Set (Language, Name_Find);
1751 end Set_Runtime_For;
1752
1753 end Prj.Conf;
Mirror of the offical gcc git repository hosted at gcc.gnu.org