projects / gcc.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
s-taprop-solaris.adb, [...]: Minor reformatting.
[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 pragma Warnings (Off, Dont_Care);
368 begin
369 if not Debug.Debug_Flag_N then
370 for Index in 1 .. Temp_Files.Last loop
371 Delete_File
372 (Get_Name_String (Temp_Files.Table (Index)), Dont_Care);
373 end loop;
374 end if;
375 end Delete_All_Temp_Files;
376
377 ---------------------
378 -- Dependency_Name --
379 ---------------------
380
381 function Dependency_Name
382 (Source_File_Name : File_Name_Type;
383 Dependency : Dependency_File_Kind) return File_Name_Type
384 is
385 begin
386 case Dependency is
387 when None =>
388 return No_File;
389
390 when Makefile =>
391 return
392 File_Name_Type
393 (Extend_Name
394 (Source_File_Name, Makefile_Dependency_Suffix));
395
396 when ALI_File =>
397 return
398 File_Name_Type
399 (Extend_Name
400 (Source_File_Name, ALI_Dependency_Suffix));
401 end case;
402 end Dependency_Name;
403
404 ---------------------------
405 -- Display_Language_Name --
406 ---------------------------
407
408 procedure Display_Language_Name
409 (In_Tree : Project_Tree_Ref;
410 Language : Language_Index)
411 is
412 begin
413 Get_Name_String (In_Tree.Languages_Data.Table (Language).Display_Name);
414 Write_Str (Name_Buffer (1 .. Name_Len));
415 end Display_Language_Name;
416
417 ---------------------------
418 -- Display_Language_Name --
419 ---------------------------
420
421 procedure Display_Language_Name (Language : Language_Index) is
422 begin
423 Get_Name_String (Language_Names.Table (Language));
424 To_Upper (Name_Buffer (1 .. 1));
425 Write_Str (Name_Buffer (1 .. Name_Len));
426 end Display_Language_Name;
427
428 ----------------
429 -- Empty_File --
430 ----------------
431
432 function Empty_File return File_Name_Type is
433 begin
434 return File_Name_Type (The_Empty_String);
435 end Empty_File;
436
437 -------------------
438 -- Empty_Project --
439 -------------------
440
441 function Empty_Project (Tree : Project_Tree_Ref) return Project_Data is
442 Value : Project_Data;
443
444 begin
445 Prj.Initialize (Tree => No_Project_Tree);
446 Value := Project_Empty;
447 Value.Naming := Tree.Private_Part.Default_Naming;
448
449 return Value;
450 end Empty_Project;
451
452 ------------------
453 -- Empty_String --
454 ------------------
455
456 function Empty_String return Name_Id is
457 begin
458 return The_Empty_String;
459 end Empty_String;
460
461 ------------
462 -- Expect --
463 ------------
464
465 procedure Expect (The_Token : Token_Type; Token_Image : String) is
466 begin
467 if Token /= The_Token then
468 Error_Msg (Token_Image & " expected", Token_Ptr);
469 end if;
470 end Expect;
471
472 -----------------
473 -- Extend_Name --
474 -----------------
475
476 function Extend_Name
477 (File : File_Name_Type;
478 With_Suffix : String) return File_Name_Type
479 is
480 Last : Positive;
481
482 begin
483 Get_Name_String (File);
484 Last := Name_Len + 1;
485
486 while Name_Len /= 0 and then Name_Buffer (Name_Len) /= '.' loop
487 Name_Len := Name_Len - 1;
488 end loop;
489
490 if Name_Len <= 1 then
491 Name_Len := Last;
492 end if;
493
494 for J in With_Suffix'Range loop
495 Name_Buffer (Name_Len) := With_Suffix (J);
496 Name_Len := Name_Len + 1;
497 end loop;
498
499 Name_Len := Name_Len - 1;
500 return Name_Find;
501
502 end Extend_Name;
503
504 --------------------------------
505 -- For_Every_Project_Imported --
506 --------------------------------
507
508 procedure For_Every_Project_Imported
509 (By : Project_Id;
510 In_Tree : Project_Tree_Ref;
511 With_State : in out State)
512 is
513
514 procedure Recursive_Check (Project : Project_Id);
515 -- Check if a project has already been seen. If not seen, mark it as
516 -- Seen, Call Action, and check all its imported projects.
517
518 ---------------------
519 -- Recursive_Check --
520 ---------------------
521
522 procedure Recursive_Check (Project : Project_Id) is
523 List : Project_List;
524 begin
525 if not In_Tree.Projects.Table (Project).Seen then
526 In_Tree.Projects.Table (Project).Seen := True;
527 Action (Project, With_State);
528
529 List :=
530 In_Tree.Projects.Table (Project).Imported_Projects;
531 while List /= Empty_Project_List loop
532 Recursive_Check (In_Tree.Project_Lists.Table (List).Project);
533 List := In_Tree.Project_Lists.Table (List).Next;
534 end loop;
535 end if;
536 end Recursive_Check;
537
538 -- Start of processing for For_Every_Project_Imported
539
540 begin
541 for Project in Project_Table.First ..
542 Project_Table.Last (In_Tree.Projects)
543 loop
544 In_Tree.Projects.Table (Project).Seen := False;
545 end loop;
546
547 Recursive_Check (Project => By);
548 end For_Every_Project_Imported;
549
550 --------------
551 -- Get_Mode --
552 --------------
553
554 function Get_Mode return Mode is
555 begin
556 return Current_Mode;
557 end Get_Mode;
558
559 ----------
560 -- Hash --
561 ----------
562
563 function Hash (Name : File_Name_Type) return Header_Num is
564 begin
565 return Hash (Get_Name_String (Name));
566 end Hash;
567
568 function Hash (Name : Name_Id) return Header_Num is
569 begin
570 return Hash (Get_Name_String (Name));
571 end Hash;
572
573 function Hash (Name : Path_Name_Type) return Header_Num is
574 begin
575 return Hash (Get_Name_String (Name));
576 end Hash;
577
578 -----------
579 -- Image --
580 -----------
581
582 function Image (Casing : Casing_Type) return String is
583 begin
584 return The_Casing_Images (Casing).all;
585 end Image;
586
587 ----------------------
588 -- In_Configuration --
589 ----------------------
590
591 function In_Configuration return Boolean is
592 begin
593 return Configuration_Mode;
594 end In_Configuration;
595
596 ----------------
597 -- Initialize --
598 ----------------
599
600 procedure Initialize (Tree : Project_Tree_Ref) is
601 begin
602 if not Initialized then
603 Initialized := True;
604 Uintp.Initialize;
605 Name_Len := 0;
606 The_Empty_String := Name_Find;
607 Empty_Name := The_Empty_String;
608 Name_Len := 4;
609 Name_Buffer (1 .. 4) := ".ads";
610 Default_Ada_Spec_Suffix_Id := Name_Find;
611 Name_Len := 4;
612 Name_Buffer (1 .. 4) := ".adb";
613 Default_Ada_Body_Suffix_Id := Name_Find;
614 Name_Len := 1;
615 Name_Buffer (1) := '/';
616 Slash_Id := Name_Find;
617 Name_Len := 3;
618 Name_Buffer (1 .. 3) := "c++";
619 Name_C_Plus_Plus := Name_Find;
620
621 Prj.Env.Initialize;
622 Prj.Attr.Initialize;
623 Set_Name_Table_Byte (Name_Project, Token_Type'Pos (Tok_Project));
624 Set_Name_Table_Byte (Name_Extends, Token_Type'Pos (Tok_Extends));
625 Set_Name_Table_Byte (Name_External, Token_Type'Pos (Tok_External));
626
627 Language_Indexes.Reset;
628 Last_Language_Index := No_Language_Index;
629 Language_Names.Init;
630 Add_Language_Name (Name_Ada);
631 Add_Language_Name (Name_C);
632 Add_Language_Name (Name_C_Plus_Plus);
633 end if;
634
635 if Tree /= No_Project_Tree then
636 Reset (Tree);
637 end if;
638 end Initialize;
639
640 -------------------
641 -- Is_A_Language --
642 -------------------
643
644 function Is_A_Language
645 (Tree : Project_Tree_Ref;
646 Data : Project_Data;
647 Language_Name : String) return Boolean
648 is
649 Lang_Id : Name_Id;
650
651 begin
652 Name_Len := 0;
653 Add_Str_To_Name_Buffer (Language_Name);
654 To_Lower (Name_Buffer (1 .. Name_Len));
655 Lang_Id := Name_Find;
656
657 if Get_Mode = Ada_Only then
658 declare
659 List : Name_List_Index := Data.Languages;
660
661 begin
662 while List /= No_Name_List loop
663 if Tree.Name_Lists.Table (List).Name = Lang_Id then
664 return True;
665
666 else
667 List := Tree.Name_Lists.Table (List).Next;
668 end if;
669 end loop;
670 end;
671
672 else
673 declare
674 Lang_Ind : Language_Index;
675 Lang_Data : Language_Data;
676
677 begin
678 Lang_Ind := Data.First_Language_Processing;
679 while Lang_Ind /= No_Language_Index loop
680 Lang_Data := Tree.Languages_Data.Table (Lang_Ind);
681
682 if Lang_Data.Name = Lang_Id then
683 return True;
684 end if;
685
686 Lang_Ind := Lang_Data.Next;
687 end loop;
688 end;
689 end if;
690
691 return False;
692 end Is_A_Language;
693
694 ------------------
695 -- Is_Extending --
696 ------------------
697
698 function Is_Extending
699 (Extending : Project_Id;
700 Extended : Project_Id;
701 In_Tree : Project_Tree_Ref) return Boolean
702 is
703 Proj : Project_Id;
704
705 begin
706 Proj := Extending;
707 while Proj /= No_Project loop
708 if Proj = Extended then
709 return True;
710 end if;
711
712 Proj := In_Tree.Projects.Table (Proj).Extends;
713 end loop;
714
715 return False;
716 end Is_Extending;
717
718 ----------------
719 -- Is_Present --
720 ----------------
721
722 function Is_Present
723 (Language : Language_Index;
724 In_Project : Project_Data;
725 In_Tree : Project_Tree_Ref) return Boolean
726 is
727 begin
728 case Language is
729 when No_Language_Index =>
730 return False;
731
732 when First_Language_Indexes =>
733 return In_Project.Langs (Language);
734
735 when others =>
736 declare
737 Supp : Supp_Language;
738 Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
739
740 begin
741 while Supp_Index /= No_Supp_Language_Index loop
742 Supp := In_Tree.Present_Languages.Table (Supp_Index);
743
744 if Supp.Index = Language then
745 return Supp.Present;
746 end if;
747
748 Supp_Index := Supp.Next;
749 end loop;
750
751 return False;
752 end;
753 end case;
754 end Is_Present;
755
756 ---------------------------------
757 -- Language_Processing_Data_Of --
758 ---------------------------------
759
760 function Language_Processing_Data_Of
761 (Language : Language_Index;
762 In_Project : Project_Data;
763 In_Tree : Project_Tree_Ref) return Language_Processing_Data
764 is
765 begin
766 case Language is
767 when No_Language_Index =>
768 return Default_Language_Processing_Data;
769
770 when First_Language_Indexes =>
771 return In_Project.First_Lang_Processing (Language);
772
773 when others =>
774 declare
775 Supp : Supp_Language_Data;
776 Supp_Index : Supp_Language_Index :=
777 In_Project.Supp_Language_Processing;
778
779 begin
780 while Supp_Index /= No_Supp_Language_Index loop
781 Supp := In_Tree.Supp_Languages.Table (Supp_Index);
782
783 if Supp.Index = Language then
784 return Supp.Data;
785 end if;
786
787 Supp_Index := Supp.Next;
788 end loop;
789
790 return Default_Language_Processing_Data;
791 end;
792 end case;
793 end Language_Processing_Data_Of;
794
795 -----------------------
796 -- Objects_Exist_For --
797 -----------------------
798
799 function Objects_Exist_For
800 (Language : String;
801 In_Tree : Project_Tree_Ref) return Boolean
802 is
803 Language_Id : Name_Id;
804 Lang : Language_Index;
805
806 begin
807 if Current_Mode = Multi_Language then
808 Name_Len := 0;
809 Add_Str_To_Name_Buffer (Language);
810 To_Lower (Name_Buffer (1 .. Name_Len));
811 Language_Id := Name_Find;
812
813 Lang := In_Tree.First_Language;
814
815 while Lang /= No_Language_Index loop
816 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
817 return
818 In_Tree.Languages_Data.Table
819 (Lang).Config.Objects_Generated;
820 end if;
821
822 Lang := In_Tree.Languages_Data.Table (Lang).Next;
823 end loop;
824 end if;
825
826 return True;
827 end Objects_Exist_For;
828
829 -----------------
830 -- Object_Name --
831 -----------------
832
833 function Object_Name
834 (Source_File_Name : File_Name_Type)
835 return File_Name_Type
836 is
837 begin
838 return Extend_Name (Source_File_Name, Object_Suffix);
839 end Object_Name;
840
841 ----------------------
842 -- Record_Temp_File --
843 ----------------------
844
845 procedure Record_Temp_File (Path : Path_Name_Type) is
846 begin
847 Temp_Files.Increment_Last;
848 Temp_Files.Table (Temp_Files.Last) := Path;
849 end Record_Temp_File;
850
851 ------------------------------------
852 -- Register_Default_Naming_Scheme --
853 ------------------------------------
854
855 procedure Register_Default_Naming_Scheme
856 (Language : Name_Id;
857 Default_Spec_Suffix : File_Name_Type;
858 Default_Body_Suffix : File_Name_Type;
859 In_Tree : Project_Tree_Ref)
860 is
861 Lang : Name_Id;
862 Suffix : Array_Element_Id;
863 Found : Boolean := False;
864 Element : Array_Element;
865
866 begin
867 -- Get the language name in small letters
868
869 Get_Name_String (Language);
870 Name_Buffer (1 .. Name_Len) := To_Lower (Name_Buffer (1 .. Name_Len));
871 Lang := Name_Find;
872
873 Suffix := In_Tree.Private_Part.Default_Naming.Spec_Suffix;
874 Found := False;
875
876 -- Look for an element of the spec sufix array indexed by the language
877 -- name. If one is found, put the default value.
878
879 while Suffix /= No_Array_Element and then not Found loop
880 Element := In_Tree.Array_Elements.Table (Suffix);
881
882 if Element.Index = Lang then
883 Found := True;
884 Element.Value.Value := Name_Id (Default_Spec_Suffix);
885 In_Tree.Array_Elements.Table (Suffix) := Element;
886
887 else
888 Suffix := Element.Next;
889 end if;
890 end loop;
891
892 -- If none can be found, create a new one
893
894 if not Found then
895 Element :=
896 (Index => Lang,
897 Src_Index => 0,
898 Index_Case_Sensitive => False,
899 Value => (Project => No_Project,
900 Kind => Single,
901 Location => No_Location,
902 Default => False,
903 Value => Name_Id (Default_Spec_Suffix),
904 Index => 0),
905 Next => In_Tree.Private_Part.Default_Naming.Spec_Suffix);
906 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
907 In_Tree.Array_Elements.Table
908 (Array_Element_Table.Last (In_Tree.Array_Elements)) :=
909 Element;
910 In_Tree.Private_Part.Default_Naming.Spec_Suffix :=
911 Array_Element_Table.Last (In_Tree.Array_Elements);
912 end if;
913
914 Suffix := In_Tree.Private_Part.Default_Naming.Body_Suffix;
915 Found := False;
916
917 -- Look for an element of the body sufix array indexed by the language
918 -- name. If one is found, put the default value.
919
920 while Suffix /= No_Array_Element and then not Found loop
921 Element := In_Tree.Array_Elements.Table (Suffix);
922
923 if Element.Index = Lang then
924 Found := True;
925 Element.Value.Value := Name_Id (Default_Body_Suffix);
926 In_Tree.Array_Elements.Table (Suffix) := Element;
927
928 else
929 Suffix := Element.Next;
930 end if;
931 end loop;
932
933 -- If none can be found, create a new one
934
935 if not Found then
936 Element :=
937 (Index => Lang,
938 Src_Index => 0,
939 Index_Case_Sensitive => False,
940 Value => (Project => No_Project,
941 Kind => Single,
942 Location => No_Location,
943 Default => False,
944 Value => Name_Id (Default_Body_Suffix),
945 Index => 0),
946 Next => In_Tree.Private_Part.Default_Naming.Body_Suffix);
947 Array_Element_Table.Increment_Last
948 (In_Tree.Array_Elements);
949 In_Tree.Array_Elements.Table
950 (Array_Element_Table.Last (In_Tree.Array_Elements))
951 := Element;
952 In_Tree.Private_Part.Default_Naming.Body_Suffix :=
953 Array_Element_Table.Last (In_Tree.Array_Elements);
954 end if;
955 end Register_Default_Naming_Scheme;
956
957 -----------
958 -- Reset --
959 -----------
960
961 procedure Reset (Tree : Project_Tree_Ref) is
962
963 -- Def_Lang : constant Name_Node :=
964 -- (Name => Name_Ada,
965 -- Next => No_Name_List);
966 -- Why is the above commented out ???
967
968 begin
969 Prj.Env.Initialize;
970
971 -- gprmake tables
972
973 Present_Language_Table.Init (Tree.Present_Languages);
974 Supp_Suffix_Table.Init (Tree.Supp_Suffixes);
975 Supp_Language_Table.Init (Tree.Supp_Languages);
976 Other_Source_Table.Init (Tree.Other_Sources);
977
978 -- Visible tables
979
980 Language_Data_Table.Init (Tree.Languages_Data);
981 Name_List_Table.Init (Tree.Name_Lists);
982 String_Element_Table.Init (Tree.String_Elements);
983 Variable_Element_Table.Init (Tree.Variable_Elements);
984 Array_Element_Table.Init (Tree.Array_Elements);
985 Array_Table.Init (Tree.Arrays);
986 Package_Table.Init (Tree.Packages);
987 Project_List_Table.Init (Tree.Project_Lists);
988 Project_Table.Init (Tree.Projects);
989 Source_Data_Table.Init (Tree.Sources);
990 Alternate_Language_Table.Init (Tree.Alt_Langs);
991 Unit_Table.Init (Tree.Units);
992 Units_Htable.Reset (Tree.Units_HT);
993 Files_Htable.Reset (Tree.Files_HT);
994 Source_Paths_Htable.Reset (Tree.Source_Paths_HT);
995
996 -- Private part table
997
998 Naming_Table.Init (Tree.Private_Part.Namings);
999 Naming_Table.Increment_Last (Tree.Private_Part.Namings);
1000 Tree.Private_Part.Namings.Table
1001 (Naming_Table.Last (Tree.Private_Part.Namings)) := Std_Naming_Data;
1002 Path_File_Table.Init (Tree.Private_Part.Path_Files);
1003 Source_Path_Table.Init (Tree.Private_Part.Source_Paths);
1004 Object_Path_Table.Init (Tree.Private_Part.Object_Paths);
1005 Tree.Private_Part.Default_Naming := Std_Naming_Data;
1006
1007 if Current_Mode = Ada_Only then
1008 Register_Default_Naming_Scheme
1009 (Language => Name_Ada,
1010 Default_Spec_Suffix => Default_Ada_Spec_Suffix,
1011 Default_Body_Suffix => Default_Ada_Body_Suffix,
1012 In_Tree => Tree);
1013 Tree.Private_Part.Default_Naming.Separate_Suffix :=
1014 Default_Ada_Body_Suffix;
1015 end if;
1016 end Reset;
1017
1018 ------------------------
1019 -- Same_Naming_Scheme --
1020 ------------------------
1021
1022 function Same_Naming_Scheme
1023 (Left, Right : Naming_Data) return Boolean
1024 is
1025 begin
1026 return Left.Dot_Replacement = Right.Dot_Replacement
1027 and then Left.Casing = Right.Casing
1028 and then Left.Separate_Suffix = Right.Separate_Suffix;
1029 end Same_Naming_Scheme;
1030
1031 ---------
1032 -- Set --
1033 ---------
1034
1035 procedure Set
1036 (Language : Language_Index;
1037 Present : Boolean;
1038 In_Project : in out Project_Data;
1039 In_Tree : Project_Tree_Ref)
1040 is
1041 begin
1042 case Language is
1043 when No_Language_Index =>
1044 null;
1045
1046 when First_Language_Indexes =>
1047 In_Project.Langs (Language) := Present;
1048
1049 when others =>
1050 declare
1051 Supp : Supp_Language;
1052 Supp_Index : Supp_Language_Index := In_Project.Supp_Languages;
1053
1054 begin
1055 while Supp_Index /= No_Supp_Language_Index loop
1056 Supp := In_Tree.Present_Languages.Table
1057 (Supp_Index);
1058
1059 if Supp.Index = Language then
1060 In_Tree.Present_Languages.Table
1061 (Supp_Index).Present := Present;
1062 return;
1063 end if;
1064
1065 Supp_Index := Supp.Next;
1066 end loop;
1067
1068 Supp := (Index => Language, Present => Present,
1069 Next => In_Project.Supp_Languages);
1070 Present_Language_Table.Increment_Last
1071 (In_Tree.Present_Languages);
1072 Supp_Index := Present_Language_Table.Last
1073 (In_Tree.Present_Languages);
1074 In_Tree.Present_Languages.Table (Supp_Index) :=
1075 Supp;
1076 In_Project.Supp_Languages := Supp_Index;
1077 end;
1078 end case;
1079 end Set;
1080
1081 procedure Set
1082 (Language_Processing : Language_Processing_Data;
1083 For_Language : Language_Index;
1084 In_Project : in out Project_Data;
1085 In_Tree : Project_Tree_Ref)
1086 is
1087 begin
1088 case For_Language is
1089 when No_Language_Index =>
1090 null;
1091
1092 when First_Language_Indexes =>
1093 In_Project.First_Lang_Processing (For_Language) :=
1094 Language_Processing;
1095
1096 when others =>
1097 declare
1098 Supp : Supp_Language_Data;
1099 Supp_Index : Supp_Language_Index;
1100
1101 begin
1102 Supp_Index := In_Project.Supp_Language_Processing;
1103 while Supp_Index /= No_Supp_Language_Index loop
1104 Supp := In_Tree.Supp_Languages.Table (Supp_Index);
1105
1106 if Supp.Index = For_Language then
1107 In_Tree.Supp_Languages.Table
1108 (Supp_Index).Data := Language_Processing;
1109 return;
1110 end if;
1111
1112 Supp_Index := Supp.Next;
1113 end loop;
1114
1115 Supp := (Index => For_Language, Data => Language_Processing,
1116 Next => In_Project.Supp_Language_Processing);
1117 Supp_Language_Table.Increment_Last
1118 (In_Tree.Supp_Languages);
1119 Supp_Index := Supp_Language_Table.Last
1120 (In_Tree.Supp_Languages);
1121 In_Tree.Supp_Languages.Table (Supp_Index) := Supp;
1122 In_Project.Supp_Language_Processing := Supp_Index;
1123 end;
1124 end case;
1125 end Set;
1126
1127 procedure Set
1128 (Suffix : File_Name_Type;
1129 For_Language : Language_Index;
1130 In_Project : in out Project_Data;
1131 In_Tree : Project_Tree_Ref)
1132 is
1133 begin
1134 case For_Language is
1135 when No_Language_Index =>
1136 null;
1137
1138 when First_Language_Indexes =>
1139 In_Project.Naming.Impl_Suffixes (For_Language) := Suffix;
1140
1141 when others =>
1142 declare
1143 Supp : Supp_Suffix;
1144 Supp_Index : Supp_Language_Index :=
1145 In_Project.Naming.Supp_Suffixes;
1146
1147 begin
1148 while Supp_Index /= No_Supp_Language_Index loop
1149 Supp := In_Tree.Supp_Suffixes.Table
1150 (Supp_Index);
1151
1152 if Supp.Index = For_Language then
1153 In_Tree.Supp_Suffixes.Table
1154 (Supp_Index).Suffix := Suffix;
1155 return;
1156 end if;
1157
1158 Supp_Index := Supp.Next;
1159 end loop;
1160
1161 Supp := (Index => For_Language, Suffix => Suffix,
1162 Next => In_Project.Naming.Supp_Suffixes);
1163 Supp_Suffix_Table.Increment_Last
1164 (In_Tree.Supp_Suffixes);
1165 Supp_Index := Supp_Suffix_Table.Last
1166 (In_Tree.Supp_Suffixes);
1167 In_Tree.Supp_Suffixes.Table (Supp_Index) := Supp;
1168 In_Project.Naming.Supp_Suffixes := Supp_Index;
1169 end;
1170 end case;
1171 end Set;
1172
1173 ---------------------
1174 -- Set_Body_Suffix --
1175 ---------------------
1176
1177 procedure Set_Body_Suffix
1178 (In_Tree : Project_Tree_Ref;
1179 Language : String;
1180 Naming : in out Naming_Data;
1181 Suffix : File_Name_Type)
1182 is
1183 Language_Id : Name_Id;
1184 Element : Array_Element;
1185
1186 begin
1187 Name_Len := 0;
1188 Add_Str_To_Name_Buffer (Language);
1189 To_Lower (Name_Buffer (1 .. Name_Len));
1190 Language_Id := Name_Find;
1191
1192 Element :=
1193 (Index => Language_Id,
1194 Src_Index => 0,
1195 Index_Case_Sensitive => False,
1196 Value =>
1197 (Kind => Single,
1198 Project => No_Project,
1199 Location => No_Location,
1200 Default => False,
1201 Value => Name_Id (Suffix),
1202 Index => 0),
1203 Next => Naming.Body_Suffix);
1204
1205 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1206 Naming.Body_Suffix :=
1207 Array_Element_Table.Last (In_Tree.Array_Elements);
1208 In_Tree.Array_Elements.Table (Naming.Body_Suffix) := Element;
1209 end Set_Body_Suffix;
1210
1211 --------------------------
1212 -- Set_In_Configuration --
1213 --------------------------
1214
1215 procedure Set_In_Configuration (Value : Boolean) is
1216 begin
1217 Configuration_Mode := Value;
1218 end Set_In_Configuration;
1219
1220 --------------
1221 -- Set_Mode --
1222 --------------
1223
1224 procedure Set_Mode (New_Mode : Mode) is
1225 begin
1226 Current_Mode := New_Mode;
1227 end Set_Mode;
1228
1229 ---------------------
1230 -- Set_Spec_Suffix --
1231 ---------------------
1232
1233 procedure Set_Spec_Suffix
1234 (In_Tree : Project_Tree_Ref;
1235 Language : String;
1236 Naming : in out Naming_Data;
1237 Suffix : File_Name_Type)
1238 is
1239 Language_Id : Name_Id;
1240 Element : Array_Element;
1241
1242 begin
1243 Name_Len := 0;
1244 Add_Str_To_Name_Buffer (Language);
1245 To_Lower (Name_Buffer (1 .. Name_Len));
1246 Language_Id := Name_Find;
1247
1248 Element :=
1249 (Index => Language_Id,
1250 Src_Index => 0,
1251 Index_Case_Sensitive => False,
1252 Value =>
1253 (Kind => Single,
1254 Project => No_Project,
1255 Location => No_Location,
1256 Default => False,
1257 Value => Name_Id (Suffix),
1258 Index => 0),
1259 Next => Naming.Spec_Suffix);
1260
1261 Array_Element_Table.Increment_Last (In_Tree.Array_Elements);
1262 Naming.Spec_Suffix :=
1263 Array_Element_Table.Last (In_Tree.Array_Elements);
1264 In_Tree.Array_Elements.Table (Naming.Spec_Suffix) := Element;
1265 end Set_Spec_Suffix;
1266
1267 -----------
1268 -- Slash --
1269 -----------
1270
1271 function Slash return Path_Name_Type is
1272 begin
1273 return Slash_Id;
1274 end Slash;
1275
1276 -----------------------
1277 -- Spec_Suffix_Id_Of --
1278 -----------------------
1279
1280 function Spec_Suffix_Id_Of
1281 (In_Tree : Project_Tree_Ref;
1282 Language : String;
1283 Naming : Naming_Data) return File_Name_Type
1284 is
1285 Language_Id : Name_Id;
1286 Element_Id : Array_Element_Id;
1287 Element : Array_Element;
1288 Suffix : File_Name_Type := No_File;
1289 Lang : Language_Index;
1290
1291 begin
1292 Name_Len := 0;
1293 Add_Str_To_Name_Buffer (Language);
1294 To_Lower (Name_Buffer (1 .. Name_Len));
1295 Language_Id := Name_Find;
1296
1297 Element_Id := Naming.Spec_Suffix;
1298
1299 while Element_Id /= No_Array_Element loop
1300 Element := In_Tree.Array_Elements.Table (Element_Id);
1301
1302 if Element.Index = Language_Id then
1303 return File_Name_Type (Element.Value.Value);
1304 end if;
1305
1306 Element_Id := Element.Next;
1307 end loop;
1308
1309 if Current_Mode = Multi_Language then
1310 Lang := In_Tree.First_Language;
1311
1312 while Lang /= No_Language_Index loop
1313 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1314 Suffix :=
1315 In_Tree.Languages_Data.Table
1316 (Lang).Config.Naming_Data.Spec_Suffix;
1317 exit;
1318 end if;
1319
1320 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1321 end loop;
1322 end if;
1323
1324 return Suffix;
1325 end Spec_Suffix_Id_Of;
1326
1327 --------------------
1328 -- Spec_Suffix_Of --
1329 --------------------
1330
1331 function Spec_Suffix_Of
1332 (In_Tree : Project_Tree_Ref;
1333 Language : String;
1334 Naming : Naming_Data) return String
1335 is
1336 Language_Id : Name_Id;
1337 Element_Id : Array_Element_Id;
1338 Element : Array_Element;
1339 Suffix : File_Name_Type := No_File;
1340 Lang : Language_Index;
1341
1342 begin
1343 Name_Len := 0;
1344 Add_Str_To_Name_Buffer (Language);
1345 To_Lower (Name_Buffer (1 .. Name_Len));
1346 Language_Id := Name_Find;
1347
1348 Element_Id := Naming.Spec_Suffix;
1349
1350 while Element_Id /= No_Array_Element loop
1351 Element := In_Tree.Array_Elements.Table (Element_Id);
1352
1353 if Element.Index = Language_Id then
1354 return Get_Name_String (Element.Value.Value);
1355 end if;
1356
1357 Element_Id := Element.Next;
1358 end loop;
1359
1360 if Current_Mode = Multi_Language then
1361 Lang := In_Tree.First_Language;
1362
1363 while Lang /= No_Language_Index loop
1364 if In_Tree.Languages_Data.Table (Lang).Name = Language_Id then
1365 Suffix :=
1366 File_Name_Type
1367 (In_Tree.Languages_Data.Table
1368 (Lang).Config.Naming_Data.Spec_Suffix);
1369 exit;
1370 end if;
1371
1372 Lang := In_Tree.Languages_Data.Table (Lang).Next;
1373 end loop;
1374
1375 if Suffix /= No_File then
1376 return Get_Name_String (Suffix);
1377 end if;
1378 end if;
1379
1380 return "";
1381 end Spec_Suffix_Of;
1382
1383 --------------------------
1384 -- Standard_Naming_Data --
1385 --------------------------
1386
1387 function Standard_Naming_Data
1388 (Tree : Project_Tree_Ref := No_Project_Tree) return Naming_Data
1389 is
1390 begin
1391 if Tree = No_Project_Tree then
1392 Prj.Initialize (Tree => No_Project_Tree);
1393 return Std_Naming_Data;
1394
1395 else
1396 return Tree.Private_Part.Default_Naming;
1397 end if;
1398 end Standard_Naming_Data;
1399
1400 ---------------
1401 -- Suffix_Of --
1402 ---------------
1403
1404 function Suffix_Of
1405 (Language : Language_Index;
1406 In_Project : Project_Data;
1407 In_Tree : Project_Tree_Ref) return File_Name_Type
1408 is
1409 begin
1410 case Language is
1411 when No_Language_Index =>
1412 return No_File;
1413
1414 when First_Language_Indexes =>
1415 return In_Project.Naming.Impl_Suffixes (Language);
1416
1417 when others =>
1418 declare
1419 Supp : Supp_Suffix;
1420 Supp_Index : Supp_Language_Index :=
1421 In_Project.Naming.Supp_Suffixes;
1422
1423 begin
1424 while Supp_Index /= No_Supp_Language_Index loop
1425 Supp := In_Tree.Supp_Suffixes.Table (Supp_Index);
1426
1427 if Supp.Index = Language then
1428 return Supp.Suffix;
1429 end if;
1430
1431 Supp_Index := Supp.Next;
1432 end loop;
1433
1434 return No_File;
1435 end;
1436 end case;
1437 end Suffix_Of;
1438
1439 -------------------
1440 -- Switches_Name --
1441 -------------------
1442
1443 function Switches_Name
1444 (Source_File_Name : File_Name_Type) return File_Name_Type
1445 is
1446 begin
1447 return Extend_Name (Source_File_Name, Switches_Dependency_Suffix);
1448 end Switches_Name;
1449
1450 ---------------------------
1451 -- There_Are_Ada_Sources --
1452 ---------------------------
1453
1454 function There_Are_Ada_Sources
1455 (In_Tree : Project_Tree_Ref;
1456 Project : Project_Id) return Boolean
1457 is
1458 Prj : Project_Id;
1459
1460 begin
1461 Prj := Project;
1462 while Prj /= No_Project loop
1463 if In_Tree.Projects.Table (Prj).Ada_Sources /= Nil_String then
1464 return True;
1465 end if;
1466
1467 Prj := In_Tree.Projects.Table (Prj).Extends;
1468 end loop;
1469
1470 return False;
1471 end There_Are_Ada_Sources;
1472
1473 -----------
1474 -- Value --
1475 -----------
1476
1477 function Value (Image : String) return Casing_Type is
1478 begin
1479 for Casing in The_Casing_Images'Range loop
1480 if To_Lower (Image) = To_Lower (The_Casing_Images (Casing).all) then
1481 return Casing;
1482 end if;
1483 end loop;
1484
1485 raise Constraint_Error;
1486 end Value;
1487
1488 begin
1489 -- Make sure that the standard config and user project file extensions are
1490 -- compatible with canonical case file naming.
1491
1492 Canonical_Case_File_Name (Config_Project_File_Extension);
1493 Canonical_Case_File_Name (Project_File_Extension);
1494 end Prj;