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