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