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