?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
* Make-lang.in (nmake.ads): Add dependency on ada/nmake.adb
[official-gcc.git] / gcc / ada / prj-part.adb
blob73d7c574575d87fbad6baffc7d274ac6aff30e10
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P R J . P A R T --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 2001-2003 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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 Err_Vars; use Err_Vars;
28 with Namet; use Namet;
29 with Opt;
30 with Osint; use Osint;
31 with Output; use Output;
32 with Prj.Com; use Prj.Com;
33 with Prj.Dect;
34 with Prj.Err; use Prj.Err;
35 with Scans; use Scans;
36 with Sinput; use Sinput;
37 with Sinput.P; use Sinput.P;
38 with Snames;
39 with Table;
40 with Types; use Types;
41
42 with Ada.Characters.Handling; use Ada.Characters.Handling;
43 with Ada.Exceptions; use Ada.Exceptions;
44
45 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
46 with GNAT.OS_Lib; use GNAT.OS_Lib;
47
48 with System.HTable; use System.HTable;
49
50 pragma Elaborate_All (GNAT.OS_Lib);
51
52 package body Prj.Part is
53
54 Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
55
56 Project_Path : String_Access;
57 -- The project path; initialized during package elaboration.
58 -- Contains at least the current working directory.
59
60 Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
61 -- Name of the env. variable that contains path name(s) of directories
62 -- where project files may reside.
63
64 Prj_Path : constant String_Access := Getenv (Ada_Project_Path);
65 -- The path name(s) of directories where project files may reside.
66 -- May be empty.
67
68 type Extension_Origin is (None, Extending_Simple, Extending_All);
69 -- Type of parameter From_Extended for procedures Parse_Single_Project and
70 -- Post_Parse_Context_Clause. Extending_All means that we are parsing the
71 -- tree rooted at an extending all project.
72
73 ------------------------------------
74 -- Local Packages and Subprograms --
75 ------------------------------------
76
77 type With_Id is new Nat;
78 No_With : constant With_Id := 0;
79
80 type With_Record is record
81 Path : Name_Id;
82 Location : Source_Ptr;
83 Limited_With : Boolean;
84 Next : With_Id;
85 end record;
86 -- Information about an imported project, to be put in table Withs below
87
88 package Withs is new Table.Table
89 (Table_Component_Type => With_Record,
90 Table_Index_Type => With_Id,
91 Table_Low_Bound => 1,
92 Table_Initial => 10,
93 Table_Increment => 50,
94 Table_Name => "Prj.Part.Withs");
95 -- Table used to store temporarily paths and locations of imported
96 -- projects. These imported projects will be effectively parsed after the
97 -- name of the current project has been extablished.
98
99 type Name_And_Id is record
100 Name : Name_Id;
101 Id : Project_Node_Id;
102 end record;
103
104 package Project_Stack is new Table.Table
105 (Table_Component_Type => Name_And_Id,
106 Table_Index_Type => Nat,
107 Table_Low_Bound => 1,
108 Table_Initial => 10,
109 Table_Increment => 50,
110 Table_Name => "Prj.Part.Project_Stack");
111 -- This table is used to detect circular dependencies
112 -- for imported and extended projects and to get the project ids of
113 -- limited imported projects when there is a circularity with at least
114 -- one limited imported project file.
115
116 package Virtual_Hash is new Simple_HTable
117 (Header_Num => Header_Num,
118 Element => Project_Node_Id,
119 No_Element => Empty_Node,
120 Key => Project_Node_Id,
121 Hash => Prj.Tree.Hash,
122 Equal => "=");
123 -- Hash table to store the node id of the project for which a virtual
124 -- extending project need to be created.
125
126 package Processed_Hash is new Simple_HTable
127 (Header_Num => Header_Num,
128 Element => Boolean,
129 No_Element => False,
130 Key => Project_Node_Id,
131 Hash => Prj.Tree.Hash,
132 Equal => "=");
133 -- Hash table to store the project process when looking for project that
134 -- need to have a virtual extending project, to avoid processing the same
135 -- project twice.
136
137 procedure Create_Virtual_Extending_Project
138 (For_Project : Project_Node_Id;
139 Main_Project : Project_Node_Id);
140 -- Create a virtual extending project of For_Project. Main_Project is
141 -- the extending all project.
142
143 procedure Look_For_Virtual_Projects_For
144 (Proj : Project_Node_Id;
145 Potentially_Virtual : Boolean);
146 -- Look for projects that need to have a virtual extending project.
147 -- This procedure is recursive. If called with Potentially_Virtual set to
148 -- True, then Proj may need an virtual extending project; otherwise it
149 -- does not (because it is already extended), but other projects that it
150 -- imports may need to be virtually extended.
151
152 procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id);
153 -- Parse the context clause of a project.
154 -- Store the paths and locations of the imported projects in table Withs.
155 -- Does nothing if there is no context clause (if the current
156 -- token is not "with" or "limited" followed by "with").
157
158 procedure Post_Parse_Context_Clause
159 (Context_Clause : With_Id;
160 Imported_Projects : out Project_Node_Id;
161 Project_Directory : Name_Id;
162 From_Extended : Extension_Origin);
163 -- Parse the imported projects that have been stored in table Withs,
164 -- if any. From_Extended is used for the call to Parse_Single_Project
165 -- below.
166
167 procedure Parse_Single_Project
168 (Project : out Project_Node_Id;
169 Path_Name : String;
170 Extended : Boolean;
171 From_Extended : Extension_Origin);
172 -- Parse a project file.
173 -- Recursive procedure: it calls itself for imported and extended
174 -- projects. When From_Extended is not None, if the project has already
175 -- been parsed and is an extended project A, return the ultimate
176 -- (not extended) project that extends A.
177
178 function Project_Path_Name_Of
179 (Project_File_Name : String;
180 Directory : String)
181 return String;
182 -- Returns the path name of a project file. Returns an empty string
183 -- if project file cannot be found.
184
185 function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id;
186 -- Get the directory of the file with the specified path name.
187 -- This includes the directory separator as the last character.
188 -- Returns "./" if Path_Name contains no directory separator.
189
190 function Project_Name_From (Path_Name : String) return Name_Id;
191 -- Returns the name of the project that corresponds to its path name.
192 -- Returns No_Name if the path name is invalid, because the corresponding
193 -- project name does not have the syntax of an ada identifier.
194
195 --------------------------------------
196 -- Create_Virtual_Extending_Project --
197 --------------------------------------
198
199 procedure Create_Virtual_Extending_Project
200 (For_Project : Project_Node_Id;
201 Main_Project : Project_Node_Id)
202 is
203
204 Virtual_Name : constant String :=
205 Virtual_Prefix &
206 Get_Name_String (Name_Of (For_Project));
207 -- The name of the virtual extending project
208
209 Virtual_Name_Id : Name_Id;
210 -- Virtual extending project name id
211
212 Virtual_Path_Id : Name_Id;
213 -- Fake path name of the virtual extending project. The directory is
214 -- the same directory as the extending all project.
215
216 Virtual_Dir_Id : constant Name_Id :=
217 Immediate_Directory_Of (Path_Name_Of (Main_Project));
218 -- The directory of the extending all project
219
220 -- The source of the virtual extending project is something like:
221
222 -- project V$<project name> extends <project path> is
223
224 -- for Source_Dirs use ();
225
226 -- end V$<project name>;
227
228 -- The project directory cannot be specified during parsing; it will be
229 -- put directly in the virtual extending project data during processing.
230
231 -- Nodes that made up the virtual extending project
232
233 Virtual_Project : constant Project_Node_Id :=
234 Default_Project_Node (N_Project);
235 With_Clause : constant Project_Node_Id :=
236 Default_Project_Node (N_With_Clause);
237 Project_Declaration : constant Project_Node_Id :=
238 Default_Project_Node (N_Project_Declaration);
239 Source_Dirs_Declaration : constant Project_Node_Id :=
240 Default_Project_Node (N_Declarative_Item);
241 Source_Dirs_Attribute : constant Project_Node_Id :=
242 Default_Project_Node
243 (N_Attribute_Declaration, List);
244 Source_Dirs_Expression : constant Project_Node_Id :=
245 Default_Project_Node (N_Expression, List);
246 Source_Dirs_Term : constant Project_Node_Id :=
247 Default_Project_Node (N_Term, List);
248 Source_Dirs_List : constant Project_Node_Id :=
249 Default_Project_Node
250 (N_Literal_String_List, List);
251
252 begin
253 -- Get the virtual name id
254
255 Name_Len := Virtual_Name'Length;
256 Name_Buffer (1 .. Name_Len) := Virtual_Name;
257 Virtual_Name_Id := Name_Find;
258
259 -- Get the virtual path name
260
261 Get_Name_String (Path_Name_Of (Main_Project));
262
263 while Name_Len > 0
264 and then Name_Buffer (Name_Len) /= Directory_Separator
265 and then Name_Buffer (Name_Len) /= '/'
266 loop
267 Name_Len := Name_Len - 1;
268 end loop;
269
270 Name_Buffer (Name_Len + 1 .. Name_Len + Virtual_Name'Length) :=
271 Virtual_Name;
272 Name_Len := Name_Len + Virtual_Name'Length;
273 Virtual_Path_Id := Name_Find;
274
275 -- With clause
276
277 Set_Name_Of (With_Clause, Virtual_Name_Id);
278 Set_Path_Name_Of (With_Clause, Virtual_Path_Id);
279 Set_Project_Node_Of (With_Clause, Virtual_Project);
280 Set_Next_With_Clause_Of
281 (With_Clause, First_With_Clause_Of (Main_Project));
282 Set_First_With_Clause_Of (Main_Project, With_Clause);
283
284 -- Virtual project node
285
286 Set_Name_Of (Virtual_Project, Virtual_Name_Id);
287 Set_Path_Name_Of (Virtual_Project, Virtual_Path_Id);
288 Set_Location_Of (Virtual_Project, Location_Of (Main_Project));
289 Set_Directory_Of (Virtual_Project, Virtual_Dir_Id);
290 Set_Project_Declaration_Of (Virtual_Project, Project_Declaration);
291 Set_Extended_Project_Path_Of
292 (Virtual_Project, Path_Name_Of (For_Project));
293
294 -- Project declaration
295
296 Set_First_Declarative_Item_Of
297 (Project_Declaration, Source_Dirs_Declaration);
298 Set_Extended_Project_Of (Project_Declaration, For_Project);
299
300 -- Source_Dirs declaration
301
302 Set_Current_Item_Node (Source_Dirs_Declaration, Source_Dirs_Attribute);
303
304 -- Source_Dirs attribute
305
306 Set_Name_Of (Source_Dirs_Attribute, Snames.Name_Source_Dirs);
307 Set_Expression_Of (Source_Dirs_Attribute, Source_Dirs_Expression);
308
309 -- Source_Dirs expression
310
311 Set_First_Term (Source_Dirs_Expression, Source_Dirs_Term);
312
313 -- Source_Dirs term
314
315 Set_Current_Term (Source_Dirs_Term, Source_Dirs_List);
316
317 -- Source_Dirs empty list: nothing to do
318
319 end Create_Virtual_Extending_Project;
320
321 ----------------------------
322 -- Immediate_Directory_Of --
323 ----------------------------
324
325 function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id is
326 begin
327 Get_Name_String (Path_Name);
328
329 for Index in reverse 1 .. Name_Len loop
330 if Name_Buffer (Index) = '/'
331 or else Name_Buffer (Index) = Dir_Sep
332 then
333 -- Remove all chars after last directory separator from name
334
335 if Index > 1 then
336 Name_Len := Index - 1;
337
338 else
339 Name_Len := Index;
340 end if;
341
342 return Name_Find;
343 end if;
344 end loop;
345
346 -- There is no directory separator in name. Return "./" or ".\"
347
348 Name_Len := 2;
349 Name_Buffer (1) := '.';
350 Name_Buffer (2) := Dir_Sep;
351 return Name_Find;
352 end Immediate_Directory_Of;
353
354 -----------------------------------
355 -- Look_For_Virtual_Projects_For --
356 -----------------------------------
357
358 procedure Look_For_Virtual_Projects_For
359 (Proj : Project_Node_Id;
360 Potentially_Virtual : Boolean)
361
362 is
363 Declaration : Project_Node_Id := Empty_Node;
364 -- Node for the project declaration of Proj
365
366 With_Clause : Project_Node_Id := Empty_Node;
367 -- Node for a with clause of Proj
368
369 Imported : Project_Node_Id := Empty_Node;
370 -- Node for a project imported by Proj
371
372 Extended : Project_Node_Id := Empty_Node;
373 -- Node for the eventual project extended by Proj
374
375 begin
376 -- Nothing to do if Proj is not defined or if it has already been
377 -- processed.
378
379 if Proj /= Empty_Node and then not Processed_Hash.Get (Proj) then
380 -- Make sure the project will not be processed again
381
382 Processed_Hash.Set (Proj, True);
383
384 Declaration := Project_Declaration_Of (Proj);
385
386 if Declaration /= Empty_Node then
387 Extended := Extended_Project_Of (Declaration);
388 end if;
389
390 -- If this is a project that may need a virtual extending project
391 -- and it is not itself an extending project, put it in the list.
392
393 if Potentially_Virtual and then Extended = Empty_Node then
394 Virtual_Hash.Set (Proj, Proj);
395 end if;
396
397 -- Now check the projects it imports
398
399 With_Clause := First_With_Clause_Of (Proj);
400
401 while With_Clause /= Empty_Node loop
402 Imported := Project_Node_Of (With_Clause);
403
404 if Imported /= Empty_Node then
405 Look_For_Virtual_Projects_For
406 (Imported, Potentially_Virtual => True);
407 end if;
408
409 With_Clause := Next_With_Clause_Of (With_Clause);
410 end loop;
411
412 -- Check also the eventual project extended by Proj. As this project
413 -- is already extended, call recursively with Potentially_Virtual
414 -- being False.
415
416 Look_For_Virtual_Projects_For
417 (Extended, Potentially_Virtual => False);
418 end if;
419 end Look_For_Virtual_Projects_For;
420
421 -----------
422 -- Parse --
423 -----------
424
425 procedure Parse
426 (Project : out Project_Node_Id;
427 Project_File_Name : String;
428 Always_Errout_Finalize : Boolean;
429 Packages_To_Check : String_List_Access := All_Packages)
430 is
431 Current_Directory : constant String := Get_Current_Dir;
432
433 begin
434 -- Save the Packages_To_Check in Prj, so that it is visible from
435 -- Prj.Dect.
436
437 Current_Packages_To_Check := Packages_To_Check;
438
439 Project := Empty_Node;
440
441 if Current_Verbosity >= Medium then
442 Write_Str ("ADA_PROJECT_PATH=""");
443 Write_Str (Project_Path.all);
444 Write_Line ("""");
445 end if;
446
447 declare
448 Path_Name : constant String :=
449 Project_Path_Name_Of (Project_File_Name,
450 Directory => Current_Directory);
451
452 begin
453 Prj.Err.Initialize;
454
455 -- Parse the main project file
456
457 if Path_Name = "" then
458 Prj.Com.Fail
459 ("project file """, Project_File_Name, """ not found");
460 Project := Empty_Node;
461 return;
462 end if;
463
464 Parse_Single_Project
465 (Project => Project,
466 Path_Name => Path_Name,
467 Extended => False,
468 From_Extended => None);
469
470 -- If Project is an extending-all project, create the eventual
471 -- virtual extending projects and check that there are no illegally
472 -- imported projects.
473
474 if Project /= Empty_Node and then Is_Extending_All (Project) then
475 -- First look for projects that potentially need a virtual
476 -- extending project.
477
478 Virtual_Hash.Reset;
479 Processed_Hash.Reset;
480
481 -- Mark the extending all project as processed, to avoid checking
482 -- the imported projects in case of a "limited with" on this
483 -- extending all project.
484
485 Processed_Hash.Set (Project, True);
486
487 declare
488 Declaration : constant Project_Node_Id :=
489 Project_Declaration_Of (Project);
490 begin
491 Look_For_Virtual_Projects_For
492 (Extended_Project_Of (Declaration),
493 Potentially_Virtual => False);
494 end;
495
496 -- Now, check the projects directly imported by the main project.
497 -- Remove from the potentially virtual any project extended by one
498 -- of these imported projects. For non extending imported
499 -- projects, check that they do not belong to the project tree of
500 -- the project being "extended-all" by the main project.
501
502 declare
503 With_Clause : Project_Node_Id :=
504 First_With_Clause_Of (Project);
505 Imported : Project_Node_Id := Empty_Node;
506 Declaration : Project_Node_Id := Empty_Node;
507
508 begin
509 while With_Clause /= Empty_Node loop
510 Imported := Project_Node_Of (With_Clause);
511
512 if Imported /= Empty_Node then
513 Declaration := Project_Declaration_Of (Imported);
514
515 if Extended_Project_Of (Declaration) /= Empty_Node then
516 loop
517 Imported := Extended_Project_Of (Declaration);
518 exit when Imported = Empty_Node;
519 Virtual_Hash.Remove (Imported);
520 Declaration := Project_Declaration_Of (Imported);
521 end loop;
522
523 elsif Virtual_Hash.Get (Imported) /= Empty_Node then
524 Error_Msg
525 ("this project cannot be imported directly",
526 Location_Of (With_Clause));
527 end if;
528
529 end if;
530
531 With_Clause := Next_With_Clause_Of (With_Clause);
532 end loop;
533 end;
534
535 -- Now create all the virtual extending projects
536
537 declare
538 Proj : Project_Node_Id := Virtual_Hash.Get_First;
539 begin
540 while Proj /= Empty_Node loop
541 Create_Virtual_Extending_Project (Proj, Project);
542 Proj := Virtual_Hash.Get_Next;
543 end loop;
544 end;
545 end if;
546
547 -- If there were any kind of error during the parsing, serious
548 -- or not, then the parsing fails.
549
550 if Err_Vars.Total_Errors_Detected > 0 then
551 Project := Empty_Node;
552 end if;
553
554 if Project = Empty_Node or else Always_Errout_Finalize then
555 Prj.Err.Finalize;
556 end if;
557 end;
558
559 exception
560 when X : others =>
561
562 -- Internal error
563
564 Write_Line (Exception_Information (X));
565 Write_Str ("Exception ");
566 Write_Str (Exception_Name (X));
567 Write_Line (" raised, while processing project file");
568 Project := Empty_Node;
569 end Parse;
570
571 ------------------------------
572 -- Pre_Parse_Context_Clause --
573 ------------------------------
574
575 procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id) is
576 Current_With_Clause : With_Id := No_With;
577 Limited_With : Boolean := False;
578
579 Current_With : With_Record;
580
581 begin
582 -- Assume no context clause
583
584 Context_Clause := No_With;
585 With_Loop :
586
587 -- If Token is not WITH or LIMITED, there is no context clause,
588 -- or we have exhausted the with clauses.
589
590 while Token = Tok_With or else Token = Tok_Limited loop
591 Limited_With := Token = Tok_Limited;
592
593 if Limited_With then
594 Scan; -- scan past LIMITED
595 Expect (Tok_With, "WITH");
596 exit With_Loop when Token /= Tok_With;
597 end if;
598
599 Comma_Loop :
600 loop
601 Scan; -- scan past WITH or ","
602
603 Expect (Tok_String_Literal, "literal string");
604
605 if Token /= Tok_String_Literal then
606 return;
607 end if;
608
609 -- Store path and location in table Withs
610
611 Current_With :=
612 (Path => Token_Name,
613 Location => Token_Ptr,
614 Limited_With => Limited_With,
615 Next => No_With);
616
617 Withs.Increment_Last;
618 Withs.Table (Withs.Last) := Current_With;
619
620 if Current_With_Clause = No_With then
621 Context_Clause := Withs.Last;
622
623 else
624 Withs.Table (Current_With_Clause).Next := Withs.Last;
625 end if;
626
627 Current_With_Clause := Withs.Last;
628
629 Scan;
630
631 if Token = Tok_Semicolon then
632
633 -- End of (possibly multiple) with clause;
634
635 Scan; -- scan past the semicolon.
636 exit Comma_Loop;
637
638 elsif Token /= Tok_Comma then
639 Error_Msg ("expected comma or semi colon", Token_Ptr);
640 exit Comma_Loop;
641 end if;
642 end loop Comma_Loop;
643 end loop With_Loop;
644 end Pre_Parse_Context_Clause;
645
646
647 -------------------------------
648 -- Post_Parse_Context_Clause --
649 -------------------------------
650
651 procedure Post_Parse_Context_Clause
652 (Context_Clause : With_Id;
653 Imported_Projects : out Project_Node_Id;
654 Project_Directory : Name_Id;
655 From_Extended : Extension_Origin)
656 is
657 Current_With_Clause : With_Id := Context_Clause;
658
659 Current_Project : Project_Node_Id := Empty_Node;
660 Previous_Project : Project_Node_Id := Empty_Node;
661 Next_Project : Project_Node_Id := Empty_Node;
662
663 Project_Directory_Path : constant String :=
664 Get_Name_String (Project_Directory);
665
666 Current_With : With_Record;
667 Limited_With : Boolean := False;
668
669 begin
670 Imported_Projects := Empty_Node;
671
672 while Current_With_Clause /= No_With loop
673 Current_With := Withs.Table (Current_With_Clause);
674 Current_With_Clause := Current_With.Next;
675
676 Limited_With := Current_With.Limited_With;
677
678 declare
679 Original_Path : constant String :=
680 Get_Name_String (Current_With.Path);
681
682 Imported_Path_Name : constant String :=
683 Project_Path_Name_Of
684 (Original_Path,
685 Project_Directory_Path);
686
687 Withed_Project : Project_Node_Id := Empty_Node;
688
689 begin
690 if Imported_Path_Name = "" then
691
692 -- The project file cannot be found
693
694 Error_Msg_Name_1 := Current_With.Path;
695
696 Error_Msg ("unknown project file: {", Current_With.Location);
697
698 -- If this is not imported by the main project file,
699 -- display the import path.
700
701 if Project_Stack.Last > 1 then
702 for Index in reverse 1 .. Project_Stack.Last loop
703 Error_Msg_Name_1 := Project_Stack.Table (Index).Name;
704 Error_Msg ("\imported by {", Current_With.Location);
705 end loop;
706 end if;
707
708 else
709 -- New with clause
710
711 Previous_Project := Current_Project;
712
713 if Current_Project = Empty_Node then
714
715 -- First with clause of the context clause
716
717 Current_Project := Default_Project_Node
718 (Of_Kind => N_With_Clause);
719 Imported_Projects := Current_Project;
720
721 else
722 Next_Project := Default_Project_Node
723 (Of_Kind => N_With_Clause);
724 Set_Next_With_Clause_Of (Current_Project, Next_Project);
725 Current_Project := Next_Project;
726 end if;
727
728 Set_String_Value_Of
729 (Current_Project, Current_With.Path);
730 Set_Location_Of (Current_Project, Current_With.Location);
731
732 -- If this is a "limited with", check if we have
733 -- a circularity; if we have one, get the project id
734 -- of the limited imported project file, and don't
735 -- parse it.
736
737 if Limited_With and then Project_Stack.Last > 1 then
738 declare
739 Normed : constant String :=
740 Normalize_Pathname (Imported_Path_Name);
741 Canonical_Path_Name : Name_Id;
742
743 begin
744 Name_Len := Normed'Length;
745 Name_Buffer (1 .. Name_Len) := Normed;
746 Canonical_Path_Name := Name_Find;
747
748 for Index in 1 .. Project_Stack.Last loop
749 if Project_Stack.Table (Index).Name =
750 Canonical_Path_Name
751 then
752 -- We have found the limited imported project,
753 -- get its project id, and don't parse it.
754
755 Withed_Project := Project_Stack.Table (Index).Id;
756 exit;
757 end if;
758 end loop;
759 end;
760 end if;
761
762 -- Parse the imported project, if its project id is unknown
763
764 if Withed_Project = Empty_Node then
765 Parse_Single_Project
766 (Project => Withed_Project,
767 Path_Name => Imported_Path_Name,
768 Extended => False,
769 From_Extended => From_Extended);
770 end if;
771
772 if Withed_Project = Empty_Node then
773 -- If parsing was not successful, remove the
774 -- context clause.
775
776 Current_Project := Previous_Project;
777
778 if Current_Project = Empty_Node then
779 Imported_Projects := Empty_Node;
780
781 else
782 Set_Next_With_Clause_Of
783 (Current_Project, Empty_Node);
784 end if;
785 else
786 -- If parsing was successful, record project name
787 -- and path name in with clause
788
789 Set_Project_Node_Of
790 (Node => Current_Project,
791 To => Withed_Project,
792 Limited_With => Limited_With);
793 Set_Name_Of (Current_Project, Name_Of (Withed_Project));
794 Name_Len := Imported_Path_Name'Length;
795 Name_Buffer (1 .. Name_Len) := Imported_Path_Name;
796 Set_Path_Name_Of (Current_Project, Name_Find);
797 end if;
798 end if;
799 end;
800 end loop;
801 end Post_Parse_Context_Clause;
802
803 --------------------------
804 -- Parse_Single_Project --
805 --------------------------
806
807 procedure Parse_Single_Project
808 (Project : out Project_Node_Id;
809 Path_Name : String;
810 Extended : Boolean;
811 From_Extended : Extension_Origin)
812 is
813 Normed_Path_Name : Name_Id;
814 Canonical_Path_Name : Name_Id;
815 Project_Directory : Name_Id;
816 Project_Scan_State : Saved_Project_Scan_State;
817 Source_Index : Source_File_Index;
818
819 Extended_Project : Project_Node_Id := Empty_Node;
820
821 A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
822 Tree_Private_Part.Projects_Htable.Get_First;
823
824 Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
825
826 Name_Of_Project : Name_Id := No_Name;
827
828 First_With : With_Id;
829
830 use Tree_Private_Part;
831
832 begin
833 declare
834 Normed : String := Normalize_Pathname (Path_Name);
835 begin
836 Name_Len := Normed'Length;
837 Name_Buffer (1 .. Name_Len) := Normed;
838 Normed_Path_Name := Name_Find;
839 Canonical_Case_File_Name (Normed);
840 Name_Len := Normed'Length;
841 Name_Buffer (1 .. Name_Len) := Normed;
842 Canonical_Path_Name := Name_Find;
843 end;
844
845 -- Check for a circular dependency
846
847 for Index in 1 .. Project_Stack.Last loop
848 if Canonical_Path_Name = Project_Stack.Table (Index).Name then
849 Error_Msg ("circular dependency detected", Token_Ptr);
850 Error_Msg_Name_1 := Normed_Path_Name;
851 Error_Msg ("\ { is imported by", Token_Ptr);
852
853 for Current in reverse 1 .. Project_Stack.Last loop
854 Error_Msg_Name_1 := Project_Stack.Table (Current).Name;
855
856 if Error_Msg_Name_1 /= Canonical_Path_Name then
857 Error_Msg
858 ("\ { which itself is imported by", Token_Ptr);
859
860 else
861 Error_Msg ("\ {", Token_Ptr);
862 exit;
863 end if;
864 end loop;
865
866 Project := Empty_Node;
867 return;
868 end if;
869 end loop;
870
871 Project_Stack.Increment_Last;
872 Project_Stack.Table (Project_Stack.Last).Name := Canonical_Path_Name;
873
874 -- Check if the project file has already been parsed.
875
876 while
877 A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
878 loop
879 if
880 Path_Name_Of (A_Project_Name_And_Node.Node) = Canonical_Path_Name
881 then
882 if Extended then
883
884 if A_Project_Name_And_Node.Extended then
885 Error_Msg
886 ("cannot extend the same project file several times",
887 Token_Ptr);
888
889 else
890 Error_Msg
891 ("cannot extend an already imported project file",
892 Token_Ptr);
893 end if;
894
895 elsif A_Project_Name_And_Node.Extended then
896 -- If the imported project is an extended project A, and we are
897 -- in an extended project, replace A with the ultimate project
898 -- extending A.
899
900 if From_Extended /= None then
901 declare
902 Decl : Project_Node_Id :=
903 Project_Declaration_Of
904 (A_Project_Name_And_Node.Node);
905 Prj : Project_Node_Id :=
906 Extending_Project_Of (Decl);
907 begin
908 loop
909 Decl := Project_Declaration_Of (Prj);
910 exit when Extending_Project_Of (Decl) = Empty_Node;
911 Prj := Extending_Project_Of (Decl);
912 end loop;
913
914 A_Project_Name_And_Node.Node := Prj;
915 end;
916 else
917 Error_Msg
918 ("cannot import an already extended project file",
919 Token_Ptr);
920 end if;
921 end if;
922
923 Project := A_Project_Name_And_Node.Node;
924 Project_Stack.Decrement_Last;
925 return;
926 end if;
927
928 A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next;
929 end loop;
930
931 -- We never encountered this project file
932 -- Save the scan state, load the project file and start to scan it.
933
934 Save_Project_Scan_State (Project_Scan_State);
935 Source_Index := Load_Project_File (Path_Name);
936
937 -- if we cannot find it, we stop
938
939 if Source_Index = No_Source_File then
940 Project := Empty_Node;
941 Project_Stack.Decrement_Last;
942 return;
943 end if;
944
945 Prj.Err.Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
946 Scan;
947
948 if Name_From_Path = No_Name then
949
950 -- The project file name is not correct (no or bad extension,
951 -- or not following Ada identifier's syntax).
952
953 Error_Msg_Name_1 := Canonical_Path_Name;
954 Error_Msg ("?{ is not a valid path name for a project file",
955 Token_Ptr);
956 end if;
957
958 if Current_Verbosity >= Medium then
959 Write_Str ("Parsing """);
960 Write_Str (Path_Name);
961 Write_Char ('"');
962 Write_Eol;
963 end if;
964
965 Project_Directory := Immediate_Directory_Of (Normed_Path_Name);
966 Project := Default_Project_Node (Of_Kind => N_Project);
967 Project_Stack.Table (Project_Stack.Last).Id := Project;
968 Set_Directory_Of (Project, Project_Directory);
969 Set_Path_Name_Of (Project, Normed_Path_Name);
970 Set_Location_Of (Project, Token_Ptr);
971
972 -- Is there any imported project?
973
974 Pre_Parse_Context_Clause (First_With);
975
976 Expect (Tok_Project, "PROJECT");
977
978 -- Mark location of PROJECT token if present
979
980 if Token = Tok_Project then
981 Set_Location_Of (Project, Token_Ptr);
982 Scan; -- scan past project
983 end if;
984
985 -- Clear the Buffer
986
987 Buffer_Last := 0;
988
989 loop
990 Expect (Tok_Identifier, "identifier");
991
992 -- If the token is not an identifier, clear the buffer before
993 -- exiting to indicate that the name of the project is ill-formed.
994
995 if Token /= Tok_Identifier then
996 Buffer_Last := 0;
997 exit;
998 end if;
999
1000 -- Add the identifier name to the buffer
1001
1002 Get_Name_String (Token_Name);
1003 Add_To_Buffer (Name_Buffer (1 .. Name_Len));
1004
1005 -- Scan past the identifier
1006
1007 Scan;
1008
1009 -- If we have a dot, add a dot the the Buffer and look for the next
1010 -- identifier.
1011
1012 exit when Token /= Tok_Dot;
1013 Add_To_Buffer (".");
1014
1015 -- Scan past the dot
1016
1017 Scan;
1018 end loop;
1019
1020 -- If the name is well formed, Buffer_Last is > 0
1021
1022 if Buffer_Last > 0 then
1023
1024 -- The Buffer contains the name of the project
1025
1026 Name_Len := Buffer_Last;
1027 Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
1028 Name_Of_Project := Name_Find;
1029 Set_Name_Of (Project, Name_Of_Project);
1030
1031 -- To get expected name of the project file, replace dots by dashes
1032
1033 Name_Len := Buffer_Last;
1034 Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
1035
1036 for Index in 1 .. Name_Len loop
1037 if Name_Buffer (Index) = '.' then
1038 Name_Buffer (Index) := '-';
1039 end if;
1040 end loop;
1041
1042 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
1043
1044 declare
1045 Expected_Name : constant Name_Id := Name_Find;
1046
1047 begin
1048 -- Output a warning if the actual name is not the expected name
1049
1050 if Name_From_Path /= No_Name
1051 and then Expected_Name /= Name_From_Path
1052 then
1053 Error_Msg_Name_1 := Expected_Name;
1054 Error_Msg ("?file name does not match unit name, " &
1055 "should be `{" & Project_File_Extension & "`",
1056 Token_Ptr);
1057 end if;
1058 end;
1059
1060 declare
1061 Imported_Projects : Project_Node_Id := Empty_Node;
1062 From_Ext : Extension_Origin := None;
1063
1064 begin
1065 -- Extending_All is always propagated
1066
1067 if From_Extended = Extending_All then
1068 From_Ext := Extending_All;
1069
1070 -- Otherwise, From_Extended is set to Extending_Single if the
1071 -- current project is an extending project.
1072
1073 elsif Extended then
1074 From_Ext := Extending_Simple;
1075 end if;
1076
1077 Post_Parse_Context_Clause
1078 (Context_Clause => First_With,
1079 Imported_Projects => Imported_Projects,
1080 Project_Directory => Project_Directory,
1081 From_Extended => From_Ext);
1082 Set_First_With_Clause_Of (Project, Imported_Projects);
1083 end;
1084
1085 declare
1086 Project_Name : Name_Id :=
1087 Tree_Private_Part.Projects_Htable.Get_First.Name;
1088
1089 begin
1090 -- Check if we already have a project with this name
1091
1092 while Project_Name /= No_Name
1093 and then Project_Name /= Name_Of_Project
1094 loop
1095 Project_Name := Tree_Private_Part.Projects_Htable.Get_Next.Name;
1096 end loop;
1097
1098 -- Report an error if we already have a project with this name
1099
1100 if Project_Name /= No_Name then
1101 Error_Msg ("duplicate project name", Token_Ptr);
1102
1103 else
1104 -- Otherwise, add the name of the project to the hash table, so
1105 -- that we can check that no other subsequent project will have
1106 -- the same name.
1107
1108 Tree_Private_Part.Projects_Htable.Set
1109 (K => Name_Of_Project,
1110 E => (Name => Name_Of_Project,
1111 Node => Project,
1112 Extended => Extended));
1113 end if;
1114 end;
1115
1116 end if;
1117
1118 if Token = Tok_Extends then
1119
1120 -- Make sure that gnatmake will use mapping files
1121
1122 Opt.Create_Mapping_File := True;
1123
1124 -- We are extending another project
1125
1126 Scan; -- scan past EXTENDS
1127
1128 if Token = Tok_All then
1129 Set_Is_Extending_All (Project);
1130 Scan; -- scan past ALL
1131 end if;
1132
1133 Expect (Tok_String_Literal, "literal string");
1134
1135 if Token = Tok_String_Literal then
1136 Set_Extended_Project_Path_Of (Project, Token_Name);
1137
1138 declare
1139 Original_Path_Name : constant String :=
1140 Get_Name_String (Token_Name);
1141
1142 Extended_Project_Path_Name : constant String :=
1143 Project_Path_Name_Of
1144 (Original_Path_Name,
1145 Get_Name_String
1146 (Project_Directory));
1147
1148 begin
1149 if Extended_Project_Path_Name = "" then
1150
1151 -- We could not find the project file to extend
1152
1153 Error_Msg_Name_1 := Token_Name;
1154
1155 Error_Msg ("unknown project file: {", Token_Ptr);
1156
1157 -- If we are not in the main project file, display the
1158 -- import path.
1159
1160 if Project_Stack.Last > 1 then
1161 Error_Msg_Name_1 :=
1162 Project_Stack.Table (Project_Stack.Last).Name;
1163 Error_Msg ("\extended by {", Token_Ptr);
1164
1165 for Index in reverse 1 .. Project_Stack.Last - 1 loop
1166 Error_Msg_Name_1 := Project_Stack.Table (Index).Name;
1167 Error_Msg ("\imported by {", Token_Ptr);
1168 end loop;
1169 end if;
1170
1171 else
1172 declare
1173 From_Extended : Extension_Origin := None;
1174
1175 begin
1176 if Is_Extending_All (Project) then
1177 From_Extended := Extending_All;
1178 end if;
1179
1180 Parse_Single_Project
1181 (Project => Extended_Project,
1182 Path_Name => Extended_Project_Path_Name,
1183 Extended => True,
1184 From_Extended => From_Extended);
1185 end;
1186
1187 -- A project that extends an extending-all project is also
1188 -- an extending-all project.
1189
1190 if Is_Extending_All (Extended_Project) then
1191 Set_Is_Extending_All (Project);
1192 end if;
1193 end if;
1194 end;
1195
1196 Scan; -- scan past the extended project path
1197 end if;
1198 end if;
1199
1200 -- Check that a non extending-all project does not import an
1201 -- extending-all project.
1202
1203 if not Is_Extending_All (Project) then
1204 declare
1205 With_Clause : Project_Node_Id := First_With_Clause_Of (Project);
1206 Imported : Project_Node_Id := Empty_Node;
1207
1208 begin
1209 With_Clause_Loop :
1210 while With_Clause /= Empty_Node loop
1211 Imported := Project_Node_Of (With_Clause);
1212 With_Clause := Next_With_Clause_Of (With_Clause);
1213
1214 if Is_Extending_All (Imported) then
1215 Error_Msg_Name_1 := Name_Of (Imported);
1216 Error_Msg ("cannot import extending-all project {",
1217 Token_Ptr);
1218 exit With_Clause_Loop;
1219 end if;
1220 end loop With_Clause_Loop;
1221 end;
1222 end if;
1223
1224 -- Check that a project with a name including a dot either imports
1225 -- or extends the project whose name precedes the last dot.
1226
1227 if Name_Of_Project /= No_Name then
1228 Get_Name_String (Name_Of_Project);
1229
1230 else
1231 Name_Len := 0;
1232 end if;
1233
1234 -- Look for the last dot
1235
1236 while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop
1237 Name_Len := Name_Len - 1;
1238 end loop;
1239
1240 -- If a dot was find, check if the parent project is imported
1241 -- or extended.
1242
1243 if Name_Len > 0 then
1244 Name_Len := Name_Len - 1;
1245
1246 declare
1247 Parent_Name : constant Name_Id := Name_Find;
1248 Parent_Found : Boolean := False;
1249 With_Clause : Project_Node_Id := First_With_Clause_Of (Project);
1250
1251 begin
1252 -- If there is an extended project, check its name
1253
1254 if Extended_Project /= Empty_Node then
1255 Parent_Found := Name_Of (Extended_Project) = Parent_Name;
1256 end if;
1257
1258 -- If the parent project is not the extended project,
1259 -- check each imported project until we find the parent project.
1260
1261 while not Parent_Found and then With_Clause /= Empty_Node loop
1262 Parent_Found := Name_Of (Project_Node_Of (With_Clause))
1263 = Parent_Name;
1264 With_Clause := Next_With_Clause_Of (With_Clause);
1265 end loop;
1266
1267 -- If the parent project was not found, report an error
1268
1269 if not Parent_Found then
1270 Error_Msg_Name_1 := Name_Of_Project;
1271 Error_Msg_Name_2 := Parent_Name;
1272 Error_Msg ("project { does not import or extend project {",
1273 Location_Of (Project));
1274 end if;
1275 end;
1276 end if;
1277
1278 Expect (Tok_Is, "IS");
1279
1280 declare
1281 Project_Declaration : Project_Node_Id := Empty_Node;
1282
1283 begin
1284 -- No need to Scan past "is", Prj.Dect.Parse will do it.
1285
1286 Prj.Dect.Parse
1287 (Declarations => Project_Declaration,
1288 Current_Project => Project,
1289 Extends => Extended_Project);
1290 Set_Project_Declaration_Of (Project, Project_Declaration);
1291
1292 if Extended_Project /= Empty_Node then
1293 Set_Extending_Project_Of
1294 (Project_Declaration_Of (Extended_Project), To => Project);
1295 end if;
1296 end;
1297
1298 Expect (Tok_End, "END");
1299
1300 -- Skip "end" if present
1301
1302 if Token = Tok_End then
1303 Scan;
1304 end if;
1305
1306 -- Clear the Buffer
1307
1308 Buffer_Last := 0;
1309
1310 -- Store the name following "end" in the Buffer. The name may be made of
1311 -- several simple names.
1312
1313 loop
1314 Expect (Tok_Identifier, "identifier");
1315
1316 -- If we don't have an identifier, clear the buffer before exiting to
1317 -- avoid checking the name.
1318
1319 if Token /= Tok_Identifier then
1320 Buffer_Last := 0;
1321 exit;
1322 end if;
1323
1324 -- Add the identifier to the Buffer
1325 Get_Name_String (Token_Name);
1326 Add_To_Buffer (Name_Buffer (1 .. Name_Len));
1327
1328 -- Scan past the identifier
1329
1330 Scan;
1331 exit when Token /= Tok_Dot;
1332 Add_To_Buffer (".");
1333 Scan;
1334 end loop;
1335
1336 -- If we have a valid name, check if it is the name of the project
1337
1338 if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
1339 if To_Lower (Buffer (1 .. Buffer_Last)) /=
1340 Get_Name_String (Name_Of (Project))
1341 then
1342 -- Invalid name: report an error
1343
1344 Error_Msg ("Expected """ &
1345 Get_Name_String (Name_Of (Project)) & """",
1346 Token_Ptr);
1347 end if;
1348 end if;
1349
1350 Expect (Tok_Semicolon, "`;`");
1351
1352 -- Check that there is no more text following the end of the project
1353 -- source.
1354
1355 if Token = Tok_Semicolon then
1356 Scan;
1357
1358 if Token /= Tok_EOF then
1359 Error_Msg
1360 ("Unexpected text following end of project", Token_Ptr);
1361 end if;
1362 end if;
1363
1364 -- Restore the scan state, in case we are not the main project
1365
1366 Restore_Project_Scan_State (Project_Scan_State);
1367
1368 -- And remove the project from the project stack
1369
1370 Project_Stack.Decrement_Last;
1371 end Parse_Single_Project;
1372
1373 -----------------------
1374 -- Project_Name_From --
1375 -----------------------
1376
1377 function Project_Name_From (Path_Name : String) return Name_Id is
1378 Canonical : String (1 .. Path_Name'Length) := Path_Name;
1379 First : Natural := Canonical'Last;
1380 Last : Natural := First;
1381 Index : Positive;
1382
1383 begin
1384 if Current_Verbosity = High then
1385 Write_Str ("Project_Name_From (""");
1386 Write_Str (Canonical);
1387 Write_Line (""")");
1388 end if;
1389
1390 -- If the path name is empty, return No_Name to indicate failure
1391
1392 if First = 0 then
1393 return No_Name;
1394 end if;
1395
1396 Canonical_Case_File_Name (Canonical);
1397
1398 -- Look for the last dot in the path name
1399
1400 while First > 0
1401 and then
1402 Canonical (First) /= '.'
1403 loop
1404 First := First - 1;
1405 end loop;
1406
1407 -- If we have a dot, check that it is followed by the correct extension
1408
1409 if First > 0 and then Canonical (First) = '.' then
1410 if Canonical (First .. Last) = Project_File_Extension
1411 and then First /= 1
1412 then
1413 -- Look for the last directory separator, if any
1414
1415 First := First - 1;
1416 Last := First;
1417
1418 while First > 0
1419 and then Canonical (First) /= '/'
1420 and then Canonical (First) /= Dir_Sep
1421 loop
1422 First := First - 1;
1423 end loop;
1424
1425 else
1426 -- Not the correct extension, return No_Name to indicate failure
1427
1428 return No_Name;
1429 end if;
1430
1431 -- If no dot in the path name, return No_Name to indicate failure
1432
1433 else
1434 return No_Name;
1435 end if;
1436
1437 First := First + 1;
1438
1439 -- If the extension is the file name, return No_Name to indicate failure
1440
1441 if First > Last then
1442 return No_Name;
1443 end if;
1444
1445 -- Put the name in lower case into Name_Buffer
1446
1447 Name_Len := Last - First + 1;
1448 Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
1449
1450 Index := 1;
1451
1452 -- Check if it is a well formed project name. Return No_Name if it is
1453 -- ill formed.
1454
1455 loop
1456 if not Is_Letter (Name_Buffer (Index)) then
1457 return No_Name;
1458
1459 else
1460 loop
1461 Index := Index + 1;
1462
1463 exit when Index >= Name_Len;
1464
1465 if Name_Buffer (Index) = '_' then
1466 if Name_Buffer (Index + 1) = '_' then
1467 return No_Name;
1468 end if;
1469 end if;
1470
1471 exit when Name_Buffer (Index) = '-';
1472
1473 if Name_Buffer (Index) /= '_'
1474 and then not Is_Alphanumeric (Name_Buffer (Index))
1475 then
1476 return No_Name;
1477 end if;
1478
1479 end loop;
1480 end if;
1481
1482 if Index >= Name_Len then
1483 if Is_Alphanumeric (Name_Buffer (Name_Len)) then
1484
1485 -- All checks have succeeded. Return name in Name_Buffer
1486
1487 return Name_Find;
1488
1489 else
1490 return No_Name;
1491 end if;
1492
1493 elsif Name_Buffer (Index) = '-' then
1494 Index := Index + 1;
1495 end if;
1496 end loop;
1497 end Project_Name_From;
1498
1499 --------------------------
1500 -- Project_Path_Name_Of --
1501 --------------------------
1502
1503 function Project_Path_Name_Of
1504 (Project_File_Name : String;
1505 Directory : String)
1506 return String
1507 is
1508 Result : String_Access;
1509
1510 begin
1511 if Current_Verbosity = High then
1512 Write_Str ("Project_Path_Name_Of (""");
1513 Write_Str (Project_File_Name);
1514 Write_Str (""", """);
1515 Write_Str (Directory);
1516 Write_Line (""");");
1517 end if;
1518
1519 if not Is_Absolute_Path (Project_File_Name) then
1520 -- First we try <directory>/<file_name>.<extension>
1521
1522 if Current_Verbosity = High then
1523 Write_Str (" Trying ");
1524 Write_Str (Directory);
1525 Write_Char (Directory_Separator);
1526 Write_Str (Project_File_Name);
1527 Write_Line (Project_File_Extension);
1528 end if;
1529
1530 Result :=
1531 Locate_Regular_File
1532 (File_Name => Directory & Directory_Separator &
1533 Project_File_Name & Project_File_Extension,
1534 Path => Project_Path.all);
1535
1536 -- Then we try <directory>/<file_name>
1537
1538 if Result = null then
1539 if Current_Verbosity = High then
1540 Write_Str (" Trying ");
1541 Write_Str (Directory);
1542 Write_Char (Directory_Separator);
1543 Write_Line (Project_File_Name);
1544 end if;
1545
1546 Result :=
1547 Locate_Regular_File
1548 (File_Name => Directory & Directory_Separator &
1549 Project_File_Name,
1550 Path => Project_Path.all);
1551 end if;
1552 end if;
1553
1554 if Result = null then
1555
1556 -- Then we try <file_name>.<extension>
1557
1558 if Current_Verbosity = High then
1559 Write_Str (" Trying ");
1560 Write_Str (Project_File_Name);
1561 Write_Line (Project_File_Extension);
1562 end if;
1563
1564 Result :=
1565 Locate_Regular_File
1566 (File_Name => Project_File_Name & Project_File_Extension,
1567 Path => Project_Path.all);
1568 end if;
1569
1570 if Result = null then
1571
1572 -- Then we try <file_name>
1573
1574 if Current_Verbosity = High then
1575 Write_Str (" Trying ");
1576 Write_Line (Project_File_Name);
1577 end if;
1578
1579 Result :=
1580 Locate_Regular_File
1581 (File_Name => Project_File_Name,
1582 Path => Project_Path.all);
1583 end if;
1584
1585 -- If we cannot find the project file, we return an empty string
1586
1587 if Result = null then
1588 return "";
1589
1590 else
1591 declare
1592 Final_Result : String :=
1593 GNAT.OS_Lib.Normalize_Pathname (Result.all);
1594 begin
1595 Free (Result);
1596 Canonical_Case_File_Name (Final_Result);
1597 return Final_Result;
1598 end;
1599 end if;
1600 end Project_Path_Name_Of;
1601
1602 begin
1603 -- Initialize Project_Path during package elaboration
1604
1605 if Prj_Path.all = "" then
1606 Project_Path := new String'(".");
1607 else
1608 Project_Path := new String'("." & Path_Separator & Prj_Path.all);
1609 end if;
1610 end Prj.Part;
Mirror of the offical gcc git repository hosted at gcc.gnu.org