?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
2014-10-31 Vasiliy Fofanov <fofanov@adacore.com>
[official-gcc.git] / gcc / ada / prj-conf.adb
blob8d4e3d46d918e67831187d1d8d07938df4317d54
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 ("invalid target name """
637 & Get_Name_String (Tgt_Name) & """ in configuration");
638 else
639 Raise_Invalid_Config
640 ("no target specified in configuration file");
641 end if;
642 end if;
643 end if;
644
645 return True;
646 end Check_Target;
647
648 --------------------------------------
649 -- Get_Or_Create_Configuration_File --
650 --------------------------------------
651
652 procedure Get_Or_Create_Configuration_File
653 (Project : Project_Id;
654 Conf_Project : Project_Id;
655 Project_Tree : Project_Tree_Ref;
656 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
657 Env : in out Prj.Tree.Environment;
658 Allow_Automatic_Generation : Boolean;
659 Config_File_Name : String := "";
660 Autoconf_Specified : Boolean;
661 Target_Name : String := "";
662 Normalized_Hostname : String;
663 Packages_To_Check : String_List_Access := null;
664 Config : out Prj.Project_Id;
665 Config_File_Path : out String_Access;
666 Automatically_Generated : out Boolean;
667 On_Load_Config : Config_File_Hook := null)
668 is
669 Shared : constant Shared_Project_Tree_Data_Access := Project_Tree.Shared;
670
671 At_Least_One_Compiler_Command : Boolean := False;
672 -- Set to True if at least one attribute Ide'Compiler_Command is
673 -- specified for one language of the system.
674
675 Conf_File_Name : String_Access := new String'(Config_File_Name);
676 -- The configuration project file name. May be modified if there are
677 -- switches --config= in the Builder package of the main project.
678
679 Selected_Target : String_Access := new String'(Target_Name);
680
681 function Default_File_Name return String;
682 -- Return the name of the default config file that should be tested
683
684 procedure Do_Autoconf;
685 -- Generate a new config file through gprconfig. In case of error, this
686 -- raises the Invalid_Config exception with an appropriate message
687
688 procedure Check_Builder_Switches;
689 -- Check for switches --config and --RTS in package Builder
690
691 procedure Get_Project_Target;
692 -- If Target_Name is empty, get the specified target in the project
693 -- file, if any.
694
695 procedure Get_Project_Runtimes;
696 -- Get the various Runtime (<lang>) in the project file or any project
697 -- it extends, if any are specified.
698
699 function Get_Config_Switches return Argument_List_Access;
700 -- Return the --config switches to use for gprconfig
701
702 function Get_Db_Switches return Argument_List_Access;
703 -- Return the --db switches to use for gprconfig
704
705 function Might_Have_Sources (Project : Project_Id) return Boolean;
706 -- True if the specified project might have sources (ie the user has not
707 -- explicitly specified it. We haven't checked the file system, nor do
708 -- we need to at this stage.
709
710 ----------------------------
711 -- Check_Builder_Switches --
712 ----------------------------
713
714 procedure Check_Builder_Switches is
715 Get_RTS_Switches : constant Boolean :=
716 RTS_Languages.Get_First = No_Name;
717 -- If no switch --RTS have been specified on the command line, look
718 -- for --RTS switches in the Builder switches.
719
720 Builder : constant Package_Id :=
721 Value_Of (Name_Builder, Project.Decl.Packages, Shared);
722
723 Switch_Array_Id : Array_Element_Id;
724 -- The Switches to be checked
725
726 procedure Check_Switches;
727 -- Check the switches in Switch_Array_Id
728
729 --------------------
730 -- Check_Switches --
731 --------------------
732
733 procedure Check_Switches is
734 Switch_Array : Array_Element;
735 Switch_List : String_List_Id := Nil_String;
736 Switch : String_Element;
737 Lang : Name_Id;
738 Lang_Last : Positive;
739
740 begin
741 while Switch_Array_Id /= No_Array_Element loop
742 Switch_Array :=
743 Shared.Array_Elements.Table (Switch_Array_Id);
744
745 Switch_List := Switch_Array.Value.Values;
746 List_Loop : while Switch_List /= Nil_String loop
747 Switch := Shared.String_Elements.Table (Switch_List);
748
749 if Switch.Value /= No_Name then
750 Get_Name_String (Switch.Value);
751
752 if Conf_File_Name'Length = 0
753 and then Name_Len > 9
754 and then Name_Buffer (1 .. 9) = "--config="
755 then
756 Conf_File_Name :=
757 new String'(Name_Buffer (10 .. Name_Len));
758
759 elsif Get_RTS_Switches
760 and then Name_Len >= 7
761 and then Name_Buffer (1 .. 5) = "--RTS"
762 then
763 if Name_Buffer (6) = '=' then
764 if not Runtime_Name_Set_For (Name_Ada) then
765 Set_Runtime_For
766 (Name_Ada,
767 Name_Buffer (7 .. Name_Len));
768 end if;
769
770 elsif Name_Len > 7
771 and then Name_Buffer (6) = ':'
772 and then Name_Buffer (7) /= '='
773 then
774 Lang_Last := 7;
775 while Lang_Last < Name_Len
776 and then Name_Buffer (Lang_Last + 1) /= '='
777 loop
778 Lang_Last := Lang_Last + 1;
779 end loop;
780
781 if Name_Buffer (Lang_Last + 1) = '=' then
782 declare
783 RTS : constant String :=
784 Name_Buffer (Lang_Last + 2 .. Name_Len);
785 begin
786 Name_Buffer (1 .. Lang_Last - 6) :=
787 Name_Buffer (7 .. Lang_Last);
788 Name_Len := Lang_Last - 6;
789 To_Lower (Name_Buffer (1 .. Name_Len));
790 Lang := Name_Find;
791
792 if not Runtime_Name_Set_For (Lang) then
793 Set_Runtime_For (Lang, RTS);
794 end if;
795 end;
796 end if;
797 end if;
798 end if;
799 end if;
800
801 Switch_List := Switch.Next;
802 end loop List_Loop;
803
804 Switch_Array_Id := Switch_Array.Next;
805 end loop;
806 end Check_Switches;
807
808 -- Start of processing for Check_Builder_Switches
809
810 begin
811 if Builder /= No_Package then
812 Switch_Array_Id :=
813 Value_Of
814 (Name => Name_Switches,
815 In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
816 Shared => Shared);
817 Check_Switches;
818
819 Switch_Array_Id :=
820 Value_Of
821 (Name => Name_Default_Switches,
822 In_Arrays => Shared.Packages.Table (Builder).Decl.Arrays,
823 Shared => Shared);
824 Check_Switches;
825 end if;
826 end Check_Builder_Switches;
827
828 ------------------------
829 -- Get_Project_Target --
830 ------------------------
831
832 procedure Get_Project_Target is
833 begin
834 if Selected_Target'Length = 0 then
835
836 -- Check if attribute Target is specified in the main
837 -- project, or in a project it extends. If it is, use this
838 -- target to invoke gprconfig.
839
840 declare
841 Variable : Variable_Value;
842 Proj : Project_Id;
843 Tgt_Name : Name_Id := No_Name;
844
845 begin
846 Proj := Project;
847 Project_Loop :
848 while Proj /= No_Project loop
849 Variable :=
850 Value_Of (Name_Target, Proj.Decl.Attributes, Shared);
851
852 if Variable /= Nil_Variable_Value
853 and then not Variable.Default
854 and then Variable.Value /= No_Name
855 then
856 Tgt_Name := Variable.Value;
857 exit Project_Loop;
858 end if;
859
860 Proj := Proj.Extends;
861 end loop Project_Loop;
862
863 if Tgt_Name /= No_Name then
864 Selected_Target := new String'(Get_Name_String (Tgt_Name));
865 end if;
866 end;
867 end if;
868 end Get_Project_Target;
869
870 --------------------------
871 -- Get_Project_Runtimes --
872 --------------------------
873
874 procedure Get_Project_Runtimes is
875 Element : Array_Element;
876 Id : Array_Element_Id;
877 Lang : Name_Id;
878 Proj : Project_Id;
879
880 begin
881 Proj := Project;
882 while Proj /= No_Project loop
883 Id := Value_Of (Name_Runtime, Proj.Decl.Arrays, Shared);
884 while Id /= No_Array_Element loop
885 Element := Shared.Array_Elements.Table (Id);
886 Lang := Element.Index;
887
888 if not Runtime_Name_Set_For (Lang) then
889 Set_Runtime_For
890 (Lang, RTS_Name => Get_Name_String (Element.Value.Value));
891 end if;
892
893 Id := Element.Next;
894 end loop;
895
896 Proj := Proj.Extends;
897 end loop;
898 end Get_Project_Runtimes;
899
900 -----------------------
901 -- Default_File_Name --
902 -----------------------
903
904 function Default_File_Name return String is
905 Ada_RTS : constant String := Runtime_Name_For (Name_Ada);
906 Tmp : String_Access;
907
908 begin
909 if Selected_Target'Length /= 0 then
910 if Ada_RTS /= "" then
911 return
912 Selected_Target.all & '-' &
913 Ada_RTS & Config_Project_File_Extension;
914 else
915 return
916 Selected_Target.all & Config_Project_File_Extension;
917 end if;
918
919 elsif Ada_RTS /= "" then
920 return Ada_RTS & Config_Project_File_Extension;
921
922 else
923 Tmp := Getenv (Config_Project_Env_Var);
924
925 declare
926 T : constant String := Tmp.all;
927
928 begin
929 Free (Tmp);
930
931 if T'Length = 0 then
932 return Default_Config_Name;
933 else
934 return T;
935 end if;
936 end;
937 end if;
938 end Default_File_Name;
939
940 -----------------
941 -- Do_Autoconf --
942 -----------------
943
944 procedure Do_Autoconf is
945 Obj_Dir : constant Variable_Value :=
946 Value_Of
947 (Name_Object_Dir,
948 Conf_Project.Decl.Attributes,
949 Shared);
950
951 Gprconfig_Path : String_Access;
952 Success : Boolean;
953
954 begin
955 Gprconfig_Path := Locate_Exec_On_Path (Gprconfig_Name);
956
957 if Gprconfig_Path = null then
958 Raise_Invalid_Config
959 ("could not locate gprconfig for auto-configuration");
960 end if;
961
962 -- First, find the object directory of the Conf_Project
963
964 if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
965 Get_Name_String (Conf_Project.Directory.Display_Name);
966
967 else
968 if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
969 Get_Name_String (Obj_Dir.Value);
970
971 else
972 Name_Len := 0;
973 Add_Str_To_Name_Buffer
974 (Get_Name_String (Conf_Project.Directory.Display_Name));
975 Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
976 end if;
977 end if;
978
979 if Subdirs /= null then
980 Add_Char_To_Name_Buffer (Directory_Separator);
981 Add_Str_To_Name_Buffer (Subdirs.all);
982 end if;
983
984 for J in 1 .. Name_Len loop
985 if Name_Buffer (J) = '/' then
986 Name_Buffer (J) := Directory_Separator;
987 end if;
988 end loop;
989
990 -- Make sure that Obj_Dir ends with a directory separator
991
992 if Name_Buffer (Name_Len) /= Directory_Separator then
993 Name_Len := Name_Len + 1;
994 Name_Buffer (Name_Len) := Directory_Separator;
995 end if;
996
997 declare
998 Obj_Dir : constant String := Name_Buffer (1 .. Name_Len);
999 Config_Switches : Argument_List_Access;
1000 Db_Switches : Argument_List_Access;
1001 Args : Argument_List (1 .. 5);
1002 Arg_Last : Positive;
1003 Obj_Dir_Exists : Boolean := True;
1004
1005 begin
1006 -- Check if the object directory exists. If Setup_Projects is True
1007 -- (-p) and directory does not exist, attempt to create it.
1008 -- Otherwise, if directory does not exist, fail without calling
1009 -- gprconfig.
1010
1011 if not Is_Directory (Obj_Dir)
1012 and then (Setup_Projects or else Subdirs /= null)
1013 then
1014 begin
1015 Create_Path (Obj_Dir);
1016
1017 if not Quiet_Output then
1018 Write_Str ("object directory """);
1019 Write_Str (Obj_Dir);
1020 Write_Line (""" created");
1021 end if;
1022
1023 exception
1024 when others =>
1025 Raise_Invalid_Config
1026 ("could not create object directory " & Obj_Dir);
1027 end;
1028 end if;
1029
1030 if not Is_Directory (Obj_Dir) then
1031 case Env.Flags.Require_Obj_Dirs is
1032 when Error =>
1033 Raise_Invalid_Config
1034 ("object directory " & Obj_Dir & " does not exist");
1035
1036 when Warning =>
1037 Prj.Err.Error_Msg
1038 (Env.Flags,
1039 "?object directory " & Obj_Dir & " does not exist");
1040 Obj_Dir_Exists := False;
1041
1042 when Silent =>
1043 null;
1044 end case;
1045 end if;
1046
1047 -- Get the config switches. This should be done only now, as some
1048 -- runtimes may have been found in the Builder switches.
1049
1050 Config_Switches := Get_Config_Switches;
1051
1052 -- Get eventual --db switches
1053
1054 Db_Switches := Get_Db_Switches;
1055
1056 -- Invoke gprconfig
1057
1058 Args (1) := new String'("--batch");
1059 Args (2) := new String'("-o");
1060
1061 -- If no config file was specified, set the auto.cgpr one
1062
1063 if Conf_File_Name'Length = 0 then
1064 if Obj_Dir_Exists then
1065 Args (3) := new String'(Obj_Dir & Auto_Cgpr);
1066
1067 else
1068 declare
1069 Path_FD : File_Descriptor;
1070 Path_Name : Path_Name_Type;
1071
1072 begin
1073 Prj.Env.Create_Temp_File
1074 (Shared => Project_Tree.Shared,
1075 Path_FD => Path_FD,
1076 Path_Name => Path_Name,
1077 File_Use => "configuration file");
1078
1079 if Path_FD /= Invalid_FD then
1080 declare
1081 Temp_Dir : constant String :=
1082 Containing_Directory
1083 (Get_Name_String (Path_Name));
1084 begin
1085 GNAT.OS_Lib.Close (Path_FD);
1086 Args (3) :=
1087 new String'(Temp_Dir &
1088 Directory_Separator &
1089 Auto_Cgpr);
1090 Delete_File (Get_Name_String (Path_Name));
1091 end;
1092
1093 else
1094 -- We'll have an error message later on
1095
1096 Args (3) := new String'(Obj_Dir & Auto_Cgpr);
1097 end if;
1098 end;
1099 end if;
1100 else
1101 Args (3) := Conf_File_Name;
1102 end if;
1103
1104 Arg_Last := 3;
1105
1106 if Selected_Target /= null and then
1107 Selected_Target.all /= ""
1108 then
1109 Args (4) :=
1110 new String'("--target=" & Selected_Target.all);
1111 Arg_Last := 4;
1112 elsif Normalized_Hostname /= "" then
1113 if At_Least_One_Compiler_Command then
1114 Args (4) :=
1115 new String'("--target=all");
1116 else
1117 Args (4) :=
1118 new String'("--target=" & Normalized_Hostname);
1119 end if;
1120
1121 Arg_Last := 4;
1122 end if;
1123
1124 if not Verbose_Mode then
1125 Arg_Last := Arg_Last + 1;
1126 Args (Arg_Last) := new String'("-q");
1127 end if;
1128
1129 if Verbose_Mode then
1130 Write_Str (Gprconfig_Name);
1131
1132 for J in 1 .. Arg_Last loop
1133 Write_Char (' ');
1134 Write_Str (Args (J).all);
1135 end loop;
1136
1137 for J in Config_Switches'Range loop
1138 Write_Char (' ');
1139 Write_Str (Config_Switches (J).all);
1140 end loop;
1141
1142 for J in Db_Switches'Range loop
1143 Write_Char (' ');
1144 Write_Str (Db_Switches (J).all);
1145 end loop;
1146
1147 Write_Eol;
1148
1149 elsif not Quiet_Output then
1150
1151 -- Display no message if we are creating auto.cgpr, unless in
1152 -- verbose mode.
1153
1154 if Config_File_Name'Length > 0 or else Verbose_Mode then
1155 Write_Str ("creating ");
1156 Write_Str (Simple_Name (Args (3).all));
1157 Write_Eol;
1158 end if;
1159 end if;
1160
1161 Spawn (Gprconfig_Path.all, Args (1 .. Arg_Last) &
1162 Config_Switches.all & Db_Switches.all,
1163 Success);
1164
1165 Free (Config_Switches);
1166
1167 Config_File_Path := Locate_Config_File (Args (3).all);
1168
1169 if Config_File_Path = null then
1170 Raise_Invalid_Config
1171 ("could not create " & Args (3).all);
1172 end if;
1173
1174 for F in Args'Range loop
1175 Free (Args (F));
1176 end loop;
1177 end;
1178 end Do_Autoconf;
1179
1180 ---------------------
1181 -- Get_Db_Switches --
1182 ---------------------
1183
1184 function Get_Db_Switches return Argument_List_Access is
1185 Result : Argument_List_Access;
1186 Nmb_Arg : Natural;
1187 begin
1188 Nmb_Arg :=
1189 (2 * Db_Switch_Args.Last) + Boolean'Pos (not Load_Standard_Base);
1190 Result := new Argument_List (1 .. Nmb_Arg);
1191
1192 if Nmb_Arg /= 0 then
1193 for J in 1 .. Db_Switch_Args.Last loop
1194 Result (2 * J - 1) :=
1195 new String'("--db");
1196 Result (2 * J) :=
1197 new String'(Get_Name_String (Db_Switch_Args.Table (J)));
1198 end loop;
1199
1200 if not Load_Standard_Base then
1201 Result (Result'Last) := new String'("--db-");
1202 end if;
1203 end if;
1204
1205 return Result;
1206 end Get_Db_Switches;
1207
1208 -------------------------
1209 -- Get_Config_Switches --
1210 -------------------------
1211
1212 function Get_Config_Switches return Argument_List_Access is
1213
1214 package Language_Htable is new GNAT.HTable.Simple_HTable
1215 (Header_Num => Prj.Header_Num,
1216 Element => Name_Id,
1217 No_Element => No_Name,
1218 Key => Name_Id,
1219 Hash => Prj.Hash,
1220 Equal => "=");
1221 -- Hash table to keep the languages used in the project tree
1222
1223 IDE : constant Package_Id :=
1224 Value_Of (Name_Ide, Project.Decl.Packages, Shared);
1225
1226 procedure Add_Config_Switches_For_Project
1227 (Project : Project_Id;
1228 Tree : Project_Tree_Ref;
1229 With_State : in out Integer);
1230 -- Add all --config switches for this project. This is also called
1231 -- for aggregate projects.
1232
1233 -------------------------------------
1234 -- Add_Config_Switches_For_Project --
1235 -------------------------------------
1236
1237 procedure Add_Config_Switches_For_Project
1238 (Project : Project_Id;
1239 Tree : Project_Tree_Ref;
1240 With_State : in out Integer)
1241 is
1242 pragma Unreferenced (With_State);
1243
1244 Shared : constant Shared_Project_Tree_Data_Access := Tree.Shared;
1245
1246 Variable : Variable_Value;
1247 Check_Default : Boolean;
1248 Lang : Name_Id;
1249 List : String_List_Id;
1250 Elem : String_Element;
1251
1252 begin
1253 if Might_Have_Sources (Project) then
1254 Variable :=
1255 Value_Of (Name_Languages, Project.Decl.Attributes, Shared);
1256
1257 if Variable = Nil_Variable_Value or else Variable.Default then
1258
1259 -- Languages is not declared. If it is not an extending
1260 -- project, or if it extends a project with no Languages,
1261 -- check for Default_Language.
1262
1263 Check_Default := Project.Extends = No_Project;
1264
1265 if not Check_Default then
1266 Variable :=
1267 Value_Of
1268 (Name_Languages,
1269 Project.Extends.Decl.Attributes,
1270 Shared);
1271 Check_Default :=
1272 Variable /= Nil_Variable_Value
1273 and then Variable.Values = Nil_String;
1274 end if;
1275
1276 if Check_Default then
1277 Variable :=
1278 Value_Of
1279 (Name_Default_Language,
1280 Project.Decl.Attributes,
1281 Shared);
1282
1283 if Variable /= Nil_Variable_Value
1284 and then not Variable.Default
1285 then
1286 Get_Name_String (Variable.Value);
1287 To_Lower (Name_Buffer (1 .. Name_Len));
1288 Lang := Name_Find;
1289 Language_Htable.Set (Lang, Lang);
1290
1291 -- If no default language is declared, default to Ada
1292
1293 else
1294 Language_Htable.Set (Name_Ada, Name_Ada);
1295 end if;
1296 end if;
1297
1298 elsif Variable.Values /= Nil_String then
1299
1300 -- Attribute Languages is declared with a non empty list:
1301 -- put all the languages in Language_HTable.
1302
1303 List := Variable.Values;
1304 while List /= Nil_String loop
1305 Elem := Shared.String_Elements.Table (List);
1306
1307 Get_Name_String (Elem.Value);
1308 To_Lower (Name_Buffer (1 .. Name_Len));
1309 Lang := Name_Find;
1310 Language_Htable.Set (Lang, Lang);
1311
1312 List := Elem.Next;
1313 end loop;
1314 end if;
1315 end if;
1316 end Add_Config_Switches_For_Project;
1317
1318 procedure For_Every_Imported_Project is new For_Every_Project_Imported
1319 (State => Integer, Action => Add_Config_Switches_For_Project);
1320 -- Document this procedure ???
1321
1322 -- Local variables
1323
1324 Name : Name_Id;
1325 Count : Natural;
1326 Result : Argument_List_Access;
1327 Variable : Variable_Value;
1328 Dummy : Integer := 0;
1329
1330 -- Start of processing for Get_Config_Switches
1331
1332 begin
1333 For_Every_Imported_Project
1334 (By => Project,
1335 Tree => Project_Tree,
1336 With_State => Dummy,
1337 Include_Aggregated => True);
1338
1339 Name := Language_Htable.Get_First;
1340 Count := 0;
1341 while Name /= No_Name loop
1342 Count := Count + 1;
1343 Name := Language_Htable.Get_Next;
1344 end loop;
1345
1346 Result := new String_List (1 .. Count);
1347
1348 Count := 1;
1349 Name := Language_Htable.Get_First;
1350 while Name /= No_Name loop
1351
1352 -- Check if IDE'Compiler_Command is declared for the language.
1353 -- If it is, use its value to invoke gprconfig.
1354
1355 Variable :=
1356 Value_Of
1357 (Name,
1358 Attribute_Or_Array_Name => Name_Compiler_Command,
1359 In_Package => IDE,
1360 Shared => Shared,
1361 Force_Lower_Case_Index => True);
1362
1363 declare
1364 Config_Command : constant String :=
1365 "--config=" & Get_Name_String (Name);
1366
1367 Runtime_Name : constant String := Runtime_Name_For (Name);
1368
1369 begin
1370 -- In CodePeer mode, we do not take into account any compiler
1371 -- command from the package IDE.
1372
1373 if CodePeer_Mode
1374 or else Variable = Nil_Variable_Value
1375 or else Length_Of_Name (Variable.Value) = 0
1376 then
1377 Result (Count) :=
1378 new String'(Config_Command & ",," & Runtime_Name);
1379
1380 else
1381 At_Least_One_Compiler_Command := True;
1382
1383 declare
1384 Compiler_Command : constant String :=
1385 Get_Name_String (Variable.Value);
1386
1387 begin
1388 if Is_Absolute_Path (Compiler_Command) then
1389 Result (Count) :=
1390 new String'
1391 (Config_Command & ",," & Runtime_Name & ","
1392 & Containing_Directory (Compiler_Command) & ","
1393 & Simple_Name (Compiler_Command));
1394 else
1395 Result (Count) :=
1396 new String'
1397 (Config_Command & ",," & Runtime_Name & ",,"
1398 & Compiler_Command);
1399 end if;
1400 end;
1401 end if;
1402 end;
1403
1404 Count := Count + 1;
1405 Name := Language_Htable.Get_Next;
1406 end loop;
1407
1408 return Result;
1409 end Get_Config_Switches;
1410
1411 ------------------------
1412 -- Might_Have_Sources --
1413 ------------------------
1414
1415 function Might_Have_Sources (Project : Project_Id) return Boolean is
1416 Variable : Variable_Value;
1417
1418 begin
1419 Variable :=
1420 Value_Of (Name_Source_Dirs, Project.Decl.Attributes, Shared);
1421
1422 if Variable = Nil_Variable_Value
1423 or else Variable.Default
1424 or else Variable.Values /= Nil_String
1425 then
1426 Variable :=
1427 Value_Of (Name_Source_Files, Project.Decl.Attributes, Shared);
1428 return Variable = Nil_Variable_Value
1429 or else Variable.Default
1430 or else Variable.Values /= Nil_String;
1431
1432 else
1433 return False;
1434 end if;
1435 end Might_Have_Sources;
1436
1437 -- Local Variables
1438
1439 Success : Boolean;
1440 Config_Project_Node : Project_Node_Id := Empty_Node;
1441
1442 -- Start of processing for Get_Or_Create_Configuration_File
1443
1444 begin
1445 pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1446
1447 Free (Config_File_Path);
1448 Config := No_Project;
1449
1450 Get_Project_Target;
1451 Get_Project_Runtimes;
1452 Check_Builder_Switches;
1453
1454 -- Do not attempt to find a configuration project file when
1455 -- Config_File_Name is No_Configuration_File.
1456
1457 if Config_File_Name = No_Configuration_File then
1458 Config_File_Path := null;
1459
1460 else
1461 if Conf_File_Name'Length > 0 then
1462 Config_File_Path := Locate_Config_File (Conf_File_Name.all);
1463 else
1464 Config_File_Path := Locate_Config_File (Default_File_Name);
1465 end if;
1466
1467 if Config_File_Path = null then
1468 if not Allow_Automatic_Generation
1469 and then Conf_File_Name'Length > 0
1470 then
1471 Raise_Invalid_Config
1472 ("could not locate main configuration project "
1473 & Conf_File_Name.all);
1474 end if;
1475 end if;
1476 end if;
1477
1478 Automatically_Generated :=
1479 Allow_Automatic_Generation and then Config_File_Path = null;
1480
1481 <<Process_Config_File>>
1482
1483 if Automatically_Generated then
1484
1485 -- This might raise an Invalid_Config exception
1486
1487 Do_Autoconf;
1488
1489 -- If the config file is not auto-generated, warn if there is any --RTS
1490 -- switch, but not when the config file is generated in memory.
1491
1492 elsif Warn_For_RTS
1493 and then RTS_Languages.Get_First /= No_Name
1494 and then Opt.Warning_Mode /= Opt.Suppress
1495 and then On_Load_Config = null
1496 then
1497 Write_Line
1498 ("warning: " &
1499 "runtimes are taken into account only in auto-configuration");
1500 end if;
1501
1502 -- Parse the configuration file
1503
1504 if Verbose_Mode and then Config_File_Path /= null then
1505 Write_Str ("Checking configuration ");
1506 Write_Line (Config_File_Path.all);
1507 end if;
1508
1509 if Config_File_Path /= null then
1510 Prj.Part.Parse
1511 (In_Tree => Project_Node_Tree,
1512 Project => Config_Project_Node,
1513 Project_File_Name => Config_File_Path.all,
1514 Errout_Handling => Prj.Part.Finalize_If_Error,
1515 Packages_To_Check => Packages_To_Check,
1516 Current_Directory => Current_Directory,
1517 Is_Config_File => True,
1518 Env => Env);
1519 else
1520 Config_Project_Node := Empty_Node;
1521 end if;
1522
1523 if On_Load_Config /= null then
1524 On_Load_Config
1525 (Config_File => Config_Project_Node,
1526 Project_Node_Tree => Project_Node_Tree);
1527 end if;
1528
1529 if Config_Project_Node /= Empty_Node then
1530 Prj.Proc.Process_Project_Tree_Phase_1
1531 (In_Tree => Project_Tree,
1532 Project => Config,
1533 Packages_To_Check => Packages_To_Check,
1534 Success => Success,
1535 From_Project_Node => Config_Project_Node,
1536 From_Project_Node_Tree => Project_Node_Tree,
1537 Env => Env,
1538 Reset_Tree => False,
1539 On_New_Tree_Loaded => null);
1540 end if;
1541
1542 if Config_Project_Node = Empty_Node or else Config = No_Project then
1543 Raise_Invalid_Config
1544 ("processing of configuration project """
1545 & Config_File_Path.all & """ failed");
1546 end if;
1547
1548 -- Check that the target of the configuration file is the one the user
1549 -- specified on the command line. We do not need to check that when in
1550 -- auto-conf mode, since the appropriate target was passed to gprconfig.
1551
1552 if not Automatically_Generated
1553 and then not
1554 Check_Target
1555 (Config, Autoconf_Specified, Project_Tree, Selected_Target.all)
1556 then
1557 Automatically_Generated := True;
1558 goto Process_Config_File;
1559 end if;
1560 end Get_Or_Create_Configuration_File;
1561
1562 ------------------------
1563 -- Locate_Config_File --
1564 ------------------------
1565
1566 function Locate_Config_File (Name : String) return String_Access is
1567 Prefix_Path : constant String := Executable_Prefix_Path;
1568 begin
1569 if Prefix_Path'Length /= 0 then
1570 return Locate_Regular_File
1571 (Name,
1572 "." & Path_Separator &
1573 Prefix_Path & "share" & Directory_Separator & "gpr");
1574 else
1575 return Locate_Regular_File (Name, ".");
1576 end if;
1577 end Locate_Config_File;
1578
1579 ------------------------------------
1580 -- Parse_Project_And_Apply_Config --
1581 ------------------------------------
1582
1583 procedure Parse_Project_And_Apply_Config
1584 (Main_Project : out Prj.Project_Id;
1585 User_Project_Node : out Prj.Tree.Project_Node_Id;
1586 Config_File_Name : String := "";
1587 Autoconf_Specified : Boolean;
1588 Project_File_Name : String;
1589 Project_Tree : Prj.Project_Tree_Ref;
1590 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
1591 Env : in out Prj.Tree.Environment;
1592 Packages_To_Check : String_List_Access;
1593 Allow_Automatic_Generation : Boolean := True;
1594 Automatically_Generated : out Boolean;
1595 Config_File_Path : out String_Access;
1596 Target_Name : String := "";
1597 Normalized_Hostname : String;
1598 On_Load_Config : Config_File_Hook := null;
1599 Implicit_Project : Boolean := False;
1600 On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null)
1601 is
1602 Success : Boolean := False;
1603 Target_Try_Again : Boolean := True;
1604 Config_Try_Again : Boolean;
1605
1606 S : State := No_State;
1607
1608 Conf_File_Name : String_Access := new String'(Config_File_Name);
1609
1610 procedure Add_Directory (Dir : String);
1611 -- Add a directory at the end of the Project Path
1612
1613 Auto_Generated : Boolean;
1614
1615 -------------------
1616 -- Add_Directory --
1617 -------------------
1618
1619 procedure Add_Directory (Dir : String) is
1620 begin
1621 if Opt.Verbose_Mode then
1622 Write_Line (" Adding directory """ & Dir & """");
1623 end if;
1624
1625 Prj.Env.Add_Directories (Env.Project_Path, Dir);
1626 end Add_Directory;
1627
1628 begin
1629 pragma Assert (Prj.Env.Is_Initialized (Env.Project_Path));
1630
1631 -- Start with ignoring missing withed projects
1632
1633 Update_Ignore_Missing_With (Env.Flags, True);
1634
1635 Automatically_Generated := False;
1636 -- If in fact the config file is automatically generated,
1637 -- Automatically_Generated will be set to True after invocation of
1638 -- Process_Project_And_Apply_Config.
1639
1640 -- Record Target_Value and Target_Origin.
1641
1642 if Target_Name = "" then
1643 Opt.Target_Value := new String'(Normalized_Hostname);
1644 Opt.Target_Origin := Default;
1645 else
1646 Opt.Target_Value := new String'(Target_Name);
1647 Opt.Target_Origin := Specified;
1648 end if;
1649
1650 <<Parse_Again>>
1651
1652 -- Parse the user project tree
1653
1654 Prj.Initialize (Project_Tree);
1655
1656 Main_Project := No_Project;
1657
1658 Prj.Part.Parse
1659 (In_Tree => Project_Node_Tree,
1660 Project => User_Project_Node,
1661 Project_File_Name => Project_File_Name,
1662 Errout_Handling => Prj.Part.Finalize_If_Error,
1663 Packages_To_Check => Packages_To_Check,
1664 Current_Directory => Current_Directory,
1665 Is_Config_File => False,
1666 Env => Env,
1667 Implicit_Project => Implicit_Project);
1668
1669 if User_Project_Node = Empty_Node then
1670 return;
1671 end if;
1672
1673 -- If --target was not specified on the command line, then do Phase 1 to
1674 -- check if attribute Target is declared in the main project.
1675
1676 if Opt.Target_Origin /= Specified then
1677 Main_Project := No_Project;
1678 Process_Project_Tree_Phase_1
1679 (In_Tree => Project_Tree,
1680 Project => Main_Project,
1681 Packages_To_Check => Packages_To_Check,
1682 Success => Success,
1683 From_Project_Node => User_Project_Node,
1684 From_Project_Node_Tree => Project_Node_Tree,
1685 Env => Env,
1686 Reset_Tree => True,
1687 On_New_Tree_Loaded => On_New_Tree_Loaded);
1688
1689 if not Success then
1690 Main_Project := No_Project;
1691 return;
1692 end if;
1693
1694 declare
1695 Variable : constant Variable_Value :=
1696 Value_Of
1697 (Name_Target,
1698 Main_Project.Decl.Attributes,
1699 Project_Tree.Shared);
1700 begin
1701 if Variable /= Nil_Variable_Value
1702 and then not Variable.Default
1703 and then
1704 Get_Name_String (Variable.Value) /= Opt.Target_Value.all
1705 then
1706 if Target_Try_Again then
1707 Opt.Target_Value :=
1708 new String'(Get_Name_String (Variable.Value));
1709 Target_Try_Again := False;
1710 goto Parse_Again;
1711
1712 else
1713 Fail_Program
1714 (Project_Tree,
1715 "inconsistent value of attribute Target");
1716 end if;
1717 end if;
1718 end;
1719 end if;
1720
1721 -- If there are missing withed projects, the projects will be parsed
1722 -- again after the project path is extended with directories rooted
1723 -- at the compiler roots.
1724
1725 Config_Try_Again := Project_Node_Tree.Incomplete_With;
1726
1727 Process_Project_And_Apply_Config
1728 (Main_Project => Main_Project,
1729 User_Project_Node => User_Project_Node,
1730 Config_File_Name => Conf_File_Name.all,
1731 Autoconf_Specified => Autoconf_Specified,
1732 Project_Tree => Project_Tree,
1733 Project_Node_Tree => Project_Node_Tree,
1734 Env => Env,
1735 Packages_To_Check => Packages_To_Check,
1736 Allow_Automatic_Generation => Allow_Automatic_Generation,
1737 Automatically_Generated => Auto_Generated,
1738 Config_File_Path => Config_File_Path,
1739 Target_Name => Target_Name,
1740 Normalized_Hostname => Normalized_Hostname,
1741 On_Load_Config => On_Load_Config,
1742 On_New_Tree_Loaded => On_New_Tree_Loaded,
1743 Do_Phase_1 => Opt.Target_Origin = Specified);
1744
1745 if Auto_Generated then
1746 Automatically_Generated := True;
1747 end if;
1748
1749 -- Exit if there was an error. Otherwise, if Config_Try_Again is True,
1750 -- update the project path and try again.
1751
1752 if Main_Project /= No_Project and then Config_Try_Again then
1753 Update_Ignore_Missing_With (Env.Flags, False);
1754
1755 if Config_File_Path /= null then
1756 Conf_File_Name := new String'(Simple_Name (Config_File_Path.all));
1757 end if;
1758
1759 -- For the second time the project files are parsed, the warning for
1760 -- --RTS= being only taken into account in auto-configuration are
1761 -- suppressed, as we are no longer in auto-configuration.
1762
1763 Warn_For_RTS := False;
1764
1765 -- Add the default directories corresponding to the compilers
1766
1767 Update_Project_Path
1768 (By => Main_Project,
1769 Tree => Project_Tree,
1770 With_State => S,
1771 Include_Aggregated => True,
1772 Imported_First => False);
1773
1774 declare
1775 Compiler_Root : Compiler_Root_Ptr;
1776 Prefix : String_Access;
1777 Runtime_Root : Runtime_Root_Ptr;
1778 Path_Value : constant String_Access := Getenv ("PATH");
1779
1780 begin
1781 if Opt.Verbose_Mode then
1782 Write_Line ("Setting the default project search directories");
1783
1784 if Prj.Current_Verbosity = High then
1785 if Path_Value = null or else Path_Value'Length = 0 then
1786 Write_Line ("No environment variable PATH");
1787
1788 else
1789 Write_Line ("PATH =");
1790 Write_Line (" " & Path_Value.all);
1791 end if;
1792 end if;
1793 end if;
1794
1795 -- Reorder the compiler roots in the PATH order
1796
1797 if First_Compiler_Root /= null
1798 and then First_Compiler_Root.Next /= null
1799 then
1800 declare
1801 Pred : Compiler_Root_Ptr;
1802 First_New_Comp : Compiler_Root_Ptr := null;
1803 New_Comp : Compiler_Root_Ptr := null;
1804 First : Positive := Path_Value'First;
1805 Last : Positive;
1806 Path_Last : Positive;
1807 begin
1808 while First <= Path_Value'Last loop
1809 Last := First;
1810
1811 if Path_Value (First) /= Path_Separator then
1812 while Last < Path_Value'Last
1813 and then Path_Value (Last + 1) /= Path_Separator
1814 loop
1815 Last := Last + 1;
1816 end loop;
1817
1818 Path_Last := Last;
1819 while Path_Last > First
1820 and then
1821 Path_Value (Path_Last) = Directory_Separator
1822 loop
1823 Path_Last := Path_Last - 1;
1824 end loop;
1825
1826 if Path_Last > First + 4
1827 and then
1828 Path_Value (Path_Last - 2 .. Path_Last) = "bin"
1829 and then
1830 Path_Value (Path_Last - 3) = Directory_Separator
1831 then
1832 Path_Last := Path_Last - 4;
1833 Pred := null;
1834 Compiler_Root := First_Compiler_Root;
1835 while Compiler_Root /= null
1836 and then Compiler_Root.Root.all /=
1837 Path_Value (First .. Path_Last)
1838 loop
1839 Pred := Compiler_Root;
1840 Compiler_Root := Compiler_Root.Next;
1841 end loop;
1842
1843 if Compiler_Root /= null then
1844 if Pred = null then
1845 First_Compiler_Root :=
1846 First_Compiler_Root.Next;
1847 else
1848 Pred.Next := Compiler_Root.Next;
1849 end if;
1850
1851 if First_New_Comp = null then
1852 First_New_Comp := Compiler_Root;
1853 else
1854 New_Comp.Next := Compiler_Root;
1855 end if;
1856
1857 New_Comp := Compiler_Root;
1858 New_Comp.Next := null;
1859 end if;
1860 end if;
1861 end if;
1862
1863 First := Last + 1;
1864 end loop;
1865
1866 if First_New_Comp /= null then
1867 New_Comp.Next := First_Compiler_Root;
1868 First_Compiler_Root := First_New_Comp;
1869 end if;
1870 end;
1871 end if;
1872
1873 -- Now that the compiler roots are in a correct order, add the
1874 -- directories corresponding to these compiler roots in the
1875 -- project path.
1876
1877 Compiler_Root := First_Compiler_Root;
1878 while Compiler_Root /= null loop
1879 Prefix := Compiler_Root.Root;
1880
1881 Runtime_Root := Compiler_Root.Runtimes;
1882 while Runtime_Root /= null loop
1883 Add_Directory
1884 (Runtime_Root.Root.all &
1885 Directory_Separator &
1886 "lib" &
1887 Directory_Separator &
1888 "gnat");
1889 Add_Directory
1890 (Runtime_Root.Root.all &
1891 Directory_Separator &
1892 "share" &
1893 Directory_Separator &
1894 "gpr");
1895 Runtime_Root := Runtime_Root.Next;
1896 end loop;
1897
1898 Add_Directory
1899 (Prefix.all &
1900 Directory_Separator &
1901 Opt.Target_Value.all &
1902 Directory_Separator &
1903 "lib" &
1904 Directory_Separator &
1905 "gnat");
1906 Add_Directory
1907 (Prefix.all &
1908 Directory_Separator &
1909 Opt.Target_Value.all &
1910 Directory_Separator &
1911 "share" &
1912 Directory_Separator &
1913 "gpr");
1914 Add_Directory
1915 (Prefix.all &
1916 Directory_Separator &
1917 "share" &
1918 Directory_Separator &
1919 "gpr");
1920 Add_Directory
1921 (Prefix.all &
1922 Directory_Separator &
1923 "lib" &
1924 Directory_Separator &
1925 "gnat");
1926 Compiler_Root := Compiler_Root.Next;
1927 end loop;
1928 end;
1929
1930 -- And parse again the project files. There will be no missing
1931 -- withed projects, as Ignore_Missing_With is set to False in
1932 -- the environment flags, so there is no risk of endless loop here.
1933
1934 goto Parse_Again;
1935 end if;
1936 end Parse_Project_And_Apply_Config;
1937
1938 --------------------------------------
1939 -- Process_Project_And_Apply_Config --
1940 --------------------------------------
1941
1942 procedure Process_Project_And_Apply_Config
1943 (Main_Project : out Prj.Project_Id;
1944 User_Project_Node : Prj.Tree.Project_Node_Id;
1945 Config_File_Name : String := "";
1946 Autoconf_Specified : Boolean;
1947 Project_Tree : Prj.Project_Tree_Ref;
1948 Project_Node_Tree : Prj.Tree.Project_Node_Tree_Ref;
1949 Env : in out Prj.Tree.Environment;
1950 Packages_To_Check : String_List_Access;
1951 Allow_Automatic_Generation : Boolean := True;
1952 Automatically_Generated : out Boolean;
1953 Config_File_Path : out String_Access;
1954 Target_Name : String := "";
1955 Normalized_Hostname : String;
1956 On_Load_Config : Config_File_Hook := null;
1957 Reset_Tree : Boolean := True;
1958 On_New_Tree_Loaded : Prj.Proc.Tree_Loaded_Callback := null;
1959 Do_Phase_1 : Boolean := True)
1960 is
1961 Shared : constant Shared_Project_Tree_Data_Access :=
1962 Project_Tree.Shared;
1963 Main_Config_Project : Project_Id;
1964 Success : Boolean;
1965
1966 Conf_Project : Project_Id := No_Project;
1967 -- The object directory of this project is used to store the config
1968 -- project file in auto-configuration. Set by Check_Project below.
1969
1970 procedure Check_Project (Project : Project_Id);
1971 -- Look for a non aggregate project. If one is found, put its project Id
1972 -- in Conf_Project.
1973
1974 -------------------
1975 -- Check_Project --
1976 -------------------
1977
1978 procedure Check_Project (Project : Project_Id) is
1979 begin
1980 if Project.Qualifier = Aggregate
1981 or else
1982 Project.Qualifier = Aggregate_Library
1983 then
1984 declare
1985 List : Aggregated_Project_List := Project.Aggregated_Projects;
1986
1987 begin
1988 -- Look for a non aggregate project until one is found
1989
1990 while Conf_Project = No_Project and then List /= null loop
1991 Check_Project (List.Project);
1992 List := List.Next;
1993 end loop;
1994 end;
1995
1996 else
1997 Conf_Project := Project;
1998 end if;
1999 end Check_Project;
2000
2001 -- Start of processing for Process_Project_And_Apply_Config
2002
2003 begin
2004 Automatically_Generated := False;
2005
2006 if Do_Phase_1 then
2007 Main_Project := No_Project;
2008 Process_Project_Tree_Phase_1
2009 (In_Tree => Project_Tree,
2010 Project => Main_Project,
2011 Packages_To_Check => Packages_To_Check,
2012 Success => Success,
2013 From_Project_Node => User_Project_Node,
2014 From_Project_Node_Tree => Project_Node_Tree,
2015 Env => Env,
2016 Reset_Tree => Reset_Tree,
2017 On_New_Tree_Loaded => On_New_Tree_Loaded);
2018
2019 if not Success then
2020 Main_Project := No_Project;
2021 return;
2022 end if;
2023 end if;
2024
2025 if Project_Tree.Source_Info_File_Name /= null then
2026 if not Is_Absolute_Path (Project_Tree.Source_Info_File_Name.all) then
2027 declare
2028 Obj_Dir : constant Variable_Value :=
2029 Value_Of
2030 (Name_Object_Dir,
2031 Main_Project.Decl.Attributes,
2032 Shared);
2033
2034 begin
2035 if Obj_Dir = Nil_Variable_Value or else Obj_Dir.Default then
2036 Get_Name_String (Main_Project.Directory.Display_Name);
2037
2038 else
2039 if Is_Absolute_Path (Get_Name_String (Obj_Dir.Value)) then
2040 Get_Name_String (Obj_Dir.Value);
2041
2042 else
2043 Name_Len := 0;
2044 Add_Str_To_Name_Buffer
2045 (Get_Name_String (Main_Project.Directory.Display_Name));
2046 Add_Str_To_Name_Buffer (Get_Name_String (Obj_Dir.Value));
2047 end if;
2048 end if;
2049
2050 Add_Char_To_Name_Buffer (Directory_Separator);
2051 Add_Str_To_Name_Buffer (Project_Tree.Source_Info_File_Name.all);
2052 Free (Project_Tree.Source_Info_File_Name);
2053 Project_Tree.Source_Info_File_Name :=
2054 new String'(Name_Buffer (1 .. Name_Len));
2055 end;
2056 end if;
2057
2058 Read_Source_Info_File (Project_Tree);
2059 end if;
2060
2061 -- Get the first project that is not an aggregate project or an
2062 -- aggregate library project. The object directory of this project will
2063 -- be used to store the config project file in auto-configuration.
2064
2065 Check_Project (Main_Project);
2066
2067 -- Fail if there is only aggregate projects and aggregate library
2068 -- projects in the project tree.
2069
2070 if Conf_Project = No_Project then
2071 Raise_Invalid_Config ("there are no non-aggregate projects");
2072 end if;
2073
2074 -- Find configuration file
2075
2076 Get_Or_Create_Configuration_File
2077 (Config => Main_Config_Project,
2078 Project => Main_Project,
2079 Conf_Project => Conf_Project,
2080 Project_Tree => Project_Tree,
2081 Project_Node_Tree => Project_Node_Tree,
2082 Env => Env,
2083 Allow_Automatic_Generation => Allow_Automatic_Generation,
2084 Config_File_Name => Config_File_Name,
2085 Autoconf_Specified => Autoconf_Specified,
2086 Target_Name => Target_Name,
2087 Normalized_Hostname => Normalized_Hostname,
2088 Packages_To_Check => Packages_To_Check,
2089 Config_File_Path => Config_File_Path,
2090 Automatically_Generated => Automatically_Generated,
2091 On_Load_Config => On_Load_Config);
2092
2093 Apply_Config_File (Main_Config_Project, Project_Tree);
2094
2095 -- Finish processing the user's project
2096
2097 Prj.Proc.Process_Project_Tree_Phase_2
2098 (In_Tree => Project_Tree,
2099 Project => Main_Project,
2100 Success => Success,
2101 From_Project_Node => User_Project_Node,
2102 From_Project_Node_Tree => Project_Node_Tree,
2103 Env => Env);
2104
2105 if Success then
2106 if Project_Tree.Source_Info_File_Name /= null
2107 and then not Project_Tree.Source_Info_File_Exists
2108 then
2109 Write_Source_Info_File (Project_Tree);
2110 end if;
2111
2112 else
2113 Main_Project := No_Project;
2114 end if;
2115 end Process_Project_And_Apply_Config;
2116
2117 --------------------------
2118 -- Raise_Invalid_Config --
2119 --------------------------
2120
2121 procedure Raise_Invalid_Config (Msg : String) is
2122 begin
2123 Raise_Exception (Invalid_Config'Identity, Msg);
2124 end Raise_Invalid_Config;
2125
2126 ----------------------
2127 -- Runtime_Name_For --
2128 ----------------------
2129
2130 function Runtime_Name_For (Language : Name_Id) return String is
2131 begin
2132 if RTS_Languages.Get (Language) /= No_Name then
2133 return Get_Name_String (RTS_Languages.Get (Language));
2134 else
2135 return "";
2136 end if;
2137 end Runtime_Name_For;
2138
2139 --------------------------
2140 -- Runtime_Name_Set_For --
2141 --------------------------
2142
2143 function Runtime_Name_Set_For (Language : Name_Id) return Boolean is
2144 begin
2145 return RTS_Languages.Get (Language) /= No_Name;
2146 end Runtime_Name_Set_For;
2147
2148 ---------------------
2149 -- Set_Runtime_For --
2150 ---------------------
2151
2152 procedure Set_Runtime_For (Language : Name_Id; RTS_Name : String) is
2153 begin
2154 Name_Len := RTS_Name'Length;
2155 Name_Buffer (1 .. Name_Len) := RTS_Name;
2156 RTS_Languages.Set (Language, Name_Find);
2157 end Set_Runtime_For;
2158
2159 ----------------------------
2160 -- Look_For_Project_Paths --
2161 ----------------------------
2162
2163 procedure Look_For_Project_Paths
2164 (Project : Project_Id;
2165 Tree : Project_Tree_Ref;
2166 With_State : in out State)
2167 is
2168 Lang_Id : Language_Ptr;
2169 Compiler_Root : Compiler_Root_Ptr;
2170 Runtime_Root : Runtime_Root_Ptr;
2171 Comp_Driver : String_Access;
2172 Comp_Dir : String_Access;
2173 Prefix : String_Access;
2174
2175 pragma Unreferenced (Tree);
2176
2177 begin
2178 With_State := No_State;
2179
2180 Lang_Id := Project.Languages;
2181 while Lang_Id /= No_Language_Index loop
2182 if Lang_Id.Config.Compiler_Driver /= No_File then
2183 Comp_Driver :=
2184 new String'
2185 (Get_Name_String (Lang_Id.Config.Compiler_Driver));
2186
2187 -- Get the absolute path of the compiler driver
2188
2189 if not Is_Absolute_Path (Comp_Driver.all) then
2190 Comp_Driver := Locate_Exec_On_Path (Comp_Driver.all);
2191 end if;
2192
2193 if Comp_Driver /= null and then Comp_Driver'Length > 0 then
2194 Comp_Dir :=
2195 new String'
2196 (Containing_Directory (Comp_Driver.all));
2197
2198 -- Consider only the compiler drivers that are in "bin"
2199 -- subdirectories.
2200
2201 if Simple_Name (Comp_Dir.all) = "bin" then
2202 Prefix :=
2203 new String'(Containing_Directory (Comp_Dir.all));
2204
2205 -- Check if the compiler root is already in the list. If it
2206 -- is not, add it to the list.
2207
2208 Compiler_Root := First_Compiler_Root;
2209 while Compiler_Root /= null loop
2210 exit when Prefix.all = Compiler_Root.Root.all;
2211 Compiler_Root := Compiler_Root.Next;
2212 end loop;
2213
2214 if Compiler_Root = null then
2215 First_Compiler_Root :=
2216 new Compiler_Root_Data'
2217 (Root => Prefix,
2218 Runtimes => null,
2219 Next => First_Compiler_Root);
2220 Compiler_Root := First_Compiler_Root;
2221 end if;
2222
2223 -- If there is a runtime for this compiler, check if it is
2224 -- recorded with the compiler root. If it is not, record
2225 -- the runtime.
2226
2227 declare
2228 Runtime : constant String :=
2229 Runtime_Name_For (Lang_Id.Name);
2230 Root : String_Access;
2231 begin
2232 if Runtime'Length > 0 then
2233 if Is_Absolute_Path (Runtime) then
2234 Root := new String'(Runtime);
2235
2236 else
2237 Root :=
2238 new String'
2239 (Prefix.all &
2240 Directory_Separator &
2241 Opt.Target_Value.all &
2242 Directory_Separator &
2243 Runtime);
2244 end if;
2245
2246 Runtime_Root := Compiler_Root.Runtimes;
2247 while Runtime_Root /= null loop
2248 exit when Root.all = Runtime_Root.Root.all;
2249 Runtime_Root := Runtime_Root.Next;
2250 end loop;
2251
2252 if Runtime_Root = null then
2253 Compiler_Root.Runtimes :=
2254 new Runtime_Root_Data'
2255 (Root => Root,
2256 Next => Compiler_Root.Runtimes);
2257 end if;
2258 end if;
2259 end;
2260 end if;
2261 end if;
2262 end if;
2263
2264 Lang_Id := Lang_Id.Next;
2265 end loop;
2266 end Look_For_Project_Paths;
2267 end Prj.Conf;
Mirror of the offical gcc git repository hosted at gcc.gnu.org