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