?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
2015-03-13 Robert Dewar <dewar@adacore.com>
[official-gcc.git] / gcc / ada / prj-conf.adb
blob9c83902d3e1cdde2eb7172656f56c1a05b9c3ee9
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-2014, 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 Makeutl; use Makeutl;
27 with MLib.Tgt;
28 with Opt; use Opt;
29 with Output; use Output;
30 with Prj.Env;
31 with Prj.Err;
32 with Prj.Part;
33 with Prj.PP;
34 with Prj.Proc; use Prj.Proc;
35 with Prj.Tree; use Prj.Tree;
36 with Prj.Util; use Prj.Util;
37 with Prj; use Prj;
38 with Snames; use Snames;
39
40 with Ada.Directories; use Ada.Directories;
41 with Ada.Exceptions; use Ada.Exceptions;
42
43 with GNAT.Case_Util; use GNAT.Case_Util;
44 with GNAT.HTable; use GNAT.HTable;
45
46 package body Prj.Conf is
47
48 Auto_Cgpr : constant String := "auto.cgpr";
49
50 Config_Project_Env_Var : constant String := "GPR_CONFIG";
51 -- Name of the environment variable that provides the name of the
52 -- configuration file to use.
53
54 Gprconfig_Name : constant String := "gprconfig";
55
56 Warn_For_RTS : Boolean := True;
57 -- Set to False when gprbuild parse again the project files, to avoid
58 -- an incorrect warning.
59
60 type Runtime_Root_Data;
61 type Runtime_Root_Ptr is access Runtime_Root_Data;
62 type Runtime_Root_Data is record
63 Root : String_Access;
64 Next : Runtime_Root_Ptr;
65 end record;
66 -- Data for a runtime root to be used when adding directories to the
67 -- project path.
68
69 type Compiler_Root_Data;
70 type Compiler_Root_Ptr is access Compiler_Root_Data;
71 type Compiler_Root_Data is record
72 Root : String_Access;
73 Runtimes : Runtime_Root_Ptr;
74 Next : Compiler_Root_Ptr;
75 end record;
76 -- Data for a compiler root to be used when adding directories to the
77 -- project path.
78
79 First_Compiler_Root : Compiler_Root_Ptr := null;
80 -- Head of the list of compiler roots
81
82 package RTS_Languages is new GNAT.HTable.Simple_HTable
83 (Header_Num => Prj.Header_Num,
84 Element => Name_Id,
85 No_Element => No_Name,
86 Key => Name_Id,
87 Hash => Prj.Hash,
88 Equal => "=");
89 -- Stores the runtime names for the various languages. This is in general
90 -- set from a --RTS command line option.
91
92 -----------------------
93 -- Local_Subprograms --
94 -----------------------
95
96 function Check_Target
97 (Config_File : Prj.Project_Id;
98 Autoconf_Specified : Boolean;
99 Project_Tree : Prj.Project_Tree_Ref;
100 Target : String := "") return Boolean;
101 -- Check that the config file's target matches Target.
102 -- Target should be set to the empty string when the user did not specify
103 -- a target. If the target in the configuration file is invalid, this
104 -- function will raise Invalid_Config with an appropriate message.
105 -- Autoconf_Specified should be set to True if the user has used
106 -- autoconf.
107
108 function Locate_Config_File (Name : String) return String_Access;
109 -- Search for Name in the config files directory. Return full path if
110 -- found, or null otherwise.
111
112 procedure Raise_Invalid_Config (Msg : String);
113 pragma No_Return (Raise_Invalid_Config);
114 -- Raises exception Invalid_Config with given message
115
116 procedure Apply_Config_File
117 (Config_File : Prj.Project_Id;
118 Project_Tree : Prj.Project_Tree_Ref);
119 -- Apply the configuration file settings to all the projects in the
120 -- project tree. The Project_Tree must have been parsed first, and
121 -- processed through the first phase so that all its projects are known.
122 --
123 -- Currently, this will add new attributes and packages in the various
124 -- projects, so that when the second phase of the processing is performed
125 -- these attributes are automatically taken into account.
126
127 type State is (No_State);
128
129 procedure Look_For_Project_Paths
130 (Project : Project_Id;
131 Tree : Project_Tree_Ref;
132 With_State : in out State);
133 -- Check the compilers in the Project and add record them in the list
134 -- rooted at First_Compiler_Root, with their runtimes, if they are not
135 -- already in the list.
136
137 procedure Update_Project_Path is new
138 For_Every_Project_Imported
139 (State => State,
140 Action => Look_For_Project_Paths);
141
142 ------------------------------------
143 -- Add_Default_GNAT_Naming_Scheme --
144 ------------------------------------
145
146 procedure Add_Default_GNAT_Naming_Scheme
147 (Config_File : in out Project_Node_Id;
148 Project_Tree : Project_Node_Tree_Ref)
149 is
150 procedure Create_Attribute
151 (Name : Name_Id;
152 Value : String;
153 Index : String := "";
154 Pkg : Project_Node_Id := Empty_Node);
155
156 ----------------------
157 -- Create_Attribute --
158 ----------------------
159
160 procedure Create_Attribute
161 (Name : Name_Id;
162 Value : String;
163 Index : String := "";
164 Pkg : Project_Node_Id := Empty_Node)
165 is
166 Attr : Project_Node_Id;
167 pragma Unreferenced (Attr);
168
169 Expr : Name_Id := No_Name;
170 Val : Name_Id := No_Name;
171 Parent : Project_Node_Id := Config_File;
172
173 begin
174 if Index /= "" then
175 Name_Len := Index'Length;
176 Name_Buffer (1 .. Name_Len) := Index;
177 Val := Name_Find;
178 end if;
179
180 if Pkg /= Empty_Node then
181 Parent := Pkg;
182 end if;
183
184 Name_Len := Value'Length;
185 Name_Buffer (1 .. Name_Len) := Value;
186 Expr := Name_Find;
187
188 Attr := Create_Attribute
189 (Tree => Project_Tree,
190 Prj_Or_Pkg => Parent,
191 Name => Name,
192 Index_Name => Val,
193 Kind => Prj.Single,
194 Value => Create_Literal_String (Expr, Project_Tree));
195 end Create_Attribute;
196
197 -- Local variables
198
199 Name : Name_Id;
200 Naming : Project_Node_Id;
201 Compiler : Project_Node_Id;
202
203 -- Start of processing for Add_Default_GNAT_Naming_Scheme
204
205 begin
206 if Config_File = Empty_Node then
207
208 -- Create a dummy config file if none was found
209
210 Name_Len := Auto_Cgpr'Length;
211 Name_Buffer (1 .. Name_Len) := Auto_Cgpr;
212 Name := Name_Find;
213
214 -- An invalid project name to avoid conflicts with user-created ones
215
216 Name_Len := 5;
217 Name_Buffer (1 .. Name_Len) := "_auto";
218
219 Config_File :=
220 Create_Project
221 (In_Tree => Project_Tree,
222 Name => Name_Find,
223 Full_Path => Path_Name_Type (Name),
224 Is_Config_File => True);
225
226 -- Setup library support
227
228 case MLib.Tgt.Support_For_Libraries is
229 when None =>
230 null;
231
232 when Static_Only =>
233 Create_Attribute (Name_Library_Support, "static_only");
234
235 when Full =>
236 Create_Attribute (Name_Library_Support, "full");
237 end case;
238
239 if MLib.Tgt.Standalone_Library_Auto_Init_Is_Supported then
240 Create_Attribute (Name_Library_Auto_Init_Supported, "true");
241 else
242 Create_Attribute (Name_Library_Auto_Init_Supported, "false");
243 end if;
244
245 -- Declare an empty target
246
247 Create_Attribute (Name_Target, "");
248
249 -- Setup Ada support (Ada is the default language here, since this
250 -- is only called when no config file existed initially, ie for
251 -- gnatmake).
252
253 Create_Attribute (Name_Default_Language, "ada");
254
255 Compiler := Create_Package (Project_Tree, Config_File, "compiler");
256 Create_Attribute
257 (Name_Driver, "gcc", "ada", Pkg => Compiler);
258 Create_Attribute
259 (Name_Language_Kind, "unit_based", "ada", Pkg => Compiler);
260 Create_Attribute
261 (Name_Dependency_Kind, "ALI_File", "ada", Pkg => Compiler);
262
263 Naming := Create_Package (Project_Tree, Config_File, "naming");
264 Create_Attribute (Name_Spec_Suffix, ".ads", "ada", Pkg => Naming);
265 Create_Attribute (Name_Separate_Suffix, ".adb", "ada", Pkg => Naming);
266 Create_Attribute (Name_Body_Suffix, ".adb", "ada", Pkg => Naming);
267 Create_Attribute (Name_Dot_Replacement, "-", Pkg => Naming);
268 Create_Attribute (Name_Casing, "lowercase", Pkg => Naming);
269
270 if Current_Verbosity = High then
271 Write_Line ("Automatically generated (in-memory) config file");
272 Prj.PP.Pretty_Print
273 (Project => Config_File,
274 In_Tree => Project_Tree,
275 Backward_Compatibility => False);
276 end if;
277 end if;
278 end Add_Default_GNAT_Naming_Scheme;
279
280 -----------------------
281 -- Apply_Config_File --
282 -----------------------
283
284 procedure Apply_Config_File
285 (Config_File : Prj.Project_Id;
286 Project_Tree : Prj.Project_Tree_Ref)
287 is
288 procedure Add_Attributes
289 (Project_Tree : Project_Tree_Ref;
290 Conf_Decl : Declarations;
291 User_Decl : in out Declarations);
292 -- Process the attributes in the config declarations. For
293 -- single string values, if the attribute is not declared in
294 -- the user declarations, declare it with the value in the
295 -- config declarations. For string list values, prepend the
296 -- value in the user declarations with the value in the config
297 -- declarations.
298
299 --------------------
300 -- Add_Attributes --
301 --------------------
302
303 procedure Add_Attributes
304 (Project_Tree : Project_Tree_Ref;
305 Conf_Decl : Declarations;
306 User_Decl : in out Declarations)
307 is
308 Shared : constant Shared_Project_Tree_Data_Access :=
309 Project_Tree.Shared;
310 Conf_Attr_Id : Variable_Id;
311 Conf_Attr : Variable;
312 Conf_Array_Id : Array_Id;
313 Conf_Array : Array_Data;
314 Conf_Array_Elem_Id : Array_Element_Id;
315 Conf_Array_Elem : Array_Element;
316 Conf_List : String_List_Id;
317 Conf_List_Elem : String_Element;
318
319 User_Attr_Id : Variable_Id;
320 User_Attr : Variable;
321 User_Array_Id : Array_Id;
322 User_Array : Array_Data;
323 User_Array_Elem_Id : Array_Element_Id;
324 User_Array_Elem : Array_Element;
325
326 begin
327 Conf_Attr_Id := Conf_Decl.Attributes;
328 User_Attr_Id := User_Decl.Attributes;
329
330 while Conf_Attr_Id /= No_Variable loop
331 Conf_Attr := Shared.Variable_Elements.Table (Conf_Attr_Id);
332 User_Attr := Shared.Variable_Elements.Table (User_Attr_Id);
333
334 if not Conf_Attr.Value.Default then
335 if User_Attr.Value.Default then
336
337 -- No attribute declared in user project file: just copy
338 -- the value of the configuration attribute.
339
340 User_Attr.Value := Conf_Attr.Value;
341 Shared.Variable_Elements.Table (User_Attr_Id) := User_Attr;
342
343 elsif User_Attr.Value.Kind = List
344 and then Conf_Attr.Value.Values /= Nil_String
345 then
346 -- List attribute declared in both the user project and the
347 -- configuration project: prepend the user list with the
348 -- configuration list.
349
350 declare
351 User_List : constant String_List_Id :=
352 User_Attr.Value.Values;
353 Conf_List : String_List_Id := Conf_Attr.Value.Values;
354 Conf_Elem : String_Element;
355 New_List : String_List_Id;
356 New_Elem : String_Element;
357
358 begin
359 -- Create new list
360
361 String_Element_Table.Increment_Last
362 (Shared.String_Elements);
363 New_List :=
364 String_Element_Table.Last (Shared.String_Elements);
365
366 -- Value of attribute is new list
367
368 User_Attr.Value.Values := New_List;
369 Shared.Variable_Elements.Table (User_Attr_Id) :=
370 User_Attr;
371
372 loop
373 -- Get each element of configuration list
374
375 Conf_Elem := Shared.String_Elements.Table (Conf_List);
376 New_Elem := Conf_Elem;
377 Conf_List := Conf_Elem.Next;
378
379 if Conf_List = Nil_String then
380
381 -- If it is the last element in the list, connect
382 -- to first element of user list, and we are done.
383
384 New_Elem.Next := User_List;
385 Shared.String_Elements.Table (New_List) := New_Elem;
386 exit;
387
388 else
389 -- If it is not the last element in the list, add
390 -- to new list.
391
392 String_Element_Table.Increment_Last
393 (Shared.String_Elements);
394 New_Elem.Next := String_Element_Table.Last
395 (Shared.String_Elements);
396 Shared.String_Elements.Table (New_List) := New_Elem;
397 New_List := New_Elem.Next;
398 end if;
399 end loop;
400 end;
401 end if;
402 end if;
403
404 Conf_Attr_Id := Conf_Attr.Next;
405 User_Attr_Id := User_Attr.Next;
406 end loop;
407
408 Conf_Array_Id := Conf_Decl.Arrays;
409 while Conf_Array_Id /= No_Array loop
410 Conf_Array := Shared.Arrays.Table (Conf_Array_Id);
411
412 User_Array_Id := User_Decl.Arrays;
413 while User_Array_Id /= No_Array loop
414 User_Array := Shared.Arrays.Table (User_Array_Id);
415 exit when User_Array.Name = Conf_Array.Name;
416 User_Array_Id := User_Array.Next;
417 end loop;
418
419 -- If this associative array does not exist in the user project
420 -- file, do a shallow copy of the full associative array.
421
422 if User_Array_Id = No_Array then
423 Array_Table.Increment_Last (Shared.Arrays);
424 User_Array := Conf_Array;
425 User_Array.Next := User_Decl.Arrays;
426 User_Decl.Arrays := Array_Table.Last (Shared.Arrays);
427 Shared.Arrays.Table (User_Decl.Arrays) := User_Array;
428
429 -- Otherwise, check each array element
430
431 else
432 Conf_Array_Elem_Id := Conf_Array.Value;
433 while Conf_Array_Elem_Id /= No_Array_Element loop
434 Conf_Array_Elem :=
435 Shared.Array_Elements.Table (Conf_Array_Elem_Id);
436
437 User_Array_Elem_Id := User_Array.Value;
438 while User_Array_Elem_Id /= No_Array_Element loop
439 User_Array_Elem :=
440 Shared.Array_Elements.Table (User_Array_Elem_Id);
441 exit when User_Array_Elem.Index = Conf_Array_Elem.Index;
442 User_Array_Elem_Id := User_Array_Elem.Next;
443 end loop;
444
445 -- If the array element doesn't exist in the user array,
446 -- insert a shallow copy of the conf array element in the
447 -- user array.
448
449 if User_Array_Elem_Id = No_Array_Element then
450 Array_Element_Table.Increment_Last
451 (Shared.Array_Elements);
452 User_Array_Elem := Conf_Array_Elem;
453 User_Array_Elem.Next := User_Array.Value;
454 User_Array.Value :=
455 Array_Element_Table.Last (Shared.Array_Elements);
456 Shared.Array_Elements.Table (User_Array.Value) :=
457 User_Array_Elem;
458 Shared.Arrays.Table (User_Array_Id) := User_Array;
459
460 -- Otherwise, if the value is a string list, prepend the
461 -- conf array element value to the array element.
462
463 elsif Conf_Array_Elem.Value.Kind = List then
464 Conf_List := Conf_Array_Elem.Value.Values;
465
466 if Conf_List /= Nil_String then
467 declare
468 Link : constant String_List_Id :=
469 User_Array_Elem.Value.Values;
470 Previous : String_List_Id := Nil_String;
471 Next : String_List_Id;
472
473 begin
474 loop
475 Conf_List_Elem :=
476 Shared.String_Elements.Table (Conf_List);
477 String_Element_Table.Increment_Last
478 (Shared.String_Elements);
479 Next :=
480 String_Element_Table.Last
481 (Shared.String_Elements);
482 Shared.String_Elements.Table (Next) :=
483 Conf_List_Elem;
484
485 if Previous = Nil_String then
486 User_Array_Elem.Value.Values := Next;
487 Shared.Array_Elements.Table
488 (User_Array_Elem_Id) := User_Array_Elem;
489
490 else
491 Shared.String_Elements.Table
492 (Previous).Next := Next;
493 end if;
494
495 Previous := Next;
496
497 Conf_List := Conf_List_Elem.Next;
498
499 if Conf_List = Nil_String then
500 Shared.String_Elements.Table
501 (Previous).Next := Link;
502 exit;
503 end if;
504 end loop;
505 end;
506 end if;
507 end if;
508
509 Conf_Array_Elem_Id := Conf_Array_Elem.Next;
510 end loop;
511 end if;
512
513 Conf_Array_Id := Conf_Array.Next;
514 end loop;
515 end Add_Attributes;
516
517 Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
518
519 Conf_Decl : constant Declarations := Config_File.Decl;
520 Conf_Pack_Id : Package_Id;
521 Conf_Pack : Package_Element;
522
523 User_Decl : Declarations;
524 User_Pack_Id : Package_Id;
525 User_Pack : Package_Element;
526 Proj : Project_List;
527
528 begin
529 Debug_Output ("Applying config file to a project tree");
530
531 Proj := Project_Tree.Projects;
532 while Proj /= null loop
533 if Proj.Project /= Config_File then
534 User_Decl := Proj.Project.Decl;
535 Add_Attributes
536 (Project_Tree => Project_Tree,
537 Conf_Decl => Conf_Decl,
538 User_Decl => User_Decl);
539
540 Conf_Pack_Id := Conf_Decl.Packages;
541 while Conf_Pack_Id /= No_Package loop
542 Conf_Pack := Shared.Packages.Table (Conf_Pack_Id);
543
544 User_Pack_Id := User_Decl.Packages;
545 while User_Pack_Id /= No_Package loop
546 User_Pack := Shared.Packages.Table (User_Pack_Id);
547 exit when User_Pack.Name = Conf_Pack.Name;
548 User_Pack_Id := User_Pack.Next;
549 end loop;
550
551 if User_Pack_Id = No_Package then
552 Package_Table.Increment_Last (Shared.Packages);
553 User_Pack := Conf_Pack;
554 User_Pack.Next := User_Decl.Packages;
555 User_Decl.Packages := Package_Table.Last (Shared.Packages);
556 Shared.Packages.Table (User_Decl.Packages) := User_Pack;
557
558 else
559 Add_Attributes
560 (Project_Tree => Project_Tree,
561 Conf_Decl => Conf_Pack.Decl,
562 User_Decl => Shared.Packages.Table
563 (User_Pack_Id).Decl);
564 end if;
565
566 Conf_Pack_Id := Conf_Pack.Next;
567 end loop;
568
569 Proj.Project.Decl := User_Decl;
570
571 -- For aggregate projects, we need to apply the config to all
572 -- their aggregated trees as well.
573
574 if Proj.Project.Qualifier in Aggregate_Project then
575 declare
576 List : Aggregated_Project_List;
577 begin
578 List := Proj.Project.Aggregated_Projects;
579 while List /= null loop
580 Debug_Output
581 ("Recursively apply config to aggregated tree",
582 List.Project.Name);
583 Apply_Config_File
584 (Config_File, Project_Tree => List.Tree);
585 List := List.Next;
586 end loop;
587 end;
588 end if;
589 end if;
590
591 Proj := Proj.Next;
592 end loop;
593 end Apply_Config_File;
594
595 ------------------
596 -- Check_Target --
597 ------------------
598
599 function Check_Target
600 (Config_File : Project_Id;
601 Autoconf_Specified : Boolean;
602 Project_Tree : Prj.Project_Tree_Ref;
603 Target : String := "") return Boolean
604 is
605 Shared : constant Shared_Project_Tree_Data_Access :=
606 Project_Tree.Shared;
607 Variable : constant Variable_Value :=
608 Value_Of
609 (Name_Target, Config_File.Decl.Attributes, Shared);
610 Tgt_Name : Name_Id := No_Name;
611 OK : Boolean;
612
613 begin
614 if Variable /= Nil_Variable_Value and then not Variable.Default then
615 Tgt_Name := Variable.Value;
616 end if;
617
618 OK :=
619 Target = ""
620 or else
621 (Tgt_Name /= No_Name
622 and then (Length_Of_Name (Tgt_Name) = 0
623 or else Target = Get_Name_String (Tgt_Name)));
624
625 if not OK then
626 if Autoconf_Specified then
627 if Verbose_Mode then
628 Write_Line ("inconsistent targets, performing autoconf");
629 end if;
630
631 return False;
632
633 else
634 if Tgt_Name /= No_Name then
635 Raise_Invalid_Config
636 ("mismatched targets: """
637 & Get_Name_String (Tgt_Name) & """ in configuration, """
638 & Target & """ specified");
639 else
640 Raise_Invalid_Config
641 ("no target specified in configuration file");
642 end if;
643 end if;
644 end if;
645
646 return True;
647 end Check_Target;
648
649 --------------------------------------
650 -- Get_Or_Create_Configuration_File --
651 --------------------------------------
652
653 procedure Get_Or_Create_Configuration_File
654 (Project : Project_Id;
655 Conf_Project : Project_Id;
656 Project_Tree : Project_Tree_Ref;
657 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
658 Env : in out Prj.Tree.Environment;
659 Allow_Automatic_Generation : Boolean;
660 Config_File_Name : String := "";
661 Autoconf_Specified : Boolean;
662 Target_Name : String := "";
663 Normalized_Hostname : String;
664 Packages_To_Check : String_List_Access := null;
665 Config : out Prj.Project_Id;
666 Config_File_Path : out String_Access;
667 Automatically_Generated : out Boolean;
668 On_Load_Config : Config_File_Hook := null)
669 is
670 Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
671
672 At_Least_One_Compiler_Command : Boolean := False;
673 -- Set to True if at least one attribute Ide'Compiler_Command is
674 -- specified for one language of the system.
675
676 Conf_File_Name : String_Access := new String'(Config_File_Name);
677 -- The configuration project file name. May be modified if there are
678 -- switches --config= in the Builder package of the main project.
679
680 Selected_Target : String_Access := new String'(Target_Name);
681
682 function Default_File_Name return String;
683 -- Return the name of the default config file that should be tested
684
685 procedure Do_Autoconf;
686 -- Generate a new config file through gprconfig. In case of error, this
687 -- raises the Invalid_Config exception with an appropriate message
688
689 procedure Check_Builder_Switches;
690 -- Check for switches --config and --RTS in package Builder
691
692 procedure Get_Project_Target;
693 -- If Target_Name is empty, get the specified target in the project
694 -- file, if any.
695
696 procedure Get_Project_Runtimes;
697 -- Get the various Runtime (<lang>) in the project file or any project
698 -- it extends, if any are specified.
699
700 function Get_Config_Switches return Argument_List_Access;
701 -- Return the --config switches to use for gprconfig
702
703 function Get_Db_Switches return Argument_List_Access;
704 -- Return the --db switches to use for gprconfig
705
706 function Might_Have_Sources (Project : Project_Id) return Boolean;
707 -- True if the specified project might have sources (ie the user has not
708 -- explicitly specified it. We haven't checked the file system, nor do
709 -- we need to at this stage.
710
711 ----------------------------
712 -- Check_Builder_Switches --
713 ----------------------------
714
715 procedure Check_Builder_Switches is
716 Get_RTS_Switches : constant Boolean :=
717 RTS_Languages.Get_First = No_Name;
718 -- If no switch --RTS have been specified on the command line, look
719 -- for --RTS switches in the Builder switches.
720
721 Builder : constant Package_Id :=
722 Value_Of (Name_Builder, Project.Decl.Packages, Shared);
723
724 Switch_Array_Id : Array_Element_Id;
725 -- The Switches to be checked
726
727 procedure Check_Switches;
728 -- Check the switches in Switch_Array_Id
729
730 --------------------
731 -- Check_Switches --
732 --------------------
733
734 procedure Check_Switches is
735 Switch_Array : Array_Element;
736 Switch_List : String_List_Id := Nil_String;
737 Switch : String_Element;
738 Lang : Name_Id;
739 Lang_Last : Positive;
740
741 begin
742 while Switch_Array_Id /= No_Array_Element loop
743 Switch_Array :=
744 Shared.Array_Elements.Table (Switch_Array_Id);
745
746 Switch_List := Switch_Array.Value.Values;
747 List_Loop : while Switch_List /= Nil_String loop
748 Switch := Shared.String_Elements.Table (Switch_List);
749
750 if Switch.Value /= No_Name then
751 Get_Name_String (Switch.Value);
752
753 if Conf_File_Name'Length = 0
754 and then Name_Len > 9
755 and then Name_Buffer (1 .. 9) = "--config="
756 then
757 Conf_File_Name :=
758 new String'(Name_Buffer (10 .. Name_Len));
759
760 elsif Get_RTS_Switches
761 and then Name_Len >= 7
762 and then Name_Buffer (1 .. 5) = "--RTS"
763 then
764 if Name_Buffer (6) = '=' then
765 if not Runtime_Name_Set_For (Name_Ada) then
766 Set_Runtime_For
767 (Name_Ada,
768 Name_Buffer (7 .. Name_Len));
769 end if;
770
771 elsif Name_Len > 7
772 and then Name_Buffer (6) = ':'
773 and then Name_Buffer (7) /= '='
774 then
775 Lang_Last := 7;
776 while Lang_Last < Name_Len
777 and then Name_Buffer (Lang_Last + 1) /= '='
778 loop
779 Lang_Last := Lang_Last + 1;
780 end loop;
781
782 if Name_Buffer (Lang_Last + 1) = '=' then
783 declare
784 RTS : constant String :=
785 Name_Buffer (Lang_Last + 2 .. Name_Len);
786 begin
787 Name_Buffer (1 .. Lang_Last - 6) :=
788 Name_Buffer (7 .. Lang_Last);
789 Name_Len := Lang_Last - 6;
790 To_Lower (Name_Buffer (1 .. Name_Len));
791 Lang := Name_Find;
792
793 if not Runtime_Name_Set_For (Lang) then
794 Set_Runtime_For (Lang, RTS);
795 end if;
796 end;
797 end if;
798 end if;
799 end if;
800 end if;
801
802 Switch_List := Switch.Next;
803 end loop List_Loop;
804
805 Switch_Array_Id := Switch_Array.Next;
806 end loop;
807 end Check_Switches;
808
809 -- Start of processing for Check_Builder_Switches
810
811 begin
812 if Builder /= No_Package then
813 Switch_Array_Id :=
814 Value_Of
815 (Name => Name_Switches,
816 In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
817 Shared => Shared);
818 Check_Switches;
819
820 Switch_Array_Id :=
821 Value_Of
822 (Name => Name_Default_Switches,
823 In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
824 Shared => Shared);
825 Check_Switches;
826 end if;
827 end Check_Builder_Switches;
828
829 ------------------------
830 -- Get_Project_Target --
831 ------------------------
832
833 procedure Get_Project_Target is
834 begin
835 if Selected_Target'Length = 0 then
836
837 -- Check if attribute Target is specified in the main
838 -- project, or in a project it extends. If it is, use this
839 -- target to invoke gprconfig.
840
841 declare
842 Variable : Variable_Value;
843 Proj : Project_Id;
844 Tgt_Name : Name_Id := No_Name;
845
846 begin
847 Proj := Project;
848 Project_Loop :
849 while Proj /= No_Project loop
850 Variable :=
851 Value_Of (Name_Target, Proj.Decl.Attributes, Shared);
852
853 if Variable /= Nil_Variable_Value
854 and then not Variable.Default
855 and then Variable.Value /= No_Name
856 then
857 Tgt_Name := Variable.Value;
858 exit Project_Loop;
859 end if;
860
861 Proj := Proj.Extends;
862 end loop Project_Loop;
863
864 if Tgt_Name /= No_Name then
865 Selected_Target := new String'(Get_Name_String (Tgt_Name));
866 end if;
867 end;
868 end if;
869 end Get_Project_Target;
870
871 --------------------------
872 -- Get_Project_Runtimes --
873 --------------------------
874
875 procedure Get_Project_Runtimes is
876 Element : Array_Element;
877 Id : Array_Element_Id;
878 Lang : Name_Id;
879 Proj : Project_Id;
880
881 begin
882 Proj := Project;
883 while Proj /= No_Project loop
884 Id := Value_Of (Name_Runtime, Proj.Decl.Arrays, Shared);
885 while Id /= No_Array_Element loop
886 Element := Shared.Array_Elements.Table (Id);
887 Lang := Element.Index;
888
889 if not Runtime_Name_Set_For (Lang) then
890 Set_Runtime_For
891 (Lang, RTS_Name => Get_Name_String (Element.Value.Value));
892 end if;
893
894 Id := Element.Next;
895 end loop;
896
897 Proj := Proj.Extends;
898 end loop;
899 end Get_Project_Runtimes;
900
901 -----------------------
902 -- Default_File_Name --
903 -----------------------
904
905 function Default_File_Name return String is
906 Ada_RTS : constant String := Runtime_Name_For (Name_Ada);
907 Tmp : String_Access;
908
909 begin
910 if Selected_Target'Length /= 0 then
911 if Ada_RTS /= "" then
912 return
913 Selected_Target.all & '-' &
914 Ada_RTS & Config_Project_File_Extension;
915 else
916 return
917 Selected_Target.all & Config_Project_File_Extension;
918 end if;
919
920 elsif Ada_RTS /= "" then
921 return Ada_RTS & Config_Project_File_Extension;
922
923 else
924 Tmp := Getenv (Config_Project_Env_Var);
925
926 declare
927 T : constant String := Tmp.all;
928
929 begin
930 Free (Tmp);
931
932 if T'Length = 0 then
933 return Default_Config_Name;
934 else
935 return T;
936 end if;
937 end;
938 end if;
939 end Default_File_Name;
940
941 -----------------
942 -- Do_Autoconf --
943 -----------------
944
945 procedure Do_Autoconf is
946 Obj_Dir : constant Variable_Value :=
947 Value_Of
948 (Name_Object_Dir,
949 Conf_Project.Decl.Attributes,
950 Shared);
951
952 Gprconfig_Path : String_Access;
953 Success : Boolean;
954
955 begin
956 Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
957
958 if Gprconfig_Path = null then
959 Raise_Invalid_Config
960 ("could not locate gprconfig for auto-configuration");
961 end if;
962
963 -- First, find the object directory of the Conf_Project
964
965 if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
966 Get_Name_String (Conf_Project.Directory.Display_Name);
967
968 else
969 if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
970 Get_Name_String (Obj_Dir.Value);
971
972 else
973 Name_Len := 0;
974 Add_Str_To_Name_Buffer
975 (Get_Name_String (Conf_Project.Directory.Display_Name));
976 Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
977 end if;
978 end if;
979
980 if Subdirs /= null then
981 Add_Char_To_Name_Buffer (Directory_Separator);
982 Add_Str_To_Name_Buffer (Subdirs.all);
983 end if;
984
985 for J in 1 .. Name_Len loop
986 if Name_Buffer (J) = '/' then
987 Name_Buffer (J) := Directory_Separator;
988 end if;
989 end loop;
990
991 -- Make sure that Obj_Dir ends with a directory separator
992
993 if Name_Buffer (Name_Len) /= Directory_Separator then
994 Name_Len := Name_Len + 1;
995 Name_Buffer (Name_Len) := Directory_Separator;
996 end if;
997
998 declare
999 Obj_Dir : constant String := Name_Buffer (1 .. Name_Len);
1000 Config_Switches : Argument_List_Access;
1001 Db_Switches : Argument_List_Access;
1002 Args : Argument_List (1 .. 5);
1003 Arg_Last : Positive;
1004 Obj_Dir_Exists : Boolean := True;
1005
1006 begin
1007 -- Check if the object directory exists. If Setup_Projects is True
1008 -- (-p) and directory does not exist, attempt to create it.
1009 -- Otherwise, if directory does not exist, fail without calling
1010 -- gprconfig.
1011
1012 if not Is_Directory (Obj_Dir)
1013 and then (Setup_Projects or else Subdirs /= null)
1014 then
1015 begin
1016 Create_Path (Obj_Dir);
1017
1018 if not Quiet_Output then
1019 Write_Str ("object directory """);
1020 Write_Str (Obj_Dir);
1021 Write_Line (""" created");
1022 end if;
1023
1024 exception
1025 when others =>
1026 Raise_Invalid_Config
1027 ("could not create object directory " & Obj_Dir);
1028 end;
1029 end if;
1030
1031 if not Is_Directory (Obj_Dir) then
1032 case Env.Flags.Require_Obj_Dirs is
1033 when Error =>
1034 Raise_Invalid_Config
1035 ("object directory " & Obj_Dir & " does not exist");
1036
1037 when Warning =>
1038 Prj.Err.Error_Msg
1039 (Env.Flags,
1040 "?object directory " & Obj_Dir & " does not exist");
1041 Obj_Dir_Exists := False;
1042
1043 when Silent =>
1044 null;
1045 end case;
1046 end if;
1047
1048 -- Get the config switches. This should be done only now, as some
1049 -- runtimes may have been found in the Builder switches.
1050
1051 Config_Switches := Get_Config_Switches;
1052
1053 -- Get eventual --db switches
1054
1055 Db_Switches := Get_Db_Switches;
1056
1057 -- Invoke gprconfig
1058
1059 Args (1) := new String'("--batch");
1060 Args (2) := new String'("-o");
1061
1062 -- If no config file was specified, set the auto.cgpr one
1063
1064 if Conf_File_Name'Length = 0 then
1065 if Obj_Dir_Exists then
1066 Args (3) := new String'(Obj_Dir & Auto_Cgpr);
1067
1068 else
1069 declare
1070 Path_FD : File_Descriptor;
1071 Path_Name : Path_Name_Type;
1072
1073 begin
1074 Prj.Env.Create_Temp_File
1075 (Shared => Project_Tree.Shared,
1076 Path_FD => Path_FD,
1077 Path_Name => Path_Name,
1078 File_Use => "configuration file");
1079
1080 if Path_FD /= Invalid_FD then
1081 declare
1082 Temp_Dir : constant String :=
1083 Containing_Directory
1084 (Get_Name_String (Path_Name));
1085 begin
1086 GNAT.OS_Lib.Close (Path_FD);
1087 Args (3) :=
1088 new String'(Temp_Dir &
1089 Directory_Separator &
1090 Auto_Cgpr);
1091 Delete_File (Get_Name_String (Path_Name));
1092 end;
1093
1094 else
1095 -- We'll have an error message later on
1096
1097 Args (3) := new String'(Obj_Dir & Auto_Cgpr);
1098 end if;
1099 end;
1100 end if;
1101 else
1102 Args (3) := Conf_File_Name;
1103 end if;
1104
1105 Arg_Last := 3;
1106
1107 if Selected_Target /= null and then
1108 Selected_Target.all /= ""
1109
1110 then
1111 Args (4) :=
1112 new String'("--target=" & Selected_Target.all);
1113 Arg_Last := 4;
1114
1115 elsif Normalized_Hostname /= "" then
1116 if At_Least_One_Compiler_Command then
1117 Args (4) := new String'("--target=all");
1118 else
1119 Args (4) := new String'("--target=" & Normalized_Hostname);
1120 end if;
1121
1122 Arg_Last := 4;
1123 end if;
1124
1125 if not Verbose_Mode then
1126 Arg_Last := Arg_Last + 1;
1127 Args (Arg_Last) := new String'("-q");
1128 end if;
1129
1130 if Verbose_Mode then
1131 Write_Str (Gprconfig_Name);
1132
1133 for J in 1 .. Arg_Last loop
1134 Write_Char (' ');
1135 Write_Str (Args (J).all);
1136 end loop;
1137
1138 for J in Config_Switches'Range loop
1139 Write_Char (' ');
1140 Write_Str (Config_Switches (J).all);
1141 end loop;
1142
1143 for J in Db_Switches'Range loop
1144 Write_Char (' ');
1145 Write_Str (Db_Switches (J).all);
1146 end loop;
1147
1148 Write_Eol;
1149
1150 elsif not Quiet_Output then
1151
1152 -- Display no message if we are creating auto.cgpr, unless in
1153 -- verbose mode.
1154
1155 if Config_File_Name'Length > 0 or else Verbose_Mode then
1156 Write_Str ("creating ");
1157 Write_Str (Simple_Name (Args (3).all));
1158 Write_Eol;
1159 end if;
1160 end if;
1161
1162 Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
1163 Config_Switches.all & Db_Switches.all,
1164 Success);
1165
1166 Free (Config_Switches);
1167
1168 Config_File_Path := Locate_Config_File (Args (3).all);
1169
1170 if Config_File_Path = null then
1171 Raise_Invalid_Config
1172 ("could not create " & Args (3).all);
1173 end if;
1174
1175 for F in Args'Range loop
1176 Free (Args (F));
1177 end loop;
1178 end;
1179 end Do_Autoconf;
1180
1181 ---------------------
1182 -- Get_Db_Switches --
1183 ---------------------
1184
1185 function Get_Db_Switches return Argument_List_Access is
1186 Result : Argument_List_Access;
1187 Nmb_Arg : Natural;
1188 begin
1189 Nmb_Arg :=
1190 (2 * Db_Switch_Args.Last) + Boolean'Pos (not Load_Standard_Base);
1191 Result := new Argument_List (1 .. Nmb_Arg);
1192
1193 if Nmb_Arg /= 0 then
1194 for J in 1 .. Db_Switch_Args.Last loop
1195 Result (2 * J - 1) :=
1196 new String'("--db");
1197 Result (2 * J) :=
1198 new String'(Get_Name_String (Db_Switch_Args.Table (J)));
1199 end loop;
1200
1201 if not Load_Standard_Base then
1202 Result (Result'Last) := new String'("--db-");
1203 end if;
1204 end if;
1205
1206 return Result;
1207 end Get_Db_Switches;
1208
1209 -------------------------
1210 -- Get_Config_Switches --
1211 -------------------------
1212
1213 function Get_Config_Switches return Argument_List_Access is
1214
1215 package Language_Htable is new GNAT.HTable.Simple_HTable
1216 (Header_Num => Prj.Header_Num,
1217 Element => Name_Id,
1218 No_Element => No_Name,
1219 Key => Name_Id,
1220 Hash => Prj.Hash,
1221 Equal => "=");
1222 -- Hash table to keep the languages used in the project tree
1223
1224 IDE : constant Package_Id :=
1225 Value_Of (Name_Ide, Project.Decl.Packages, Shared);
1226
1227 procedure Add_Config_Switches_For_Project
1228 (Project : Project_Id;
1229 Tree : Project_Tree_Ref;
1230 With_State : in out Integer);
1231 -- Add all --config switches for this project. This is also called
1232 -- for aggregate projects.
1233
1234 -------------------------------------
1235 -- Add_Config_Switches_For_Project --
1236 -------------------------------------
1237
1238 procedure Add_Config_Switches_For_Project
1239 (Project : Project_Id;
1240 Tree : Project_Tree_Ref;
1241 With_State : in out Integer)
1242 is
1243 pragma Unreferenced (With_State);
1244
1245 Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
1246
1247 Variable : Variable_Value;
1248 Check_Default : Boolean;
1249 Lang : Name_Id;
1250 List : String_List_Id;
1251 Elem : String_Element;
1252
1253 begin
1254 if Might_Have_Sources (Project) then
1255 Variable :=
1256 Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
1257
1258 if Variable = Nil_Variable_Value or else Variable.Default then
1259
1260 -- Languages is not declared. If it is not an extending
1261 -- project, or if it extends a project with no Languages,
1262 -- check for Default_Language.
1263
1264 Check_Default := Project.Extends = No_Project;
1265
1266 if not Check_Default then
1267 Variable :=
1268 Value_Of
1269 (Name_Languages,
1270 Project.Extends.Decl.Attributes,
1271 Shared);
1272 Check_Default :=
1273 Variable /= Nil_Variable_Value
1274 and then Variable.Values = Nil_String;
1275 end if;
1276
1277 if Check_Default then
1278 Variable :=
1279 Value_Of
1280 (Name_Default_Language,
1281 Project.Decl.Attributes,
1282 Shared);
1283
1284 if Variable /= Nil_Variable_Value
1285 and then not Variable.Default
1286 then
1287 Get_Name_String (Variable.Value);
1288 To_Lower (Name_Buffer (1 .. Name_Len));
1289 Lang := Name_Find;
1290 Language_Htable.Set (Lang, Lang);
1291
1292 -- If no default language is declared, default to Ada
1293
1294 else
1295 Language_Htable.Set (Name_Ada, Name_Ada);
1296 end if;
1297 end if;
1298
1299 elsif Variable.Values /= Nil_String then
1300
1301 -- Attribute Languages is declared with a non empty list:
1302 -- put all the languages in Language_HTable.
1303
1304 List := Variable.Values;
1305 while List /= Nil_String loop
1306 Elem := Shared.String_Elements.Table (List);
1307
1308 Get_Name_String (Elem.Value);
1309 To_Lower (Name_Buffer (1 .. Name_Len));
1310 Lang := Name_Find;
1311 Language_Htable.Set (Lang, Lang);
1312
1313 List := Elem.Next;
1314 end loop;
1315 end if;
1316 end if;
1317 end Add_Config_Switches_For_Project;
1318
1319 procedure For_Every_Imported_Project is new For_Every_Project_Imported
1320 (State => Integer, Action => Add_Config_Switches_For_Project);
1321 -- Document this procedure ???
1322
1323 -- Local variables
1324
1325 Name : Name_Id;
1326 Count : Natural;
1327 Result : Argument_List_Access;
1328 Variable : Variable_Value;
1329 Dummy : Integer := 0;
1330
1331 -- Start of processing for Get_Config_Switches
1332
1333 begin
1334 For_Every_Imported_Project
1335 (By => Project,
1336 Tree => Project_Tree,
1337 With_State => Dummy,
1338 Include_Aggregated => True);
1339
1340 Name := Language_Htable.Get_First;
1341 Count := 0;
1342 while Name /= No_Name loop
1343 Count := Count + 1;
1344 Name := Language_Htable.Get_Next;
1345 end loop;
1346
1347 Result := new String_List (1 .. Count);
1348
1349 Count := 1;
1350 Name := Language_Htable.Get_First;
1351 while Name /= No_Name loop
1352
1353 -- Check if IDE'Compiler_Command is declared for the language.
1354 -- If it is, use its value to invoke gprconfig.
1355
1356 Variable :=
1357 Value_Of
1358 (Name,
1359 Attribute_Or_Array_Name => Name_Compiler_Command,
1360 In_Package => IDE,
1361 Shared => Shared,
1362 Force_Lower_Case_Index => True);
1363
1364 declare
1365 Config_Command : constant String :=
1366 "--config=" & Get_Name_String (Name);
1367
1368 Runtime_Name : constant String := Runtime_Name_For (Name);
1369
1370 begin
1371 -- In CodePeer mode, we do not take into account any compiler
1372 -- command from the package IDE.
1373
1374 if CodePeer_Mode
1375 or else Variable = Nil_Variable_Value
1376 or else Length_Of_Name (Variable.Value) = 0
1377 then
1378 Result (Count) :=
1379 new String'(Config_Command & ",," & Runtime_Name);
1380
1381 else
1382 At_Least_One_Compiler_Command := True;
1383
1384 declare
1385 Compiler_Command : constant String :=
1386 Get_Name_String (Variable.Value);
1387
1388 begin
1389 if Is_Absolute_Path (Compiler_Command) then
1390 Result (Count) :=
1391 new String'
1392 (Config_Command & ",," & Runtime_Name & ","
1393 & Containing_Directory (Compiler_Command) & ","
1394 & Simple_Name (Compiler_Command));
1395 else
1396 Result (Count) :=
1397 new String'
1398 (Config_Command & ",," & Runtime_Name & ",,"
1399 & Compiler_Command);
1400 end if;
1401 end;
1402 end if;
1403 end;
1404
1405 Count := Count + 1;
1406 Name := Language_Htable.Get_Next;
1407 end loop;
1408
1409 return Result;
1410 end Get_Config_Switches;
1411
1412 ------------------------
1413 -- Might_Have_Sources --
1414 ------------------------
1415
1416 function Might_Have_Sources (Project : Project_Id) return Boolean is
1417 Variable : Variable_Value;
1418
1419 begin
1420 Variable :=
1421 Value_Of (Name_Source_Dirs, Project.Decl.Attributes, Shared);
1422
1423 if Variable = Nil_Variable_Value
1424 or else Variable.Default
1425 or else Variable.Values /= Nil_String
1426 then
1427 Variable :=
1428 Value_Of (Name_Source_Files, Project.Decl.Attributes, Shared);
1429 return Variable = Nil_Variable_Value
1430 or else Variable.Default
1431 or else Variable.Values /= Nil_String;
1432
1433 else
1434 return False;
1435 end if;
1436 end Might_Have_Sources;
1437
1438 -- Local Variables
1439
1440 Success : Boolean;
1441 Config_Project_Node : Project_Node_Id := Empty_Node;
1442
1443 -- Start of processing for Get_Or_Create_Configuration_File
1444
1445 begin
1446 pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1447
1448 Free (Config_File_Path);
1449 Config := No_Project;
1450
1451 Get_Project_Target;
1452 Get_Project_Runtimes;
1453 Check_Builder_Switches;
1454
1455 -- Do not attempt to find a configuration project file when
1456 -- Config_File_Name is No_Configuration_File.
1457
1458 if Config_File_Name = No_Configuration_File then
1459 Config_File_Path := null;
1460
1461 else
1462 if Conf_File_Name'Length > 0 then
1463 Config_File_Path := Locate_Config_File (Conf_File_Name.all);
1464 else
1465 Config_File_Path := Locate_Config_File (Default_File_Name);
1466 end if;
1467
1468 if Config_File_Path = null then
1469 if not Allow_Automatic_Generation
1470 and then Conf_File_Name'Length > 0
1471 then
1472 Raise_Invalid_Config
1473 ("could not locate main configuration project "
1474 & Conf_File_Name.all);
1475 end if;
1476 end if;
1477 end if;
1478
1479 Automatically_Generated :=
1480 Allow_Automatic_Generation and then Config_File_Path = null;
1481
1482 <<Process_Config_File>>
1483
1484 if Automatically_Generated then
1485
1486 -- This might raise an Invalid_Config exception
1487
1488 Do_Autoconf;
1489
1490 -- If the config file is not auto-generated, warn if there is any --RTS
1491 -- switch, but not when the config file is generated in memory.
1492
1493 elsif Warn_For_RTS
1494 and then RTS_Languages.Get_First /= No_Name
1495 and then Opt.Warning_Mode /= Opt.Suppress
1496 and then On_Load_Config = null
1497 then
1498 Write_Line
1499 ("warning: " &
1500 "runtimes are taken into account only in auto-configuration");
1501 end if;
1502
1503 -- Parse the configuration file
1504
1505 if Verbose_Mode and then Config_File_Path /= null then
1506 Write_Str ("Checking configuration ");
1507 Write_Line (Config_File_Path.all);
1508 end if;
1509
1510 if Config_File_Path /= null then
1511 Prj.Part.Parse
1512 (In_Tree => Project_Node_Tree,
1513 Project => Config_Project_Node,
1514 Project_File_Name => Config_File_Path.all,
1515 Errout_Handling => Prj.Part.Finalize_If_Error,
1516 Packages_To_Check => Packages_To_Check,
1517 Current_Directory => Current_Directory,
1518 Is_Config_File => True,
1519 Env => Env);
1520 else
1521 Config_Project_Node := Empty_Node;
1522 end if;
1523
1524 if On_Load_Config /= null then
1525 On_Load_Config
1526 (Config_File => Config_Project_Node,
1527 Project_Node_Tree => Project_Node_Tree);
1528 end if;
1529
1530 if Config_Project_Node /= Empty_Node then
1531 Prj.Proc.Process_Project_Tree_Phase_1
1532 (In_Tree => Project_Tree,
1533 Project => Config,
1534 Packages_To_Check => Packages_To_Check,
1535 Success => Success,
1536 From_Project_Node => Config_Project_Node,
1537 From_Project_Node_Tree => Project_Node_Tree,
1538 Env => Env,
1539 Reset_Tree => False,
1540 On_New_Tree_Loaded => null);
1541 end if;
1542
1543 if Config_Project_Node = Empty_Node or else Config = No_Project then
1544 Raise_Invalid_Config
1545 ("processing of configuration project """
1546 & Config_File_Path.all & """ failed");
1547 end if;
1548
1549 -- Check that the target of the configuration file is the one the user
1550 -- specified on the command line. We do not need to check that when in
1551 -- auto-conf mode, since the appropriate target was passed to gprconfig.
1552
1553 if not Automatically_Generated
1554 and then not
1555 Check_Target
1556 (Config, Autoconf_Specified, Project_Tree, Selected_Target.all)
1557 then
1558 Automatically_Generated := True;
1559 goto Process_Config_File;
1560 end if;
1561 end Get_Or_Create_Configuration_File;
1562
1563 ------------------------
1564 -- Locate_Config_File --
1565 ------------------------
1566
1567 function Locate_Config_File (Name : String) return String_Access is
1568 Prefix_Path : constant String := Executable_Prefix_Path;
1569 begin
1570 if Prefix_Path'Length /= 0 then
1571 return Locate_Regular_File
1572 (Name,
1573 "." & Path_Separator &
1574 Prefix_Path & "share" & Directory_Separator & "gpr");
1575 else
1576 return Locate_Regular_File (Name, ".");
1577 end if;
1578 end Locate_Config_File;
1579
1580 ------------------------------------
1581 -- Parse_Project_And_Apply_Config --
1582 ------------------------------------
1583
1584 procedure Parse_Project_And_Apply_Config
1585 (Main_Project : out Prj.Project_Id;
1586 User_Project_Node : out Prj.Tree.Project_Node_Id;
1587 Config_File_Name : String := "";
1588 Autoconf_Specified : Boolean;
1589 Project_File_Name : String;
1590 Project_Tree : Prj.Project_Tree_Ref;
1591 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
1592 Env : in out Prj.Tree.Environment;
1593 Packages_To_Check : String_List_Access;
1594 Allow_Automatic_Generation : Boolean := True;
1595 Automatically_Generated : out Boolean;
1596 Config_File_Path : out String_Access;
1597 Target_Name : String := "";
1598 Normalized_Hostname : String;
1599 On_Load_Config : Config_File_Hook := null;
1600 Implicit_Project : Boolean := False;
1601 On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null)
1602 is
1603 Success : Boolean := False;
1604 Target_Try_Again : Boolean := True;
1605 Config_Try_Again : Boolean;
1606
1607 Finalization : Prj.Part.Errout_Mode := Prj.Part.Always_Finalize;
1608
1609 S : State := No_State;
1610
1611 Conf_File_Name : String_Access := new String'(Config_File_Name);
1612
1613 procedure Add_Directory (Dir : String);
1614 -- Add a directory at the end of the Project Path
1615
1616 Auto_Generated : Boolean;
1617
1618 -------------------
1619 -- Add_Directory --
1620 -------------------
1621
1622 procedure Add_Directory (Dir : String) is
1623 begin
1624 if Opt.Verbose_Mode then
1625 Write_Line (" Adding directory """ & Dir & """");
1626 end if;
1627
1628 Prj.Env.Add_Directories (Env.Project_Path, Dir);
1629 end Add_Directory;
1630
1631 begin
1632 pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1633
1634 -- Start with ignoring missing withed projects
1635
1636 Set_Ignore_Missing_With (Env.Flags, True);
1637
1638 -- Note: If in fact the config file is automatically generated, then
1639 -- Automatically_Generated will be set to True after invocation of
1640 -- Process_Project_And_Apply_Config.
1641
1642 Automatically_Generated := False;
1643
1644 -- Record Target_Value and Target_Origin
1645
1646 if Target_Name = "" then
1647 Opt.Target_Value := new String'(Normalized_Hostname);
1648 Opt.Target_Origin := Default;
1649 else
1650 Opt.Target_Value := new String'(Target_Name);
1651 Opt.Target_Origin := Specified;
1652 end if;
1653
1654 <<Parse_Again>>
1655
1656 -- Parse the user project tree
1657
1658 Project_Node_Tree.Incomplete_With := False;
1659 Env.Flags.Incomplete_Withs := False;
1660 Prj.Initialize (Project_Tree);
1661
1662 Main_Project := No_Project;
1663
1664 Prj.Part.Parse
1665 (In_Tree => Project_Node_Tree,
1666 Project => User_Project_Node,
1667 Project_File_Name => Project_File_Name,
1668 Errout_Handling => Finalization,
1669 Packages_To_Check => Packages_To_Check,
1670 Current_Directory => Current_Directory,
1671 Is_Config_File => False,
1672 Env => Env,
1673 Implicit_Project => Implicit_Project);
1674
1675 Finalization := Prj.Part.Finalize_If_Error;
1676
1677 if User_Project_Node = Empty_Node then
1678 return;
1679 end if;
1680
1681 -- If --target was not specified on the command line, then do Phase 1 to
1682 -- check if attribute Target is declared in the main project.
1683
1684 if Opt.Target_Origin /= Specified then
1685 Main_Project := No_Project;
1686 Process_Project_Tree_Phase_1
1687 (In_Tree => Project_Tree,
1688 Project => Main_Project,
1689 Packages_To_Check => Packages_To_Check,
1690 Success => Success,
1691 From_Project_Node => User_Project_Node,
1692 From_Project_Node_Tree => Project_Node_Tree,
1693 Env => Env,
1694 Reset_Tree => True,
1695 On_New_Tree_Loaded => On_New_Tree_Loaded);
1696
1697 if not Success then
1698 Main_Project := No_Project;
1699 return;
1700 end if;
1701
1702 declare
1703 Variable : constant Variable_Value :=
1704 Value_Of
1705 (Name_Target,
1706 Main_Project.Decl.Attributes,
1707 Project_Tree.Shared);
1708 begin
1709 if Variable /= Nil_Variable_Value
1710 and then not Variable.Default
1711 and then
1712 Get_Name_String (Variable.Value) /= Opt.Target_Value.all
1713 then
1714 if Target_Try_Again then
1715 Opt.Target_Value :=
1716 new String'(Get_Name_String (Variable.Value));
1717 Target_Try_Again := False;
1718 goto Parse_Again;
1719
1720 else
1721 Fail_Program
1722 (Project_Tree,
1723 "inconsistent value of attribute Target");
1724 end if;
1725 end if;
1726 end;
1727 end if;
1728
1729 -- If there are missing withed projects, the projects will be parsed
1730 -- again after the project path is extended with directories rooted
1731 -- at the compiler roots.
1732
1733 Config_Try_Again := Project_Node_Tree.Incomplete_With;
1734
1735 Process_Project_And_Apply_Config
1736 (Main_Project => Main_Project,
1737 User_Project_Node => User_Project_Node,
1738 Config_File_Name => Conf_File_Name.all,
1739 Autoconf_Specified => Autoconf_Specified,
1740 Project_Tree => Project_Tree,
1741 Project_Node_Tree => Project_Node_Tree,
1742 Env => Env,
1743 Packages_To_Check => Packages_To_Check,
1744 Allow_Automatic_Generation => Allow_Automatic_Generation,
1745 Automatically_Generated => Auto_Generated,
1746 Config_File_Path => Config_File_Path,
1747 Target_Name => Target_Name,
1748 Normalized_Hostname => Normalized_Hostname,
1749 On_Load_Config => On_Load_Config,
1750 On_New_Tree_Loaded => On_New_Tree_Loaded,
1751 Do_Phase_1 => Opt.Target_Origin = Specified);
1752
1753 if Auto_Generated then
1754 Automatically_Generated := True;
1755 end if;
1756
1757 -- Exit if there was an error. Otherwise, if Config_Try_Again is True,
1758 -- update the project path and try again.
1759
1760 if Main_Project /= No_Project and then Config_Try_Again then
1761 Set_Ignore_Missing_With (Env.Flags, False);
1762
1763 if Config_File_Path /= null then
1764 Conf_File_Name := new String'(Config_File_Path.all);
1765 end if;
1766
1767 -- For the second time the project files are parsed, the warning for
1768 -- --RTS= being only taken into account in auto-configuration are
1769 -- suppressed, as we are no longer in auto-configuration.
1770
1771 Warn_For_RTS := False;
1772
1773 -- Add the default directories corresponding to the compilers
1774
1775 Update_Project_Path
1776 (By => Main_Project,
1777 Tree => Project_Tree,
1778 With_State => S,
1779 Include_Aggregated => True,
1780 Imported_First => False);
1781
1782 declare
1783 Compiler_Root : Compiler_Root_Ptr;
1784 Prefix : String_Access;
1785 Runtime_Root : Runtime_Root_Ptr;
1786 Path_Value : constant String_Access := Getenv ("PATH");
1787
1788 begin
1789 if Opt.Verbose_Mode then
1790 Write_Line ("Setting the default project search directories");
1791
1792 if Prj.Current_Verbosity = High then
1793 if Path_Value = null or else Path_Value'Length = 0 then
1794 Write_Line ("No environment variable PATH");
1795
1796 else
1797 Write_Line ("PATH =");
1798 Write_Line (" " & Path_Value.all);
1799 end if;
1800 end if;
1801 end if;
1802
1803 -- Reorder the compiler roots in the PATH order
1804
1805 if First_Compiler_Root /= null
1806 and then First_Compiler_Root.Next /= null
1807 then
1808 declare
1809 Pred : Compiler_Root_Ptr;
1810 First_New_Comp : Compiler_Root_Ptr := null;
1811 New_Comp : Compiler_Root_Ptr := null;
1812 First : Positive := Path_Value'First;
1813 Last : Positive;
1814 Path_Last : Positive;
1815 begin
1816 while First <= Path_Value'Last loop
1817 Last := First;
1818
1819 if Path_Value (First) /= Path_Separator then
1820 while Last < Path_Value'Last
1821 and then Path_Value (Last + 1) /= Path_Separator
1822 loop
1823 Last := Last + 1;
1824 end loop;
1825
1826 Path_Last := Last;
1827 while Path_Last > First
1828 and then
1829 Path_Value (Path_Last) = Directory_Separator
1830 loop
1831 Path_Last := Path_Last - 1;
1832 end loop;
1833
1834 if Path_Last > First + 4
1835 and then
1836 Path_Value (Path_Last - 2 .. Path_Last) = "bin"
1837 and then
1838 Path_Value (Path_Last - 3) = Directory_Separator
1839 then
1840 Path_Last := Path_Last - 4;
1841 Pred := null;
1842 Compiler_Root := First_Compiler_Root;
1843 while Compiler_Root /= null
1844 and then Compiler_Root.Root.all /=
1845 Path_Value (First .. Path_Last)
1846 loop
1847 Pred := Compiler_Root;
1848 Compiler_Root := Compiler_Root.Next;
1849 end loop;
1850
1851 if Compiler_Root /= null then
1852 if Pred = null then
1853 First_Compiler_Root :=
1854 First_Compiler_Root.Next;
1855 else
1856 Pred.Next := Compiler_Root.Next;
1857 end if;
1858
1859 if First_New_Comp = null then
1860 First_New_Comp := Compiler_Root;
1861 else
1862 New_Comp.Next := Compiler_Root;
1863 end if;
1864
1865 New_Comp := Compiler_Root;
1866 New_Comp.Next := null;
1867 end if;
1868 end if;
1869 end if;
1870
1871 First := Last + 1;
1872 end loop;
1873
1874 if First_New_Comp /= null then
1875 New_Comp.Next := First_Compiler_Root;
1876 First_Compiler_Root := First_New_Comp;
1877 end if;
1878 end;
1879 end if;
1880
1881 -- Now that the compiler roots are in a correct order, add the
1882 -- directories corresponding to these compiler roots in the
1883 -- project path.
1884
1885 Compiler_Root := First_Compiler_Root;
1886 while Compiler_Root /= null loop
1887 Prefix := Compiler_Root.Root;
1888
1889 Runtime_Root := Compiler_Root.Runtimes;
1890 while Runtime_Root /= null loop
1891 Add_Directory
1892 (Runtime_Root.Root.all &
1893 Directory_Separator &
1894 "lib" &
1895 Directory_Separator &
1896 "gnat");
1897 Add_Directory
1898 (Runtime_Root.Root.all &
1899 Directory_Separator &
1900 "share" &
1901 Directory_Separator &
1902 "gpr");
1903 Runtime_Root := Runtime_Root.Next;
1904 end loop;
1905
1906 Add_Directory
1907 (Prefix.all &
1908 Directory_Separator &
1909 Opt.Target_Value.all &
1910 Directory_Separator &
1911 "lib" &
1912 Directory_Separator &
1913 "gnat");
1914 Add_Directory
1915 (Prefix.all &
1916 Directory_Separator &
1917 Opt.Target_Value.all &
1918 Directory_Separator &
1919 "share" &
1920 Directory_Separator &
1921 "gpr");
1922 Add_Directory
1923 (Prefix.all &
1924 Directory_Separator &
1925 "share" &
1926 Directory_Separator &
1927 "gpr");
1928 Add_Directory
1929 (Prefix.all &
1930 Directory_Separator &
1931 "lib" &
1932 Directory_Separator &
1933 "gnat");
1934 Compiler_Root := Compiler_Root.Next;
1935 end loop;
1936 end;
1937
1938 -- And parse again the project files. There will be no missing
1939 -- withed projects, as Ignore_Missing_With is set to False in
1940 -- the environment flags, so there is no risk of endless loop here.
1941
1942 goto Parse_Again;
1943 end if;
1944 end Parse_Project_And_Apply_Config;
1945
1946 --------------------------------------
1947 -- Process_Project_And_Apply_Config --
1948 --------------------------------------
1949
1950 procedure Process_Project_And_Apply_Config
1951 (Main_Project : out Prj.Project_Id;
1952 User_Project_Node : Prj.Tree.Project_Node_Id;
1953 Config_File_Name : String := "";
1954 Autoconf_Specified : Boolean;
1955 Project_Tree : Prj.Project_Tree_Ref;
1956 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
1957 Env : in out Prj.Tree.Environment;
1958 Packages_To_Check : String_List_Access;
1959 Allow_Automatic_Generation : Boolean := True;
1960 Automatically_Generated : out Boolean;
1961 Config_File_Path : out String_Access;
1962 Target_Name : String := "";
1963 Normalized_Hostname : String;
1964 On_Load_Config : Config_File_Hook := null;
1965 Reset_Tree : Boolean := True;
1966 On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null;
1967 Do_Phase_1 : Boolean := True)
1968 is
1969 Shared : constant Shared_Project_Tree_Data_Access :=
1970 Project_Tree.Shared;
1971 Main_Config_Project : Project_Id;
1972 Success : Boolean;
1973
1974 Conf_Project : Project_Id := No_Project;
1975 -- The object directory of this project is used to store the config
1976 -- project file in auto-configuration. Set by Check_Project below.
1977
1978 procedure Check_Project (Project : Project_Id);
1979 -- Look for a non aggregate project. If one is found, put its project Id
1980 -- in Conf_Project.
1981
1982 -------------------
1983 -- Check_Project --
1984 -------------------
1985
1986 procedure Check_Project (Project : Project_Id) is
1987 begin
1988 if Project.Qualifier = Aggregate
1989 or else
1990 Project.Qualifier = Aggregate_Library
1991 then
1992 declare
1993 List : Aggregated_Project_List := Project.Aggregated_Projects;
1994
1995 begin
1996 -- Look for a non aggregate project until one is found
1997
1998 while Conf_Project = No_Project and then List /= null loop
1999 Check_Project (List.Project);
2000 List := List.Next;
2001 end loop;
2002 end;
2003
2004 else
2005 Conf_Project := Project;
2006 end if;
2007 end Check_Project;
2008
2009 -- Start of processing for Process_Project_And_Apply_Config
2010
2011 begin
2012 Automatically_Generated := False;
2013
2014 if Do_Phase_1 then
2015 Main_Project := No_Project;
2016 Process_Project_Tree_Phase_1
2017 (In_Tree => Project_Tree,
2018 Project => Main_Project,
2019 Packages_To_Check => Packages_To_Check,
2020 Success => Success,
2021 From_Project_Node => User_Project_Node,
2022 From_Project_Node_Tree => Project_Node_Tree,
2023 Env => Env,
2024 Reset_Tree => Reset_Tree,
2025 On_New_Tree_Loaded => On_New_Tree_Loaded);
2026
2027 if not Success then
2028 Main_Project := No_Project;
2029 return;
2030 end if;
2031 end if;
2032
2033 if Project_Tree.Source_Info_File_Name /= null then
2034 if not Is_Absolute_Path (Project_Tree.Source_Info_File_Name.all) then
2035 declare
2036 Obj_Dir : constant Variable_Value :=
2037 Value_Of
2038 (Name_Object_Dir,
2039 Main_Project.Decl.Attributes,
2040 Shared);
2041
2042 begin
2043 if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
2044 Get_Name_String (Main_Project.Directory.Display_Name);
2045
2046 else
2047 if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
2048 Get_Name_String (Obj_Dir.Value);
2049
2050 else
2051 Name_Len := 0;
2052 Add_Str_To_Name_Buffer
2053 (Get_Name_String (Main_Project.Directory.Display_Name));
2054 Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
2055 end if;
2056 end if;
2057
2058 Add_Char_To_Name_Buffer (Directory_Separator);
2059 Add_Str_To_Name_Buffer (Project_Tree.Source_Info_File_Name.all);
2060 Free (Project_Tree.Source_Info_File_Name);
2061 Project_Tree.Source_Info_File_Name :=
2062 new String'(Name_Buffer (1 .. Name_Len));
2063 end;
2064 end if;
2065
2066 Read_Source_Info_File (Project_Tree);
2067 end if;
2068
2069 -- Get the first project that is not an aggregate project or an
2070 -- aggregate library project. The object directory of this project will
2071 -- be used to store the config project file in auto-configuration.
2072
2073 Check_Project (Main_Project);
2074
2075 -- Fail if there is only aggregate projects and aggregate library
2076 -- projects in the project tree.
2077
2078 if Conf_Project = No_Project then
2079 Raise_Invalid_Config ("there are no non-aggregate projects");
2080 end if;
2081
2082 -- Find configuration file
2083
2084 Get_Or_Create_Configuration_File
2085 (Config => Main_Config_Project,
2086 Project => Main_Project,
2087 Conf_Project => Conf_Project,
2088 Project_Tree => Project_Tree,
2089 Project_Node_Tree => Project_Node_Tree,
2090 Env => Env,
2091 Allow_Automatic_Generation => Allow_Automatic_Generation,
2092 Config_File_Name => Config_File_Name,
2093 Autoconf_Specified => Autoconf_Specified,
2094 Target_Name => Target_Name,
2095 Normalized_Hostname => Normalized_Hostname,
2096 Packages_To_Check => Packages_To_Check,
2097 Config_File_Path => Config_File_Path,
2098 Automatically_Generated => Automatically_Generated,
2099 On_Load_Config => On_Load_Config);
2100
2101 Apply_Config_File (Main_Config_Project, Project_Tree);
2102
2103 -- Finish processing the user's project
2104
2105 Prj.Proc.Process_Project_Tree_Phase_2
2106 (In_Tree => Project_Tree,
2107 Project => Main_Project,
2108 Success => Success,
2109 From_Project_Node => User_Project_Node,
2110 From_Project_Node_Tree => Project_Node_Tree,
2111 Env => Env);
2112
2113 if Success then
2114 if Project_Tree.Source_Info_File_Name /= null
2115 and then not Project_Tree.Source_Info_File_Exists
2116 then
2117 Write_Source_Info_File (Project_Tree);
2118 end if;
2119
2120 else
2121 Main_Project := No_Project;
2122 end if;
2123 end Process_Project_And_Apply_Config;
2124
2125 --------------------------
2126 -- Raise_Invalid_Config --
2127 --------------------------
2128
2129 procedure Raise_Invalid_Config (Msg : String) is
2130 begin
2131 Raise_Exception (Invalid_Config'Identity, Msg);
2132 end Raise_Invalid_Config;
2133
2134 ----------------------
2135 -- Runtime_Name_For --
2136 ----------------------
2137
2138 function Runtime_Name_For (Language : Name_Id) return String is
2139 begin
2140 if RTS_Languages.Get (Language) /= No_Name then
2141 return Get_Name_String (RTS_Languages.Get (Language));
2142 else
2143 return "";
2144 end if;
2145 end Runtime_Name_For;
2146
2147 --------------------------
2148 -- Runtime_Name_Set_For --
2149 --------------------------
2150
2151 function Runtime_Name_Set_For (Language : Name_Id) return Boolean is
2152 begin
2153 return RTS_Languages.Get (Language) /= No_Name;
2154 end Runtime_Name_Set_For;
2155
2156 ---------------------
2157 -- Set_Runtime_For --
2158 ---------------------
2159
2160 procedure Set_Runtime_For (Language : Name_Id; RTS_Name : String) is
2161 begin
2162 Name_Len := RTS_Name'Length;
2163 Name_Buffer (1 .. Name_Len) := RTS_Name;
2164 RTS_Languages.Set (Language, Name_Find);
2165 end Set_Runtime_For;
2166
2167 ----------------------------
2168 -- Look_For_Project_Paths --
2169 ----------------------------
2170
2171 procedure Look_For_Project_Paths
2172 (Project : Project_Id;
2173 Tree : Project_Tree_Ref;
2174 With_State : in out State)
2175 is
2176 Lang_Id : Language_Ptr;
2177 Compiler_Root : Compiler_Root_Ptr;
2178 Runtime_Root : Runtime_Root_Ptr;
2179 Comp_Driver : String_Access;
2180 Comp_Dir : String_Access;
2181 Prefix : String_Access;
2182
2183 pragma Unreferenced (Tree);
2184
2185 begin
2186 With_State := No_State;
2187
2188 Lang_Id := Project.Languages;
2189 while Lang_Id /= No_Language_Index loop
2190 if Lang_Id.Config.Compiler_Driver /= No_File then
2191 Comp_Driver :=
2192 new String'
2193 (Get_Name_String (Lang_Id.Config.Compiler_Driver));
2194
2195 -- Get the absolute path of the compiler driver
2196
2197 if not Is_Absolute_Path (Comp_Driver.all) then
2198 Comp_Driver := Locate_Exec_On_Path (Comp_Driver.all);
2199 end if;
2200
2201 if Comp_Driver /= null and then Comp_Driver'Length > 0 then
2202 Comp_Dir :=
2203 new String'
2204 (Containing_Directory (Comp_Driver.all));
2205
2206 -- Consider only the compiler drivers that are in "bin"
2207 -- subdirectories.
2208
2209 if Simple_Name (Comp_Dir.all) = "bin" then
2210 Prefix :=
2211 new String'(Containing_Directory (Comp_Dir.all));
2212
2213 -- Check if the compiler root is already in the list. If it
2214 -- is not, add it to the list.
2215
2216 Compiler_Root := First_Compiler_Root;
2217 while Compiler_Root /= null loop
2218 exit when Prefix.all = Compiler_Root.Root.all;
2219 Compiler_Root := Compiler_Root.Next;
2220 end loop;
2221
2222 if Compiler_Root = null then
2223 First_Compiler_Root :=
2224 new Compiler_Root_Data'
2225 (Root => Prefix,
2226 Runtimes => null,
2227 Next => First_Compiler_Root);
2228 Compiler_Root := First_Compiler_Root;
2229 end if;
2230
2231 -- If there is a runtime for this compiler, check if it is
2232 -- recorded with the compiler root. If it is not, record
2233 -- the runtime.
2234
2235 declare
2236 Runtime : constant String :=
2237 Runtime_Name_For (Lang_Id.Name);
2238 Root : String_Access;
2239
2240 begin
2241 if Runtime'Length > 0 then
2242 if Is_Absolute_Path (Runtime) then
2243 Root := new String'(Runtime);
2244
2245 else
2246 Root :=
2247 new String'
2248 (Prefix.all &
2249 Directory_Separator &
2250 Opt.Target_Value.all &
2251 Directory_Separator &
2252 Runtime);
2253 end if;
2254
2255 Runtime_Root := Compiler_Root.Runtimes;
2256 while Runtime_Root /= null loop
2257 exit when Root.all = Runtime_Root.Root.all;
2258 Runtime_Root := Runtime_Root.Next;
2259 end loop;
2260
2261 if Runtime_Root = null then
2262 Compiler_Root.Runtimes :=
2263 new Runtime_Root_Data'
2264 (Root => Root,
2265 Next => Compiler_Root.Runtimes);
2266 end if;
2267 end if;
2268 end;
2269 end if;
2270 end if;
2271 end if;
2272
2273 Lang_Id := Lang_Id.Next;
2274 end loop;
2275 end Look_For_Project_Paths;
2276 end Prj.Conf;
Mirror of the offical gcc git repository hosted at gcc.gnu.org