projects / gcc.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
makeutl.ads (Main_Config_Project): Moved to gpr_util.ads
[gcc.git] / gcc / ada / prj.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2007, 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 Ada.Characters.Handling; use Ada.Characters.Handling;
27
28 with Debug;
29 with Output; use Output;
30 with Osint; use Osint;
31 with Prj.Attr;
32 with Prj.Env;
33 with Prj.Err; use Prj.Err;
34 with Snames; use Snames;
35 with Uintp; use Uintp;
36
37 with System.Case_Util; use System.Case_Util;
38
39 package body Prj is
40
41 Object_Suffix : constant String := Get_Target_Object_Suffix.all;
42 -- File suffix for object files
43
44 Initial_Buffer_Size : constant := 100;
45 -- Initial size for extensible buffer used in Add_To_Buffer
46
47 Current_Mode : Mode := Ada_Only;
48
49 Configuration_Mode : Boolean := False;
50
51 The_Empty_String : Name_Id;
52
53 Name_C_Plus_Plus : Name_Id;
54
55 Default_Ada_Spec_Suffix_Id : File_Name_Type;
56 Default_Ada_Body_Suffix_Id : File_Name_Type;
57 Slash_Id : Path_Name_Type;
58 -- Initialized in Prj.Initialize, then never modified
59
60 subtype Known_Casing is Casing_Type range All_Upper_Case .. Mixed_Case;
61
62 The_Casing_Images : constant array (Known_Casing) of String_Access :=
63 (All_Lower_Case => new String'("lowercase"),
64 All_Upper_Case => new String'("UPPERCASE"),
65 Mixed_Case => new String'("MixedCase"));
66
67 Initialized : Boolean := False;
68
69 Standard_Dot_Replacement : constant File_Name_Type :=
70 File_Name_Type
71 (First_Name_Id + Character'Pos ('-'));
72
73 Std_Naming_Data : constant Naming_Data :=
74 (Dot_Replacement => Standard_Dot_Replacement,
75 Dot_Repl_Loc => No_Location,
76 Casing => All_Lower_Case,
77 Spec_Suffix => No_Array_Element,
78 Ada_Spec_Suffix_Loc => No_Location,
79 Body_Suffix => No_Array_Element,
80 Ada_Body_Suffix_Loc => No_Location,
81 Separate_Suffix => No_File,
82 Sep_Suffix_Loc => No_Location,
83 Specs => No_Array_Element,
84 Bodies => No_Array_Element,
85 Specification_Exceptions => No_Array_Element,
86 Implementation_Exceptions => No_Array_Element,
87 Impl_Suffixes => No_Impl_Suffixes,
88 Supp_Suffixes => No_Supp_Language_Index);
89
90 Project_Empty : constant Project_Data :=
91 (Externally_Built => False,
92 Config => Default_Project_Config,
93 Languages => No_Name_List,
94 First_Referred_By => No_Project,
95 Name => No_Name,
96 Display_Name => No_Name,
97 Path_Name => No_Path,
98 Display_Path_Name => No_Path,
99 Virtual => False,
100 Location => No_Location,
101 Mains => Nil_String,
102 Directory => No_Path,
103 Display_Directory => No_Path,
104 Dir_Path => null,
105 Library => False,
106 Library_Dir => No_Path,
107 Display_Library_Dir => No_Path,
108 Library_Src_Dir => No_Path,
109 Display_Library_Src_Dir => No_Path,
110 Library_ALI_Dir => No_Path,
111 Display_Library_ALI_Dir => No_Path,
112 Library_Name => No_Name,
113 Library_Kind => Static,
114 Lib_Internal_Name => No_Name,
115 Standalone_Library => False,
116 Lib_Interface_ALIs => Nil_String,
117 Lib_Auto_Init => False,
118 Libgnarl_Needed => Unknown,
119 Symbol_Data => No_Symbols,
120 Ada_Sources => Nil_String,
121 Sources => Nil_String,
122 First_Source => No_Source,
123 Last_Source => No_Source,
124 Unit_Based_Language_Name => No_Name,
125 Unit_Based_Language_Index => No_Language_Index,
126 Imported_Directories_Switches => null,
127 Include_Path => null,
128 Include_Data_Set => False,
129 Include_Language => No_Language_Index,
130 Source_Dirs => Nil_String,
131 Known_Order_Of_Source_Dirs => True,
132 Object_Directory => No_Path,
133 Display_Object_Dir => No_Path,
134 Library_TS => Empty_Time_Stamp,
135 Exec_Directory => No_Path,
136 Display_Exec_Dir => No_Path,
137 Extends => No_Project,
138 Extended_By => No_Project,
139 Naming => Std_Naming_Data,
140 First_Language_Processing => No_Language_Index,
141 Decl => No_Declarations,
142 Imported_Projects => Empty_Project_List,
143 All_Imported_Projects => Empty_Project_List,
144 Ada_Include_Path => null,
145 Ada_Objects_Path => null,
146 Objects_Path => null,
147 Include_Path_File => No_Path,
148 Objects_Path_File_With_Libs => No_Path,
149 Objects_Path_File_Without_Libs => No_Path,
150 Config_File_Name => No_Path,
151 Config_File_Temp => False,
152 Linker_Name => No_File,
153 Linker_Path => No_Path,
154 Minimum_Linker_Options => No_Name_List,
155 Config_Checked => False,
156 Checked => False,
157 Seen => False,
158 Need_To_Build_Lib => False,
159 Depth => 0,
160 Unkept_Comments => False,
161 Langs => No_Languages,
162 Supp_Languages => No_Supp_Language_Index,
163 Ada_Sources_Present => True,
164 Other_Sources_Present => True,
165 First_Other_Source => No_Other_Source,
166 Last_Other_Source => No_Other_Source,
167 First_Lang_Processing => Default_First_Language_Processing_Data,
168 Supp_Language_Processing => No_Supp_Language_Index);
169
170 package Temp_Files is new Table.Table
171 (Table_Component_Type => Path_Name_Type,
172 Table_Index_Type => Integer,
173 Table_Low_Bound => 1,
174 Table_Initial => 20,
175 Table_Increment => 100,
176 Table_Name => "Makegpr.Temp_Files");
177 -- Table to store the path name of all the created temporary files, so that
178 -- they can be deleted at the end, or when the program is interrupted.
179
180 -----------------------
181 -- Add_Language_Name --
182 -----------------------
183
184 procedure Add_Language_Name (Name : Name_Id) is
185 begin
186 Last_Language_Index := Last_Language_Index + 1;
187 Language_Indexes.Set (Name, Last_Language_Index);
188 Language_Names.Increment_Last;
189 Language_Names.Table (Last_Language_Index) := Name;
190 end Add_Language_Name;
191
192 -------------------
193 -- Add_To_Buffer --
194 -------------------
195
196 procedure Add_To_Buffer
197 (S : String;
198 To : in out String_Access;
199 Last : in out Natural)
200 is
201 begin
202 if To = null then
203 To := new String (1 .. Initial_Buffer_Size);
204 Last := 0;
205 end if;
206
207 -- If Buffer is too small, double its size
208
209 while Last + S'Length > To'Last loop
210 declare
211 New_Buffer : constant String_Access :=
212 new String (1 .. 2 * Last);
213
214 begin
215 New_Buffer (1 .. Last) := To (1 .. Last);
216 Free (To);
217 To := New_Buffer;
218 end;
219 end loop;
220
221 To (Last + 1 .. Last + S'Length) := S;
222 Last := Last + S'Length;
223 end Add_To_Buffer;
224
225 -----------------------
226 -- Body_Suffix_Id_Of --
227 -----------------------
228
229 function Body_Suffix_Id_Of
230 (In_Tree : Project_Tree_Ref;
231 Language : String;
232 Naming : Naming_Data) return File_Name_Type
233 is
234 Language_Id : Name_Id;
235 Element_Id : Array_Element_Id;
236 Element : Array_Element;
237 Suffix : File_Name_Type := No_File;
238 Lang : Language_Index;
239
240 begin
241 Name_Len := 0;
242 Add_Str_To_Name_Buffer (Language);
243 To_Lower (Name_Buffer (1 .. Name_Len));
244 Language_Id := Name_Find;
245
246 Element_Id := Naming.Body_Suffix;
247 while Element_Id /= No_Array_Element loop
248 Element := In_Tree.Array_Elements.Table (Element_Id);
249
250 if Element.Index = Language_Id then
251 return File_Name_Type (Element.Value.Value);
252 end if;
253
254 Element_Id := Element.Next;
255 end loop;
256
257 if Current_Mode = Multi_Language then
258 Lang := In_Tree.First_Language;
259 while Lang /= No_Language_Index loop
260 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
261 Suffix :=
262 In_Tree.Languages_Data.Table
263 (Lang).Config.Naming_Data.Body_Suffix;
264 exit;
265 end if;
266
267 Lang := In_Tree.Languages_Data.Table (Lang).Next;
268 end loop;
269 end if;
270
271 return Suffix;
272 end Body_Suffix_Id_Of;
273
274 --------------------
275 -- Body_Suffix_Of --
276 --------------------
277
278 function Body_Suffix_Of
279 (In_Tree : Project_Tree_Ref;
280 Language : String;
281 Naming : Naming_Data) return String
282 is
283 Language_Id : Name_Id;
284 Element_Id : Array_Element_Id;
285 Element : Array_Element;
286 Suffix : File_Name_Type := No_File;
287 Lang : Language_Index;
288
289 begin
290 Name_Len := 0;
291 Add_Str_To_Name_Buffer (Language);
292 To_Lower (Name_Buffer (1 .. Name_Len));
293 Language_Id := Name_Find;
294
295 Element_Id := Naming.Body_Suffix;
296 while Element_Id /= No_Array_Element loop
297 Element := In_Tree.Array_Elements.Table (Element_Id);
298
299 if Element.Index = Language_Id then
300 return Get_Name_String (Element.Value.Value);
301 end if;
302
303 Element_Id := Element.Next;
304 end loop;
305
306 if Current_Mode = Multi_Language then
307 Lang := In_Tree.First_Language;
308 while Lang /= No_Language_Index loop
309 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
310 Suffix :=
311 File_Name_Type
312 (In_Tree.Languages_Data.Table
313 (Lang).Config.Naming_Data.Body_Suffix);
314 exit;
315 end if;
316
317 Lang := In_Tree.Languages_Data.Table (Lang).Next;
318 end loop;
319
320 if Suffix /= No_File then
321 return Get_Name_String (Suffix);
322 end if;
323 end if;
324
325 return "";
326 end Body_Suffix_Of;
327
328 function Body_Suffix_Of
329 (Language : Language_Index;
330 In_Project : Project_Data;
331 In_Tree : Project_Tree_Ref) return String
332 is
333 Suffix_Id : constant File_Name_Type :=
334 Suffix_Of (Language, In_Project, In_Tree);
335 begin
336 if Suffix_Id /= No_File then
337 return Get_Name_String (Suffix_Id);
338 else
339 return "." & Get_Name_String (Language_Names.Table (Language));
340 end if;
341 end Body_Suffix_Of;
342
343 -----------------------------
344 -- Default_Ada_Body_Suffix --
345 -----------------------------
346
347 function Default_Ada_Body_Suffix return File_Name_Type is
348 begin
349 return Default_Ada_Body_Suffix_Id;
350 end Default_Ada_Body_Suffix;
351
352 -----------------------------
353 -- Default_Ada_Spec_Suffix --
354 -----------------------------
355
356 function Default_Ada_Spec_Suffix return File_Name_Type is
357 begin
358 return Default_Ada_Spec_Suffix_Id;
359 end Default_Ada_Spec_Suffix;
360
361 ---------------------------
362 -- Delete_All_Temp_Files --
363 ---------------------------
364
365 procedure Delete_All_Temp_Files is
366 Dont_Care : Boolean;
367 begin
368 if not Debug.Debug_Flag_N then
369 for Index in 1 .. Temp_Files.Last loop
370 Delete_File
371 (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
372 end loop;
373 end if;
374 end Delete_All_Temp_Files;
375
376 ---------------------
377 -- Dependency_Name --
378 ---------------------
379
380 function Dependency_Name
381 (Source_File_Name : File_Name_Type;
382 Dependency : Dependency_File_Kind) return File_Name_Type
383 is
384 begin
385 case Dependency is
386 when None =>
387 return No_File;
388
389 when Makefile =>
390 return
391 File_Name_Type
392 (Extend_Name
393 (Source_File_Name, Makefile_Dependency_Suffix));
394
395 when ALI_File =>
396 return
397 File_Name_Type
398 (Extend_Name
399 (Source_File_Name, ALI_Dependency_Suffix));
400 end case;
401 end Dependency_Name;
402
403 ---------------------------
404 -- Display_Language_Name --
405 ---------------------------
406
407 procedure Display_Language_Name
408 (In_Tree : Project_Tree_Ref;
409 Language : Language_Index)
410 is
411 begin
412 Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
413 Write_Str (Name_Buffer (1 .. Name_Len));
414 end Display_Language_Name;
415
416 ---------------------------
417 -- Display_Language_Name --
418 ---------------------------
419
420 procedure Display_Language_Name (Language : Language_Index) is
421 begin
422 Get_Name_String (Language_Names.Table (Language));
423 To_Upper (Name_Buffer (1 .. 1));
424 Write_Str (Name_Buffer (1 .. Name_Len));
425 end Display_Language_Name;
426
427 ----------------
428 -- Empty_File --
429 ----------------
430
431 function Empty_File return File_Name_Type is
432 begin
433 return File_Name_Type (The_Empty_String);
434 end Empty_File;
435
436 -------------------
437 -- Empty_Project --
438 -------------------
439
440 function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
441 Value : Project_Data;
442
443 begin
444 Prj.Initialize (Tree => No_Project_Tree);
445 Value := Project_Empty;
446 Value.Naming := Tree.Private_Part.Default_Naming;
447
448 return Value;
449 end Empty_Project;
450
451 ------------------
452 -- Empty_String --
453 ------------------
454
455 function Empty_String return Name_Id is
456 begin
457 return The_Empty_String;
458 end Empty_String;
459
460 ------------
461 -- Expect --
462 ------------
463
464 procedure Expect (The_Token : Token_Type; Token_Image : String) is
465 begin
466 if Token /= The_Token then
467 Error_Msg (Token_Image & " expected", Token_Ptr);
468 end if;
469 end Expect;
470
471 -----------------
472 -- Extend_Name --
473 -----------------
474
475 function Extend_Name
476 (File : File_Name_Type;
477 With_Suffix : String) return File_Name_Type
478 is
479 Last : Positive;
480
481 begin
482 Get_Name_String (File);
483 Last := Name_Len + 1;
484
485 while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
486 Name_Len := Name_Len - 1;
487 end loop;
488
489 if Name_Len <= 1 then
490 Name_Len := Last;
491 end if;
492
493 for J in With_Suffix'Range loop
494 Name_Buffer (Name_Len) := With_Suffix (J);
495 Name_Len := Name_Len + 1;
496 end loop;
497
498 Name_Len := Name_Len - 1;
499 return Name_Find;
500
501 end Extend_Name;
502
503 --------------------------------
504 -- For_Every_Project_Imported --
505 --------------------------------
506
507 procedure For_Every_Project_Imported
508 (By : Project_Id;
509 In_Tree : Project_Tree_Ref;
510 With_State : in out State)
511 is
512
513 procedure Recursive_Check (Project : Project_Id);
514 -- Check if a project has already been seen. If not seen, mark it as
515 -- Seen, Call Action, and check all its imported projects.
516
517 ---------------------
518 -- Recursive_Check --
519 ---------------------
520
521 procedure Recursive_Check (Project : Project_Id) is
522 List : Project_List;
523 begin
524 if not In_Tree.Projects.Table (Project).Seen then
525 In_Tree.Projects.Table (Project).Seen := True;
526 Action (Project, With_State);
527
528 List :=
529 In_Tree.Projects.Table (Project).Imported_Projects;
530 while List /= Empty_Project_List loop
531 Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
532 List := In_Tree.Project_Lists.Table (List).Next;
533 end loop;
534 end if;
535 end Recursive_Check;
536
537 -- Start of processing for For_Every_Project_Imported
538
539 begin
540 for Project in Project_Table.First ..
541 Project_Table.Last (In_Tree.Projects)
542 loop
543 In_Tree.Projects.Table (Project).Seen := False;
544 end loop;
545
546 Recursive_Check (Project => By);
547 end For_Every_Project_Imported;
548
549 --------------
550 -- Get_Mode --
551 --------------
552
553 function Get_Mode return Mode is
554 begin
555 return Current_Mode;
556 end Get_Mode;
557
558 ----------
559 -- Hash --
560 ----------
561
562 function Hash (Name : File_Name_Type) return Header_Num is
563 begin
564 return Hash (Get_Name_String (Name));
565 end Hash;
566
567 function Hash (Name : Name_Id) return Header_Num is
568 begin
569 return Hash (Get_Name_String (Name));
570 end Hash;
571
572 function Hash (Name : Path_Name_Type) return Header_Num is
573 begin
574 return Hash (Get_Name_String (Name));
575 end Hash;
576
577 -----------
578 -- Image --
579 -----------
580
581 function Image (Casing : Casing_Type) return String is
582 begin
583 return The_Casing_Images (Casing).all;
584 end Image;
585
586 ----------------------
587 -- In_Configuration --
588 ----------------------
589
590 function In_Configuration return Boolean is
591 begin
592 return Configuration_Mode;
593 end In_Configuration;
594
595 ----------------
596 -- Initialize --
597 ----------------
598
599 procedure Initialize (Tree : Project_Tree_Ref) is
600 begin
601 if not Initialized then
602 Initialized := True;
603 Uintp.Initialize;
604 Name_Len := 0;
605 The_Empty_String := Name_Find;
606 Empty_Name := The_Empty_String;
607 Name_Len := 4;
608 Name_Buffer (1 .. 4) := ".ads";
609 Default_Ada_Spec_Suffix_Id := Name_Find;
610 Name_Len := 4;
611 Name_Buffer (1 .. 4) := ".adb";
612 Default_Ada_Body_Suffix_Id := Name_Find;
613 Name_Len := 1;
614 Name_Buffer (1) := '/';
615 Slash_Id := Name_Find;
616 Name_Len := 3;
617 Name_Buffer (1 .. 3) := "c++";
618 Name_C_Plus_Plus := Name_Find;
619
620 Prj.Env.Initialize;
621 Prj.Attr.Initialize;
622 Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
623 Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
624 Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
625
626 Language_Indexes.Reset;
627 Last_Language_Index := No_Language_Index;
628 Language_Names.Init;
629 Add_Language_Name (Name_Ada);
630 Add_Language_Name (Name_C);
631 Add_Language_Name (Name_C_Plus_Plus);
632 end if;
633
634 if Tree /= No_Project_Tree then
635 Reset (Tree);
636 end if;
637 end Initialize;
638
639 -------------------
640 -- Is_A_Language --
641 -------------------
642
643 function Is_A_Language
644 (Tree : Project_Tree_Ref;
645 Data : Project_Data;
646 Language_Name : String) return Boolean
647 is
648 Lang_Id : Name_Id;
649
650 begin
651 Name_Len := 0;
652 Add_Str_To_Name_Buffer (Language_Name);
653 To_Lower (Name_Buffer (1 .. Name_Len));
654 Lang_Id := Name_Find;
655
656 if Get_Mode = Ada_Only then
657 declare
658 List : Name_List_Index := Data.Languages;
659
660 begin
661 while List /= No_Name_List loop
662 if Tree.Name_Lists.Table (List).Name = Lang_Id then
663 return True;
664
665 else
666 List := Tree.Name_Lists.Table (List).Next;
667 end if;
668 end loop;
669 end;
670
671 else
672 declare
673 Lang_Ind : Language_Index;
674 Lang_Data : Language_Data;
675
676 begin
677 Lang_Ind := Data.First_Language_Processing;
678 while Lang_Ind /= No_Language_Index loop
679 Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
680
681 if Lang_Data.Name = Lang_Id then
682 return True;
683 end if;
684
685 Lang_Ind := Lang_Data.Next;
686 end loop;
687 end;
688 end if;
689
690 return False;
691 end Is_A_Language;
692
693 ------------------
694 -- Is_Extending --
695 ------------------
696
697 function Is_Extending
698 (Extending : Project_Id;
699 Extended : Project_Id;
700 In_Tree : Project_Tree_Ref) return Boolean
701 is
702 Proj : Project_Id;
703
704 begin
705 Proj := Extending;
706 while Proj /= No_Project loop
707 if Proj = Extended then
708 return True;
709 end if;
710
711 Proj := In_Tree.Projects.Table (Proj).Extends;
712 end loop;
713
714 return False;
715 end Is_Extending;
716
717 ----------------
718 -- Is_Present --
719 ----------------
720
721 function Is_Present
722 (Language : Language_Index;
723 In_Project : Project_Data;
724 In_Tree : Project_Tree_Ref) return Boolean
725 is
726 begin
727 case Language is
728 when No_Language_Index =>
729 return False;
730
731 when First_Language_Indexes =>
732 return In_Project.Langs (Language);
733
734 when others =>
735 declare
736 Supp : Supp_Language;
737 Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
738
739 begin
740 while Supp_Index /= No_Supp_Language_Index loop
741 Supp := In_Tree.Present_Languages.Table (Supp_Index);
742
743 if Supp.Index = Language then
744 return Supp.Present;
745 end if;
746
747 Supp_Index := Supp.Next;
748 end loop;
749
750 return False;
751 end;
752 end case;
753 end Is_Present;
754
755 ---------------------------------
756 -- Language_Processing_Data_Of --
757 ---------------------------------
758
759 function Language_Processing_Data_Of
760 (Language : Language_Index;
761 In_Project : Project_Data;
762 In_Tree : Project_Tree_Ref) return Language_Processing_Data
763 is
764 begin
765 case Language is
766 when No_Language_Index =>
767 return Default_Language_Processing_Data;
768
769 when First_Language_Indexes =>
770 return In_Project.First_Lang_Processing (Language);
771
772 when others =>
773 declare
774 Supp : Supp_Language_Data;
775 Supp_Index : Supp_Language_Index :=
776 In_Project.Supp_Language_Processing;
777
778 begin
779 while Supp_Index /= No_Supp_Language_Index loop
780 Supp := In_Tree.Supp_Languages.Table (Supp_Index);
781
782 if Supp.Index = Language then
783 return Supp.Data;
784 end if;
785
786 Supp_Index := Supp.Next;
787 end loop;
788
789 return Default_Language_Processing_Data;
790 end;
791 end case;
792 end Language_Processing_Data_Of;
793
794 -----------------------
795 -- Objects_Exist_For --
796 -----------------------
797
798 function Objects_Exist_For
799 (Language : String;
800 In_Tree : Project_Tree_Ref) return Boolean
801 is
802 Language_Id : Name_Id;
803 Lang : Language_Index;
804
805 begin
806 if Current_Mode = Multi_Language then
807 Name_Len := 0;
808 Add_Str_To_Name_Buffer (Language);
809 To_Lower (Name_Buffer (1 .. Name_Len));
810 Language_Id := Name_Find;
811
812 Lang := In_Tree.First_Language;
813
814 while Lang /= No_Language_Index loop
815 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
816 return
817 In_Tree.Languages_Data.Table
818 (Lang).Config.Objects_Generated;
819 end if;
820
821 Lang := In_Tree.Languages_Data.Table (Lang).Next;
822 end loop;
823 end if;
824
825 return True;
826 end Objects_Exist_For;
827
828 -----------------
829 -- Object_Name --
830 -----------------
831
832 function Object_Name
833 (Source_File_Name : File_Name_Type)
834 return File_Name_Type
835 is
836 begin
837 return Extend_Name (Source_File_Name, Object_Suffix);
838 end Object_Name;
839
840 ----------------------
841 -- Record_Temp_File --
842 ----------------------
843
844 procedure Record_Temp_File (Path : Path_Name_Type) is
845 begin
846 Temp_Files.Increment_Last;
847 Temp_Files.Table (Temp_Files.Last) := Path;
848 end Record_Temp_File;
849
850 ------------------------------------
851 -- Register_Default_Naming_Scheme --
852 ------------------------------------
853
854 procedure Register_Default_Naming_Scheme
855 (Language : Name_Id;
856 Default_Spec_Suffix : File_Name_Type;
857 Default_Body_Suffix : File_Name_Type;
858 In_Tree : Project_Tree_Ref)
859 is
860 Lang : Name_Id;
861 Suffix : Array_Element_Id;
862 Found : Boolean := False;
863 Element : Array_Element;
864
865 begin
866 -- Get the language name in small letters
867
868 Get_Name_String (Language);
869 Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
870 Lang := Name_Find;
871
872 Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
873 Found := False;
874
875 -- Look for an element of the spec sufix array indexed by the language
876 -- name. If one is found, put the default value.
877
878 while Suffix /= No_Array_Element and then not Found loop
879 Element := In_Tree.Array_Elements.Table (Suffix);
880
881 if Element.Index = Lang then
882 Found := True;
883 Element.Value.Value := Name_Id (Default_Spec_Suffix);
884 In_Tree.Array_Elements.Table (Suffix) := Element;
885
886 else
887 Suffix := Element.Next;
888 end if;
889 end loop;
890
891 -- If none can be found, create a new one
892
893 if not Found then
894 Element :=
895 (Index => Lang,
896 Src_Index => 0,
897 Index_Case_Sensitive => False,
898 Value => (Project => No_Project,
899 Kind => Single,
900 Location => No_Location,
901 Default => False,
902 Value => Name_Id (Default_Spec_Suffix),
903 Index => 0),
904 Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
905 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
906 In_Tree.Array_Elements.Table
907 (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
908 Element;
909 In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
910 Array_Element_Table.Last (In_Tree.Array_Elements);
911 end if;
912
913 Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
914 Found := False;
915
916 -- Look for an element of the body sufix array indexed by the language
917 -- name. If one is found, put the default value.
918
919 while Suffix /= No_Array_Element and then not Found loop
920 Element := In_Tree.Array_Elements.Table (Suffix);
921
922 if Element.Index = Lang then
923 Found := True;
924 Element.Value.Value := Name_Id (Default_Body_Suffix);
925 In_Tree.Array_Elements.Table (Suffix) := Element;
926
927 else
928 Suffix := Element.Next;
929 end if;
930 end loop;
931
932 -- If none can be found, create a new one
933
934 if not Found then
935 Element :=
936 (Index => Lang,
937 Src_Index => 0,
938 Index_Case_Sensitive => False,
939 Value => (Project => No_Project,
940 Kind => Single,
941 Location => No_Location,
942 Default => False,
943 Value => Name_Id (Default_Body_Suffix),
944 Index => 0),
945 Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
946 Array_Element_Table.Increment_Last
947 (In_Tree.Array_Elements);
948 In_Tree.Array_Elements.Table
949 (Array_Element_Table.Last (In_Tree.Array_Elements))
950 := Element;
951 In_Tree.Private_Part.Default_Naming.Body_Suffix :=
952 Array_Element_Table.Last (In_Tree.Array_Elements);
953 end if;
954 end Register_Default_Naming_Scheme;
955
956 -----------
957 -- Reset --
958 -----------
959
960 procedure Reset (Tree : Project_Tree_Ref) is
961
962 -- Def_Lang : constant Name_Node :=
963 -- (Name => Name_Ada,
964 -- Next => No_Name_List);
965 -- Why is the above commented out ???
966
967 begin
968 Prj.Env.Initialize;
969
970 -- gprmake tables
971
972 Present_Language_Table.Init (Tree.Present_Languages);
973 Supp_Suffix_Table.Init (Tree.Supp_Suffixes);
974 Supp_Language_Table.Init (Tree.Supp_Languages);
975 Other_Source_Table.Init (Tree.Other_Sources);
976
977 -- Visible tables
978
979 Language_Data_Table.Init (Tree.Languages_Data);
980 Name_List_Table.Init (Tree.Name_Lists);
981 String_Element_Table.Init (Tree.String_Elements);
982 Variable_Element_Table.Init (Tree.Variable_Elements);
983 Array_Element_Table.Init (Tree.Array_Elements);
984 Array_Table.Init (Tree.Arrays);
985 Package_Table.Init (Tree.Packages);
986 Project_List_Table.Init (Tree.Project_Lists);
987 Project_Table.Init (Tree.Projects);
988 Source_Data_Table.Init (Tree.Sources);
989 Alternate_Language_Table.Init (Tree.Alt_Langs);
990 Unit_Table.Init (Tree.Units);
991 Units_Htable.Reset (Tree.Units_HT);
992 Files_Htable.Reset (Tree.Files_HT);
993 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
994
995 -- Private part table
996
997 Naming_Table.Init (Tree.Private_Part.Namings);
998 Naming_Table.Increment_Last (Tree.Private_Part.Namings);
999 Tree.Private_Part.Namings.Table
1000 (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
1001 Path_File_Table.Init (Tree.Private_Part.Path_Files);
1002 Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
1003 Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
1004 Tree.Private_Part.Default_Naming := Std_Naming_Data;
1005
1006 if Current_Mode = Ada_Only then
1007 Register_Default_Naming_Scheme
1008 (Language => Name_Ada,
1009 Default_Spec_Suffix => Default_Ada_Spec_Suffix,
1010 Default_Body_Suffix => Default_Ada_Body_Suffix,
1011 In_Tree => Tree);
1012 Tree.Private_Part.Default_Naming.Separate_Suffix :=
1013 Default_Ada_Body_Suffix;
1014 end if;
1015 end Reset;
1016
1017 ------------------------
1018 -- Same_Naming_Scheme --
1019 ------------------------
1020
1021 function Same_Naming_Scheme
1022 (Left, Right : Naming_Data) return Boolean
1023 is
1024 begin
1025 return Left.Dot_Replacement = Right.Dot_Replacement
1026 and then Left.Casing = Right.Casing
1027 and then Left.Separate_Suffix = Right.Separate_Suffix;
1028 end Same_Naming_Scheme;
1029
1030 ---------
1031 -- Set --
1032 ---------
1033
1034 procedure Set
1035 (Language : Language_Index;
1036 Present : Boolean;
1037 In_Project : in out Project_Data;
1038 In_Tree : Project_Tree_Ref)
1039 is
1040 begin
1041 case Language is
1042 when No_Language_Index =>
1043 null;
1044
1045 when First_Language_Indexes =>
1046 In_Project.Langs (Language) := Present;
1047
1048 when others =>
1049 declare
1050 Supp : Supp_Language;
1051 Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
1052
1053 begin
1054 while Supp_Index /= No_Supp_Language_Index loop
1055 Supp := In_Tree.Present_Languages.Table
1056 (Supp_Index);
1057
1058 if Supp.Index = Language then
1059 In_Tree.Present_Languages.Table
1060 (Supp_Index).Present := Present;
1061 return;
1062 end if;
1063
1064 Supp_Index := Supp.Next;
1065 end loop;
1066
1067 Supp := (Index => Language, Present => Present,
1068 Next => In_Project.Supp_Languages);
1069 Present_Language_Table.Increment_Last
1070 (In_Tree.Present_Languages);
1071 Supp_Index := Present_Language_Table.Last
1072 (In_Tree.Present_Languages);
1073 In_Tree.Present_Languages.Table (Supp_Index) :=
1074 Supp;
1075 In_Project.Supp_Languages := Supp_Index;
1076 end;
1077 end case;
1078 end Set;
1079
1080 procedure Set
1081 (Language_Processing : Language_Processing_Data;
1082 For_Language : Language_Index;
1083 In_Project : in out Project_Data;
1084 In_Tree : Project_Tree_Ref)
1085 is
1086 begin
1087 case For_Language is
1088 when No_Language_Index =>
1089 null;
1090
1091 when First_Language_Indexes =>
1092 In_Project.First_Lang_Processing (For_Language) :=
1093 Language_Processing;
1094
1095 when others =>
1096 declare
1097 Supp : Supp_Language_Data;
1098 Supp_Index : Supp_Language_Index;
1099
1100 begin
1101 Supp_Index := In_Project.Supp_Language_Processing;
1102 while Supp_Index /= No_Supp_Language_Index loop
1103 Supp := In_Tree.Supp_Languages.Table (Supp_Index);
1104
1105 if Supp.Index = For_Language then
1106 In_Tree.Supp_Languages.Table
1107 (Supp_Index).Data := Language_Processing;
1108 return;
1109 end if;
1110
1111 Supp_Index := Supp.Next;
1112 end loop;
1113
1114 Supp := (Index => For_Language, Data => Language_Processing,
1115 Next => In_Project.Supp_Language_Processing);
1116 Supp_Language_Table.Increment_Last
1117 (In_Tree.Supp_Languages);
1118 Supp_Index := Supp_Language_Table.Last
1119 (In_Tree.Supp_Languages);
1120 In_Tree.Supp_Languages.Table (Supp_Index) := Supp;
1121 In_Project.Supp_Language_Processing := Supp_Index;
1122 end;
1123 end case;
1124 end Set;
1125
1126 procedure Set
1127 (Suffix : File_Name_Type;
1128 For_Language : Language_Index;
1129 In_Project : in out Project_Data;
1130 In_Tree : Project_Tree_Ref)
1131 is
1132 begin
1133 case For_Language is
1134 when No_Language_Index =>
1135 null;
1136
1137 when First_Language_Indexes =>
1138 In_Project.Naming.Impl_Suffixes (For_Language) := Suffix;
1139
1140 when others =>
1141 declare
1142 Supp : Supp_Suffix;
1143 Supp_Index : Supp_Language_Index :=
1144 In_Project.Naming.Supp_Suffixes;
1145
1146 begin
1147 while Supp_Index /= No_Supp_Language_Index loop
1148 Supp := In_Tree.Supp_Suffixes.Table
1149 (Supp_Index);
1150
1151 if Supp.Index = For_Language then
1152 In_Tree.Supp_Suffixes.Table
1153 (Supp_Index).Suffix := Suffix;
1154 return;
1155 end if;
1156
1157 Supp_Index := Supp.Next;
1158 end loop;
1159
1160 Supp := (Index => For_Language, Suffix => Suffix,
1161 Next => In_Project.Naming.Supp_Suffixes);
1162 Supp_Suffix_Table.Increment_Last
1163 (In_Tree.Supp_Suffixes);
1164 Supp_Index := Supp_Suffix_Table.Last
1165 (In_Tree.Supp_Suffixes);
1166 In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
1167 In_Project.Naming.Supp_Suffixes := Supp_Index;
1168 end;
1169 end case;
1170 end Set;
1171
1172 ---------------------
1173 -- Set_Body_Suffix --
1174 ---------------------
1175
1176 procedure Set_Body_Suffix
1177 (In_Tree : Project_Tree_Ref;
1178 Language : String;
1179 Naming : in out Naming_Data;
1180 Suffix : File_Name_Type)
1181 is
1182 Language_Id : Name_Id;
1183 Element : Array_Element;
1184
1185 begin
1186 Name_Len := 0;
1187 Add_Str_To_Name_Buffer (Language);
1188 To_Lower (Name_Buffer (1 .. Name_Len));
1189 Language_Id := Name_Find;
1190
1191 Element :=
1192 (Index => Language_Id,
1193 Src_Index => 0,
1194 Index_Case_Sensitive => False,
1195 Value =>
1196 (Kind => Single,
1197 Project => No_Project,
1198 Location => No_Location,
1199 Default => False,
1200 Value => Name_Id (Suffix),
1201 Index => 0),
1202 Next => Naming.Body_Suffix);
1203
1204 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1205 Naming.Body_Suffix :=
1206 Array_Element_Table.Last (In_Tree.Array_Elements);
1207 In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
1208 end Set_Body_Suffix;
1209
1210 --------------------------
1211 -- Set_In_Configuration --
1212 --------------------------
1213
1214 procedure Set_In_Configuration (Value : Boolean) is
1215 begin
1216 Configuration_Mode := Value;
1217 end Set_In_Configuration;
1218
1219 --------------
1220 -- Set_Mode --
1221 --------------
1222
1223 procedure Set_Mode (New_Mode : Mode) is
1224 begin
1225 Current_Mode := New_Mode;
1226 end Set_Mode;
1227
1228 ---------------------
1229 -- Set_Spec_Suffix --
1230 ---------------------
1231
1232 procedure Set_Spec_Suffix
1233 (In_Tree : Project_Tree_Ref;
1234 Language : String;
1235 Naming : in out Naming_Data;
1236 Suffix : File_Name_Type)
1237 is
1238 Language_Id : Name_Id;
1239 Element : Array_Element;
1240
1241 begin
1242 Name_Len := 0;
1243 Add_Str_To_Name_Buffer (Language);
1244 To_Lower (Name_Buffer (1 .. Name_Len));
1245 Language_Id := Name_Find;
1246
1247 Element :=
1248 (Index => Language_Id,
1249 Src_Index => 0,
1250 Index_Case_Sensitive => False,
1251 Value =>
1252 (Kind => Single,
1253 Project => No_Project,
1254 Location => No_Location,
1255 Default => False,
1256 Value => Name_Id (Suffix),
1257 Index => 0),
1258 Next => Naming.Spec_Suffix);
1259
1260 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1261 Naming.Spec_Suffix :=
1262 Array_Element_Table.Last (In_Tree.Array_Elements);
1263 In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
1264 end Set_Spec_Suffix;
1265
1266 -----------
1267 -- Slash --
1268 -----------
1269
1270 function Slash return Path_Name_Type is
1271 begin
1272 return Slash_Id;
1273 end Slash;
1274
1275 -----------------------
1276 -- Spec_Suffix_Id_Of --
1277 -----------------------
1278
1279 function Spec_Suffix_Id_Of
1280 (In_Tree : Project_Tree_Ref;
1281 Language : String;
1282 Naming : Naming_Data) return File_Name_Type
1283 is
1284 Language_Id : Name_Id;
1285 Element_Id : Array_Element_Id;
1286 Element : Array_Element;
1287 Suffix : File_Name_Type := No_File;
1288 Lang : Language_Index;
1289
1290 begin
1291 Name_Len := 0;
1292 Add_Str_To_Name_Buffer (Language);
1293 To_Lower (Name_Buffer (1 .. Name_Len));
1294 Language_Id := Name_Find;
1295
1296 Element_Id := Naming.Spec_Suffix;
1297
1298 while Element_Id /= No_Array_Element loop
1299 Element := In_Tree.Array_Elements.Table (Element_Id);
1300
1301 if Element.Index = Language_Id then
1302 return File_Name_Type (Element.Value.Value);
1303 end if;
1304
1305 Element_Id := Element.Next;
1306 end loop;
1307
1308 if Current_Mode = Multi_Language then
1309 Lang := In_Tree.First_Language;
1310
1311 while Lang /= No_Language_Index loop
1312 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1313 Suffix :=
1314 In_Tree.Languages_Data.Table
1315 (Lang).Config.Naming_Data.Spec_Suffix;
1316 exit;
1317 end if;
1318
1319 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1320 end loop;
1321 end if;
1322
1323 return Suffix;
1324 end Spec_Suffix_Id_Of;
1325
1326 --------------------
1327 -- Spec_Suffix_Of --
1328 --------------------
1329
1330 function Spec_Suffix_Of
1331 (In_Tree : Project_Tree_Ref;
1332 Language : String;
1333 Naming : Naming_Data) return String
1334 is
1335 Language_Id : Name_Id;
1336 Element_Id : Array_Element_Id;
1337 Element : Array_Element;
1338 Suffix : File_Name_Type := No_File;
1339 Lang : Language_Index;
1340
1341 begin
1342 Name_Len := 0;
1343 Add_Str_To_Name_Buffer (Language);
1344 To_Lower (Name_Buffer (1 .. Name_Len));
1345 Language_Id := Name_Find;
1346
1347 Element_Id := Naming.Spec_Suffix;
1348
1349 while Element_Id /= No_Array_Element loop
1350 Element := In_Tree.Array_Elements.Table (Element_Id);
1351
1352 if Element.Index = Language_Id then
1353 return Get_Name_String (Element.Value.Value);
1354 end if;
1355
1356 Element_Id := Element.Next;
1357 end loop;
1358
1359 if Current_Mode = Multi_Language then
1360 Lang := In_Tree.First_Language;
1361
1362 while Lang /= No_Language_Index loop
1363 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1364 Suffix :=
1365 File_Name_Type
1366 (In_Tree.Languages_Data.Table
1367 (Lang).Config.Naming_Data.Spec_Suffix);
1368 exit;
1369 end if;
1370
1371 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1372 end loop;
1373
1374 if Suffix /= No_File then
1375 return Get_Name_String (Suffix);
1376 end if;
1377 end if;
1378
1379 return "";
1380 end Spec_Suffix_Of;
1381
1382 --------------------------
1383 -- Standard_Naming_Data --
1384 --------------------------
1385
1386 function Standard_Naming_Data
1387 (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
1388 is
1389 begin
1390 if Tree = No_Project_Tree then
1391 Prj.Initialize (Tree => No_Project_Tree);
1392 return Std_Naming_Data;
1393
1394 else
1395 return Tree.Private_Part.Default_Naming;
1396 end if;
1397 end Standard_Naming_Data;
1398
1399 ---------------
1400 -- Suffix_Of --
1401 ---------------
1402
1403 function Suffix_Of
1404 (Language : Language_Index;
1405 In_Project : Project_Data;
1406 In_Tree : Project_Tree_Ref) return File_Name_Type
1407 is
1408 begin
1409 case Language is
1410 when No_Language_Index =>
1411 return No_File;
1412
1413 when First_Language_Indexes =>
1414 return In_Project.Naming.Impl_Suffixes (Language);
1415
1416 when others =>
1417 declare
1418 Supp : Supp_Suffix;
1419 Supp_Index : Supp_Language_Index :=
1420 In_Project.Naming.Supp_Suffixes;
1421
1422 begin
1423 while Supp_Index /= No_Supp_Language_Index loop
1424 Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
1425
1426 if Supp.Index = Language then
1427 return Supp.Suffix;
1428 end if;
1429
1430 Supp_Index := Supp.Next;
1431 end loop;
1432
1433 return No_File;
1434 end;
1435 end case;
1436 end Suffix_Of;
1437
1438 -------------------
1439 -- Switches_Name --
1440 -------------------
1441
1442 function Switches_Name
1443 (Source_File_Name : File_Name_Type) return File_Name_Type
1444 is
1445 begin
1446 return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
1447 end Switches_Name;
1448
1449 ---------------------------
1450 -- There_Are_Ada_Sources --
1451 ---------------------------
1452
1453 function There_Are_Ada_Sources
1454 (In_Tree : Project_Tree_Ref;
1455 Project : Project_Id) return Boolean
1456 is
1457 Prj : Project_Id;
1458
1459 begin
1460 Prj := Project;
1461 while Prj /= No_Project loop
1462 if In_Tree.Projects.Table (Prj).Ada_Sources /= Nil_String then
1463 return True;
1464 end if;
1465
1466 Prj := In_Tree.Projects.Table (Prj).Extends;
1467 end loop;
1468
1469 return False;
1470 end There_Are_Ada_Sources;
1471
1472 -----------
1473 -- Value --
1474 -----------
1475
1476 function Value (Image : String) return Casing_Type is
1477 begin
1478 for Casing in The_Casing_Images'Range loop
1479 if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
1480 return Casing;
1481 end if;
1482 end loop;
1483
1484 raise Constraint_Error;
1485 end Value;
1486
1487 begin
1488 -- Make sure that the standard config and user project file extensions are
1489 -- compatible with canonical case file naming.
1490
1491 Canonical_Case_File_Name (Config_Project_File_Extension);
1492 Canonical_Case_File_Name (Project_File_Extension);
1493 end Prj;