1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
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. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 ------------------------------------------------------------------------------
27 with Err_Vars; use Err_Vars;
28 with Namet; use Namet;
30 with Osint; use Osint;
31 with Output; use Output;
32 with Prj.Com; use Prj.Com;
34 with Prj.Err; use Prj.Err;
35 with Scans; use Scans;
36 with Sinput; use Sinput;
37 with Sinput.P; use Sinput.P;
39 with Types; use Types;
41 with Ada.Characters.Handling; use Ada.Characters.Handling;
42 with Ada.Exceptions; use Ada.Exceptions;
44 with GNAT.Directory_Operations; use GNAT.Directory_Operations;
45 with GNAT.OS_Lib; use GNAT.OS_Lib;
47 pragma Elaborate_All (GNAT.OS_Lib);
49 package body Prj.Part is
51 Dir_Sep : Character renames GNAT.OS_Lib.Directory_Separator;
53 Project_Path : String_Access;
54 -- The project path; initialized during package elaboration.
55 -- Contains at least the current working directory.
57 Ada_Project_Path : constant String := "ADA_PROJECT_PATH";
58 -- Name of the env. variable that contains path name(s) of directories
59 -- where project files may reside.
61 Prj_Path : constant String_Access := Getenv (Ada_Project_Path);
62 -- The path name(s) of directories where project files may reside.
65 ------------------------------------
66 -- Local Packages and Subprograms --
67 ------------------------------------
69 type With_Id is new Nat;
70 No_With : constant With_Id := 0;
72 type With_Record is record
74 Location : Source_Ptr;
75 Limited_With : Boolean;
78 -- Information about an imported project, to be put in table Withs below
80 package Withs is new Table.Table
81 (Table_Component_Type => With_Record,
82 Table_Index_Type => With_Id,
85 Table_Increment => 50,
86 Table_Name => "Prj.Part.Withs");
87 -- Table used to store temporarily paths and locations of imported
88 -- projects. These imported projects will be effectively parsed after the
89 -- name of the current project has been extablished.
91 type Name_And_Id is record
96 package Project_Stack is new Table.Table
97 (Table_Component_Type => Name_And_Id,
98 Table_Index_Type => Nat,
101 Table_Increment => 50,
102 Table_Name => "Prj.Part.Project_Stack");
103 -- This table is used to detect circular dependencies
104 -- for imported and extended projects and to get the project ids of
105 -- limited imported projects when there is a circularity with at least
106 -- one limited imported project file.
108 procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id);
109 -- Parse the context clause of a project.
110 -- Store the paths and locations of the imported projects in table Withs.
111 -- Does nothing if there is no context clause (if the current
112 -- token is not "with" or "limited" followed by "with").
114 procedure Post_Parse_Context_Clause
115 (Context_Clause : With_Id;
116 Imported_Projects : out Project_Node_Id;
117 Project_Directory : Name_Id;
118 From_Extended : Boolean);
119 -- Parse the imported projects that have been stored in table Withs,
120 -- if any. From_Extended is used for the call to Parse_Single_Project
123 procedure Parse_Single_Project
124 (Project : out Project_Node_Id;
127 From_Extended : Boolean);
128 -- Parse a project file.
129 -- Recursive procedure: it calls itself for imported and extended
130 -- projects. When From_Extended is True, if the project has already
131 -- been parsed and is an extended project A, return the ultimate
132 -- (not extended) project that extends A.
134 function Project_Path_Name_Of
135 (Project_File_Name : String;
138 -- Returns the path name of a project file. Returns an empty string
139 -- if project file cannot be found.
141 function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id;
142 -- Get the directory of the file with the specified path name.
143 -- This includes the directory separator as the last character.
144 -- Returns "./" if Path_Name contains no directory separator.
146 function Project_Name_From (Path_Name : String) return Name_Id;
147 -- Returns the name of the project that corresponds to its path name.
148 -- Returns No_Name if the path name is invalid, because the corresponding
149 -- project name does not have the syntax of an ada identifier.
151 ----------------------------
152 -- Immediate_Directory_Of --
153 ----------------------------
155 function Immediate_Directory_Of (Path_Name : Name_Id) return Name_Id is
157 Get_Name_String (Path_Name);
159 for Index in reverse 1 .. Name_Len loop
160 if Name_Buffer (Index) = '/'
161 or else Name_Buffer (Index) = Dir_Sep
163 -- Remove all chars after last directory separator from name
166 Name_Len := Index - 1;
176 -- There is no directory separator in name. Return "./" or ".\"
179 Name_Buffer (1) := '.';
180 Name_Buffer (2) := Dir_Sep;
182 end Immediate_Directory_Of;
189 (Project : out Project_Node_Id;
190 Project_File_Name : String;
191 Always_Errout_Finalize : Boolean;
192 Packages_To_Check : String_List_Access := All_Packages)
194 Current_Directory : constant String := Get_Current_Dir;
197 -- Save the Packages_To_Check in Prj, so that it is visible from
200 Current_Packages_To_Check := Packages_To_Check;
202 Project := Empty_Node;
204 if Current_Verbosity >= Medium then
205 Write_Str ("ADA_PROJECT_PATH=""");
206 Write_Str (Project_Path.all);
211 Path_Name : constant String :=
212 Project_Path_Name_Of (Project_File_Name,
213 Directory => Current_Directory);
218 -- Parse the main project file
220 if Path_Name = "" then
222 ("project file """, Project_File_Name, """ not found");
223 Project := Empty_Node;
229 Path_Name => Path_Name,
231 From_Extended => False);
233 -- If there were any kind of error during the parsing, serious
234 -- or not, then the parsing fails.
236 if Err_Vars.Total_Errors_Detected > 0 then
237 Project := Empty_Node;
240 if Project = Empty_Node or else Always_Errout_Finalize then
250 Write_Line (Exception_Information (X));
251 Write_Str ("Exception ");
252 Write_Str (Exception_Name (X));
253 Write_Line (" raised, while processing project file");
254 Project := Empty_Node;
257 ------------------------------
258 -- Pre_Parse_Context_Clause --
259 ------------------------------
261 procedure Pre_Parse_Context_Clause (Context_Clause : out With_Id) is
262 Current_With_Clause : With_Id := No_With;
263 Limited_With : Boolean := False;
265 Current_With : With_Record;
268 -- Assume no context clause
270 Context_Clause := No_With;
273 -- If Token is not WITH or LIMITED, there is no context clause,
274 -- or we have exhausted the with clauses.
276 while Token = Tok_With or else Token = Tok_Limited loop
277 Limited_With := Token = Tok_Limited;
280 Scan; -- scan past LIMITED
281 Expect (Tok_With, "WITH");
282 exit With_Loop when Token /= Tok_With;
287 Scan; -- scan past WITH or ","
289 Expect (Tok_String_Literal, "literal string");
291 if Token /= Tok_String_Literal then
295 -- Store path and location in table Withs
299 Location => Token_Ptr,
300 Limited_With => Limited_With,
303 Withs.Increment_Last;
304 Withs.Table (Withs.Last) := Current_With;
306 if Current_With_Clause = No_With then
307 Context_Clause := Withs.Last;
310 Withs.Table (Current_With_Clause).Next := Withs.Last;
313 Current_With_Clause := Withs.Last;
317 if Token = Tok_Semicolon then
319 -- End of (possibly multiple) with clause;
321 Scan; -- scan past the semicolon.
324 elsif Token /= Tok_Comma then
325 Error_Msg ("expected comma or semi colon", Token_Ptr);
330 end Pre_Parse_Context_Clause;
333 -------------------------------
334 -- Post_Parse_Context_Clause --
335 -------------------------------
337 procedure Post_Parse_Context_Clause
338 (Context_Clause : With_Id;
339 Imported_Projects : out Project_Node_Id;
340 Project_Directory : Name_Id;
341 From_Extended : Boolean)
343 Current_With_Clause : With_Id := Context_Clause;
345 Current_Project : Project_Node_Id := Empty_Node;
346 Previous_Project : Project_Node_Id := Empty_Node;
347 Next_Project : Project_Node_Id := Empty_Node;
349 Project_Directory_Path : constant String :=
350 Get_Name_String (Project_Directory);
352 Current_With : With_Record;
353 Limited_With : Boolean := False;
356 Imported_Projects := Empty_Node;
358 while Current_With_Clause /= No_With loop
359 Current_With := Withs.Table (Current_With_Clause);
360 Current_With_Clause := Current_With.Next;
362 Limited_With := Current_With.Limited_With;
365 Original_Path : constant String :=
366 Get_Name_String (Current_With.Path);
368 Imported_Path_Name : constant String :=
371 Project_Directory_Path);
373 Withed_Project : Project_Node_Id := Empty_Node;
376 if Imported_Path_Name = "" then
378 -- The project file cannot be found
380 Error_Msg_Name_1 := Current_With.Path;
382 Error_Msg ("unknown project file: {", Current_With.Location);
384 -- If this is not imported by the main project file,
385 -- display the import path.
387 if Project_Stack.Last > 1 then
388 for Index in reverse 1 .. Project_Stack.Last loop
389 Error_Msg_Name_1 := Project_Stack.Table (Index).Name;
390 Error_Msg ("\imported by {", Current_With.Location);
397 Previous_Project := Current_Project;
399 if Current_Project = Empty_Node then
401 -- First with clause of the context clause
403 Current_Project := Default_Project_Node
404 (Of_Kind => N_With_Clause);
405 Imported_Projects := Current_Project;
408 Next_Project := Default_Project_Node
409 (Of_Kind => N_With_Clause);
410 Set_Next_With_Clause_Of (Current_Project, Next_Project);
411 Current_Project := Next_Project;
415 (Current_Project, Current_With.Path);
416 Set_Location_Of (Current_Project, Current_With.Location);
418 -- If this is a "limited with", check if we have
419 -- a circularity; if we have one, get the project id
420 -- of the limited imported project file, and don't
423 if Limited_With and then Project_Stack.Last > 1 then
425 Normed : constant String :=
426 Normalize_Pathname (Imported_Path_Name);
427 Canonical_Path_Name : Name_Id;
430 Name_Len := Normed'Length;
431 Name_Buffer (1 .. Name_Len) := Normed;
432 Canonical_Path_Name := Name_Find;
434 for Index in 1 .. Project_Stack.Last loop
435 if Project_Stack.Table (Index).Name =
438 -- We have found the limited imported project,
439 -- get its project id, and don't parse it.
441 Withed_Project := Project_Stack.Table (Index).Id;
448 -- Parse the imported project, if its project id is unknown
450 if Withed_Project = Empty_Node then
452 (Project => Withed_Project,
453 Path_Name => Imported_Path_Name,
455 From_Extended => From_Extended);
458 if Withed_Project = Empty_Node then
459 -- If parsing was not successful, remove the
462 Current_Project := Previous_Project;
464 if Current_Project = Empty_Node then
465 Imported_Projects := Empty_Node;
468 Set_Next_With_Clause_Of
469 (Current_Project, Empty_Node);
472 -- If parsing was successful, record project name
473 -- and path name in with clause
476 (Node => Current_Project,
477 To => Withed_Project,
478 Limited_With => Limited_With);
479 Set_Name_Of (Current_Project, Name_Of (Withed_Project));
480 Name_Len := Imported_Path_Name'Length;
481 Name_Buffer (1 .. Name_Len) := Imported_Path_Name;
482 Set_Path_Name_Of (Current_Project, Name_Find);
487 end Post_Parse_Context_Clause;
489 --------------------------
490 -- Parse_Single_Project --
491 --------------------------
493 procedure Parse_Single_Project
494 (Project : out Project_Node_Id;
497 From_Extended : Boolean)
499 Normed_Path_Name : Name_Id;
500 Canonical_Path_Name : Name_Id;
501 Project_Directory : Name_Id;
502 Project_Scan_State : Saved_Project_Scan_State;
503 Source_Index : Source_File_Index;
505 Extended_Project : Project_Node_Id := Empty_Node;
507 A_Project_Name_And_Node : Tree_Private_Part.Project_Name_And_Node :=
508 Tree_Private_Part.Projects_Htable.Get_First;
510 Name_From_Path : constant Name_Id := Project_Name_From (Path_Name);
512 Name_Of_Project : Name_Id := No_Name;
514 First_With : With_Id;
516 use Tree_Private_Part;
520 Normed : String := Normalize_Pathname (Path_Name);
522 Name_Len := Normed'Length;
523 Name_Buffer (1 .. Name_Len) := Normed;
524 Normed_Path_Name := Name_Find;
525 Canonical_Case_File_Name (Normed);
526 Name_Len := Normed'Length;
527 Name_Buffer (1 .. Name_Len) := Normed;
528 Canonical_Path_Name := Name_Find;
531 -- Check for a circular dependency
533 for Index in 1 .. Project_Stack.Last loop
534 if Canonical_Path_Name = Project_Stack.Table (Index).Name then
535 Error_Msg ("circular dependency detected", Token_Ptr);
536 Error_Msg_Name_1 := Normed_Path_Name;
537 Error_Msg ("\ { is imported by", Token_Ptr);
539 for Current in reverse 1 .. Project_Stack.Last loop
540 Error_Msg_Name_1 := Project_Stack.Table (Current).Name;
542 if Error_Msg_Name_1 /= Canonical_Path_Name then
544 ("\ { which itself is imported by", Token_Ptr);
547 Error_Msg ("\ {", Token_Ptr);
552 Project := Empty_Node;
557 Project_Stack.Increment_Last;
558 Project_Stack.Table (Project_Stack.Last).Name := Canonical_Path_Name;
560 -- Check if the project file has already been parsed.
563 A_Project_Name_And_Node /= Tree_Private_Part.No_Project_Name_And_Node
566 Path_Name_Of (A_Project_Name_And_Node.Node) = Canonical_Path_Name
570 if A_Project_Name_And_Node.Extended then
572 ("cannot extend the same project file several times",
577 ("cannot extend an already imported project file",
581 elsif A_Project_Name_And_Node.Extended then
582 -- If the imported project is an extended project A, and we are
583 -- in an extended project, replace A with the ultimate project
586 if From_Extended then
588 Decl : Project_Node_Id :=
589 Project_Declaration_Of
590 (A_Project_Name_And_Node.Node);
591 Prj : Project_Node_Id :=
592 Extending_Project_Of (Decl);
595 Decl := Project_Declaration_Of (Prj);
596 exit when Extending_Project_Of (Decl) = Empty_Node;
597 Prj := Extending_Project_Of (Decl);
600 A_Project_Name_And_Node.Node := Prj;
604 ("cannot import an already extended project file",
609 Project := A_Project_Name_And_Node.Node;
610 Project_Stack.Decrement_Last;
614 A_Project_Name_And_Node := Tree_Private_Part.Projects_Htable.Get_Next;
617 -- We never encountered this project file
618 -- Save the scan state, load the project file and start to scan it.
620 Save_Project_Scan_State (Project_Scan_State);
621 Source_Index := Load_Project_File (Path_Name);
623 -- if we cannot find it, we stop
625 if Source_Index = No_Source_File then
626 Project := Empty_Node;
627 Project_Stack.Decrement_Last;
631 Prj.Err.Scanner.Initialize_Scanner (Types.No_Unit, Source_Index);
634 if Name_From_Path = No_Name then
636 -- The project file name is not correct (no or bad extension,
637 -- or not following Ada identifier's syntax).
639 Error_Msg_Name_1 := Canonical_Path_Name;
640 Error_Msg ("?{ is not a valid path name for a project file",
644 if Current_Verbosity >= Medium then
645 Write_Str ("Parsing """);
646 Write_Str (Path_Name);
651 Project_Directory := Immediate_Directory_Of (Normed_Path_Name);
652 Project := Default_Project_Node (Of_Kind => N_Project);
653 Project_Stack.Table (Project_Stack.Last).Id := Project;
654 Set_Directory_Of (Project, Project_Directory);
655 Set_Path_Name_Of (Project, Normed_Path_Name);
656 Set_Location_Of (Project, Token_Ptr);
658 -- Is there any imported project?
660 Pre_Parse_Context_Clause (First_With);
662 Expect (Tok_Project, "PROJECT");
664 -- Mark location of PROJECT token if present
666 if Token = Tok_Project then
667 Set_Location_Of (Project, Token_Ptr);
668 Scan; -- scan past project
676 Expect (Tok_Identifier, "identifier");
678 -- If the token is not an identifier, clear the buffer before
679 -- exiting to indicate that the name of the project is ill-formed.
681 if Token /= Tok_Identifier then
686 -- Add the identifier name to the buffer
688 Get_Name_String (Token_Name);
689 Add_To_Buffer (Name_Buffer (1 .. Name_Len));
691 -- Scan past the identifier
695 -- If we have a dot, add a dot the the Buffer and look for the next
698 exit when Token /= Tok_Dot;
706 -- If the name is well formed, Buffer_Last is > 0
708 if Buffer_Last > 0 then
710 -- The Buffer contains the name of the project
712 Name_Len := Buffer_Last;
713 Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
714 Name_Of_Project := Name_Find;
715 Set_Name_Of (Project, Name_Of_Project);
717 -- To get expected name of the project file, replace dots by dashes
719 Name_Len := Buffer_Last;
720 Name_Buffer (1 .. Name_Len) := Buffer (1 .. Buffer_Last);
722 for Index in 1 .. Name_Len loop
723 if Name_Buffer (Index) = '.' then
724 Name_Buffer (Index) := '-';
728 Canonical_Case_File_Name (Name_Buffer (1 .. Name_Len));
731 Expected_Name : constant Name_Id := Name_Find;
734 -- Output a warning if the actual name is not the expected name
736 if Name_From_Path /= No_Name
737 and then Expected_Name /= Name_From_Path
739 Error_Msg_Name_1 := Expected_Name;
740 Error_Msg ("?file name does not match unit name, " &
741 "should be `{" & Project_File_Extension & "`",
747 Imported_Projects : Project_Node_Id := Empty_Node;
750 Post_Parse_Context_Clause
751 (Context_Clause => First_With,
752 Imported_Projects => Imported_Projects,
753 Project_Directory => Project_Directory,
754 From_Extended => Extended);
755 Set_First_With_Clause_Of (Project, Imported_Projects);
759 Project_Name : Name_Id :=
760 Tree_Private_Part.Projects_Htable.Get_First.Name;
763 -- Check if we already have a project with this name
765 while Project_Name /= No_Name
766 and then Project_Name /= Name_Of_Project
768 Project_Name := Tree_Private_Part.Projects_Htable.Get_Next.Name;
771 -- Report an error if we already have a project with this name
773 if Project_Name /= No_Name then
774 Error_Msg ("duplicate project name", Token_Ptr);
777 -- Otherwise, add the name of the project to the hash table, so
778 -- that we can check that no other subsequent project will have
781 Tree_Private_Part.Projects_Htable.Set
782 (K => Name_Of_Project,
783 E => (Name => Name_Of_Project,
785 Extended => Extended));
791 if Token = Tok_Extends then
793 -- Make sure that gnatmake will use mapping files
795 Opt.Create_Mapping_File := True;
797 -- We are extending another project
799 Scan; -- scan past EXTENDS
800 Expect (Tok_String_Literal, "literal string");
802 if Token = Tok_String_Literal then
803 Set_Extended_Project_Path_Of (Project, Token_Name);
806 Original_Path_Name : constant String :=
807 Get_Name_String (Token_Name);
809 Extended_Project_Path_Name : constant String :=
813 (Project_Directory));
816 if Extended_Project_Path_Name = "" then
818 -- We could not find the project file to extend
820 Error_Msg_Name_1 := Token_Name;
822 Error_Msg ("unknown project file: {", Token_Ptr);
824 -- If we are not in the main project file, display the
827 if Project_Stack.Last > 1 then
829 Project_Stack.Table (Project_Stack.Last).Name;
830 Error_Msg ("\extended by {", Token_Ptr);
832 for Index in reverse 1 .. Project_Stack.Last - 1 loop
833 Error_Msg_Name_1 := Project_Stack.Table (Index).Name;
834 Error_Msg ("\imported by {", Token_Ptr);
840 (Project => Extended_Project,
841 Path_Name => Extended_Project_Path_Name,
843 From_Extended => False);
847 Scan; -- scan past the extended project path
851 -- Check that a project with a name including a dot either imports
852 -- or extends the project whose name precedes the last dot.
854 if Name_Of_Project /= No_Name then
855 Get_Name_String (Name_Of_Project);
861 -- Look for the last dot
863 while Name_Len > 0 and then Name_Buffer (Name_Len) /= '.' loop
864 Name_Len := Name_Len - 1;
867 -- If a dot was find, check if the parent project is imported
871 Name_Len := Name_Len - 1;
874 Parent_Name : constant Name_Id := Name_Find;
875 Parent_Found : Boolean := False;
876 With_Clause : Project_Node_Id := First_With_Clause_Of (Project);
879 -- If there is an extended project, check its name
881 if Extended_Project /= Empty_Node then
882 Parent_Found := Name_Of (Extended_Project) = Parent_Name;
885 -- If the parent project is not the extended project,
886 -- check each imported project until we find the parent project.
888 while not Parent_Found and then With_Clause /= Empty_Node loop
889 Parent_Found := Name_Of (Project_Node_Of (With_Clause))
891 With_Clause := Next_With_Clause_Of (With_Clause);
894 -- If the parent project was not found, report an error
896 if not Parent_Found then
897 Error_Msg_Name_1 := Name_Of_Project;
898 Error_Msg_Name_2 := Parent_Name;
899 Error_Msg ("project { does not import or extend project {",
900 Location_Of (Project));
905 Expect (Tok_Is, "IS");
908 Project_Declaration : Project_Node_Id := Empty_Node;
911 -- No need to Scan past "is", Prj.Dect.Parse will do it.
914 (Declarations => Project_Declaration,
915 Current_Project => Project,
916 Extends => Extended_Project);
917 Set_Project_Declaration_Of (Project, Project_Declaration);
919 if Extended_Project /= Empty_Node then
920 Set_Extending_Project_Of
921 (Project_Declaration_Of (Extended_Project), To => Project);
925 Expect (Tok_End, "END");
927 -- Skip "end" if present
929 if Token = Tok_End then
937 -- Store the name following "end" in the Buffer. The name may be made of
938 -- several simple names.
941 Expect (Tok_Identifier, "identifier");
943 -- If we don't have an identifier, clear the buffer before exiting to
944 -- avoid checking the name.
946 if Token /= Tok_Identifier then
951 -- Add the identifier to the Buffer
952 Get_Name_String (Token_Name);
953 Add_To_Buffer (Name_Buffer (1 .. Name_Len));
955 -- Scan past the identifier
958 exit when Token /= Tok_Dot;
963 -- If we have a valid name, check if it is the name of the project
965 if Name_Of_Project /= No_Name and then Buffer_Last > 0 then
966 if To_Lower (Buffer (1 .. Buffer_Last)) /=
967 Get_Name_String (Name_Of (Project))
969 -- Invalid name: report an error
971 Error_Msg ("Expected """ &
972 Get_Name_String (Name_Of (Project)) & """",
977 Expect (Tok_Semicolon, "`;`");
979 -- Check that there is no more text following the end of the project
982 if Token = Tok_Semicolon then
985 if Token /= Tok_EOF then
987 ("Unexpected text following end of project", Token_Ptr);
991 -- Restore the scan state, in case we are not the main project
993 Restore_Project_Scan_State (Project_Scan_State);
995 -- And remove the project from the project stack
997 Project_Stack.Decrement_Last;
998 end Parse_Single_Project;
1000 -----------------------
1001 -- Project_Name_From --
1002 -----------------------
1004 function Project_Name_From (Path_Name : String) return Name_Id is
1005 Canonical : String (1 .. Path_Name'Length) := Path_Name;
1006 First : Natural := Canonical'Last;
1007 Last : Natural := First;
1011 if Current_Verbosity = High then
1012 Write_Str ("Project_Name_From (""");
1013 Write_Str (Canonical);
1017 -- If the path name is empty, return No_Name to indicate failure
1023 Canonical_Case_File_Name (Canonical);
1025 -- Look for the last dot in the path name
1029 Canonical (First) /= '.'
1034 -- If we have a dot, check that it is followed by the correct extension
1036 if First > 0 and then Canonical (First) = '.' then
1037 if Canonical (First .. Last) = Project_File_Extension
1040 -- Look for the last directory separator, if any
1046 and then Canonical (First) /= '/'
1047 and then Canonical (First) /= Dir_Sep
1053 -- Not the correct extension, return No_Name to indicate failure
1058 -- If no dot in the path name, return No_Name to indicate failure
1066 -- If the extension is the file name, return No_Name to indicate failure
1068 if First > Last then
1072 -- Put the name in lower case into Name_Buffer
1074 Name_Len := Last - First + 1;
1075 Name_Buffer (1 .. Name_Len) := To_Lower (Canonical (First .. Last));
1079 -- Check if it is a well formed project name. Return No_Name if it is
1083 if not Is_Letter (Name_Buffer (Index)) then
1090 exit when Index >= Name_Len;
1092 if Name_Buffer (Index) = '_' then
1093 if Name_Buffer (Index + 1) = '_' then
1098 exit when Name_Buffer (Index) = '-';
1100 if Name_Buffer (Index) /= '_'
1101 and then not Is_Alphanumeric (Name_Buffer (Index))
1109 if Index >= Name_Len then
1110 if Is_Alphanumeric (Name_Buffer (Name_Len)) then
1112 -- All checks have succeeded. Return name in Name_Buffer
1120 elsif Name_Buffer (Index) = '-' then
1124 end Project_Name_From;
1126 --------------------------
1127 -- Project_Path_Name_Of --
1128 --------------------------
1130 function Project_Path_Name_Of
1131 (Project_File_Name : String;
1135 Result : String_Access;
1138 if Current_Verbosity = High then
1139 Write_Str ("Project_Path_Name_Of (""");
1140 Write_Str (Project_File_Name);
1141 Write_Str (""", """);
1142 Write_Str (Directory);
1143 Write_Line (""");");
1146 if not Is_Absolute_Path (Project_File_Name) then
1147 -- First we try <directory>/<file_name>.<extension>
1149 if Current_Verbosity = High then
1150 Write_Str (" Trying ");
1151 Write_Str (Directory);
1152 Write_Char (Directory_Separator);
1153 Write_Str (Project_File_Name);
1154 Write_Line (Project_File_Extension);
1159 (File_Name => Directory & Directory_Separator &
1160 Project_File_Name & Project_File_Extension,
1161 Path => Project_Path.all);
1163 -- Then we try <directory>/<file_name>
1165 if Result = null then
1166 if Current_Verbosity = High then
1167 Write_Str (" Trying ");
1168 Write_Str (Directory);
1169 Write_Char (Directory_Separator);
1170 Write_Line (Project_File_Name);
1175 (File_Name => Directory & Directory_Separator &
1177 Path => Project_Path.all);
1181 if Result = null then
1183 -- Then we try <file_name>.<extension>
1185 if Current_Verbosity = High then
1186 Write_Str (" Trying ");
1187 Write_Str (Project_File_Name);
1188 Write_Line (Project_File_Extension);
1193 (File_Name => Project_File_Name & Project_File_Extension,
1194 Path => Project_Path.all);
1197 if Result = null then
1199 -- Then we try <file_name>
1201 if Current_Verbosity = High then
1202 Write_Str (" Trying ");
1203 Write_Line (Project_File_Name);
1208 (File_Name => Project_File_Name,
1209 Path => Project_Path.all);
1212 -- If we cannot find the project file, we return an empty string
1214 if Result = null then
1219 Final_Result : String :=
1220 GNAT.OS_Lib.Normalize_Pathname (Result.all);
1223 Canonical_Case_File_Name (Final_Result);
1224 return Final_Result;
1227 end Project_Path_Name_Of;
1230 -- Initialize Project_Path during package elaboration
1232 if Prj_Path.all = "" then
1233 Project_Path := new String'(".");
1235 Project_Path := new String'("." & Path_Separator & Prj_Path.all);